BradleyTerry2/0000755000176200001440000000000013616022414012743 5ustar liggesusersBradleyTerry2/NAMESPACE0000744000176200001440000000373113615337047014201 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(add1,BTm) S3method(anova,BTm) S3method(coef,BTabilities) S3method(drop1,BTm) S3method(formula,BTm) S3method(model.matrix,BTm) S3method(predict,BTglmmPQL) S3method(predict,BTm) S3method(print,BTabilities) S3method(print,BTglmmPQL) S3method(print,BTm) S3method(print,summary.BTglmmPQL) S3method(qvcalc,BTabilities) S3method(residuals,BTm) S3method(summary,BTglmmPQL) S3method(vcov,BTabilities) S3method(vcov,BTglmmPQL) export(BTabilities) export(BTm) export(GenDavidson) export(countsToBinomial) export(glmmPQL) export(glmmPQL.control) export(plotProportions) export(qvcalc) importFrom(brglm,brglm) importFrom(graphics,curve) importFrom(graphics,plot) importFrom(graphics,points) importFrom(gtools,combinations) importFrom(lme4,findbars) importFrom(lme4,nobars) importFrom(qvcalc,qvcalc) importFrom(qvcalc,qvcalc.default) importFrom(stats,.checkMFClasses) importFrom(stats,.getXlevels) importFrom(stats,C) importFrom(stats,add.scope) importFrom(stats,as.formula) importFrom(stats,coef) importFrom(stats,contrasts) importFrom(stats,delete.response) importFrom(stats,drop.scope) importFrom(stats,family) importFrom(stats,fitted) importFrom(stats,formula) importFrom(stats,gaussian) importFrom(stats,glm.control) importFrom(stats,glm.fit) importFrom(stats,is.empty.model) importFrom(stats,model.frame) importFrom(stats,model.matrix) importFrom(stats,model.offset) importFrom(stats,model.response) importFrom(stats,model.weights) importFrom(stats,na.exclude) importFrom(stats,na.omit) importFrom(stats,na.pass) importFrom(stats,napredict) importFrom(stats,naprint) importFrom(stats,optimize) importFrom(stats,pchisq) importFrom(stats,pf) importFrom(stats,plogis) importFrom(stats,pnorm) importFrom(stats,printCoefmat) importFrom(stats,reformulate) importFrom(stats,relevel) importFrom(stats,runif) importFrom(stats,symnum) importFrom(stats,terms) importFrom(stats,update) importFrom(stats,update.formula) importFrom(stats,vcov) importFrom(utils,flush.console) BradleyTerry2/README.md0000744000176200001440000000220413615536111014224 0ustar liggesusers # BradleyTerry2 [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/BradleyTerry2)](https://cran.r-project.org/package=BradleyTerry2) [![Travis-CI Build Status](https://travis-ci.org/hturner/BradleyTerry2.svg?branch=master)](https://travis-ci.org/hturner/BradleyTerry2) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/hturner/BradleyTerry2?branch=master&svg=true)](https://ci.appveyor.com/project/hturner/BradleyTerry2) Specify and fit the Bradley-Terry model, including structured versions in which the parameters are related to explanatory variables through a linear predictor and versions with contest-specific effects, such as a home advantage. ## Installation You can install **BradleyTerry2** from github with: ``` r # install.packages("devtools") devtools::install_github("hturner/BradleyTerry2") ``` ## Code of conduct Please note that this project is released with a [Contributor Code of Conduct](https://github.com/hturner/BradleyTerry2/blob/master/CONDUCT.md). By participating in this project you agree to abide by its terms. BradleyTerry2/data/0000755000176200001440000000000013615557421013666 5ustar liggesusersBradleyTerry2/data/seeds.rda0000644000176200001440000000047713615557421015471 0ustar liggesusersJ@omRB.\IE]E+첏#9b.:09d&SN]"޶Ȳ :4ȡѭ,IWT5h=tX3݇ޮJj䯡wC  U}ZޣX6E=BQ{sz6cdUg߃~fF}{$rS{}d#eX weƳJ_߼n6Ca0dB){B BP(45͞eDnieŹЧqwgzǎaUڧk \kۣ%mL;m펯%8-նҾءǓ;[o7i_E: ?K5ΚD&V#&ְK`xZlڵDjGCtl9r}Iy~.ƶmvenreNUa틠e,v=jb8/͌^뵞]tL6h_k-f6,FwiL}{j4.k{s|<ް[ czk7)p1㜊1;\ٯc3m2kQ>ӦEfZk<,oh"]G{Mefk_neڞ_~ >V:όڹǬAǴ e4^~vcqXTk]ˌg}n-hl.W-ocۧe3'g1Iږw>wSqW8̼H/ sڏS#f>fOoT{].)c۷Y߱]f/7;YX/96&_^0sokS};ybi_1h{1K~Mb/;+g;B׿;Z_ɹ5&^<ڭĴGD:9;݌XvV|,-'ow]+Aڃqat3fZL9^oh=y~lbhxsf}:6xX֥py Ę,mCЬf㡱oO?>xDu"D=VOR*7&Fk='chƞnjT/91Zmo]qs6Dcl62Q9?{js\ę7P5W͵f>~E*'ϾчO4㱲V<# WGΜMLL6ToLTo21)1>vlmYƐVֶΝlߓ7ߊD)8%7ȍķCG;9fȧ(w_w|:fnΉczbǘ,om/0={Baε^&roO9^sKLvwO+f|Bb,-;,9/>c3JDfp{Nk(ѿ)N}j^zןQ7{LvudDܧw-zyx@/X rX/8111rAz_he=&es^V_?߬ݷkEzguX>6l,N߫m=\sj2۩,Zbҥhm5Nzac+ ۵MA:M;-%Zx:X;i{Ljz5f|/LIuhi7hOېt[ֻͭ~-#q79^kZוZߕ&%u֘uƳ{tlw<ڤԧ#޲2Dy uDhb\Z5Z-o RXcaU:1nZ!vwSL0q˴;] ԁ+.kυ:[ O5Nť0/ױ:h֬a>mZfn01=G9ޮ٧zIqeeڎ؏ﶘyr},,o3 \ۤ j4~UӀImߩ}، ?Z)Q.L0)"ӦMi_1\(cQL_Zu<1qI)^Ϥ,1Xe͘^xbWNLo+-؛MG.5:LZf=#fRczFL^h֛agY2-KLzHˌczP[n㏘agV.t,{~~6{ѣ.{Dvl3kOLA٧mXb6w{'4{:+͵e:4~L]rb}8ly N" sҾZs!7}\ɠz1&*}:J-_ۢ嬙J5 Ü2-&sf=~mo#:vk\ݠ8l'6kܱG[)CZVĽwwT冁?C\6{^#6xy9Ǭs&fqgDu|kYgyqu.,2?۸bk9fМm7ibKVhݎkМ4\~)-p5jRդIe$# wO1y"禒 3[D.VH;wK~AژqssBWH\LDۨ$ߧcrmEHWLqpuI䏔G]sc%%Tܿ|JĸO$GK#%sA\}}XH+=6r<?xzf~{D=.+$ }|nTgq\ aS<+G.SGHgD\9$ȃxWsʼ9L\wפry|./N[$Q7)o4G +oY=[+n3;|QXC$Z˝W NߖĽP3fND |2o;{'fl|%r\$q-yINWp}[PPvs|^\dSÇD~w=_>['$_5CqII(WD>a|% eJbOT:~ %Òxy?B"6K乧rC >u(cM)=]HO%^6/'1^}="7*nṆO~^-N䲱R?DuOb/%cJ\$G.O;E gA(_$L}k^ŌH|Αe%vN$3sydr/K2ˎi|[K*F;m3Fn.T>ų6;p!GSq WҲgւa\S;j=)uoWۍXEIP¯+ck_Ȯ|:ן(wk}^r]HIM9xYoUz?/_1- H\_x%{f^r-JryKpk?QN^[eCb_$)1!!OxNОgWǾϹPeSͧX% n>])NBk]d||R9_;psl\ƹg߅v]*+* Oƿ81nMoM~vωK|,_??x~nsxnt?gi?q:~qnmmw>u~?/l^cv.tgM|iEe;oBgÙ{|LYY[Ԧ;ٮ\#ܴM_/_;vmg͹:ojۏ.L]L7u>-?m禭ׅcQݚ_31C͐nߴ]\f8~}fƳMGuw:;|v0϶K9=x_:8ݼ>a׽f΋]찝Ǚ^g;wm!g:r<܌{:~cƹu9~N߻A{;N}TΏywrƋW4ԁ6?K} f=Nc]U]Clefm~}̍c΋|_Y|:'G8b᪮dPlYw__zڼ+x}b%u:$xXm ?iW-󣓯>8W_ l<4k6`.W;٥W׮^_MjYuԭW^LU֭׸^?Uح`^ z`vׁ^zvWr^zxD^7_zUyKo" kBZnV/.ˠ/o]:nnn =z ttt't7T諡C_= 3gAUk{4A@u45(l9P뱪֘&BC_=z>7@/^z17B/ z9 [WAz5o z=7B}'wA}/}B?C? O@? 4SC?/@?"K/C UW_~M跡߂~?}O?ϡ诠{o z ?B z;O;z'.PB{B _ЇC> .~ $'> }9ǡC }A'O O 'O @>{/ O` &x|?@ @>'x{'x} ^@? 'x ? 'x 'O?}'O? @`>>@?w '0O'pO>} A >@  >@ >@`?@>}'pO><>@>'O?} ^@ PwxO ` 3|4{0< >0< >? 3g3gx `` 3g >{03g7pn=z>g`> ݭ!p0gp`<0g`?G0g`> 3gx `;3gx3< 3g? `x 3| 3g` `00gx0< 3 `=3|=3xgx3<>y'0< 3g>3g=3xg `={0g` 3g?{ ``< ?`?}0gx 3g?}0g 3 /`_ x} p/`^!_ xy x p/0/p/// |@x}p/^}/`_{O |@}|@> x{/ / @}x}/_ x// rm9`?/kAZ/Tx@Zh];x@@hz*~0A/]Htu:t_;. J:BradleyTerry2/data/football.RData0000744000176200001440000001420313152515665016406 0ustar liggesusersyW$%TdY@a}ԿII( 쿴Mh1ABη+pN=[J"@q:=SX˿nɵ'o\|Ƶqr׷zo?|xrro>}×˱˱P˱˱kQ˱˱kQn˱˱kQywgQ{Gp:7M{.:o'ev>z|/'?X~2|65\y`39坁eW˭݁7qsqu^9|>G#F#Gwu~|ӁÁptGwa2c??X^2>y56??[ٽOvO.?nowsn_v_.w|ߗ~nj:_}~v>>f{_g_~v꼾T//e]&2 ȴ,v-K/qY's}68[s18s\o\7xpsn\ I#Ϛ['WUW\o \՚u|\|\7xps\uspzoplo^ƺ|}d7~MZ~Kc\=l}8$WWU㪹ukpۃs}:8s78 eкB\[^-Xk?Z- }8$WWU㪹>\=8s}08{,[|tr|?*ׇs譹~<8gs]6_%ךN38׵Wuwp[s>qxE|?z˶s_{[skxx~:-g{غn~{-}꫎}k/zgk[zxlV_og<˶Cz~u<懵7Uk۱uqvX;[yoU/y8gΧ~:t^:r/_}^}ggm{?t>i׫-|~=?lW:ʿ~׏Z緎mzkT?|[{Wo~5_+oe]7O^lX;o_C}뺇Sz5Gk~/Zש?Wwh>_ovϫʷv>߻Ρmz_[[om[Uo/7?/mm{^?:NӲ׏~(˶[/O׎}nm{_uY;>zlϭ^?y~՛޽lq?>{\븕gxq?me[;mqozWxz]{~oԼkC,[[ڛgWǷ޶v8[߫׶w}~zv|y^νquxW+ޛڛ:_mזmwh]oZ;|W=ڿV|kۣmߺ~ӛ/[νX>Źc鍯ZmmkwZ;?m[mZ;?z<9yg7?}G˟ã?.|wk9'>miz?O_]G}q7q~ccWǡ:qsu\?ξuvw:@:P&UML5j0`Ts u&uM5kRפICMjP,` 5XB kX,UkXƚ4֤&5iISMjT,`K5Xr k\,Uk\4פ&-5iIKMZjR`+5\5\5\u5\5鼐ڧL#dD " @8p wz9yfY`fY`B 4 B 4 BV f999999999000000000V#333333333 Q3g A8p `+V[ lӚY/_[ l%J`+V[ l%J`+V/_ l%J`+V[ l%J`+V  %K`+V[ l%J`+V[ lfK/_[ l%J`+V[ l%J`+` %J`+V [2leʰa+V [2 2e˰a+V [2leʰa+V [2le>>>>>>>>555555555#3Q3Q3Q3Q3Q3Q3Q3Q%BBBBBBBBBB3QgD:u<P(CQ E2[[B(Q(CQ E2e(P(CQ E2e(po5o ~(Q(CQ E2e(P(CQ E2eHO?~(P(CQ E2e(P(CQ E2[; яE?~e(P(CQ E2e(P(CQ E-!ӏE?2e(P)CS M24ehД)CS ͇EӏM?~4ehД)CS M24ehД)CS MM?~4hД)CS M24ehД)CS M24M?~4hє)CS M24ehД)CS M24eh>,~4h)CS M24ehД)CS M24eh|X4hjtojˀ@:@u~[{"F$ IdD "`fP BP  BШU`6 f`6####j59999999999000000000V33333    g A8pZ,~4h)CS M24ehД)CS M24eh|X4hGS M24ehД)CS M24ehДhGӏ M24ehД)CS M24ehД)CaGӏy7yo5eu ԁXRuԁ: 潊L#$D2"0 @( @( AhԪl0l0@@@@@AAAAQ3g A8pF`>>>>>>>>555555555#3Q3Q3Q3Q3Q3Q3Q3Q%BBBBBBBBBB3QgD:u<P(CQ E2_; ^Gя E2e(P(CQ E2e(P(ռGяE2e(P(CQ E2e(P(CQyg!ӏE?2e(P(CQ E2e(P(CQ W^GяE?2e(P(CQ E2e(P(CQ WBE?~e(P(CS M24ehД)CS MM?~4hД)CS M24ehД)CS M24M?~4hє)CS M24ehД)CS M24eh>,~4h)CS M24ehД)CS M24eh|X4hGS M24ehД)CS M24ehДhy''yQz(bb"BradleyTerry2/data/citations.rda0000644000176200001440000000036313615557421016355 0ustar liggesusersQ;@4BԘx.`'OEخJt# Qъ#x#3h&g r.]`5 K[UDg4*M2Dg>!4@xxOӍc'<{s8gN8`] hmFh;FϗDW=uKX:2G̴&^<3(qa׼ul.*Dr-Vovˬ~H#WqDn(^i*BradleyTerry2/data/CEMS.rda0000644000176200001440000002007413615557421015110 0ustar liggesusers][rWr.z9A@8AKFyli5 G Ҟk Z+;wpW DClT>N#fwɼO7>{뺾JN~Ou|o|ݓO>_;us=ye#k$J_&ᯐWII_#ᯓ7H$-6 ME·I$=> H?"OH$39 pv$8^GH8p?H8p ~ؑp_v$8#H8p𣎄?H8p # $Ht$p ႃt$p ႃ7;I8pO;I8pw$p ႃۑpN #ᜄ #ᜄ s$\p;I8pH8'@#ᜄ s$\p;I8pH8'@:npN-$<"ႄ 7I8' pAHI9 H8 6t$$ᜄ[$HxD ou$$ᜄ[$HxD w;npN-$<"ႄ;npN-$<"ႄ?HI9 H8 6~ޑpsnp  $lӑpsnp  $lYGMIEG$\q$p H a^GMIEG$\qnGMIEG$\qp#& $"@#.H8xБpsnp  $lב* 7I& $A-#@/IxD¯H $l$?ػ{ʗw//vno<8x}7mڳ|C\~!y%?%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[%[[􏺴mz.-ҝy+wy{Z=W[:UU_^VK?]wQ8ֿ~ӯU<֯_>[GڿZ}ꕶi_KG7召~jZ=nT;{Zcc#F]mGUo/^q7qߨ8_kF_7DŅ,>)9^; vhV V^R^nmg~kתg|K-Y+hヵv#:f:tꁔGIfQ_T{gՑ ūE^_yۑnBfm>m?suuѬzR7CKzo8u 5+}iǭfV>]W֭zOXX^Eϓɚ7WY̪3X7q(~mj|c*yy:i ޼ͧ~mQ5~}(@>PUȚߎO퇽Zu?GQv<1Qv«o(QvUgUz]nTߨ87PQ:FukjQ~/FʿPotFs8,j}e'>eGY Dީwjh ϭ㽿h7ڏQ~Q5Q7+ߋ_e,;BPko o{(;G8csGZEQT;kI4V^m¯͟'떧xGsQ1+Eh?UB (=gGuo:PTEs3d:Q8<FSϮesR~2*?#oCsB;]UTlj =O&]%QBT)Qvdh?TK~e`mϩ?Q-XQ~Ds;5~Y~ mσd7T ^%}SZ(?}.źD&o!odk͟áyqa߬(x%βxn׍7kmOZ&=q+:O؛_}UWYW5|skD!$:=z+z;klG|)n45;o}?k\%;d_־Y~폢Z_%ߟj1gfek}\>G]8yS;elj׬ߧbG'|Zv>X~'2$LL-fs,j~ghEl{aVyJWx]j6]WWdlUS@۩k?ֹC1!j=u'}N+:|*5s̨|l~ݻWAcO`v'k_<'jqukuoԹ77[ze[d/O{~Y|2jBQA:\\`=8׵cmGsT\:/~sFyտ8w^*SZygs]wJS6<:{9Ӿ.z^#+*?Y(:EGo/z+pEui/k\Fzkǯzui穴TϕWǮU{~U|SY놧 k|'k}[aլvzs!k~(?-绖ߺ/zwu{(d[uG*הy+'3u~}|V<|exQ~nEZw/Z,{{YWy}C2N3<{R\>|Ckd}yEZ=UΥ]s]7:^1q/F\z+.^4u(}߬}TfWUoWUUzMW߮ ,XwjZ.=\~.T2Mo޼+ y=\u~XHlg]c e?oUyPԤ~NVd_+/^<Lzvqz OqoYoWZ?[N)+q m2?!o9f ZGV]9.(_E /E:x:yJkR#F߭h}0_oGi7Gs۔rWV;ZJ{Yܧy,bگb=F[φۑ28f]WZUe]goh+Ql(5@  T{gՑy Wɕq5IʟQC_ڎu;>K cIqP=kjvo;Nnlxo;uy~2*?#uRVQu3s?T;kTP +X\MXWhظ v}V:X#E]7j\ڏc^?9q)߯W|P]W{ RkڇX< 1='3Wc+gb^t|[ڎ7i̷žS?G[S߇0n?Dπz3GK=OCGxcWv5:\׽qU?q(a~ooFgi|RMn:tk~l;a)#5Y;At#j{U}DMy@3_yXԺԺ0 'uM}yfg·GDG8{Qv}>\`uI HQ/u[LjO:_ݟ4wJf)9Z6;8y5>h5z6,?*_xՎMiF40M}hXa.Ql<'?2=k]]C_TaFxb/|7=I+_EOY>7.H5q;cU|ց`TgT}CWW޸وXhJnǗqpuXK(oP\Gճ!x4ՁJY\D镵2ql?obCw oM<Św{ח6I oo5tosQ(z&F7u֩Կ`󮅼)+EQI|,? ^YOAhM+uMPTگYQ9h}Quک뚬|=k=U/$jϩ'at(?i=*/iJwmxۣznh=Wat $ޕ寴yhmg#QYzޗie>tݵ<@i~=OS~}]zBk=O qcc󦚮^5VާOzh7o+vnu..K}|cW7L?kѺG(WQ|cѼjG(Giͮj;;kGX¯y(jެ֎ۄyhrvV YG;^V=tJ*`Eۑ6DAT4ۛŏ1ᝇfs z%Yoho;SNd7^kfz~~eGֺZ[i q[)ZuTQԳfRK^Ӌ>B͏2N|y(jCW![B;]*.&+ձj4Ou7KȻo77w+m?6T&;<uޯW|PYWk\fͯU;ylH^k]s< Ai}WZGP?MϢxNyv]7fsyϤ=ۄvt{V?ϣv%:U]|j^~S(D>v]DC]i|R런 ck:TImit8ڗes!>vna躀/ku'|oP㶯|%?@烨}=m_C?ikG}׎:E5~|]-1C8W]'f?ބ7]?P|3ύQ'{nMT>莇B;{(:1Ǖ~bև,(dCZތu]1IԺ()Oy.NIqpXq+belRӄ}tum]eߏ}N]:/:?AMHߚ25Ix{9xQ[`ԸAή+rS)*1C~]Aq>Vx<Ԛ/K$ţ||"u3h5_xҏܽ{=r{{SKԘ̠f|ViT]jUo-HW$/qgSl~ ?S/s}u{C<>qVCman&BtZj*-faIz83U UJ4yZǮ#-Kg4]tzR׌GGi53[N8RMIOp!Rj{a 96GVОWn]fO~xtj"Oұ~~w޼|ןL}{ˏ^Gzs&>3L}AN!R9rgȋ^"ڼR>:ؿu|g;7\p{oowq{wJѻ>DWBradleyTerry2/data/springall.rda0000644000176200001440000000127413615557421016355 0ustar liggesusersUn@n %) "!CVTA&⨽5CVN57z@73;;;z14J`.G7/&ӳ M55d@.zj-o c Y GI09'ҁtLL61bļ!GL8s10قsR4)SSIܾIN2Ofihl+ KÐe{H鞔Tt5UO~I wEPKKq,qq&)K-&_4%!֊4.к|HⲱפqЁvK--}|֚1ہbrQ=Tkg~Hߐ_2<>vs`Z}r؁1pC3`x*[Z܆|ש*k*y8J\źu&?LY)>TJ<?O)@ɊyAe*ްKH7 ];E^L`hƯe-3DGX rM:W|t1I5o,x֯-wϯQuثX]y|޻K?eCt[=xWۊ>A3iXQpNrF[MzM N$LSfտI!ge/i"MĻ da BradleyTerry2/data/chameleons.rda0000644000176200001440000000426113615557421016477 0ustar liggesusersX pT޽ym&$E4ewHpy@B64RpIbvFik8iҡ #-NgjZ ZHZQ!=߹rY;8ܙ/s5.󸖹l6ds$K6A]D6-ZWgWp](鎐P͐CmfRPǶɄRB.a 1J!L2TtBp!/֓y-2/ k.ȧc}#srȔ#?:LsB>>N~a^BaWݓ鰫EqqireĞRKfá pT`0mt=Fktnѭ1s{5xunm1zc*< 1x=ǰcz ^5x^^k2TT-I #";zV;Q2޾XҚ筰%c'i!o_,ىt^8L:%M/&/ɴf'(bpc'SJNDdLrX`C+Q&dbM{&Y;IxbL{-g7-Ĥ҈^zo_hCk#SiLa+qT WSv,`RpP?(JPlir+ 3 WB0UB%k</PM!\CC%%#\K#'FX@'4 MEfB a1%A&# Bpa9[on" + Ua5fBa rt Ocqu V2WB& D<0[+Z)N@NiHG%q\8!9.G: l,8%t V(3Ŧ'X)\pNB2֋1z:[#.}6nLG:.5إ*l] em ԩ<Ѿ /ũmqUwN=z6/ў/*_!}|IQxH1tNj&-Z8љ[|?͗"ʗaw4[iI˜uF>$Sk3մ~WߘαC4vZW)PawʗzGޢ P>Jܥ *Gz*wy}ȝ<{t3'ZӡmVZe Wi=O%zE}+Au~uy!we26grB}_uh@9nuyxr(2\ۣbYnfJPB|,uÈn> =2Wo+䄼ȇX9SF\DQQN8|ҹ݃5X `jr,>V^q?O}Y4ci\?yGvg܏"H OT7,>'8g]?ͨxS_~6 F`g.׫s;?_F a?Ρ2{4/X? qN7pnq'ar/80֟v~ _7_ćx|;5_3@x[m#M{0_7k pG9 YwN=?m1c=r}ǣ?>}k=ٜ{qiz+_?r6G2}w]z-}ٷÿxh7s|b^v-MG >b[p骏>@ǧpT6ۼgt9k|i-׳cs>h:;)k* e|M{\Κk'Wrn֔d_c _Te^k+o;{= ~vd`d)ݞu沦[>{5-7ٸDX$b:ftޑla͎ܫu.gˊ>]g) S?ӝ]} GͣuH4vۗ_4{zz+tC 2U~UUWw\H?ݡ>[y'(Uk_f"i& BradleyTerry2/data/sound.fields.rda0000644000176200001440000000151013615557421016750 0ustar liggesusersXQn@u7 h?8⣿&qcm9w*=B?]{u@A4fvfgw޼G|xs9$J:Q)Yz,f(Yv%UI/Kq;ecaC!V 8 }l"n⢙o~m__mG 3Ak(`rȒsieCύ?^UYܪ0 u5j͇zy̦aσG;Uq`M b{'H6`x`? K8\b/s;u{qUP) :F:u*68WP_'g>y#ҟNOJ1"!N ^U^n S-Ak iy -M387xh\=i}kLǰ>;Yi{}?zh:1ę:Ypauvy@~~m vmN,pYpz5莥{zjxG ,<8c?@;l}x٩#|w𾓟םG>9q!;ZoΪȄqey׽8J~M}5JU1wsG[ڥ֜(_(dfU.`LEIoWa[A̖=Z3j=*⻾ȝlcӖ2h:0 j7O|dyB-lPheh^Z.^bXرn.:?ٕ['<,?JU]fL[Q&t5XGYdEE/jBradleyTerry2/data/flatlizards.rda0000744000176200001440000002067613152515665016711 0ustar liggesusers{wTIs@@DIb@S슂a ( (M19ŀšA*# ( "I$D~]5 ۺws9=5Uw[{3u @V "WNr+/+GF Ж <}܂}C݃$Srҫ..1Dt$b#kF0V"$b$CX2jCt $I"=$W"]U S+T߾Ł[>ց9(%%lZmmCҚJk~E<Ze5?P@Ye @Y;u0quLTRa*f%VF< H a**S b"s*TK׿SI@EKŶQ "*L5b|TTP*aR}!]S{՘dF<uS1jpPahYza@oأxoZ5X`9Y>ԩ- CzR)jǏYm4sr˛ufJ7߃ zsVw1ֺcqoTcJna __(@ zDϠbQja|wXcwn@h&sVnJ1 B37]ey鉗lǞ^,$`vjOxF(<& OA>nm^ MJ>ZΙuZMJۉM @4@ާ~0Tzq!!4}cD}dٰKZA,嵻^'yP6nmַ%d};_b|A%*NFʥe`nhx4k9t<9$^֞c_Xe2l}bԀkUC+&/ Cgz2l5]`=5=*ۺ(& 5ƲD~ͳ@.}f xhj64m`0Y?v G3:e\9 ׾Wi{T}C+3@?dHEI[MwJ&vى*J_lV¶z7/c3M>}%)/Vb2;Cѓ|Q[mS|3ǝRzʕrKUx1)l|cԔ>Zn<±"vfNU:- +UVVw_ qzSl>mwq Szop060Tu0ۯ 4xagOD֖eu,O`~w8-\5=3@\P͈S{P_C &LGmKb6^q 5vy1_l9)nӋ 㳴CH׫Cֆ_S 3 ,BNbɗ{e,%a@i͛%\# *Y5^N5T͏0d *~y rKs/^UIQn$#k.Wጪz3ȉE5Vu[|3 Lz9{&z TlQ 1Wڸ_"qWðfľL(׫lu__Q~.8sȷ@U+'&zm=X ُ>޶_az o['1up*&,CE_~ x+XXV.gzzM%o .ls㷲x1Adɘ~ gq`͗(6vԙ'Η^`מ4M=wQ8V;_ܐZ%ߚ&c$KR_Y-"oxp4 x]36YC#,+X([]<M>+48AXE|bz-XQ{"g?{-g_V Uk]23t3(fvMt2ϰdwW@MC0io̲O[6I-{dF; ֯9t/%9~ʺk-eݮI. j&džV:~+YI`:eX;\0'M9XgsYS2^d?ªn7j0j}vB!oY󖢖o9nP'\S5?(?^H/X5Hms6^P uiaE Ɨ]sb2{z$PG4ugetjԾNɒ̛x£`%ܩ؄藗8AbVc6H,_ Q͞W-c\ mHuHhՇ}aag6v!Elm$H^*w( z'2T;$|N3% 9Va;ШM ,c: 3^ͪHe8A#9r:kna׃׬[C%dK[8=Ь+S_+s`yl칆OTOsL}=dH;†w("=/ oyj_;$/Q)79oX-?i؈ĝdXO؅}CṈ A}IT$:6?L I:n_K˜Hj#W,Kx ES~_H@E=Ԧ~Ы"9 :T`R_XR>-Q%ƳSQ7u~VȦy?Ah:qEX8(V~zC-wM|?=oPFPI8~Dϳ&PO+;l='-^a!'@w&>f0B=634wuAC_*cq4M_lk ֡uY'ބiޫ^18i"S]?nGZձ$ kczlꔒ>Ao[P8Z񇚄w%«ŤBYt*[K&",砂~ vRM`m2zu@PGтMI+S. y!]eqW7Ii=@ zUȾ1=&IM}؈>7 L@!.?-ZIc9hPM.9JyNڧ[Y hA?8Fb V?3M؝1?} H /Bs P#T|L @>mLҷj tm5hӵrKoBU,oroh~@5U򭕥Ѩ:$_W o@]+6O?MdLI(R|(Crh@h֝AI< s3hvԱ}5_eHfROzE *"(5{| *(,d%yWBr1:mZ߀,.$0J؍J󚉐|SA99Eʹ%˯a7Qj?} 69/V'Z|J |~lx2]V'~:ili@RE]'D׿< M|_\Zʮ2I L̒l?}>6wapy. Lyw/Vr~9+&W:}# \OېYG|AߕtR9^C"X13Ȁc*54 _&$MDbUP8#9O7H#~˵(9?othR!{>` /lv3HpxG}nK ^w? JqW$}?vpYMl?J>Fg \W%ww!=*F>0*?) D_h+H(~xyl3ȗkD9'HT5ѻGgsjֹ4AIιg u{1T}657O~,~/:7ONHܕ2T,^u+VęW=Rx~=$qqn sgG3\\sHKۼN+ ([Jv'UgH8i:>[2XߜDc~k&M +ƭ $ (E4ON?n[şOPVRf;\yh޸ayQAy)G@nf\P(=;.bJgty%@DxyPZ[4Dׂ) vK6_wI5zrŻ8f oٝ: =5˙ɡ}q~4^sn/^_vg [R{dM3=@Nܵط) lktq3dJI?t-Ԏ|l0 (ݼraˢj@V3Arv[Z?DúħkV7-iChn^0#]w=me_*`SWw#-uY7ߵ! m(|28C8?24&ob9*e~ } uPccv'r&Gw71r@Jc>色`OS!,|uy0:z%t8PS4닦|3BUWF^7EmǽA5S Ji$GW3kp%dЁz٭F;ՠTݔg7CwϽJR&i4Ag֢|}r)K (s`PzV!H[$&$] :mtz9+^(ʮM*nٻ$hiP(t|opϖa @bڷ4M{]G%3m IOY|x h<Pڃw2>VeE$ eԜ+&ҜE=ÐW%|ugQ r_@QKQo ?T[K ^-55+4A]v9 G>8=&a%ţFGOYI AC9egG%#y O+O8q˃ʖu=+A~IBy*E7=#A9m3R t$nOn= ޯ 6:a>x2 ciUU 5iYt+"eAz13@LFF6@o܇n;p擒n1:63ȯ{7{9m|u:ǧO| =Wr+/Nl^e̳ J,9ٖύj9c~vlG9 *vzvpqS_+Tm9x{P-}[s3nQ՚&wS?j.cz{|Z(/PX9xhUP6̦ @@a# [Y9 / Wp]zznFI__*V>?g֢)7k[Ğ@Br,ƀ"f=5tTչxmz9ވ>~y?y4 dH1]ҧvYF'Oy7Qj*7LrN#b& 8*Fgߔn<+t‰iP6g=qʗUTZo=ddo{T?r>PEM_u%VP֧mO%XJ óʶQکWɫPIPpoI7n#^1{X( cA~~:tU{@RZ¤hfgWU:+$/u--Pָ( d;o.D vjԬdV#]oԏ rŜR\P[gْ9ĩfܐA3lq >d-TTbƃqg!_r6WqjWrz6"g. 2$l `dUL+wa7.]?Qbv=2<]2:ˬawrGo0?FdfKgҟQ{Jt2F?P Xa]1q?YȣBn? ]JC<=$>9Lj^n}<|{IuC+ݹ2{Ա* |ݽ|8~%^HO?''?wf>H?ݛ)jAd .jvFBradleyTerry2/man/0000755000176200001440000000000013463535404013526 5ustar liggesusersBradleyTerry2/man/citations.Rd0000744000176200001440000000327613615002170016007 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/citations.R \docType{data} \name{citations} \alias{citations} \title{Statistics Journal Citation Data from Stigler (1994)} \format{A 4 by 4 contingency table of citations, cross-classified by the factors \code{cited} and \code{citing} each with levels \code{Biometrika}, \verb{Comm Statist}, \code{JASA}, and \code{JRSS-B}.} \source{ Agresti, A. (2002) \emph{Categorical Data Analysis} (2nd ed). New York: Wiley. } \usage{ citations } \description{ Extracted from a larger table in Stigler (1994). Inter-journal citation counts for four journals, \dQuote{Biometrika}, \dQuote{Comm Statist.}, \dQuote{JASA} and \dQuote{JRSS-B}, as used on p448 of Agresti (2002). } \details{ In the context of paired comparisons, the \sQuote{winner} is the cited journal and the \sQuote{loser} is the one doing the citing. } \examples{ ## Data as a square table, as in Agresti p448 citations ## ## Convert frequencies to success/failure data: ## citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") ## Standard Bradley-Terry model fitted to these data citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) } \references{ Firth, D. (2005) Bradley-Terry models in R. \emph{Journal of Statistical Software} \strong{12}(1), 1--12. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. Stigler, S. (1994) Citation patterns in the journals of statistics and probability. \emph{Statistical Science} \strong{9}, 94--108. } \seealso{ \code{\link[=BTm]{BTm()}} } \keyword{datasets} BradleyTerry2/man/flatlizards.Rd0000744000176200001440000001504013615337047016337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flatlizards.R \docType{data} \name{flatlizards} \alias{flatlizards} \title{Augrabies Male Flat Lizards: Contest Results and Predictor Variables} \format{This dataset is a list containing two data frames: \code{flatlizards$contests} and \code{flatlizards$predictors}. The \code{flatlizards$contests} data frame has 100 observations on the following 2 variables: \describe{ \item{winner}{a factor with 77 levels \code{lizard003} ... \code{lizard189}.} \item{loser}{a factor with the same 77 levels \code{lizard003} ... \code{lizard189}.} } The \code{flatlizards$predictors} data frame has 77 observations (one for each of the 77 lizards) on the following 18 variables: \describe{ \item{id}{factor with 77 levels (3 5 6 ... 189), the lizard identifiers.} \item{throat.PC1}{numeric, the first principal component of the throat spectrum.} \item{throat.PC2}{numeric, the second principal component of the throat spectrum.} \item{throat.PC3}{numeric, the third principal component of the throat spectrum.} \item{frontleg.PC1}{numeric, the first principal component of the front-leg spectrum.} \item{frontleg.PC2}{numeric, the second principal component of the front-leg spectrum.} \item{frontleg.PC3}{numeric, the third principal component of the front-leg spectrum.} \item{badge.PC1}{numeric, the first principal component of the ventral colour patch spectrum.} \item{badge.PC2}{numeric, the second principal component of the ventral colour patch spectrum.} \item{badge.PC3}{numeric, the third principal component of the ventral colour patch spectrum.} \item{badge.size}{numeric, a measure of the area of the ventral colour patch.} \item{testosterone}{numeric, a measure of blood testosterone concentration.} \item{SVL}{numeric, the snout-vent length of the lizard.} \item{head.length}{numeric, head length.} \item{head.width}{numeric, head width.} \item{head.height}{numeric, head height.} \item{condition}{numeric, a measure of body condition.} \item{repro.tactic}{a factor indicating reproductive tactic; levels are \code{resident} and \code{floater}.} }} \source{ The data were collected by Dr Martin Whiting, \url{http://whitinglab.com/people/martin-whiting/}, and they appear here with his kind permission. } \usage{ flatlizards } \description{ Data collected at Augrabies Falls National Park (South Africa) in September-October 2002, on the contest performance and background attributes of 77 male flat lizards (\emph{Platysaurus broadleyi}). The results of exactly 100 contests were recorded, along with various measurements made on each lizard. Full details of the study are in Whiting et al. (2006). } \details{ There were no duplicate contests (no pair of lizards was seen fighting more than once), and there were no tied contests (the result of each contest was clear). The variables \code{head.length}, \code{head.width}, \code{head.height} and \code{condition} were all computed as residuals (of directly measured head length, head width, head height and body mass index, respectively) from simple least-squares regressions on \code{SVL}. Values of some predictors are missing (\code{NA}) for some lizards, \sQuote{at random}, because of instrument problems unconnected with the value of the measurement being made. } \examples{ ## ## Fit the standard Bradley-Terry model, using the bias-reduced ## maximum likelihood method: ## result <- rep(1, nrow(flatlizards$contests)) BTmodel <- BTm(result, winner, loser, br = TRUE, data = flatlizards$contests) summary(BTmodel) ## ## That's fairly useless, though, because of the rather small ## amount of data on each lizard. And really the scientific ## interest is not in the abilities of these particular 77 ## lizards, but in the relationship between ability and the ## measured predictor variables. ## ## So next fit (by maximum likelihood) a "structured" B-T model in ## which abilities are determined by a linear predictor. ## ## This reproduces results reported in Table 1 of Whiting et al. (2006): ## Whiting.model <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..], data = flatlizards) summary(Whiting.model) ## ## Equivalently, fit the same model using glmmPQL: ## Whiting.model <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), sigma = 0, sigma.fixed = TRUE, data = flatlizards) summary(Whiting.model) ## ## But that analysis assumes that the linear predictor formula for ## abilities is _perfect_, i.e., that there is no error in the linear ## predictor. This will always be unrealistic. ## ## So now fit the same predictor but with a normally distributed error ## term --- a generalized linear mixed model --- by using the BTm ## function instead of glm. ## Whiting.model2 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards, trace = TRUE) summary(Whiting.model2) ## ## The estimated coefficients (of throat.PC1, throat.PC3, ## head.length and SVL are not changed substantially by ## the recognition of an error term in the model; but the estimated ## standard errors are larger, as expected. The main conclusions from ## Whiting et al. (2006) are unaffected. ## ## With the normally distributed random error included, it is perhaps ## at least as natural to use probit rather than logit as the link ## function: ## require(stats) Whiting.model3 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards, trace = TRUE) summary(Whiting.model3) BTabilities(Whiting.model3) ## Note the "separate" attribute here, identifying two lizards with ## missing values of at least one predictor variable ## ## Modulo the usual scale change between logit and probit, the results ## are (as expected) very similar to Whiting.model2. } \references{ Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. Whiting, M. J., Stuart-Fox, D. M., O'Connor, D., Firth, D., Bennett, N. C. and Blomberg, S. P. (2006). Ultraviolet signals ultra-aggression in a lizard. \emph{Animal Behaviour} \strong{72}, 353--363. } \seealso{ \code{\link[=BTm]{BTm()}} } \keyword{datasets} BradleyTerry2/man/qvcalc.BTabilities.Rd0000744000176200001440000000652713436770253017476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/qvcalc.BTabilities.R \name{qvcalc.BTabilities} \alias{qvcalc.BTabilities} \title{Quasi Variances for Estimated Abilities} \usage{ \method{qvcalc}{BTabilities}(object, ...) } \arguments{ \item{object}{a \code{"BTabilities"} object as returned by \code{\link[=BTabilities]{BTabilities()}}.} \item{...}{additional arguments, currently ignored.} } \value{ A list of class \code{"qv"}, with components \item{covmat}{The full variance-covariance matrix for the estimated abilities.} \item{qvframe}{A data frame with variables \code{estimate}, \code{SE}, \code{quasiSE} and \code{quasiVar}, the last two being a quasi standard error and quasi-variance for each ability.} \item{dispersion}{\code{NULL} (dispersion is fixed to 1).} \item{relerrs}{Relative errors for approximating the standard errors of all simple contrasts.} \item{factorname}{The name of the ID factor identifying players in the \code{BTm} formula.} \item{coef.indices}{\code{NULL} (no required for this method).} \item{modelcall}{The call to \code{BTm} to fit the Bradley-Terry model from which the abilities were estimated.} } \description{ A method for \code{\link[qvcalc:qvcalc]{qvcalc::qvcalc()}} to compute a set of quasi variances (and corresponding quasi standard errors) for estimated abilities from a Bradley-Terry model as returned by \code{\link[=BTabilities]{BTabilities()}}. } \details{ For details of the method see Firth (2000), Firth (2003) or Firth and de Menezes (2004). Quasi variances generalize and improve the accuracy of \dQuote{floating absolute risk} (Easton et al., 1991). This device for economical model summary was first suggested by Ridout (1989). Ordinarily the quasi variances are positive and so their square roots (the quasi standard errors) exist and can be used in plots, etc. } \examples{ example(baseball) baseball.qv <- qvcalc(BTabilities(baseballModel2)) print(baseball.qv) plot(baseball.qv, xlab = "team", levelNames = c("Bal", "Bos", "Cle", "Det", "Mil", "NY", "Tor")) } \references{ Easton, D. F, Peto, J. and Babiker, A. G. A. G. (1991) Floating absolute risk: an alternative to relative risk in survival and case-control analysis avoiding an arbitrary reference group. \emph{Statistics in Medicine} \strong{10}, 1025--1035. Firth, D. (2000) Quasi-variances in Xlisp-Stat and on the web. \emph{Journal of Statistical Software} \strong{5.4}, 1--13. \url{https://www.jstatsoft.org/article/view/v005i04}. Firth, D. (2003) Overcoming the reference category problem in the presentation of statistical models. \emph{Sociological Methodology} \strong{33}, 1--18. Firth, D. and de Menezes, R. X. (2004) Quasi-variances. \emph{Biometrika} \strong{91}, 65--80. Menezes, R. X. de (1999) More useful standard errors for group and factor effects in generalized linear models. \emph{D.Phil. Thesis}, Department of Statistics, University of Oxford. Ridout, M.S. (1989). Summarizing the results of fitting generalized linear models to data from designed experiments. In: \emph{Statistical Modelling: Proceedings of GLIM89 and the 4th International Workshop on Statistical Modelling held in Trento, Italy, July 17--21, 1989} (A. Decarli et al., eds.), pp 262--269. New York: Springer. } \seealso{ \code{\link[qvcalc:worstErrors]{qvcalc::worstErrors()}}, \code{\link[qvcalc:plot.qv]{qvcalc::plot.qv()}}. } \author{ David Firth } BradleyTerry2/man/BTm.Rd0000744000176200001440000002345213615002170014472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/BTm.R \name{BTm} \alias{BTm} \title{Bradley-Terry Model and Extensions} \usage{ BTm( outcome = 1, player1, player2, formula = NULL, id = "..", separate.ability = NULL, refcat = NULL, family = "binomial", data = NULL, weights = NULL, subset = NULL, na.action = NULL, start = NULL, etastart = NULL, mustart = NULL, offset = NULL, br = FALSE, model = TRUE, x = FALSE, contrasts = NULL, ... ) } \arguments{ \item{outcome}{the binomial response: either a numeric vector, a factor in which the first level denotes failure and all others success, or a two-column matrix with the columns giving the numbers of successes and failures.} \item{player1}{either an ID factor specifying the first player in each contest, or a data.frame containing such a factor and possibly other contest-level variables that are specific to the first player. If given in a data.frame, the ID factor must have the name given in the \code{id} argument. If a factor is specified it will be used to create such a data.frame.} \item{player2}{an object corresponding to that given in \code{player1} for the second player in each contest, with identical structure -- in particular factors must have identical levels.} \item{formula}{a formula with no left-hand-side, specifying the model for player ability. See details for more information.} \item{id}{the name of the ID factor.} \item{separate.ability}{(if \code{formula} does not include the ID factor as a separate term) a character vector giving the names of players whose abilities are to be modelled individually rather than using the specification given by \code{formula}.} \item{refcat}{(if \code{formula} includes the ID factor as a separate term) a character specifying which player to use as a reference, with the first level of the ID factor as the default. Overrides any other contrast specification for the ID factor.} \item{family}{a description of the error distribution and link function to be used in the model. Only the binomial family is implemented, with either\code{"logit"}, \code{"probit"} , or \code{"cauchit"} link. (See \code{\link[stats:family]{stats::family()}} for details of family functions.)} \item{data}{an optional object providing data required by the model. This may be a single data frame of contest-level data or a list of data frames. Names of data frames are ignored unless they refer to data frames specified by \code{player1} and \code{player2}. The rows of data frames that do not contain contest-level data must correspond to the levels of a factor used for indexing, i.e. row 1 corresponds to level 1, etc. Note any rownames are ignored. Objects are searched for first in the \code{data} object if provided, then in the environment of \code{formula}. If \code{data} is a list, the data frames are searched in the order given.} \item{weights}{an optional numeric vector of \sQuote{prior weights}.} \item{subset}{an optional logical or numeric vector specifying a subset of observations to be used in the fitting process.} \item{na.action}{a function which indicates what should happen when any contest-level variables contain \code{NA}s. The default is the \code{na.action} setting of \code{options}. See details for the handling of missing values in other variables.} \item{start}{a vector of starting values for the fixed effects.} \item{etastart}{a vector of starting values for the linear predictor.} \item{mustart}{a vector of starting values for the vector of means.} \item{offset}{an optional offset term in the model. A vector of length equal to the number of contests.} \item{br}{logical. If \code{TRUE} fitting will be by penalized maximum likelihood as in Firth (1992, 1993), using \code{\link[brglm:brglm]{brglm::brglm()}}, rather than maximum likelihood using \code{\link[=glm]{glm()}}, when abilities are modelled exactly or when the abilities are modelled by covariates and the variance of the random effects is estimated as zero.} \item{model}{logical: whether or not to return the model frame.} \item{x}{logical: whether or not to return the design matrix for the fixed effects.} \item{contrasts}{an optional list specifying contrasts for the factors in \code{formula}. See the \code{contrasts.arg} of \code{\link[=model.matrix]{model.matrix()}}.} \item{\dots}{other arguments for fitting function (currently either \code{\link[=glm]{glm()}}, \code{\link[brglm:brglm]{brglm::brglm()}}, or \code{\link[=glmmPQL]{glmmPQL()}})} } \value{ An object of class \code{c("BTm", "x")}, where \code{"x"} is the class of object returned by the model fitting function (e.g. \code{glm}). Components are as for objects of class \code{"x"}, with additionally \item{id}{the \code{id} argument.} \item{separate.ability}{the \code{separate.ability} argument.} \item{refcat}{the \code{refcat} argument.} \item{player1}{a data frame for the first player containing the ID factor and any player-specific contest-level variables.} \item{player2}{a data frame corresponding to that for \code{player1}.} \item{assign}{a numeric vector indicating which coefficients correspond to which terms in the model.} \item{term.labels}{labels for the model terms.} \item{random}{for models with random effects, the design matrix for the random effects. } } \description{ Fits Bradley-Terry models for pair comparison data, including models with structured scores, order effect and missing covariate data. Fits by either maximum likelihood or maximum penalized likelihood (with Jeffreys-prior penalty) when abilities are modelled exactly, or by penalized quasi-likelihood when abilities are modelled by covariates. } \details{ In each comparison to be modelled there is a 'first player' and a 'second player' and it is assumed that one player wins while the other loses (no allowance is made for tied comparisons). The \code{\link[=countsToBinomial]{countsToBinomial()}} function is provided to convert a contingency table of wins into a data frame of wins and losses for each pair of players. The \code{formula} argument specifies the model for player ability and applies to both the first player and the second player in each contest. If \code{NULL} a separate ability is estimated for each player, equivalent to setting \code{formula = reformulate(id)}. Contest-level variables can be specified in the formula in the usual manner, see \code{\link[=formula]{formula()}}. Player covariates should be included as variables indexed by \code{id}, see examples. Thus player covariates must be ordered according to the levels of the ID factor. If \code{formula} includes player covariates and there are players with missing values over these covariates, then a separate ability will be estimated for those players. When player abilities are modelled by covariates, then random player effects should be added to the model. These should be specified in the formula using the vertical bar notation of \code{\link[lme4:lmer]{lme4::lmer()}}, see examples. When specified, it is assumed that random player effects arise from a \eqn{N(0, }{N(0, sigma^2)}\eqn{ \sigma^2)}{N(0, sigma^2)} distribution and model parameters, including \eqn{\sigma}{sigma}, are estimated using PQL (Breslow and Clayton, 1993) as implemented in the \code{\link[=glmmPQL]{glmmPQL()}} function. } \examples{ ######################################################## ## Statistics journal citation data from Stigler (1994) ## -- see also Agresti (2002, p448) ######################################################## ## Convert frequencies to success/failure data citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") ## First fit the "standard" Bradley-Terry model citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) ## Now the same thing with a different "reference" journal citeModel2 <- update(citeModel, refcat = "JASA") BTabilities(citeModel2) ################################################################## ## Now an example with an order effect -- see Agresti (2002) p438 ################################################################## data(baseball) # start with baseball data as provided by package ## Simple Bradley-Terry model, ignoring home advantage: baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") ## Now incorporate the "home advantage" effect baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) ## Compare the fit of these two models: anova(baseballModel1, baseballModel2) ## ## For a more elaborate example with both player-level and contest-level ## predictor variables, see help(chameleons). ## } \references{ Agresti, A. (2002) \emph{Categorical Data Analysis} (2nd ed). New York: Wiley. Firth, D. (1992) Bias reduction, the Jeffreys prior and GLIM. In \emph{Advances in GLIM and Statistical Modelling}, Eds. Fahrmeir, L., Francis, B. J., Gilchrist, R. and Tutz, G., pp91--100. New York: Springer. Firth, D. (1993) Bias reduction of maximum likelihood estimates. \emph{Biometrika} \strong{80}, 27--38. Firth, D. (2005) Bradley-Terry models in R. \emph{Journal of Statistical Software}, \strong{12}(1), 1--12. Stigler, S. (1994) Citation patterns in the journals of statistics and probability. \emph{Statistical Science} \strong{9}, 94--108. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. } \seealso{ \code{\link[=countsToBinomial]{countsToBinomial()}}, \code{\link[=glmmPQL]{glmmPQL()}}, \code{\link[=BTabilities]{BTabilities()}}, \code{\link[=residuals.BTm]{residuals.BTm()}}, \code{\link[=add1.BTm]{add1.BTm()}}, \code{\link[=anova.BTm]{anova.BTm()}} } \author{ Heather Turner, David Firth } \keyword{models} BradleyTerry2/man/residuals.BTm.Rd0000744000176200001440000000515613615002170016465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/residuals.BTm.R \name{residuals.BTm} \alias{residuals.BTm} \title{Residuals from a Bradley-Terry Model} \usage{ \method{residuals}{BTm}( object, type = c("deviance", "pearson", "working", "response", "partial", "grouped"), by = object$id, ... ) } \arguments{ \item{object}{a model object for which \code{inherits(model, "BTm")} is \code{TRUE}.} \item{type}{the type of residuals which should be returned. The alternatives are: \code{"deviance"} (default), \code{"pearson"}, \code{"working"}, \code{"response"}, and \code{"partial"}.} \item{by}{the grouping factor to use when \code{type = "grouped"}.} \item{...}{arguments to pass on other methods.} } \value{ A numeric vector of length equal to the number of players, with a \code{"weights"} attribute. } \description{ Computes residuals from a model object of class \code{"BTm"}. In additional to the usual options for objects inheriting from class \code{"glm"}, a \code{"grouped"} option is implemented to compute player-specific residuals suitable for diagnostic checking of a predictor involving player-level covariates. } \details{ For \code{type} other than \code{"grouped"} see \code{\link[=residuals.glm]{residuals.glm()}}. For \code{type = "grouped"} the residuals returned are weighted means of working residuals, with weights equal to the binomial denominators in the fitted model. These are suitable for diagnostic model checking, for example plotting against candidate predictors. } \examples{ ## ## See ?springall ## springall.model <- BTm(cbind(win.adj, loss.adj), col, row, ~ flav[..] + gel[..] + flav.2[..] + gel.2[..] + flav.gel[..] + (1 | ..), data = springall) res <- residuals(springall.model, type = "grouped") with(springall$predictors, plot(flav, res)) with(springall$predictors, plot(gel, res)) ## Weighted least-squares regression of these residuals on any variable ## already included in the model yields slope coefficient zero: lm(res ~ flav, weights = attr(res, "weights"), data = springall$predictors) lm(res ~ gel, weights = attr(res, "weights"), data = springall$predictors) } \references{ Firth, D. (2005) Bradley-Terry models in R. \emph{Journal of Statistical Software} \strong{12}(1), 1--12. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. } \seealso{ \code{\link[=BTm]{BTm()}}, \code{\link[=BTabilities]{BTabilities()}} } \author{ David Firth and Heather Turner } \keyword{models} BradleyTerry2/man/icehockey.Rd0000744000176200001440000001066013615002170015750 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/icehockey.R \docType{data} \name{icehockey} \alias{icehockey} \title{College Hockey Men's Division I 2009-10 results} \format{A data frame with 1083 observations on the following 6 variables. \describe{ \item{date}{a numeric vector} \item{visitor}{a factor with 58 levels \verb{Alaska Anchorage} ... \code{Yale}} \item{v_goals}{a numeric vector} \item{opponent}{a factor with 58 levels \verb{Alaska Anchorage} ... \code{Yale}} \item{o_goals}{a numeric vector} \item{conference}{a factor with levels \code{AH}, \code{CC}, \code{CH}, \code{EC}, \code{HE}, \code{NC}, \code{WC}} \item{result}{a numeric vector: 1 if visitor won, 0.5 for a draw and 0 if visitor lost} \item{home.ice}{a logical vector: 1 if opponent on home ice, 0 if game on neutral ground} }} \source{ \url{http://www.collegehockeystats.net/0910/schedules/men}. } \usage{ icehockey } \description{ Game results from American College Hockey Men's Division I composite schedule 2009-2010. } \details{ The Division I ice hockey teams are arranged in six conferences: Atlantic Hockey, Central Collegiate Hockey Association, College Hockey America, ECAC Hockey, Hockey East and the Western Collegiate Hockey Association, all part of the National Collegiate Athletic Association. The composite schedule includes within conference games and between conference games. The data set here contains only games from the regular season, the results of which determine the teams that play in the NCAA national tournament. There are six automatic bids that go to the conference tournament champions, the remaining 10 teams are selected based upon ranking under the NCAA's system of pairwise comparisons (\url{https://www.collegehockeynews.com/info/?d=pwcrpi}). Some have argued that Bradley-Terry rankings would be fairer (\url{https://www.collegehockeynews.com/info/?d=krach}). } \examples{ ### Fit the standard Bradley-Terry model standardBT <- BTm(outcome = result, player1 = visitor, player2 = opponent, id = "team", data = icehockey) ## Bradley-Terry abilities abilities <- exp(BTabilities(standardBT)[,1]) ## Compute round-robin winning probability and KRACH ratings ## (scaled abilities such that KRACH = 100 for a team with ## round-robin winning probability of 0.5) rankings <- function(abilities){ probwin <- abilities/outer(abilities, abilities, "+") diag(probwin) <- 0 nteams <- ncol(probwin) RRWP <- rowSums(probwin)/(nteams - 1) low <- quantile(abilities, 0.45) high <- quantile(abilities, 0.55) middling <- uniroot(function(x) {sum(x/(x+abilities)) - 0.5*nteams}, lower = low, upper = high)$root KRACH <- abilities/middling*100 cbind(KRACH, RRWP) } ranks <- rankings(abilities) ## matches those produced by Joe Schlobotnik's Build Your Own Rankings head(signif(ranks, 4)[order(ranks[,1], decreasing = TRUE),]) ## At one point the NCAA rankings gave more credit for wins on ## neutral/opponent's ground. Home ice effects are easily ## incorporated into the Bradley-Terry model, comparing teams ## on a "level playing field" levelBT <- BTm(result, data.frame(team = visitor, home.ice = 0), data.frame(team = opponent, home.ice = home.ice), ~ team + home.ice, id = "team", data = icehockey) abilities <- exp(BTabilities(levelBT)[,1]) ranks2 <- rankings(abilities) ## Look at movement between the two rankings change <- factor(rank(ranks2[,1]) - rank(ranks[,1])) barplot(xtabs(~change), xlab = "Change in Rank", ylab = "No. Teams") ## Take out regional winners and look at top 10 regional <- c("RIT", "Alabama-Huntsville", "Michigan", "Cornell", "Boston College", "North Dakota") ranks <- ranks[!rownames(ranks) \%in\% regional] ranks2 <- ranks2[!rownames(ranks2) \%in\% regional] ## compare the 10 at-large selections under both rankings ## with those selected under NCAA rankings cbind(names(sort(ranks, decr = TRUE)[1:10]), names(sort(ranks2, decr = TRUE)[1:10]), c("Miami", "Denver", "Wisconsin", "St. Cloud State", "Bemidji State", "Yale", "Northern Michigan", "New Hampshire", "Alsaka", "Vermont")) } \references{ Schlobotnik, J. Build your own rankings: \url{http://www.elynah.com/tbrw/2010/rankings.diy.shtml}. College Hockey News \url{https://www.collegehockeynews.com/}. Selections for 2010 NCAA tournament: \url{https://www.espn.com/college-sports/news/story?id=5012918}. } \keyword{datasets} BradleyTerry2/man/glmmPQL.control.Rd0000744000176200001440000000441313615002170016774 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glmmPQL.control.R \name{glmmPQL.control} \alias{glmmPQL.control} \title{Control Aspects of the glmmPQL Algorithm} \usage{ glmmPQL.control(maxiter = 50, IWLSiter = 10, tol = 1e-06, trace = FALSE) } \arguments{ \item{maxiter}{the maximum number of outer iterations.} \item{IWLSiter}{the maximum number of iterated weighted least squares iterations used to estimate the fixed effects, given the standard deviation of the random effects.} \item{tol}{the tolerance used to determine convergence in the IWLS iterations and over all (see details).} \item{trace}{logical: whether or not to print the score for the random effects variance at the end of each iteration.} } \value{ A list with the arguments as components. } \description{ Set control variables for the glmmPQL algorithm. } \details{ This function provides an interface to control the PQL algorithm used by \code{\link[=BTm]{BTm()}} for fitting Bradley Terry models with random effects. The algorithm iterates between a series of iterated weighted least squares iterations to update the fixed effects and a single Fisher scoring iteration to update the standard deviation of the random effects. Convergence of both the inner and outer iterations are judged by comparing the squared components of the relevant score vector with corresponding elements of the diagonal of the Fisher information matrix. If, for all components of the relevant score vector, the ratio is less than \code{tolerance^2}, or the corresponding diagonal element of the Fisher information matrix is less than 1e-20, iterations cease. } \examples{ ## Variation on example(flatlizards) result <- rep(1, nrow(flatlizards$contests)) ## BTm passes arguments on to glmmPQL.control() args(BTm) BTmodel <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards, tol = 1e-3, trace = TRUE) summary(BTmodel) } \references{ Breslow, N. E. and Clayton, D. G. (1993), Approximate inference in Generalized Linear Mixed Models. \emph{Journal of the American Statistical Association} \strong{88}(421), 9--25. } \seealso{ \code{\link[=glmmPQL]{glmmPQL()}}, \code{\link[=BTm]{BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/GenDavidson.Rd0000744000176200001440000002137513615002170016213 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/GenDavidson.R \name{GenDavidson} \alias{GenDavidson} \title{Specify a Generalised Davidson Term in a gnm Model Formula} \usage{ GenDavidson( win, tie, loss, player1, player2, home.adv = NULL, tie.max = ~1, tie.mode = NULL, tie.scale = NULL, at.home1 = NULL, at.home2 = NULL ) } \arguments{ \item{win}{a logical vector: \code{TRUE} if player1 wins, \code{FALSE} otherwise.} \item{tie}{a logical vector: \code{TRUE} if the outcome is a tie, \code{FALSE} otherwise.} \item{loss}{a logical vector: \code{TRUE} if player1 loses, \code{FALSE} otherwise.} \item{player1}{an ID factor specifying the first player in each contest, with the same set of levels as \code{player2}.} \item{player2}{an ID factor specifying the second player in each contest, with the same set of levels as \code{player2}.} \item{home.adv}{a formula for the parameter corresponding to the home advantage effect. If \code{NULL}, no home advantage effect is estimated.} \item{tie.max}{a formula for the parameter corresponding to the maximum tie probability.} \item{tie.mode}{a formula for the parameter corresponding to the location of maximum tie probability, in terms of the probability that \code{player1} wins, given the outcome is not a draw.} \item{tie.scale}{a formula for the parameter corresponding to the scale of dependence of the tie probability on the probability that \code{player1} wins, given the outcome is not a draw.} \item{at.home1}{a logical vector: \code{TRUE} if \code{player1} is at home, \code{FALSE} otherwise.} \item{at.home2}{a logical vector: \code{TRUE} if \code{player2} is at home, \code{FALSE} otherwise.} } \value{ A list with the anticipated components of a "nonlin" function: \item{ predictors }{ the formulae for the different parameters and the ID factors for player 1 and player 2. } \item{ variables }{ the outcome variables and the \dQuote{at home} variables, if specified. } \item{ common }{ an index to specify that common effects are to be estimated for the players. } \item{ term }{ a function to create a deparsed mathematical expression of the term, given labels for the predictors.} \item{ start }{ a function to generate starting values for the parameters.} } \description{ GenDavidson is a function of class \code{"nonlin"} to specify a generalised Davidson term in the formula argument to \code{\link[gnm:gnm]{gnm::gnm()}}, providing a model for paired comparison data where ties are a possible outcome. } \details{ \code{GenDavidson} specifies a generalisation of the Davidson model (1970) for paired comparisons where a tie is a possible outcome. It is designed for modelling trinomial counts corresponding to the win/draw/loss outcome for each contest, which are assumed Poisson conditional on the total count for each match. Since this total must be one, the expected counts are equivalently the probabilities for each possible outcome, which are modelled on the log scale: \deqn{\log(p(i \textrm{beats} j)_k) = \theta_{ijk} + \log(\mu\alpha_i}{log(p(i beats j)_k) = theta_{ijk} + log(mu * alpha_i)} \deqn{\log(p(draw)_k) = \theta_{ijk} + \delta + c + }{ log(p(draw)_k) = theta_{ijk} + log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * log(alpha_j)) + (1 - sigma) * log(mu * alpha_i + alpha_j) }\deqn{ \sigma(\pi\log(\mu\alpha_i) - (1 - \pi)log(\alpha_j)) + }{ log(p(draw)_k) = theta_{ijk} + log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * log(alpha_j)) + (1 - sigma) * log(mu * alpha_i + alpha_j) }\deqn{ (1 - \sigma)(\log(\mu\alpha_i + \alpha_j))}{ log(p(draw)_k) = theta_{ijk} + log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * log(alpha_j)) + (1 - sigma) * log(mu * alpha_i + alpha_j) } \deqn{\log(p(j \textrm{beats} i)_k) = \theta_{ijk} + }{log(p(j beats i)_k) = theta_{ijk} + log(alpha_j)}\deqn{ log(\alpha_j)}{log(p(j beats i)_k) = theta_{ijk} + log(alpha_j)} Here \eqn{\theta_{ijk}}{theta_{ijk}} is a structural parameter to fix the trinomial totals; \eqn{\mu}{mu} is the home advantage parameter; \eqn{\alpha_i}{alpha_i} and \eqn{\alpha_j}{alpha_j} are the abilities of players \eqn{i} and \eqn{j} respectively; \eqn{c}{c} is a function of the parameters such that \eqn{\textrm{expit}(\delta)}{plogis(delta)} is the maximum probability of a tie, \eqn{\sigma}{sigma} scales the dependence of the probability of a tie on the relative abilities and \eqn{\pi}{pi} allows for asymmetry in this dependence. For parameters that must be positive (\eqn{\alpha_i, \sigma, \mu}{alpha, sigma, mu}), the log is estimated, while for parameters that must be between zero and one (\eqn{\delta, \pi}), the logit is estimated, as illustrated in the example. } \examples{ ### example requires gnm if (require(gnm)) { ### convert to trinomial counts football.tri <- expandCategorical(football, "result", idvar = "match") head(football.tri) ### add variable to indicate whether team playing at home football.tri$at.home <- !logical(nrow(football.tri)) ### fit shifted & scaled Davidson model ### - subset to first and last season for illustration shifScalDav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, tie.scale = ~1, tie.mode = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri, subset = season \%in\% c("2008-9", "2012-13")) ### look at coefs coef <- coef(shifScalDav) ## home advantage exp(coef["home.adv"]) ## max p(tie) plogis(coef["tie.max"]) ## mode p(tie) plogis(coef["tie.mode"]) ## scale relative to Davidson of dependence of p(tie) on p(win|not a draw) exp(coef["tie.scale"]) ### check model fit alpha <- names(coef[-(1:4)]) plotProportions(result == 1, result == 0, result == -1, home:season, away:season, abilities = coef[alpha], home.adv = coef["home.adv"], tie.max = coef["tie.max"], tie.scale = coef["tie.scale"], tie.mode = coef["tie.mode"], at.home1 = at.home, at.home2 = !at.home, data = football.tri, subset = count == 1) } ### analyse all five seasons ### - takes a little while to run, particularly likelihood ratio tests \dontrun{ ### fit Davidson model Dav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri) ### fit scaled Davidson model scalDav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, tie.scale = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri) ### fit shifted & scaled Davidson model shifScalDav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, tie.scale = ~1, tie.mode = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri) ### compare models anova(Dav, scalDav, shifScalDav, test = "Chisq") ### diagnostic plots main <- c("Davidson", "Scaled Davidson", "Shifted & Scaled Davidson") mod <- list(Dav, scalDav, shifScalDav) names(mod) <- main ## use football.tri data so that at.home can be found, ## but restrict to actual match results par(mfrow = c(2,2)) for (i in 1:3) { coef <- parameters(mod[[i]]) plotProportions(result == 1, result == 0, result == -1, home:season, away:season, abilities = coef[alpha], home.adv = coef["home.adv"], tie.max = coef["tie.max"], tie.scale = coef["tie.scale"], tie.mode = coef["tie.mode"], at.home1 = at.home, at.home2 = !at.home, main = main[i], data = football.tri, subset = count == 1) } } } \references{ Davidson, R. R. (1970). On extending the Bradley-Terry model to accommodate ties in paired comparison experiments. \emph{Journal of the American Statistical Association}, \strong{65}, 317--328. } \seealso{ \code{\link[=football]{football()}}, \code{\link[=plotProportions]{plotProportions()}} } \author{ Heather Turner } \keyword{models} \keyword{nonlinear} BradleyTerry2/man/plotProportions.Rd0000744000176200001440000002054613615002170017246 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plotProportions.R \name{plotProportions} \alias{plotProportions} \title{Plot Proportions of Tied Matches and Non-tied Matches Won} \usage{ plotProportions( win, tie = NULL, loss, player1, player2, abilities = NULL, home.adv = NULL, tie.max = NULL, tie.scale = NULL, tie.mode = NULL, at.home1 = NULL, at.home2 = NULL, data = NULL, subset = NULL, bin.size = 20, xlab = "P(player1 wins | not a tie)", ylab = "Proportion", legend = NULL, col = 1:2, ... ) } \arguments{ \item{win}{a logical vector: \code{TRUE} if player1 wins, \code{FALSE} otherwise.} \item{tie}{a logical vector: \code{TRUE} if the outcome is a tie, \code{FALSE} otherwise (\code{NULL} if there are no ties).} \item{loss}{a logical vector: \code{TRUE} if player1 loses, \code{FALSE} otherwise.} \item{player1}{an ID factor specifying the first player in each contest, with the same set of levels as \code{player2}.} \item{player2}{an ID factor specifying the second player in each contest, with the same set of levels as \code{player2}.} \item{abilities}{the fitted abilities from a generalized Davidson model (or a Bradley-Terry model).} \item{home.adv}{if applicable, the fitted home advantage parameter from a generalized Davidson model (or a Bradley-Terry model).} \item{tie.max}{the fitted parameter from a generalized Davidson model corresponding to the maximum tie probability.} \item{tie.scale}{if applicable, the fitted parameter from a generalized Davidson model corresponding to the scale of dependence of the tie probability on the probability that \code{player1} wins, given the outcome is not a draw.} \item{tie.mode}{if applicable, the fitted parameter from a generalized Davidson model corresponding to the location of maximum tie probability, in terms of the probability that \code{player1} wins, given the outcome is not a draw.} \item{at.home1}{a logical vector: \code{TRUE} if \code{player1} is at home, \code{FALSE} otherwise.} \item{at.home2}{a logical vector: \code{TRUE} if \code{player2} is at home, \code{FALSE} otherwise.} \item{data}{an optional data frame providing variables required by the model, with one observation per match.} \item{subset}{an optional logical or numeric vector specifying a subset of observations to include in the plot.} \item{bin.size}{the approximate number of matches in each bin.} \item{xlab}{the label to use for the x-axis.} \item{ylab}{the label to use for the y-axis.} \item{legend}{text to use for the legend.} \item{col}{a vector specifying colours to use for the proportion of non-tied matches won and the proportion of tied matches.} \item{\dots}{further arguments passed to plot.} } \value{ A list of data frames: \item{win}{ a data frame comprising \code{prop.win}, the proportion of non-tied matches won by the first player in each bin and \code{bin.win}, the mid-point of each bin. } \item{tie}{ (when ties are present) a data frame comprising \code{prop.tie}, the proportion of tied matches in each bin and \code{bin.tie}, the mid-point of each bin. } } \description{ Plot proportions of tied matches and non-tied matches won by the first player, within matches binned by the relative player ability, as expressed by the probability that the first player wins, given the match is not a tie. Add fitted lines for each set of matches, as given by the generalized Davidson model. } \details{ If \code{home.adv} is specified, the results are re-ordered if necessary so that the home player comes first; any matches played on neutral ground are omitted. First the probability that the first player wins given that the match is not a tie is computed: \deqn{expit(home.adv + abilities[player1] - abilities[player2])} where \code{home.adv} and \code{abilities} are parameters from a generalized Davidson model that have been estimated on the log scale. The matches are then binned according to this probability, grouping together matches with similar relative ability between the first player and the second player. Within each bin, the proportion of tied matches is computed and these proportions are plotted against the mid-point of the bin. Then the bins are re-computed omitting the tied games and the proportion of non-tied matches won by the first player is found and plotted against the new mid-point. Finally curves are added for the probability of a tie and the conditional probability of win given the match is not a tie, under a generalized Davidson model with parameters as specified by \code{tie.max}, \code{tie.scale} and \code{tie.mode}. The function can also be used to plot the proportions of wins along with the fitted probability of a win under the Bradley-Terry model. } \note{ This function is designed for single match outcomes, therefore data aggregated over player pairs will need to be expanded. } \examples{ #### A Bradley-Terry example using icehockey data ## Fit the standard Bradley-Terry model, ignoring home advantage standardBT <- BTm(outcome = result, player1 = visitor, player2 = opponent, id = "team", data = icehockey) ## comparing teams on a "level playing field" levelBT <- BTm(result, data.frame(team = visitor, home.ice = 0), data.frame(team = opponent, home.ice = home.ice), ~ team + home.ice, id = "team", data = icehockey) ## compare fit to observed proportion won ## exclude tied matches as not explicitly modelled here par(mfrow = c(1, 2)) plotProportions(win = result == 1, loss = result == 0, player1 = visitor, player2 = opponent, abilities = BTabilities(standardBT)[,1], data = icehockey, subset = result != 0.5, main = "Without home advantage") plotProportions(win = result == 1, loss = result == 0, player1 = visitor, player2 = opponent, home.adv = coef(levelBT)["home.ice"], at.home1 = 0, at.home2 = home.ice, abilities = BTabilities(levelBT)[,1], data = icehockey, subset = result != 0.5, main = "With home advantage") #### A generalized Davidson example using football data if (require(gnm)) { ## subset to first and last season for illustration football <- subset(football, season \%in\% c("2008-9", "2012-13")) ## convert to trinomial counts football.tri <- expandCategorical(football, "result", idvar = "match") ## add variable to indicate whether team playing at home football.tri$at.home <- !logical(nrow(football.tri)) ## fit Davidson model Dav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri) ## fit shifted & scaled Davidson model shifScalDav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, tie.scale = ~1, tie.mode = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri) ## diagnostic plots main <- c("Davidson", "Shifted & Scaled Davidson") mod <- list(Dav, shifScalDav) names(mod) <- main alpha <- names(coef(Dav)[-(1:2)]) ## use football.tri data so that at.home can be found, ## but restrict to actual match results par(mfrow = c(1,2)) for (i in 1:2) { coef <- parameters(mod[[i]]) plotProportions(result == 1, result == 0, result == -1, home:season, away:season, abilities = coef[alpha], home.adv = coef["home.adv"], tie.max = coef["tie.max"], tie.scale = coef["tie.scale"], tie.mode = coef["tie.mode"], at.home1 = at.home, at.home2 = !at.home, main = main[i], data = football.tri, subset = count == 1) } } } \seealso{ \code{\link[=GenDavidson]{GenDavidson()}}, \code{\link[=BTm]{BTm()}} } \author{ Heather Turner } \keyword{models} \keyword{nonlinear} BradleyTerry2/man/springall.Rd0000744000176200001440000000571413441512005016004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/springall.R \docType{data} \name{springall} \alias{springall} \title{Springall (1973) Data on Subjective Evaluation of Flavour Strength} \format{A list containing two data frames, \code{springall$contests} and \code{springall$predictors}. The \code{springall$contests} data frame has 36 observations (one for each possible pairwise comparison of the 9 treatments) on the following 7 variables: \describe{ \item{row}{a factor with levels \code{1:9}, the row number in Springall's dataset} # \item{col}{a factor with levels \code{1:9}, the column number in Springall's dataset} \item{win}{integer, the number of wins for column treatment over row treatment} \item{loss}{integer, the number of wins for row treatment over column treatment} \item{tie}{integer, the number of ties between row and column treatments} \item{win.adj}{numeric, equal to \code{win + tie/2}} \item{loss.adj}{numeric, equal to \code{loss + tie/2}} } The \code{predictors} data frame has 9 observations (one for each treatment) on the following 5 variables: \describe{ \item{flav}{numeric, the flavour concentration} \item{gel}{numeric, the gel concentration} \item{flav.2}{numeric, equal to \code{flav^2}} \item{gel.2}{numeric, equal to \code{gel^2}} \item{flav.gel}{numeric, equal to \code{flav * gel}} }} \source{ Springall, A (1973) Response surface fitting using a generalization of the Bradley-Terry paired comparison method. \emph{Applied Statistics} \strong{22}, 59--68. } \usage{ springall } \description{ Data from Section 7 of the paper by Springall (1973) on Bradley-Terry response surface modelling. An experiment to assess the effects of gel and flavour concentrations on the subjective assessment of flavour strength by pair comparisons. } \details{ The variables \code{win.adj} and \code{loss.adj} are provided in order to allow a simple way of handling ties (in which a tie counts as half a win and half a loss), which is slightly different numerically from the Rao and Kupper (1967) model that Springall (1973) uses. } \examples{ ## ## Fit the same response-surface model as in section 7 of ## Springall (1973). ## ## Differences from Springall's fit are minor, arising from the ## different treatment of ties. ## ## Springall's model in the paper does not include the random effect. ## In this instance, however, that makes no difference: the random-effect ## variance is estimated as zero. ## summary(springall.model <- BTm(cbind(win.adj, loss.adj), col, row, ~ flav[..] + gel[..] + flav.2[..] + gel.2[..] + flav.gel[..] + (1 | ..), data = springall)) } \references{ Rao, P. V. and Kupper, L. L. (1967) Ties in paired-comparison experiments: a generalization of the Bradley-Terry model. \emph{Journal of the American Statistical Association}, \strong{63}, 194--204. } \author{ David Firth } \keyword{datasets} BradleyTerry2/man/anova.BTm.Rd0000744000176200001440000000555413441512005015600 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anova.BTm.R \name{anova.BTm} \alias{anova.BTm} \title{Compare Nested Bradley Terry Models} \usage{ \method{anova}{BTm}(object, ..., dispersion = NULL, test = NULL) } \arguments{ \item{object}{a fitted object of class inheriting from \code{"BTm"}.} \item{...}{additional \code{"BTm"} objects.} \item{dispersion}{a value for the dispersion. Not implemented for models with random effects.} \item{test}{optional character string (partially) matching one of \code{"Chisq"}, \code{"F"} or \code{"Cp"} to specify that p-values should be returned. The Chisq test is a likelihood ratio test for models with no random effects, otherwise a Wald test. Options \code{"F"} and \code{"Cp"} are only applicable to models with no random effects, see \code{\link[=stat.anova]{stat.anova()}}.} } \value{ An object of class \code{"anova"} inheriting from class \code{"data.frame"}. } \description{ Compare nested models inheriting from class \code{"BTm"}. For models with no random effects, compute analysis of deviance table, otherwise compute Wald tests of additional terms. } \details{ For models with no random effects, an analysis of deviance table is computed using \code{\link[=anova.glm]{anova.glm()}}. Otherwise, Wald tests are computed as detailed here. If a single object is specified, terms are added sequentially and a Wald statistic is computed for the extra parameters. If the full model includes player covariates and there are players with missing values over these covariates, then the \code{NULL} model will include a separate ability for these players. If there are missing values in any contest-level variables in the full model, the corresponding contests will be omitted throughout. The random effects structure of the full model is assumed for all sub-models. For a list of objects, consecutive pairs of models are compared by computing a Wald statistic for the extra parameters in the larger of the two models. The Wald statistic is always based on the variance-covariance matrix of the larger of the two models being compared. } \section{Warning}{ The comparison between two or more models will only be valid if they are fitted to the same dataset. This may be a problem if there are missing values and 's default of \code{na.action = na.omit} is used. An error will be returned in this case. The same problem will occur when separate abilities have been estimated for different subsets of players in the models being compared. However no warning is given in this case. } \examples{ result <- rep(1, nrow(flatlizards$contests)) BTmodel <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + (1|..), data = flatlizards, trace = TRUE) anova(BTmodel) } \seealso{ \code{\link[=BTm]{BTm()}}, \code{\link[=add1.BTm]{add1.BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/football.Rd0000744000176200001440000000443113441512005015606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/football.R \docType{data} \name{football} \alias{football} \title{English Premier League Football Results 2008/9 to 2012/13} \format{A data frame with 1881 observations on the following 4 variables. \describe{ \item{season}{a factor with levels \code{2008-9}, \code{2009-10}, \code{2010-11}, \code{2011-12}, \code{2012-13}} \item{home}{a factor specifying the home team, with 29 levels \code{Ars} (Arsenal), ... , \code{Wol} (Wolverhampton)} \item{away}{a factor specifying the away team, with the same levels as \code{home}.} \item{result}{a numeric vector giving the result for the home team: 1 for a win, 0 for a draw, -1 for a loss.} }} \source{ These data were downloaded from http://soccernet.espn.go.com in 2013. The site has since moved and the new site does not appear to have an equivalent source. } \usage{ football } \description{ The win/lose/draw results for five seasons of the English Premier League football results, from 2008/9 to 2012/13 } \details{ In each season, there are 20 teams, each of which plays one home game and one away game against all the other teams in the league. The results in 380 games per season. } \examples{ ### example requires gnm if (require(gnm)) { ### convert to trinomial counts football.tri <- expandCategorical(football, "result", idvar = "match") head(football.tri) ### add variable to indicate whether team playing at home football.tri$at.home <- !logical(nrow(football.tri)) ### fit Davidson model for ties ### - subset to first and last season for illustration Davidson <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, home:season, away:season, home.adv = ~1, tie.max = ~1, at.home1 = at.home, at.home2 = !at.home) - 1, eliminate = match, family = poisson, data = football.tri, subset = season \%in\% c("2008-9", "2012-13")) ### see ?GenDavidson for further analysis } } \references{ Davidson, R. R. (1970). On extending the Bradley-Terry model to accommodate ties in paired comparison experiments. \emph{Journal of the American Statistical Association}, \strong{65}, 317--328. } \seealso{ \code{\link[=GenDavidson]{GenDavidson()}} } \keyword{datasets} BradleyTerry2/man/baseball.Rd0000744000176200001440000000370413615002170015553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/baseball.R \docType{data} \name{baseball} \alias{baseball} \title{Baseball Data from Agresti (2002)} \format{A data frame with 42 observations on the following 4 variables. \describe{ \item{home.team}{a factor with levels \code{Baltimore}, \code{Boston}, \code{Cleveland}, \code{Detroit}, \code{Milwaukee}, \verb{New York}, \code{Toronto}.} \item{away.team}{a factor with levels \code{Baltimore}, \code{Boston}, \code{Cleveland}, \code{Detroit}, \code{Milwaukee}, \verb{New York}, \code{Toronto}.} \item{home.wins}{a numeric vector.} \item{away.wins}{a numeric vector.} }} \source{ Page 438 of Agresti, A. (2002) \emph{Categorical Data Analysis} (2nd Edn.). New York: Wiley. } \usage{ baseball } \description{ Baseball results for games in the 1987 season between 7 teams in the Eastern Division of the American League. } \note{ This dataset is in a simpler format than the one described in Firth (2005). } \examples{ ## This reproduces the analysis in Sec 10.6 of Agresti (2002). data(baseball) # start with baseball data as provided by package ## Simple Bradley-Terry model, ignoring home advantage: baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") ## Now incorporate the "home advantage" effect baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) ## Compare the fit of these two models: anova(baseballModel1, baseballModel2) } \references{ Firth, D. (2005) Bradley-Terry models in R. \emph{Journal of Statistical Software}, \strong{12}(1), 1--12. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. } \seealso{ \code{\link[=BTm]{BTm()}} } \keyword{datasets} BradleyTerry2/man/glmmPQL.Rd0000744000176200001440000001621213615002170015315 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glmmPQL.R \name{glmmPQL} \alias{glmmPQL} \title{PQL Estimation of Generalized Linear Mixed Models} \usage{ glmmPQL( fixed, random = NULL, family = "binomial", data = NULL, subset = NULL, weights = NULL, offset = NULL, na.action = NULL, start = NULL, etastart = NULL, mustart = NULL, control = glmmPQL.control(...), sigma = 0.1, sigma.fixed = FALSE, model = TRUE, x = FALSE, contrasts = NULL, ... ) } \arguments{ \item{fixed}{a formula for the fixed effects.} \item{random}{a design matrix for the random effects, with number of rows equal to the length of variables in \code{formula}.} \item{family}{a description of the error distribution and link function to be used in the model. This can be a character string naming a family function, a family function or the result of a call to a family function. (See \code{\link[=family]{family()}} for details of family functions.)} \item{data}{an optional data frame, list or environment (or object coercible by \code{\link[=as.data.frame]{as.data.frame()}} to a data frame) containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{glmmPQL} called.} \item{subset}{an optional logical or numeric vector specifying a subset of observations to be used in the fitting process.} \item{weights}{an optional vector of \sQuote{prior weights} to be used in the fitting process.} \item{offset}{an optional numeric vector to be added to the linear predictor during fitting. One or more \code{offset} terms can be included in the formula instead or as well, and if more than one is specified their sum is used. See \code{\link[=model.offset]{model.offset()}}.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{\link[=options]{options()}}, and is \code{\link[=na.fail]{na.fail()}} if that is unset.} \item{start}{starting values for the parameters in the linear predictor.} \item{etastart}{starting values for the linear predictor.} \item{mustart}{starting values for the vector of means.} \item{control}{a list of parameters for controlling the fitting process. See the \code{\link[=glmmPQL.control]{glmmPQL.control()}} for details.} \item{sigma}{a starting value for the standard deviation of the random effects.} \item{sigma.fixed}{logical: whether or not the standard deviation of the random effects should be fixed at its starting value.} \item{model}{logical: whether or not the model frame should be returned.} \item{x}{logical: whether or not the design matrix for the fixed effects should be returned.} \item{contrasts}{an optional list. See the \code{contrasts.arg} argument of \code{\link[=model.matrix]{model.matrix()}}.} \item{\dots}{arguments to be passed to \code{\link[=glmmPQL.control]{glmmPQL.control()}}.} } \value{ An object of class \code{"BTglmmPQL"} which inherits from \code{"glm"} and \code{"lm"}: \item{coefficients}{ a named vector of coefficients, with a \code{"random"} attribute giving the estimated random effects.} \item{residuals}{ the working residuals from the final iteration of the IWLS loop.} \item{random}{the design matrix for the random effects.} \item{fitted.values}{ the fitted mean values, obtained by transforming the linear predictors by the inverse of the link function.} \item{rank}{the numeric rank of the fitted linear model.} \item{family}{the \code{family} object used.} \item{linear.predictors}{the linear fit on link scale.} \item{deviance}{up to a constant, minus twice the maximized log-likelihood.} \item{aic}{a version of Akaike's \emph{An Information Criterion}, minus twice the maximized log-likelihood plus twice the number of parameters, computed by the \code{aic} component of the family.} \item{null.deviance}{the deviance for the null model, comparable with \code{deviance}.} \item{iter}{the numer of iterations of the PQL algorithm.} \item{weights}{the working weights, that is the weights in the final iteration of the IWLS loop.} \item{prior.weights}{the weights initially supplied, a vector of \code{1}'s if none were.} \item{df.residual}{the residual degrees of freedom.} \item{df.null}{the residual degrees of freedom for the null model.} \item{y}{if requested (the default) the \code{y} vector used. (It is a vector even for a binomial model.)} \item{x}{if requested, the model matrix.} \item{model}{if requested (the default), the model frame.} \item{converged}{logical. Was the PQL algorithm judged to have converged?} \item{call}{the matched call.} \item{formula}{the formula supplied.} \item{terms}{the \code{terms} object used.} \item{data}{the \code{data} argument used.} \item{offset}{the offset vector used.} \item{control}{the value of the \code{control} argument used.} \item{contrasts}{(where relevant) the contrasts used.} \item{xlevels}{(where relevant) a record of the levels of the factors used in fitting.} \item{na.action}{(where relevant) information returned by \code{model.frame} on the special handling of \code{NA}s.} \item{sigma}{the estimated standard deviation of the random effects} \item{sigma.fixed}{logical: whether or not \code{sigma} was fixed} \item{varFix}{the variance-covariance matrix of the fixed effects} \item{varSigma}{the variance of \code{sigma}} } \description{ Fits GLMMs with simple random effects structure via Breslow and Clayton's PQL algorithm. The GLMM is assumed to be of the form \ifelse{html}{\out{g(μ) = Xβ + Ze}}{\deqn{g(\boldsymbol{\mu}) = \boldsymbol{X\beta} + \boldsymbol{Ze}}{ g(mu) = X * beta + Z * e}} where \eqn{g} is the link function, \ifelse{html}{\out{μ}}{\eqn{\boldsymbol{\mu}}{mu}} is the vector of means and \ifelse{html}{\out{X, Z}}{\eqn{\boldsymbol{X}, \boldsymbol{Z}}{X,Z}} are design matrices for the fixed effects \ifelse{html}{\out{β}}{\eqn{\boldsymbol{\beta}}{beta}} and random effects \ifelse{html}{\out{e}}{\eqn{\boldsymbol{e}}{e}} respectively. Furthermore the random effects are assumed to be i.i.d. \ifelse{html}{\out{N(0, σ2)}}{\eqn{N(0, \sigma^2)}{ N(0, sigma^2)}}. } \examples{ ############################################### ## Crowder seeds example from Breslow & Clayton ############################################### summary(glmmPQL(cbind(r, n - r) ~ seed + extract, random = diag(nrow(seeds)), family = "binomial", data = seeds)) summary(glmmPQL(cbind(r, n - r) ~ seed*extract, random = diag(nrow(seeds)), family = "binomial", data = seeds)) } \references{ Breslow, N. E. and Clayton, D. G. (1993) Approximate inference in Generalized Linear Mixed Models. \emph{Journal of the American Statistical Association} \strong{88}(421), 9--25. Harville, D. A. (1977) Maximum likelihood approaches to variance component estimation and to related problems. \emph{Journal of the American Statistical Association} \strong{72}(358), 320--338. } \seealso{ \code{\link[=predict.BTglmmPQL]{predict.BTglmmPQL()}},\code{\link[=glmmPQL.control]{glmmPQL.control()}},\code{\link[=BTm]{BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/add1.BTm.Rd0000744000176200001440000000541213615002170015276 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/add1.BTm.R \name{add1.BTm} \alias{add1.BTm} \alias{drop1.BTm} \title{Add or Drop Single Terms to/from a Bradley Terry Model} \usage{ \method{add1}{BTm}(object, scope, scale = 0, test = c("none", "Chisq", "F"), x = NULL, ...) } \arguments{ \item{object}{a fitted object of class inheriting from \code{"BTm"}.} \item{scope}{a formula specifying the model including all terms to be considered for adding or dropping.} \item{scale}{an estimate of the dispersion. Not implemented for models with random effects.} \item{test}{should a p-value be returned? The F test is only appropriate for models with no random effects for which the dispersion has been estimated. The Chisq test is a likelihood ratio test for models with no random effects, otherwise a Wald test.} \item{x}{a model matrix containing columns for all terms in the scope. Useful if \code{add1} is to be called repeatedly. \strong{Warning:} no checks are done on its validity.} \item{\dots}{further arguments passed to \code{\link[=add1.glm]{add1.glm()}}.} } \value{ An object of class \code{"anova"} summarizing the differences in fit between the models. } \description{ Add or drop single terms within the limit specified by the \code{scope} argument. For models with no random effects, compute an analysis of deviance table, otherwise compute the Wald statistic of the parameters that have been added to or dropped from the model. } \details{ The hierarchy is respected when considering terms to be added or dropped: all main effects contained in a second-order interaction must remain, and so on. In a scope formula \samp{.} means \sQuote{what is already there}. For \code{drop1}, a missing \code{scope} is taken to mean that all terms in the model may be considered for dropping. If \code{scope} includes player covariates and there are players with missing values over these covariates, then a separate ability will be estimated for these players in \emph{all} fitted models. Similarly if there are missing values in any contest-level variables in \code{scope}, the corresponding contests will be omitted from all models. If \code{formula} includes random effects, the same random effects structure will apply to all models. } \examples{ result <- rep(1, nrow(flatlizards$contests)) BTmodel1 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + (1|..), data = flatlizards, tol = 1e-4, sigma = 2, trace = TRUE) drop1(BTmodel1) add1(BTmodel1, ~ . + head.length[..] + SVL[..], test = "Chisq") BTmodel2 <- update(BTmodel1, formula = ~ . + head.length[..]) drop1(BTmodel2, test = "Chisq") } \seealso{ \code{\link[=BTm]{BTm()}}, \code{\link[=anova.BTm]{anova.BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/reexports.Rd0000744000176200001440000000062513441512005016040 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/qvcalc.BTabilities.R \docType{import} \name{reexports} \alias{reexports} \alias{qvcalc} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{qvcalc}{\code{\link[qvcalc]{qvcalc}}} }} BradleyTerry2/man/predict.BTm.Rd0000744000176200001440000001767613615002170016136 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/predict.BTm.R \name{predict.BTm} \alias{predict.BTm} \title{Predict Method for Bradley-Terry Models} \usage{ \method{predict}{BTm}( object, newdata = NULL, level = ifelse(is.null(object$random), 0, 1), type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, ... ) } \arguments{ \item{object}{a fitted object of class \code{"BTm"}} \item{newdata}{(optional) a data frame in which to look for variables with which to predict. If omitted, the fitted linear predictors are used.} \item{level}{for models with random effects: an integer vector giving the level(s) at which predictions are required. Level zero corresponds to population-level predictions (fixed effects only), whilst level one corresponds to the player-level predictions (full model) which are NA for contests involving players not in the original data. By default, \code{level = 0} for a fixed effects model, \code{1} otherwise.} \item{type}{the type of prediction required. The default is on the scale of the linear predictors; the alternative \code{"response"} is on the scale of the response variable. Thus for a default Bradley-Terry model the default predictions are of log-odds (probabilities on logit scale) and \code{type = "response"} gives the predicted probabilities. The \code{"terms"} option returns a matrix giving the fitted values of each term in the model formula on the linear predictor scale (fixed effects only).} \item{se.fit}{logical switch indicating if standard errors are required.} \item{dispersion}{a value for the dispersion, not used for models with random effects. If omitted, that returned by \code{summary} applied to the object is used, where applicable.} \item{terms}{with \code{type ="terms"} by default all terms are returned. A character vector specifies which terms are to be returned.} \item{na.action}{function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ If \code{se.fit = FALSE}, a vector or matrix of predictions. If \code{se = TRUE}, a list with components \item{fit }{Predictions} \item{se.fit }{Estimated standard errors} } \description{ Obtain predictions and optionally standard errors of those predictions from a fitted Bradley-Terry model. } \details{ If \code{newdata} is omitted the predictions are based on the data used for the fit. In that case how cases with missing values in the original fit are treated is determined by the \code{na.action} argument of that fit. If \code{na.action = na.omit} omitted cases will not appear in the residuals, whereas if \code{na.action = na.exclude} they will appear (in predictions and standard errors), with residual value \code{NA}. See also \code{napredict}. } \examples{ ## The final model in example(flatlizards) result <- rep(1, nrow(flatlizards$contests)) Whiting.model3 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards, trace = TRUE) ## `new' data for contests between four of the original lizards ## factor levels must correspond to original levels, but unused levels ## can be dropped - levels must match rows of predictors newdata <- list(contests = data.frame( winner = factor(c("lizard048", "lizard060"), levels = c("lizard006", "lizard011", "lizard048", "lizard060")), loser = factor(c("lizard006", "lizard011"), levels = c("lizard006", "lizard011", "lizard048", "lizard060")) ), predictors = flatlizards$predictors[c(3, 6, 27, 33), ]) predict(Whiting.model3, level = 1, newdata = newdata) ## same as predict(Whiting.model3, level = 1)[1:2] ## introducing a new lizard newpred <- rbind(flatlizards$predictors[c(3, 6, 27), c("throat.PC1","throat.PC3", "SVL", "head.length")], c(-5, 1.5, 1, 0.1)) rownames(newpred)[4] <- "lizard059" newdata <- list(contests = data.frame( winner = factor(c("lizard048", "lizard059"), levels = c("lizard006", "lizard011", "lizard048", "lizard059")), loser = factor(c("lizard006", "lizard011"), levels = c("lizard006", "lizard011", "lizard048", "lizard059")) ), predictors = newpred) ## can only predict at population level for contest with new lizard predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata) ## predicting at specific levels of covariates ## consider a model from example(CEMS) table6.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * Paris[..] + WOR[student] * Milano[..] + WOR[student] * Barcelona[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) ## estimate abilities for a combination not seen in the original data ## same schools schools <- levels(CEMS$preferences$school1) ## new student data students <- data.frame(STUD = "other", ENG = "good", FRA = "good", SPA = "good", ITA = "good", WOR = "yes", DEG = "no", SEX = "female", stringsAsFactors = FALSE) ## set levels to be the same as original data for (i in seq_len(ncol(students))){ students[,i] <- factor(students[,i], levels(CEMS$students[,i])) } newdata <- list(preferences = data.frame(student = factor(500), # new id matching with `students[1,]` school1 = factor("London", levels = schools), school2 = factor("Paris", levels = schools)), students = students, schools = CEMS$schools) ## warning can be ignored as model specification was over-parameterized predict(table6.model, newdata = newdata) ## if treatment contrasts are use (i.e. one player is set as the reference ## category), then predicting the outcome of contests against the reference ## is equivalent to estimating abilities with specific covariate values ## add student with all values at reference levels students <- rbind(students, data.frame(STUD = "other", ENG = "good", FRA = "good", SPA = "good", ITA = "good", WOR = "no", DEG = "no", SEX = "female", stringsAsFactors = FALSE)) ## set levels to be the same as original data for (i in seq_len(ncol(students))){ students[,i] <- factor(students[,i], levels(CEMS$students[,i])) } newdata <- list(preferences = data.frame(student = factor(rep(c(500, 502), each = 6)), school1 = factor(schools, levels = schools), school2 = factor("Stockholm", levels = schools)), students = students, schools = CEMS$schools) predict(table6.model, newdata = newdata, se.fit = TRUE) ## the second set of predictions (elements 7-12) are equivalent to the output ## of BTabilities; the first set are adjust for `WOR` being equal to "yes" BTabilities(table6.model) } \seealso{ \code{\link[=predict.glm]{predict.glm()}}, \code{\link[=predict.glmmPQL]{predict.glmmPQL()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/countsToBinomial.Rd0000744000176200001440000000231413441512005017273 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/countsToBinomial.R \name{countsToBinomial} \alias{countsToBinomial} \title{Convert Contingency Table of Wins to Binomial Counts} \usage{ countsToBinomial(xtab) } \arguments{ \item{xtab}{a contingency table of wins cross-classified by \dQuote{winner} and \dQuote{loser}} } \value{ A data frame with four columns \item{player1 }{ the first player in the contest. } \item{player2 }{ the second player in the contest. } \item{win1 }{ the number of times \code{player1} won. } \item{win2 }{ the number of times \code{player2} won. } } \description{ Convert a contingency table of wins to a four-column data frame containing the number of wins and losses for each pair of players. } \examples{ ######################################################## ## Statistics journal citation data from Stigler (1994) ## -- see also Agresti (2002, p448) ######################################################## citations ## Convert frequencies to success/failure data citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") citations.sf } \seealso{ \code{\link[=BTm]{BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/predict.BTglmmPQL.Rd0000744000176200001440000000727613615002170017206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/predict.BTglmmPQL.R \name{predict.BTglmmPQL} \alias{predict.BTglmmPQL} \title{Predict Method for BTglmmPQL Objects} \usage{ \method{predict}{BTglmmPQL}( object, newdata = NULL, newrandom = NULL, level = ifelse(object$sigma == 0, 0, 1), type = c("link", "response", "terms"), se.fit = FALSE, terms = NULL, na.action = na.pass, ... ) } \arguments{ \item{object}{a fitted object of class \code{"BTglmmPQL"}} \item{newdata}{(optional) a data frame in which to look for variables with which to predict. If omitted, the fitted linear predictors are used.} \item{newrandom}{if \code{newdata} is provided, a corresponding design matrix for the random effects, will columns corresponding to the random effects estimated in the original model.} \item{level}{an integer vector giving the level(s) at which predictions are required. Level zero corresponds to population-level predictions (fixed effects only), whilst level one corresponds to the individual-level predictions (full model) which are NA for contests involving individuals not in the original data. By default \code{level = 0} if the model converged to a fixed effects model, \code{1} otherwise.} \item{type}{the type of prediction required. The default is on the scale of the linear predictors; the alternative \code{"response"} is on the scale of the response variable. Thus for a default binomial model the default predictions are of log-odds (probabilities on logit scale) and \code{type = "response"} gives the predicted probabilities. The \code{"terms"} option returns a matrix giving the fitted values of each term in the model formula on the linear predictor scale (fixed effects only).} \item{se.fit}{logical switch indicating if standard errors are required.} \item{terms}{with \code{type ="terms"} by default all terms are returned. A character vector specifies which terms are to be returned.} \item{na.action}{function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}.} \item{\dots}{further arguments passed to or from other methods.} } \value{ If \code{se.fit = FALSE}, a vector or matrix of predictions. If \code{se = TRUE}, a list with components \item{fit }{Predictions} \item{se.fit }{Estimated standard errors} } \description{ Obtain predictions and optionally standard errors of those predictions from a \code{"BTglmmPQL"} object. } \details{ If \code{newdata} is omitted the predictions are based on the data used for the fit. In that case how cases with missing values in the original fit are treated is determined by the \code{na.action} argument of that fit. If \code{na.action = na.omit} omitted cases will not appear in the residuals, whereas if \code{na.action = na.exclude} they will appear (in predictions and standard errors), with residual value \code{NA}. See also \code{napredict}. Standard errors for the predictions are approximated assuming the variance of the random effects is known, see Booth and Hobert (1998). } \examples{ seedsModel <- glmmPQL(cbind(r, n - r) ~ seed + extract, random = diag(nrow(seeds)), family = binomial, data = seeds) pred <- predict(seedsModel, level = 0) predTerms <- predict(seedsModel, type = "terms") all.equal(pred, rowSums(predTerms) + attr(predTerms, "constant")) } \references{ Booth, J. G. and Hobert, J. P. (1998). Standard errors of prediction in Generalized Linear Mixed Models. \emph{Journal of the American Statistical Association} \strong{93}(441), 262 -- 272. } \seealso{ \code{\link[=predict.glm]{predict.glm()}}, \code{\link[=predict.BTm]{predict.BTm()}} } \author{ Heather Turner } \keyword{models} BradleyTerry2/man/sound.fields.Rd0000744000176200001440000000730213615337047016417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sound.fields.R \docType{data} \name{sound.fields} \alias{sound.fields} \title{Kousgaard (1984) Data on Pair Comparisons of Sound Fields} \format{A list containing two data frames, \code{sound.fields$comparisons}, and \code{sound.fields$design}. The \code{sound.fields$comparisons} data frame has 84 observations on the following 8 variables: \describe{ \item{field1}{a factor with levels \code{c("000", "001", "010", "011", "100", "101", "110", "111")}, the first sound field in a comparison} \item{field2}{a factor with the same levels as \code{field1}; the second sound field in a comparison} \item{win1}{integer, the number of times that \code{field1} was preferred to \code{field2}} \item{tie}{integer, the number of times that no preference was expressed when comparing \code{field1} and \code{field2}} \item{win2}{integer, the number of times that \code{field2} was preferred to \code{field1}} \item{win1.adj}{numeric, equal to \code{win1 + tie/2}} \item{win2.adj}{numeric, equal to \code{win2 + tie/2}} \item{instrument}{a factor with 3 levels, \code{c("cello", "flute", "violin")}} } The \code{sound.fields$design} data frame has 8 observations (one for each of the sound fields compared in the experiment) on the following 3 variables: \describe{ \item{a")}{a factor with levels \code{c("0", "1")}, the \emph{direct sound} factor (0 for \emph{obstructed sight line}, 1 for \emph{free sight line}); contrasts are sum contrasts} \item{b}{a factor with levels \code{c("0", "1")}, the \emph{reflection} factor (0 for \emph{-26dB}, 1 for \emph{-20dB}); contrasts are sum contrasts} \item{c}{a factor with levels \code{c("0", "1")}, the \emph{reverberation} factor (0 for \emph{-24dB}, 1 for \emph{-20dB}); contrasts are sum contrasts} }} \source{ Kousgaard, N. (1984) Analysis of a Sound Field Experiment by a Model for Paired Comparisons with Explanatory Variables. \emph{Scandinavian Journal of Statistics} \strong{11}, 51--57. } \usage{ sound.fields } \description{ The results of a series of factorial subjective room acoustic experiments carried out at the Technical University of Denmark by A C Gade. } \details{ The variables \code{win1.adj} and \code{win2.adj} are provided in order to allow a simple way of handling ties (in which a tie counts as half a win and half a loss), which is slightly different numerically from the Davidson (1970) method that is used by Kousgaard (1984): see the examples. } \examples{ ## ## Fit the Bradley-Terry model to data for flutes, using the simple ## 'add 0.5' method to handle ties: ## flutes.model <- BTm(cbind(win1.adj, win2.adj), field1, field2, ~ field, id = "field", subset = (instrument == "flute"), data = sound.fields) ## ## This agrees (after re-scaling) quite closely with the estimates given ## in Table 3 of Kousgaard (1984): ## table3.flutes <- c(-0.581, -1.039, 0.347, 0.205, 0.276, 0.347, 0.311, 0.135) plot(c(0, coef(flutes.model)), table3.flutes) abline(lm(table3.flutes ~ c(0, coef(flutes.model)))) ## ## Now re-parameterise that model in terms of the factorial effects, as ## in Table 5 of Kousgaard (1984): ## flutes.model.reparam <- update(flutes.model, formula = ~ a[field] * b[field] * c[field] ) table5.flutes <- c(.267, .250, -.088, -.294, .062, .009, -0.070) plot(coef(flutes.model.reparam), table5.flutes) abline(lm(table5.flutes ~ coef(flutes.model.reparam))) } \references{ Davidson, R. R. (1970) Extending the Bradley-Terry model to accommodate ties in paired comparison experiments. \emph{Journal of the American Statistical Association} \strong{65}, 317--328. } \author{ David Firth } \keyword{datasets} BradleyTerry2/man/seeds.Rd0000744000176200001440000000223013441512005015102 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seeds.R \docType{data} \name{seeds} \alias{seeds} \title{Seed Germination Data from Crowder (1978)} \format{A data frame with 21 observations on the following 4 variables. \describe{ \item{r}{the number of germinated seeds.} \item{n}{the total number of seeds.} \item{seed}{the seed variety.} \item{extract}{the type of root extract.} }} \source{ Crowder, M. (1978) Beta-Binomial ANOVA for proportions. \emph{Applied Statistics}, \strong{27}, 34--37. } \usage{ seeds } \description{ Data from Crowder(1978) giving the proportion of seeds germinated for 21 plates that were arranged according to a 2x2 factorial layout by seed variety and type of root extract. } \examples{ summary(glmmPQL(cbind(r, n - r) ~ seed + extract, random = diag(nrow(seeds)), family = binomial, data = seeds)) } \references{ Breslow, N. E. and Clayton, D. G. (1993) Approximate inference in Generalized Linear Mixed Models. \emph{Journal of the American Statistical Association}, \strong{88}(421), 9--25. } \seealso{ \code{\link[=glmmPQL]{glmmPQL()}} } \keyword{datasets} BradleyTerry2/man/BTabilities.Rd0000744000176200001440000000615713441512005016206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/BTabilities.R \name{BTabilities} \alias{BTabilities} \alias{print.BTabilities} \alias{coef.BTabilities} \alias{vcov.BTabilities} \title{Estimated Abilities from a Bradley-Terry Model} \usage{ BTabilities(model) } \arguments{ \item{model}{a model object for which \code{inherits(model, "BTm")} is \code{TRUE}} } \value{ A two-column numeric matrix of class \code{c("BTabilities", "matrix")}, with columns named \code{"ability"} and \code{"se"}; has one row for each player; has attributes named \code{"vcov"}, \code{"modelcall"}, \code{"factorname"} and (sometimes --- see below) \code{"separate"}. The first three attributes are not printed by the method \code{print.BTabilities}. } \description{ Computes the (baseline) ability of each player from a model object of class \code{"BTm"}. } \details{ The player abilities are either directly estimated by the model, in which case the appropriate parameter estimates are returned, otherwise the abilities are computed from the terms of the fitted model that involve player covariates only (those indexed by \code{model$id} in the model formula). Thus parameters in any other terms are assumed to be zero. If one player has been set as the reference, then \code{predict.BTm()} can be used to obtain ability estimates with non-player covariates set to other values, see examples for \code{\link[=predict.BTm]{predict.BTm()}}. If the abilities are structured according to a linear predictor, and if there are player covariates with missing values, the abilities for the corresponding players are estimated as separate parameters. In this event the resultant matrix has an attribute, named \code{"separate"}, which identifies those players whose ability was estimated separately. For an example, see \code{\link[=flatlizards]{flatlizards()}}. } \examples{ ### citations example ## Convert frequencies to success/failure data citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") ## Fit the "standard" Bradley-Terry model citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) BTabilities(citeModel) ### baseball example data(baseball) # start with baseball data as provided by package ## Fit mode with home advantage baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) baseballModel2 <- BTm(cbind(home.wins, away.wins), home.team, away.team, formula = ~ team + at.home, id = "team", data = baseball) ## Estimate abilities for each team, relative to Baltimore, when ## playing away from home: BTabilities(baseballModel2) } \references{ Firth, D. (2005) Bradley-Terry models in R. \emph{Journal of Statistical Software}, \strong{12}(1), 1--12. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. } \seealso{ \code{\link[=BTm]{BTm()}}, \code{\link[=residuals.BTm]{residuals.BTm()}} } \author{ David Firth and Heather Turner } \keyword{models} BradleyTerry2/man/chameleons.Rd0000744000176200001440000000706113436770253016143 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/chameleons.R \docType{data} \name{chameleons} \alias{chameleons} \title{Male Cape Dwarf Chameleons: Measured Traits and Contest Outcomes} \format{A list containing three data frames: \code{chameleons$winner}, \code{chameleons$loser} and \code{chameleons$predictors}. The \code{chameleons$winner} and \code{chameleons$loser} data frames each have 106 observations (one per contest) on the following 4 variables: \describe{ \item{ID}{a factor with 35 levels \code{C01}, \code{C02}, ... , \code{C43}, the identity of the winning (or losing) male in each contest} \item{prev.wins.1}{integer (values 0 or 1), did the winner/loser of this contest win in an immediately previous contest?} \item{prev.wins.2}{integer (values 0, 1 or 2), how many of his (maximum) previous 2 contests did each male win?} \item{prev.wins.all}{integer, how many previous contests has each male won?} } The \code{chameleons$predictors} data frame has 35 observations, one for each male involved in the contests, on the following 7 variables: \describe{ \item{ch.res}{numeric, residuals of casque height regression on \code{SVL}, i.e. relative height of the bony part on the top of the chameleons' heads} \item{jl.res}{numeric, residuals of jaw length regression on \code{SVL}} \item{tl.res}{numeric, residuals of tail length regression on \code{SVL}} \item{mass.res}{numeric, residuals of body mass regression on \code{SVL} (body condition)} \item{SVL}{numeric, snout-vent length (body size)} \item{prop.main}{numeric, proportion (arcsin transformed) of area of the flank occupied by the main pink patch on the flank} \item{prop.patch}{numeric, proportion (arcsin transformed) of area of the flank occupied by the entire flank patch} }} \source{ The data were obtained by Dr Devi Stuart-Fox, \url{https://devistuartfox.com/}, and they are reproduced here with her kind permission. These are the same data that were used in Stuart-Fox, D. M., Firth, D., Moussalli, A. and Whiting, M. J. (2006) Multiple signals in chameleon contests: designing and analysing animal contests as a tournament. \emph{Animal Behaviour} \strong{71}, 1263--1271. } \usage{ chameleons } \description{ Data as used in the study by Stuart-Fox et al. (2006). Physical measurements made on 35 male Cape dwarf chameleons, and the results of 106 inter-male contests. } \details{ The published paper mentions 107 contests, but only 106 contests are included here. Contest number 16 was deleted from the data used to fit the models, because it involved a male whose predictor-variables were incomplete (and it was the only contest involving that lizard, so it is uninformative). } \examples{ ## ## Reproduce Table 3 from page 1268 of the above paper: ## summary(chameleon.model <- BTm(player1 = winner, player2 = loser, formula = ~ prev.wins.2 + ch.res[ID] + prop.main[ID] + (1|ID), id = "ID", data = chameleons)) head(BTabilities(chameleon.model)) ## ## Note that, although a per-chameleon random effect is specified as in the ## above [the term "+ (1|ID)"], the estimated variance for that random ## effect turns out to be zero in this case. The "prior experience" ## effect ["+ prev.wins.2"] in this analysis has explained most of the ## variation, leaving little for the ID-specific predictors to do. ## Despite that, two of the ID-specific predictors do emerge as ## significant. ## ## Test whether any of the other ID-specific predictors has an effect: ## add1(chameleon.model, ~ . + jl.res[ID] + tl.res[ID] + mass.res[ID] + SVL[ID] + prop.patch[ID]) } \author{ David Firth } \keyword{datasets} BradleyTerry2/man/CEMS.Rd0000744000176200001440000001570013436770253014553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/CEMS.R \docType{data} \name{CEMS} \alias{CEMS} \title{Dittrich, Hatzinger and Katzenbeisser (1998, 2001) Data on Management School Preference in Europe} \format{A list containing three data frames, \code{CEMS$preferences}, \code{CEMS$students} and \code{CEMS$schools}. The \code{CEMS$preferences} data frame has \code{303 * 15 = 4505} observations (15 possible comparisons, for each of 303 students) on the following 8 variables: \describe{ \item{student}{a factor with levels \code{1:303}} \item{school1}{a factor with levels \code{c("Barcelona", "London", "Milano", "Paris", "St.Gallen", "Stockholm")}; the first management school in a comparison} \item{school2}{a factor with the same levels as \code{school1}; the second management school in a comparison} \item{win1}{integer (value 0 or 1) indicating whether \code{school1} was preferred to \code{school2}} \item{win2}{integer (value 0 or 1) indicating whether \code{school2} was preferred to \code{school1}} \item{tied}{integer (value 0 or 1) indicating whether no preference was expressed} \item{win1.adj}{numeric, equal to \code{win1 + tied/2}} \item{win2.adj}{numeric, equal to \code{win2 + tied/2}} } The \code{CEMS$students} data frame has 303 observations (one for each student) on the following 8 variables: \describe{ \item{STUD}{a factor with levels \code{c("other", "commerce")}, the student's main discipline of study} \item{ENG}{a factor with levels \code{c("good, poor")}, indicating the student's knowledge of English} \item{FRA}{a factor with levels \code{c("good, poor")}, indicating the student's knowledge of French} \item{SPA}{a factor with levels \code{c("good, poor")}, indicating the student's knowledge of Spanish} \item{ITA}{a factor with levels \code{c("good, poor")}, indicating the student's knowledge of Italian} \item{WOR}{a factor with levels \code{c("no", "yes")}, whether the student was in full-time employment while studying} \item{DEG}{a factor with levels \code{c("no", "yes")}, whether the student intended to take an international degree} \item{SEX}{a factor with levels \code{c("female", "male")} } } The \code{CEMS$schools} data frame has 6 observations (one for each management school) on the following 7 variables: \describe{ \item{Barcelona}{numeric (value 0 or 1)} \item{London}{numeric (value 0 or 1)} \item{Milano}{numeric (value 0 or 1)} \item{Paris}{numeric (value 0 or 1)} \item{St.Gallen}{numeric (value 0 or 1)} \item{Stockholm}{numeric (value 0 or 1)} \item{LAT}{numeric (value 0 or 1) indicating a 'Latin' city} }} \source{ Royal Statistical Society datasets website, at \url{https://rss.onlinelibrary.wiley.com/hub/journal/14679876/series-c-datasets/pre_2016}. } \usage{ CEMS } \description{ \emph{Community of European management schools} (CEMS) data as used in the paper by Dittrich et al. (1998, 2001), re-formatted for use with \code{\link[=BTm]{BTm()}} } \details{ The variables \code{win1.adj} and \code{win2.adj} are provided in order to allow a simple way of handling ties (in which a tie counts as half a win and half a loss), which is slightly different numerically from the Davidson (1970) method that is used by Dittrich et al. (1998): see the examples. } \examples{ ## ## Fit the standard Bradley-Terry model, using the simple 'add 0.5' ## method to handle ties: ## table3.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~.. , refcat = "Stockholm", data = CEMS) ## The results in Table 3 of Dittrich et al (2001) are reproduced ## approximately by a simple re-scaling of the estimates: table3 <- summary(table3.model)$coef[, 1:2]/1.75 print(table3) ## ## Now fit the 'final model' from Table 6 of Dittrich et al.: ## table6.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * Paris[..] + WOR[student] * Milano[..] + WOR[student] * Barcelona[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) ## ## Again re-scale to reproduce approximately Table 6 of Dittrich et ## al. (2001): ## table6 <- summary(table6.model)$coef[, 1:2]/1.75 print(table6) ## \dontrun{ ## Now the slightly simplified model of Table 8 of Dittrich et al. (2001): ## table8.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * LAT[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) table8 <- summary(table8.model)$coef[, 1:2]/1.75 ## ## Notice some larger than expected discrepancies here (the coefficients ## named "..Barcelona", "..Milano" and "..Paris") from the results in ## Dittrich et al. (2001). Apparently a mistake was made in Table 8 of ## the published Corrigendum note (R. Dittrich personal communication, ## February 2010). ## print(table8) } } \references{ Davidson, R. R. (1970) Extending the Bradley-Terry model to accommodate ties in paired comparison experiments. \emph{Journal of the American Statistical Association} \strong{65}, 317--328. Dittrich, R., Hatzinger, R. and Katzenbeisser, W. (1998) Modelling the effect of subject-specific covariates in paired comparison studies with an application to university rankings. \emph{Applied Statistics} \strong{47}, 511--525. Dittrich, R., Hatzinger, R. and Katzenbeisser, W. (2001) Corrigendum: Modelling the effect of subject-specific covariates in paired comparison studies with an application to university rankings. \emph{Applied Statistics} \strong{50}, 247--249. Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 package. \emph{Journal of Statistical Software}, \strong{48}(9), 1--21. } \author{ David Firth } \keyword{datasets} BradleyTerry2/DESCRIPTION0000744000176200001440000000176613616022414014464 0ustar liggesusersPackage: BradleyTerry2 Version: 1.1-2 Title: Bradley-Terry Models Authors@R: c(person("Heather", "Turner", role = c("aut", "cre"), email = "ht@heatherturner.net"), person("David", "Firth", role = "aut")) URL: https://github.com/hturner/BradleyTerry2 BugReports: https://github.com/hturner/BradleyTerry2/issues Description: Specify and fit the Bradley-Terry model, including structured versions in which the parameters are related to explanatory variables through a linear predictor and versions with contest-specific effects, such as a home advantage. Depends: R (>= 2.10) Imports: brglm, gtools, lme4 (>= 1.0), qvcalc, stats Suggests: prefmod, testthat Enhances: gnm License: GPL (>= 2) LazyData: yes Encoding: UTF-8 RoxygenNote: 7.0.2 Language: en-GB NeedsCompilation: no Packaged: 2020-02-02 14:39:13 UTC; hturner Author: Heather Turner [aut, cre], David Firth [aut] Maintainer: Heather Turner Repository: CRAN Date/Publication: 2020-02-03 13:50:04 UTC BradleyTerry2/build/0000755000176200001440000000000013615557421014054 5ustar liggesusersBradleyTerry2/build/vignette.rds0000644000176200001440000000045613615557421016420 0ustar liggesusers}RN0tZ 8@U/\PWކU]؉p)AHXZk홝}د XʲYҌܬmFvKͽdToھt_ `$(Q_E4UVсE+O/8$.Wp-W? 4X$WAءr =v|oå=(|3F{՘:u]:c=8Pn/9E-]=COܱ g)_q.l~jܤgG2߹5]9ON*XHшrg) JZiBradleyTerry2/tests/0000755000176200001440000000000013615334374014117 5ustar liggesusersBradleyTerry2/tests/testthat/0000755000176200001440000000000013616022414015745 5ustar liggesusersBradleyTerry2/tests/testthat/test-predict.R0000744000176200001440000002311113615333555020510 0ustar liggesuserscontext("methods [add1, drop1]") tol <- 1e-6 ## some awkward cases for predict ## (in response to bug reports from Arthur Spirling and Fonti Kar) ## Case 1: The final model in example(flatlizards) Whiting.model3 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards) ## add new lizard (54, 59) lev <- c(levels(flatlizards$contests$winner), "lizard054", "lizard059") ## add features for new lizards (excluding factor variables for convenience) ## 59 has missing values for some model predictors features <- rbind(flatlizards$predictors[, -c(1,18)], c(1.5, 1.5, 1.5, -.2, 3, 1, -1, -1.5, -1.5, 250, 2000, 1, 0.1, 0.2, 0.5, -0.2), c(NA, 1.5, 1.5, -.2, 3, 1, -1, -1.5, -1.5, 250, 2000, 1, 0.1, 0.2, 0.5, -0.2)) ## alternatively create new data just for lizards of interest: lev must match lev2 <- c("lizard048", "lizard052", "lizard099", "lizard054", "lizard059") features2 <- rbind(flatlizards$predictors[c(27, 29, 56),-c(1,18) ], c(1.5, 1.5, 1.5, -.2, 3, 1, -1, -1.5, -1.5, 250, 2000, 1, 0.1, 0.2, 0.5, -0.2), c(NA, 1.5, 1.5, -.2, 3, 1, -1, -1.5, -1.5, 250, 2000, 1, 0.1, 0.2, 0.5, -0.2)) test_that("predict on original data same as original fit", { tmp <- predict(Whiting.model3) tmp2 <- predict(Whiting.model3, newdata = flatlizards) expect_identical(tmp, tmp2) }) test_that("predict works at level 0 only with new lizard", { newdata <- list(contests = data.frame(winner = factor("lizard054", levels = lev), loser = factor("lizard048", levels = lev)), predictors = features) pred0 <- predict(Whiting.model3, level = 0, se.fit = TRUE, newdata = newdata) expect_known_value(pred0, file = test_path("outputs/flatlizards-pred0-new.rds"), tol = tol) pred1 <- predict(Whiting.model3, level = 1, se.fit = TRUE, newdata = newdata) expect_true(all(is.na(pred1))) # use alternative newdata newdata <- list(contests = data.frame(winner = factor("lizard054", levels = lev2), loser = factor("lizard048", levels = lev2)), predictors = features2) pred0b <- predict(Whiting.model3, level = 0, se.fit = TRUE, newdata = newdata) pred1b <- predict(Whiting.model3, level = 1, se.fit = TRUE, newdata = newdata) expect_identical(pred0, pred0b) expect_identical(pred1, pred1b) }) test_that("predict works for original lizard with NA predictors", { newdata <- list(contests = data.frame(winner = factor("lizard099", levels = lev), loser = factor("lizard052", levels = lev)), predictors = features) # predict based on "new" data pred0a <- predict(Whiting.model3, level = 0, se.fit = TRUE, newdata = newdata) pred1a <- predict(Whiting.model3, level = 1, se.fit = TRUE, newdata = newdata) # should be same as original fit pred0b <- predict(Whiting.model3, level = 0, se.fit = TRUE) pred1b <- predict(Whiting.model3, level = 1, se.fit = TRUE) expect_equal(pred0a$fit, pred0b$fit[34]) expect_equal(pred0a$se.fit, pred0b$se.fit[34]) expect_equal(pred1a$fit, pred1b$fit[34]) expect_equal(pred1a$se.fit, pred1b$se.fit[34]) # use alternative newdata newdata <- list(contests = data.frame(winner = factor("lizard099", levels = lev2), loser = factor("lizard052", levels = lev2)), predictors = features2) pred0b <- predict(Whiting.model3, level = 0, se.fit = TRUE, newdata = newdata) pred1b <- predict(Whiting.model3, level = 1, se.fit = TRUE, newdata = newdata) expect_identical(pred0a, pred0b) expect_identical(pred1a, pred1b) }) test_that("predict respects na.action for new lizard with NA", { newdata <- list(contests = data.frame(winner = factor(c("lizard099", "lizard059"), levels = lev), loser = factor(c("lizard052", "lizard048"), levels = lev)), predictors = features) # keep NA where prediction not possible (due to NAs in predictors) pred_na_pass <- predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata, na.action = na.pass) # predictions for contest 1 should be as original fit, contest 2 NA pred <- predict(Whiting.model3, level = 0:1, se.fit = TRUE) expect_equal(pred_na_pass$population$fit[1], pred$population$fit[34]) expect_equal(pred_na_pass$population$se.fit[1], pred$population$se.fit[34]) expect_equal(pred_na_pass$individual$fit[1], pred$individual$fit[34]) expect_equal(pred_na_pass$individual$se.fit[1], pred$individual$se.fit[34]) expect_true(all(is.na(c(pred_na_pass$population$fit[2], pred_na_pass$population$se.fit[2], pred_na_pass$individual$fit[2], pred_na_pass$individual$se.fit[2])))) # remove NA with na.omit pred_na_omit <- predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata, na.action = na.omit) expect_equal(pred_na_pass$population$fit[1], pred_na_omit$population$fit[1]) expect_equal(pred_na_pass$population$se.fit[1], pred_na_omit$population$se.fit[1]) expect_equal(pred_na_pass$individual$fit[1], pred_na_omit$individual$fit[1]) expect_equal(pred_na_pass$individual$se.fit[1], pred_na_omit$individual$se.fit[1]) # use alternative newdata newdata <- list(contests = data.frame(winner = factor(c("lizard099", "lizard059"), levels = lev2), loser = factor(c("lizard052", "lizard048"), levels = lev2)), predictors = features2) pred_na_pass2 <- predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata, na.action = na.pass) pred_na_omit2 <- predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata, na.action = na.omit) expect_identical(pred_na_pass, pred_na_pass2) expect_identical(pred_na_omit, pred_na_omit2) }) ## Case 2: model in which some parameters are inestimable, e.g. contest-level ## predictor that is same for both players (interactions may be of interest in ## practice) ### set seed for consistency with historical results ### (when sampling predictor values for new hypothetical lizards) suppressWarnings(RNGversion("2.10")) set.seed(1) flatlizards$contests$rainy <- sample(c(0, 1), nrow(flatlizards$contests), replace = TRUE) ### "rainy" main effect is inestimable example.model <- BTm(1, winner, loser, ~ rainy + throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards) ## create data for 4 new lizards (sample data from of old lizards) lev <- c("lizard100", "lizard101", "lizard102", "lizard103") newdata <- list(contests = data.frame( rainy = c(0, 1), winner = factor(c("lizard100", "lizard101"), levels = lev), loser = factor(c("lizard103", "lizard102"), levels = lev)), predictors = as.data.frame(lapply(flatlizards$predictors, sample, 4))) # or new data for 4 old lizards id <- 5:8 lev <- paste0("lizard0", 10:13) newcontests <- list(contests = data.frame( rainy = c(0, 1), winner = factor(c("lizard010", "lizard013"), levels = lev), loser = factor(c("lizard012", "lizard011"), levels = lev)), predictors = flatlizards$predictors[id,]) test_that("predict as expected for model with inestimable par", { ## no se pred0a <- predict(example.model, level = 0) pred1a <- predict(example.model, level = 1) ## with se pred0b <- predict(example.model, level = 0, se.fit = TRUE) pred1b <- predict(example.model, level = 1, se.fit = TRUE) ## predictions (fitted values) are the same expect_equal(pred0a, pred0b$fit) expect_equal(pred1a, pred1b$fit) }) test_that("predict works for unknown lizards at level 0 only", { pred0 <- predict(example.model, level = 0, newdata = newdata, type = "response", se.fit = TRUE) expect_known_value(pred0, file = test_path("outputs/flatlizards-pred0-rainy.rds"), tol = tol) pred1 <- predict(example.model, level = 1, newdata = newdata, type = "response", se.fit = TRUE) expect_true(all(is.na(unlist(pred1)))) }) test_that("predict works for known lizards at level 1", { pred1 <- predict(example.model, level = 1, newdata = newcontests, type = "response", se.fit = TRUE) expect_known_value(pred1, file = test_path("outputs/flatlizards-pred1-rainy.rds"), tol = tol) })BradleyTerry2/tests/testthat/test-add1-drop1.R0000744000176200001440000000223213615335213020704 0ustar liggesuserscontext("methods [add1, drop1]") tol <- 1e-6 # flatlizards GLMM result <- rep(1, nrow(flatlizards$contests)) BTmodel1 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + (1|..), data = flatlizards, tol = 1e-4, sigma = 2) # add a term BTmodel2 <- update(BTmodel1, formula = ~ . + head.length[..]) test_that("drop1 works with GLMM", { # check against expected values for single term deletions res <- drop1(BTmodel1) expect_known_value(res, file = test_path("outputs/drop1.rds"), tol = tol) # check against anova res2 <- drop1(BTmodel2, test = "Chisq") expect_equal(res2$Statistic[3], anova(BTmodel1, BTmodel2)$Statistic[2]) }) test_that("add1 with Chisq tests works with GLMM", { # check against expected values for single term additions res <- add1(BTmodel1, ~ . + head.length[..] + SVL[..], test = "Chisq") expect_known_value(res, file = test_path("outputs/add1.rds"), tol = tol) # check against anova expect_equal(res$Statistic[1], anova(BTmodel1, BTmodel2)$Statistic[2]) }) BradleyTerry2/tests/testthat/test-flatlizards.R0000744000176200001440000001051513615344572021402 0ustar liggesuserscontext("data sets [flatlizards]") tol <- 1e-6 ## standard BT model, using the bias-reduced maximum likelihood method: result <- rep(1, nrow(flatlizards$contests)) BTmodel <- BTm(result, winner, loser, br = TRUE, data = flatlizards$contests) ## "structured" B-T model: abilities are determined by a linear predictor. Whiting.model1 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..], family = binomial, data = flatlizards) ## Equivalently, fit the same model using glmmPQL: Whiting.model1b <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), sigma = 0, sigma.fixed = TRUE, data = flatlizards) ## Same predictor but with a normally distributed error Whiting.model2 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards) ## Now use probit rather than logit as the link function: Whiting.model3 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards) test_that("standard model as expected on flatlizards", { # check standard model # ignore family: mode of initialize changes between R versions res <- summary(BTmodel) res$family <- NULL expect_known_value(res, file = test_path("outputs/flatlizards-BTmodel.rds"), tol = tol) # check structured model against Table 1 of Whiting et al. (2006) # (for coefficients of covariates only, not separate lizard effects) cf <- coef(summary(Whiting.model1))[-(1:2),] expect_equal(unname(round(cf[, "Estimate"], 2)), c(-0.09, 0.34, -1.13, 0.19)) expect_equal(unname(round(cf[, "Std. Error"], 2)), c(0.03, 0.11, 0.49, 0.1)) # reported Z stat appear to be Chi-squared stat expect_equal(unname(round(cf[, "z value"]^2, 1)), c(10.3, 9.5, 5.2, 3.6), tol = 1e-1) expect_equal(unname(signif(cf[, "Pr(>|z|)"], 1)), c(0.001, 0.002, 0.02, 0.06)) # check equiv glmmPQL against Table 1 of Whiting et al. (2006) # (for coefficients of covariates only, not separate lizard effects) cf <- coef(summary(Whiting.model1b))[-(1:2),] expect_equal(unname(round(cf[, "Estimate"], 2)), c(-0.09, 0.34, -1.13, 0.19)) expect_equal(unname(round(cf[, "Std. Error"], 2)), c(0.03, 0.11, 0.49, 0.1)) # reported Z stat appear to be Chi-squared stat expect_equal(unname(round(cf[, "z value"]^2, 1)), c(10.3, 9.5, 5.2, 3.6), tol = 1e-1) expect_equal(unname(signif(cf[, "Pr(>|z|)"], 1)), c(0.001, 0.002, 0.02, 0.06)) }) test_that("GLMM models as expected on flatlizards", { ## The estimated coefficients (of throat.PC1, throat.PC3, ## head.length and SVL are not changed substantially by ## the recognition of an error term in the model cf <- coef(summary(Whiting.model1b))[-(1:2),] cf2 <- summary(Whiting.model2)$fixef[-(1:2),] expect_equal(cf[, "Estimate"], cf2[, "Estimate"], tol = 0.5) ## but the estimated ## standard errors are larger, as expected. The main conclusions from ## Whiting et al. (2006) are unaffected. expect_true(all(cf2[, "Std. Error"] > cf[, "Std. Error"])) ## Modulo the usual scale change between logit and probit, the results ## are (as expected) very similar to Whiting.model2. cf3 <- summary(Whiting.model3)$fixef[-(1:2),] expect_equal(unname(cf2[, "Estimate"]/cf3[, "Estimate"]), rep(1.6, 4), tol = 0.1) ## drop lizard 996as coef not estimable !! should be 96 abilities <- BTabilities(Whiting.model3)[-55,] expect_known_value(abilities, file = test_path("outputs/flatlizards-abilities.rds"), tol = tol) resids <- residuals(Whiting.model3, "grouped") expect_known_value(resids, file = test_path("outputs/flatlizards-residuals.rds"), tol = tol) }) BradleyTerry2/tests/testthat/test-BTabilities.R0000744000176200001440000000400513615335152021245 0ustar liggesuserscontext("implementation [BTabilities]") # citations data ## Convert frequencies to success/failure data citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") ## First fit the "standard" Bradley-Terry model citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) ## Now the same thing with a different "reference" journal citeModel2 <- update(citeModel, refcat = "JASA") test_that("BTabilities works with changing refcat", { # standard model abilities1 <- BTabilities(citeModel) abilities2 <- BTabilities(citeModel2) ## check abilities expect_equal(abilities2[, "ability"], abilities1[, "ability"] - abilities1["JASA", "ability"]) ## check standard errors M <- diag(4) M[3, ] <- -1 M[, 3] <- 0 V <- cbind(0, rbind(0, vcov(citeModel))) expect_equal(unname(abilities2[, "s.e."]), sqrt(diag(t(M) %*% V %*% M))) }) test_that("BTabilities works with sum to zero contrasts", { # specify contrasts via contrast arg mod3 <- BTm(cbind(win1, win2), journal1, journal2, ~ journal, id = "journal", x = FALSE, contrasts = list(journal = "contr.sum"), data = citations.sf) # or as attribute of factors citations.sf$journal1 <- C(citations.sf$journal1, "contr.sum") citations.sf$journal2 <- C(citations.sf$journal2, "contr.sum") mod3b <- BTm(cbind(win1, win2), journal1, journal2, ~ journal, id = "journal", x = FALSE, data = citations.sf) # results should be the same expect_equivalent(BTabilities(mod3), BTabilities(mod3b)) # check vs deriving from model based on treatment contrasts M <- matrix(- 1/4, nrow = 4, ncol = 4) diag(M) <- 1 - 1/4 expect_equivalent(BTabilities(mod3)[, "ability"], BTabilities(citeModel)[, "ability"] %*% M) V <- cbind(0, rbind(0, vcov(citeModel))) expect_equivalent(BTabilities(mod3)[, "s.e."], sqrt(diag(t(M) %*% V %*% M))) }) BradleyTerry2/tests/testthat/test-countsToBinomial.R0000744000176200001440000000106213615051623022341 0ustar liggesuserscontext("implementation [countsToBinomial]") test_that("countstoBinomial works as expected", { ## Convert frequencies to success/failure data results <- countsToBinomial(citations) lev <- c("Biometrika", "Comm Statist", "JASA", "JRSS-B") expect_equal(results, data.frame(player1 = factor(rep(lev[1:3], 3:1), lev), player2 = factor(lev[c(2:4, 3:4, 4)], lev), win1 = c(730, 498, 221, 68, 17, 142), win2 = c(33, 320, 284, 813, 276, 325))) }) BradleyTerry2/tests/testthat/outputs/0000755000176200001440000000000013615344566017506 5ustar liggesusersBradleyTerry2/tests/testthat/outputs/add1.rds0000744000176200001440000000046513615034363021026 0ustar liggesusersb```b`@YD1HAIGGVބi`F.L]lwե[xX@94k^bnj1!"\XY\ `rIIh8gdhX 3 &_p$$-DY_~Լh=X0{pj ;Huf^:!b@TԢ\Ĕ̒b.o~JjB]IFQ~b^!lm1T@PFAOOSAfԂĢĒTĤ>ɬJ,J14rBradleyTerry2/tests/testthat/outputs/nested.rds0000744000176200001440000006315613615344440021505 0ustar liggesusers=|r`2I @ {)8؉ao.(-3eU(\أ7¦(P|-u@{%=N^';94xr\oƖӊn|=Ml Vۜ#rCn܋{?^/}r+b|_/> ;]{xuX**|ສqJbXe.Vz+ UުBo5:z(3~_̱rv8w#mV6ṼϷH<2|sk3k×I[s5q:w?מh6]\d?jch7LRt}n9xuM)`5OO}91wwoEsێrV VzͲo~{gy].a`3-Fm '\ 뻫wlbmG܀6?vA9֮~?EBg-wsOm^@XÀ#"rӿo1\[^6|]޶5eleD2R2R2R2R2R2R2Rt2RhN|q9 UUUUUρ\) (KWC7s8.yrqmCuʕׁє; ힼpAhGxZ}3swzoiW Vut>gSM9wøN^;?ɘ~{ΐ@W#sO. ͘:}9I:m~̣W^eJ9C/Z2 Sy4 >uOr9Y /2Zه'^\iC..wIsu|#mGJʸ~4v<]§% ѣ#p_WfUU_4{|@(@D_k6Ӥ٣?ob6p-Iɧዥ>U=^p>ء`~>P9`;Tçu{L/&5ς7[hwM`|,:F) n\zgxiz=&ťp?<[DLׁU.<}㏛v=Uߥj´Voꗷ;@>3sGKKu\}Sk6Kށ˩;TP^dY[ܣ-5{moJqRn]cwRwUy'=']Ý+>ӸI+-d4z{;IݑT'=w[1u1•o:UlͻՌ~ۯjWٴa}/Oq{ /ݭW}\Ns y꼹KzzJnƂSvuty`j.TˆR3pV nИ wb<`|Q5-{\R2S) Z6m':/o E#G,zwxWl +]r o}K}iSQ¥d@?*ң5}yw۽~vxdۚ yu7>OX=xZ9y R{5 y5b[Us݅)i_@Z#@mד-1[k>z,mڼ㷹f^z^UsǦU:fD5nmr蛃ru}y KTm̥$4+knO 9E<(S#~Q#:Ôwk~3?g2MM`p4y?jy90RLg4Нؾ~w$<[7ǥsɽǦ>27Ivr;;m1s:rv)ܣtK8xni+n~ mʗ;'9mi\_][nu3}0z&|իuC-L?*B߶[r[v|օ[^-<\]˭agIns4m-CCz99[wӅ7-wYw~oe48)|V-܆9kLͩ=RxBudꊅy⌓O[SZ|Fw'6oIX~f"\E #'s]ٵ .2u +GvRU5Z͖6Y%a=yh$ 8C՚ȭJZU܂r]Cnp` LY퇪]'g)4WS.M^?vp/X^bupy/:)\oK_ح1W}MNpſ1kI6˰3\aUn} pj45t*Z=X'_sgB /|.nO~zq=ප_ga r 5.8!$}=Ez*QoiVpG#].t3˳.5E+_(yyE^+LKojTz^ W;; K~@!ݸ{x(ضϕ_qss ])=[a߮W .nNG?=il8JavFoNhތ?sF(1&x}88n_}>)YC[:%gcow.|&{L:LupS'Eg~^mϝo :ul!Dh0n@"HHxQ2j/}7FR,fؕDr*}o"qīid2DeW\b:*KIxE_xG"3ÆM}]phn{.P ^H.}?oĥKnd<="=aj7 v{/y>2ڳ|q*T:o7g޵9^^^<5|ָ×^#&$Yy3\n? '|.zo 64wUge8߯G]w 痏 W&G{\8ޞE'*,_V'|T!"wyKIyO^GzﺠHxJ!zF|~_ÿrq슄fo|ͦ7,\%[ˎ䙱~ۈ2/":6{TYg6Cቱ]7.Oopܚ"|]o >~[uf ݻ]zSDnN*z|w<[Owm_/HV wo,*gdnX{U}Y=s_ 3.OI VPg/=;NW!^E&^@Ʈ0=σIk0OWڱ ;)Iag <|Oarܖq[ [ؽIxz^ h2 gK'8 S(09aCmw=.[ v2~ ݂tIø$]<5$|x_ هz;#-ͤad0n /%ҵW?[tId٠2.N+qP.FMMl&Q_}'KoVY=J=_>?~sy+z>2+OV[O+Ӈ>_~W禟ds{>_KÌ&,й)t:Uo5" I+2u!?: z6NgN7&³BR5v"\bU:=6c>, kN&-'s{#)(woӐXE/e,j6ZR@.J\k:%!p9Eiq ^~*FT#.XKh*cIZm|]>Fl|˛:>u|yl}~^:>D񹯐`H}k1TB7,;Wq|+:a7ozp|M^7oz:fq~K9X^*&Ne]c5UzrWXNГUiJ!C*2+Nqop\C ȯGʐYc\ cb~RϟMT RP@N6aV7ĸucX j2Y.Xac)ΏAPK S~lP.8ȸBǼ1Cn>4(- Qr 8McQzoZ( 5@^Rn] tW/7@ 8ei*`*va*\jS:ByAO`*U Өi:g4Hu[˟M}lM42 ,K,K36Ǻh-)њM[0n;ۑqb.8q|w`*^סhߵq>5ik8-[,CTq:h=Da7уC/`~g|Z}>@u A)=ǑbNSts>!" CpX)$V" "S3 ĈU{mb.jFϤuJHğ!Z̖Pnv _cK,GfxJ TcnMP nNSYNbP`zKa*%]i6Ʈ8b!!NgP!Q Z RuyaR+LqJQ&%!$[] Q'4|㘄y FVƊhCJ;V+=kZe.Ih 1WOC٘6  G~;*hnr!زJ)$Rk)cj /^e lQ2#]v֪ Kx\ꪋU͔̖oQZe<5S&0BX զTD1Eۛbͩti&zQzj Br):JCWRc x2[IHOiY0zw93Ps+NP14J i@k],{4Vں!oT`urY9?OT!H.&p-MM+4?66@TG{aW!3ɴ2?A(T$|' }%\#t?}r%3ː _k8dŰ8\JcQ| q O74~6#7nC9@=XQ eXWHMZvꑷ٨GBc8d|j⺨2;_ؗ4~vLu˪>&$?%L_>}٥0gcf;X\d[ʔIuX}y? -1ff5I6\<(2w<%KʋmD' ԓY5&69Fgg,քEZKf јsMTRb`1ak;2D<Hs=ҭZlHhfHlcm:$#fU7'+|3=Y.LI\)px`D8H[aoP)(* $05 HAi (CAY (OA;U쀚V:%b@RPh@34Іv6]$%1'8lS+C H+3pWB%ܴfl65w>7ܩ^$9Z!P]lձx,CE{Potm0=c!Z^:+T!7(-h SAQMkˉH5NWdeB|50'aWl3#dnLA\+ieXiSMTTh<$2Kd0e,đ⦊Q EtV|fyȌ>Y0li!V20H]ImxqfE6{ZM`MJDDths)'^WkjcXMoJ;ϲreԔ;7;bdd$5ӦAZ4Б)NďZj 嫆QOJGY=78&tM)!+3i '*Æ]Ir:/G'2G#'4Frv@]`̍Ob1vN=ȣUY,zuh*Z'goeDbo-am/8#_#{-Z ]b`52°蹷É U1)rSĪї3tycu^߅)}n wr®+GDD?Z Q)fkL a,v$P!UjyVV[]AdloA:\kCJue8礯a$~l|>iFKUz)L.V #᤾f'zzUG)mN\[Ɉ1 >yd>}ܑ9Nl'%?.L P03w#i_Ǵc15kHT)~է0G6ZkFhi#|oN+ER7s?(-+f3f%F4'0{b ܵ jM/4yH^x],͟,ɋʼn+Q 6bB(.S\JIrN<.QR+kՖ'V %ShfT>;SRIWD-f-Z5d=2Ig]1UKe-OH1{qVҙd+fݤֽZzj7@UԽEH:>](hSK2z?ˏicƏiY~,?,f93 m B&hVgYz#,gs!W`}U˱X2e9b#_k5H^rBp|IɁzgN$&Ofz,Nd3yVi :LsǶ ^yQ/3sgm[cvԡp[F`:Nb4ZBiݡtraz,ݒE#2gBjl8!C+/7%?s%UcmɞI_eܚOwe *L +`J >8F ;ĸqpWf VDJ+(Y>x$5b:RPI+Z[K Xك#Pu@ P(D` uJ69h?=Ѱ<:R/tJ.zcN?LH|f!NOǫ. uSs^xG"3ÆM}]phn{.P ^H.}?oĥKnd<="=aj7 v{/y>2ڳ|q*T:o7g޵}}Wñ{,n5en׈ {V~m̿6f ޛ~.p7 x]Y;z8;Qs{G41$~gQEI ˗I7&Uh~[uf ݻ]i^i귃sUyO"pۿ^D/& X:9>Uݰ<W]\kq'3b!F*3øq-Mn9(vRD(!*2rb6v=y~L: g]]!~ڔԎ|MI . ?S/lL.wb ;\ w0>,H}<"s 1> O7>r{Y&#<V~~* > j\,!tٚxU[c#OjL%屨!Rxl>K&oi&ï ·qx)]>v³٠Q8/ ,[Uuq*^r5j:oe#|H6R=dV_~Q_Yy?~z_я>#>7|h?%M?-:pnjX3 >FBXe.Vz+ UުBo5a%A?dh>Y&]$#XY ̀fwx- 3Eoo'b;5d0oQIk.0IIQEra-jUƑEVp} y2szVO;ZWԋUc X4{Oșb^$`vq=BӪHОZM%Ĥt$֍P.CbƓU9iD}ƈF}kM8BGμi*P:_aa,&oH$V^7S*aTьx\ ^&r5P\ν?@nlY<^?1䖽_ϽH-qS'.?qe?zÝ?Ww~AU/E /xqiz7 fec<|+7WV>6|雴.oۚZű VA!+Eo]}4X_[1]uq΀C{לseF_& |"xծǮ'ֿn TZdSxreirw'Upo;G Zt=G}ѹW?i9F<:.f@xڔCĆ vzOSd%!Ǜ] Sݼ\{vL!:J\@hNtvO^ #QUù;oUۺl:L۳a}'p/[vzqUdLncgH ꫑'fL 윤IsT?mV~/2wpvC~̡S?-igc੼O\sZ' }-/|ݡ{V夹:׶[#w%epe?V.SHY8+3**Iy{vf=> "/5iRQ7VK1KʖqҶSIv{BD8P0`y_~0}ӺOsOZgA-&|0_G>oЉK}BW}p.3N4CMKwzxvȞ\oZtٿXx`xi>MR5aZ7sjcG L#}ƥ_ߺg>&[y}+mN{=νSw$%× |,ɲ۷GgW[\k .R޼ݺR&Q̥sNWWZ}hEGv#wseNzHb`/p=bׅ+t,w=p{_=tw?xͯFia^^w [>{6+<.ys8Vw_-*ZɅ܊<{C||M?Ԝ]ĥ y73݅7S ~-:̛ho`kax9qۉNAŅ:>U[3ijDL{ViSQ¥d@?*ң5}yw۽~vxdۚ yu7>OX=xZ9y R{5 y5b[Us݅)i_@Z# mד-1[k>z,mڼ㷹f^z^UsǦU:fD5nmr蛃ru}y KTm̥$4+knO 9E<(S#~Q#:Ôwk~3?g2MM`p4y?jy90RLg4Нؾ~w$<[7ǥsɽǦ>2ً7Ivr;;m1s:rv)ܣtK8xni+n~ mʗ;'9mi\_][nu3}0z&|իuC-L?*B߶[r[v|օ[^-<\]˭agIns4m-CCz99[wӅ7-wYw~oe48)|V-܆9kLͩ=RxBudꊅy⌓O[SZ|Fw'6oIX~f"\E #'s]ٵ .2u +GvRU5Z͖6Y%a=yh$ 8C՚ȭJZU܂r]Cnp` LY퇪]'g)4WS.M^?b/X^bupy/:)\oK_ح1W}MNpſ1kI6˰3\aUn} pj45t*Z=X'_sgB /|.nO~zq=ප_ga r 5.8!ͣ }=Ez*QoiVpG#].t3˳.5E+_(yyE^+LKojTz^ W;; K~@!ݸ{x(ضϕ_qss ])=[a߮W .nNG?=il8Jav8@|>ei\J[WjOJk3ĥNI ^'ft/>;}IWs['N];&.]+Ъ*9eNd^n؍Ȳ0)Ah ZEW5뾈ie<9X:_.Bpnjbg`eK.Szp\ opsϊs\ Jdnǥĵq)Rxr\ q)\șwKK᥯5~gȸ(.C-%ʼn莾WC.sۅ3swv^n*컓uY"q w"rz?rܸ2];n\U{Ԏ72ǍFǍq:V쒀uǍf:7Ǎ =7`uFf 9n\'y@,q㺝o=2;n\N.Lq]BND?PHquy7ׁvƖ,|Z.uǍl ;n\zǍ7;n\wܸuǍV.7Kqܸ=|7ǍRP 8n\wܸqݸqui!q!#vܸ.p}?]mJjGǍ^* q2PǍ"|xqx:Ǎqq=sy7g/~V;n\^<ǍKq]￾s|r;f|uuvgM;SObҧMs@$~E/MU0|~4C) 3Gܑ(d4f4}XC8{ǿn4Can v[ʐf6}+*nlsDZ94ʘUJ֓Χqk"1V]!3#&F'?;7Y U mHVB:!T<ڜ&Ee5ȗ_y4cBHH2C"MAdҨ)ܣ&Q8M$sR$λH!щ&&F${j'4[RGCxUSTIcIJmkn *z!BB# sd8P_Ѣ1/;򎾼/Ax+@=xXMecRXŋ0>y @XlfұKxCj8a=ڒDұ.)_f%~I9H~m)''"kl>ٿ?bB_*: [C=OX`dq,g09@!cD\ȱh8>YsrgZ0 X0{w9lXXB@9ebɠ=z+ B+Ԁ Go3u]b/O"" ͖eNEP$' 2/ v 15'L߹ehُoIQ: 0{T;ӆhZA4mȼ,8qgM5~ <4e~`QUӭq8 aa.i30saڞ64$^CCqA8 LGl/C2^م›<0-D%v bY cpzkWC+c(=pZ9NӖIJw=x!4ȑepr%" SYL]7[0VE1PJO(0q=Y qB)H1>-*؏BTtY '2Ca@0:Q]zl_HO"zjnD@)좴Mp9"ُR!c@h_vkGdOh]GvȀh(]x1@hwpb(Ry`#1Nlw3N0_u_oUP׉!'hM0-0 8?C{!|5oi1?ژWu'@ԡi1AQT=e#b2| 괅<`9~r,2?ȱ˱q)7dWJ_)YW`^+ <= xDUjL-uzWJf˾ ښ8SoNL~`0pڭ8_Epwb]wz}ٍqa} T~S$I `b}W3!\ (Uv7j3.TL뤁VOL uWvK!;:Lj."0{q&e!n$04k3 خo`C/(zD;XKqd&}G˒!럘 tu6Ҵ~B}v;ֿ/fx"$(!x6T&Lj)Q}BKri NB 79Kpȡ҅DQh )V(q&zFcXޮ@so K,),>`d>TGLc?J D49^Ua^݆=$xzlK͞T3sM,1gZdȜx1<ޯ\uתb$B"V,d ;(Mojl${cCy$ҡaPR9 X[o㫣Q)Yeג³raRh '*5MbUօô~\u1\Pᗲ+ʾ$iP:<5&|Ǖ`M 4h <&VFj1ePCm36оBOm=Vn1YJջPć$u*wˮ|>YTvZ:IY[V_mb z5HbfhɥK^+W`Yk+u'ǔʧ(?k#K#l諮 }Eq;ɥ҅(I!M )Vb= 9LiM+ULl} ^nb\Kt]Zm gb7VX͖Q# =~J#NX"ANEv%1Tooj[ds` V۲6跔PՆVŌE9qn%l'K!H^JBBƭ5^mt9HCV+Vv^֬=by_E RK8OgiN|:o46Nj}~d} I`} ŴNv!Wwa|Y6ka|5tmL_m `51rS*T\G-W&$*b?BSj)ě [EʚN$83MVߣxVjæ(cGܣ593F[f;5z[ɗ9Э 3zg흋7Z OaO"T쟊c?)x'FR EdYh gUji%Ѫhc /_^RGi Rd+ڐ+HAV+qmR.ͯ?G)e?EVB%fk*}ٓ J!VECtUaٓ/Ql~1NM'jLҷE'v|C < ɞQAÐ-lY$PH$(`պ-G jhm:5ZB!<91@XPX){rqV2~N&mL*sĕA"~NMwƮH6$GCL;h:&\G.xԧV^nġ蝌Zs3(܀X0 o 2aELj;=]/zb7'vs`3I+e+@'}"ebeJ$`!k_F٘n^3/0 Iɿ P*`|~rK5d3_ C4I&#ڤG~TmmHz_T(P-b _B‹2rp8g\wU^(Jk]udbF/.H-.߆nykA#гAL Q8fe˸Ϯѓҭ L~`sRK0dh4t?f8OJ i-`a+n)ѢխM(QyD֣"9)l1 "`?Lecc 1'1#Ċ&8ۗ4 Q2<؅_w"حJu$}񳱼0Obv5xUq͂׋L>[IZ:$LmnMat7nboCLV!+X1 b'vj?;۰؍0@ˤ\Q̼Ÿ̏׀ЭOcCD6F]p&&zliO Ax`:VNj M(jloS_52&6nS6n3V-ef߶(WK[` qE8uYN&ZD'EX4"ovnv\ 7Ó;va%>{/_4@[ U L׉ֲcX2h%C0I}zRwZk | >]g?dփoD_NL] O>  K Q؍ɤ1QTzw #B<#"k0%SȘD7vb7N$2)bWcg&7;H&Ń$ p- ׋d276 >L|9—Κec]VE/YyCiY>̄V `!1l ?U@rdRٶM ჰ;:}V ltdxm7C;,s9bK^t ysJR >20w*yPa8̋ aT7A)'˔ HyGo L|EI1 [(d;}FKpD#MY8|;vGaw5vݰ;$ 27G47sD׀7r4 !+<м30L&}j,d`b& mR3Qq\蹇 sa!1oÅ< @gNg;y@^ | Ɠ"w> PZBV`8@ %(e) C9 wJ(NAe;V-TPPCU0 "m@} ~44Cs ZYn J@t C'z(}(Cb7qK4L_)b@#Q@c*$Nf`0vhL{ fӱfP0 @pR0O2 ' ~@`X HE,E ,ea90ۋ`% Xa=:JڀnR(-(*`8=L 8FQ )HppB,1\f2+*+ 71ܦ&w0ܥ`2{P@2ßQ0<=bo!3}j}}]moHBۻŠN?ZyPJ44^+&QF%ϲj;lĺ֓Y=~iͪ~2GKOV#[SfT*^vE?RzK׏T>~>7|n+718` M(> UUUUU1嘨8&j?=y5ً􎉚sLd.cF￞=܎D'Л6Las,uqscsF6gJ#&0#|9xka8 }J3~Qa2?d%Q?RIE z3h{ PjXS9QAPV6< Ʊ$w)kJ$L|=1DaJ? 'y1ɂs|WI&*q!^ptRSdS sӋcIJmW0]HXcc>ۖka1˖kanʳA}M>`w(p;:ke0tHIGive9I%XA`B82LCG|ߣ$Xcѧ(l$+Q~#PžY }Bs짎> #!ߘ[q_{a$rqc6*Fef+V6^KkߘDuVy99I>x@ / "4j&Rĩc`R#V?:a'U/ 7hD RGS($e1## 5E嵉4* Hf!^z<ԦEjZC3_bGi, M[Pg!ry+9bHG]dZg$'1` B Ӱɒ+ zݢ֕%=DצYu H I hua:t2>3NvI[(GL 0Crl6*7 ˨!lKw NN@E/UJՏ) p@hy9c~IG/܏b]c5Uzbe͇1`~gR MA4[ i {T?l3>8S8mLx:" fy ve8> 'c9_,$G'S Seˀ.[6$Cʂc? ]nbg5V~G֘^]0kN 3̓g=s(g@MGgF4#G {[7'#+ _ 쥸Y|C'aWl0V.V`,>Hs(hF5Lt -X^uytEBoVK2TT+Q y)wl\IDU "q2_]E%nOu_]Hх}+Ai2;JK[KpնotNZ\6jDOĴxHv@,^CGMck8}hO5PgVjtMU; * n$/ghתSCKU+ ^8, 덚G~c&6>!#|?2+=ھc' 臌(ރA닌"d(uˢ.ƾ&ȐS:O0`w)wu"8w`</_<|E b%?Nf+9G4"q"8}1Ǣ8(޴lŁiv!hlzEKaAvi.E8_ar8,V0NƩP,CNS VƸU[ V溷[0#Tߢr*U Өi:g0եձu`"XH cZnfoL6쿁eieiX-%²6J[ׇ'7AWZzGyiSF+!>m=}Z o&1z嬧}4fK[JBOL-r2.X3|frXٱ({.@?;ň $~FNwa}P{JxO9G\_C=G2ܻ&{>|<&ʡ8'.-dW ׾Hgc WB5+> KgeU/@8dLz43B~dyxb>ۏp ٧@?X_k7BϏE,"; 9fd)`}Zvꑷ٨Gv'SEM_ľ|W+,*/@G0IFg>&œACb& `rn)SF$] aAٟX6 ·3'_oBeϓrawe#)9H]U^D[G"oߌ٧0?;+eMZ4ԈĈ-# 6]kk`LC J.9X:#F):H.4L_oOW1"z!fz\瞹[zw9}NڴC~; ܏j  $0`P*v@M+P1D` u)g4GC hEhCA;`0|-(舡0?a ^Y<b(FZր˟)Es3m;4P}wwL>~ J"PyE+ɉZ UaRUz"V5?hmxO">U"{xi|>ziqPUӿv(K'H3E@Z~mHVmGy`N>p|4ڴ#9?EBC*$u6 g΂C<ɋ '3v7*ϜsOE5 i͊jDu>oTJr12^Րѓkb.j:6hQ{ƅLr{ə0fw6';NL F&ϱ$Fi11(Rm>8C:cBLuGL2O$k:2;㔠ſ#À:Z@yD+S4ԄLNubll2s 9:&$3!Dr2Npn^DuBK\4Jx:]ӧ w7!D>}@uּBS&|tǪ i#ۓ ;a`e0ʢ:A3BradleyTerry2/tests/testthat/outputs/drop1.rds0000744000176200001440000000034213615034361021232 0ustar liggesusersb```b`@Yg` o;X 0h'fKM-29KK2K2L.is&%B9\)%ziE@raW $(?D/0ZO/6S"j {FjbJf^:qb@TԢ\ԜԒb.o>PJNmTˀ 5 zz @mLfއBradleyTerry2/tests/testthat/outputs/flatlizards-pred1-rainy.rds0000744000176200001440000000016013615331152024651 0ustar liggesusersb```b` Bg`wdX~\CHY]WfΝ,4H%PAi%P&[q{tBradleyTerry2/tests/testthat/outputs/flatlizards-residuals.rds0000744000176200001440000000307413615060205024516 0ustar liggesusersV SSWE\ъ+KȂBOD낢b@T ,*V,n}An(P \, hiÛy}9h4qqR-+@br>Ye95WiZtm~"ɔȕդ,IJ:JeHњoV@w>1To -#7[Fő Nm4˟t Un4<]uEHF 6mɅb+?^«mD-94ͮʆu]#m@!{*R` 3Y+6,?gM W2&u yer[{g)QfGrx?y%4ݫID|0!Q rOߞon;HfDⰀyef: ⊩m;Vnkzw^?u'DخHN)P#k'HS »` ,R 29Ud-; &Daq,s[Q6b,%J;p4'"}kc(Z{d ЙmI'Dh[E,+JX/;&.^-R E=Ѥ\hc+;$+{[)ce,ji(8čZ'z10q L?8>BradleyTerry2/tests/testthat/outputs/flatlizards-pred0-new.rds0000744000176200001440000000014113615332433024321 0ustar liggesusersb```b` Bg`bGZݕ*|ە* H #P'fKM-22KLT=upBradleyTerry2/tests/testthat/outputs/flatlizards-pred0-rainy.rds0000744000176200001440000000016013615327137024660 0ustar liggesusersb```b` Bg`ϵ x"+ڿݹ[ũShw{5`F9@5/17dN,2يS@<BradleyTerry2/tests/testthat/outputs/flatlizards-BTmodel.rds0000744000176200001440000024273513615344566024101 0ustar liggesusers=<רhQd(RF堢ҐJ.{"JdQv1&-)e'ݼŽW;ߟ8<9=PbFQ1u3G(TP3`)'fY[N@ʹ63%&4u2H`lnnhMPxj .r1cdkkjkm`CEoankhc%M7* 3f̍RP$׵635!RƖHbn2gZX2c4DFe`P%9;0z%ex,V,c-hwU\5T0 ?u`4c߾{Ϙўk85Ço{yLm*0|W8yoAE8Fwfb0m-6#ĵ2`jޑ =klOCkRsc۽lm8RnYP 佮ô>?|/~Yez!~ۡR&<$P,a>Xz*/Ov,˔dHv1)=#kŰ+@xOVƒ? IQR$(!AR)J%B"($I&(LKXEGaRd$f[T lf[TU REI3$JK)/1RUHU#(F^8iሓJ'(NZJ֣8iI%AJH*!AZ#I*Q$$I$UB4ےٖ"(EP$ Iy *Du6!1B @ֶ8IA Vi Vi IJZBU+$AZzV$)z6 RuPX~ W=Y }^##Ѿ6"9Oez_1,T9opOJ]';WY G>V f\m.j4:AxN@7[=BP|@zv_ x~}%\ FD'(I˺A tV:A1wtI-J+e@7SɆrvQú]Ae'|VǠuoI>X ֯}/5:Tn;8vQxq= t0⸾Q_!|o痸޲K見xD/B>zY5Vje z27OwdFU%-.w\AEůTAM+=ޝ;UAIC96q.) QsjY%A_QL-=ZbdC:/*J{.}VfR_JD&<{mH׏wik"gvʁl97ǀ*n~u+i}3a-Btǖ5vB/\/})·9גX E+EG?:n殈|x/Ŕ%fpsqdidYЃ |8—{7]WF`i&l6ҏ;,/ ^ie.u!MOSi eXgޱ,ZnռkD-O}/4C,_h6 :1S= 40MHcZlA9rN-X;ݤ1i}=] /V0=/|>֋ՙ@ņ,>M9G[KWrh.b ٶWݰO,VEl|:.]8:9U']Lsjn@%b`y0%umϸ1%c :dwZֽ-;+EWr?nRM.?XʫN8#|UQr.iGEtnՑg/τ];ʨ.uonSFR0E6Zp-qD4m |,@ (GX#zPAlcWѦ}(g Ep^VD,ܸPZ5E<+VæKgQ PK ե\/f}n-5᭏_Nmw;,N\oO8Щ3DkW^d/>ƫڻw9|Oz>~33;,*1vnPZܲx0Vex/nlXQ!;ill36_6 &0OĉI9D0yN\a2йD +LN.2!2!S"dtF'qdt%#WLD%O ?12:!N&dҊɯ8:''L 2 ]$"AF 2e*AL%ȕ$S.dt$$2$SRdJI+Ev|<G~CL/OiBdچv0>g#SBd\L D9u>>w$:>Oasu8ph,i iWzLO1 ]ԕ+^Lw|%?47]?47?`e?47vY|O1 @P?9Ld<ּJBbŞ~՛`ߙҕMO;az}|~'LO;)_i= Ѝ;e_4J쇳ǪyIۣt7sٸ!N0f۽c|p.Rv[;tROgtς0g`Rqv*\m\Z޷%c>q;9Ocxi^z:Nby 3IlxCakޓi? U6AwQN{I&SUβy ݦ Iz-nI vMK=qGM~X^RGbU&a&`E]ҲjNJ<bƱlX8-%{i,%^]*E#:jb~ٍzJ8e._OE:RKp,Z}e="oS킺Ǩ/iO+MWOӀv+q|J6bS/Y?zL`U#i=UL?h#:+hy ŋ6-*aDÆ>'Y~{Ͱ|Wy-N[x H0ECצJ7QCo/iaZ^gs4W\K:"ǧDG~ig4C;yv8q J} _S9nˍǨm\;-Oؾ>X)cZ_*}9tZ80a=p:o9Sd('s-;8 mYI7fo!}[>~<}??!#4[q3/RV8> :ՙE WVV_m%nۓ 7gL4LAVN$#al2v#!'װ]r x8U 9+=)vAb~8-fF(J)y 6r,̎n\E4˷#K1jEYXV0%/G>?0ɲe0/[aU(}-[si5Y]NiCyĔ°Mc}}?4 e {h^(|vt5:C-֦,MLb;(q;p =޾\@.wREoN ^(u0IG|ʨO1 >_xlxH}EG8:>z8ݍva~a 7`"d:|6S}IX1wkobJ<KYz"y]E":DQ ճjK /{'b'ɗ+FY7+o;ah߳cf% 5X ApTۯn l5oxUna+S4`n!a #T f;8'\=уzOO\?>~:s8}#0k= 7]'HؿGÐxa]q>wW(N;+ ZH)<?ؓG̗П\.>5C&8hkAG>|NZw8$7„zDGS$`-r* S̙-kfc 9 suΏH!mY^h/ky2@ۻ7lzC\IBl7Tv|^o 9λ@X+`RY Om*z 8P[1[kqVʋ0֝dNȒ'?4WY{Zœֻ%d {?E8/$Fc{}lAWcgتw{S`> ~ׄp^{G 4tXq}Pc9b4|Ar F $ٯ% 6:~(?QL.t$ȅ'{0(oGAoe{QC:hzqXx<ݿ@B95h򪍊8ȫG ugzUt7XF5yapڃ8p~+Xr75ZjLB=,;# DZz15ja]M ]JX_2o0 Tq51?3[ f Ū,"w:L)kOj%Ö`?9@& (6&ǥ g*ٵڛ|u̇R6\㹝QυĆ;{dAUL׀`g4ޯNXM^pUtuцnbM֮D 1`gAQ>lV/-/JUe`cC-]ޖ=2T+0X*YL'`PD ^}k5ݴYp^spXFh+j "^n~BfdYa.ɥ YCWڧ r L޳Kw gfGݲ1ݗEp =q u!u796Sl,NJsK0q~#`P$n> ;g%˛bEr!bdۘOMtGnAMs#Et˂|p^~k'b(~9:رl/c7Z;˼x^+ps.3w"5 yf[.'h֮#KnsZl V!96[Q8(&+rXѬ7vXyamitDaṈSf);Mu3F0qg_0uئa~ oMRoDIR'+a'jEvufcnM Ar)t%uYth[_-1̹(Ūԗ=GvMgSZ01#$|@#Fz@m\\`nOFk:Ě+kdѽVJecsH킬FfƗ$nRF{: 8׻IT:2xr@K*? Ȇ"F].8OޛLR^^\$}ġs W xAG}4ǜIMoݢ㭆F_;'^wmn%ݍ{9m\W r81|㯍ij qXEp&+b9h/Ķ:/ߦ!|1I;b(xI@ϛX-Sx|ξWmoVbNßpnOC7?^c=U@; lI7 @-go<v xKdCP tE+j •g4T7m_eJ{hӗ5\kѼXMJGKǧF͙ڋ5OF,>mr5 K^ cKz?=Vŕ<ި<39N& -'#BCzݽҨ<7D^pEFXA{">KXggSu}6Z2  FDΟ '\@550`ȧkG]]*\. 342u3Nm KKxBlG<sy@#˟Gb)77vo>9z裂=ӵ}KGf`G0@#tc:¸TFܚ]@/6p&~+mbS3 {HLNſR`! N_D N+.#q"Bɳvn}?(nYoqfaea]o Ə?`/Yz4(jb.0Gen^Zk!ܖrG%<ōa~ܱڜ-p,?$S .RcT8P{rc~ d0{%/wp's>jRk 7aZSJtCmEQU^JFtg@ɬp4/#^e:S]2 ׇA{Mky'.@Q!W[c-XVHO \|mtO^5v$ /ES0:7CP^J0RJA]; Ou!f~HGtk4 ޝ5ۨ]Qr]fM"pxW] m;"'/GW*~jxRT~XlZ+u=8p"s9Tݝ(/TϾ7ZQY3c;逈t&ggB]AlY}H~AO',j/д~C?R=?qq_e:0jSw,O#WBE˿k"$/ &Q,h΅cv{]KOa* 3mxse9s%H1IvܣŬ!s+pÎ޿(`uzmsP ո8WYdus42xBPSG߃OX[yC:m9J'798XBQvzrm"(}9.4(F> b?>xJm>TEƬ̜Ie~|#'@ՀhrqRE ; u˫@}+i%08_8s Jmb~Y:JO$W@/Lj+aĕ:ۈ\ҾHoY;B_d)\', 6r$S}B[ެdϟ26-[wAX]I`U۰Ayen Ί}ZprM]ѥ7U# ΁bCU6Hχ bYwF\ Oe +j{cPjxai]+T2$酦7bً>ԂRE. B^r\z$ge**nf{/I'y9 zӒSڻ =U>k'HG jr2D;|y+ g-: ֔'ޛṣD)) >Y"C@ۏ%y>Jio}&">cxB~>||'(h~ھ^{D Q.{2>o)7"%5Yk`+ W(W%IEp(9~wfC|o'@a e4KjO*$#:&\/g+OkpVc 5Zuhtkz]3Ē ?x>n9Q|Z`Nb>\JyP:^NDzJpjw l ׻,*P'ܜQ;tOvAwVZ tꯆ5' ؃ˇZċ\JAWksk4/PK{ ܴf8zFSޡE>>zeGi=YCz?~wlxmh^_;:kZB.3U `Q:\p]e;f\Xx.Z1֫aᲛugB6@ӃcgO pxJ i.soh2,CpD&uAz`lwp23eAB`S9ֶy\$%y%qH~,78r(oj7(Yx nc zT+̆ YV/Ab?W[>Yjsc,=zN:o`2{{ [E+wv.y!u+7)6C{lnm{hZ yؖdR۟8>~/s<_@uо<ཋ=e*3<,ТC3q]kkc֘Q4_:1+A:{p#ٓr^sr`` gsubu7L9 :-?2._MvYrb {j/'~7p$;>E2?mAӎeߠAuOA,$vw|Q`zoF91 |5bZ{zUH% lSNyU ҦjlFǥ]ze/dfci/x")-5=P߉ϭIB׶_ksb|%5I>!S/;ilFVNM% ߨoPǥ >קg'S/5^s5H U>cPJ̸'%H2A7C]!P')hy^lE?ͷ-A Iv5lZ||ZyNt*g 7oz![P?kw|x|rk /#_a5x%M_ 㫟nho9 m_m .N0  ko^Bx{ųAŃG+Y`|o k/|`%|e:?-7$ԝTtʿ 3ֿ @amh.ag//Ԝ]~Yd]Tv[ZS%t{$bjJ獽`ʓ%^{tB0]W$G>xj{f,b<,gӯ+ &/>^|=0APxª_|nэA ϠWU gI*}{f\e~2lMMNA$tn)e]~o6EksÏ (XzjnU"Wg4'&)JYˀnY.zVJd _-"oɻS)Gnݖ4_|}7~1TTa{@DO\p$iri :M'sFpU8yq8#PfDոASK u4)ߪDyuz|zkz\׿n԰ՉC6琜/ic]|W`^@=+-8 ^?lօGVy5h_I'nç}!Nh뇳QNݿט :׻2q`/,fJj s<{όCf%YޖI~}g须0x% 0@rFLbpeʝr?ǎ2ΓIzvN4_~iZ˦{D*?)JRQ"X"Yj:lE|5Cyttil&6jqz>> +pgYSSTZ`8f$YZmEOpP; =*>NeىadDlw *' L WQ:uY~4Dmfyb׆߭^,Ps0}ٽ w<Nzw~H{g֥?1}bzW.XuVlܴ3 4Psz8uܼq]6µh")g'4,jWK%{ kϬɠnpUxi~n+j_xra-f졳~@çg]IUT6WaWQwdMA+w>Ϋ Qgi4A̩t|Kz&7ZiG<88CX:{sRwkלz+D|b#*HmsE{婸ɼ(/n: hiJ}/0ݫ8ABbX"*$! jER9S󦍥<#?doy/2[BC2mgr\?%yy.c+`wݗ [ZzWa8W3@=V-[`%:WgL/yVgXIcue$}|W#WFb<(OXPrc& D|9􂈏<Ł׵Scurkⓡ›i۪[/%T8UjWqEMox̿{^MٝL=g,nLl?ʅ)FW]@:\=YK^~~ v\&&>*<=TS%RUgp83] ]5|ĩ~Y|%ЇW= pX'2ctҔ/(2avP@6a6>.4=3j B8Yà9ő_bC%Hzb햴`=U<>gkTV'+ Lt^[]txzUq?JZR;.EB'cP' ?ҫ3>%};pHo<bDѹި繹X_f4l_.r Υ#E!0ֺqc+Q H\~C } GRWFI*,Wı)SX8֔$?ޗjDx0B}OgϭLMß0r½ 9)X8 gS=w8&Rwp\>)귏0u`4%Gh EFqVgva,c֔8z.솹!G-'xDe#Va{^GJ;IJ;U<ז9skH\v$I1KdDRvg_Ǯ:x'Ѹa{Ϥbm rbL^d'O6xC~ίD%WS$`NNjQ3"١(u 70%Td霫Dr_gB.OZsڳ=2zW߳Gvv߬lg,sZ$t>ښ a$Z*T>/bci ) e1|Soi* tS:\|?1^ٔ;[*x-c;Sퟐ L4f9.X޺JۻB%ڿHLN;B\xwVdx [̭C~]ήM0`R?[pC: >s-RڵvxaEP9ދpBʅ>5a~xn#׆ HKU͋{G6i.>7޿Yѷ_E??t;a896t}{}ZdiI)9s[#}z/p]oaa9oIRi]/Z@iQϥj秤Η#ye 4<~oTDSD%,>_$rp+F9(xl垯 1W[t䋔>۔b2H-8|&"+cG) 7=0ˌZ5c7 n΋t:\H RWpMPaz9{:MM{-ቈX$ޝ[O/j^U >|^ϻYX|GJ$ms λq _Ө_B/d+QwV*u : NpC/0+7{I 1oqQ2,j^˄=3Jt3_"`pRؾ$:XisLmDxxpo_N OK,8' s.GqK$trY fj$p/.~x5$ٛOl~Y=5ٰ\]!~O#;+I״{cW: 7:1e+ D܄V`dKtI8ؕf}E>*\T<<  [w?MZE NkwmC+kj$Ssi L^2UjKŒDFAذ=S 3o "AvS]l0,j,:XS<<2_$y`YmIBtU|XBI୷Qrh8Jʯ]dr<$'-̓)ϻ%uХ$*ҙ/OCfV"!*k:ϫR~:O9(nDYq|$'˅Έt)9m0ێ4ڀڂ+ @2n<3 }W^nt''/8yN &t]k|taKW̫p_p :_Z<(]\w2hu@X"Gq# 똼LH陵0x̫AVt7A3`Gmw<9`SÓ$II-XBsbо\T>La)NϹTe1bgkuW%W FzȳqO𻡫A&S~t>Jkݜ>v@Nrֱrc*bXKul"TآȔOT|Q` GrU3,ZC]lS0j*d\m% Wn._Mb+፮NAueSr 0`{7# Z: viP%y0p勣G˶ǴQ**R_]@嗧OeWz}3Z߂un|@1}~;p78脻ו*Nʀq*!JG]`љpP}CxvŻ(PUh8-ήs;_ Ň| $'st$80Wԇn2>3F%jHY-]<脠GîsCw=yI9TKOނ Igr]T nsDs ;]&n/xk y/gsK%u)Q;e y~_؅/K\Yn7b@nޤ62nsg\L #V(ݵ玴޺jA#YJ 60QQXq[e+u[>_Ew/ݚM;ע`֬%50/6:5$+7@83@==BjX%NsQ|KaWC-(”ß3a s;-:φݧ>- l"4Ϡ~}PII5A_E|2n3HP{F0M"}P^}q;zF* 10Y@ԙ[FSLât3d}{H{=([e+S/s>OlbROk'tIt]ɾ}r& /0U"'$L.~K3ECx ,.ez;>Up2䣨=}\_<#%tx[{ę_Q\2 vxI&-x fj{{tVg|thgO\4?gŁ[B[n{ K̠ߝvh s(+;eoUX٨:gO2" W@{.p0AzF$b-~}c.݇Wˆg|y ĜE҅& geg S廸 6hePK3V'N?"w]tN.T|V{UaB+9 U݋|ZG:?SM;̭CTwi\-;$!;$9nsL@U'|u`]s[ aQioC WXpL1p \ P A Dۭ(܁1vb^IO̗x'4d _A;`-+Bvd -1v. lKN9y&+H Y>KLa$`s8 *Z1DlIޖAz! Yw &C_CyPNGҍspX{{[|dK@{Q͸f}7(m<7 HWRY03:Nk+I]}z3x2h׿n EçSL W[L?]FP{{'-B; Vc='18ZKgqWUnS,umq't qȎ0nT0y}똞K vDtDʕ<_ђ:At85޽3,/}tL(4_USAc]Q|čVFZD@M "uAvLrP-;LnlHۙ%xzcV3!+?sNGVTVG lQ$9#iVo8f$S*+< SƧEо#{wK+2:kGIaǗP)|uP|@f~X!?81eoyIsThso0#Zrx̡_n`CJY^d^xi ;q:`y ݄! ԯQ:{=R.ë^*ZiM$b8u15ϯ7+ Hųf#kNxO*lF/ zВ<+^a.xiCF\`.AjEvE$Ֆ 50FQŁgy~|@[mLO:֛MwU p =0` MH>8s䝄޽ /}5Bߍ[m&3҉| fqJoS܆g{*A; X5,Z_X ]fk; 0Dtɽ'T7rkϟJ7GB]B_DI '|鹼-(oWQ!KORH㘟2v| аJ9CX=>$X-5oֵ߰ O!q;O.7⛚Yki 3$'m%T5 jΞLpp ͹V?-]\8XS45j3?8-9|3cw|_cs"x؅Q9]@۬Eΰؒ8I0.eU\;G?f%U͸;3,X8/o"o0QAϕ7\< %DSvCЮƾP;q΁"_@RSpMrڝ ^Rx]Z GDt[`ĥQuQ)j3 eQM$z9h:g8uƟ?篗eʵ FWyOC8Ǎ7ʘ0ԓfK5JKcZF>'J#[H7(+yo[> }ae2|sT6_܃AƩ}R`-C2aǷpbX:cw׶w396o=^*9d>(R4\|S: YsۨϵnXR V&%oz3IۛSX!f{VAI;@tGg'ٗP]r&~_c k-9|K|#k sNą{d9;:._XaMDDm?{9>]ya8G GG-;'W؄O Pzަv6a2ҙNI$X a0]ڠn+=Mt6W͋ `Cʬuo@ޅӥ߂Њ5MઔV0uyS͏aO&Lt0`U|ގP].X/ Lq *{)S7 H)K;.Ugv Gs帀OA*VUJ,%"M Q1í/G0OwiqMe9оz#U&pd5#DZVDMݶtʮs=CmֱV Gi );i p6z B^׫#úDHA(c͍CtCpZ_ԉŠҥ9'y yΘvD%<7Sϻm|F8kZGp*t5Xd,U{P^TM+6r ^/N[).a]xH!s27} coae֗fɖ<8/bw'|{%ޞm͸V y [̰҅QƓC=LhScLT=-1H×4_7O EˣRaŋ@ާrza`PBR@? W}%.x+۴9P,M }x^(w=;ؚ`% >쳦 6(zl,=l4[݄#PW%L uN@89`нiE"\AƎ|Y?WՂ bn{IU,O_/xymx:7Zʫ' N[~4_xmؾJf%FGD\{ʛpe|"w-j0 =I81qJVb#m>"J)a%{7y99p*`Ҍ9Y 7|ha?\&j O6aOi >wm ]]@zEJm.NgSs9_Q"sU-~9י *r+[Nx7$Rw3\đo,9sUQݚ~y@pmBٴ22Y+7], P$ w B< gs10>>p<{i^N,ZZyh|$.,U}> u9aWƱEgçT:M`%]0F=F v ū70extó.lוrf3a Xw ڦTW^^K?s,j\nޚ[7HeW㪆>暴"n\-i5{/%W]@2G"7}v> YP(}gsi>sRu1S(9 H Ń.lV yX߳'{Ti#ȵDR<K]AԆ$!@P8'RўaJX~%k'cU_HXq;DrhFΝI"{f_A[ 4f $[Z+Mj+IfFZpkX\*z+ȜA!5rdgP<xD| }vru=~ vWe3s<0~ C_LI!a`i u(Ӝ92n4 '`<4WM)N8ӦҞ u| 4WǬHl]vҢĞ7zSCn֍e={mRka=To4x|,sL4 'Z'elyg#E I/a^^mLi@alsLTu{-n3p-[f9 ?ԡNkp8̻vOlZ/WWĨm)O^wUyzVW]rMfiAJ3}3cNߟ-({ xW.cܑ3VщCx큤}y\.5ixŹdY\ L73g~g[=d:g~I0X3Uo~ٓwGtIjW$E8y^=Jv,W[͚W}7PZZݓ}e䁸mȢѓMȎ>~^c6p!(qwIGO*I~LR)2}bjo-ɶveb(v'^MqJR2HGK!oKַuxC ofgxC#wPBp -:p >|!|ˠ臚Y8 l?"6د]t{p0jfYwNZemixg& 4ܪQ}w7$[ʛPfu."MAx& v^[4H9au|N J\͉<.laʼnA6l&H72>xy`𲋅1 7ޓ@oc%o[aJ֥ *cL7DSM- 7Ae#b黝*Dt [~Я؞6U,</^xFc /?j?HeO_ ҤE wڎkvAE{wqVb#m0V_zy_F2"Ǡ3upD q/wat3a*V|/,,iȯT ]=fkm"`L= 7U .| 7y1^ ϟ</ٴ ֣jعIsG.5t}h*D)zZSDK皂|%R8TJqd0{siq'wr>~x? Z-IK?}6`>kdgb?[?c cke"ēDov"_zLәFMK9w.KE'Uy{ע S- } ̪OlO"/ˋ]w22l\xXQ;7e&,F0t! .ƞ_ prnbϩBM$p7b́;9@J׆o߱km0LƁ*p55߱$SyW&RVcZн}vߥT ڴw{_# o cġL0I~67{zC]`݄#p `۠-4 Nnסmysaǝ4Ƽ'al1 &?^UyN+iG9q =xlVgtnѵp,?XL""wT.,nSuK^v}vzlsNn kiS-^[Yw9d g,Lb 8oc>wglnue!N5z`iNkjtoUcvk\VyQG|88'yQI~)Q7+yQBvz{qa%.,ǚ-V UNe+-myߟn7ZϬ0s'\ !A Aº;y:u,Xz#Uo:^^?~ѕ˫n}"'~V_QbU"QPmJsL*/P;8:ɦ@K3ꋧ/Qf=#λia?}f_ jwBQ@+ZMx.ю@w."Mj3v/:.; 9kVhzk ߹}4QfX15L g9_<۶x9 Yy =Ps HըəI{ N^ җYzfz1@wq.$8nnh ϫ?d&{'˃e..]kJ9D3?Lƭ$%N{[ 8 Gq O7݆U9 ,{3.{b`q67zY&El. Y;_-[\B\tey3`v>UQ_Œ<4|a%JW}V9܅nlY}n7 򸃳΋@j)Ҏ\SLXP7.!LlnʘC zOC,Fb?:v%QS\f-pߖpٲ iX1Gze>yvlKĀUj-ŀvJ94#ݾr <:rsR䇍#ov)LhBgO0N:Lzafg#0C@Z4lsfm2 gb?_ zX [Vαdv9~} {MXcpg'۔Gޮ[t85.{)oтji@u'FaFdw/)Qp;+9jaZڛ0zΎ 8|dC [v2/>2Ն# ˜嫋AZa Ԏ;p3P bzApW!Qy``58Y .0܅ژ5WΡEgr<|*ޞ3 S'i\ɹڊo|Z(3$%9==k.BwA }RF8Y4ȸvxs 6-ΟF|qh/٬$ /Ajorԅ zŠ5G阀}{qsF/]F#/VHr:8?Zn^j&stXγcJZEzw_W BgKϾ2euKEdn;z.axAXc3S;UC'MY+:-|Z M՜KDZ}r&--j}>?E#yz@4*\;"i"zq8%%宪R|3A[9o ̒9޿xܮC*[` 'ߝ=iƔw0WuQ?h󎄝^3DqV1,g0GiJ)n`| A;ݼ|(8NiF_|wrk8C8C q#ń%>{wy>,fαaw7R`Uiϼp.fڿݟ;=Iƀ.msj7}9痊m'Mڍu3/р<Dt& 7!R; 9߃hX4I*sT,7y>mL҆sJ5۹gdau`P01ٶXƟTײہ[v}j ʍz3Fl,FËgz'NWm`ca;E\J:]IL[ȕP?76VQ@-ǺS˅IUr. t 7kK gX:J}Xt 0~G=AgZ2ēf8Xay k\Х qrW~9 W{+W8/{{TA @1 Sf*7ry0{LٖP_qxx}E3(‡ -G_Nà&NPM3RgPh)d*- K*44ta= WRU;_8%¦uOX^e?BKf)bT9K@*קsGg~}3> *Bѵt։ʕE ZO%&gL!CB0":L,Hqf*X9`a^.}?l90ķH(f| z {፯JG@řcgE@Aȵe B)epsӧJt}Q S.TWXdcXx~*^^ &S𥨲:v(^_uGe*N}ڲ;a9>Ьq[o@Eahn_ OpsCN%=+6O8 |ulqIi~h@mx=vWe'+f }Bpc^|G}|Z$s*5WPaBo}Ul$,h}}@6 ;tP\Rp/; pm+;o\^$TQ[8Fs{C h}aCM)f8R+E85 SoëwB%c70nind: @ȜޟGϖl<*yDo(Uʜj'HXmx˜vAM6xh زQSl8|GCxnTt)ui}xm*Ef=h3 U_dct |׃kb_@ݜ S_5ms݌.@' ڟ{y}0qhq x6{*v-Q*^ŞwљNR! ])s0:q'&qp~s~IӟKE< aK#wr/"GGp} fPpl fbo6,7JVL O c4fknui2DAvp4rG%Rarf/}xzCK0.Ÿ۔wTϮ˼oɲ2S JèػN0aҌfAib v.|_} W5 LiAݽ?|0̢G!ω w]12<[zü '7ofܽsA^8fk7=1,uj=`ي5bNJǪeE=wb类^f)o ^u]NYtuܹ0- ;V츼`/__[ S'pC˕/maRp 1U^Ɂ &q18k^y6VK;T]xkgpj '(773[`M^xJsc݄nibqw+. H%2_뮽/Y+7riqh VL\֙ \o`䦬4c|ղU5 G6,[K?4+veGbtp:7ͱ|Uԙ {0Xs p w6-={,M H5dҵkPd:]-PgtVk5's+Arw+KrP7@1njsTRCf=/&1BI׿h, lZ6:td${[ԽANxH K,bۢD9wxeX} _eS2W_zn7M4j 5vԟkcc| o`뷘i _ G×X9 x<7VB„"bRJ!AK%E_/I*C!Fe2Q¨ aT0*C!Ae2DP" T*C!Ae2DQ QT(*C!Ee2DQ 1T*C !Ce2Pb 1T*C!Ge2Q qT8*C!ʐ@eH2$P T*C!ʐ@eH2$Q IT$*C!ʐDeH2$Q )T*C !ʐBeH2PR )TA oEPsw;Z IЇ{"N N N \􁟀&#W ?􁟈#_a2r%S"dt!S"d@h1GFQ2rEM ?Q2#d+N&8#qr2ԑ8  2IE.dt SdT\I2"IFI2H)I2e EFRi})Tg!2!$F*WL"6ȴ!qҲ"SBd\L s! 2:s!2u.$AL%G΅$#Wbdڋ''c@p󨛏7X1m!e ɓ)Ths ~ʙVf^pV0 *S]xx Q~0`%xb>$ #w ng006}GP\ї{a ?Ϡuԣ Yofg9n.F0ccb+%i"vQx--usjq:-j%HQu|nuUpQ'4G~Xtԉ: :QuxvMOwɍ:!|φnu=/(: 9(#e6gFSsV/jk]s +k];GBv,= !=ńz*'[gZ4PRRH[][B@__h Oi7iL*G55E9wo[ȷ`!bOeh;"tYۏEsqPZ$ 6fFvcTHb-ێCm>pZ4ڪ)#eό{*NL<&D[#^Y gD~}Sosh#TLŀ̈́?uu^H^<4Kː<.E~쉺\6D;f?aoN\W!|W#tkxEv'D|!Da$Wd_1V%Zq^eۚ e ("rnMׄrFcXX'mc9иb~Z?f +K~.`"75R"򖒑Go+~<Wy}x27a_$LV\NB?wfgk,9&z  zR EЋo#C J:!s冝H;+h1لI!hhJ7^p Dxb[3KdKg& x?EǶTC4ES{9??#1f\7 3(^/|_o> ǿ$ ߿o3~a=%f6<و ߇,C!?oCEτ8|߂ð il!D;j$ wSL'/JObiXv`(S I=z2l&:DFV7IȘ9EƩl숏!Qg-3 M'm9r{5ffr^H2395DD`4 2̔5SMue;)#jk I{RS2V W s*Sl@XT>ń%wd)۳Cn!OCn@jb"5fb̤րY%z(=bkDvq٤+-Y)~f|k\͙+- O?st0?[ߓ7/Gf><~!,4Ÿ17OfL'd @OO~1G|MMTq욱cƉDm7Z4"wH; -ioqc)F>@P-Aw'7l~2ώ!u*ekjl03>؉}R\{Ⱋ3yNU 3y>Qv!Uz) |70$N) vؖ% DjVs uGm\S1 } $焱h0!4xL}<3Ɨ(r'/AOhfw`Fp8MX,ȕɷHg^2kK[ȼ̎ڮG_HajnuAg:ikflDbנQ^6D#B8OjYq!kM~`YNQrR{1HNgG~كV5?WqqY{eN^G֑DZcbfK7a}b&VfE+eeeeֲOD-&^š㒙M=>Iھ~1rJHL~v0̾v p5f=dȾzjw&5>fhkn.fhX]xq233g3pcb7a7g7)Q„(#]cS;kD~C8.4Ѣ߿mB7ln=iO6'>5Ϩf)>NjLwFީ|DֆZbyDX~r}O;XvI1R'h#$h#$4#'4^0xgAG&A,3GMJM"|la/Rˑ&rzKL0^\r')KN_Gb!ȴq<1O=!ӲNN#C`xȮ7-xYD8Wd:YTQ41~Gv ʜ&lmr֟iwtm#br዇ou/lZL{oB'>/ULG$>*W۶$IO۲^},5IKiÕI- WbȯMA ODhi1ӆ+RP*ӆ+Dy-?mrpʟiÕp7f S$kT;~/0dHl8r%y(1(W` Pi(L10p0?wU{!! $x)@ދHG@DR UHU bXPP 偂QTD)#"M:k }ljGhHcҙLBl|cMǹ-b㢼lj|rgóx9mߗ|@BB.:FsYϯ}xZ#G"]ާ ^LOso߮9R3/J }(nMLTx2`]1ypɔm=1M9{]#Ы_1(`(W}/, Uuz#_NєjUo{xfsW^fŋDtcgWO)sݒ7F=;W<-IX_Č_Ї>6檠ׁW ,"~m}S/$n:O7SG74+nmbE 6)-E[o|6Hc↤?7^;NܸܖSzm3W ĵïTi g#wN﯋[^Ȼ/#~5K5[^}87]5jUw C7]9i 巹S9w%n̬ Gk)7)ފ\߱FfM6?󴅖jެYƏm26A|pڜ?ZMIOf|[Ǝ-K7W6Bŭʮ(n{K]z/~ٹJZ,nuyX-?_qmv%T񓄗5޸Y\gI }3Cm@_kkz꠸~_u?Z\gޫ5Sw=S ByV*GPZՕun]qsJ2n$nXoSo/oįV3}ۈ?̬`oij/}7SnSmϽ#n:}٣(mM_ݲE\:btyH͊/')}K%8?ɟ.υO8?' XO4&47fN"_$g6G8 G8'#ppN8 G8 #pDA8"G #pDHI8" G$$#pD(E8G"Q#pD(E8,B8,B8,B8,B8,B8J8J8J8J8J8lF8lF8lF8lF8lF8 G4&ф#pDhM8 G4(dnDP9& rq;gɞ^ºkeޟX-'iu?ƮYo:V_oeL'd^hQ|xֽV#2 ofcYߋ=MRQN?&7?ųr]_ cuʔ߷>\1-$/5_x&zM]%ߖO3;<*+/d2|>Fzsg{,uu|fȇ o*϶'%-?VG?ao|`/gfyZ!o:Aw q2.o>˻T\Sl\tr-?=˭8( fcNo3={ J>ew{h}Ngp!q]K<’ǻ7Ov8#trvrvg|ɣyzv 8Lp?vųWOWvή)xޮAO9Cw P _??%-u'mZ+gxl9tۏ?iJ-'`W|tzorV( g/A`%Cߜ[vv`[ "̑>e>;7!ow>5΃ܾU􋌟CVWKU%\7Ԫ^ϳ+wĜ#r'tCJUmMM9{BBCn?nܯ[953pZwV~w+4yW ҲLi~)!+wo:4u~=x_];ⱟ{ݠ pWhRw!?t Rmvy0@+wVo:rΝG)]x)7^)]?)m~4f"I[)yo={r>徟oj"0G)?~r=7+=^]r/oן?M 鷾j:w׹+աSEwzyw'CoskP<a| MMǽ /q{'8Yonڷ=Ss;_=RP(tݯKev{_y "O@Ac)p'Sy ]Y<:)Cֺ4͐IqxSs n=*-vxfͦАWU~]5SOga5<ӷMISAv~xafV0krWz}AA^axXgg.SO7yὺߓzU;[wupq_!36IB4)U uם,puvFo79o_Oozm4c~#A򼸄89WN$bڧ'#X&ﺊGW믯px 5 *ó~zckkw:.3/[ÀxtjǡvP/U{vQxF2wĿ\F+ԩ=ї9cuZIAŸbfOr;s~S-^>yU3pLųã>l⁌{ixSi[~SO^C/xhOJWԺuIui_v,=/,>6|íkm5F3 "9`ʋG~jz&CG<8E<:}׋-+xHwGN*3c k?qo[{\vI[, |S:45wߊ+oQt)x5!:>\!?槔k&O{z, w1bf˩OZ"i!}!1s#{}qI ut-m[8ZF'8_kyQH?w; ɟlLN|.3lpEN?`?p<w8p O8ܛY8>Un{~|ŁCAA9p Nџxvsp|ŁC.o9M<ý- \Nr[.O8'- y 0ṕq wr~NAnד s;=ܫ.OwonݪϚp}' vې G { jvS8V{<~p;>o{ N8LBAAnG8p]r`%9~~^=Ew ]9=Xކ6 wCAŁC/8x;)e x`?!? _!m3~^oȯqC^ w J;+hxG nrp-wqN8p |ρpwg 'p)o=8h#8xnmr'w ܫ|i;|xU~)nzp?AAwCA>{`8dwg ރ{[?%_s.Jx Y|?d?'D(c?Vc?܄_8/Y蟕'#ppN8 G8'#pDA8"G #pDHI8" G$$#pDHI8G"Q#pD(E8G     +++++&ф#pDhM8 G4&шIλ@PĄqMD,ƠhC}ؚ 1(a 2b\ 7b 7E&Xp#p'Ŏ0a,vFRIhDD1F i+ҘW1(#QFR[[̱1Z-zb4..V#slF6#'lF"lF"lbیŎ6b6&6$!@(:fb2`46[ 6lZjƪ5[lZB.c՚mƼ5F{n1`.[*2ySb8b+SeE 9[YɅR f_ׂ0Q nde1i]-'/eIUV&(a+ϲxKIMĭ[øbRƦy):16--ޑGhԄONMOM6RS#M֓#KKVRٙdԔqaɱI2Jf(>baRI|Et-NxP皢_OZ34d_}HjXĔdGHRt?=5vh<!Kr#֘Z" +(,U22:}oaJU58࿯YqBB2JW. ,p8\E+p8ipWa+pUgIo4gxr e4#!/9!˲%ijAr@[Hq+6ȳ]?9}?qӄC< k@IÇ@ ª mo)lX؀h&`fB3] gyزX XEh#E` -h#Y,,llQlQ,aQ,aQ,(6S -baXzh-lXjtXY:,Z+ʢ<ŷXllim,Z.&fsQ gҚVVJ3[s؊2ef+V:2V:ˤytwS@G7)8Y*Ҍ vB{+q@N6."ڳ\UW׍Fq5]E8 8ˑy$wŀkp-Nt8IPXٵv6K t!:i\gAˮx7ǻ9nws9; ‰)i,1c oͳ}{voHĤa n4kQU`$͜9-bVL| |}=}u٘Ж[._䫀(Fy7ʻt#L MДa&'_j|ZBܘD (1,!==>.lllxҲqJL=ojlH;W2DRBNLHM s)?6!6 ŒM1a{߄tZ,-:.>a"ĨԄ0}`aaX:Lr ~CSƧbCR$Ŧb]S%=44%.!mD|ja)HX_8J1aI)q*dɤ}[APzjJbX*ՠQɱV0[Cc$ Tr#ÊK6,- *>"93r?6Lش{瓀 Jj{IZ!,1vaVl(q3*J"Ⴏ<"(,M,aLzULuKؐ䔤GR!x1Cd%dž9R )N^NKMMwRbMtjFא7 Yt*PQέ(dEvRGܜ x'TΐG7xj[~9 ^~W UU<<rY#?e  t5lLgk2 -u!ВE~W+S -6 0c&l Fʴp)Bږ'Fp >4<5c M NPΎt)2)O06n3ta{u{:Cvg8SP0401a!>Lx?'v3zmr~C u! @x#O~cw4u g"g5ɂ<%(m*x9ZSi1w,1=q^'iOv%ˍ'Oާ_JA>z/MGL=y5}CSW*By+C*)uj4:]7A71:] Tđ5!' SMS] %QGPF@>rL2c^;yT)sCȇ-s 1.hi;>`hv_M S4/2xb }<3jBA71Iϖ|N(d1S[x߂IwۜA XNL}#迍.Lnoy{Ii]˒r9zA~[DPNjW_˷(:-A759&ǼAo&N}QA. X^L!XGL #8hsà|ǘ$|4htR6ncBQ氦$+aU\)jXFAX&m;P>\pΕ K2qT-6c4qCdM=s*m'D _y ~oq؎$-NPώ J}}{!+b>IVuHM:" R7|9Dr! !-lء⬅Vg|ݗt ܅g:KJ̒!Y&ذ1ɸX_8>ylB*-̣bS4>Ww|.\,3C'6e|"GK]Vk JMHv֐>+j2.WG<?4ex%_>~W&Lw4$`ǏҾipUHf2㘬*NO MI>"69"Y?tL,3'&$JOrwtr]4)!--!ybtym;+Ƣm,ٙ,M3ފIQw1)+SvǏM KVAkQՔO)3p9kXi65]EQ]W72]"x7RClqĕ4SuYUճ SG%} TpcA5}1W_6,Z5FF6 5ܔ}Շ2*lL0P%0bAkFe5'X.9UKp!8cӲ2 a,C?-nJR.ǯ*njҼm;Wq z!%hF. gXUcR`Ai}ԌF023WhtQ3%҆#dG&ąQT\4 uvAp]k)+ k,)69 wdž&2K9 ׿Y#qR]=$EWt&eBĦ3u GknɌrOf)}BZ>}T>Yq]'~LE$'1)c-Xj84Gm)[h)w6E{^ҿfY橜-+';tUNo aKIe6XVpdJ&'J:v.r P>'y\]* S.Rvٽ]=xwU/)v< ǎ8Yq 9m mM9LbiW@gr*eܔC؊u6.>~`/yo(h&PW%R<~xl.AO J(E܉Km e]/ނ{YGpۍ$zȿ ;d-Z3LׁZ*˄ T ܶr_Ͼ_A6͸i#G ֿOtʐ'VTN06>ZMzwlbb8+C*^~ =5Lp߇+!{V>~w5V{3qFcx7RՎW瞀,Sb[|>pKP#k6gyc%L?6l(p ؠRT=uz ze7Q~)vV KHNO?پ 9 I,^ '<0hr~2țIuvU%Dse\~gگF~?E]\sxݎfa}ԔQنqu_-A-9aŌ1ЌiBf.FwNg$Zss>mwW{B {(i?O-;]; 1K4<ԂlU6WU:[XO?ͻwÜO 8_ݗߋý^JY"}|z/2oe1[yM$mt*5=. ;n. ݉Wܭm甿&ӇJMmR)d yK/rNn[m7t@,}bv-F7vR8;gD˝.wxFmD oD9лr>ܡEt8 ~$s8wN'n/ܶW|4w4<\aܡWYsb9KP*\~ R{ 2%d@M ' w{@Bp%\OP/ fd+<+ijxԿWwt;hrU#{g_VyW [1K+}|V>>^2ʳx?~\x`]A}NTŦ Y+2=ktOjgiIIM[ƵNp OGQ5蜪չ^J(wVm n[ 0W sU:JD9/B  S+u NjSrr.DMNOa%nf 58)ǏJOK:&ŏxS޸`4<1:Xht٢Ց_?gQx%J1}lA\lIrR'n4FItr'I"9w6~n}r~YWf_glfN*D @vr>qɯ< Zv~R fͼ57HI7Sk0QAomof7 =cN20Gv3-f2 4s2\0ʐ+4MɜhƗYjw A~&#c#3F&b#s[ wa8dq]CBSxiU/16~.ea4& Ϣp\BI4Rlvnұ.LO-ْ!hnKdNIǒK c%R>>E~ <[+DL:%T!e#WQgz6IMCRgLpF 0?;sq ;Iܥgnv?\%y ܳ,T|;*Gk}<crMC+*"1-~OT_8N9ۃ–x @vSXqɞ #Gz) K jmgm.ockB!)*Yb#phjNj%3Ԋ MS |b^Pm+Y ɀncA= çsZm_`A|dfNd89X3l2S~0\>A3B[1ߧ99%6pbK|e;4|F};Brwr3i+^WmLjnw!~9{˿9|])~oxszi'o*6K!pv}O樣zk~f^#js'{ nw2NeC={e~}6G/r./$[N%v|Y^d}1G#x~>_L+rH|dx2'<٥m>2] Y<)i(Uѹ,9Rx~%\ϕJF?!< x#e;` qUvi/q1̶^V؏]a g'R-(gGOaZhZ{hJ8.LNj6ҽx|WkV[rIslI{DINez b%Ʀ4hTvMI7]:F<*(+(NVˮs !LgQˡ+(JqA̸pACh|⥜Up*pBU׸jT\Mpָ:.\mW_pg\7.BYݸ(ƅkqҸւ)F:puոY{pj&700|Ňmt=Qp.\ s0AKu7+I 'Rp׸&q5&k\ 7U䵾fp5n 8y9jg5?ykNfK.j|/ ƽ@nHB[M-uVhrp|]q\p_k3Ѹ0[p5lѸ.mCw=n'p.].npjo^:mӃ;q=#w̅;q2w] 酃vMZHk2iO>:?+aq05+ ƕոJ.પ=PeYu8S55pTGyVW\=p^\p45v"4ά:*(pM5\㚩ǒDðHIZN88Skpm\֪sVv:h[NZaXUu\w:ořz.kL{H0řz:yhaXo&>7Pq85=q{@M|Uwᆂ6HðKt 9á{$p]Iú]v|}4qƥLU=R7b!y(Jи +ˋ$]X͑Ȃ8qA]̑Cg)ϒ/i 08[ \:C^rZy!/̵x6H[hi0ny6e~[/A|?G^ zpa ^"]6⢡߶÷]q;1ablj\&l@`as6,Z3lcY,ll[pK [m[p,aV6EbdIddbb b bDZL-l-, ֋EkaVaeZYV婕-bcKkcX6p6p,h6I4ܤ 05mb٪4UifklaXhf+V(3[Qf+K[QfVA666Gdu>.B>s+:v99o/w8|Łg}r5>!rk.r w΁CNnowss, pynޏp-oqMp~?rOpy!?nN8pK$mp8pO׾{_s wy/^wy~s V}܆{;pg܆N

rC /8p)Kzp' )SPÂV6yp(Pо "u.{{I>/+Xc9u pM ه~/\ns38drC~ /qPPYA7S?RPvpCoqpwgxp=<N8p ;_|ހ{MNA~A 3p&(h{;)h[^[N˅ ˝sN_v3 ڸ "<_!<W8pߋ r)pBuQƒ`z+9&3 ?'D ?>&L_QBFG8'#ppN8 G8'#pDA8"G #pDHI8" G$$#pDHE8G"Q#pD(E8pXpXpXpXpXpX pX pX pX pX pppppG4&ф#pDhM8 G4FMw%&LMk$d1EAƠc#}jPc1/5A21;h,vc#Ŏ0J@d$"҈1XHc^ƼyEI2eebbdňbh1֣HXcYtYtYDXDXDXc3b9a3a3a3f,vc1a!,/ ARFa66s`6ֶb`Xfc՚Uk6Vj$Xfc՚Fڌtl3Ǭ18vswr7űɟ݇eMY:\!iWtsp|9 <w8p \ NM,r*ֿ_Pk>!~8|m&^_W.'9pԿ- 'OrNw8{;WU?yIkWzq_7ngm׾w zm#ýy5_W)nr~x?~qs='n|&u#8.pZ[|~ρ?tGwꞢ;?,hpoCA ; _!L|{ N8p ;3فu_ Q?<[n6N׿U\pY<*ie?Ax=sǡ s=u0;3~B-ǟ/9\%lMn 01w1\d,ccbG0;X#$ 4AF""#4i+ʘW(#QFQ--FX-Fc=ZDXh1VHHHHH{96#F6#6#6cmbG1FFd lfc31G0 llfcm-FUk6VXfc՚FRUk6VjdHj6c^z=c7ǘM0q-wS S Ӽ(B2r%ppgp\õW ;\p  0J3[fAef+V(uA,66e(uxAQ7WHWTdNW J3.؉ ƕ.;۔ʊhrU:j:\]7N9\5DPkt .J,.G56õp8$Abe0N.q(AP qep'x7ǻ9J7' *(0}PKHNO_ĔT?.6=6lXjlRc:&|D&ʿ{t&, _e>^fxY{38K(s֭7(_vN(Fy7ʻQoѬb{??uGAP_\a)Icc7$\)569.% })Æŧxz|jRXb4?lh,FbǤƦⲯ,QSz/-:q GPE QIRE#v(4qO/$,KjLG/NN|`Qii )i ::և[7&>ABWa ^=_1|c՟ix&|-ႯO_p oyf2r坘:2|e$/ <K^*ix'?&yiHwkJA`x_e)eF-40,_eAVyF3m)ߤѿdҿȓ,pV׮2-k9'gs%H3`,h(˾S$h}A\֛W4qei*碏b2?1LI7xز:^;vcz{:/P]?Xg񦘇MAХ-q(XRQ%࿳1 |!­XVۿh ;} '8s1L Vfl-z< ~@:}3rCwJ! > j^|rEɿjS8~ܦӸ1ڲƅUWB*.jcw4.)S8wO1d}-SDhF9 Y^%Ŝjk #l-yhiq»|9{w4Yn{i\む6 j92t5 ")I"-2 I^L>5YnW7|]37YS>">N:b'4ttnņhBS9Ps4?64$IJMMOM:nD|jjMH MN UR~&$qД]y*<۾]]+sϵn˳bL\([Y/W|qV3'q+}Y1{L^pҭM!fEm$YbW`VcDt>MPN\044gmY?Pu|4N 8YV &gz3>LQ2 Ӭ:i:G_F L2q5[Σ 6𠬆7~o])oS- xPpawGAUܔߗ 'ȗU,WeeI9y4 }(ce(gk n-m꼌'TP!݆wM૜w-ȷ]Յ|8!NCA=!#M8a <@C8i Fh򍂸xq-*{Bjx$E| ?,(u?DPV0ʙpn?˖a-42L 3C<Ç!eX5B]ԆL:SY|X|L>w>טa -~3ٕs_?~f˰kbv (=#eqW>\G9+;ee j64699%=4-A֡IJMHI Cu+ѩ%mR@m1r9k9N3Y\!} gd|eݗOdǗ[zBi+Ӷr!ZrWxJrp$ ۹㣓|J|{7A^ѝ$vw#o"oWfUxtt]|w&_^to_C;i웘.CgϿ,=lu+&{7JuOOOzy>>[Yy}:%/@cgvE猾0=}zj,d_puE7}w.Jp ]:|xGE?5F/CgQş57?4B:?ˣq\@a :G&]Gpk9J͠$R݂Z5&5`j6~.p th]Ҳ0rzBjNnU.h H-6PS?S^pLq*xǛXgY tB i G^I]cDm _|K>R|d@v-".ۣwshVv/{@ɿ j#F?AFR (g%`p&"ZJ1]MA/xWFy5ޜ\RmyG_)mܮV+[~f# (Kk +MlDduo7o19^i'!nt pJC[t*.yfRc! /JB~>.\akiQ=jcVJ4.\Y/\ypiqM13WqHWMPk%t]zkqtg5s5 ' !'I7ɵ8lu`\5!w Ը>qh -"4nH]ip4.i[m< #h@?lL֛<Ʀ&&Ec qcH|D؄$iLXg<&XvM |xvV=T4ў/8ܹxֺS&'-Y-Eӄ;|&"N6*} hN[~^S {Ը!~vB"Ĉ:̔5%'-]֝1XB_u?1z?\K\(xڀּ/i>pd13v1(OE?OY3P/J*5Yxu1mLot^'6bq;,īv6x^]`xnǍT~CH3|P@#Oo?~yߗONP{fryj3)`7+}ӓ ZW<=q߶ۯ=Ԗ7B_/m[>oCi%/4~Pd&_گ?<祉UPF/9/4&h߰۩N*;F_G%Yo٭RԫԋtԧOo_Ewa}zQv>ə)wu BTR ~Nf_[~_lgxh/?5bsZ 濐VU}{ 5?YqϿn9'/{UVDdX3xQ׹+W7~+W7r>C \}nOJxTzOa#*J~oyTvPkF/ݱH$SA;-J|ҿ) " ]ek .'а2| IEt^MԎxQ)ҍ_'ع_TE jT2ttLI%.7M}.^*ّ|ؓquS=PT|dSq/":~R`h7K%G-X_w}̦Rj 3w.P)$?xU*uO?KeG&nuO)$Jenڹfk)TxzbsKO.>JJe/j |'T*:-'Α5ͧ~Bj.T{CkW}j˶ok&}m?tj{%y~tXϨu߆>0ͮQşY^}j^Lq_볿%: w7^l.b?x3'}dF7uzj3xsufl/Yhųn|lc'#/;o>Ow]^Y'~G[l?JȰXl:o#Y#~4_HqK^QW݇}xxß-nmCӘۿm9?ۿ]u~j)|e$'5:cK{do0~l>xvn9wξoړ/~ҼIEC|"olZZҦ,tR K~k'ӁMbYy//}SCn;/GbٷTzmUkJ5E-:Eԍ{/3}@q)?v1]N<$>)#gw~mm9=ewq7m 1eCkTKDԧc3NxbƯ?Xcxz653 yxR-uJ<2o _&73GVx|y[\')g4.+$TK(ͬg#-jgw>1k;K=^aO|fX&_^acԅ*9OfxĵX%МtfxLۃ[.6qd哎PAk'qz'o)v %}N<'xG2OPFAYQڰÃ`z ٍ׬&5Ai 2O'Mz#͝Ԡp#pc^4qnF""Ŏ0;H*Ͱ4AF""#4i+ʘW(cc-Ƅc-8X#FFF"F"F"FZ,1ڌm3;ڈ1ژ0ڐP¯ 2j6J c0X۪U~5Xfc՚Uk6Vj_jU+jHjU[h-*MKOH(CqamSSStDŖ&ZŤ|X^i0i&w &?#N(cc'8qf_VJWeϵF5ݵ~6x~ 혁iCNQy|g#ⅉ}|W#{6ZF;_&C*r~V:KAVx/5]]ȯFJrċ.)5^KI鿓LO.CPI[/-N*O=mx5Ŵc*)Uth͆|X!< n*XuX[|bedEA\> U_\ ֊(wNK'/.>#T*7ooQWZ>sIqoW)wE̴Rg~@whG] YDlۦ(|iGcmL'> J5\wΚu4i |C~4S)Ўv4 -H)|v|ʳ%:r9H}Rs/ kvJ-g},/YzH1K~<\W^MvGIPD(jGe_oҎ2ҎA;ZBO;vךDX"gvt@)ЎVBx#X,hc!_۬"]BFh! PLPO})_S)GЎ@;z \KoR;[@}!zs_LZߦA=5vHSb\ƏA;*hd]^#=]e$kGlVmEV˄3B; 7h~XPD(*oB; B~J;:@v hk?~CMH9ӎKM-]th跧JNڣ<.^UytC~{bzF-0#?H_?ۊG{U-%[3q _>(?ACl=Km-M'Jz<"|cj{WOˣ#2e) 2rI\ πJ52lDqWEȟgǛJ;T͈g!%>E:]RD' N2{ssrre7t_|^j ᙒħ٧v!’k{_OAd4B_i|_xUNךtwR&5br{y oϻ-~RCm2Foևʟrm'0LWm-R֛UTEF~K~d/SVmqB :²]hg@e'WW_k?ʮr^п~~ݬcO~Cx:~uTϩ,lV8fG<^q~@>tRj)liɜiͯ)jm2['W,~8DOU6b?/.R ;TEsZLtJ?M˷|7~{P+饲.\ۻK![[؆ɷe޼)6@4jEkt>!_?a&+s8v4{q}K*sDݥw/>߉Q2_.vȓwrʅ>w_vﯷzHm6 -чV$@<9b^ :>tե ~җHRǕ}_0$)cv}?50lx܇EGA|o #[}á>*.C҈ܭRrZ ©I~?N,xfKzԌ/\,ki=w`<'7y-2?6r*UNdŏc_L'^^*@_(>i3;I!M|"L)=>54Rp7|:0^z]|=_ y:tK?}Y&E v3SV"R-_|eTW'Ukt}"UjUӍrR2COw0)x䛛V\ʥa> k6}~k0_[/Y$[R/v?jw:yem<Up/`4yXjK`<,2_ 0_"~#?Iz*|mEvT+o{9\~;/2a#_Qr$()𽭁}2XJO ět~ @_wO^k{9yԝ@/Kytʥ<Ә|*|ݮf d{w@Yz4V}'An#*R[z*rx1ka=r"|/g>V]$ik}mK }kk%˥ 4I swJv>䖎rl~կMWPMzmЯ̀~mWA? =ˣk5 Z{_2FJ7}+e׍HYQCe|J <潅L{p̻"#,?5G*7mml2{G6&VRJ~Egʿ#]W͟ x}R҃WH>'-n߱˿شDK?_yOMmFIљ=S}j7 >%h `?p|jSI$Scyj:RP'+\ R~۶2xSz|)UT]g]:J?g6syJ `tB/IRj6>Wz}M/(>2 o/2CG rY*΅k)#Ÿ/\+ ]Q}/UTؙ/7O.H)𬤠R?A=kF PAE'o;aҁ`k|_Q`̠ʬl)=>&^]3Slۼ} t:GC'{xU2VԱ_խ&_yy.;TF=sҤYH_:hc~SRY);/΋r{>`|a@jJS+*q k"уNYo`[|?W| xSJ::Mi"kw{_xkέRO֮uv lS*?.e0?H'R')1/ fxTÐo%~oGGa)ghI!+te)~m_ pя_<짣*?Mw? Cz\;ο|Sjߌ߀xgDcgF|^v?B ]>i*vP>߮g;l(^\֯ŮT.=mb_^+/htJ ]?L OV =sbˍZo/.Ys_oljSh%S5kc/~6z?;qywc3cf=Kw:;gX?3xQzt~ 2lC)в =39Ʊ`݆@`3τƏx q<gs-a\I`<,2g!yF~(^g7q&߂~'Գxp >s=Ō[Sz뇰 +>s蜀^A|F!=?>=8We*4:=2z^Ͽ>翗z!#z:Kdht0_/(_1.ߖ4E??+L:n'"N>:T:lDP;Ƶ5p)CO+ߨRPq?'qZߤx'~RU޾JRx# ʼX^ͤM^d%iy9Lr=Ea<,OѢ[7^Iw7-mQNjoG񚧇~S xU*_t7 c d? O~ `L: K tk/qT~*/x~$_}x=3G~8#)@ŁO+hZq[?G#I?x,#ܧڟ_2_`7G*r!-Q D Ϸa:hr׈/ m*65׹zJTvF O(>r%(͎5[H>Kztg/|??o|ݴ6 gwg|_w ֳqGezGѻ*=ܣfRNy_wܑxI~$LڻhSރŸ (W чAH7pq ~\AB/?/zz>ʅUsлvYgzr!PD}n~>Z_Bl>oU_/Bݏ~|Ԝ7h|d/pq:N~1KL{t/1u>6?\}氀uB܊[E网ȏOr Y'<=-x22ƃ{^/ (7_o3@?W.}G&ߒx%ӹR<PUѯKA W}Qu$Y|(W]׿x1#suQ; hwjyJ>XĖ9_($uAJR] !tK#ǷW; zqWY)Az `?r?هd}t!(ᑿ7>n8rٛ>pd>^+ ^#(1uj|]oķ~&?&x >b:OQ?_*q߭աt[P|}5n!a_ϣp/f򭮦'دCcd? ćЏSփGg?F|te뇸r_8~҃<[v!#ژDŽ~#?tN7=a)쑝gGC;/#܏z{h0Nw?E/P%(_G7|}(=T_ʨtȇoWH>$@ywɣT.<*ȣ|zy%2?xx `ޟI|ﴮ_@ 8 M(er{ |s}z`4Gh|42bG[(33>b|a|Dh|4m'xf|GgG_PQGhJ0>zm<ѯܳ%R3_h^sʔ0h5.ߊto\x/g-'<Gh틡F?_OW@ϟA(ˑ3PוqOa xX\;οpF~SSzы{9a EV?z.B:{1/PWp)%>0S˭kp.R]ޟyx%? |Pz|pٟha~\%h췀'P<8O\^_B,>?D1A S3iF~`EO9U#AB A:@GmxVuQu]QWu͐>V+!gJ{kXl#+ۏs )G?baik^ TI_{G]UytC~{bzF-0#?ʠlիg[xmzG`k([hkYgGO9+Acytĕ<<5S<wdƹ(?j?e؈tweMrZRC`ߢ|]G7:`30w ҝpxɄ6q C~=]ImMLiЦڄr{6L;™.3iF0鄁NdО:!Lksrg?Il~ՕEggݵkf{%Lk5?lp U=V_[Sh+m&g&%a}8ԝayMKkޝMҬ5*?(Wp~'(_xa#s{AߣLpe]M {;t.ܕw]]t Muɏt< Q<\z~z1xu!ó>D+* u=Ja֪q=w`<'7y-NQIŦ$RN.`~Ʌ(ٸNh[w0'tw.}JwW]_~53laU3C۫d;ʅdŇ;@g҇<+ {{o{ e#8/?~\a9B.g3;]?G':F0==;jF:T3Wxp.,u>~V+ l%2~[ݶa;Ϫ2w6bv/";l[^=s-my?ۃ\~?1~T?ykC+>]ٴUIh>=3+<<ڐDiig{\9û-ٚglH^2!؊*6mӆoZy#dq]xi;οh A$_x#G2aK u AY@tWժiσMl]ȾlZl+zVjoڷRpX폔u?TM?^˷[c[ȴtfMw1Uzd+=Lx?^4mRF˪-m]sh;vJɷ%gUWFCQ@#`#θe:F~|:LQL1#?ˣ5.=#?~/l4(#U$f;꡻V >A|`+ʣ^?{lmlV۟Bޟ{g?S:X?fٳ|S~ZC\;gK?~ K@W0}m@m陡= wQ(65.no+^G|xW!5w]OxWݵ`<,G[h5=ښ"[A`/h?C,0;\1-^=?!0~B_(4>:'_DzsyDmSO=u_FBϯW]xW^g2z{T[#z:KdG7$ӡ;~x+?Pےƽ;Z?+L:n'"G)mR/-w==x7R .;Ƃ8oR<ݝHW;3~f]x%ޡ90 xXdkNjoD[hm(\?A-`22/?r'ӯSC"Sѫ6.֏|Z=Cᨏwo+|ZIw%)Zq[?G#I?x>ŻPר!=u>-zGŪ_?*OL>MyT&G 3hȣV=TD{`OiGGs=y>1h}v@}RվnЫE\Π4dz8gҫ;},GZ덯xG:zu OKGG/W $Q;/?|Ỗg0z=նW[Kիj5L;:HSU2(] GBg_}@}WI |_z;ԟi-p;A;* h% vF˃`gt-ȣO3zQNR~aVQ>Ow5w]sxW9~_;UbQHw-面ϟA<w|WQz|!ꏑo;qr_0~_O6} ?|e7Q)$!w$~Pׁ?C\7> |DtWZɌ>VGuG`Gh?ο{!G{HP?>jN4>S8r5>_4>#V$]-)Y Yjzd;Wk!|1=>C}}8?7;L;:Fx+ӎ&2 <#gy?;~E\$ygV(աWm޳W}E|ϻ99H|Oq /;ο 7gkA.qEt9^tr9O uz 8S=9=C+t Ϥ|m)|O}0=> yFU_G17~]~ qpgUf)z#@oy#Q3e!z0G97r;!xW<ǻݜ~8dWw~?+A8ozRĴ#'`` Gys 4CZO뇆uH?:$~ﰾv_~?گT7;dP)TƯw;F?s~&)QΟA:wꇡ3Qz2h OяiEaWceTfΗ7";sՂxO9'#ϒf˺o߸ Iakv,Fw8nsxpDJ Yw['?Kڏ%&߽jzxe:ABԟG?ꯒ_ןq˅w/X|~j[׾J}źtŸP> zsXnoTnέoG_'^نއ| yWTOhpxv曌?J7h#oIJO<\) s]w*zӥ^(} \WrẎ_,>+.j~_庨?T;<%,b˜L/c m%~)o :t?۫J~N S=y}\[MO9ΟهeAv>HO~HAcL_՛]uqd7GMxwbcrcЕ}H/?H_:5.7^[d?~n <cr1_Џ/X{8ECx_X.]η8g/?~ wb@=;_IYrJ몌aϷ5џSnKW~&0dG߂7T p/GQϧ*P<ݹT.yT\a?俱[ ч<ʹUWe sٓ~mgw8=i'^~mU5Ӿ 'g xVRP:Wf-(>ߚd/~83VWס1~ C G~E? 3CCra>:u2C\A/?xXZN;KmcB^QE :lA\γ#㡝gGP==]zy4;W۟kuK_/ˣL>g*گxeTQ:yC7Џ߫?$?x~_<;E*^eI>A[P@vSzzx_|˪ 3!ٯ#ch? η:Bh|Џ/0?*@9h\;οGcSGbMK!6K=޵j5<٫U){jt^5{LF{`۫[{;z}Gܻ_%}G7ْSV욶t׫.I'G`&8ɤy~/_E`߇~p~B}\x~ϟb<߀wZ/ܿgaypg`&~2yzsX}^=_^my4>Q1㣭 f|a|ԙur1>J0>Zs4>}Q<3>3/(#4Q%]PVW x~b/4/F]eJ _oEp.c?Η3Sƃh쇣gߋP^Я  wO HŇcʸN`<,_8~F~#?P`)CRَ=Sߜ"We=_=O+^YKAz)V58wu.SSLK(=> σp鰿G?ג_GgD[(_X.|/!y)Ѓhi4~#?"*`A y TUf9_ ǧ&X\؄/07&H$)'#G?hT|rlb86QI+( 4`hJa Cӑ¢ b1\BڨԴd&6&9QX5!Y)1a$%ŦN:S אwE@JҴfGyBy:sj]+R-w!t&s.A EaU8m^//ٜ:LT2RK CŽP?L/4D}(}jk6K* )jM9I ttGxd8`o˸y$}NI+wbn=ʹrnɁ/c$h髷`@C؃FPtGq*Vk8[ c`1[7Jײ&gu1T[}h7Fw_y *.jWOڐk mjȂgrt_kf([*k=Y0RFe ȩjǠ,Yy4dZX@R|  xn[@) [PS(8c9XS.NX.rq8.g)eg:P8 wK 7G(\F7F^( {p/ýP/}^(.ۛNp:Am5迅)T BradleyTerry2/tests/testthat/test-nested.R0000744000176200001440000000354013615344572020345 0ustar liggesuserscontext("bugs [nested model calls]") tol <- 1e-6 ## nested use of BTm (in response to Jing Hua Zhao's bug report) ## example data x <- matrix(c(0,0, 0, 2, 0,0, 0, 0, 0, 0, 0, 0, 0,0, 1, 3, 0,0, 0, 2, 3, 0, 0, 0, 2,3,26,35, 7,0, 2,10,11, 3, 4, 1, 2,3,22,26, 6,2, 4, 4,10, 2, 2, 0, 0,1, 7,10, 2,0, 0, 2, 2, 1, 1, 0, 0,0, 1, 4, 0,1, 0, 1, 0, 0, 0, 0, 0,2, 5, 4, 1,1, 0, 0, 0, 2, 0, 0, 0,0, 2, 6, 1,0, 2, 0, 2, 0, 0, 0, 0,3, 6,19, 6,0, 0, 2, 5, 3, 0, 0, 0,0, 3, 1, 1,0, 0, 0, 1, 0, 0, 0, 0,0, 0, 2, 0,0, 0, 0, 0, 0, 0, 0, 0,0, 1, 0, 0,0, 0, 0, 0, 0, 0, 0),nrow=12) colnames(x) <- 1:12 rownames(x) <- 1:12 ## function calling BTm, based on data created in function fun1 <- function(x) { c2b <- countsToBinomial(x) names(c2b) <- c("allele1", "allele2", "transmitted", "nontransmitted") btx <- BTm(cbind(transmitted, nontransmitted), allele1, allele2, ~allele, id = "allele", data = c2b) } ## function calling BTm, based on data and variables created in function fun2 <- function(x) { c2b <- countsToBinomial(x) names(c2b) <- c("allele1", "allele2", "transmitted", "nontransmitted") denom <- with(c2b, transmitted + nontransmitted) outcome <- with(c2b, transmitted/denom) btx <- BTm(outcome, allele1, allele2, ~allele, id = "allele", weights = denom, data = c2b) } test_that("nested call to BTm works", { # ignore family: mode of initialize changes between R versions res <- fun1(x) res$family <- NULL expect_known_value(res, file = test_path("outputs/nested.rds"), tol = tol) res2 <- fun2(x) res2$family <- NULL nm <- setdiff(names(res), c("call", "model")) expect_equal(res[nm], res2[nm]) }) BradleyTerry2/tests/testthat/test-baseball.R0000744000176200001440000000262013615042306020614 0ustar liggesuserscontext("data sets [baseball]") ## This reproduces the analysis in Sec 10.6 of Agresti (2002). ## pp 437-438 Categorical Data Analysis (2nd Edn.) ## Simple Bradley-Terry model, ignoring home advantage: baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") ## Now incorporate the "home advantage" effect baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) test_that("baseball analysis reproducible", { # check model 1 cf1 <- coef(summary(baseballModel1)) # check against Table 10.11, column 3 expect_identical(unname(round(sort(cf1[, "Estimate"]), 2)), c(0.68, 1.11, 1.25, 1.29, 1.44, 1.58)) # check statement that standard errors are about 0.3 expect_identical(unname(round(cf1[, "Std. Error"], 1)), rep(0.3, 6)) # check model 2 abilities <- exp(BTabilities(baseballModel2)[, "ability"]) abilities <- abilities/sum(abilities) # check against Table 10.11, column 5 expect_identical(unname(round(sort(abilities), 3)), c(0.044, 0.088, 0.137, 0.157, 0.164, 0.190, 0.220)) expect_identical(unname(round(coef(baseballModel2)["at.home"], 3)), 0.302) })BradleyTerry2/tests/old-tests/0000755000176200001440000000000013615046465016036 5ustar liggesusersBradleyTerry2/tests/old-tests/old-tests.R0000744000176200001440000000170413615336604020077 0ustar liggesusers# old test of BTabilities # - all parameters are estimable, not sure what this was about ## modelled by covariates where some parameters inestimable summary(chameleon.model <- BTm(player1 = winner, player2 = loser, formula = ~ prev.wins.2 + ch.res[ID] + prop.main[ID] + (1|ID), id = "ID", data = chameleons)) head(BTabilities(chameleon.model)) # old test of grouped residuals # - there is no "separate" attribute here, has behaviour changed? Whiting.model3 <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), family = binomial(link = "probit"), data = flatlizards, trace = TRUE) residuals(Whiting.model3, "grouped") ## Note the "separate" attribute here, identifying two lizards with ## missing values of at least one predictor variableBradleyTerry2/tests/testthat.R0000744000176200001440000000010513615031336016067 0ustar liggesuserslibrary(testthat) library(BradleyTerry2) test_check("BradleyTerry2")BradleyTerry2/vignettes/0000755000176200001440000000000013615557421014765 5ustar liggesusersBradleyTerry2/vignettes/baseball-qvplot.pdf0000744000176200001440000000766613152515665020570 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20100223094452) /ModDate (D:20100223094452) /Title (R Graphics Output) /Producer (R 2.10.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 5 0 obj << /Type /Page /Parent 3 0 R /Contents 6 0 R /Resources 4 0 R >> endobj 6 0 obj << /Length 7 0 R >> stream q Q q 59.04 73.44 414.72 371.52 re W n Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 101.83 73.44 m 430.97 73.44 l S 101.83 73.44 m 101.83 66.24 l S 156.69 73.44 m 156.69 66.24 l S 211.54 73.44 m 211.54 66.24 l S 266.40 73.44 m 266.40 66.24 l S 321.26 73.44 m 321.26 66.24 l S 376.11 73.44 m 376.11 66.24 l S 430.97 73.44 m 430.97 66.24 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 93.16 47.52 Tm (Bal) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 146.35 47.52 Tm (Bos) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 202.54 47.52 Tm (Cle) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 257.06 47.52 Tm (Det) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 313.60 47.52 Tm (Mil) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 367.78 47.52 Tm (NY) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 422.69 47.52 Tm [(T) 120 (or)] TJ ET 59.04 117.93 m 59.04 394.65 l S 59.04 117.93 m 51.84 117.93 l S 59.04 173.28 m 51.84 173.28 l S 59.04 228.62 m 51.84 228.62 l S 59.04 283.97 m 51.84 283.97 l S 59.04 339.31 m 51.84 339.31 l S 59.04 394.65 m 51.84 394.65 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 106.09 Tm (-0.5) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 164.94 Tm (0.0) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 220.28 Tm (0.5) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 275.63 Tm (1.0) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 330.97 Tm (1.5) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 386.31 Tm (2.0) Tj ET Q q BT 0.000 0.000 0.000 rg /F3 1 Tf 14.00 0.00 -0.00 14.00 131.47 469.45 Tm [(Inter) -10 (v) 20 (als based on quasi standar) 20 (d err) 20 (or) 15 (s)] TJ ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 253.06 18.72 Tm (team) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 236.53 Tm (estimate) Tj ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 59.04 73.44 m 473.76 73.44 l 473.76 444.96 l 59.04 444.96 l 59.04 73.44 l S Q q 59.04 73.44 414.72 371.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 98.87 170.68 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 153.72 297.29 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 208.58 248.68 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 263.44 333.99 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 318.30 349.95 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 373.15 312.51 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 428.01 317.58 Tm (l) Tj 0 Tr ET 101.83 115.87 m 101.83 230.69 l S 156.69 251.63 m 156.69 348.14 l S 211.54 201.81 m 211.54 300.75 l S 266.40 287.34 m 266.40 385.82 l S 321.26 302.55 m 321.26 402.53 l S 376.11 266.63 m 376.11 363.58 l S 430.97 271.74 m 430.97 368.61 l S Q endstream endobj 7 0 obj 2612 endobj 3 0 obj << /Type /Pages /Kids [ 5 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 9 0 R /F2 10 0 R /F3 11 0 R >> /ExtGState << >> >> endobj 8 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 9 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 8 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 8 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000164 00000 n 0000002978 00000 n 0000003061 00000 n 0000000213 00000 n 0000000293 00000 n 0000002958 00000 n 0000003165 00000 n 0000003422 00000 n 0000003505 00000 n 0000003602 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 3704 %%EOF BradleyTerry2/vignettes/BradleyTerry.Rnw0000744000176200001440000013105413441760376020074 0ustar liggesusers% \VignetteIndexEntry{Bradley-Terry models in R} % \VignetteKeyword{generalized linear model} % \VignetteKeyword{logistic regression} % \VignetteKeyword{penalized quasi-likelihood} % \VignetteKeyword{ranking} % \VignetteKeyword{tournament analysis} % \VignetteKeyword{working residuals} % \VignettePackage{BradleyTerry2} %%% For jss: %% \documentclass{jss} %% \newcommand{\pkginfo}{} %%% uncomment for vignette version \documentclass[nojss]{jss} \newcommand{\pkginfo}{\small \\[12pt]For \pkg{BradleyTerry2} version \Sexpr{packageDescription("BradleyTerry2")[["Version"]]}, \Sexpr{Sys.Date()}\\\url{https://github.com/hturner/BradleyTerry2}\\[-12pt]} %% need no \usepackage{Sweave.sty} \usepackage[english]{babel} % to avoid et~al with texi2pdf \usepackage{amsmath} \usepackage{booktabs} \usepackage{thumbpdf} \setkeys{Gin}{width=0.6\textwidth} \SweaveOpts{keep.source=TRUE} %http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf \newcommand{\R}{\proglang{R}} \newcommand{\BT}{\pkg{BradleyTerry2}} \newcommand{\logit}{\mathop{\rm logit}} \newcommand{\pr}{\mathop{\rm pr}} \author{Heather Turner\\University of Warwick \And David Firth\\University of Warwick} \Plainauthor{Heather Turner, David Firth} \title{Bradley-Terry Models in \proglang{R}: The \BT\ Package \pkginfo} \Plaintitle{Bradley-Terry Models in R: The BradleyTerry2 Package} \Shorttitle{\pkg{BradleyTerry2}: Bradley-Terry Models in \proglang{R}} \Abstract{ This is a short overview of the \R\ add-on package \BT, which facilitates the specification and fitting of Bradley-Terry logit, probit or cauchit models to pair-comparison data. Included are the standard `unstructured' Bradley-Terry model, structured versions in which the parameters are related through a linear predictor to explanatory variables, and the possibility of an order or `home advantage' effect or other `contest-specific' effects. Model fitting is either by maximum likelihood, by penalized quasi-likelihood (for models which involve a random effect), or by bias-reduced maximum likelihood in which the first-order asymptotic bias of parameter estimates is eliminated. Also provided are a simple and efficient approach to handling missing covariate data, and suitably-defined residuals for diagnostic checking of the linear predictor. } \Keywords{generalized linear model, logistic regression, penalized quasi-likelihood, ranking, tournament analysis, working residuals} \Address{ David Firth\\ Department of Statistics\\ University of Warwick\\ Coventry\\ CV4 7AL, United Kingdom\\ E-mail: \email{d.firth@warwick.ac.uk}\\ URL: \url{http://go.warwick.ac.uk/dfirth} } \begin{document} @ <>= options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE, digits = 7) @ %def \section{Introduction} The Bradley-Terry model \citep{brad:terr:52} assumes that in a `contest' between any two `players', say player $i$ and player $j$ $(i, j \in \{1,\ldots,K\})$, the odds that $i$ beats $j$ are $\alpha_i/\alpha_j$, where $\alpha_i$ and $\alpha_j$ are positive-valued parameters which might be thought of as representing `ability'. A general introduction can be found in \citet{brad:84} or \citet{agre:02}. Applications are many, ranging from experimental psychology to the analysis of sports tournaments to genetics (for example, the allelic transmission/disequilibrium test of \citealp{sham:curt:95} is based on a Bradley-Terry model in which the `players' are alleles). In typical psychometric applications the `contests' are comparisons, made by different human subjects, between pairs of items. The model can alternatively be expressed in the logit-linear form \begin{equation} \logit[\pr(i\ \mathrm{beats}\ j)]=\lambda_i-\lambda_j, \label{eq:unstructured} \end{equation} where $\lambda_i=\log\alpha_i$ for all $i$. Thus, assuming independence of all contests, the parameters $\{\lambda_i\}$ can be estimated by maximum likelihood using standard software for generalized linear models, with a suitably specified model matrix. The primary purpose of the \BT\ package \citep{turn:12}, implemented in the \R\ statistical computing environment \citep{ihak:gent:96, R}, is to facilitate the specification and fitting of such models and some extensions. The \BT\ package supersedes the earlier \pkg{BradleyTerry} package \citep{firt:05}, providing a more flexible user interface to allow a wider range of models to be fitted. In particular, \BT\ allows the inclusion of simple random effects so that the ability parameters can be related to available explanatory variables through a linear predictor of the form \begin{equation} \lambda_i=\sum_{r=1}^p\beta_rx_{ir} + U_i. \end{equation} The inclusion of the prediction error $U_i$ allows for variability between players with equal covariate values and induces correlation between comparisons with a common player. \BT\ also allows for general contest-specific effects to be included in the model and allows the logit link to be replaced, if required, by a different symmetric link function (probit or cauchit). The remainder of the paper is organised as follows. Section~\ref{sec:BTmodel} demonstrates how to use the \pkg{BradleyTerry2} package to fit a standard (i.e., unstructured) Bradley-Terry model, with a separate ability parameter estimated for each player, including the use of bias-reduced estimation for such models. Section~\ref{sec:covariates} considers variations of the standard model, including the use of player-specific variables to model ability and allowing for contest-specific effects such as an order effect or judge effects. Sections~\ref{sec:ability} and \ref{sec:residuals} explain how to obtain important information about a fitted model, in particular the estimates of ability and their standard errors, and player-level residuals, whilst Section~\ref{sec:model} notes the functions available to aid model search. Section~\ref{sec:data} explains in more detail how set up data for use with the \BT\ package, Section~\ref{sec:functions} lists the functions provided by the package and finally Section~\ref{sec:finalremarks} comments on two directions for further development of the software. \section{Standard Bradley-Terry model} \label{sec:BTmodel} \subsection{Example: Analysis of journal citations} \label{citations} The following data come from page 448 of \citet{agre:02}, extracted from the larger table of \citet{stig:94}. The data are counts of citations among four prominent journals of statistics and are included the \BT\ package as the data set \code{citations}: @ <>= library("BradleyTerry2") @ @ <>= data("citations", package = "BradleyTerry2") @ @ <>= citations @ %def Thus, for example, \emph{Biometrika} was cited 498 times by papers in \emph{Journal of the American Statistical Association} (JASA) during the period under study. In order to fit a Bradley-Terry model to these data using \code{BTm} from the \BT\ package, the data must first be converted to binomial frequencies. That is, the data need to be organised into pairs (\code{player1}, \code{player2}) and corresponding frequencies of wins and losses for \code{player1} against \code{player2}. The \BT\ package provides the utility function \code{countsToBinomial} to convert a contingency table of wins to the format just described: @ <>= citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") citations.sf @ %def Note that the self-citation counts are ignored -- these provide no information on the ability parameters, since the abilities are relative rather than absolute quantities. The binomial response can then be modelled by the difference in player abilities as follows: @ <>= citeModel <- BTm(cbind(win1, win2), journal1, journal2, ~ journal, id = "journal", data = citations.sf) citeModel @ %def The coefficients here are maximum likelihood estimates of $\lambda_2, \lambda_3, \lambda_4$, with $\lambda_1$ (the log-ability for \emph{Biometrika}) set to zero as an identifying convention. The one-sided model formula \begin{verbatim} ~ journal \end{verbatim} specifies the model for player ability, in this case the `citeability' of the journal. The \code{id} argument specifies that \code{"journal"} is the name to be used for the factor that identifies the player -- the values of which are given here by \code{journal1} and \code{journal2} for the first and second players respectively. Therefore in this case a separate citeability parameter is estimated for each journal. If a different `reference' journal is required, this can be achieved using the optional \code{refcat} argument: for example, making use of \code{update} to avoid re-specifying the whole model, @ <>= update(citeModel, refcat = "JASA") @ %def -- the same model in a different parameterization. The use of the standard Bradley-Terry model for this application might perhaps seem rather questionable -- for example, citations within a published paper can hardly be considered independent, and the model discards potentially important information on self-citation. \citet{stig:94} provides arguments to defend the model's use despite such concerns. \subsection{Bias-reduced estimates} %\label{sec:bias} Estimation of the standard Bradley-Terry model in \code{BTm} is by default computed by maximum likelihood, using an internal call to the \code{glm} function. An alternative is to fit by bias-reduced maximum likelihood \citep{firt:93}: this requires additionally the \pkg{brglm} package \citep{kosm:07}, and is specified by the optional argument \code{br = TRUE}. The resultant effect, namely removal of first-order asymptotic bias in the estimated coefficients, is often quite small. One notable feature of bias-reduced fits is that all estimated coefficients and standard errors are necessarily finite, even in situations of `complete separation' where maximum likelihood estimates take infinite values \citep{hein:sche:02}. For the citation data, the parameter estimates are only very slightly changed in the bias-reduced fit: @ <>= update(citeModel, br = TRUE) @ %def Here the bias of maximum likelihood is small because the binomial counts are fairly large. In more sparse arrangements of contests -- that is, where there is less or no replication of the contests -- the effect of bias reduction would typically be more substantial than the insignificant one seen here. \section{Abilities predicted by explanatory variables} \label{sec:covariates} \subsection{`Player-specific' predictor variables} In some application contexts there may be `player-specific' explanatory variables available, and it is then natural to consider model simplification of the form \begin{equation} \lambda_i=\sum_{r=1}^p\beta_rx_{ir} + U_i, \end{equation} in which ability of each player $i$ is related to explanatory variables $x_{i1},\ldots,x_{ip}$ through a linear predictor with coefficients $\beta_1,\ldots,\beta_p$; the $\{U_i\}$ are independent errors. Dependence of the player abilities on explanatory variables can be specified via the \code{formula} argument, using the standard \emph{S}-language model formulae. The difference in the abilities of player $i$ and player $j$ is modelled by \begin{equation} \sum_{r=1}^p\beta_rx_{ir} - \sum_{r=1}^p\beta_rx_{jr} + U_i - U_j, \label{eq:structured} \end{equation} where $U_i \sim N(0, \sigma^2)$ for all $i$. The Bradley-Terry model is then a generalized linear mixed model, which the \code{BTm} function currently fits by using the penalized quasi-likelihood algorithm of \citet{bres:93}. As an illustration, consider the following simple model for the \code{flatlizards} data, which predicts the fighting ability of Augrabies flat lizards by body size (snout to vent length): @ <>= options(show.signif.stars = FALSE) data("flatlizards", package = "BradleyTerry2") lizModel <- BTm(1, winner, loser, ~ SVL[..] + (1|..), data = flatlizards) @ %def Here the winner of each fight is compared to the loser, so the outcome is always 1. The special name `\code{..}' appears in the formula as the default identifier for players, in the absence of a user-specified \code{id} argument. The values of this factor are given by \code{winner} for the winning lizard and \code{loser} for the losing lizard in each contest. %Since \code{winner} %and \code{loser} are specific instances of the factor \code{..}, they must %share the same set of levels (one for each lizard). %The factors \code{winner}and \code{loser} These factors are provided in the data frame \code{contests} that is the first element of the list object \code{flatlizards}. The second element of \code{flatlizards} is another data frame, \code{predictors}, containing measurements on the observed lizards, including \code{SVL}, which is the snout to vent length. Thus \code{SVL[..]} represents the snout to vent length indexed by lizard (\code{winner} or \code{loser} as appropriate). Finally a random intercept for each lizard is included using the bar notation familiar to users of the \pkg{lme4} package \citep{bate:11}. (Note that a random intercept is the only random effect structure currently implemented in \pkg{BradleyTerry2}.) The fitted model is summarized below: @ <>= summary(lizModel) @ %def The coefficient of snout to vent length is weakly significant; however, the standard deviation of the random effect is quite large, suggesting that this simple model has fairly poor explanatory power. A more appropriate model is considered in the next section. \subsection{Missing values} The contest data may include all possible pairs of players and hence rows of missing data corresponding to players paired with themselves. Such rows contribute no information to the Bradley-Terry model and are simply discarded by \code{BTm}. Where there are missing values in player-specific \emph{predictor} (or \emph{explanatory}) variables which appear in the formula, it will typically be very wasteful to discard all contests involving players for which some values are missing. Instead, such cases are accommodated by the inclusion of one or more parameters in the model. If, for example, player $1$ has one or more of its predictor values $x_{11},\ldots,x_{1p}$ missing, then the combination of Equations~\ref{eq:unstructured} and \ref{eq:structured} above yields \begin{equation} \logit[\pr(1\ \mathrm{beats}\ j)]=\lambda_1 - \left(\sum_{r=1}^p\beta_rx_{jr} + U_j\right), \end{equation} for all other players $j$. This results in the inclusion of a `direct' ability parameter for each player having missing predictor values, in addition to the common coefficients $\beta_1,\ldots,\beta_p$ -- an approach which will be appropriate when the missingness mechanism is unrelated to contest success. The same device can be used also to accommodate any user-specified departures from a structured Bradley-Terry model, whereby some players have their abilities determined by the linear predictor but others do not. In the original analysis of the \code{flatlizards} data \citep{whit:06}, the final model included the first and third principal components of the spectral reflectance from the throat (representing brightness and UV intensity respectively) as well as head length and the snout to vent length seen in our earlier model. The spectroscopy data was missing for two lizards, therefore the ability of these lizards was estimated directly. The following fits this model, with the addition of a random intercept as before: @ <>= lizModel2 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards) summary(lizModel2) @ %def Note that \code{BTm} detects that lizards 96 and 99 have missing values in the specified predictors and automatically includes separate ability parameters for these lizards. This model was found to be the single best model based on the principal components of reflectance and the other predictors available and indeed the standard deviation of the random intercept is much reduced, but still highly significant. Allowing for this significant variation between lizards with the same predictor values produces more realistic (i.e., larger) standard errors for the parameters when compared to the original analysis of \citet{whit:06}. Although this affects the significance of the morphological variables, it does not affect the significance of the principal components, so in this case does not affect the main conclusions of the study. \subsection{Order effect} \label{sec:order} In certain types of application some or all contests have an associated `bias', related to the order in which items are presented to a judge or with the location in which a contest takes place, for example. A natural extension of the Bradley-Terry model (Equation~\ref{eq:unstructured}) is then \begin{equation} \logit[\pr(i\ \mathrm{beats}\ j)]=\lambda_i-\lambda_j + \delta z, \end{equation} where $z=1$ if $i$ has the supposed advantage and $z=-1$ if $j$ has it. (If the `advantage' is in fact a disadvantage, $\delta$ will be negative.) The scores $\lambda_i$ then relate to ability in the absence of any such advantage. As an example, consider the baseball data given in \citet{agre:02}, page 438: @ <>= data("baseball", package = "BradleyTerry2") head(baseball) @ %def The data set records the home wins and losses for each baseball team against each of the 6 other teams in the data set. The \code{head} function is used to show the first 6 records, which are the Milwaukee home games. We see for example that Milwaukee played 7 home games against Detroit and won 4 of them. The `standard' Bradley-Terry model without a home-advantage parameter will be fitted if no formula is specified in the call to \code{BTm}: @ <>= baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") summary(baseballModel1) @ %def The reference team is Baltimore, estimated to be the weakest of these seven, with Milwaukee and Detroit the strongest. In the above, the ability of each team is modelled simply as \code{~ team} where the values of the factor \code{team} are given by \code{home.team} for the first team and \code{away.team} for the second team in each game. To estimate the home-advantage effect, an additional variable is required to indicate whether the team is at home or not. Therefore data frames containing both the team factor and this new indicator variable are required in place of the factors \code{home.team} and \code{away.team} in the call to \code{BTm}. This is achieved here by over-writing the \code{home.team} and \code{away.team} factors in the \code{baseball} data frame: @ <>= baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) @ %def The \code{at.home} variable is needed for both the home team and the away team, so that it can be differenced as appropriate in the linear predictor. With the data organised in this way, the ability formula can now be updated to include the \code{at.home} variable as follows: @ <>= baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) summary(baseballModel2) @ %def \vspace*{-0.3cm} This reproduces the results given on page 438 of \citet{agre:02}: the home team has an estimated odds-multiplier of $\exp(0.3023) = 1.35$ in its favour. \vspace*{-0.2cm} \subsection{More general (contest-specific) predictors} \label{sec:CEMS} The `home advantage' effect is a simple example of a contest-specific predictor. Such predictors are necessarily interactions, between aspects of the contest and (aspects of) the two `players' involved. For more elaborate examples of such effects, see \code{?chameleons} and \code{?CEMS}. The former includes an `experience' effect, which changes through time, on the fighting ability of male chameleons. The latter illustrates a common situation in psychometric applications of the Bradley-Terry model, where \emph{subjects} express preference for one of two \emph{objects} (the `players'), and it is the influence on the results of subject attributes that is of primary interest. As an illustration of the way in which such effects are specified, consider the following model specification taken from the examples in \code{?CEMS}, where data on students' preferences in relation to six European management schools is analysed. \vspace*{-0.3cm} @ <>= data("CEMS", package = "BradleyTerry2") table8.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * LAT[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) @ %def This model reproduces results from Table~8 of \cite{ditt:01} apart from minor differences due to the different treatment of ties. Here the outcome is the binomial frequency of preference for \code{school1} over \code{school2}, with ties counted as half a `win' and half a `loss'. The formula specifies the model for school `ability' or worth. In this formula, the default label `\code{..}' represents the school (with values given by \code{school1} or \code{school2} as appropriate) and \code{student} is a factor specifying the student that made the comparison. The remaining variables in the formula use \proglang{R}'s standard indexing mechanism to include student-specific variables, e.g., \code{WOR}: whether or not the student was in full-time employment, and school-specific variables, e.g., \code{LAT}: whether the school was in a `Latin' city. Thus there are three types of variables: contest-specific (\code{school1}, \code{school2}, \code{student}), subject-specific (\code{WOR}, \code{DEG}, \ldots) and object-specific (\code{LAT}, \code{St.Gallen}, \ldots). These three types of variables are provided in three data frames, contained in the list object \code{CEMS}. \section{Ability scores} \label{sec:ability} The function \code{BTabilities} extracts estimates and standard errors for the log-ability scores $\lambda_1, \ldots,\lambda_K$. These will either be `direct' estimates, in the case of the standard Bradley-Terry model or for players with one or more missing predictor values, or `model-based' estimates of the form $\hat\lambda_i=\sum_{r=1}^p\hat\beta_rx_{ir}$ for players whose ability is predicted by explanatory variables. As a simple illustration, team ability estimates in the home-advantage model for the \code{baseball} data are obtained by: @ <>= BTabilities(baseballModel2) @ %def This gives, for each team, the estimated ability when the team enjoys no home advantage. Similarly, estimates of the fighting ability of each lizard in the \code{flatlizards} data under the model based on the principal components of the spectral reflectance from the throat are obtained as follows: @ <>= head(BTabilities(lizModel2), 4) @ %def % The ability estimates in an unstructured Bradley-Terry model are particularly well suited to presentation using the device of \emph{quasi-variances} \citep{firt:04}. The \pkg{qvcalc} package \citep[][version 0.8-5 or later]{firt:10} contains a function of the same name which does the necessary work: \begin{Sinput} > library("qvcalc") > baseball.qv <- qvcalc(BTabilities(baseballModel2)) > plot(baseball.qv, + levelNames = c("Bal", "Bos", "Cle", "Det", "Mil", "NY", "Tor")) \end{Sinput} % \begin{figure}[t!] \centering \includegraphics[width=0.67\textwidth]{baseball-qvplot.pdf} \caption{Estimated relative abilities of baseball teams.\label{fig:qvplot}} \end{figure} % The `comparison intervals' as shown in Figure~\ref{fig:qvplot} are based on `quasi standard errors', and can be interpreted as if they refer to \emph{independent} estimates of ability for the journals. This has the advantage that comparison between any pair of journals is readily made (i.e., not only comparisons with the `reference' journal). For details of the theory and method of calculation see \citet{firt:04}. \section{Residuals} \label{sec:residuals} There are two main types of residuals available for a Bradley-Terry model object. First, there are residuals obtained by the standard methods for models of class \code{"glm"}. These all deliver one residual for each contest or type of contest. For example, Pearson residuals for the model \code{lizModel2} can be obtained simply by \vspace*{0.2cm} @ <>= res.pearson <- round(residuals(lizModel2), 3) head(cbind(flatlizards$contests, res.pearson), 4) @ %def \vspace*{-0.2cm} More useful for diagnostics on the linear predictor $\sum\beta_rx_{ir}$ are `player'-level residuals, obtained by using the function \code{residuals} with argument \code{type = "grouped"}. These residuals can then be plotted against other player-specific variables. \vspace*{-0.2cm} @ <>= res <- residuals(lizModel2, type = "grouped") # with(flatlizards$predictors, plot(throat.PC2, res)) # with(flatlizards$predictors, plot(head.width, res)) @ %def \vspace*{-0.2cm} These residuals estimate the error in the linear predictor; they are obtained by suitable aggregation of the so-called `working' residuals from the model fit. The \code{weights} attribute indicates the relative information in these residuals -- weight is roughly inversely proportional to variance -- which may be useful for plotting and/or interpretation; for example, a large residual may be of no real concern if based on very little information. Weighted least-squares regression of these residuals on any variable already in the model is null. For example: \vspace*{-0.2cm} @ <>= lm(res ~ throat.PC1, weights = attr(res, "weights"), data = flatlizards$predictors) lm(res ~ head.length, weights = attr(res, "weights"), data = flatlizards$predictors) @ %def %$ \vspace*{-0.2cm} As an illustration of evident \emph{non-null} residual structure, consider the unrealistically simple model \code{lizModel} that was fitted in Section~\ref{sec:covariates} above. That model lacks the clearly significant predictor variable \code{throat.PC3}, and the plot shown in Figure~\ref{fig:residuals} demonstrates this fact graphically: \begin{Sinput} > lizModel.residuals <- residuals(lizModel, type = "grouped") > plot(flatlizards$predictors$throat.PC3, lizModel.residuals) \end{Sinput} % \begin{figure}[t!] \centering \includegraphics[width=0.69\textwidth]{residuals.pdf} \caption{Lizard residuals for the simple model \code{lizModel}, plotted against \code{throat.PC3}.\label{fig:residuals}} \end{figure} % The residuals in the plot exhibit a strong, positive regression slope in relation to the omitted predictor variable \code{throat.PC3}. \section{Model search} \label{sec:model} In addition to \code{update()} as illustrated in preceding sections, methods for the generic functions \code{add1()}, \code{drop1()} and \code{anova()} are provided. These can be used to investigate the effect of adding or removing a variable, whether that variable is contest-specific, such as an order effect, or player-specific; and to compare the fit of nested models. %These can be used in the standard way for model elaboration or specialization, %and their availability also allows the use of \texttt{\color{black} step()} for %automated exploration of a set of candidate player-specific predictors. \section{Setting up the data} \label{sec:data} \subsection{Contest-specific data} \label{sec:contest} The \code{outcome} argument of \code{BTm} represents a binomial response and can be supplied in any of the formats allowed by the \code{glm} function. That is, either a two-column matrix with the columns giving the number of wins and losses (for \code{player1} vs.\ \code{player2}), a factor where the first level denotes a loss and all other levels denote a win, or a binary variable where 0 denotes a loss and 1 denotes a win. Each row represents either a single contest or a set of contests between the same two players. The \code{player1} and \code{player2} arguments are either factors specifying the two players in each contest, or data frames containing such factors, along with any contest-specific variables that are also player-specific, such as the \code{at.home} variable seen in Section~\ref{sec:order}. If given in data frames, the factors identifying the players should be named as specified by the \code{id} argument and should have identical levels, since they represent a particular sample of the full set of players. Thus for the model \code{baseballModel2}, which was specified by the following call: @ <>= baseballModel2$call @ %def the data are provided in the \code{baseball} data frame, which has the following structure: @ <>= str(baseball, vec.len = 2) @ %def In this case \code{home.team} and \code{away.team} are both data frames, with the factor \code{team} specifying the team and the variable \code{at.home} specifying whether or not the team was at home. So the first comparison @ <>= baseball$home.team[1,] baseball$away.team[1,] @ %def is Milwaukee playing at home against Detroit. The outcome is given by @ <>= baseball[1, c("home.wins", "away.wins")] @ %def Contest-specific variables that are \emph{not} player-specific -- for example, whether it rained or not during a contest -- should only be used in interactions with variables that \emph{are} player-specific, otherwise the effect on ability would be the same for both players and would cancel out. Such variables can conveniently be provided in a single data frame along with the \code{outcome}, \code{player1} and \code{player2} data. An offset in the model can be specified by using the \code{offset} argument to \code{BTm}\null. This facility is provided for completeness: the authors have not yet encountered an application where it is needed. To use only certain rows of the contest data in the analysis, the \code{subset} argument may be used in the call to \code{BTm}. This should either be a logical vector of the same length as the binomial response, or a numeric vector containing the indices of rows to be used. \subsection{Non contest-specific data} \label{sec:non-contest} Some variables do not vary by contest directly, but rather vary by a factor that is contest-specific, such as the player ID or the judge making the paired comparison. For such variables, it is more economical to store the data by the levels of the contest-specific factor and use indexing to obtain the values for each contest. The \code{CEMS} example in Section~\ref{sec:CEMS} provides an illustration of such variables. In this example student-specific variables are indexed by \code{student} and school-specific variables are indexed by \code{..}, i.e., the first or second school in the comparison as appropriate. There are then two extra sets of variables in addition to the usual contest-specific data as described in the last section. A good way to provide these data to \code{BTm} is as a list of data frames, one for each set of variables, e.g., @ <>= str(CEMS, vec.len = 2) @ %def The names of the data frames are only used by \code{BTm} if they match the names specified in the \code{player1} and \code{player2} arguments, in which case it is assumed that these are data frames providing the data for the first and second player respectively. The rows of data frames in the list should either correspond to the contests or the levels of the factor used for indexing. Player-specific offsets should be included in the formula by using the \code{offset} function. \subsection{Converting data from a `wide' format} The \code{BTm} function requires data in a `long' format, with one row per contest, provided either directly as in Section~\ref{sec:contest} or via indexing as in Section~\ref{sec:non-contest}. In studies where the same set of paired comparisons are made by several judges, as in a questionnaire for example, the data may be stored in a `wide' format, with one row per judge. As an example, consider the \code{cemspc} data from the \pkg{prefmod} package \citep{hatz:12}, which provides data from the CEMS study in a wide format. Each row corresponds to one student; the first 15 columns give the outcome of all pairwise comparisons between the 6~schools in the study and the last two columns correspond to two of the student-specific variables: \code{ENG} (indicating the student's knowledge of English) and \code{SEX} (indicating the student's gender). The following steps convert these data into a form suitable for analysis with \code{BTm}. First a new data frame is created from the student-specific variables and these variables are converted to factors: @ <>= library("prefmod") student <- cemspc[c("ENG", "SEX")] student$ENG <- factor(student$ENG, levels = 1:2, labels = c("good", "poor")) student$SEX <- factor(student$SEX, levels = 1:2, labels = c("female", "male")) @ %def This data frame is put into a list, which will eventually hold all the necessary data. Then a \code{student} factor is created for indexing the student data to produce contest-level data. This is put in a new data frame that will hold the contest-specific data. @ <>= cems <- list(student = student) student <- gl(303, 1, 303 * 15) #303 students, 15 comparisons contest <- data.frame(student = student) @ %def Next the outcome data is converted to a binomial response, adjusted for ties. The result is added to the \code{contest} data frame. @ <>= win <- cemspc[, 1:15] == 0 lose <- cemspc[, 1:15] == 2 draw <- cemspc[, 1:15] == 1 contest$win.adj <- c(win + draw/2) contest$lose.adj <- c(lose + draw/2) @ %def Then two factors are created identifying the first and second school in each comparison. The comparisons are in the order 1 vs.\ 2, 1 vs.\ 3, 2 vs.\ 3, 1 vs.\ 4, \ldots, so the factors can be created as follows: @ <>= lab <- c("London", "Paris", "Milano", "St. Gallen", "Barcelona", "Stockholm") contest$school1 <- factor(sequence(1:5), levels = 1:6, labels = lab) contest$school2 <- factor(rep(2:6, 1:5), levels = 1:6, labels = lab) @ %def Note that both factors have exactly the same levels, even though only five of the six players are represented in each case. In other words, the numeric factor levels refer to the same players in each case, so that the player is unambiguously identified. This ensures that player-specific parameters and player-specific covariates are correctly specified. Finally the \code{contest} data frame is added to the main list: @ <>= cems$contest <- contest @ %def This creates a single data object that can be passed to the \code{data} argument of \code{BTm}. Of course, such a list could be created on-the-fly as in \code{data = list(contest, student)}, which may be more convenient in practice. \subsection[Converting data from the format required by the earlier BradleyTerry package]{Converting data from the format required by the earlier \pkg{BradleyTerry} package} The \pkg{BradleyTerry} package described in \citet{firt:05} required contest/comparison results to be in a data frame with columns named \code{winner}, \code{loser} and \code{Freq}. The following example shows how \code{xtabs} and \code{countsToBinomial} can be used to convert such data for use with the \code{BTm} function in \pkg{BradleyTerry2}: \begin{Sinput} > library("BradleyTerry") ## the /old/ BradleyTerry package > ## load data frame with columns "winner", "loser", "Freq" > data("citations", package = "BradleyTerry") > ## convert to 2-way table of counts > citations <- xtabs(Freq ~ winner + loser, citations) > ## convert to a data frame of binomial observations > citations.sf <- countsToBinomial(citations) \end{Sinput} The \code{citations.sf} data frame can then be used with \code{BTm} as shown in Section~\ref{citations}. \section[A list of the functions provided in BradleyTerry2]{A list of the functions provided in \pkg{BradleyTerry2}} \label{sec:functions} The standard \R\ help files provide the definitive reference. Here we simply list the main user-level functions and their arguments, as a convenient overview: @ <>= ## cf. prompt options(width = 55) for (fn in getNamespaceExports("BradleyTerry2")) { name <- as.name(fn) args <- formals(fn) n <- length(args) arg.names <- arg.n <- names(args) arg.n[arg.n == "..."] <- "\\dots" is.missing.arg <- function(arg) typeof(arg) == "symbol" && deparse(arg) == "" Call <- paste(name, "(", sep = "") for (i in seq_len(n)) { Call <- paste(Call, arg.names[i], if (!is.missing.arg(args[[i]])) paste(" = ", paste(deparse(args[[i]]), collapse = "\n"), sep = ""), sep = "") if (i != n) Call <- paste(Call, ", ", sep = "") } Call <- paste(Call, ")", sep = "") cat(deparse(parse(text = Call)[[1]], width.cutoff = 50), fill = TRUE) } options(width = 60) @ %def \section{Some final remarks} \label{sec:finalremarks} \subsection[A note on the treatment of ties]{A note on the treatment of ties} The present version of \BT\ provides no sophisticated facilities for handling tied contests/comparisons; the well-known models of \cite{rao:kupp:67} and \cite{davi:70} are not implemented here. At present the \code{BTm} function requires a binary or binomial response variable, the third (`tied') category of response is not allowed. In several of the data examples (e.g., \code{?CEMS}, \code{?springall}, \code{?sound.fields}), ties are handled by the crude but simple device of adding half of a `win' to the tally for each player involved; in each of the examples where this has been done it is found that the result is very similar, after a simple re-scaling, to the more sophisticated analyses that have appeared in the literature. Note that this device when used with \code{BTm} typically gives rise to warnings produced by the back-end \code{glm} function, about non-integer `binomial' counts; such warnings are of no consequence and can be safely ignored. It is likely that a future version of \BT\ will have a more general method for handling ties. \subsection{A note on `contest-specific' random effects} The current version of \BT\ provides facilities for fitting models with random effects in `player-specific' predictor functions, as illustrated in Section~\ref{sec:covariates}. For more general, `contest-specific' random-effect structures, such as random `judge' effects in psychological studies \citep[e.g.,][]{bock:01}, \BT\ provides (through \code{BTm}) the necessary user interface but as yet no back-end calculation. It is hoped that this important generalization can be made successfully in a future version of \BT. \section*{Acknowledgments} This work was supported by the UK Engineering and Physical Sciences Research Council. \begin{thebibliography}{22} \newcommand{\enquote}[1]{``#1''} \providecommand{\natexlab}[1]{#1} \providecommand{\url}[1]{\texttt{#1}} \providecommand{\urlprefix}{URL } \expandafter\ifx\csname urlstyle\endcsname\relax \providecommand{\doi}[1]{doi:\discretionary{}{}{}#1}\else \providecommand{\doi}{doi:\discretionary{}{}{}\begingroup \urlstyle{rm}\Url}\fi \providecommand{\eprint}[2][]{\url{#2}} \bibitem[{Agresti(2002)}]{agre:02} Agresti A (2002). \newblock \emph{Categorical Data Analysis}. \newblock 2nd edition. John Wiley \& Sons. \bibitem[{Bates \emph{et~al.}(2011)Bates, M\"achler, and Bolker}]{bate:11} Bates D, M\"achler M, Bolker B (2011). \newblock \emph{\pkg{lme4}: Linear Mixed-Effects Models Using \proglang{S}4 Classes}. \newblock \proglang{R}~package version~0.999375-42, \urlprefix\url{http://CRAN.R-project.org/package=lme4}. \bibitem[{B\"ockenholt(2001)}]{bock:01} B\"ockenholt U (2001). \newblock \enquote{Hierarchical Modeling of Paired Comparison Data.} \newblock \emph{Psychological Methods}, \textbf{6}(1), 49--66. \bibitem[{Bradley(1984)}]{brad:84} Bradley RA (1984). \newblock \enquote{Paired Comparisons: Some Basic Procedures and Examples.} \newblock In PR~Krishnaiah, PK~Sen (eds.), \emph{Nonparametric Methods}, volume~4 of \emph{Handbook of Statistics}, pp. 299 -- 326. Elsevier. \bibitem[{Bradley and Terry(1952)}]{brad:terr:52} Bradley RA, Terry ME (1952). \newblock \enquote{Rank Analysis of Incomplete Block Designs {I}: {T}he Method of Paired Comparisons.} \newblock \emph{Biometrika}, \textbf{39}, 324--45. \bibitem[{Breslow and Clayton(1993)}]{bres:93} Breslow NE, Clayton DG (1993). \newblock \enquote{Approximate Inference in Generalized Linear Mixed Models.} \newblock \emph{Journal of the American Statistical Association}, \textbf{88}(421), 9--25. \bibitem[{Davidson(1970)}]{davi:70} Davidson RR (1970). \newblock \enquote{On Extending the {B}radley-{T}erry Model to Accommodate Ties in Paired Comparison Experiments.} \newblock \emph{Journal of the American Statistical Association}, \textbf{65}, 317--328. \bibitem[{Dittrich \emph{et~al.}(2001)Dittrich, Hatzinger, and Katzenbeisser}]{ditt:01} Dittrich R, Hatzinger R, Katzenbeisser W (2001). \newblock \enquote{Corrigendum: {M}odelling the Effect of Subject-Specific Covariates in Paired Comparison Studies with an Application to University Rankings.} \newblock \emph{Applied Statistics}, \textbf{50}, 247--249. \bibitem[{Firth(1993)}]{firt:93} Firth D (1993). \newblock \enquote{Bias Reduction of Maximum Likelihood Estimates.} \newblock \emph{Biometrika}, \textbf{80}, 27--38. \bibitem[{Firth(2005)}]{firt:05} Firth D (2005). \newblock \enquote{Bradley-Terry Models in \proglang{R}.} \newblock \emph{Journal of Statistical Software}, \textbf{12}(1), 1--12. \newblock \urlprefix\url{http://www.jstatsoft.org/v12/i01/}. \bibitem[{Firth(2010)}]{firt:10} Firth D (2010). \newblock \emph{\pkg{qvcalc}: Quasi-Variances for Factor Effects in Statistical Models}. \newblock \proglang{R}~package version~0.8-7, \urlprefix\url{http://CRAN.R-project.org/package=qvcalc}. \bibitem[{Firth and {de Menezes}(2004)}]{firt:04} Firth D, {de Menezes} RX (2004). \newblock \enquote{Quasi-Variances.} \newblock \emph{Biometrika}, \textbf{91}, 65--80. \bibitem[{Hatzinger and Dittrich(2012)}]{hatz:12} Hatzinger R, Dittrich R (2012). \newblock \enquote{\pkg{prefmod}: An \proglang{R} Package for Modeling Preferences Based on Paired Comparisons, Rankings, or Ratings.} \newblock \emph{Journal of Statistical Software}, \textbf{48}(10), 1--31. \newblock \urlprefix\url{http://www.jstatsoft.org/v48/i10/}. \bibitem[{Heinze and Schemper(2002)}]{hein:sche:02} Heinze G, Schemper M (2002). \newblock \enquote{A Solution to the Problem of Separation in Logistic Regression.} \newblock \emph{Statistics in Medicine}, \textbf{21}, 2409--2419. \bibitem[{Ihaka and Gentleman(1996)}]{ihak:gent:96} Ihaka R, Gentleman R (1996). \newblock \enquote{\proglang{R}: A Language for Data Analysis and Graphics.} \newblock \emph{Journal of Computational and Graphical Statistics}, \textbf{5}(3), 299--314. \bibitem[{Kosmidis(2007)}]{kosm:07} Kosmidis I (2007). \newblock \emph{\pkg{brglm}: Bias Reduction in Binary-Response GLMs}. \newblock \proglang{R}~package version~0.5-6, \urlprefix\url{http://www.ucl.ac.uk/~ucakiko/software.html}. \bibitem[{Rao and Kupper(1967)}]{rao:kupp:67} Rao PV, Kupper LL (1967). \newblock \enquote{Ties in Paired-Comparison Experiments: {A} Generalization of the {B}radley-{T}erry Model.} \newblock \emph{Journal of the American Statistical Association}, \textbf{62}, 194--204. \bibitem[{{\proglang{R} Development Core Team}(2012)}]{R} {\proglang{R} Development Core Team} (2012). \newblock \emph{\proglang{R}: A Language and Environment for Statistical Computing}. \newblock \proglang{R} Foundation for Statistical Computing, Vienna, Austria. \newblock {ISBN} 3-900051-07-0, \urlprefix\url{http://www.R-project.org/}. \bibitem[{Sham and Curtis(1995)}]{sham:curt:95} Sham PC, Curtis D (1995). \newblock \enquote{An Extended Transmission/Disequilibrium Test ({TDT}) for Multi-Allele Marker Loci.} \newblock \emph{Annals of Human Genetics}, \textbf{59}(3), 323--336. \bibitem[{Stigler(1994)}]{stig:94} Stigler S (1994). \newblock \enquote{Citation Patterns in the Journals of Statistics and Probability.} \newblock \emph{Statistical Science}, \textbf{9}, 94--108. \bibitem[{Turner and Firth(2012)}]{turn:12} Turner H, Firth D (2012). \newblock \enquote{Bradley-Terry Models in \proglang{R}: The \pkg{BradleyTerry2} Package.} \newblock \emph{Journal of Statistical Software}, \textbf{48}(9), 1--21. \newblock \urlprefix\url{http://www.jstatsoft.org/v48/i09/}. \bibitem[{Whiting \emph{et~al.}({2006})Whiting, Stuart-Fox, O'Connor, Firth, Bennett, and Blomberg}]{whit:06} Whiting MJ, Stuart-Fox DM, O'Connor D, Firth D, Bennett NC, Blomberg SP ({2006}). \newblock \enquote{{Ultraviolet Signals Ultra-Aggression in a Lizard}.} \newblock \emph{Animal Behaviour}, \textbf{{72}}, 353--363. \end{thebibliography} \end{document} BradleyTerry2/vignettes/BradleyTerry-concordance.tex0000744000176200001440000000140413441760332022365 0ustar liggesusers\Sconcordance{concordance:BradleyTerry.tex:BradleyTerry.Rnw:% 1 72 1 1 6 72 1 1 3 4 0 1 2 1 3 4 0 1 2 1 3 12 0 1 2 % 8 1 1 3 1 0 2 1 12 0 1 2 4 1 1 4 2 0 1 1 17 0 1 2 17 % 1 1 3 18 0 1 2 25 1 1 3 17 0 1 2 34 1 1 3 1 0 1 1 1 2 % 4 0 1 2 18 1 1 3 22 0 1 2 36 1 1 6 4 0 1 1 26 0 1 2 % 27 1 1 3 1 0 1 1 12 0 1 2 5 1 1 4 2 0 1 1 29 0 1 2 11 % 1 1 3 1 0 1 1 3 0 1 2 3 1 1 3 1 0 1 1 31 0 1 2 30 1 1 % 3 1 0 1 9 11 0 1 2 28 1 1 3 14 0 1 2 5 1 1 3 11 0 1 2 % 38 1 1 3 1 0 1 1 10 0 1 2 9 1 1 3 6 0 1 4 14 1 1 4 13 % 0 1 2 13 0 1 2 63 1 1 3 9 0 1 2 1 1 1 3 15 0 1 2 2 1 % 1 3 7 0 1 1 7 0 1 2 1 3 8 0 1 2 34 1 1 3 33 0 1 2 27 % 1 1 3 1 0 1 1 1 2 1 0 1 2 4 0 1 2 3 1 1 3 1 0 2 1 3 0 % 1 2 1 1 1 3 1 0 4 1 3 0 1 2 2 1 1 4 2 0 2 1 3 0 1 2 6 % 1 1 3 4 0 1 2 26 1 1 23 29 0 1 1 1 2 197 1} BradleyTerry2/vignettes/BradleyTerry.bib0000744000176200001440000001705013157723067020061 0ustar liggesusers@Manual{r, title = {\proglang{R}: A Language and Environment for Statistical Computing}, author = {{\proglang{R} Development Core Team}}, organization = {\proglang{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2012}, note = {{ISBN} 3-900051-07-0}, url = {http://www.R-project.org/}, } @Article{bock:01, author = {U B\"ockenholt}, year = {2001}, title = {Hierarchical Modeling of Paired Comparison Data}, journal = {Psychological Methods}, volume = {6}, number = {1}, pages = {49-66}, } @Book{agre:02, year = {2002}, title = {Categorical Data Analysis}, edition = {2nd}, publisher = {John Wiley \& Sons}, author = {A. Agresti}, } @InCollection{brad:84, title = {Paired Comparisons: Some Basic Procedures and Examples}, editor = {P. R. Krishnaiah and P. K. Sen}, booktitle = {Nonparametric Methods}, publisher = {Elsevier}, year = {1984}, volume = {4}, pages = {299 - 326}, series = {Handbook of Statistics}, author = {R. A. Bradley}, } @Article{brad:terr:52, journal = {Biometrika}, year = {1952}, title = {Rank Analysis of Incomplete Block Designs {I}: {T}he Method of Paired Comparisons}, pages = {324--45}, author = {R. A. Bradley and M. E. Terry}, volume = {39}, } @Article{sham:curt:95, journal = {Annals of Human Genetics}, year = {1995}, title = {An Extended Transmission/Disequilibrium Test ({TDT}) for Multi-Allele Marker Loci}, number = {3}, pages = {323--336}, author = {P. C. Sham and D. Curtis}, volume = {59}, } @Article{ihak:gent:96, journal = {Journal of Computational and Graphical Statistics}, year = {1996}, title = {\proglang{R}: A Language for Data Analysis and Graphics}, number = {3}, pages = {299--314}, author = {Ross Ihaka and Robert Gentleman}, volume = {5}, } @article{spring:73, Journal = {Applied Statistics}, Year = {1973}, Title = {Response Surface Fitting Using a Generalization of the {B}radley-{T}erry Paired Comparisons Model}, Pages = {59--68}, Author = {Springall, A}, Volume = {22}} @article{crit:flig:91, Journal = {Psychometrika}, Year = {1991}, Title = {Paired Comparison, Triple Comparison, and Ranking Experiments as Generalized Linear Models, and Their Implementation in {GLIM}}, Pages = {517--533}, Author = {Critchlow, D E and Fligner, M A}, Volume = {56}} @Article{firt:93, journal = {Biometrika}, year = {1993}, title = {Bias Reduction of Maximum Likelihood Estimates}, pages = {27--38}, author = {D Firth}, volume = {80}, } @Article{hein:sche:02, journal = {Statistics in Medicine}, year = {2002}, title = {A Solution to the Problem of Separation in Logistic Regression}, author = {G Heinze and M Schemper}, pages = {2409--2419}, volume = {21}, } @Article{stig:94, journal = {Statistical Science}, year = {1994}, title = {Citation Patterns in the Journals of Statistics and Probability}, pages = {94--108}, author = {S Stigler}, volume = {9}, } @Article{bres:93, journal = {Journal of the American Statistical Association}, year = {1993}, title = {Approximate Inference in Generalized Linear Mixed Models}, pages = {9--25}, author = {N E Breslow and D G Clayton}, volume = {88}, number = {421}, } @article{spri:73, author = {Springall, A}, title = {Response Surface Fitting Using a Generalization of the {B}radley-{T}erry Paired Comparison Model}, year = {1973}, journal = {Applied Statistics}, volume = {22}, pages = {59--68} } @article{ditt:98, author = {Dittrich, R and Hatzinger, R and Katzenbeisser, W}, title = {Modelling the Effect of Subject-specific Covariates in Paired Comparison Studies with an Application to University Rankings}, year = {1998}, journal = {Applied Statistics}, volume = {47}, pages = {511--525}, keywords = {Bradley-Terry model; Log-linear model} } @Article{ditt:01, author = {R Dittrich and R Hatzinger and W Katzenbeisser}, title = {Corrigendum: {M}odelling the Effect of Subject-Specific Covariates in Paired Comparison Studies with an Application to University Rankings}, year = {2001}, journal = {Applied Statistics}, volume = {50}, pages = {247--249}, } @Article{davi:70, author = {R. R. Davidson}, title = {On Extending the {B}radley-{T}erry Model to Accommodate Ties in Paired Comparison Experiments}, year = {1970}, journal = {Journal of the American Statistical Association}, volume = {65}, pages = {317--328}, } @Article{rao:kupp:67, author = {P. V. Rao and L. L. Kupper}, title = {Ties in Paired-Comparison Experiments: {A} Generalization of the {B}radley-{T}erry Model}, year = {1967}, journal = {Journal of the American Statistical Association}, volume = {62}, pages = {194--204}, } @Article{whit:06, author = {Martin J. Whiting and Devi M. Stuart-Fox and David O'Connor and David Firth and Nigel C. Bennett and Simon P. Blomberg}, title = {{Ultraviolet Signals Ultra-Aggression in a Lizard}}, journal = {Animal Behaviour}, year = {{2006}}, volume = {{72}}, pages = {353--363}, } @article{stua:06, Author = {Stuart-Fox, D M and Firth, D and Moussalli, A and Whiting, M J}, Title = {Multiple Signals in Chameleon Contests: Designing and Analysing Animal Contests as a Tournament}, Journal = {Animal Behaviour}, Year = {{2006}}, Volume = {{71}}, Pages = {1263--1271}, DOI = {10.1016/j.anbehav.2005.07.028} } @article{kous:84, author = {Kousgaard, N}, title = {Analysis of a Sound Field Experiment by a Model for Paired Comparisons with Explanatory Variables}, year = {1984}, journal = {Scandinavian Journal of Statistics}, volume = {11}, pages = {51--57}, keywords = {Bradley-Terry model} } @Article{firt:04, author = {D. Firth and R. X. {de Menezes}}, title = {Quasi-Variances}, journal = {Biometrika}, volume = {91}, year = {2004}, pages = {65--80}, } @Article{firt:05, author = {David Firth}, title = {Bradley-Terry Models in \proglang{R}}, journal = {Journal of Statistical Software}, year = {2005}, volume = {12}, number = {1}, pages = {1--12}, url = {http://www.jstatsoft.org/v12/i01/} } @Manual{kosm:07, title = {\pkg{brglm}: Bias Reduction in Binary-Response GLMs}, author = {Ioannis Kosmidis}, year = {2007}, note = {\proglang{R}~package version~0.5-6}, url = {http://www.ucl.ac.uk/~ucakiko/software.html}, } @Manual{bate:11, title = {\pkg{lme4}: Linear Mixed-Effects Models Using \proglang{S}4 Classes}, author = {Douglas Bates and Martin M\"achler and Ben Bolker}, year = {2011}, note = {\proglang{R}~package version~0.999375-42}, url = {http://CRAN.R-project.org/package=lme4}, } @Manual{firt:10, title = {\pkg{qvcalc}: Quasi-Variances for Factor Effects in Statistical Models}, author = {David Firth}, year = {2010}, note = {\proglang{R}~package version~0.8-7}, url = {http://CRAN.R-project.org/package=qvcalc}, } @Article{hatz:12, author = {Reinhold Hatzinger and Regina Dittrich}, title = {\pkg{prefmod}: An \proglang{R} Package for Modeling Preferences Based on Paired Comparisons, Rankings, or Ratings}, journal = {Journal of Statistical Software}, year = {2012}, volume = {48}, number = {10}, pages = {1--31}, url = {http://www.jstatsoft.org/v48/i10/} } @Article{turn:12, author = {Heather Turner and David Firth}, title = {Bradley-Terry Models in \proglang{R}: The \pkg{BradleyTerry2} Package}, journal = {Journal of Statistical Software}, year = {2012}, volume = {48}, number = {9}, pages = {1--21}, url = {http://www.jstatsoft.org/v48/i09/} }BradleyTerry2/vignettes/residuals.pdf0000744000176200001440000004163213152515665017462 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20120416000729) /ModDate (D:20120416000729) /Title (R Graphics Output) /Producer (R 2.13.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 9 0 R >> stream 1 J 1 j q Q q 59.04 73.44 414.72 371.52 re W n /sRGB CS 0.000 0.000 0.000 SCN 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 373.76 370.86 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 297.91 364.27 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 217.06 132.95 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 271.98 383.23 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 285.59 363.98 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 365.30 109.35 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 166.54 150.45 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 274.48 215.97 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 328.67 368.87 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 272.35 115.81 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 455.44 365.89 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 241.51 388.89 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 184.46 84.60 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 290.30 359.01 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 376.27 93.93 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 321.69 225.79 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 325.88 145.31 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 330.24 358.44 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 231.58 186.43 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 175.43 117.56 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 187.64 276.05 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 288.44 145.23 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 300.30 272.64 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 232.39 359.08 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 327.14 288.49 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 267.06 243.62 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 237.09 272.74 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 207.74 117.56 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 220.56 285.87 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 306.99 421.78 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 140.81 135.56 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 336.31 428.60 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 405.04 397.04 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 343.34 137.46 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 321.39 130.95 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 369.62 135.77 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 199.22 378.73 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 197.79 380.58 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 391.71 373.06 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 194.90 141.86 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 363.42 363.47 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 238.05 368.46 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 302.64 365.37 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 247.67 296.91 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 281.16 87.02 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 126.01 145.54 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 272.17 150.16 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 264.87 118.10 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 236.66 239.79 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 231.33 367.70 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 162.43 139.70 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 211.98 266.17 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 313.64 126.71 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 355.45 96.44 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 232.66 147.51 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 152.31 270.06 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 161.55 149.19 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 145.16 140.22 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 254.52 141.46 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 252.23 146.83 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 283.14 144.31 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 236.03 137.25 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 309.92 254.74 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 331.25 368.60 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 288.93 142.56 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 118.77 142.71 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 260.49 356.52 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 317.25 312.25 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 364.78 316.81 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 249.62 128.04 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 282.97 230.71 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 388.64 140.44 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 194.71 143.39 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 71.44 116.05 Tm (l) Tj 0 Tr ET BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 324.14 130.38 Tm (l) Tj 0 Tr ET Q q /sRGB CS 0.000 0.000 0.000 SCN 0.75 w [] 0 d 1 J 1 j 10.00 M 77.70 73.44 m 467.08 73.44 l S 77.70 73.44 m 77.70 66.24 l S 142.60 73.44 m 142.60 66.24 l S 207.50 73.44 m 207.50 66.24 l S 272.39 73.44 m 272.39 66.24 l S 337.29 73.44 m 337.29 66.24 l S 402.18 73.44 m 402.18 66.24 l S 467.08 73.44 m 467.08 66.24 l S BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 12.00 0.00 -0.00 12.00 70.86 47.52 Tm (-6) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 135.76 47.52 Tm (-4) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 200.66 47.52 Tm (-2) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 269.06 47.52 Tm (0) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 333.95 47.52 Tm (2) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 398.85 47.52 Tm (4) Tj ET BT /F2 1 Tf 12.00 0.00 -0.00 12.00 463.74 47.52 Tm (6) Tj ET 59.04 74.72 m 59.04 436.85 l S 59.04 74.72 m 51.84 74.72 l S 59.04 165.25 m 51.84 165.25 l S 59.04 255.79 m 51.84 255.79 l S 59.04 346.32 m 51.84 346.32 l S 59.04 436.85 m 51.84 436.85 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 67.88 Tm (-2) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 158.41 Tm (-1) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 252.45 Tm (0) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 342.98 Tm (1) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 433.51 Tm (2) Tj ET 59.04 73.44 m 473.76 73.44 l 473.76 444.96 l 59.04 444.96 l 59.04 73.44 l S Q q BT /sRGB cs 0.000 0.000 0.000 scn /F2 1 Tf 12.00 0.00 -0.00 12.00 179.37 18.72 Tm (flatlizards$predictors$throat.PC3) Tj ET BT /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 211.52 Tm (lizModel.residuals) Tj ET Q endstream endobj 9 0 obj 6385 endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 11 0 R /F2 12 0 R >> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /N 3 /Alternate /DeviceRGB /Length 9433 /Filter /ASCIIHexDecode >> stream 00 00 0c 48 4c 69 6e 6f 02 10 00 00 6d 6e 74 72 52 47 42 20 58 59 5a 20 07 ce 00 02 00 09 00 06 00 31 00 00 61 63 73 70 4d 53 46 54 00 00 00 00 49 45 43 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 00 00 00 f6 d6 00 01 00 00 00 00 d3 2d 48 50 20 20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 11 63 70 72 74 00 00 01 50 00 00 00 33 64 65 73 63 00 00 01 84 00 00 00 6c 77 74 70 74 00 00 01 f0 00 00 00 14 62 6b 70 74 00 00 02 04 00 00 00 14 72 58 59 5a 00 00 02 18 00 00 00 14 67 58 59 5a 00 00 02 2c 00 00 00 14 62 58 59 5a 00 00 02 40 00 00 00 14 64 6d 6e 64 00 00 02 54 00 00 00 70 64 6d 64 64 00 00 02 c4 00 00 00 88 76 75 65 64 00 00 03 4c 00 00 00 86 76 69 65 77 00 00 03 d4 00 00 00 24 6c 75 6d 69 00 00 03 f8 00 00 00 14 6d 65 61 73 00 00 04 0c 00 00 00 24 74 65 63 68 00 00 04 30 00 00 00 0c 72 54 52 43 00 00 04 3c 00 00 08 0c 67 54 52 43 00 00 04 3c 00 00 08 0c 62 54 52 43 00 00 04 3c 00 00 08 0c 74 65 78 74 00 00 00 00 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 38 20 48 65 77 6c 65 74 74 2d 50 61 63 6b 61 72 64 20 43 6f 6d 70 61 6e 79 00 00 64 65 73 63 00 00 00 00 00 00 00 12 73 52 47 42 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 12 73 52 47 42 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 58 59 5a 20 00 00 00 00 00 00 f3 51 00 01 00 00 00 01 16 cc 58 59 5a 20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 58 59 5a 20 00 00 00 00 00 00 6f a2 00 00 38 f5 00 00 03 90 58 59 5a 20 00 00 00 00 00 00 62 99 00 00 b7 85 00 00 18 da 58 59 5a 20 00 00 00 00 00 00 24 a0 00 00 0f 84 00 00 b6 cf 64 65 73 63 00 00 00 00 00 00 00 16 49 45 43 20 68 74 74 70 3a 2f 2f 77 77 77 2e 69 65 63 2e 63 68 00 00 00 00 00 00 00 00 00 00 00 16 49 45 43 20 68 74 74 70 3a 2f 2f 77 77 77 2e 69 65 63 2e 63 68 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 64 65 73 63 00 00 00 00 00 00 00 2e 49 45 43 20 36 31 39 36 36 2d 32 2e 31 20 44 65 66 61 75 6c 74 20 52 47 42 20 63 6f 6c 6f 75 72 20 73 70 61 63 65 20 2d 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 2e 49 45 43 20 36 31 39 36 36 2d 32 2e 31 20 44 65 66 61 75 6c 74 20 52 47 42 20 63 6f 6c 6f 75 72 20 73 70 61 63 65 20 2d 20 73 52 47 42 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 64 65 73 63 00 00 00 00 00 00 00 2c 52 65 66 65 72 65 6e 63 65 20 56 69 65 77 69 6e 67 20 43 6f 6e 64 69 74 69 6f 6e 20 69 6e 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 2c 52 65 66 65 72 65 6e 63 65 20 56 69 65 77 69 6e 67 20 43 6f 6e 64 69 74 69 6f 6e 20 69 6e 20 49 45 43 36 31 39 36 36 2d 32 2e 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 76 69 65 77 00 00 00 00 00 13 a4 fe 00 14 5f 2e 00 10 cf 14 00 03 ed cc 00 04 13 0b 00 03 5c 9e 00 00 00 01 58 59 5a 20 00 00 00 00 00 4c 09 56 00 50 00 00 00 57 1f e7 6d 65 61 73 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 8f 00 00 00 02 73 69 67 20 00 00 00 00 43 52 54 20 63 75 72 76 00 00 00 00 00 00 04 00 00 00 00 05 00 0a 00 0f 00 14 00 19 00 1e 00 23 00 28 00 2d 00 32 00 37 00 3b 00 40 00 45 00 4a 00 4f 00 54 00 59 00 5e 00 63 00 68 00 6d 00 72 00 77 00 7c 00 81 00 86 00 8b 00 90 00 95 00 9a 00 9f 00 a4 00 a9 00 ae 00 b2 00 b7 00 bc 00 c1 00 c6 00 cb 00 d0 00 d5 00 db 00 e0 00 e5 00 eb 00 f0 00 f6 00 fb 01 01 01 07 01 0d 01 13 01 19 01 1f 01 25 01 2b 01 32 01 38 01 3e 01 45 01 4c 01 52 01 59 01 60 01 67 01 6e 01 75 01 7c 01 83 01 8b 01 92 01 9a 01 a1 01 a9 01 b1 01 b9 01 c1 01 c9 01 d1 01 d9 01 e1 01 e9 01 f2 01 fa 02 03 02 0c 02 14 02 1d 02 26 02 2f 02 38 02 41 02 4b 02 54 02 5d 02 67 02 71 02 7a 02 84 02 8e 02 98 02 a2 02 ac 02 b6 02 c1 02 cb 02 d5 02 e0 02 eb 02 f5 03 00 03 0b 03 16 03 21 03 2d 03 38 03 43 03 4f 03 5a 03 66 03 72 03 7e 03 8a 03 96 03 a2 03 ae 03 ba 03 c7 03 d3 03 e0 03 ec 03 f9 04 06 04 13 04 20 04 2d 04 3b 04 48 04 55 04 63 04 71 04 7e 04 8c 04 9a 04 a8 04 b6 04 c4 04 d3 04 e1 04 f0 04 fe 05 0d 05 1c 05 2b 05 3a 05 49 05 58 05 67 05 77 05 86 05 96 05 a6 05 b5 05 c5 05 d5 05 e5 05 f6 06 06 06 16 06 27 06 37 06 48 06 59 06 6a 06 7b 06 8c 06 9d 06 af 06 c0 06 d1 06 e3 06 f5 07 07 07 19 07 2b 07 3d 07 4f 07 61 07 74 07 86 07 99 07 ac 07 bf 07 d2 07 e5 07 f8 08 0b 08 1f 08 32 08 46 08 5a 08 6e 08 82 08 96 08 aa 08 be 08 d2 08 e7 08 fb 09 10 09 25 09 3a 09 4f 09 64 09 79 09 8f 09 a4 09 ba 09 cf 09 e5 09 fb 0a 11 0a 27 0a 3d 0a 54 0a 6a 0a 81 0a 98 0a ae 0a c5 0a dc 0a f3 0b 0b 0b 22 0b 39 0b 51 0b 69 0b 80 0b 98 0b b0 0b c8 0b e1 0b f9 0c 12 0c 2a 0c 43 0c 5c 0c 75 0c 8e 0c a7 0c c0 0c d9 0c f3 0d 0d 0d 26 0d 40 0d 5a 0d 74 0d 8e 0d a9 0d c3 0d de 0d f8 0e 13 0e 2e 0e 49 0e 64 0e 7f 0e 9b 0e b6 0e d2 0e ee 0f 09 0f 25 0f 41 0f 5e 0f 7a 0f 96 0f b3 0f cf 0f ec 10 09 10 26 10 43 10 61 10 7e 10 9b 10 b9 10 d7 10 f5 11 13 11 31 11 4f 11 6d 11 8c 11 aa 11 c9 11 e8 12 07 12 26 12 45 12 64 12 84 12 a3 12 c3 12 e3 13 03 13 23 13 43 13 63 13 83 13 a4 13 c5 13 e5 14 06 14 27 14 49 14 6a 14 8b 14 ad 14 ce 14 f0 15 12 15 34 15 56 15 78 15 9b 15 bd 15 e0 16 03 16 26 16 49 16 6c 16 8f 16 b2 16 d6 16 fa 17 1d 17 41 17 65 17 89 17 ae 17 d2 17 f7 18 1b 18 40 18 65 18 8a 18 af 18 d5 18 fa 19 20 19 45 19 6b 19 91 19 b7 19 dd 1a 04 1a 2a 1a 51 1a 77 1a 9e 1a c5 1a ec 1b 14 1b 3b 1b 63 1b 8a 1b b2 1b da 1c 02 1c 2a 1c 52 1c 7b 1c a3 1c cc 1c f5 1d 1e 1d 47 1d 70 1d 99 1d c3 1d ec 1e 16 1e 40 1e 6a 1e 94 1e be 1e e9 1f 13 1f 3e 1f 69 1f 94 1f bf 1f ea 20 15 20 41 20 6c 20 98 20 c4 20 f0 21 1c 21 48 21 75 21 a1 21 ce 21 fb 22 27 22 55 22 82 22 af 22 dd 23 0a 23 38 23 66 23 94 23 c2 23 f0 24 1f 24 4d 24 7c 24 ab 24 da 25 09 25 38 25 68 25 97 25 c7 25 f7 26 27 26 57 26 87 26 b7 26 e8 27 18 27 49 27 7a 27 ab 27 dc 28 0d 28 3f 28 71 28 a2 28 d4 29 06 29 38 29 6b 29 9d 29 d0 2a 02 2a 35 2a 68 2a 9b 2a cf 2b 02 2b 36 2b 69 2b 9d 2b d1 2c 05 2c 39 2c 6e 2c a2 2c d7 2d 0c 2d 41 2d 76 2d ab 2d e1 2e 16 2e 4c 2e 82 2e b7 2e ee 2f 24 2f 5a 2f 91 2f c7 2f fe 30 35 30 6c 30 a4 30 db 31 12 31 4a 31 82 31 ba 31 f2 32 2a 32 63 32 9b 32 d4 33 0d 33 46 33 7f 33 b8 33 f1 34 2b 34 65 34 9e 34 d8 35 13 35 4d 35 87 35 c2 35 fd 36 37 36 72 36 ae 36 e9 37 24 37 60 37 9c 37 d7 38 14 38 50 38 8c 38 c8 39 05 39 42 39 7f 39 bc 39 f9 3a 36 3a 74 3a b2 3a ef 3b 2d 3b 6b 3b aa 3b e8 3c 27 3c 65 3c a4 3c e3 3d 22 3d 61 3d a1 3d e0 3e 20 3e 60 3e a0 3e e0 3f 21 3f 61 3f a2 3f e2 40 23 40 64 40 a6 40 e7 41 29 41 6a 41 ac 41 ee 42 30 42 72 42 b5 42 f7 43 3a 43 7d 43 c0 44 03 44 47 44 8a 44 ce 45 12 45 55 45 9a 45 de 46 22 46 67 46 ab 46 f0 47 35 47 7b 47 c0 48 05 48 4b 48 91 48 d7 49 1d 49 63 49 a9 49 f0 4a 37 4a 7d 4a c4 4b 0c 4b 53 4b 9a 4b e2 4c 2a 4c 72 4c ba 4d 02 4d 4a 4d 93 4d dc 4e 25 4e 6e 4e b7 4f 00 4f 49 4f 93 4f dd 50 27 50 71 50 bb 51 06 51 50 51 9b 51 e6 52 31 52 7c 52 c7 53 13 53 5f 53 aa 53 f6 54 42 54 8f 54 db 55 28 55 75 55 c2 56 0f 56 5c 56 a9 56 f7 57 44 57 92 57 e0 58 2f 58 7d 58 cb 59 1a 59 69 59 b8 5a 07 5a 56 5a a6 5a f5 5b 45 5b 95 5b e5 5c 35 5c 86 5c d6 5d 27 5d 78 5d c9 5e 1a 5e 6c 5e bd 5f 0f 5f 61 5f b3 60 05 60 57 60 aa 60 fc 61 4f 61 a2 61 f5 62 49 62 9c 62 f0 63 43 63 97 63 eb 64 40 64 94 64 e9 65 3d 65 92 65 e7 66 3d 66 92 66 e8 67 3d 67 93 67 e9 68 3f 68 96 68 ec 69 43 69 9a 69 f1 6a 48 6a 9f 6a f7 6b 4f 6b a7 6b ff 6c 57 6c af 6d 08 6d 60 6d b9 6e 12 6e 6b 6e c4 6f 1e 6f 78 6f d1 70 2b 70 86 70 e0 71 3a 71 95 71 f0 72 4b 72 a6 73 01 73 5d 73 b8 74 14 74 70 74 cc 75 28 75 85 75 e1 76 3e 76 9b 76 f8 77 56 77 b3 78 11 78 6e 78 cc 79 2a 79 89 79 e7 7a 46 7a a5 7b 04 7b 63 7b c2 7c 21 7c 81 7c e1 7d 41 7d a1 7e 01 7e 62 7e c2 7f 23 7f 84 7f e5 80 47 80 a8 81 0a 81 6b 81 cd 82 30 82 92 82 f4 83 57 83 ba 84 1d 84 80 84 e3 85 47 85 ab 86 0e 86 72 86 d7 87 3b 87 9f 88 04 88 69 88 ce 89 33 89 99 89 fe 8a 64 8a ca 8b 30 8b 96 8b fc 8c 63 8c ca 8d 31 8d 98 8d ff 8e 66 8e ce 8f 36 8f 9e 90 06 90 6e 90 d6 91 3f 91 a8 92 11 92 7a 92 e3 93 4d 93 b6 94 20 94 8a 94 f4 95 5f 95 c9 96 34 96 9f 97 0a 97 75 97 e0 98 4c 98 b8 99 24 99 90 99 fc 9a 68 9a d5 9b 42 9b af 9c 1c 9c 89 9c f7 9d 64 9d d2 9e 40 9e ae 9f 1d 9f 8b 9f fa a0 69 a0 d8 a1 47 a1 b6 a2 26 a2 96 a3 06 a3 76 a3 e6 a4 56 a4 c7 a5 38 a5 a9 a6 1a a6 8b a6 fd a7 6e a7 e0 a8 52 a8 c4 a9 37 a9 a9 aa 1c aa 8f ab 02 ab 75 ab e9 ac 5c ac d0 ad 44 ad b8 ae 2d ae a1 af 16 af 8b b0 00 b0 75 b0 ea b1 60 b1 d6 b2 4b b2 c2 b3 38 b3 ae b4 25 b4 9c b5 13 b5 8a b6 01 b6 79 b6 f0 b7 68 b7 e0 b8 59 b8 d1 b9 4a b9 c2 ba 3b ba b5 bb 2e bb a7 bc 21 bc 9b bd 15 bd 8f be 0a be 84 be ff bf 7a bf f5 c0 70 c0 ec c1 67 c1 e3 c2 5f c2 db c3 58 c3 d4 c4 51 c4 ce c5 4b c5 c8 c6 46 c6 c3 c7 41 c7 bf c8 3d c8 bc c9 3a c9 b9 ca 38 ca b7 cb 36 cb b6 cc 35 cc b5 cd 35 cd b5 ce 36 ce b6 cf 37 cf b8 d0 39 d0 ba d1 3c d1 be d2 3f d2 c1 d3 44 d3 c6 d4 49 d4 cb d5 4e d5 d1 d6 55 d6 d8 d7 5c d7 e0 d8 64 d8 e8 d9 6c d9 f1 da 76 da fb db 80 dc 05 dc 8a dd 10 dd 96 de 1c de a2 df 29 df af e0 36 e0 bd e1 44 e1 cc e2 53 e2 db e3 63 e3 eb e4 73 e4 fc e5 84 e6 0d e6 96 e7 1f e7 a9 e8 32 e8 bc e9 46 e9 d0 ea 5b ea e5 eb 70 eb fb ec 86 ed 11 ed 9c ee 28 ee b4 ef 40 ef cc f0 58 f0 e5 f1 72 f1 ff f2 8c f3 19 f3 a7 f4 34 f4 c2 f5 50 f5 de f6 6d f6 fb f7 8a f8 19 f8 a8 f9 38 f9 c7 fa 57 fa e7 fb 77 fc 07 fc 98 fd 29 fd ba fe 4b fe dc ff 6d ff ff > endstream endobj 10 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 12 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 10 0 R >> endobj xref 0 13 0000000000 65535 f 0000000021 00000 n 0000000164 00000 n 0000006751 00000 n 0000006834 00000 n 0000006958 00000 n 0000006991 00000 n 0000000213 00000 n 0000000293 00000 n 0000006731 00000 n 0000016527 00000 n 0000016785 00000 n 0000016869 00000 n trailer << /Size 13 /Info 1 0 R /Root 2 0 R >> startxref 16967 %%EOF BradleyTerry2/R/0000755000176200001440000000000013465114222013145 5ustar liggesusersBradleyTerry2/R/CEMS.R0000744000176200001440000001612213436770253014034 0ustar liggesusers#' Dittrich, Hatzinger and Katzenbeisser (1998, 2001) Data on Management School #' Preference in Europe #' #' *Community of European management schools* (CEMS) data as used in the #' paper by Dittrich et al. (1998, 2001), re-formatted for use with #' [BTm()] #' #' The variables `win1.adj` and `win2.adj` are provided in order to #' allow a simple way of handling ties (in which a tie counts as half a win and #' half a loss), which is slightly different numerically from the Davidson #' (1970) method that is used by Dittrich et al. (1998): see the examples. #' #' @name CEMS #' @docType data #' @format A list containing three data frames, `CEMS$preferences`, #' `CEMS$students` and `CEMS$schools`. #' #' The `CEMS$preferences` data frame has `303 * 15 = 4505` #' observations (15 possible comparisons, for each of 303 students) on the #' following 8 variables: \describe{ #' \item{student}{a factor with #' levels `1:303`} #' \item{school1}{a factor with levels #' `c("Barcelona", "London", "Milano", "Paris", "St.Gallen", #' "Stockholm")`; the first management school in a comparison} #' \item{school2}{a factor with the same levels as `school1`; the #' second management school in a comparison} #' \item{win1}{integer (value #' 0 or 1) indicating whether `school1` was preferred to `school2`} #' \item{win2}{integer (value 0 or 1) indicating whether `school2` #' was preferred to `school1`} #' \item{tied}{integer (value 0 or 1) #' indicating whether no preference was expressed} #' \item{win1.adj}{numeric, equal to `win1 + tied/2`} #' \item{win2.adj}{numeric, equal to `win2 + tied/2`} } #' #' The `CEMS$students` data frame has 303 observations (one for each #' student) on the following 8 variables: \describe{ #' \item{STUD}{a #' factor with levels `c("other", "commerce")`, the student's main #' discipline of study} #' \item{ENG}{a factor with levels `c("good, #' poor")`, indicating the student's knowledge of English} #' \item{FRA}{a #' factor with levels `c("good, poor")`, indicating the student's #' knowledge of French} #' \item{SPA}{a factor with levels `c("good, #' poor")`, indicating the student's knowledge of Spanish} #' \item{ITA}{a #' factor with levels `c("good, poor")`, indicating the student's #' knowledge of Italian} #' \item{WOR}{a factor with levels `c("no", #' "yes")`, whether the student was in full-time employment while studying} #' \item{DEG}{a factor with levels `c("no", "yes")`, whether the #' student intended to take an international degree} #' \item{SEX}{a #' factor with levels `c("female", "male")` } } #' #' The `CEMS$schools` data frame has 6 observations (one for each #' management school) on the following 7 variables: \describe{ #' \item{Barcelona}{numeric (value 0 or 1)} #' \item{London}{numeric (value 0 or 1)} #' \item{Milano}{numeric #' (value 0 or 1)} \item{Paris}{numeric (value 0 or 1)} #' \item{St.Gallen}{numeric (value 0 or 1)} #' \item{Stockholm}{numeric (value 0 or 1)} #' \item{LAT}{numeric #' (value 0 or 1) indicating a 'Latin' city} } #' @author David Firth #' @references Davidson, R. R. (1970) Extending the Bradley-Terry model to #' accommodate ties in paired comparison experiments. *Journal of the #' American Statistical Association* **65**, 317--328. #' #' Dittrich, R., Hatzinger, R. and Katzenbeisser, W. (1998) Modelling the #' effect of subject-specific covariates in paired comparison studies with an #' application to university rankings. *Applied Statistics* **47**, #' 511--525. #' #' Dittrich, R., Hatzinger, R. and Katzenbeisser, W. (2001) Corrigendum: #' Modelling the effect of subject-specific covariates in paired comparison #' studies with an application to university rankings. *Applied #' Statistics* **50**, 247--249. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' @source Royal Statistical Society datasets website, at #' \url{https://rss.onlinelibrary.wiley.com/hub/journal/14679876/series-c-datasets/pre_2016}. #' @keywords datasets #' @examples #' #' ## #' ## Fit the standard Bradley-Terry model, using the simple 'add 0.5' #' ## method to handle ties: #' ## #' table3.model <- BTm(outcome = cbind(win1.adj, win2.adj), #' player1 = school1, player2 = school2, #' formula = ~.. , refcat = "Stockholm", #' data = CEMS) #' ## The results in Table 3 of Dittrich et al (2001) are reproduced #' ## approximately by a simple re-scaling of the estimates: #' table3 <- summary(table3.model)$coef[, 1:2]/1.75 #' print(table3) #' ## #' ## Now fit the 'final model' from Table 6 of Dittrich et al.: #' ## #' table6.model <- BTm(outcome = cbind(win1.adj, win2.adj), #' player1 = school1, player2 = school2, #' formula = ~ .. + #' WOR[student] * Paris[..] + #' WOR[student] * Milano[..] + #' WOR[student] * Barcelona[..] + #' DEG[student] * St.Gallen[..] + #' STUD[student] * Paris[..] + #' STUD[student] * St.Gallen[..] + #' ENG[student] * St.Gallen[..] + #' FRA[student] * London[..] + #' FRA[student] * Paris[..] + #' SPA[student] * Barcelona[..] + #' ITA[student] * London[..] + #' ITA[student] * Milano[..] + #' SEX[student] * Milano[..], #' refcat = "Stockholm", #' data = CEMS) #' ## #' ## Again re-scale to reproduce approximately Table 6 of Dittrich et #' ## al. (2001): #' ## #' table6 <- summary(table6.model)$coef[, 1:2]/1.75 #' print(table6) #' ## #' \dontrun{ #' ## Now the slightly simplified model of Table 8 of Dittrich et al. (2001): #' ## #' table8.model <- BTm(outcome = cbind(win1.adj, win2.adj), #' player1 = school1, player2 = school2, #' formula = ~ .. + #' WOR[student] * LAT[..] + #' DEG[student] * St.Gallen[..] + #' STUD[student] * Paris[..] + #' STUD[student] * St.Gallen[..] + #' ENG[student] * St.Gallen[..] + #' FRA[student] * London[..] + #' FRA[student] * Paris[..] + #' SPA[student] * Barcelona[..] + #' ITA[student] * London[..] + #' ITA[student] * Milano[..] + #' SEX[student] * Milano[..], #' refcat = "Stockholm", #' data = CEMS) #' table8 <- summary(table8.model)$coef[, 1:2]/1.75 #' ## #' ## Notice some larger than expected discrepancies here (the coefficients #' ## named "..Barcelona", "..Milano" and "..Paris") from the results in #' ## Dittrich et al. (2001). Apparently a mistake was made in Table 8 of #' ## the published Corrigendum note (R. Dittrich personal communication, #' ## February 2010). #' ## #' print(table8) #' } #' "CEMS" BradleyTerry2/R/icehockey.R0000744000176200001440000001104413463567155015253 0ustar liggesusers#' College Hockey Men's Division I 2009-10 results #' #' Game results from American College Hockey Men's Division I composite #' schedule 2009-2010. #' #' The Division I ice hockey teams are arranged in six conferences: Atlantic #' Hockey, Central Collegiate Hockey Association, College Hockey America, ECAC #' Hockey, Hockey East and the Western Collegiate Hockey Association, all part #' of the National Collegiate Athletic Association. The composite schedule #' includes within conference games and between conference games. #' #' The data set here contains only games from the regular season, the results #' of which determine the teams that play in the NCAA national tournament. #' There are six automatic bids that go to the conference tournament champions, #' the remaining 10 teams are selected based upon ranking under the NCAA's #' system of pairwise comparisons #' (\url{https://www.collegehockeynews.com/info/?d=pwcrpi}). Some have argued #' that Bradley-Terry rankings would be fairer #' (\url{https://www.collegehockeynews.com/info/?d=krach}). #' #' @name icehockey #' @docType data #' @format A data frame with 1083 observations on the following 6 variables. #' \describe{ #' \item{date}{a numeric vector} #' \item{visitor}{a #' factor with 58 levels `Alaska Anchorage` ... `Yale`} #' \item{v_goals}{a numeric vector} #' \item{opponent}{a factor #' with 58 levels `Alaska Anchorage` ... `Yale`} #' \item{o_goals}{a numeric vector} #' \item{conference}{a factor #' with levels `AH`, `CC`, `CH`, `EC`, `HE`, #' `NC`, `WC`} #' \item{result}{a numeric vector: 1 if visitor #' won, 0.5 for a draw and 0 if visitor lost} #' \item{home.ice}{a logical #' vector: 1 if opponent on home ice, 0 if game on neutral ground} } #' @references Schlobotnik, J. Build your own rankings: #' \url{http://www.elynah.com/tbrw/2010/rankings.diy.shtml}. #' #' College Hockey News \url{https://www.collegehockeynews.com/}. #' #' Selections for 2010 NCAA tournament: #' \url{https://www.espn.com/college-sports/news/story?id=5012918}. #' @source \url{http://www.collegehockeystats.net/0910/schedules/men}. #' @keywords datasets #' @examples #' #' ### Fit the standard Bradley-Terry model #' standardBT <- BTm(outcome = result, #' player1 = visitor, player2 = opponent, #' id = "team", data = icehockey) #' #' ## Bradley-Terry abilities #' abilities <- exp(BTabilities(standardBT)[,1]) #' #' ## Compute round-robin winning probability and KRACH ratings #' ## (scaled abilities such that KRACH = 100 for a team with #' ## round-robin winning probability of 0.5) #' rankings <- function(abilities){ #' probwin <- abilities/outer(abilities, abilities, "+") #' diag(probwin) <- 0 #' nteams <- ncol(probwin) #' RRWP <- rowSums(probwin)/(nteams - 1) #' low <- quantile(abilities, 0.45) #' high <- quantile(abilities, 0.55) #' middling <- uniroot(function(x) {sum(x/(x+abilities)) - 0.5*nteams}, #' lower = low, upper = high)$root #' KRACH <- abilities/middling*100 #' cbind(KRACH, RRWP) #' } #' #' ranks <- rankings(abilities) #' ## matches those produced by Joe Schlobotnik's Build Your Own Rankings #' head(signif(ranks, 4)[order(ranks[,1], decreasing = TRUE),]) #' #' ## At one point the NCAA rankings gave more credit for wins on #' ## neutral/opponent's ground. Home ice effects are easily #' ## incorporated into the Bradley-Terry model, comparing teams #' ## on a "level playing field" #' levelBT <- BTm(result, #' data.frame(team = visitor, home.ice = 0), #' data.frame(team = opponent, home.ice = home.ice), #' ~ team + home.ice, #' id = "team", data = icehockey) #' #' abilities <- exp(BTabilities(levelBT)[,1]) #' ranks2 <- rankings(abilities) #' #' ## Look at movement between the two rankings #' change <- factor(rank(ranks2[,1]) - rank(ranks[,1])) #' barplot(xtabs(~change), xlab = "Change in Rank", ylab = "No. Teams") #' #' ## Take out regional winners and look at top 10 #' regional <- c("RIT", "Alabama-Huntsville", "Michigan", "Cornell", "Boston College", #' "North Dakota") #' #' ranks <- ranks[!rownames(ranks) %in% regional] #' ranks2 <- ranks2[!rownames(ranks2) %in% regional] #' #' ## compare the 10 at-large selections under both rankings #' ## with those selected under NCAA rankings #' cbind(names(sort(ranks, decr = TRUE)[1:10]), #' names(sort(ranks2, decr = TRUE)[1:10]), #' c("Miami", "Denver", "Wisconsin", "St. Cloud State", #' "Bemidji State", "Yale", "Northern Michigan", "New Hampshire", #' "Alsaka", "Vermont")) #' #' "icehockey" BradleyTerry2/R/flatlizards.R0000744000176200001440000001532113615337035015620 0ustar liggesusers#' Augrabies Male Flat Lizards: Contest Results and Predictor Variables #' #' Data collected at Augrabies Falls National Park (South Africa) in #' September-October 2002, on the contest performance and background attributes #' of 77 male flat lizards (*Platysaurus broadleyi*). The results of #' exactly 100 contests were recorded, along with various measurements made on #' each lizard. Full details of the study are in Whiting et al. (2006). #' #' There were no duplicate contests (no pair of lizards was seen fighting more #' than once), and there were no tied contests (the result of each contest was #' clear). #' #' The variables `head.length`, `head.width`, `head.height` and #' `condition` were all computed as residuals (of directly measured head #' length, head width, head height and body mass index, respectively) from #' simple least-squares regressions on `SVL`. #' #' Values of some predictors are missing (`NA`) for some lizards, #' \sQuote{at random}, because of instrument problems unconnected with the #' value of the measurement being made. #' #' @name flatlizards #' @docType data #' @format This dataset is a list containing two data frames: #' `flatlizards$contests` and `flatlizards$predictors`. #' #' The `flatlizards$contests` data frame has 100 observations on the #' following 2 variables: \describe{ #' \item{winner}{a factor with 77 #' levels `lizard003` ... `lizard189`.} #' \item{loser}{a factor #' with the same 77 levels `lizard003` ... `lizard189`.} } #' #' The `flatlizards$predictors` data frame has 77 observations (one for #' each of the 77 lizards) on the following 18 variables: \describe{ #' \item{id}{factor with 77 levels (3 5 6 ... 189), the lizard #' identifiers.} #' \item{throat.PC1}{numeric, the first principal #' component of the throat spectrum.} #' \item{throat.PC2}{numeric, the #' second principal component of the throat spectrum.} #' \item{throat.PC3}{numeric, the third principal component of the #' throat spectrum.} #' \item{frontleg.PC1}{numeric, the first principal #' component of the front-leg spectrum.} #' \item{frontleg.PC2}{numeric, #' the second principal component of the front-leg spectrum.} #' \item{frontleg.PC3}{numeric, the third principal component of the #' front-leg spectrum.} #' \item{badge.PC1}{numeric, the first principal #' component of the ventral colour patch spectrum.} #' \item{badge.PC2}{numeric, the second principal component of the #' ventral colour patch spectrum.} #' \item{badge.PC3}{numeric, the third #' principal component of the ventral colour patch spectrum.} #' \item{badge.size}{numeric, a measure of the area of the ventral #' colour patch.} #' \item{testosterone}{numeric, a measure of blood #' testosterone concentration.} #' \item{SVL}{numeric, the snout-vent #' length of the lizard.} #' \item{head.length}{numeric, head length.} #' \item{head.width}{numeric, head width.} #' \item{head.height}{numeric, head height.} #' \item{condition}{numeric, a measure of body condition.} #' \item{repro.tactic}{a factor indicating reproductive tactic; levels #' are `resident` and `floater`.} } #' @seealso [BTm()] #' @references Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The #' BradleyTerry2 package. *Journal of Statistical Software*, #' **48**(9), 1--21. #' #' Whiting, M. J., Stuart-Fox, D. M., O'Connor, D., Firth, D., Bennett, N. C. #' and Blomberg, S. P. (2006). Ultraviolet signals ultra-aggression in a #' lizard. *Animal Behaviour* **72**, 353--363. #' @source The data were collected by Dr Martin Whiting, #' \url{http://whitinglab.com/people/martin-whiting/}, and they appear here #' with his kind permission. #' @keywords datasets #' @examples #' #' ## #' ## Fit the standard Bradley-Terry model, using the bias-reduced #' ## maximum likelihood method: #' ## #' result <- rep(1, nrow(flatlizards$contests)) #' BTmodel <- BTm(result, winner, loser, br = TRUE, data = flatlizards$contests) #' summary(BTmodel) #' ## #' ## That's fairly useless, though, because of the rather small #' ## amount of data on each lizard. And really the scientific #' ## interest is not in the abilities of these particular 77 #' ## lizards, but in the relationship between ability and the #' ## measured predictor variables. #' ## #' ## So next fit (by maximum likelihood) a "structured" B-T model in #' ## which abilities are determined by a linear predictor. #' ## #' ## This reproduces results reported in Table 1 of Whiting et al. (2006): #' ## #' Whiting.model <- BTm(result, winner, loser, #' ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..], #' data = flatlizards) #' summary(Whiting.model) #' ## #' ## Equivalently, fit the same model using glmmPQL: #' ## #' Whiting.model <- BTm(result, winner, loser, #' ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..] + (1|..), #' sigma = 0, sigma.fixed = TRUE, data = flatlizards) #' summary(Whiting.model) #' ## #' ## But that analysis assumes that the linear predictor formula for #' ## abilities is _perfect_, i.e., that there is no error in the linear #' ## predictor. This will always be unrealistic. #' ## #' ## So now fit the same predictor but with a normally distributed error #' ## term --- a generalized linear mixed model --- by using the BTm #' ## function instead of glm. #' ## #' Whiting.model2 <- BTm(result, winner, loser, #' ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..] + (1|..), #' data = flatlizards, trace = TRUE) #' summary(Whiting.model2) #' ## #' ## The estimated coefficients (of throat.PC1, throat.PC3, #' ## head.length and SVL are not changed substantially by #' ## the recognition of an error term in the model; but the estimated #' ## standard errors are larger, as expected. The main conclusions from #' ## Whiting et al. (2006) are unaffected. #' ## #' ## With the normally distributed random error included, it is perhaps #' ## at least as natural to use probit rather than logit as the link #' ## function: #' ## #' require(stats) #' Whiting.model3 <- BTm(result, winner, loser, #' ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..] + (1|..), #' family = binomial(link = "probit"), #' data = flatlizards, trace = TRUE) #' summary(Whiting.model3) #' BTabilities(Whiting.model3) #' ## Note the "separate" attribute here, identifying two lizards with #' ## missing values of at least one predictor variable #' ## #' ## Modulo the usual scale change between logit and probit, the results #' ## are (as expected) very similar to Whiting.model2. #' "flatlizards" BradleyTerry2/R/BTabilities.R0000744000176200001440000001715313465114264015501 0ustar liggesusers#' Estimated Abilities from a Bradley-Terry Model #' #' Computes the (baseline) ability of each player from a model object of class #' `"BTm"`. #' #' The player abilities are either directly estimated by the model, in which #' case the appropriate parameter estimates are returned, otherwise the #' abilities are computed from the terms of the fitted model that involve #' player covariates only (those indexed by `model$id` in the model #' formula). Thus parameters in any other terms are assumed to be zero. If one #' player has been set as the reference, then `predict.BTm()` can be used to #' obtain ability estimates with non-player covariates set to other values, #' see examples for [predict.BTm()]. #' #' If the abilities are structured according to a linear predictor, and if #' there are player covariates with missing values, the abilities for the #' corresponding players are estimated as separate parameters. In this event #' the resultant matrix has an attribute, named `"separate"`, which #' identifies those players whose ability was estimated separately. For an #' example, see [flatlizards()]. #' #' @aliases BTabilities print.BTabilities coef.BTabilities vcov.BTabilities #' @param model a model object for which `inherits(model, "BTm")` is #' `TRUE` #' @return A two-column numeric matrix of class `c("BTabilities", #' "matrix")`, with columns named `"ability"` and `"se"`; has one row #' for each player; has attributes named `"vcov"`, `"modelcall"`, #' `"factorname"` and (sometimes --- see below) `"separate"`. The #' first three attributes are not printed by the method #' `print.BTabilities`. #' #' @author David Firth and Heather Turner #' @seealso [BTm()], [residuals.BTm()] #' @references Firth, D. (2005) Bradley-Terry models in R. *Journal of #' Statistical Software*, **12**(1), 1--12. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' @keywords models #' @examples #' #' ### citations example #' #' ## Convert frequencies to success/failure data #' citations.sf <- countsToBinomial(citations) #' names(citations.sf)[1:2] <- c("journal1", "journal2") #' #' ## Fit the "standard" Bradley-Terry model #' citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) #' BTabilities(citeModel) #' #' ### baseball example #' #' data(baseball) # start with baseball data as provided by package #' #' ## Fit mode with home advantage #' baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) #' baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) #' baseballModel2 <- BTm(cbind(home.wins, away.wins), home.team, away.team, #' formula = ~ team + at.home, id = "team", #' data = baseball) #' ## Estimate abilities for each team, relative to Baltimore, when #' ## playing away from home: #' BTabilities(baseballModel2) #' #' @importFrom stats C contrasts model.frame model.matrix model.offset na.exclude na.pass terms reformulate relevel vcov #' @export BTabilities <- function (model) { if (!inherits(model, "BTm")) stop("model is not of class BTm") X0 <- model.matrix(model) player1 <- model$player1[, model$id] player.names <- levels(player1) factors <- attr(terms(model$formula), "factors") if (!(model$id %in% rownames(factors))) { players <- data.frame(factor(seq(player.names), labels = player.names)) names(players) <- model$id ## assume player covariates indexed by id fixed <- nobars(model$formula) factors <- attr(terms(fixed), "factors") vars <- rownames(factors) by.id <- grep(paste("[", model$id, "]", sep = ""), vars, fixed = TRUE) drop <- setdiff(seq(length(vars)), by.id) ## following will only work for linear terms ## (drop any term involving non-player covariate) keep <- colSums(factors[drop, , drop = FALSE]) == 0 formula <- reformulate(names(keep)[keep]) mf <- model.frame(terms(formula), data = c(players, model$data), na.action = na.pass) rownames(mf) <- player.names players <- players[, model$id] offset <- model.offset(mf) if (is.null(offset)) offset <- 0 predvars <- setdiff(seq(ncol(mf)), attr(attr(mf, "terms"), "offset")) predvars <- reformulate(colnames(mf)[predvars]) X <- model.matrix(predvars, mf) Xmiss <- is.na(rowSums(X)) | players %in% model$separate.ability X[Xmiss, ] <- 0 X <- X[, -1, drop = FALSE] separate.ability <- unique(union(players[Xmiss], model$separate.ability)) ns <- length(separate.ability) if (ns) { S <- matrix(0, nrow = nrow(X), ncol = ns) S[cbind(which(players %in% separate.ability), seq(ns))] <- 1 X <- cbind(S, X) } ## remove inestimable coef est <- !is.na(model$coef) kept <- model$assign[est] %in% c(0, which(keep)) est <- est[kept] X <- X[, est, drop = FALSE] sqrt.vcov <- chol(vcov(model)[kept, kept]) V <- crossprod(sqrt.vcov %*% t(X)) se <- sqrt(diag(V)) abilities <- cbind(X %*% coef(model)[est][kept] + offset, se) attr(abilities, "vcov") <- V if (length(separate.ability)) { attr(abilities, "separate") <- separate.ability } } else { ## get ability coef and corresponding vcov asgn <- model$assign if (is.null(asgn)) abilities <- TRUE else { idterm <- attr(terms(model$formula), "term.labels") == model$id if (!any(idterm)) stop("abilities not uniquely defined for this parameterization") coefs.to.include <- asgn == which(idterm) vcov.to.include <- asgn[!is.na(coef(model))] == which(idterm) } coef <- na.exclude(coef(model)[coefs.to.include]) vc <- vcov(model)[names(coef), names(coef), drop = FALSE] ## setup factor reflecting contrasts used .. fac <- factor(player.names, levels = player.names) if (!is.null(model$refcat)) { fac <- C(relevel(fac, model$refcat), "contr.treatment") } else fac <- C(fac, model$contrasts[[model$id]]) contr <- contrasts(fac)[player.names,] ## calc abilities and s.e., fill in NA as necessary if (!is.null(attr(coef, "na.action"))) { contr <- contr[, -attr(coef, "na.action"), drop = FALSE] } est <- contr %*% coef ## vc of contrasts for use with qvcalc vc <- contr %*% vc %*% t(contr) se <- sqrt(diag(vc)) if (!is.null(attr(coef, "na.action"))){ id <- match(names(attr(coef, "na.action")), paste0(model$id, rownames(contr))) est[id] <- se[id] <- NA } abilities <- cbind(est, se) rownames(abilities) <- player.names attr(abilities, "vcov") <- vc } colnames(abilities) <- c("ability", "s.e.") attr(abilities, "modelcall") <- model$call attr(abilities, "factorname") <- model$id class(abilities) <- c("BTabilities", "matrix") abilities } #' @export print.BTabilities <- function(x, ...) { attr(x, "vcov") <- attr(x, "modelcall") <- attr(x, "factorname") <- NULL class(x) <- "matrix" print(x, ...) ## ie, print without showing the messy attributes } #' @export vcov.BTabilities <- function(object, ...) { attr(object, "vcov") } #' @export coef.BTabilities <- function(object, ...) { object[, "ability"] } BradleyTerry2/R/plotProportions.R0000744000176200001440000003403013152515665016537 0ustar liggesusers## P(win|not tie) in terms of expit(lambda_i - lambda_j) GenDavidsonTie <- function(p){ scale <- match("tie.scale", substring(names(coef), 1, 9), 0) if (scale != 0) scale <- exp(coef[scale]) else scale <- 1 tie.mode <- match("tie.mode", substring(names(coef), 1, 8), 0) if (tie.mode != 0) tie.mode <- coef["tie.mode"] delta <- coef[match("tie.max", substring(names(coef), 1, 7))] ## first player is at home weight1 <- plogis(tie.mode) weight2 <- 1 - weight1 ## plogis = expit plogis(delta - scale * (weight1 * log(weight1) + weight2 * log(weight2)) + scale * (weight1 * log(p) + weight2 * log(1-p))) } #tmp <- eval(substitute(player1), data, parent.frame()) #' Plot Proportions of Tied Matches and Non-tied Matches Won #' #' Plot proportions of tied matches and non-tied matches won by the first #' player, within matches binned by the relative player ability, as expressed #' by the probability that the first player wins, given the match is not a tie. #' Add fitted lines for each set of matches, as given by the generalized #' Davidson model. #' #' If `home.adv` is specified, the results are re-ordered if necessary so #' that the home player comes first; any matches played on neutral ground are #' omitted. #' #' First the probability that the first player wins given that the match is not #' a tie is computed: \deqn{expit(home.adv + abilities[player1] - #' abilities[player2])} where `home.adv` and `abilities` are #' parameters from a generalized Davidson model that have been estimated on the #' log scale. #' #' The matches are then binned according to this probability, grouping together #' matches with similar relative ability between the first player and the #' second player. Within each bin, the proportion of tied matches is computed #' and these proportions are plotted against the mid-point of the bin. Then the #' bins are re-computed omitting the tied games and the proportion of non-tied #' matches won by the first player is found and plotted against the new #' mid-point. #' #' Finally curves are added for the probability of a tie and the conditional #' probability of win given the match is not a tie, under a generalized #' Davidson model with parameters as specified by `tie.max`, #' `tie.scale` and `tie.mode`. #' #' The function can also be used to plot the proportions of wins along with the #' fitted probability of a win under the Bradley-Terry model. #' #' @param win a logical vector: `TRUE` if player1 wins, `FALSE` #' otherwise. #' @param tie a logical vector: `TRUE` if the outcome is a tie, #' `FALSE` otherwise (`NULL` if there are no ties). #' @param loss a logical vector: `TRUE` if player1 loses, `FALSE` #' otherwise. #' @param player1 an ID factor specifying the first player in each contest, #' with the same set of levels as `player2`. #' @param player2 an ID factor specifying the second player in each contest, #' with the same set of levels as `player2`. #' @param abilities the fitted abilities from a generalized Davidson model (or #' a Bradley-Terry model). #' @param home.adv if applicable, the fitted home advantage parameter from a #' generalized Davidson model (or a Bradley-Terry model). #' @param tie.max the fitted parameter from a generalized Davidson model #' corresponding to the maximum tie probability. #' @param tie.scale if applicable, the fitted parameter from a generalized #' Davidson model corresponding to the scale of dependence of the tie #' probability on the probability that `player1` wins, given the outcome #' is not a draw. #' @param tie.mode if applicable, the fitted parameter from a generalized #' Davidson model corresponding to the location of maximum tie probability, in #' terms of the probability that `player1` wins, given the outcome is not #' a draw. #' @param at.home1 a logical vector: `TRUE` if `player1` is at home, #' `FALSE` otherwise. #' @param at.home2 a logical vector: `TRUE` if `player2` is at home, #' `FALSE` otherwise. #' @param data an optional data frame providing variables required by the #' model, with one observation per match. #' @param subset an optional logical or numeric vector specifying a subset of #' observations to include in the plot. #' @param bin.size the approximate number of matches in each bin. #' @param xlab the label to use for the x-axis. #' @param ylab the label to use for the y-axis. #' @param legend text to use for the legend. #' @param col a vector specifying colours to use for the proportion of non-tied #' matches won and the proportion of tied matches. #' @param \dots further arguments passed to plot. #' @return A list of data frames: \item{win}{ a data frame comprising #' `prop.win`, the proportion of non-tied matches won by the first player #' in each bin and `bin.win`, the mid-point of each bin. } \item{tie}{ #' (when ties are present) a data frame comprising `prop.tie`, the #' proportion of tied matches in each bin and `bin.tie`, the mid-point of #' each bin. } #' @note This function is designed for single match outcomes, therefore data #' aggregated over player pairs will need to be expanded. #' @author Heather Turner #' @seealso [GenDavidson()], [BTm()] #' @keywords models nonlinear #' @examples #' #' #### A Bradley-Terry example using icehockey data #' #' ## Fit the standard Bradley-Terry model, ignoring home advantage #' standardBT <- BTm(outcome = result, #' player1 = visitor, player2 = opponent, #' id = "team", data = icehockey) #' #' ## comparing teams on a "level playing field" #' levelBT <- BTm(result, #' data.frame(team = visitor, home.ice = 0), #' data.frame(team = opponent, home.ice = home.ice), #' ~ team + home.ice, #' id = "team", data = icehockey) #' #' ## compare fit to observed proportion won #' ## exclude tied matches as not explicitly modelled here #' par(mfrow = c(1, 2)) #' plotProportions(win = result == 1, loss = result == 0, #' player1 = visitor, player2 = opponent, #' abilities = BTabilities(standardBT)[,1], #' data = icehockey, subset = result != 0.5, #' main = "Without home advantage") #' #' plotProportions(win = result == 1, loss = result == 0, #' player1 = visitor, player2 = opponent, #' home.adv = coef(levelBT)["home.ice"], #' at.home1 = 0, at.home2 = home.ice, #' abilities = BTabilities(levelBT)[,1], #' data = icehockey, subset = result != 0.5, #' main = "With home advantage") #' #' #### A generalized Davidson example using football data #' if (require(gnm)) { #' #' ## subset to first and last season for illustration #' football <- subset(football, season %in% c("2008-9", "2012-13")) #' #' ## convert to trinomial counts #' football.tri <- expandCategorical(football, "result", idvar = "match") #' #' ## add variable to indicate whether team playing at home #' football.tri$at.home <- !logical(nrow(football.tri)) #' #' ## fit Davidson model #' Dav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri) #' #' ## fit shifted & scaled Davidson model #' shifScalDav <- gnm(count ~ #' GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, tie.scale = ~1, tie.mode = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri) #' #' ## diagnostic plots #' main <- c("Davidson", "Shifted & Scaled Davidson") #' mod <- list(Dav, shifScalDav) #' names(mod) <- main #' alpha <- names(coef(Dav)[-(1:2)]) #' #' ## use football.tri data so that at.home can be found, #' ## but restrict to actual match results #' par(mfrow = c(1,2)) #' for (i in 1:2) { #' coef <- parameters(mod[[i]]) #' plotProportions(result == 1, result == 0, result == -1, #' home:season, away:season, #' abilities = coef[alpha], #' home.adv = coef["home.adv"], #' tie.max = coef["tie.max"], #' tie.scale = coef["tie.scale"], #' tie.mode = coef["tie.mode"], #' at.home1 = at.home, #' at.home2 = !at.home, #' main = main[i], #' data = football.tri, subset = count == 1) #' } #' } #' #' @importFrom graphics curve plot points #' @importFrom stats na.omit #' @export plotProportions <- function(win, tie = NULL, loss, player1, player2, abilities = NULL, home.adv = NULL, tie.max = NULL, tie.scale = NULL, tie.mode = NULL, at.home1 = NULL, at.home2 = NULL, data = NULL, subset = NULL, bin.size = 20, xlab = "P(player1 wins | not a tie)", ylab = "Proportion", legend = NULL, col = 1:2, ...){ call <- as.list(match.call()) var <- intersect(names(call), c("win", "tie", "loss", "player1", "player2", "at.home1", "at.home2")) var <- var[!vapply(call[var], is.null, logical(1))] dat <- with(data, do.call("data.frame", call[var])) if (!missing(subset)){ subset <- eval(substitute(subset), data, parent.frame()) dat <- subset(dat, subset) } if (!missing(tie) && sum(dat$tie) == 0) dat$tie <- NULL if (!is.null(home.adv) && (missing(at.home1) || missing(at.home2))) stop("at.home1 and at.home2 must be specified") if (!is.null(home.adv)){ ## exclude neutral contests, make sure home player is first dat <- subset(dat, at.home1 | at.home2) swap <- which(as.logical(dat$at.home2)) if (length(swap)) { dat$win[swap] <- dat$loss[swap] if (is.null(dat$tie)) dat$loss[swap] <- !dat$win[swap] else dat$loss[swap] <- !(dat$win[swap] | dat$tie[swap]) tmp <- dat$player1[swap] dat$player1[swap] <- dat$player2[swap] dat$player2[swap] <- tmp dat$at.home1[swap] <- TRUE dat$at.home2[swap] <- FALSE } } else home.adv <- 0 ### get proportions p <- with(dat, plogis(home.adv + abilities[as.character(player1)] - abilities[as.character(player2)])) ## Depending on the distribution of p_ij (across all matches), ## divide the range of probabilities p_ij into discrete "bins", each ## of which has at least (say) 20 matches in it getBins <- function(p, bin.size) { ## alternatively estimate bins to same size intervals ## at least bin.size - distribute extra evenly over range min.size <- bin.size n <- length(p) r <- n %% min.size size <- rep(min.size, n %/% min.size) if (r > 0) { step <- length(size)/r extra <- round(seq(from = step/2 + 0.01, to = step/2 + 0.01 + (r - 1)*step, by = step)) size[extra] <- min.size + 1 } bin <- factor(rep(seq(length(size)), size))[match(p, sort(p))] low <- sort(p)[cumsum(c(1, size[-length(size)]))] #first high <- sort(p)[cumsum(size)] #last mid <- (high - low)/2 + low list(bin = bin, mid = mid) } winBin <- getBins(p, bin.size) ## Within each bin b, calculate ## d_b = proportion of matches in that bin that were drawn if (!is.null(dat$tie)) { tieBin <- winBin tri <- with(dat, win - (!win & !tie)) d_b <- tapply(tri, tieBin$bin, function(x) sum(x == 0)/length(x)) ## recompute bins omitting ties winBin <- getBins(p[!dat$tie], bin.size) } ## h_b = proportion of *non-drawn* matches in that bin that were won ## by the home team if (!is.null(dat$tie)) { h_b <- tapply(tri[!dat$tie], winBin$bin, function(x) sum(x == 1)/length(x)) } else h_b <- tapply(dat$win, winBin$bin, function(x) sum(x == 1)/length(x)) ## Plot d_b and h_b against the bin midpoints, in a plot with ## axis limits both (0,1) plot(h_b ~ winBin$mid, xlim = c(0, 1), ylim = c(0, 1), xlab = xlab, ylab = ylab, ...) if (missing(legend)) { if (is.null(dat$tie)) legend <- "Matches won" else legend <- c("Non-tied matches won", "Matches tied") } legend("topleft", legend, col = col[c(1, 2[!missing(tie)])], pch = 1) if (!is.null(dat$tie)) points(d_b ~ tieBin$mid, col = col[2]) ## Add to the plot the lines/curves ## y = x ## y = expit(log(nu * sqrt(p_ij * (1 - p_ij)))) ## The d_b should lie around the latter curve, and the h_b should ## lie around the former line. Any clear patterns of departure are ## of interest. curve(I, 0, 1, add = TRUE) env <- new.env() environment(GenDavidsonTie) <- env coef <- na.omit(c(home.adv = unname(home.adv), tie.max = unname(tie.max), tie.scale = unname(tie.scale), tie.mode = unname(tie.mode))) assign("coef", coef, envir=env) curve(GenDavidsonTie, 0, 1, col = col[2], add = TRUE) out <- list(win = data.frame(prop.win = h_b, bin.win = winBin$mid)) if (!is.null(dat$tie)) out <- c(out, tie = data.frame(prop.tie = d_b, bin.tie = tieBin$mid)) invisible(out) } BradleyTerry2/R/countsToBinomial.R0000744000176200001440000000354613436770253016604 0ustar liggesusers#' Convert Contingency Table of Wins to Binomial Counts #' #' Convert a contingency table of wins to a four-column data frame containing #' the number of wins and losses for each pair of players. #' #' #' @param xtab a contingency table of wins cross-classified by \dQuote{winner} #' and \dQuote{loser} #' @return A data frame with four columns \item{player1 }{ the first player in #' the contest. } \item{player2 }{ the second player in the contest. } #' \item{win1 }{ the number of times `player1` won. } \item{win2 }{ the #' number of times `player2` won. } #' @author Heather Turner #' @seealso [BTm()] #' @keywords models #' @examples #' #' ######################################################## #' ## Statistics journal citation data from Stigler (1994) #' ## -- see also Agresti (2002, p448) #' ######################################################## #' citations #' #' ## Convert frequencies to success/failure data #' citations.sf <- countsToBinomial(citations) #' names(citations.sf)[1:2] <- c("journal1", "journal2") #' citations.sf #' #' @importFrom gtools combinations #' @export countsToBinomial <- function(xtab) { ## make square if necessary if (nrow(xtab) != ncol(xtab) || !all(rownames(xtab) == colnames(xtab))) { dat <- as.data.frame(xtab) lev <- union(rownames(xtab), colnames(xtab)) dat[,1] <- factor(dat[,1], levels = lev) dat[,2] <- factor(dat[,2], levels = lev) xtab <- tapply(dat[,3], dat[1:2], sum) xtab[is.na(xtab)] <- 0 } ##assumes square players <- rownames(xtab) comb <- combinations(nrow(xtab), 2) won <- xtab[comb] lost <- t(xtab)[comb] res <- !(won == 0 & lost == 0) player1 <- factor(players[comb[,1]], levels = players)[res] player2 <- factor(players[comb[,2]], levels = players)[res] data.frame(player1, player2, win1 = won[res], win2 = lost[res]) } BradleyTerry2/R/sound.fields.R0000744000176200001440000000715713615336534015711 0ustar liggesusers#' Kousgaard (1984) Data on Pair Comparisons of Sound Fields #' #' The results of a series of factorial subjective room acoustic experiments #' carried out at the Technical University of Denmark by A C Gade. #' #' The variables `win1.adj` and `win2.adj` are provided in order to #' allow a simple way of handling ties (in which a tie counts as half a win and #' half a loss), which is slightly different numerically from the Davidson #' (1970) method that is used by Kousgaard (1984): see the examples. #' #' @name sound.fields #' @docType data #' @format A list containing two data frames, `sound.fields$comparisons`, #' and `sound.fields$design`. #' #' The `sound.fields$comparisons` data frame has 84 observations on the #' following 8 variables: \describe{ #' \item{field1}{a factor with levels #' `c("000", "001", "010", "011", "100", "101", "110", "111")`, the first #' sound field in a comparison} #' \item{field2}{a factor with the same #' levels as `field1`; the second sound field in a comparison} #' \item{win1}{integer, the number of times that `field1` was #' preferred to `field2`} #' \item{tie}{integer, the number of times #' that no preference was expressed when comparing `field1` and #' `field2`} #' \item{win2}{integer, the number of times that #' `field2` was preferred to `field1`} #' \item{win1.adj}{numeric, equal to `win1 + tie/2`} #' \item{win2.adj}{numeric, equal to `win2 + tie/2`} #' \item{instrument}{a factor with 3 levels, `c("cello", "flute", #' "violin")`} } #' #' The `sound.fields$design` data frame has 8 observations (one for each #' of the sound fields compared in the experiment) on the following 3 #' variables: \describe{ #' \item{a")}{a factor with levels `c("0", #' "1")`, the *direct sound* factor (0 for *obstructed sight line*, 1 #' for *free sight line*); contrasts are sum contrasts} #' \item{b}{a #' factor with levels `c("0", "1")`, the *reflection* factor (0 for #' *-26dB*, 1 for *-20dB*); contrasts are sum contrasts} #' \item{c}{a factor with levels `c("0", "1")`, the #' *reverberation* factor (0 for *-24dB*, 1 for *-20dB*); #' contrasts are sum contrasts} } #' @author David Firth #' @references Davidson, R. R. (1970) Extending the Bradley-Terry model to #' accommodate ties in paired comparison experiments. *Journal of the #' American Statistical Association* **65**, 317--328. #' @source Kousgaard, N. (1984) Analysis of a Sound Field Experiment by a Model #' for Paired Comparisons with Explanatory Variables. *Scandinavian #' Journal of Statistics* **11**, 51--57. #' @keywords datasets #' @examples #' #' ## #' ## Fit the Bradley-Terry model to data for flutes, using the simple #' ## 'add 0.5' method to handle ties: #' ## #' flutes.model <- BTm(cbind(win1.adj, win2.adj), field1, field2, ~ field, #' id = "field", #' subset = (instrument == "flute"), #' data = sound.fields) #' ## #' ## This agrees (after re-scaling) quite closely with the estimates given #' ## in Table 3 of Kousgaard (1984): #' ## #' table3.flutes <- c(-0.581, -1.039, 0.347, 0.205, 0.276, 0.347, 0.311, 0.135) #' plot(c(0, coef(flutes.model)), table3.flutes) #' abline(lm(table3.flutes ~ c(0, coef(flutes.model)))) #' ## #' ## Now re-parameterise that model in terms of the factorial effects, as #' ## in Table 5 of Kousgaard (1984): #' ## #' flutes.model.reparam <- update(flutes.model, #' formula = ~ a[field] * b[field] * c[field] #' ) #' table5.flutes <- c(.267, .250, -.088, -.294, .062, .009, -0.070) #' plot(coef(flutes.model.reparam), table5.flutes) #' abline(lm(table5.flutes ~ coef(flutes.model.reparam))) #' "sound.fields" BradleyTerry2/R/BTm.setup.R0000744000176200001440000000525113615336246015126 0ustar liggesusers#' @importFrom stats reformulate BTm.setup <- function(outcome = 1, player1, player2, formula = NULL, id = "..", separate.ability = NULL, refcat = NULL, data = NULL, weights = NULL, subset = NULL, offset = NULL, contrasts = NULL, ...){ if (!is.data.frame(data)){ keep <- names(data) %in% c(deparse(substitute(player1)), deparse(substitute(player2))) if (!length(keep)) keep <- FALSE ## save row names for checking against index variables (in Diff) data <- lapply(data, as.data.frame) nm <- lapply(data, rownames) data <- c(data[keep], unlist(unname(data[!keep]), recursive = FALSE)) if (any(dup <- duplicated(names(data)))) warning("'data' argument specifies duplicate variable names: ", paste(names(data)[dup], collapse = " ")) } ## (will take first occurence of replicated names) withIfNecessary <- function(x, formula, data = NULL, as.data.frame = TRUE) { if (as.data.frame) expr <- substitute(data.frame(x), list(x = x)) else expr <- x eval(expr, data, enclos = environment(formula)) } player1 <- withIfNecessary(substitute(player1), formula, data) player2 <- withIfNecessary(substitute(player2), formula, data) if (ncol(player1) == 1) colnames(player1) <- colnames(player2) <- id Y <- withIfNecessary(substitute(outcome), formula, c(player1, player2, data), as.data.frame = FALSE) weights <- withIfNecessary(substitute(weights), formula, data, FALSE) subset1 <- withIfNecessary(substitute(subset), formula, c(player1 = list(player1), player2 = list(player2), player1, data), FALSE) subset2 <- withIfNecessary(substitute(subset), formula, c(player1 = list(player1), player2 = list(player2), player2, data), FALSE) if (is.logical(subset1)) subset <- subset1 | subset2 else subset <- c(subset1, subset2) diffModel <- Diff(player1, player2, formula, id, data, separate.ability, refcat, contrasts, nm) # offset is contest level offset <- withIfNecessary(substitute(offset), formula, data, FALSE) if (!is.null(offset)) { if (is.null(diffModel$offset)) diffModel$offset <- offset else diffModel$offset <- diffModel$offset + offset } res <- c(diffModel, list(data = data, player1 = player1, player2 = player2, Y = Y, weights = weights, subset = subset, formula = formula)) } BradleyTerry2/R/print.BTglmmPQL.R0000744000176200001440000000124213152515665016173 0ustar liggesusers#' @importFrom stats coef naprint #' @export print.BTglmmPQL <- function (x, digits = max(3, getOption("digits") - 3), ...) { if (identical(x$sigma, 0)){ cat("PQL algorithm converged to fixed effects model\n") return(NextMethod()) } cat("\nCall: ", deparse(x$call), "\n", sep = "", fill = TRUE) if (length(coef(x))) { cat("Fixed effects:\n\n") print.default(format(x$coefficients, digits = digits), print.gap = 2, quote = FALSE) } else cat("No fixed effects\n\n") cat("\nRandom Effects Std. Dev.:", x$sigma, "\n") if (nzchar(mess <- naprint(x$na.action))) cat("\n", mess, "\n", sep = "") } BradleyTerry2/R/anova.BTmlist.R0000744000176200001440000000661413463536710015771 0ustar liggesusers#' @importFrom stats coef fitted formula na.omit pchisq pf terms vcov anova.BTmlist <- function (object, ..., dispersion = NULL, test = NULL) { ## Pass on if no random effects fixed <- unlist(lapply(object, function(x) is.null(x$random))) if (!all(!fixed)) stop("Models must have the same random effects structure") responses <- as.character(lapply(object, function(x) { deparse(formula(terms(x))[[2]]) })) sameresp <- responses == responses[1] if (!all(sameresp)) { object <- object[sameresp] warning("models with response ", deparse(responses[!sameresp]), " removed because response differs from model 1") } ns <- vapply(object, function(x) length(fitted(x)), numeric(1)) if (any(ns != ns[1])) stop("models were not all fitted to the same size of dataset") nmodels <- length(object) ncoefs <- vapply(object, function(x) length(na.omit(coef(x))), numeric(1)) #omit aliased labels <- lapply(object, function(x) x$term.labels) stat <- numeric(nmodels) for (i in 2:nmodels) { descending <- ncoefs[i] < ncoefs[i - 1] bigger <- i - descending smaller <- i - !descending if (!all(labels[[smaller]] %in% labels[[bigger]])) stop("models are not nested") term.ind <- !(labels[[bigger]] %in% labels[[smaller]]) ind <- object[[bigger]]$assign %in% which(term.ind) stat[i] <- t(coef(object[[bigger]])[ind]) %*% chol2inv(chol(vcov(object[[bigger]], dispersion = dispersion)[ind, ind])) %*% coef(object[[bigger]])[ind] #vcov should handle dispersion != 1 } stat[1] <- NA table <- data.frame(stat, c(NA, diff(ncoefs))) variables <- lapply(object, function(x) paste(deparse(formula(x)), collapse = "\n")) dimnames(table) <- list(1:nmodels, c("Statistic", "Df")) title <- paste("Sequential Wald Tests\n\n", "Response: ", responses[1], "\n", sep = "") topnote <- paste("Model ", format(1:nmodels), ": ", variables, sep = "", collapse = "\n") if (!is.null(test)) { ## Assume dispersion fixed at one - if dispersion estimated, would use ## "residual" df from larger model in each comparison df.dispersion <- Inf if (test == "F" && df.dispersion == Inf) { fam <- object[[1]]$family$family if (fam == "binomial" || fam == "poisson") warning(gettextf( "using F test with a '%s' family is inappropriate", fam), domain = NA, call. = FALSE) else { warning("using F test with a fixed dispersion is inappropriate") } } table <- switch(test, Chisq = { dfs <- table[, "Df"] vals <- table[, "Statistic"] vals[dfs %in% 0] <- NA cbind(table, `P(>|Chi|)` = pchisq(vals, abs(dfs), lower.tail = FALSE)) }, F = { dfs <- table[, "Df"] Fvalue <- table[, "Statistic"]/abs(dfs) Fvalue[dfs %in% 0] <- NA cbind(table, F = Fvalue, `Pr(>F)` = pf(Fvalue, abs(dfs), df.dispersion, lower.tail = FALSE)) }) } structure(table, heading = c(title, topnote), class = c("anova", "data.frame")) } BradleyTerry2/R/baseball.R0000744000176200001440000000350713152515665015054 0ustar liggesusers#' Baseball Data from Agresti (2002) #' #' Baseball results for games in the 1987 season between 7 teams in the Eastern #' Division of the American League. #' #' #' @name baseball #' @docType data #' @format A data frame with 42 observations on the following 4 variables. #' \describe{ #' \item{home.team}{a factor with levels `Baltimore`, #' `Boston`, `Cleveland`, `Detroit`, `Milwaukee`, `New York`, `Toronto`.} #' \item{away.team}{a factor with levels #' `Baltimore`, `Boston`, `Cleveland`, `Detroit`, #' `Milwaukee`, `New York`, `Toronto`.} #' \item{home.wins}{a numeric vector.} #' \item{away.wins}{a numeric vector.} } #' @note This dataset is in a simpler format than the one described in Firth #' (2005). #' @seealso [BTm()] #' @references Firth, D. (2005) Bradley-Terry models in R. *Journal of #' Statistical Software*, **12**(1), 1--12. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' @source Page 438 of Agresti, A. (2002) *Categorical Data Analysis* (2nd #' Edn.). New York: Wiley. #' @keywords datasets #' @examples #' #' ## This reproduces the analysis in Sec 10.6 of Agresti (2002). #' data(baseball) # start with baseball data as provided by package #' #' ## Simple Bradley-Terry model, ignoring home advantage: #' baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, #' data = baseball, id = "team") #' #' ## Now incorporate the "home advantage" effect #' baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) #' baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) #' baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) #' #' ## Compare the fit of these two models: #' anova(baseballModel1, baseballModel2) #' #' "baseball" BradleyTerry2/R/Diff.R0000744000176200001440000001371413463535404014156 0ustar liggesusers#' @importFrom stats is.empty.model model.frame model.matrix model.offset na.omit na.pass reformulate relevel terms Diff <- function(player1, player2, formula = NULL, id = "..", data = NULL, separate.ability = NULL, refcat = NULL, contrasts = NULL, subset = NULL) { player.one <- player1[[id]] player.two <- player2[[id]] if (!is.factor(player.one) || !is.factor(player.two) || !identical(levels(player.one), levels(player.two))) stop("'player1$", id, "' and 'player2$", id, "' must be factors with the same levels") if (!identical(attr(player.one, "contrasts"), attr(player.two, "contrasts"))) stop("'player1$", id, "' and 'player2$", id, "' must have the same contrasts attribute") if(is.null(formula)) formula <- reformulate(id) players <- levels(player.one) nplayers <- nlevels(player.one) ncontests <- length(player.one) D <- matrix(nrow = ncontests, ncol = nplayers) D <- col(D) == as.numeric(player.one) D <- D - (col(D) == as.numeric(player.two)) colnames(D) <- paste(id, players, sep = "") fixed <- nobars(formula) X <- offset <- missing <- term.labels <- NULL saturated <- FALSE sep <- list() empty <- is.null(fixed) || is.empty.model(mt <- terms(fixed)) if (!empty) { factors <- attr(mt, "factors") term.labels <- as.character(colnames(factors)) vars <- rownames(factors) indexed <- grep("[[][^],]+[],]", vars) if (length(indexed)) { #set NAs to zero indices <- gsub("[^[]*[[]([^],]+)[],].*", "\\1", vars[indexed]) vars <- gsub("[[][^]]*[]]", "", vars[indexed]) ## assumes no overlap, e.g. no age[..]:judge.gender[judge] grp <- split(vars, indices) for (ind in names(grp)) { vars <- model.frame(terms(reformulate(grp[[ind]])), data = data, na.action = na.pass) lev <- levels(eval(as.name(ind), c(player1, data))) as.sep <- rowSums(is.na(vars)) | lev %in% separate.ability if (any(as.sep)) { sep[[ind]] <- as.sep vars[sep[[ind]], ] <- lapply(vars, function(x) max(levels(x)[1], 0)) colnames(vars) <- gsub(".*[$[],? ?\"?([^]\"]*).*", "\\1", grp[[ind]]) labels <- gsub("([^[$]*)[[$].*", "\\1", grp[[ind]]) for (lab in intersect(labels, grp[[ind]])) data[lab] <- vars[lab] for (lab in setdiff(labels, grp[[ind]])) data[[lab]] <- vars[, labels == lab, drop = FALSE] } } if (length(sep)) { fixed <- reformulate(c(names(sep), attr(mt, "term.labels"), rownames(attr(mt, "factors"))[ attr(mt, "offset")])) mt <- terms(fixed) } } idterm <- id %in% rownames(attr(mt, "factors")) mf1 <- model.frame(mt, data = c(player1, data), na.action = na.pass) if (nrow(mf1) != ncontests) stop("Predictor variables are not of the correct length --", "they probably need indexing in 'formula'.") mf2 <- model.frame(mt, data = c(player2, data), na.action = na.pass) if (idterm){ if (!is.null(refcat)) { mf1[[id]] <- relevel(mf1[[id]], refcat) mf2[[id]] <- relevel(mf2[[id]], refcat) if (!is.null(contrasts)) contrasts[[id]] <- "contr.treatment" } else { ## 'else' defined by contrasts arg/contrasts attr of id factor ## leave refcat NULL if (is.null(contrasts) & !is.null(attr(player.one, "contrasts"))){ contrasts <- list() contrasts[[id]] <- attr(player.one, "contrasts") } } } offset <- model.offset(mf1) if (!is.null(offset)) offset <- offset - model.offset(mf2) if (length(sep)){ #create separate effect factor recode <- function(x, keep){ lev <- levels(x) ext <- make.unique(c(lev[keep], "nosep"))[sum(keep) + 1] levels(x)[!keep] <- ext relevel(x, ref = ext) } for (ind in names(grp)) { mf1[ind] <- recode(mf1[[ind]], sep[[ind]]) mf2[ind] <- recode(mf2[[ind]], sep[[ind]]) } } X1 <- model.matrix(fixed, mf1, contrasts = contrasts) X2 <- model.matrix(fixed, mf2, contrasts = contrasts) X <- X1 - X2 ## will need to check for saturation in each set of indexed var ## - however as only allowing (1|..) just consider player id for now saturated <- qr(na.omit(X))$rank == qr(na.omit(cbind(D, X)))$rank && !idterm if (all(X[,1] == 0)) X <- X[, -1, drop = FALSE] attr(X, "assign") <- attr(X1, "assign")[-1] } random <- findbars(formula[[2]]) if (!is.null(random)) { if (!is.list(random)) random <- list(random) if (length(random) > 1 || random[[1]] != parse(text = paste("1|", id, sep = ""))[[1]]) stop("Currently '(1 | ", id, ")' is the only random effects", "structure allowed.") random <- D } else if (!empty && (!idterm & !saturated)) warning("Ability modelled by predictors but no random effects", call. = FALSE) if (length(sep)) { attr(X, "assign") <- attr(X, "assign") - 1 if (!is.null(random)) random <- D[,!sep[[id]], drop = FALSE] } list(X = X, random = random, offset = offset, term.labels = term.labels, refcat = refcat, contrasts = contrasts, saturated = saturated) } BradleyTerry2/R/glmmPQL.fit.R0000744000176200001440000002115413465106062015371 0ustar liggesusers#' @importFrom utils flush.console glmmPQL.fit <- function(X, y, Z, weights = rep(1, NROW(y)), start = NULL, etastart = NULL, mustart = NULL, offset = rep(0, NROW(y)), family = gaussian(), control = glmmPQL.control(...), sigma = NULL, sigma.fixed = FALSE, ...) { matchCall <- as.list(match.call(expand.dots = FALSE)) dots <- names(matchCall[["..."]]) dots <- intersect(dots, setdiff(names(formals(glm)), "control")) fit0 <- do.call("glm.fit", c(list(X, y, weights, start = start, etastart = etastart, mustart = mustart, offset = offset, family = family, control = glm.control()), matchCall[dots])) w <- fit0$prior.weights # QR missing from glm.fit if ncol(X) = 0 QR <- qr(X) R <- qr.R(QR) rank <- QR$rank p <- ncol(R) nm <- colnames(R)[seq(length = rank)] if (rank < p) { X0 <- X[,colnames(R)[-seq(length = rank)]] X <- X[, nm] } empty <- !length(X) if (empty) { alpha <- numeric(0) Xa <- matrix(0, length(y), 1) } eta <- fit0$linear.predictors residuals <- fit0$residuals Y <- eta + residuals - offset #working response wy <- fit0$weights # iterative weights wY <- sqrt(wy) * Y wZ <- sqrt(wy) * Z ZWy <- crossprod(wZ, wY) ZWZ <- crossprod(wZ, wZ) if (!empty) { wX <- sqrt(wy) * X XWy <- crossprod(wX, wY) XWX <- crossprod(wX, wX) ZWX <- crossprod(wZ, wX) E <- chol(XWX) J <- backsolve(E, t(ZWX), transpose = TRUE) f <- backsolve(E, XWy, transpose = TRUE) ZSy <- ZWy - crossprod(J, f) ZSZ <- ZWZ - crossprod(J, J) } if (is.null(sigma)) sigma <- 0.1 logtheta <- log(sigma^2) conv <- FALSE for (i in 1:control$maxiter) { ## Update coefficients for (j in 1:control$IWLSiter) { IZWZD <- ZWZ * sigma^2 diag(IZWZD) <- 1 + diag(IZWZD) A <- chol(IZWZD) if (!empty) { IZSZD <- ZSZ * sigma^2 diag(IZSZD) <- 1 + diag(IZSZD) G <- chol(IZSZD) g <- backsolve(G, ZSy, transpose = TRUE) v <- backsolve(G, g) B <- backsolve(A, sigma * ZWX, transpose = TRUE) K <- chol(XWX - crossprod(B, B)) b <- backsolve(A, sigma * ZWy, transpose = TRUE) c <- backsolve(K, XWy - t(B) %*% b, transpose = TRUE) alpha <- backsolve(K, c) Xa <- X %*% alpha beta <- sigma^2 * v } else { g <- backsolve(A, ZWy, transpose = TRUE) v <- backsolve(A, g) beta <- sigma^2 * v } eta <- c(Xa + Z %*% beta + offset) ## Update working response & weights mu <- family$linkinv(eta) mu.eta.val <- family$mu.eta(eta) residuals <- (fit0$y - mu)/mu.eta.val Y <- eta + residuals - offset wy <- w * mu.eta.val^2/family$variance(mu) wY <- sqrt(wy) * Y wZ <- sqrt(wy) * Z ZWy <- crossprod(wZ, wY) ZWZ <- crossprod(wZ, wZ) if (!empty) { wX <- sqrt(wy) * X XWy <- crossprod(wX, wY) XWX <- crossprod(wX, wX) ZWX <- crossprod(wZ, wX) E <- chol(XWX) J <- backsolve(E, t(ZWX), transpose = TRUE) f <- backsolve(E, XWy, transpose = TRUE) ZSy <- ZWy - crossprod(J, f) ZSZ <- ZWZ - crossprod(J, J) score <- c(crossprod(X, wy * residuals), crossprod(Z, wy * residuals) - v) diagInfo <- c(diag(XWX), diag(ZWZ)) if (all(diagInfo < 1e-20) || all(abs(score) < control$tol * sqrt(control$tol + diagInfo))) { if (sigma.fixed) conv <- TRUE break } } else { score <- crossprod(Z, wy * residuals) - v diagInfo <- diag(ZWZ) if (all(diagInfo < 1e-20) || all(abs(score) < control$tol * sqrt(control$tol + diagInfo))) { if (sigma.fixed) conv <- TRUE break } } } if (!sigma.fixed){ ## Update sigma ## sigma^2 = exp(logtheta) ## One Fisher scoring iteration IZWZD <- ZWZ * sigma^2 diag(IZWZD) <- 1 + diag(IZWZD) A <- chol(IZWZD) if (!empty) { IZSZD <- ZSZ * sigma^2 diag(IZSZD) <- 1 + diag(IZSZD) G <- chol(IZSZD) g <- backsolve(G, ZSy, transpose = TRUE) v <- backsolve(G, g) h <- backsolve(G, ZSZ, transpose = TRUE) H <- backsolve(G, h) } else { g <- backsolve(A, ZWy, transpose = TRUE) v <- backsolve(A, g) h <- backsolve(A, ZWZ, transpose = TRUE) H <- backsolve(A, h) } ## Harville p326 score <- drop(-0.5 * sum(diag(H)) + 0.5 * crossprod(v, v)) * sigma^2 Info <- 0.5 * sum(H^2) * sigma^4 if (control$trace) { ##B & K eq 5 - still not consistently increasing cat("Iteration ", i, ". Score = ", abs(score) , "\n", sep = "") flush.console() } ## check for overall convergence if (Info < 1e-20 || abs(score) < control$tol * sqrt(control$tol + Info)){ conv <- TRUE break } ## Cannot use beta to update t(YXa) %*% Vinv %*% YXa ZWYXa <- crossprod(wZ, sqrt(wy) * (Y - Xa)) optfun <- function(logtheta) { IZWZD <- ZWZ * exp(logtheta) diag(IZWZD) <- 1 + diag(IZWZD) A <- chol(IZWZD) if (!empty) { IZSZD <- ZSZ * exp(logtheta) diag(IZSZD) <- 1 + diag(IZSZD) G <- chol(IZSZD) d <- backsolve(A, sqrt(exp(logtheta)) * ZWYXa, transpose = TRUE) sum(log(diag(G))) - 0.5 * crossprod(d, d) } else { d <- backsolve(A, sqrt(exp(logtheta)) * ZWy, transpose = TRUE) sum(log(diag(A))) - 0.5 * crossprod(d, d) } } optres <- optimize(optfun, c(-10, 10)) if (optfun(-10) < optfun(optres$minimum)) sigma <- 0 else { if (abs(optres$minimum - (logtheta + score/Info)) > 0.1) logtheta <- optres$minimum else logtheta <- logtheta + score/Info sigma <- sqrt(exp(logtheta)) } } else if (conv) break } if (!empty) varFix <- chol2inv(K) else varFix <- matrix(, 0, 0) rownames(varFix) <- colnames(varFix) <- colnames(X) fit0$coef[nm] <- alpha if (!sigma.fixed) varSigma <- sigma^2/(4 * Info) else varSigma <- NA glm <- identical(sigma, 0) if (!empty) { if (rank < p) QR <- qr(cbind(wX, sqrt(w) * X0)) else QR <- qr(wX) R <- qr.R(QR) } list(coefficients = structure(fit0$coef, random = beta), residuals = residuals, fitted.values = mu, #effect = ? R = if (!empty) R, rank = rank, qr = if (!empty) QR, family = family, linear.predictors = eta, deviance = if (glm) sum(family$dev.resids(y, mu, w)), aic = if (glm) family$aic(y, length(y), mu, w, sum(family$dev.resids(y, mu, w))) + 2 * rank, null.deviance = if (glm) { wtdmu <- family$linkinv(offset) sum(family$dev.resids(y, wtdmu, w)) }, iter = ifelse(glm, NA, i), weights = wy, prior.weights = w, df.residual = length(y) - rank, df.null = if (glm) length(y) - sum(w == 0), y = y, sigma = sigma, sigma.fixed = sigma.fixed, varFix = varFix, varSigma = varSigma, converged = conv) } BradleyTerry2/R/BTm.R0000744000176200001440000003252313615023725013764 0ustar liggesusers#' Bradley-Terry Model and Extensions #' #' Fits Bradley-Terry models for pair comparison data, including models with #' structured scores, order effect and missing covariate data. Fits by either #' maximum likelihood or maximum penalized likelihood (with Jeffreys-prior #' penalty) when abilities are modelled exactly, or by penalized #' quasi-likelihood when abilities are modelled by covariates. #' #' In each comparison to be modelled there is a 'first player' and a 'second #' player' and it is assumed that one player wins while the other loses (no #' allowance is made for tied comparisons). #' #' The [countsToBinomial()] function is provided to convert a #' contingency table of wins into a data frame of wins and losses for each pair #' of players. #' #' The `formula` argument specifies the model for player ability and #' applies to both the first player and the second player in each contest. If #' `NULL` a separate ability is estimated for each player, equivalent to #' setting `formula = reformulate(id)`. #' #' Contest-level variables can be specified in the formula in the usual manner, #' see [formula()]. Player covariates should be included as variables #' indexed by `id`, see examples. Thus player covariates must be ordered #' according to the levels of the ID factor. #' #' If `formula` includes player covariates and there are players with #' missing values over these covariates, then a separate ability will be #' estimated for those players. #' #' When player abilities are modelled by covariates, then random player effects #' should be added to the model. These should be specified in the formula using #' the vertical bar notation of [lme4::lmer()], see examples. #' #' When specified, it is assumed that random player effects arise from a #' \eqn{N(0, }{N(0, sigma^2)}\eqn{ \sigma^2)}{N(0, sigma^2)} distribution and #' model parameters, including \eqn{\sigma}{sigma}, are estimated using PQL #' (Breslow and Clayton, 1993) as implemented in the [glmmPQL()] #' function. #' #' @param outcome the binomial response: either a numeric vector, a factor in #' which the first level denotes failure and all others success, or a #' two-column matrix with the columns giving the numbers of successes and #' failures. #' @param player1 either an ID factor specifying the first player in each #' contest, or a data.frame containing such a factor and possibly other #' contest-level variables that are specific to the first player. If given in a #' data.frame, the ID factor must have the name given in the `id` #' argument. If a factor is specified it will be used to create such a #' data.frame. #' @param player2 an object corresponding to that given in `player1` for #' the second player in each contest, with identical structure -- in particular #' factors must have identical levels. #' @param formula a formula with no left-hand-side, specifying the model for #' player ability. See details for more information. #' @param id the name of the ID factor. #' @param separate.ability (if `formula` does not include the ID factor as #' a separate term) a character vector giving the names of players whose #' abilities are to be modelled individually rather than using the #' specification given by `formula`. #' @param refcat (if `formula` includes the ID factor as a separate term) #' a character specifying which player to use as a reference, with the first #' level of the ID factor as the default. Overrides any other contrast #' specification for the ID factor. #' @param family a description of the error distribution and link function to #' be used in the model. Only the binomial family is implemented, with #' either`"logit"`, `"probit"` , or `"cauchit"` link. (See #' [stats::family()] for details of family functions.) #' @param data an optional object providing data required by the model. This #' may be a single data frame of contest-level data or a list of data frames. #' Names of data frames are ignored unless they refer to data frames specified #' by `player1` and `player2`. The rows of data frames that do not #' contain contest-level data must correspond to the levels of a factor used #' for indexing, i.e. row 1 corresponds to level 1, etc. Note any rownames are #' ignored. Objects are searched for first in the `data` object if #' provided, then in the environment of `formula`. If `data` is a #' list, the data frames are searched in the order given. #' @param weights an optional numeric vector of \sQuote{prior weights}. #' @param subset an optional logical or numeric vector specifying a subset of #' observations to be used in the fitting process. #' @param na.action a function which indicates what should happen when any #' contest-level variables contain `NA`s. The default is the #' `na.action` setting of `options`. See details for the handling of #' missing values in other variables. #' @param start a vector of starting values for the fixed effects. #' @param etastart a vector of starting values for the linear predictor. #' @param mustart a vector of starting values for the vector of means. #' @param offset an optional offset term in the model. A vector of length equal #' to the number of contests. #' @param br logical. If `TRUE` fitting will be by penalized maximum #' likelihood as in Firth (1992, 1993), using [brglm::brglm()], #' rather than maximum likelihood using [glm()], when abilities are #' modelled exactly or when the abilities are modelled by covariates and the #' variance of the random effects is estimated as zero. #' @param model logical: whether or not to return the model frame. #' @param x logical: whether or not to return the design matrix for the fixed #' effects. #' @param contrasts an optional list specifying contrasts for the factors in #' `formula`. See the `contrasts.arg` of [model.matrix()]. #' @param \dots other arguments for fitting function (currently either #' [glm()], [brglm::brglm()], or [glmmPQL()]) #' @return An object of class `c("BTm", "x")`, where `"x"` is the #' class of object returned by the model fitting function (e.g. `glm`). #' Components are as for objects of class `"x"`, with additionally #' \item{id}{the `id` argument.} \item{separate.ability}{the #' `separate.ability` argument.} \item{refcat}{the `refcat` #' argument.} \item{player1}{a data frame for the first player containing the #' ID factor and any player-specific contest-level variables.} \item{player2}{a #' data frame corresponding to that for `player1`.} \item{assign}{a #' numeric vector indicating which coefficients correspond to which terms in #' the model.} \item{term.labels}{labels for the model terms.} #' \item{random}{for models with random effects, the design matrix for the #' random effects. } #' @author Heather Turner, David Firth #' @seealso [countsToBinomial()], [glmmPQL()], #' [BTabilities()], [residuals.BTm()], #' [add1.BTm()], [anova.BTm()] #' @references #' #' Agresti, A. (2002) *Categorical Data Analysis* (2nd ed). New York: #' Wiley. #' #' Firth, D. (1992) Bias reduction, the Jeffreys prior and GLIM. In #' *Advances in GLIM and Statistical Modelling*, Eds. Fahrmeir, L., #' Francis, B. J., Gilchrist, R. and Tutz, G., pp91--100. New York: Springer. #' #' Firth, D. (1993) Bias reduction of maximum likelihood estimates. #' *Biometrika* **80**, 27--38. #' #' Firth, D. (2005) Bradley-Terry models in R. *Journal of Statistical #' Software*, **12**(1), 1--12. #' #' Stigler, S. (1994) Citation patterns in the journals of statistics and #' probability. *Statistical Science* **9**, 94--108. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' @keywords models #' @examples #' #' ######################################################## #' ## Statistics journal citation data from Stigler (1994) #' ## -- see also Agresti (2002, p448) #' ######################################################## #' #' ## Convert frequencies to success/failure data #' citations.sf <- countsToBinomial(citations) #' names(citations.sf)[1:2] <- c("journal1", "journal2") #' #' ## First fit the "standard" Bradley-Terry model #' citeModel <- BTm(cbind(win1, win2), journal1, journal2, data = citations.sf) #' #' ## Now the same thing with a different "reference" journal #' citeModel2 <- update(citeModel, refcat = "JASA") #' BTabilities(citeModel2) #' #' ################################################################## #' ## Now an example with an order effect -- see Agresti (2002) p438 #' ################################################################## #' data(baseball) # start with baseball data as provided by package #' #' ## Simple Bradley-Terry model, ignoring home advantage: #' baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, #' data = baseball, id = "team") #' #' ## Now incorporate the "home advantage" effect #' baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) #' baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) #' baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) #' #' ## Compare the fit of these two models: #' anova(baseballModel1, baseballModel2) #' #' ## #' ## For a more elaborate example with both player-level and contest-level #' ## predictor variables, see help(chameleons). #' ## #' #' @importFrom brglm brglm #' @export BTm <- function(outcome = 1, player1, player2, formula = NULL, id = "..", separate.ability = NULL, refcat = NULL, family = "binomial", data = NULL, weights = NULL, subset = NULL, na.action = NULL, start = NULL, etastart = NULL, mustart = NULL, offset = NULL, br = FALSE, model = TRUE, x = FALSE, contrasts = NULL, ...){ call <- match.call() if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame()) if (is.function(family)) family <- family() if (is.null(family$family)) { print(family) stop("`family' not recognized") } if (family$family != "binomial") stop("`family' must be binomial") if (!family$link %in% c("logit", "probit", "cauchit")) stop("link for binomial family must be one of \"logit\", \"probit\"", "or \"cauchit\"") fcall <- as.list(match.call(expand.dots = FALSE)) if (is.null(formula)) { formula <- reformulate(id) environment(formula) <- parent.frame() fcall$formula <- formula } setup <- match(c("outcome", "player1", "player2", "formula", "id", "separate.ability", "refcat", "data", "weights", "subset", "offset", "contrasts"), names(fcall), 0L) setup <- do.call(BTm.setup, fcall[setup], envir = parent.frame()) if (setup$saturated) warning("Player ability saturated - equivalent to fitting ", "separate abilities.") mf <- data.frame(X = setup$player1) #just to get length if (!is.null(setup$X)) { mf$X <- setup$X formula <- Y ~ X - 1 } else formula <- Y ~ 0 mf$Y <- setup$Y argPos <- match(c("na.action", "start", "etastart", "mustart", "control", "model", "x"), names(fcall), 0) dotArgs <- fcall$"..." if (is.null(setup$random)) { method <- get(ifelse(br, "brglm", "glm"), mode = "function") fit <- as.call(c(method, fcall[argPos], list(formula = formula, family = family, data = mf, offset = setup$offset, subset = setup$subset, weights = setup$weights), dotArgs)) fit <- eval(fit, parent.frame()) } else { method <- get("glmmPQL", mode = "function") fit <- as.call(c(method, fcall[argPos], list(formula, setup$random, family = family, data = mf, offset = setup$offset, subset = setup$subset, weights = setup$weights), dotArgs)) fit <- eval(fit, parent.frame()) if (br) { if (identical(fit$sigma, 0)){ argPos <- match(c("na.action", "model", "x"), names(fcall), 0) method <- get("brglm", mode = "function") fit <- as.call(c(method, fcall[argPos], list(formula, family = family, data = mf, offset = setup$offset, subset = setup$subset, weights = setup$weights, etastart = fit$linear.predictors))) fit <- eval(fit, parent.frame()) fit$class <- c("glmmPQL", class(fit)) } else warning("'br' argument ignored for models with random effects", call. = FALSE) } } if (length(fit$coefficients)) { if (ncol(setup$X) > 1) names(fit$coefficients) <- substring(names(fit$coefficients), 2) else names(fit$coefficients) <- colnames(setup$X) fit$assign <- attr(setup$X, "assign") } fit$call <- call fit$id <- id fit$separate.ability <- separate.ability fit$contrasts <- setup$contrasts fit$refcat <- setup$refcat fit$formula <- setup$formula fit$player1 <- setup$player1 fit$player2 <- setup$player2 fit$term.labels <- setup$term.labels fit$data <- setup$data fit$random <- setup$random class(fit) <- c("BTm", class(fit)) fit } BradleyTerry2/R/seeds.R0000744000176200001440000000207213152515665014406 0ustar liggesusers#' Seed Germination Data from Crowder (1978) #' #' Data from Crowder(1978) giving the proportion of seeds germinated for 21 #' plates that were arranged according to a 2x2 factorial layout by seed #' variety and type of root extract. #' #' #' @name seeds #' @docType data #' @format A data frame with 21 observations on the following 4 variables. #' \describe{ #' \item{r}{the number of germinated seeds.} #' \item{n}{the total number of seeds.} #' \item{seed}{the seed #' variety.} #' \item{extract}{the type of root extract.} } #' @seealso [glmmPQL()] #' @references Breslow, N. E. and Clayton, D. G. (1993) Approximate inference #' in Generalized Linear Mixed Models. *Journal of the American #' Statistical Association*, **88**(421), 9--25. #' @source Crowder, M. (1978) Beta-Binomial ANOVA for proportions. #' *Applied Statistics*, **27**, 34--37. #' @keywords datasets #' @examples #' #' summary(glmmPQL(cbind(r, n - r) ~ seed + extract, #' random = diag(nrow(seeds)), #' family = binomial, #' data = seeds)) #' "seeds" BradleyTerry2/R/glmmPQL.control.R0000744000176200001440000000507013152515665016274 0ustar liggesusers#' Control Aspects of the glmmPQL Algorithm #' #' Set control variables for the glmmPQL algorithm. #' #' This function provides an interface to control the PQL algorithm used by #' [BTm()] for fitting Bradley Terry models with random effects. #' #' The algorithm iterates between a series of iterated weighted least squares #' iterations to update the fixed effects and a single Fisher scoring iteration #' to update the standard deviation of the random effects. #' #' Convergence of both the inner and outer iterations are judged by comparing #' the squared components of the relevant score vector with corresponding #' elements of the diagonal of the Fisher information matrix. If, for all #' components of the relevant score vector, the ratio is less than #' `tolerance^2`, or the corresponding diagonal element of the Fisher #' information matrix is less than 1e-20, iterations cease. #' #' @param maxiter the maximum number of outer iterations. #' @param IWLSiter the maximum number of iterated weighted least squares #' iterations used to estimate the fixed effects, given the standard deviation #' of the random effects. #' @param tol the tolerance used to determine convergence in the IWLS #' iterations and over all (see details). #' @param trace logical: whether or not to print the score for the random #' effects variance at the end of each iteration. #' @return A list with the arguments as components. #' @author Heather Turner #' @seealso [glmmPQL()], [BTm()] #' @references Breslow, N. E. and Clayton, D. G. (1993), Approximate inference #' in Generalized Linear Mixed Models. *Journal of the American #' Statistical Association* **88**(421), 9--25. #' @keywords models #' @examples #' #' ## Variation on example(flatlizards) #' result <- rep(1, nrow(flatlizards$contests)) #' #' ## BTm passes arguments on to glmmPQL.control() #' args(BTm) #' BTmodel <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..] + (1|..), #' data = flatlizards, tol = 1e-3, trace = TRUE) #' summary(BTmodel) #' #' @export glmmPQL.control <- function (maxiter = 50, IWLSiter = 10, tol = 1e-6, trace = FALSE) { call <- as.list(match.call()) if (length(call) > 1) { argPos <- match(c("maxiter", "IWLSiter", "tol"), names(call)) for (n in argPos[!is.na(argPos)]) { if (!is.numeric(call[[n]]) || call[[n]] <= 0) stop("value of '", names(call)[n], "' must be > 0") } } list(maxiter = maxiter, IWLSiter = IWLSiter, tol = tol, trace = trace) } BradleyTerry2/R/vcov.BTglmmPQL.R0000744000176200001440000000021113152515665016007 0ustar liggesusers#' @export vcov.BTglmmPQL <- function (object, ...) { so <- summary(object, corr = FALSE, ...) so$dispersion * so$cov.unscaled } BradleyTerry2/R/drop1.BTm.R0000744000176200001440000000733613152515665015021 0ustar liggesusers#' @importFrom stats coef drop.scope model.matrix formula pchisq pf terms update.formula vcov #' @export drop1.BTm <- function(object, scope, scale = 0, test = c("none", "Chisq", "F"), ...) { x <- model.matrix(object) ## Pass on if no random effects if (is.null(object$random)){ object$x <- x attr(object$x, "assign") <- object$assign object$terms <- terms(object$formula) return(NextMethod()) } form <- formula(object) if (missing(scope)) scope <- drop.scope(nobars(form)) else { if (!is.character(scope)) { srandom <- findbars(scope[[2]]) if (length(srandom)) stop("Scope should not include random effects.") scope <- attr(terms(update.formula(form, scope)), "term.labels") } if (!all(match(scope, terms(form), 0L) > 0L)) stop("scope is not a subset of term labels") } asgn <- object$assign coefs <- coef(object) if (scale == 0) dispersion <- 1 else dispersion <- scale vc <- vcov(object, dispersion = dispersion) #vcov should handle disp != 1 sTerms <- vapply(strsplit(scope, ":", fixed = TRUE), function(x) paste(sort(x), collapse = ":"), character(1)) stat <- df <- numeric(length(scope)) names(stat) <- names(df) <- as.character(lapply(scope, as.name)) tryerror <- FALSE for (i in seq(scope)) { stt <- paste(sort(strsplit(scope[i], ":")[[1]]), collapse = ":") usex <- match(asgn, match(stt, sTerms), 0) > 0 trystat <- try(t(coefs[usex]) %*% chol2inv(chol(vc[usex, usex])) %*% coefs[usex], silent = TRUE) if (inherits(trystat, "try-error")) { stat[i] <- df[i] <- NA tryerror <- TRUE } else { stat[i] <- trystat df[i] <- sum(usex) } } table <- data.frame(stat, df) dimnames(table) <- list(names(df), c("Statistic", "Df")) title <- "Single term deletions\n" topnote <- gsub("\\s+", " ", paste("Model: ", paste(deparse(as.vector(formula(object))), collapse = ""), if (scale > 0) paste("\nscale: ", format(scale), "\n"), if (tryerror) "\n\nTest statistic unestimable for at least one term"), perl = TRUE) test <- match.arg(test) if (test == "Chisq") { dfs <- table[, "Df"] vals <- table[, "Statistic"] vals[dfs %in% 0] <- NA table <- cbind(table, `P(>|Chi|)` = pchisq(vals, abs(dfs), lower.tail = FALSE)) } else if (test == "F") { ## Assume dispersion fixed at one - if dispersion estimated, would use ## "residual" df from larger model in each comparison df.dispersion <- Inf if (df.dispersion == Inf) { fam <- object[[1]]$family$family if (fam == "binomial" || fam == "poisson") warning(gettextf("using F test with a '%s' family is ", "inappropriate", fam), domain = NA, call. = FALSE) else { warning("using F test with a fixed dispersion is inappropriate") } } dfs <- table[, "Df"] Fvalue <- table[, "Statistic"]/abs(dfs) Fvalue[dfs %in% 0] <- NA table <- cbind(table, F = Fvalue, `Pr(>F)` = pf(Fvalue, abs(dfs), df.dispersion, lower.tail = FALSE)) } structure(table, heading = c(title, topnote), class = c("anova", "data.frame")) } BradleyTerry2/R/formula.BTm.R0000744000176200001440000000006613152515665015432 0ustar liggesusers#' @export formula.BTm <- function(x, ...) x$formula BradleyTerry2/R/GenDavidson.R0000744000176200001440000003117713152515665015514 0ustar liggesusers#' Specify a Generalised Davidson Term in a gnm Model Formula #' #' GenDavidson is a function of class `"nonlin"` to specify a generalised #' Davidson term in the formula argument to [gnm::gnm()], providing a #' model for paired comparison data where ties are a possible outcome. #' #' `GenDavidson` specifies a generalisation of the Davidson model (1970) #' for paired comparisons where a tie is a possible outcome. It is designed for #' modelling trinomial counts corresponding to the win/draw/loss outcome for #' each contest, which are assumed Poisson conditional on the total count for #' each match. Since this total must be one, the expected counts are #' equivalently the probabilities for each possible outcome, which are modelled #' on the log scale: \deqn{\log(p(i \textrm{beats} j)_k) = \theta_{ijk} + #' \log(\mu\alpha_i}{log(p(i beats j)_k) = theta_{ijk} + log(mu * alpha_i)} #' \deqn{\log(p(draw)_k) = \theta_{ijk} + \delta + c + }{ log(p(draw)_k) = #' theta_{ijk} + log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * #' log(alpha_j)) + (1 - sigma) * log(mu * alpha_i + alpha_j) }\deqn{ #' \sigma(\pi\log(\mu\alpha_i) - (1 - \pi)log(\alpha_j)) + }{ log(p(draw)_k) = #' theta_{ijk} + log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * #' log(alpha_j)) + (1 - sigma) * log(mu * alpha_i + alpha_j) }\deqn{ (1 - #' \sigma)(\log(\mu\alpha_i + \alpha_j))}{ log(p(draw)_k) = theta_{ijk} + #' log(delta) + c + sigma * (pi * log(mu * alpha_i) + (1 - pi) * log(alpha_j)) #' + (1 - sigma) * log(mu * alpha_i + alpha_j) } \deqn{\log(p(j \textrm{beats} #' i)_k) = \theta_{ijk} + }{log(p(j beats i)_k) = theta_{ijk} + #' log(alpha_j)}\deqn{ log(\alpha_j)}{log(p(j beats i)_k) = theta_{ijk} + #' log(alpha_j)} Here \eqn{\theta_{ijk}}{theta_{ijk}} is a structural parameter #' to fix the trinomial totals; \eqn{\mu}{mu} is the home advantage parameter; #' \eqn{\alpha_i}{alpha_i} and \eqn{\alpha_j}{alpha_j} are the abilities of #' players \eqn{i} and \eqn{j} respectively; \eqn{c}{c} is a function of the #' parameters such that \eqn{\textrm{expit}(\delta)}{plogis(delta)} is the #' maximum probability of a tie, \eqn{\sigma}{sigma} scales the dependence of #' the probability of a tie on the relative abilities and \eqn{\pi}{pi} allows #' for asymmetry in this dependence. #' #' For parameters that must be positive (\eqn{\alpha_i, \sigma, \mu}{alpha, #' sigma, mu}), the log is estimated, while for parameters that must be between #' zero and one (\eqn{\delta, \pi}), the logit is estimated, as illustrated in #' the example. #' #' @param win a logical vector: `TRUE` if player1 wins, `FALSE` #' otherwise. #' @param tie a logical vector: `TRUE` if the outcome is a tie, #' `FALSE` otherwise. #' @param loss a logical vector: `TRUE` if player1 loses, `FALSE` #' otherwise. #' @param player1 an ID factor specifying the first player in each contest, #' with the same set of levels as `player2`. #' @param player2 an ID factor specifying the second player in each contest, #' with the same set of levels as `player2`. #' @param home.adv a formula for the parameter corresponding to the home #' advantage effect. If `NULL`, no home advantage effect is estimated. #' @param tie.max a formula for the parameter corresponding to the maximum tie #' probability. #' @param tie.scale a formula for the parameter corresponding to the scale of #' dependence of the tie probability on the probability that `player1` #' wins, given the outcome is not a draw. #' @param tie.mode a formula for the parameter corresponding to the location of #' maximum tie probability, in terms of the probability that `player1` #' wins, given the outcome is not a draw. #' @param at.home1 a logical vector: `TRUE` if `player1` is at home, #' `FALSE` otherwise. #' @param at.home2 a logical vector: `TRUE` if `player2` is at home, #' `FALSE` otherwise. #' @return A list with the anticipated components of a "nonlin" function: #' \item{ predictors }{ the formulae for the different parameters and the ID #' factors for player 1 and player 2. } \item{ variables }{ the outcome #' variables and the \dQuote{at home} variables, if specified. } \item{ common #' }{ an index to specify that common effects are to be estimated for the #' players. } \item{ term }{ a function to create a deparsed mathematical #' expression of the term, given labels for the predictors.} \item{ start }{ a #' function to generate starting values for the parameters.} #' @author Heather Turner #' @seealso [football()], [plotProportions()] #' @references Davidson, R. R. (1970). On extending the Bradley-Terry model to #' accommodate ties in paired comparison experiments. *Journal of the #' American Statistical Association*, **65**, 317--328. #' @keywords models nonlinear #' @examples #' #' ### example requires gnm #' if (require(gnm)) { #' ### convert to trinomial counts #' football.tri <- expandCategorical(football, "result", idvar = "match") #' head(football.tri) #' #' ### add variable to indicate whether team playing at home #' football.tri$at.home <- !logical(nrow(football.tri)) #' #' ### fit shifted & scaled Davidson model #' ### - subset to first and last season for illustration #' shifScalDav <- gnm(count ~ #' GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, tie.scale = ~1, tie.mode = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri, #' subset = season %in% c("2008-9", "2012-13")) #' #' ### look at coefs #' coef <- coef(shifScalDav) #' ## home advantage #' exp(coef["home.adv"]) #' ## max p(tie) #' plogis(coef["tie.max"]) #' ## mode p(tie) #' plogis(coef["tie.mode"]) #' ## scale relative to Davidson of dependence of p(tie) on p(win|not a draw) #' exp(coef["tie.scale"]) #' #' ### check model fit #' alpha <- names(coef[-(1:4)]) #' plotProportions(result == 1, result == 0, result == -1, #' home:season, away:season, #' abilities = coef[alpha], home.adv = coef["home.adv"], #' tie.max = coef["tie.max"], tie.scale = coef["tie.scale"], #' tie.mode = coef["tie.mode"], #' at.home1 = at.home, at.home2 = !at.home, #' data = football.tri, subset = count == 1) #' } #' #' ### analyse all five seasons #' ### - takes a little while to run, particularly likelihood ratio tests #' \dontrun{ #' ### fit Davidson model #' Dav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri) #' #' ### fit scaled Davidson model #' scalDav <- gnm(count ~ GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, tie.scale = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri) #' #' ### fit shifted & scaled Davidson model #' shifScalDav <- gnm(count ~ #' GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, home.adv = ~1, #' tie.max = ~1, tie.scale = ~1, tie.mode = ~1, #' at.home1 = at.home, #' at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri) #' #' ### compare models #' anova(Dav, scalDav, shifScalDav, test = "Chisq") #' #' ### diagnostic plots #' main <- c("Davidson", "Scaled Davidson", "Shifted & Scaled Davidson") #' mod <- list(Dav, scalDav, shifScalDav) #' names(mod) <- main #' #' ## use football.tri data so that at.home can be found, #' ## but restrict to actual match results #' par(mfrow = c(2,2)) #' for (i in 1:3) { #' coef <- parameters(mod[[i]]) #' plotProportions(result == 1, result == 0, result == -1, #' home:season, away:season, #' abilities = coef[alpha], #' home.adv = coef["home.adv"], #' tie.max = coef["tie.max"], #' tie.scale = coef["tie.scale"], #' tie.mode = coef["tie.mode"], #' at.home1 = at.home, #' at.home2 = !at.home, #' main = main[i], #' data = football.tri, subset = count == 1) #' } #' } #' #' @importFrom stats coef plogis runif #' @export GenDavidson <- function(win, # TRUE/FALSE tie, # TRUE/FALSE loss, # TRUE/FALSE player1, # player1 in each contest player2, # ditto player2 home.adv = NULL, tie.max = ~1, tie.mode = NULL, tie.scale = NULL, at.home1 = NULL, at.home2 = NULL){ call <- as.expression(sys.call()[c(1,5:6)]) extra <- NULL if (is.null(tie.max)) stop("a formula must be specified for tie.max") if (!is.null(home.adv) & is.null(at.home1)) stop("at.home1 and at.home2 must be specified") has.home.adv <- !is.null(home.adv) has.tie.mode <- !is.null(tie.mode) has.tie.scale <- !is.null(tie.scale) if (has.home.adv) extra <- c(extra, list(home.adv = home.adv)) if (has.tie.mode) extra <- c(extra, list(tie.mode = tie.mode)) if (has.tie.scale) extra <- c(extra, list(tie.scale = tie.scale)) i <- has.home.adv + has.tie.mode + has.tie.scale a <- match("home.adv", names(extra), 1) b <- match("tie.mode", names(extra), 1) c <- match("tie.scale", names(extra), 1) adv <- has.home.adv | has.tie.mode list(predictors = {c(extra, list(tie.max = tie.max, substitute(player1), # player1 & 2 are homogeneous substitute(player2)))}, ## substitutes "result" for "outcome", but also substitutes all of ## code vector variables = {c(list(loss = substitute(loss), tie = substitute(tie), win = substitute(win)), list(at.home1 = substitute(at.home1), at.home2 = substitute(at.home2))[adv])}, common = c(1[has.home.adv], 2[has.tie.mode], 3[has.tie.scale], 4, 5, 5), term = function(predLabels, varLabels){ if (has.home.adv) { ability1 <- paste("(", predLabels[a], ") * ", varLabels[4], " + ", predLabels[i + 2], sep = "") ability2 <- paste("(", predLabels[a], ") * ", varLabels[5], " + ", predLabels[i + 3], sep = "") } else { ability1 <- predLabels[i + 2] ability2 <- predLabels[i + 3] } tie.scale <- ifelse(has.tie.scale, predLabels[c], 0) scale <- paste("exp(", tie.scale, ")", sep = "") if (has.tie.mode) { psi1 <- paste("exp((", predLabels[b], ") * ", varLabels[4], ")", sep = "") psi2 <- paste("exp((", predLabels[b], ") * ", varLabels[5], ")", sep = "") weight1 <- paste(psi1, "/(", psi1, " + ", psi2, ")", sep = "") weight2 <- paste(psi2, "/(", psi1, " + ", psi2, ")", sep = "") } else { weight1 <- weight2 <- "0.5" } nu <- paste(predLabels[i + 1], " - ", scale, " * (", weight1, " * log(", weight1, ") + ", weight2, " * log(", weight2, "))", sep = "") paste(varLabels[1], " * (", ability2, ") + ", varLabels[2], " * (", nu, " + ", scale, " * ", weight1, " * (", ability1, ") + ", scale, " * ", weight2, " * (", ability2, ") + ", "(1 - ", scale, ") * ", "log(exp(", ability1, ") + exp(", ability2, "))) + ", varLabels[3], " * (", ability1, ")", sep = "") }, start = function(theta) { init <- runif(length(theta)) - 0.5 init[c] <- 0.5 } ) } class(GenDavidson) <- "nonlin" BradleyTerry2/R/glmmPQL.R0000744000176200001440000002506313463537117014622 0ustar liggesusers#' PQL Estimation of Generalized Linear Mixed Models #' #' Fits GLMMs with simple random effects structure via Breslow and Clayton's #' PQL algorithm. #' The GLMM is assumed to be of the form \ifelse{html}{\out{g(μ) = #' Xβ + Ze}}{\deqn{g(\boldsymbol{\mu}) = \boldsymbol{X\beta} #' + \boldsymbol{Ze}}{ g(mu) = X * beta + Z * e}} where \eqn{g} is the link #' function, \ifelse{html}{\out{μ}}{\eqn{\boldsymbol{\mu}}{mu}} is the #' vector of means and \ifelse{html}{\out{X, Z}}{\eqn{\boldsymbol{X}, #' \boldsymbol{Z}}{X,Z}} are design matrices for the fixed effects #' \ifelse{html}{\out{β}}{\eqn{\boldsymbol{\beta}}{beta}} and random #' effects \ifelse{html}{\out{e}}{\eqn{\boldsymbol{e}}{e}} respectively. #' Furthermore the random effects are assumed to be i.i.d. #' \ifelse{html}{\out{N(0, σ2)}}{\eqn{N(0, \sigma^2)}{ #' N(0, sigma^2)}}. #' #' @param fixed a formula for the fixed effects. #' @param random a design matrix for the random effects, with number of rows #' equal to the length of variables in `formula`. #' @param family a description of the error distribution and link function to #' be used in the model. This can be a character string naming a family #' function, a family function or the result of a call to a family function. #' (See [family()] for details of family functions.) #' @param data an optional data frame, list or environment (or object coercible #' by [as.data.frame()] to a data frame) containing the variables in #' the model. If not found in `data`, the variables are taken from #' `environment(formula)`, typically the environment from which #' `glmmPQL` called. #' @param subset an optional logical or numeric vector specifying a subset of #' observations to be used in the fitting process. #' @param weights an optional vector of \sQuote{prior weights} to be used in #' the fitting process. #' @param offset an optional numeric vector to be added to the linear predictor #' during fitting. One or more `offset` terms can be included in the #' formula instead or as well, and if more than one is specified their sum is #' used. See [model.offset()]. #' @param na.action a function which indicates what should happen when the data #' contain `NA`s. The default is set by the `na.action` setting of #' [options()], and is [na.fail()] if that is unset. #' @param start starting values for the parameters in the linear predictor. #' @param etastart starting values for the linear predictor. #' @param mustart starting values for the vector of means. #' @param control a list of parameters for controlling the fitting process. #' See the [glmmPQL.control()] for details. #' @param sigma a starting value for the standard deviation of the random #' effects. #' @param sigma.fixed logical: whether or not the standard deviation of the #' random effects should be fixed at its starting value. #' @param model logical: whether or not the model frame should be returned. #' @param x logical: whether or not the design matrix for the fixed effects #' should be returned. #' @param contrasts an optional list. See the `contrasts.arg` argument of #' [model.matrix()]. #' @param \dots arguments to be passed to [glmmPQL.control()]. #' @return An object of class `"BTglmmPQL"` which inherits from #' `"glm"` and `"lm"`: \item{coefficients}{ a named vector of #' coefficients, with a `"random"` attribute giving the estimated random #' effects.} \item{residuals}{ the working residuals from the final iteration #' of the IWLS loop.} \item{random}{the design matrix for the random effects.} #' \item{fitted.values}{ the fitted mean values, obtained by transforming the #' linear predictors by the inverse of the link function.} \item{rank}{the #' numeric rank of the fitted linear model.} \item{family}{the `family` #' object used.} \item{linear.predictors}{the linear fit on link scale.} #' \item{deviance}{up to a constant, minus twice the maximized log-likelihood.} #' \item{aic}{a version of Akaike's *An Information Criterion*, minus #' twice the maximized log-likelihood plus twice the number of parameters, #' computed by the `aic` component of the family.} #' \item{null.deviance}{the deviance for the null model, comparable with #' `deviance`.} \item{iter}{the numer of iterations of the PQL algorithm.} #' \item{weights}{the working weights, that is the weights in the final #' iteration of the IWLS loop.} \item{prior.weights}{the weights initially #' supplied, a vector of `1`'s if none were.} \item{df.residual}{the #' residual degrees of freedom.} \item{df.null}{the residual degrees of freedom #' for the null model.} \item{y}{if requested (the default) the `y` vector #' used. (It is a vector even for a binomial model.)} \item{x}{if requested, #' the model matrix.} \item{model}{if requested (the default), the model #' frame.} \item{converged}{logical. Was the PQL algorithm judged to have #' converged?} \item{call}{the matched call.} \item{formula}{the formula #' supplied.} \item{terms}{the `terms` object used.} \item{data}{the #' `data` argument used.} \item{offset}{the offset vector used.} #' \item{control}{the value of the `control` argument used.} #' \item{contrasts}{(where relevant) the contrasts used.} \item{xlevels}{(where #' relevant) a record of the levels of the factors used in fitting.} #' \item{na.action}{(where relevant) information returned by `model.frame` #' on the special handling of `NA`s.} \item{sigma}{the estimated standard #' deviation of the random effects} \item{sigma.fixed}{logical: whether or not #' `sigma` was fixed} \item{varFix}{the variance-covariance matrix of the #' fixed effects} \item{varSigma}{the variance of `sigma`} #' @author Heather Turner #' @seealso #' [predict.BTglmmPQL()],[glmmPQL.control()],[BTm()] #' @references Breslow, N. E. and Clayton, D. G. (1993) Approximate inference #' in Generalized Linear Mixed Models. *Journal of the American #' Statistical Association* **88**(421), 9--25. #' #' Harville, D. A. (1977) Maximum likelihood approaches to variance component #' estimation and to related problems. *Journal of the American #' Statistical Association* **72**(358), 320--338. #' @keywords models #' @examples #' #' ############################################### #' ## Crowder seeds example from Breslow & Clayton #' ############################################### #' #' summary(glmmPQL(cbind(r, n - r) ~ seed + extract, #' random = diag(nrow(seeds)), #' family = "binomial", data = seeds)) #' #' summary(glmmPQL(cbind(r, n - r) ~ seed*extract, #' random = diag(nrow(seeds)), #' family = "binomial", data = seeds)) #' #' @importFrom stats gaussian .getXlevels glm.control is.empty.model glm.control glm.fit model.frame model.matrix model.offset model.response model.weights optimize terms #' @export glmmPQL <- function(fixed, random = NULL, family = "binomial", data = NULL, subset = NULL, weights = NULL, offset = NULL, na.action = NULL, start = NULL, etastart = NULL, mustart = NULL, control = glmmPQL.control(...), sigma = 0.1, sigma.fixed = FALSE, model = TRUE, x = FALSE, contrasts = NULL, ...) { call <- match.call() nm <- names(call)[-1] if (is.null(random)) { keep <- is.element(nm, c("family", "data", "subset", "weights", "offset", "na.action")) for (i in nm[!keep]) call[[i]] <- NULL call$formula <- fixed environment(call$formula) <- environment(fixed) call[[1]] <- as.name("glm") return(eval.parent(call)) } modelTerms <- terms(fixed, data = data) modelCall <- as.list(match.call(expand.dots = FALSE)) argPos <- match(c("data", "subset", "na.action", "weights", "offset"), names(modelCall), 0) modelData <- as.call(c(model.frame, list(formula = modelTerms, drop.unused.levels = TRUE), modelCall[argPos])) modelData <- eval(modelData, parent.frame()) if (!is.matrix(random) || nrow(random) != nrow(modelData)) { stop("`random` should be a matrix object, with ", nrow(modelData), " rows.") } if (!is.null(modelCall$subset)) Z <- random[eval(modelCall$subset, data, parent.frame()),] else Z <- random if (!is.null(attr(modelData, "na.action"))) Z <- Z[-attr(modelData, "na.action"),] nObs <- nrow(modelData) y <- model.response(modelData, "numeric") if (is.null(y)) y <- rep(0, nObs) weights <- as.vector(model.weights(modelData)) if (!is.null(weights) && any(weights < 0)) stop("negative weights are not allowed") if (is.null(weights)) weights <- rep.int(1, nObs) offset <- as.vector(model.offset(modelData)) if (is.null(offset)) offset <- rep.int(0, nObs) if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame()) if (is.function(family)) family <- family() if (is.null(family$family)) { print(family) stop("`family' not recognized") } if (family$family == "binomial") { if (is.factor(y) && NCOL(y) == 1) y <- y != levels(y)[1] else if (NCOL(y) == 2) { n <- y[, 1] + y[, 2] y <- ifelse(n == 0, 0, y[, 1]/n) weights <- weights * n } } ## Use GLM to estimate fixed effects empty <- is.empty.model(modelTerms) if (!empty) X <- model.matrix(formula(modelTerms), data = modelData, contrasts) else X <- matrix(, nObs, 0) fit <- glmmPQL.fit(X = X, y = y, Z = Z, weights = weights, start = start, etastart = etastart, mustart = mustart, offset = offset, family = family, control = control, sigma = sigma, sigma.fixed = sigma.fixed, ...) if (sum(offset) && attr(modelTerms, "intercept") > 0) { fit$null.deviance <- glm.fit(x = X[, "(Intercept)", drop = FALSE], y = y, weights = weights, offset = offset, family = family, control = glm.control(), intercept = TRUE)$deviance } if (model) fit$model <- modelData fit$na.action <- attr(modelData, "na.action") if (x) fit$x <- X fit <- c(fit, list(call = call, formula = fixed, random = random, terms = modelTerms, data = data, offset = offset, control = control, method = "glmmPQL.fit", contrasts = attr(X, "contrasts"), xlevels = .getXlevels(modelTerms, modelData))) class(fit) <- c("BTglmmPQL", "glm", "lm") fit } BradleyTerry2/R/springall.R0000744000176200001440000000565113152515665015304 0ustar liggesusers#' Springall (1973) Data on Subjective Evaluation of Flavour Strength #' #' Data from Section 7 of the paper by Springall (1973) on Bradley-Terry #' response surface modelling. An experiment to assess the effects of gel and #' flavour concentrations on the subjective assessment of flavour strength by #' pair comparisons. #' #' The variables `win.adj` and `loss.adj` are provided in order to #' allow a simple way of handling ties (in which a tie counts as half a win and #' half a loss), which is slightly different numerically from the Rao and #' Kupper (1967) model that Springall (1973) uses. #' #' @name springall #' @docType data #' @format A list containing two data frames, `springall$contests` and #' `springall$predictors`. #' #' The `springall$contests` data frame has 36 observations (one for each #' possible pairwise comparison of the 9 treatments) on the following 7 #' variables: \describe{ #' \item{row}{a factor with levels `1:9`, #' the row number in Springall's dataset} # #' \item{col}{a factor with #' levels `1:9`, the column number in Springall's dataset} #' \item{win}{integer, the number of wins for column treatment over row #' treatment} #' \item{loss}{integer, the number of wins for row treatment #' over column treatment} #' \item{tie}{integer, the number of ties #' between row and column treatments} #' \item{win.adj}{numeric, equal to #' `win + tie/2`} #' \item{loss.adj}{numeric, equal to `loss + tie/2`} } #' #' The `predictors` data frame has 9 observations (one for each treatment) #' on the following 5 variables: \describe{ #' \item{flav}{numeric, the #' flavour concentration} #' \item{gel}{numeric, the gel concentration} #' \item{flav.2}{numeric, equal to `flav^2`} #' \item{gel.2}{numeric, equal to `gel^2`} #' \item{flav.gel}{numeric, equal to `flav * gel`} } #' @author David Firth #' @references Rao, P. V. and Kupper, L. L. (1967) Ties in paired-comparison #' experiments: a generalization of the Bradley-Terry model. *Journal of #' the American Statistical Association*, **63**, 194--204. #' @source Springall, A (1973) Response surface fitting using a generalization #' of the Bradley-Terry paired comparison method. *Applied Statistics* #' **22**, 59--68. #' @keywords datasets #' @examples #' #' ## #' ## Fit the same response-surface model as in section 7 of #' ## Springall (1973). #' ## #' ## Differences from Springall's fit are minor, arising from the #' ## different treatment of ties. #' ## #' ## Springall's model in the paper does not include the random effect. #' ## In this instance, however, that makes no difference: the random-effect #' ## variance is estimated as zero. #' ## #' summary(springall.model <- BTm(cbind(win.adj, loss.adj), col, row, #' ~ flav[..] + gel[..] + #' flav.2[..] + gel.2[..] + flav.gel[..] + #' (1 | ..), #' data = springall)) #' "springall" BradleyTerry2/R/summary.BTglmmPQL.R0000744000176200001440000000310513463563706016540 0ustar liggesusers#' @importFrom stats coef pnorm #' @export summary.BTglmmPQL <- function(object, dispersion = NULL, correlation = FALSE, symbolic.cor = FALSE, ...) { if (identical(object$sigma, 0)){ ans <- NextMethod("summary") ans$sigma <- 0 class(ans) <- c("summary.BTglmmPQL", class(ans)) return(ans) } aliased <- is.na(coef(object)) coefs <- coef(object)[!aliased] cov.scaled <- cov.unscaled <- object$varFix # when dispersion != 1? dn <- c("Estimate", "Std. Error", "z value", "Pr(>|z|)") if (object$rank > 0) { sterr <- sqrt(diag(cov.scaled)) tvalue <- coefs/sterr pvalue <- 2 * pnorm(-abs(tvalue)) fixef.table <- cbind(coefs, sterr, tvalue, pvalue) dimnames(fixef.table) <- list(names(coefs), dn) } else { fixef.table <- matrix(, 0, 4) dimnames(fixef.table) <- list(NULL, dn) } sterr <- sqrt(object$varSigma) tvalue <- object$sigma/sterr pvalue <- 2 * pnorm(-abs(tvalue)) ranef.table <- cbind(object$sigma, sterr, tvalue, pvalue) dimnames(ranef.table) <- list("Std. Dev.", dn) ans <- c(object[c("call", "family", "iter", "rank", "na.action")], list(fixef = fixef.table, ranef = ranef.table, aliased = aliased, dispersion = 1, cov.unscaled = cov.unscaled)) if (correlation & object$rank > 0) { dd <- sqrt(diag(cov.unscaled)) ans$correlation <- cov.unscaled/outer(dd, dd) ans$symbolic.cor <- symbolic.cor } class(ans) <- "summary.BTglmmPQL" ans } BradleyTerry2/R/qvcalc.BTabilities.R0000744000176200001440000000704713436770253016756 0ustar liggesusers#' Quasi Variances for Estimated Abilities #' #' A method for [qvcalc::qvcalc()] to compute a set of quasi variances (and #' corresponding quasi standard errors) for estimated abilities from a #' Bradley-Terry model as returned by [BTabilities()]. #' #' For details of the method see Firth (2000), Firth (2003) or Firth and de #' Menezes (2004). Quasi variances generalize and improve the accuracy of #' \dQuote{floating absolute risk} (Easton et al., 1991). This device for #' economical model summary was first suggested by Ridout (1989). #' #' Ordinarily the quasi variances are positive and so their square roots #' (the quasi standard errors) exist and can be used in plots, etc. #' #' @param object a `"BTabilities"` object as returned by [BTabilities()]. #' @param ... additional arguments, currently ignored. #' @return A list of class `"qv"`, with components #' \item{covmat}{The full variance-covariance matrix for the estimated #' abilities.} #' \item{qvframe}{A data frame with variables `estimate`, `SE`, `quasiSE` and #' `quasiVar`, the last two being a quasi standard error and quasi-variance #' for each ability.} #' \item{dispersion}{`NULL` (dispersion is fixed to 1).} #' \item{relerrs}{Relative errors for approximating the standard errors of all #' simple contrasts.} #' \item{factorname}{The name of the ID factor identifying players in the `BTm` #' formula.} #' \item{coef.indices}{`NULL` (no required for this method).} #' \item{modelcall}{The call to `BTm` to fit the Bradley-Terry model from which #' the abilities were estimated.} #' @references #' Easton, D. F, Peto, J. and Babiker, A. G. A. G. (1991) Floating absolute #' risk: an alternative to relative risk in survival and case-control analysis #' avoiding an arbitrary reference group. *Statistics in Medicine* **10**, #' 1025--1035. #' #' Firth, D. (2000) Quasi-variances in Xlisp-Stat and on the web. #' *Journal of Statistical Software* **5.4**, 1--13. #' \url{https://www.jstatsoft.org/article/view/v005i04}. #' #' Firth, D. (2003) Overcoming the reference category problem in the #' presentation of statistical models. *Sociological Methodology* #' **33**, 1--18. #' #' Firth, D. and de Menezes, R. X. (2004) Quasi-variances. #' *Biometrika* **91**, 65--80. #' #' Menezes, R. X. de (1999) More useful standard errors for group and factor #' effects in generalized linear models. *D.Phil. Thesis*, #' Department of Statistics, University of Oxford. #' #' Ridout, M.S. (1989). Summarizing the results of fitting generalized #' linear models to data from designed experiments. In: *Statistical #' Modelling: Proceedings of GLIM89 and the 4th International #' Workshop on Statistical Modelling held in Trento, Italy, July 17--21, #' 1989* (A. Decarli et al., eds.), pp 262--269. New York: Springer. #' @author David Firth #' @seealso [qvcalc::worstErrors()], [qvcalc::plot.qv()]. #' @examples #' example(baseball) #' baseball.qv <- qvcalc(BTabilities(baseballModel2)) #' print(baseball.qv) #' plot(baseball.qv, xlab = "team", #' levelNames = c("Bal", "Bos", "Cle", "Det", "Mil", "NY", "Tor")) #' @method qvcalc BTabilities #' @importFrom qvcalc qvcalc.default #' @importFrom stats coef vcov #' @export qvcalc.BTabilities <- function(object, ...){ vc <- vcov(object) cf <- coef(object) factorname <- attr(object, "factorname") modelcall <- attr(object, "modelcall") qvcalc.default(vc, factorname = factorname, estimates = cf, modelcall = modelcall) } #' @importFrom qvcalc qvcalc #' @export qvcalc::qvcalc BradleyTerry2/R/chameleons.R0000744000176200001440000000707013436770253015425 0ustar liggesusers#' Male Cape Dwarf Chameleons: Measured Traits and Contest Outcomes #' #' Data as used in the study by Stuart-Fox et al. (2006). Physical #' measurements made on 35 male Cape dwarf chameleons, and the results of 106 #' inter-male contests. #' #' The published paper mentions 107 contests, but only 106 contests are #' included here. Contest number 16 was deleted from the data used to fit the #' models, because it involved a male whose predictor-variables were incomplete #' (and it was the only contest involving that lizard, so it is uninformative). #' #' @name chameleons #' @docType data #' @format A list containing three data frames: `chameleons$winner`, #' `chameleons$loser` and `chameleons$predictors`. #' #' The `chameleons$winner` and `chameleons$loser` data frames each #' have 106 observations (one per contest) on the following 4 variables: #' \describe{ #' \item{ID}{a factor with 35 levels `C01`, `C02`, #' ... , `C43`, the identity of the winning (or losing) male in each #' contest} #' \item{prev.wins.1}{integer (values 0 or 1), did the #' winner/loser of this contest win in an immediately previous contest?} #' \item{prev.wins.2}{integer (values 0, 1 or 2), how many of his #' (maximum) previous 2 contests did each male win?} #' \item{prev.wins.all}{integer, how many previous contests has each #' male won?} } #' #' The `chameleons$predictors` data frame has 35 observations, one for #' each male involved in the contests, on the following 7 variables: #' \describe{ #' \item{ch.res}{numeric, residuals of casque height regression on #' `SVL`, i.e. relative height of the bony part on the top of the #' chameleons' heads} #' \item{jl.res}{numeric, residuals of jaw length #' regression on `SVL`} #' \item{tl.res}{numeric, residuals of tail #' length regression on `SVL`} #' \item{mass.res}{numeric, residuals #' of body mass regression on `SVL` (body condition)} #' \item{SVL}{numeric, snout-vent length (body size)} #' \item{prop.main}{numeric, proportion (arcsin transformed) of area of #' the flank occupied by the main pink patch on the flank} #' \item{prop.patch}{numeric, proportion (arcsin transformed) of area #' of the flank occupied by the entire flank patch} } #' @author David Firth #' @source The data were obtained by Dr Devi Stuart-Fox, #' \url{https://devistuartfox.com/}, #' and they are reproduced here with her kind permission. #' #' These are the same data that were used in #' #' Stuart-Fox, D. M., Firth, D., Moussalli, A. and Whiting, M. J. (2006) #' Multiple signals in chameleon contests: designing and analysing animal #' contests as a tournament. *Animal Behaviour* **71**, 1263--1271. #' @keywords datasets #' @examples #' #' ## #' ## Reproduce Table 3 from page 1268 of the above paper: #' ## #' summary(chameleon.model <- BTm(player1 = winner, player2 = loser, #' formula = ~ prev.wins.2 + ch.res[ID] + prop.main[ID] + (1|ID), id = "ID", #' data = chameleons)) #' head(BTabilities(chameleon.model)) #' ## #' ## Note that, although a per-chameleon random effect is specified as in the #' ## above [the term "+ (1|ID)"], the estimated variance for that random #' ## effect turns out to be zero in this case. The "prior experience" #' ## effect ["+ prev.wins.2"] in this analysis has explained most of the #' ## variation, leaving little for the ID-specific predictors to do. #' ## Despite that, two of the ID-specific predictors do emerge as #' ## significant. #' ## #' ## Test whether any of the other ID-specific predictors has an effect: #' ## #' add1(chameleon.model, ~ . + jl.res[ID] + tl.res[ID] + mass.res[ID] + #' SVL[ID] + prop.patch[ID]) #' "chameleons" BradleyTerry2/R/print.summary.glmmPQL.R0000744000176200001440000000443713463540257017452 0ustar liggesusers#' @importFrom stats naprint printCoefmat symnum #' @export print.summary.BTglmmPQL <- function(x, digits = max(3, getOption("digits") - 3), symbolic.cor = x$symbolic.cor, signif.stars = getOption("show.signif.stars"), ...) { if (identical(x$sigma, 0)){ cat("PQL algorithm converged to fixed effects model\n") return(NextMethod("print.summary")) } cat("\nCall:\n", deparse(x$call), sep = "", fill = TRUE) p <- length(x$aliased) tidy.zeros <- function(vec) ifelse(abs(vec) < 100 * .Machine$double.eps, 0, vec) if (p == 0) { cat("\nNo Fixed Effects\n") } else { if (nsingular <- p - x$rank) { cat("\nFixed Effects: (", nsingular, " not defined because of singularities)\n", sep = "") cn <- names(x$aliased) pars <- matrix(NA, p, 4, dimnames = list(cn, colnames(x$fixef))) pars[!x$aliased, ] <- tidy.zeros(x$fixef) } else { cat("\nFixed Effects:\n") pars <- tidy.zeros(x$fixef) } printCoefmat(pars, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) } cat("\n(Dispersion parameter for ", x$family$family, " family taken to be 1)\n", sep = "") cat("\nRandom Effects:\n") pars <- tidy.zeros(x$ranef) printCoefmat(pars, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) if (nzchar(mess <- naprint(x$na.action))) cat("\n", mess, "\n", sep = "") cat("\nNumber of iterations: ", x$iter, "\n", sep = "") correl <- x$correlation if (!is.null(correl)) { if (x$rank > 1) { cat("\nCorrelation of Coefficients:\n") if (is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl, abbr.colnames = NULL)) } else { correl <- format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -x$rank, drop = FALSE], quote = FALSE) } } } cat("\n") invisible(x) } BradleyTerry2/R/citations.R0000744000176200001440000000310213157761361015274 0ustar liggesusers#' Statistics Journal Citation Data from Stigler (1994) #' #' Extracted from a larger table in Stigler (1994). Inter-journal citation #' counts for four journals, \dQuote{Biometrika}, \dQuote{Comm Statist.}, #' \dQuote{JASA} and \dQuote{JRSS-B}, as used on p448 of Agresti (2002). #' #' In the context of paired comparisons, the \sQuote{winner} is the cited #' journal and the \sQuote{loser} is the one doing the citing. #' #' @name citations #' @docType data #' @format A 4 by 4 contingency table of citations, cross-classified by the #' factors `cited` and `citing` each with levels `Biometrika`, #' `Comm Statist`, `JASA`, and `JRSS-B`. #' @seealso [BTm()] #' @references Firth, D. (2005) Bradley-Terry models in R. *Journal of #' Statistical Software* **12**(1), 1--12. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' #' Stigler, S. (1994) Citation patterns in the journals of statistics and #' probability. *Statistical Science* **9**, 94--108. #' @source Agresti, A. (2002) *Categorical Data Analysis* (2nd ed). New #' York: Wiley. #' @keywords datasets #' @examples #' #' ## Data as a square table, as in Agresti p448 #' citations #' #' ## #' ## Convert frequencies to success/failure data: #' ## #' citations.sf <- countsToBinomial(citations) #' names(citations.sf)[1:2] <- c("journal1", "journal2") #' #' ## Standard Bradley-Terry model fitted to these data #' citeModel <- BTm(cbind(win1, win2), journal1, journal2, #' data = citations.sf) #' "citations" BradleyTerry2/R/predict.BTm.R0000744000176200001440000002660413615321707015421 0ustar liggesusers#' Predict Method for Bradley-Terry Models #' #' Obtain predictions and optionally standard errors of those predictions from #' a fitted Bradley-Terry model. #' #' If `newdata` is omitted the predictions are based on the data used for #' the fit. In that case how cases with missing values in the original fit are #' treated is determined by the `na.action` argument of that fit. If #' `na.action = na.omit` omitted cases will not appear in the residuals, #' whereas if `na.action = na.exclude` they will appear (in predictions #' and standard errors), with residual value `NA`. See also #' `napredict`. #' #' @param object a fitted object of class `"BTm"` #' @param newdata (optional) a data frame in which to look for variables with #' which to predict. If omitted, the fitted linear predictors are used. #' @param level for models with random effects: an integer vector giving the #' level(s) at which predictions are required. Level zero corresponds to #' population-level predictions (fixed effects only), whilst level one #' corresponds to the player-level predictions (full model) which are NA for #' contests involving players not in the original data. By default, `level = 0` #' for a fixed effects model, `1` otherwise. #' @param type the type of prediction required. The default is on the scale of #' the linear predictors; the alternative `"response"` is on the scale of #' the response variable. Thus for a default Bradley-Terry model the default #' predictions are of log-odds (probabilities on logit scale) and #' `type = "response"` gives the predicted probabilities. The `"terms"` option #' returns a matrix giving the fitted values of each term in the model formula #' on the linear predictor scale (fixed effects only). #' @param se.fit logical switch indicating if standard errors are required. #' @param dispersion a value for the dispersion, not used for models with #' random effects. If omitted, that returned by `summary` applied to the #' object is used, where applicable. #' @param terms with `type ="terms"` by default all terms are returned. A #' character vector specifies which terms are to be returned. #' @param na.action function determining what should be done with missing #' values in `newdata`. The default is to predict `NA`. #' @param \dots further arguments passed to or from other methods. #' @return If `se.fit = FALSE`, a vector or matrix of predictions. If #' `se = TRUE`, a list with components \item{fit }{Predictions} #' \item{se.fit }{Estimated standard errors} #' @author Heather Turner #' @seealso [predict.glm()], [predict.glmmPQL()] #' @keywords models #' @examples #' #' ## The final model in example(flatlizards) #' result <- rep(1, nrow(flatlizards$contests)) #' Whiting.model3 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + SVL[..] + (1|..), #' family = binomial(link = "probit"), #' data = flatlizards, trace = TRUE) #' #' ## `new' data for contests between four of the original lizards #' ## factor levels must correspond to original levels, but unused levels #' ## can be dropped - levels must match rows of predictors #' newdata <- list(contests = data.frame( #' winner = factor(c("lizard048", "lizard060"), #' levels = c("lizard006", "lizard011", #' "lizard048", "lizard060")), #' loser = factor(c("lizard006", "lizard011"), #' levels = c("lizard006", "lizard011", #' "lizard048", "lizard060")) #' ), #' predictors = flatlizards$predictors[c(3, 6, 27, 33), ]) #' #' predict(Whiting.model3, level = 1, newdata = newdata) #' #' ## same as #' predict(Whiting.model3, level = 1)[1:2] #' #' ## introducing a new lizard #' newpred <- rbind(flatlizards$predictors[c(3, 6, 27), #' c("throat.PC1","throat.PC3", "SVL", "head.length")], #' c(-5, 1.5, 1, 0.1)) #' rownames(newpred)[4] <- "lizard059" #' #' newdata <- list(contests = data.frame( #' winner = factor(c("lizard048", "lizard059"), #' levels = c("lizard006", "lizard011", #' "lizard048", "lizard059")), #' loser = factor(c("lizard006", "lizard011"), #' levels = c("lizard006", "lizard011", #' "lizard048", "lizard059")) #' ), #' predictors = newpred) #' #' ## can only predict at population level for contest with new lizard #' predict(Whiting.model3, level = 0:1, se.fit = TRUE, newdata = newdata) #' #' ## predicting at specific levels of covariates #' #' ## consider a model from example(CEMS) #' table6.model <- BTm(outcome = cbind(win1.adj, win2.adj), #' player1 = school1, player2 = school2, #' formula = ~ .. + #' WOR[student] * Paris[..] + #' WOR[student] * Milano[..] + #' WOR[student] * Barcelona[..] + #' DEG[student] * St.Gallen[..] + #' STUD[student] * Paris[..] + #' STUD[student] * St.Gallen[..] + #' ENG[student] * St.Gallen[..] + #' FRA[student] * London[..] + #' FRA[student] * Paris[..] + #' SPA[student] * Barcelona[..] + #' ITA[student] * London[..] + #' ITA[student] * Milano[..] + #' SEX[student] * Milano[..], #' refcat = "Stockholm", #' data = CEMS) #' #' ## estimate abilities for a combination not seen in the original data #' #' ## same schools #' schools <- levels(CEMS$preferences$school1) #' ## new student data #' students <- data.frame(STUD = "other", ENG = "good", FRA = "good", #' SPA = "good", ITA = "good", WOR = "yes", DEG = "no", #' SEX = "female", stringsAsFactors = FALSE) #' ## set levels to be the same as original data #' for (i in seq_len(ncol(students))){ #' students[,i] <- factor(students[,i], levels(CEMS$students[,i])) #' } #' newdata <- list(preferences = #' data.frame(student = factor(500), # new id matching with `students[1,]` #' school1 = factor("London", levels = schools), #' school2 = factor("Paris", levels = schools)), #' students = students, #' schools = CEMS$schools) #' #' ## warning can be ignored as model specification was over-parameterized #' predict(table6.model, newdata = newdata) #' #' ## if treatment contrasts are use (i.e. one player is set as the reference #' ## category), then predicting the outcome of contests against the reference #' ## is equivalent to estimating abilities with specific covariate values #' #' ## add student with all values at reference levels #' students <- rbind(students, #' data.frame(STUD = "other", ENG = "good", FRA = "good", #' SPA = "good", ITA = "good", WOR = "no", DEG = "no", #' SEX = "female", stringsAsFactors = FALSE)) #' ## set levels to be the same as original data #' for (i in seq_len(ncol(students))){ #' students[,i] <- factor(students[,i], levels(CEMS$students[,i])) #' } #' newdata <- list(preferences = #' data.frame(student = factor(rep(c(500, 502), each = 6)), #' school1 = factor(schools, levels = schools), #' school2 = factor("Stockholm", levels = schools)), #' students = students, #' schools = CEMS$schools) #' #' predict(table6.model, newdata = newdata, se.fit = TRUE) #' #' ## the second set of predictions (elements 7-12) are equivalent to the output #' ## of BTabilities; the first set are adjust for `WOR` being equal to "yes" #' BTabilities(table6.model) #' #' @importFrom stats model.matrix na.pass reformulate #' @export predict.BTm <- function (object, newdata = NULL, level = ifelse(is.null(object$random), 0, 1), type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, ...) { type <- match.arg(type) if (!is.null(newdata)) { ## need to define X so will work with model terms setup <- match(c("player1", "player2", "formula", "id", "separate.ability", "refcat", "weights", "subset", "offset", "contrasts"), names(object$call), 0L) setup <- do.call(BTm.setup, c(as.list(object$call)[setup], list(data = newdata)), envir = environment(object$formula)) nfix <- length(object$coefficients) newdata <- data.frame(matrix(, nrow(setup$X), 0)) keep <- as.logical(match(colnames(setup$X), names(object$coefficients), nomatch = 0)) if (any(!keep)){ ## new players with missing data - set to NA missing <- rowSums(setup$X[,!keep, drop = FALSE]) != 0 setup$X <- setup$X[, keep, drop = FALSE] setup$X[missing,] <- NA } if (ncol(setup$X) != nfix) { ## newdata does not include original players with missing data X <- matrix(0, nrow(setup$X), nfix, dimnames = list(rownames(setup$X), names(object$coefficients))) X[, colnames(setup$X)] <- setup$X newdata$X <- X } else newdata$X <- setup$X nran <- length(attr(object$coefficients, "random")) if (1 %in% level && !is.null(object$random) && type != "terms"){ if (ncol(setup$random) != nran) { ## expand to give col for every random effect Z <- matrix(0, nrow(setup$random), nran, dimnames = list(rownames(setup$random), colnames(object$random))) #ranef need names!! ## set to NA for contests with new players ## (with predictors present) miss <- !colnames(setup$random) %in% colnames(Z) Z[, colnames(setup$random)[!miss]] <- setup$random[,!miss] if (any(miss)) { miss <- rowSums(setup$random[, miss, drop = FALSE] != 0) > 0 Z[miss,] <- NA } newrandom <- Z } else newrandom <- setup$random return(NextMethod(newrandom = newrandom)) } } if (type == "terms") { object$x <- model.matrix(object) attr(object$x, "assign") <- object$assign id <- unique(object$assign) terms <- paste("X", id, sep = "") object$terms <- terms(reformulate(c(0, terms))) splitX <- function(X) { newdata <- data.frame(matrix(, nrow(X), 0)) for (i in seq(id)) newdata[terms[i]] <- X[,object$assign == id[i]] newdata } if (is.null(newdata)) newdata <- splitX(object$x) else newdata <- splitX(newdata$X) tmp <- NextMethod(newdata = newdata) #tmp$fit[tmp$se.fit == 0] <- NA tmp$se.fit[tmp$se.fit == 0] <- NA colnames(tmp$fit) <- colnames(tmp$se.fit) <- c("(separate)"[0 %in% id], object$term.labels) return(tmp) } else NextMethod() } BradleyTerry2/R/model.matrix.BTm.R0000744000176200001440000000016313463535404016364 0ustar liggesusers#' @importFrom stats model.frame #' @export model.matrix.BTm <- function(object, ...){ model.frame(object)$X } BradleyTerry2/R/missToZero.R0000744000176200001440000000015413152515665015420 0ustar liggesusersmissToZero <- function(x, miss, dim = 1) { if (dim == 1) x[miss, ] <- 0 else x[, miss] <- 0 x } BradleyTerry2/R/residuals.BTm.R0000744000176200001440000000632713152515665015766 0ustar liggesusers#' Residuals from a Bradley-Terry Model #' #' Computes residuals from a model object of class `"BTm"`. In additional #' to the usual options for objects inheriting from class `"glm"`, a #' `"grouped"` option is implemented to compute player-specific residuals #' suitable for diagnostic checking of a predictor involving player-level #' covariates. #' #' For `type` other than `"grouped"` see [residuals.glm()]. #' #' For `type = "grouped"` the residuals returned are weighted means of #' working residuals, with weights equal to the binomial denominators in the #' fitted model. These are suitable for diagnostic model checking, for example #' plotting against candidate predictors. #' #' @param object a model object for which `inherits(model, "BTm")` is #' `TRUE`. #' @param type the type of residuals which should be returned. The #' alternatives are: `"deviance"` (default), `"pearson"`, #' `"working"`, `"response"`, and `"partial"`. #' @param by the grouping factor to use when `type = "grouped"`. #' @param ... arguments to pass on other methods. #' @return A numeric vector of length equal to the number of players, with a #' `"weights"` attribute. #' @author David Firth and Heather Turner #' @seealso [BTm()], [BTabilities()] #' @references Firth, D. (2005) Bradley-Terry models in R. *Journal of #' Statistical Software* **12**(1), 1--12. #' #' Turner, H. and Firth, D. (2012) Bradley-Terry models in R: The BradleyTerry2 #' package. *Journal of Statistical Software*, **48**(9), 1--21. #' @keywords models #' @examples #' #' ## #' ## See ?springall #' ## #' springall.model <- BTm(cbind(win.adj, loss.adj), #' col, row, #' ~ flav[..] + gel[..] + #' flav.2[..] + gel.2[..] + flav.gel[..] + (1 | ..), #' data = springall) #' res <- residuals(springall.model, type = "grouped") #' with(springall$predictors, plot(flav, res)) #' with(springall$predictors, plot(gel, res)) #' ## Weighted least-squares regression of these residuals on any variable #' ## already included in the model yields slope coefficient zero: #' lm(res ~ flav, weights = attr(res, "weights"), #' data = springall$predictors) #' lm(res ~ gel, weights = attr(res, "weights"), #' data = springall$predictors) #' #' @importFrom stats as.formula model.frame model.matrix terms #' @export residuals.BTm <- function(object, type = c("deviance", "pearson", "working", "response", "partial", "grouped"), by = object$id, ...) { type <- match.arg(type) if (type != "grouped") return(NextMethod()) ## for glm, lm would just be ## X <- model.matrix(formula, data = object$data) formula <- as.formula(paste("~", by, "- 1")) mt <- terms(formula) mf1 <- model.frame(mt, data = c(object$player1, object$data)) X1 <- model.matrix(mt, data = mf1) mf2 <- model.frame(mt, data = c(object$player2, object$data)) X2 <- model.matrix(mt, data = mf2) X <- X1 - X2 r <- object$residuals ## the "working" residuals w <- object$weights total.resid <- crossprod(X, r * w) total.weight <- crossprod(abs(X), w) result <- total.resid / total.weight attr(result, "weights") <- total.weight result } BradleyTerry2/R/predict.BTglmmPQL.R0000744000176200001440000002147113436770253016500 0ustar liggesusers#' Predict Method for BTglmmPQL Objects #' #' Obtain predictions and optionally standard errors of those predictions from #' a `"BTglmmPQL"` object. #' #' If `newdata` is omitted the predictions are based on the data used for #' the fit. In that case how cases with missing values in the original fit are #' treated is determined by the `na.action` argument of that fit. If #' `na.action = na.omit` omitted cases will not appear in the residuals, #' whereas if `na.action = na.exclude` they will appear (in predictions #' and standard errors), with residual value `NA`. See also #' `napredict`. #' #' Standard errors for the predictions are approximated assuming the variance #' of the random effects is known, see Booth and Hobert (1998). #' #' @param object a fitted object of class `"BTglmmPQL"` #' @param newdata (optional) a data frame in which to look for variables with #' which to predict. If omitted, the fitted linear predictors are used. #' @param newrandom if `newdata` is provided, a corresponding design #' matrix for the random effects, will columns corresponding to the random #' effects estimated in the original model. #' @param level an integer vector giving the level(s) at which predictions are #' required. Level zero corresponds to population-level predictions (fixed #' effects only), whilst level one corresponds to the individual-level #' predictions (full model) which are NA for contests involving individuals not #' in the original data. By default `level = 0` if the model converged to a #' fixed effects model, `1` otherwise. #' @param type the type of prediction required. The default is on the scale of #' the linear predictors; the alternative `"response"` is on the scale of #' the response variable. Thus for a default binomial model the default #' predictions are of log-odds (probabilities on logit scale) and `type = #' "response"` gives the predicted probabilities. The `"terms"` option #' returns a matrix giving the fitted values of each term in the model formula #' on the linear predictor scale (fixed effects only). #' @param se.fit logical switch indicating if standard errors are required. #' @param terms with `type ="terms"` by default all terms are returned. A #' character vector specifies which terms are to be returned. #' @param na.action function determining what should be done with missing #' values in `newdata`. The default is to predict `NA`. #' @param \dots further arguments passed to or from other methods. #' @return If `se.fit = FALSE`, a vector or matrix of predictions. If #' `se = TRUE`, a list with components \item{fit }{Predictions} #' \item{se.fit }{Estimated standard errors} #' @author Heather Turner #' @seealso [predict.glm()], [predict.BTm()] #' @references Booth, J. G. and Hobert, J. P. (1998). Standard errors of #' prediction in Generalized Linear Mixed Models. *Journal of the American #' Statistical Association* **93**(441), 262 -- 272. #' @keywords models #' @examples #' #' seedsModel <- glmmPQL(cbind(r, n - r) ~ seed + extract, #' random = diag(nrow(seeds)), #' family = binomial, #' data = seeds) #' #' pred <- predict(seedsModel, level = 0) #' predTerms <- predict(seedsModel, type = "terms") #' #' all.equal(pred, rowSums(predTerms) + attr(predTerms, "constant")) #' #' @importFrom stats .checkMFClasses coef delete.response family model.frame model.matrix na.exclude na.pass napredict #' @export predict.BTglmmPQL <- function(object, newdata = NULL, newrandom = NULL, level = ifelse(object$sigma == 0, 0, 1), type = c("link", "response", "terms"), se.fit = FALSE, terms = NULL, na.action = na.pass, ...) { ## only pass on if a glm if (object$sigma == 0) { if (level != 0) warning("Fixed effects model: setting level to 0") return(NextMethod()) } if (!all(level %in% c(0, 1))) stop("Only level %in% c(0, 1) allowed") type <- match.arg(type) if (!is.null(newdata) || type == "terms") tt <- terms(object) if (!is.null(newdata)) { ## newdata should give variables in terms formula Terms <- delete.response(tt) m <- model.frame(Terms, newdata, na.action = na.action, xlev = object$xlevels) na.action <- attr(m, "na.action") if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) D <- model.matrix(Terms, m, contrasts.arg = object$contrasts) np <- nrow(D) # n predictions offset <- rep(0, np) if (!is.null(off.num <- attr(tt, "offset"))) for (i in off.num) offset <- offset + eval(attr(tt, "variables")[[i + 1]], newdata) if (!is.null(object$call$offset)) offset <- offset + eval(object$call$offset, newdata) } else { D <- model.matrix(object) newrandom <- object$random na.action <- object$na.action offset <- object$offset } cf <- coef(object) keep <- !is.na(cf) aa <- attr(D, "assign")[keep] cf <- cf[keep] D <- D[, keep, drop = FALSE] if (se.fit == TRUE) { sigma <- object$sigma w <- sqrt(object$weights) wX <- w * model.matrix(object)[, keep] wZ <- w * object$random XWX <- crossprod(wX) XWZ <- crossprod(wX, wZ) ZWZ <- crossprod(wZ, wZ) diag(ZWZ) <- diag(ZWZ) + 1/sigma^2 K <- cbind(XWX, XWZ) K <- chol(rbind(K, cbind(t(XWZ), ZWZ))) if (type == "terms" || 0 %in% level){ ## work out (chol of inverse of) topleft of K-inv directly A <- backsolve(chol(ZWZ), t(XWZ), transpose = TRUE) A <- chol(XWX - t(A) %*% A) } } if (type == "terms") { # ignore level if (1 %in% level) warning("type = \"terms\": setting level to 0", call. = FALSE) ll <- attr(tt, "term.labels") if (!is.null(terms)) { include <- ll %in% terms ll <- ll[include] } hasintercept <- attr(tt, "intercept") > 0L if (hasintercept) { avx <- colMeans(model.matrix(object)) termsconst <- sum(avx * cf) #NA coefs? D <- sweep(D, 2, avx) } pred0 <- matrix(ncol = length(ll), nrow = NROW(D)) colnames(pred0) <- ll if (se.fit) { A <- chol2inv(A) se.pred0 <- pred0 } for (i in seq(length.out = length(ll))){ ind <- aa == which(attr(tt, "term.labels") == ll[i]) pred0[, i] <- D[, ind, drop = FALSE] %*% cf[ind] if (se.fit) { se.pred0[, i] <- sqrt(diag(D[, ind] %*% tcrossprod(A[ind, ind], D[, ind]))) } } if (hasintercept) attr(pred0, "constant") <- termsconst if (se.fit) return(list(fit = pred0, se.fit = se.pred0)) return(pred0) } if (0 %in% level) { pred0 <- napredict(na.action, c(D %*% cf) + offset) if (type == "response") pred0 <- family(object)$linkinv(pred0) if (se.fit == TRUE) { na.act <- attr(na.exclude(pred0), "na.action") H <- backsolve(A, t(na.exclude(D)), transpose = TRUE) ## se.pred0 <- ## sqrt(diag(D %*% chol2inv(K)[1:ncol(D), 1:ncol(D)] %*% t(D))) se.pred0 <- napredict(na.action, napredict(na.act, sqrt(colSums(H^2)))) if (type == "response") se.pred0 <- se.pred0*abs(family(object)$mu.eta(pred0)) pred0 <- list(fit = pred0, se.fit = se.pred0) } if (identical(level, 0)) return(pred0) } r <- nrow(D) ## newrandom should give new design matrix for original random effects if (!is.null(newdata)){ if(is.null(newrandom)) stop("newdata specified without newrandom") if (!is.null(na.action)) newrandom <- newrandom[-na.action, , drop = FALSE] } if (!identical(dim(newrandom), c(r, ncol(object$random)))) stop("newrandom should have ", r, " rows and ", ncol(object$random), " columns") D <- cbind(D, newrandom) cf <- c(cf, attr(coef(object), "random")) pred <- napredict(na.action, c(D %*% cf) + offset) if (type == "response") pred <- family(object)$linkinv(pred) if (se.fit == TRUE) { ##se.pred <- sqrt(diag(D %*% chol2inv(K) %*% t(D))) na.act <- attr(na.exclude(pred), "na.action") H <- backsolve(K, t(na.exclude(D)), transpose = TRUE) se.pred <- napredict(na.action, napredict(na.act, sqrt(colSums(H^2)))) if (type == "response") se.pred <- se.pred*abs(family(object)$mu.eta(pred)) pred <- list(fit = pred, se.fit = se.pred) } if (0 %in% level) list(population = pred0, individual = pred) else pred } BradleyTerry2/R/football.R0000744000176200001440000000431213152515665015104 0ustar liggesusers#' English Premier League Football Results 2008/9 to 2012/13 #' #' The win/lose/draw results for five seasons of the English Premier League #' football results, from 2008/9 to 2012/13 #' #' In each season, there are 20 teams, each of which plays one home game and #' one away game against all the other teams in the league. The results in 380 #' games per season. #' #' @name football #' @docType data #' @format A data frame with 1881 observations on the following 4 variables. #' \describe{ #' \item{season}{a factor with levels `2008-9`, #' `2009-10`, `2010-11`, `2011-12`, `2012-13`} #' \item{home}{a factor specifying the home team, with 29 levels #' `Ars` (Arsenal), ... , `Wol` (Wolverhampton)} #' \item{away}{a factor specifying the away team, with the same levels #' as `home`.} #' \item{result}{a numeric vector giving the result #' for the home team: 1 for a win, 0 for a draw, -1 for a loss.} } #' @seealso [GenDavidson()] #' @references Davidson, R. R. (1970). On extending the Bradley-Terry model to #' accommodate ties in paired comparison experiments. *Journal of the #' American Statistical Association*, **65**, 317--328. #' @source These data were downloaded from http://soccernet.espn.go.com in #' 2013. The site has since moved and the new site does not appear to have an #' equivalent source. #' @keywords datasets #' @examples #' #' ### example requires gnm #' if (require(gnm)) { #' ### convert to trinomial counts #' football.tri <- expandCategorical(football, "result", idvar = "match") #' head(football.tri) #' #' ### add variable to indicate whether team playing at home #' football.tri$at.home <- !logical(nrow(football.tri)) #' #' ### fit Davidson model for ties #' ### - subset to first and last season for illustration #' Davidson <- gnm(count ~ #' GenDavidson(result == 1, result == 0, result == -1, #' home:season, away:season, #' home.adv = ~1, tie.max = ~1, #' at.home1 = at.home, at.home2 = !at.home) - 1, #' eliminate = match, family = poisson, data = football.tri, #' subset = season %in% c("2008-9", "2012-13")) #' #' ### see ?GenDavidson for further analysis #' } #' "football" BradleyTerry2/R/print.BTm.R0000744000176200001440000000017613152515665015123 0ustar liggesusers#' @export print.BTm <- function (x, ...) { cat("Bradley Terry model fit by ") cat(x$method, "\n") NextMethod() } BradleyTerry2/R/add1.BTm.R0000744000176200001440000002200113615336163014565 0ustar liggesusers#' Add or Drop Single Terms to/from a Bradley Terry Model #' #' Add or drop single terms within the limit specified by the `scope` #' argument. For models with no random effects, compute an analysis of deviance #' table, otherwise compute the Wald statistic of the parameters that have been #' added to or dropped from the model. #' #' The hierarchy is respected when considering terms to be added or dropped: #' all main effects contained in a second-order interaction must remain, and so #' on. #' #' In a scope formula \samp{.} means \sQuote{what is already there}. #' #' For `drop1`, a missing `scope` is taken to mean that all terms in #' the model may be considered for dropping. #' #' If `scope` includes player covariates and there are players with #' missing values over these covariates, then a separate ability will be #' estimated for these players in *all* fitted models. Similarly if there #' are missing values in any contest-level variables in `scope`, the #' corresponding contests will be omitted from all models. #' #' If `formula` includes random effects, the same random effects structure #' will apply to all models. #' #' @aliases add1.BTm drop1.BTm #' @param object a fitted object of class inheriting from `"BTm"`. #' @param scope a formula specifying the model including all terms to be #' considered for adding or dropping. #' @param scale an estimate of the dispersion. Not implemented for models with #' random effects. #' @param test should a p-value be returned? The F test is only appropriate for #' models with no random effects for which the dispersion has been estimated. #' The Chisq test is a likelihood ratio test for models with no random effects, #' otherwise a Wald test. #' @param x a model matrix containing columns for all terms in the scope. #' Useful if `add1` is to be called repeatedly. **Warning:** no checks #' are done on its validity. #' @param \dots further arguments passed to [add1.glm()]. #' @return An object of class `"anova"` summarizing the differences in fit #' between the models. #' @author Heather Turner #' @seealso [BTm()], [anova.BTm()] #' @keywords models #' @examples #' #' result <- rep(1, nrow(flatlizards$contests)) #' BTmodel1 <- BTm(result, winner, loser, #' ~ throat.PC1[..] + throat.PC3[..] + (1|..), #' data = flatlizards, #' tol = 1e-4, sigma = 2, trace = TRUE) #' #' drop1(BTmodel1) #' #' add1(BTmodel1, ~ . + head.length[..] + SVL[..], test = "Chisq") #' #' BTmodel2 <- update(BTmodel1, formula = ~ . + head.length[..]) #' #' drop1(BTmodel2, test = "Chisq") #' #' @importFrom stats add.scope coef model.frame model.offset model.response model.weights formula pchisq pf reformulate terms update update.formula vcov #' @importFrom lme4 findbars nobars #' @export add1.BTm <- function(object, scope, scale = 0, test = c("none", "Chisq", "F"), x = NULL, ...) { old.form <- formula(object) new.form <- update.formula(old.form, scope) if (!is.character(scope)){ orandom <- findbars(old.form[[2]]) srandom <- findbars(new.form[[2]]) if (length(srandom) && !identical(orandom, srandom)) stop("Random effects structure of object and scope must be ", "identical.") scope <- add.scope(old.form, new.form) } if (!length(scope)) stop("no terms in scope for adding to object") if (is.null(x)) { # create model.matrix for maximum scope model <- Diff(object$player1, object$player2, new.form, object$id, object$data, object$separate.ability, object$refcat) if (sum(model$offset) > 0) warning("ignoring offset terms in scope") x <- model$X asgn <- attr(x, "assign") ## add dummy term for any separate effects oTerms <- c("sep"[0 %in% asgn], object$term.labels) object$terms <- terms(reformulate(oTerms)) y <- object$y dummy <- y ~ x - 1 if (!is.null(model$random)) { dummy <- update(dummy, .~ . + Z) Z <- model$random } argPos <- match(c("weights", "subset", "na.action"), names(object$call), 0) mf <- as.call(c(model.frame, as.list(object$call)[argPos], list(formula = dummy, offset = object$offset))) mf <- eval(mf, parent.frame()) x <- mf$x y <- model.response(mf) Z <- mf$Z wt <- model.weights(mf) if (is.null(wt)) wt <- rep.int(1, length(y)) offset <- model.offset(mf) } else { asgn <- attr(x, "assign") y <- object$y wt <- object$prior.weights offset <- object$offset Z <- object$random } if (is.null(object$random)){ attr(x, "assign") <- asgn + 1 object$formula <- formula(object$terms) object$x <- x object$y <- y object$random <- Z object$prior.weights <- wt object$offset <- offset stat.table <- NextMethod(x = x) attr(stat.table, "heading")[3] <- deparse(old.form) if (newsep <- sum(asgn == 0) - sum(object$assign ==0)) attr(stat.table, "heading") <- c(attr(stat.table, "heading"), paste("\n", newsep, " separate effects added\n", sep = "")) attr(stat.table, "separate.abilities") <- colnames(x)[asgn == 0] return(stat.table) } ## use original term labels: no sep effects or backticks (typically) oTerms <- attr(terms(nobars(old.form)), "term.labels") Terms <- attr(terms(nobars(new.form)), "term.labels") ousex <- asgn %in% c(0, which(Terms %in% oTerms)) sTerms <- vapply(strsplit(Terms, ":", fixed = TRUE), function(x) paste(sort(x), collapse = ":"), character(1)) method <- switch(object$method, glmmPQL.fit) control <- object$control control$trace <- FALSE if (scale == 0) dispersion <- 1 else dispersion <- scale ns <- length(scope) stat <- df <- numeric(ns) # don't add in original as don't need for tests names(stat) <- names(df) <- as.character(scope) tryerror <- FALSE for (i in seq(scope)) { stt <- paste(sort(strsplit(scope[i], ":")[[1]]), collapse = ":") usex <- match(asgn, match(stt, sTerms), 0) > 0 | ousex fit <- method(X = x[, usex, drop = FALSE], y = y, Z = Z, weights = wt, offset = offset, family = object$family, control = control, sigma = object$call$sigma, sigma.fixed = object$sigma.fixed) class(fit) <- oldClass(object) ind <- (usex & !ousex)[usex] trystat <- try(t(coef(fit)[ind]) %*% chol2inv(chol(vcov(fit, dispersion = dispersion)[ind, ind])) %*% coef(fit)[ind], silent = TRUE) #vcov should handle disp != 1 if (inherits(trystat, "try-error")) { stat[i] <- df[i] <- NA tryerror <- TRUE } else { stat[i] <- trystat df[i] <- sum(ind) } } table <- data.frame(stat, df) dimnames(table) <- list(names(df), c("Statistic", "Df")) title <- "Single term additions\n" topnote <- paste("Model: ", deparse(as.vector(formula(object))), if (scale > 0) paste("\nscale: ", format(scale), "\n"), if (tryerror) "\n\nTest statistic unestimable for at least one term") test <- match.arg(test) if (test == "Chisq") { dfs <- table[, "Df"] vals <- table[, "Statistic"] vals[dfs %in% 0] <- NA table <- cbind(table, `P(>|Chi|)` = pchisq(vals, abs(dfs), lower.tail = FALSE)) } else if (test == "F") { ## Assume dispersion fixed at one - if dispersion estimated, would use ## "residual" df from larger model in each comparison df.dispersion <- Inf if (df.dispersion == Inf) { fam <- object[[1]]$family$family if (fam == "binomial" || fam == "poisson") warning(gettextf( "using F test with a '%s' family is inappropriate", fam), domain = NA, call. = FALSE) else { warning("using F test with a fixed dispersion is inappropriate") } } dfs <- table[, "Df"] Fvalue <- table[, "Statistic"]/abs(dfs) Fvalue[dfs %in% 0] <- NA table <- cbind(table, F = Fvalue, `Pr(>F)` = pf(Fvalue, abs(dfs), df.dispersion, lower.tail = FALSE)) } if (newsep <- sum(asgn == 0) - sum(object$assign ==0)) heading <- c(heading, paste("\n", newsep, " separate effects added\n", sep = "")) structure(table, heading = c(title, topnote), class = c("anova", "data.frame"), separate.abilities = colnames(x)[asgn == 0]) } BradleyTerry2/R/anova.BTm.R0000744000176200001440000002151313463536211015064 0ustar liggesusers#' Compare Nested Bradley Terry Models #' #' Compare nested models inheriting from class `"BTm"`. For models with no #' random effects, compute analysis of deviance table, otherwise compute Wald #' tests of additional terms. #' #' For models with no random effects, an analysis of deviance table is computed #' using [anova.glm()]. Otherwise, Wald tests are computed as #' detailed here. #' #' If a single object is specified, terms are added sequentially and a Wald #' statistic is computed for the extra parameters. If the full model includes #' player covariates and there are players with missing values over these #' covariates, then the `NULL` model will include a separate ability for #' these players. If there are missing values in any contest-level variables in #' the full model, the corresponding contests will be omitted throughout. The #' random effects structure of the full model is assumed for all sub-models. #' #' For a list of objects, consecutive pairs of models are compared by computing #' a Wald statistic for the extra parameters in the larger of the two models. #' #' The Wald statistic is always based on the variance-covariance matrix of the #' larger of the two models being compared. #' #' @param object a fitted object of class inheriting from `"BTm"`. #' @param ... additional `"BTm"` objects. #' @param dispersion a value for the dispersion. Not implemented for models #' with random effects. #' @param test optional character string (partially) matching one of #' `"Chisq"`, `"F"` or `"Cp"` to specify that p-values should be #' returned. The Chisq test is a likelihood ratio test for models with no #' random effects, otherwise a Wald test. Options `"F"` and `"Cp"` #' are only applicable to models with no random effects, see #' [stat.anova()]. #' @return An object of class `"anova"` inheriting from class #' `"data.frame"`. #' @section Warning: The comparison between two or more models will only be #' valid if they are fitted to the same dataset. This may be a problem if there #' are missing values and 's default of `na.action = na.omit` is used. An #' error will be returned in this case. #' #' The same problem will occur when separate abilities have been estimated for #' different subsets of players in the models being compared. However no #' warning is given in this case. #' @author Heather Turner #' @seealso [BTm()], [add1.BTm()] #' @keywords models #' @examples #' #' result <- rep(1, nrow(flatlizards$contests)) #' BTmodel <- BTm(result, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + #' head.length[..] + (1|..), data = flatlizards, #' trace = TRUE) #' anova(BTmodel) #' #' @export anova.BTm <- function (object, ..., dispersion = NULL, test = NULL) { ## Only list models in ... dotargs <- list(...) named <- if (is.null(names(dotargs))) rep(FALSE, length(dotargs)) else (names(dotargs) != "") if (any(named)) warning("the following arguments to 'anova.BTm' are invalid and ", "dropped: ", paste(deparse(dotargs[named]), collapse = ", ")) dotargs <- dotargs[!named] is.BTm <- unlist(lapply(dotargs, function(x) inherits(x, "BTm"))) dotargs <- dotargs[is.BTm] ## Compare list of models models <- c(list(object), dotargs) if (length(dotargs) > 0){ fixed <- unlist(lapply(models, function(x) is.null(x$random))) if (all(fixed)) { variables <- lapply(models, function(x) paste(deparse(formula(x)), collapse = "\n")) models <- lapply(models, function(x) { x$formula <- formula(x$terms) class(x) <- setdiff(class(x), "BTm") x}) call <- match.call() anova.table <- do.call("anova", c(models, dispersion = call$dispersion, test = call$test)) attr(anova.table, "heading") <- c(paste("Analysis of Deviance Table\n\n", "Response: ", deparse(object$call$outcome, 500), "\n", sep = ""), paste("Model ", format(seq(models)), ": ", variables, sep = "", collapse = "\n")) return(anova.table) } else return(anova.BTmlist(c(list(object), dotargs), dispersion = dispersion, test = test)) } X <- model.matrix(object) Z <- object$random sep <- 0 %in% object$assign ## Passing on to glm when no random effects if (is.null(Z)) { object$x <- X attr(object$x, "assign") <- object$assign + sep attr(object$terms, "term.labels") <- c("[sep]"[sep], object$term.labels) anova.table <- NextMethod() attr(anova.table, "heading") <- paste("Analysis of Deviance Table", "\n\nModel: ", object$family$family, ", link: ", object$family$link, "\n\nResponse: ", deparse(object$call$outcome, 500), "\n\nTerms added sequentially (first to last)\n\n", sep = "") if (sep) { anova.table <- anova.table[-1,] rownames(anova.table)[1] <- "NULL" anova.table[1, 1:2] <- NA } return(anova.table) } varseq <- object$assign nvars <- max(0, varseq) stat <- df <- numeric(nvars) tryerror <- FALSE if (nvars > 1) { y <- object$y ## Extension to further methods method <- object$method if (!is.function(method)) method <- get(method, mode = "function") control <- object$control control$trace <- FALSE for (i in 1:(nvars - 1)) { fit <- method(X = X[, varseq <= i, drop = FALSE], y = y, Z = Z, weights = object$prior.weights, start = object$start, offset = object$offset, family = object$family, control = control, sigma = object$call$sigma, sigma.fixed = object$sigma.fixed) class(fit) <- oldClass(object) ind <- (varseq == i)[varseq <= i] trystat <- try(t(coef(fit)[ind]) %*% chol2inv(chol(suppressMessages( #vcov should deal with dispersion != 1 vcov(fit, dispersion = dispersion))[ind, ind])) %*% coef(fit)[ind], silent = TRUE) if (inherits(trystat, "try-error")) { stat[i] <- df[i] <- NA tryerror <- TRUE } else { stat[i] <- trystat df[i] <- sum(ind) } } } ind <- varseq == nvars trystat <- try(t(coef(object)[ind]) %*% chol2inv(chol(object$varFix[ind, ind])) %*% coef(object)[ind], silent = TRUE) if (inherits(trystat, "try-error")) { stat[nvars] <- df[nvars] <- NA tryerror <- TRUE } else { stat[nvars] <- trystat df[nvars] <- sum(ind) } table <- data.frame(c(NA, stat), c(NA, df)) dimnames(table) <- list(c("NULL", object$term.labels), c("Statistic", "Df")) title <- paste("Sequential Wald Tests", "\n\nModel: ", object$family$family, ", link: ", object$family$link, "\n\nResponse: ", deparse(object$call$outcome, 500), "\n\nPredictor: ", paste(formula(object), collapse = ""), "\n\nTerms added sequentially (first to last)", if (tryerror) "\n\nTest statistic unestimable for at least one term", "\n", sep = "") ## Assume dispersion fixed at one - if dispersion estimated, would use ## "residual" df from larger model in each comparison df.dispersion <- Inf if (!is.null(test)) { if (test == "F" && df.dispersion == Inf) { fam <- object$family$family if (fam == "binomial" || fam == "poisson") warning(gettextf("using F test with a %s family is ", "inappropriate", fam), domain = NA) else { warning("using F test with a fixed dispersion is inappropriate") } } table <- switch(test, Chisq = { dfs <- table[, "Df"] vals <- table[, "Statistic"] vals[dfs %in% 0] <- NA cbind(table, `P(>|Chi|)` = pchisq(vals, dfs, lower.tail = FALSE)) }, F = { dfs <- table[, "Df"] Fvalue <- table[, "Statistic"]/dfs Fvalue[dfs %in% 0] <- NA cbind(table, F = Fvalue, `Pr(>F)` = pf(Fvalue, dfs, df.dispersion, lower.tail = FALSE)) }) } structure(table, heading = title, class = c("anova", "data.frame")) } BradleyTerry2/NEWS.md0000744000176200001440000001161113615335373014054 0ustar liggesusersChanges in BradleyTerry2 1.1-1 ============================== * improve the way `BTm` finds variables passed to `outcome`, `player1` etc, so that it works when run in a separate environment. * convert old tests to unit tests. Changes in BradleyTerry2 1.1-0 ============================== * `anova.BTm` now respects `test` and `dispersion` arguments for models that inherit from `glm`. * fix bug in `anova.BTmlist` affecting models where ability is modelled by predictors but ability is estimated separately for some players due to missing values. * fix bug in `glmmPQL` affecting models with `.` in formula and either offset or weights specified. * standardize tests to use random number generation as in R 2.10 for backwards compatibility. Changes in BradleyTerry2 1.0-9 ============================== * fix bug in setting contrasts in internal function `Diff()` that gave warning under R-devel. * update urls (using https where possible). * fix a couple of `if` statements where argument could be > 1. Changes in BradleyTerry2 1.0-8 ============================== * fix bug in `qvcalc.BTabilities` Changes in BradleyTerry2 1.0-7 ============================== Improvements ------------ * new examples of prediction added, including using `predict.BTm` to estimate abilities with non-player abilities set to non-zero values (for models with a fixed reference category). * `qvcalc.BTabilities` moved over from package **qvcalc**. * package imports rather than depends on **lme4**. Changes in behaviour -------------------- * default `level` in `predict.BTm` and `predict.glmmPQL` is 0 if a fixed effects model has been fitted, 1 otherwise. Bug fixes --------- * BTabilities now works (again) for models where the reference category is not the first player. Players are kept in their original order (levels of `player1` and `player2`), but the abilities are returned with the appropriate reference. * BTabilities now works when ability is modelled by covariates and some parameters are inestimable (e.g. as in `chameleons.model` on `?chameleons`). * `predict.BTglmmPQL` now works for models with inestimable parameters Changes in BradleyTerry2 1.0-6 ============================== Changes in behaviour -------------------- * `BTabilities` now returns `NA` for unidentified abilities Bug fixes --------- * BTabilities now respects contrasts argument and contrasts attributes of `player1` and `player2` factors. Also handle unidentified coefficients correctly. Changes in BradleyTerry2 1.0-5 ============================== Bug fixes --------- * no longer imports from **gnm**, so **gnm** need not be installed. Changes in BradleyTerry2 1.0-4 ============================== Bug fixes --------- * depends on **lme4** (>=1.0). Changes in BradleyTerry2 1.0-3 ============================== New Features ------------ * updated football data to include full 2011-12 season. Changes in BradleyTerry2 1.0-2 ============================== New Features ------------ * added football example presented at useR! 2013 with generalised Davidson model for ties. Changes in BradleyTerry2 1.0-1 ============================== Bug fixes --------- * renamed `glmmPQL` object `BTglmmPQL` to avoid conflict with **lme4** (which loads **MASS**). * fixed `BTm` so that it is able to find variables when called inside another function (stackoverflow.com question 14911525). Changes in BradleyTerry2 1.0-0 ============================== * updated references and CITATION to cite JSS paper on BradleyTerry2 Changes in BradleyTerry2 0.9-7 ============================== Bug fixes --------- * fixed `anova.BTmlist` to work for models with random effects * allow models to be specified with no fixed effects Improvements ------------ * updated vignette, including example of bias-reduction, a new example incorporating random effects and a new example on preparing data for use with package Changes in BradleyTerry2 0.9-6 ============================== Bug fixes --------- * fixed `offset` argument to work as documented * corrected documentation for `citations` data Improvements ------------ * updated vignette, to provide more explanation of setting up the data Changes in BradleyTerry2 0.9-5 ============================== * updated contact details Changes in BradleyTerry2 0.9-4 ============================== New Features ------------ * added ice hockey example presented at useR! 2010 Bug fixes --------- * `predict.BTm` now works for models with no random effects and handles new individuals with missing values in predictors. Changes in BradleyTerry2 0.9-3 ============================= New Features ------------ * added predict method for BTm objects. Bug fixes --------- * fixed bug in `BTm.setup` causing problems in finding variables when `BTm` nested within another function. BradleyTerry2/MD50000644000176200001440000001307113616022414013255 0ustar liggesusersd8a96b6bd70c4b6603a536f603830d83 *DESCRIPTION b4a60f3ba1f9224eddfa1ddec28cf5eb *NAMESPACE 1fafa26f6c7ff50bcecf78b6ce880a98 *NEWS.md 08172d78e5c312907f6618a33bfdce6b *R/BTabilities.R 107896cd786f75acde51cdf613c7940a *R/BTm.R 964b111982941af22b4f7d229764a4d7 *R/BTm.setup.R 2d4943321a42fc96c20125c78f43ffc3 *R/CEMS.R 27e525264e7368f50cf3d0b150ad4136 *R/Diff.R 070b197dc1b4c515ee22b614d15b98f7 *R/GenDavidson.R 02c0e53cac09c2faaa218c44faaf808f *R/add1.BTm.R e704869faf47311257e4e190ab534c27 *R/anova.BTm.R eb276481eb9605e5dd94d9b2a79fd0e5 *R/anova.BTmlist.R ff3dc98281b3017bf721a018da9a90ce *R/baseball.R a9a4924b10faa5b2d70882d026ffc52d *R/chameleons.R 030b0ae34e782887c2fdaa60678af4d4 *R/citations.R a8c757bfd838de9a258d1cff69d2c8da *R/countsToBinomial.R cb77a329168157872f1083cb8fe7bef1 *R/drop1.BTm.R ee690eee7afe4a1f6cb69c73f26ef63a *R/flatlizards.R 7a5e66bf9864169a9b4f30eb4740c55c *R/football.R 4a6ead5401d25a3e6a2dfdf0536748e1 *R/formula.BTm.R 10d3a2f3229a4574cd7ae097df63acb1 *R/glmmPQL.R 3fa9494ca70fc2767ec48e34d9c5be11 *R/glmmPQL.control.R 9be3697e0db9dc0b7d4fbf1590fe4e45 *R/glmmPQL.fit.R cb08555cdad1523dec73d1ae2aa017f8 *R/icehockey.R ad1d3edac7e8613101ee16ad0493d223 *R/missToZero.R f2ffb551a8d3250eb7e83bd94ad9a0d1 *R/model.matrix.BTm.R af3b0525d78eddd70e5cfdca89b5365f *R/plotProportions.R 11964e277d0442dfde1ffd9a563f79f3 *R/predict.BTglmmPQL.R 3a3afe61c6cda3fcbe1a782f33bb6f80 *R/predict.BTm.R 93e6029dccb86b3bebee46f628cf9d58 *R/print.BTglmmPQL.R 1b35359cd5a9cee5c8850a00793c5cf2 *R/print.BTm.R 89eacfd76292016f6cc3d1e678d7d9e5 *R/print.summary.glmmPQL.R 41fe89d148219a01411d22bf711d0751 *R/qvcalc.BTabilities.R 9f32c8a38dcb0c958ee1c6c3f66c2b37 *R/residuals.BTm.R 55edfaa680490009b1582200d3656842 *R/seeds.R 6e7c170e459be043d324e46c58c58e12 *R/sound.fields.R 7c33db37fe53efdd1c6906c57c23d7d3 *R/springall.R 02998d4e723e28bbe9a2fe84500cec03 *R/summary.BTglmmPQL.R 694c54f87587c2d001e7aac9f76bc069 *R/vcov.BTglmmPQL.R 660a6ed454a0a5e3441558b151625c9c *README.md 07b8caee82c69814ca6c1ffa9a3b8789 *build/vignette.rds 588c6fa8bb54a988a399be745d2ca867 *data/CEMS.rda ee0852f01caba3acc47ed1a8267062e8 *data/baseball.RData e87bdac9e2cddce1c209892f543c4e36 *data/chameleons.rda 6349e92692dd41dbe5f43e3899c30038 *data/citations.rda a8402c784331c5e6a14ded61b6d615e3 *data/flatlizards.rda 8aba0268f583bf5e16c86f094e7747e4 *data/football.RData 933b7ff2dbeca08ddb1d8f0e7d570585 *data/icehockey.rda d309c54e533b90a3f7eef628e04ebbda *data/seeds.rda 255c196fce509ef9e5c2e19209837c9d *data/sound.fields.rda a82bf4e699e97d5fb34b898c77e4c30e *data/springall.rda 83abbe10a6728ff6a12ae3c1ef1055a7 *inst/CITATION e56f9affb8b951a02e7babf573beb1f6 *inst/WORDLIST b63448ce61ee61668d947c716ba757ca *inst/doc/BradleyTerry.R 065021176a325aa27e9491e68538c913 *inst/doc/BradleyTerry.Rnw 52cb6a734b86f4cdf47c6cd9b5bb52c7 *inst/doc/BradleyTerry.pdf 87ea788b9784b38e7103b167a4195b30 *man/BTabilities.Rd 9aeb1bfa3de2d35b0daa8f0c8fbbf527 *man/BTm.Rd 45f0bf1e2e9d82cd543129de31850930 *man/CEMS.Rd 8c00f3eddac308814830aa66fc669abd *man/GenDavidson.Rd 450525be8b6f142ae7455e4e4a1cd1bd *man/add1.BTm.Rd 5af0710a5615975e8c2b73b1583fb32c *man/anova.BTm.Rd 766e20f3c4c6ddbacefad7a3f4a91c39 *man/baseball.Rd 9c8d1d5195f52e59a468b823b520e5e9 *man/chameleons.Rd 48ac533057e7ba618a2a6b3044c86c05 *man/citations.Rd b605365c6595a030d90ca10684c073a9 *man/countsToBinomial.Rd 0a62e3912be573d67ec4f7add6587a8d *man/flatlizards.Rd 52043fc0c44693b6cbf58301cd516cf2 *man/football.Rd 73f86de43d43c70621a053530568c114 *man/glmmPQL.Rd 874fca5df890a4b3cb532cabf41007a0 *man/glmmPQL.control.Rd c3699a5411bcc9f7ff7754330c60ed92 *man/icehockey.Rd 2b61796e183a1c7ff5e7cd212ee597a3 *man/plotProportions.Rd a047b0eb282a27884c2eaff1eb8cd8f9 *man/predict.BTglmmPQL.Rd 8797e6b328007c98b5c4438469259392 *man/predict.BTm.Rd 3c1c2f24cf58cbc923d4a992917a4e9e *man/qvcalc.BTabilities.Rd be513ac5a3744266c73c7d5df116bf24 *man/reexports.Rd f5114d52b31ea2b9b384e51545fc4764 *man/residuals.BTm.Rd 7a3869e0fd4b4dfadb2abb167c8e758e *man/seeds.Rd a622a98e1c9dbc1259a7c7f2d82cddc1 *man/sound.fields.Rd 45608b05f3c1a9e7cbde661e92b70187 *man/springall.Rd 73e9893b10fbc3398cde605aa8b72700 *tests/old-tests/old-tests.R 9d36a66f3b206c50b0f8a2c1e3b8c7af *tests/testthat.R 90adc2a0be1f680c9b7980b6f25b946c *tests/testthat/outputs/add1.rds 231dcb947ba04dc567bc413eaea85acb *tests/testthat/outputs/drop1.rds 7734cfbb7e08cb5c7eeec4a21364ce95 *tests/testthat/outputs/flatlizards-BTmodel.rds 113d09ced58b8d3ca20df33a7ce6961e *tests/testthat/outputs/flatlizards-abilities.rds 74ee6523760d9d36889a0c3547ab0e86 *tests/testthat/outputs/flatlizards-pred0-new.rds 8ebe8e3e0f7a0c6b35311281e8f3a337 *tests/testthat/outputs/flatlizards-pred0-rainy.rds 0d52877d133a04f4343d179821c3b4b3 *tests/testthat/outputs/flatlizards-pred1-rainy.rds d62e73c0193ba36d3ce2a2acc8848ccb *tests/testthat/outputs/flatlizards-residuals.rds b01943e351cb7283ef994ecc9abfdd31 *tests/testthat/outputs/nested.rds d1ebf343c4e9c18e129047121f2b9827 *tests/testthat/test-BTabilities.R 74339bbeb85313d50d585541f1c53de6 *tests/testthat/test-add1-drop1.R 872dc7aa91d4ba22ac400b0f4db69d59 *tests/testthat/test-baseball.R e4d286a3a67060f9fcd78e362e27d512 *tests/testthat/test-countsToBinomial.R 1920c8c83b5a4a6b9724e40d8c8b5e14 *tests/testthat/test-flatlizards.R c72cb1fc790bf458ccc50875f27e4f17 *tests/testthat/test-nested.R c7ef183aea7fa1c9b9183a6a3d7dacdb *tests/testthat/test-predict.R 11bb8382b588024cf2a7d914f423bf2a *vignettes/BradleyTerry-concordance.tex 065021176a325aa27e9491e68538c913 *vignettes/BradleyTerry.Rnw df33930c7d7ef359d3a320cc0f44c132 *vignettes/BradleyTerry.bib 7abfe1eb2816210b8d43fcc351468f07 *vignettes/baseball-qvplot.pdf 44843a3e7711c360bc0ad21c743b7674 *vignettes/residuals.pdf BradleyTerry2/inst/0000755000176200001440000000000013615557421013732 5ustar liggesusersBradleyTerry2/inst/doc/0000755000176200001440000000000013615557421014477 5ustar liggesusersBradleyTerry2/inst/doc/BradleyTerry.Rnw0000744000176200001440000013105413441760376017606 0ustar liggesusers% \VignetteIndexEntry{Bradley-Terry models in R} % \VignetteKeyword{generalized linear model} % \VignetteKeyword{logistic regression} % \VignetteKeyword{penalized quasi-likelihood} % \VignetteKeyword{ranking} % \VignetteKeyword{tournament analysis} % \VignetteKeyword{working residuals} % \VignettePackage{BradleyTerry2} %%% For jss: %% \documentclass{jss} %% \newcommand{\pkginfo}{} %%% uncomment for vignette version \documentclass[nojss]{jss} \newcommand{\pkginfo}{\small \\[12pt]For \pkg{BradleyTerry2} version \Sexpr{packageDescription("BradleyTerry2")[["Version"]]}, \Sexpr{Sys.Date()}\\\url{https://github.com/hturner/BradleyTerry2}\\[-12pt]} %% need no \usepackage{Sweave.sty} \usepackage[english]{babel} % to avoid et~al with texi2pdf \usepackage{amsmath} \usepackage{booktabs} \usepackage{thumbpdf} \setkeys{Gin}{width=0.6\textwidth} \SweaveOpts{keep.source=TRUE} %http://www.stat.auckland.ac.nz/~ihaka/downloads/Sweave-customisation.pdf \newcommand{\R}{\proglang{R}} \newcommand{\BT}{\pkg{BradleyTerry2}} \newcommand{\logit}{\mathop{\rm logit}} \newcommand{\pr}{\mathop{\rm pr}} \author{Heather Turner\\University of Warwick \And David Firth\\University of Warwick} \Plainauthor{Heather Turner, David Firth} \title{Bradley-Terry Models in \proglang{R}: The \BT\ Package \pkginfo} \Plaintitle{Bradley-Terry Models in R: The BradleyTerry2 Package} \Shorttitle{\pkg{BradleyTerry2}: Bradley-Terry Models in \proglang{R}} \Abstract{ This is a short overview of the \R\ add-on package \BT, which facilitates the specification and fitting of Bradley-Terry logit, probit or cauchit models to pair-comparison data. Included are the standard `unstructured' Bradley-Terry model, structured versions in which the parameters are related through a linear predictor to explanatory variables, and the possibility of an order or `home advantage' effect or other `contest-specific' effects. Model fitting is either by maximum likelihood, by penalized quasi-likelihood (for models which involve a random effect), or by bias-reduced maximum likelihood in which the first-order asymptotic bias of parameter estimates is eliminated. Also provided are a simple and efficient approach to handling missing covariate data, and suitably-defined residuals for diagnostic checking of the linear predictor. } \Keywords{generalized linear model, logistic regression, penalized quasi-likelihood, ranking, tournament analysis, working residuals} \Address{ David Firth\\ Department of Statistics\\ University of Warwick\\ Coventry\\ CV4 7AL, United Kingdom\\ E-mail: \email{d.firth@warwick.ac.uk}\\ URL: \url{http://go.warwick.ac.uk/dfirth} } \begin{document} @ <>= options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE, digits = 7) @ %def \section{Introduction} The Bradley-Terry model \citep{brad:terr:52} assumes that in a `contest' between any two `players', say player $i$ and player $j$ $(i, j \in \{1,\ldots,K\})$, the odds that $i$ beats $j$ are $\alpha_i/\alpha_j$, where $\alpha_i$ and $\alpha_j$ are positive-valued parameters which might be thought of as representing `ability'. A general introduction can be found in \citet{brad:84} or \citet{agre:02}. Applications are many, ranging from experimental psychology to the analysis of sports tournaments to genetics (for example, the allelic transmission/disequilibrium test of \citealp{sham:curt:95} is based on a Bradley-Terry model in which the `players' are alleles). In typical psychometric applications the `contests' are comparisons, made by different human subjects, between pairs of items. The model can alternatively be expressed in the logit-linear form \begin{equation} \logit[\pr(i\ \mathrm{beats}\ j)]=\lambda_i-\lambda_j, \label{eq:unstructured} \end{equation} where $\lambda_i=\log\alpha_i$ for all $i$. Thus, assuming independence of all contests, the parameters $\{\lambda_i\}$ can be estimated by maximum likelihood using standard software for generalized linear models, with a suitably specified model matrix. The primary purpose of the \BT\ package \citep{turn:12}, implemented in the \R\ statistical computing environment \citep{ihak:gent:96, R}, is to facilitate the specification and fitting of such models and some extensions. The \BT\ package supersedes the earlier \pkg{BradleyTerry} package \citep{firt:05}, providing a more flexible user interface to allow a wider range of models to be fitted. In particular, \BT\ allows the inclusion of simple random effects so that the ability parameters can be related to available explanatory variables through a linear predictor of the form \begin{equation} \lambda_i=\sum_{r=1}^p\beta_rx_{ir} + U_i. \end{equation} The inclusion of the prediction error $U_i$ allows for variability between players with equal covariate values and induces correlation between comparisons with a common player. \BT\ also allows for general contest-specific effects to be included in the model and allows the logit link to be replaced, if required, by a different symmetric link function (probit or cauchit). The remainder of the paper is organised as follows. Section~\ref{sec:BTmodel} demonstrates how to use the \pkg{BradleyTerry2} package to fit a standard (i.e., unstructured) Bradley-Terry model, with a separate ability parameter estimated for each player, including the use of bias-reduced estimation for such models. Section~\ref{sec:covariates} considers variations of the standard model, including the use of player-specific variables to model ability and allowing for contest-specific effects such as an order effect or judge effects. Sections~\ref{sec:ability} and \ref{sec:residuals} explain how to obtain important information about a fitted model, in particular the estimates of ability and their standard errors, and player-level residuals, whilst Section~\ref{sec:model} notes the functions available to aid model search. Section~\ref{sec:data} explains in more detail how set up data for use with the \BT\ package, Section~\ref{sec:functions} lists the functions provided by the package and finally Section~\ref{sec:finalremarks} comments on two directions for further development of the software. \section{Standard Bradley-Terry model} \label{sec:BTmodel} \subsection{Example: Analysis of journal citations} \label{citations} The following data come from page 448 of \citet{agre:02}, extracted from the larger table of \citet{stig:94}. The data are counts of citations among four prominent journals of statistics and are included the \BT\ package as the data set \code{citations}: @ <>= library("BradleyTerry2") @ @ <>= data("citations", package = "BradleyTerry2") @ @ <>= citations @ %def Thus, for example, \emph{Biometrika} was cited 498 times by papers in \emph{Journal of the American Statistical Association} (JASA) during the period under study. In order to fit a Bradley-Terry model to these data using \code{BTm} from the \BT\ package, the data must first be converted to binomial frequencies. That is, the data need to be organised into pairs (\code{player1}, \code{player2}) and corresponding frequencies of wins and losses for \code{player1} against \code{player2}. The \BT\ package provides the utility function \code{countsToBinomial} to convert a contingency table of wins to the format just described: @ <>= citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") citations.sf @ %def Note that the self-citation counts are ignored -- these provide no information on the ability parameters, since the abilities are relative rather than absolute quantities. The binomial response can then be modelled by the difference in player abilities as follows: @ <>= citeModel <- BTm(cbind(win1, win2), journal1, journal2, ~ journal, id = "journal", data = citations.sf) citeModel @ %def The coefficients here are maximum likelihood estimates of $\lambda_2, \lambda_3, \lambda_4$, with $\lambda_1$ (the log-ability for \emph{Biometrika}) set to zero as an identifying convention. The one-sided model formula \begin{verbatim} ~ journal \end{verbatim} specifies the model for player ability, in this case the `citeability' of the journal. The \code{id} argument specifies that \code{"journal"} is the name to be used for the factor that identifies the player -- the values of which are given here by \code{journal1} and \code{journal2} for the first and second players respectively. Therefore in this case a separate citeability parameter is estimated for each journal. If a different `reference' journal is required, this can be achieved using the optional \code{refcat} argument: for example, making use of \code{update} to avoid re-specifying the whole model, @ <>= update(citeModel, refcat = "JASA") @ %def -- the same model in a different parameterization. The use of the standard Bradley-Terry model for this application might perhaps seem rather questionable -- for example, citations within a published paper can hardly be considered independent, and the model discards potentially important information on self-citation. \citet{stig:94} provides arguments to defend the model's use despite such concerns. \subsection{Bias-reduced estimates} %\label{sec:bias} Estimation of the standard Bradley-Terry model in \code{BTm} is by default computed by maximum likelihood, using an internal call to the \code{glm} function. An alternative is to fit by bias-reduced maximum likelihood \citep{firt:93}: this requires additionally the \pkg{brglm} package \citep{kosm:07}, and is specified by the optional argument \code{br = TRUE}. The resultant effect, namely removal of first-order asymptotic bias in the estimated coefficients, is often quite small. One notable feature of bias-reduced fits is that all estimated coefficients and standard errors are necessarily finite, even in situations of `complete separation' where maximum likelihood estimates take infinite values \citep{hein:sche:02}. For the citation data, the parameter estimates are only very slightly changed in the bias-reduced fit: @ <>= update(citeModel, br = TRUE) @ %def Here the bias of maximum likelihood is small because the binomial counts are fairly large. In more sparse arrangements of contests -- that is, where there is less or no replication of the contests -- the effect of bias reduction would typically be more substantial than the insignificant one seen here. \section{Abilities predicted by explanatory variables} \label{sec:covariates} \subsection{`Player-specific' predictor variables} In some application contexts there may be `player-specific' explanatory variables available, and it is then natural to consider model simplification of the form \begin{equation} \lambda_i=\sum_{r=1}^p\beta_rx_{ir} + U_i, \end{equation} in which ability of each player $i$ is related to explanatory variables $x_{i1},\ldots,x_{ip}$ through a linear predictor with coefficients $\beta_1,\ldots,\beta_p$; the $\{U_i\}$ are independent errors. Dependence of the player abilities on explanatory variables can be specified via the \code{formula} argument, using the standard \emph{S}-language model formulae. The difference in the abilities of player $i$ and player $j$ is modelled by \begin{equation} \sum_{r=1}^p\beta_rx_{ir} - \sum_{r=1}^p\beta_rx_{jr} + U_i - U_j, \label{eq:structured} \end{equation} where $U_i \sim N(0, \sigma^2)$ for all $i$. The Bradley-Terry model is then a generalized linear mixed model, which the \code{BTm} function currently fits by using the penalized quasi-likelihood algorithm of \citet{bres:93}. As an illustration, consider the following simple model for the \code{flatlizards} data, which predicts the fighting ability of Augrabies flat lizards by body size (snout to vent length): @ <>= options(show.signif.stars = FALSE) data("flatlizards", package = "BradleyTerry2") lizModel <- BTm(1, winner, loser, ~ SVL[..] + (1|..), data = flatlizards) @ %def Here the winner of each fight is compared to the loser, so the outcome is always 1. The special name `\code{..}' appears in the formula as the default identifier for players, in the absence of a user-specified \code{id} argument. The values of this factor are given by \code{winner} for the winning lizard and \code{loser} for the losing lizard in each contest. %Since \code{winner} %and \code{loser} are specific instances of the factor \code{..}, they must %share the same set of levels (one for each lizard). %The factors \code{winner}and \code{loser} These factors are provided in the data frame \code{contests} that is the first element of the list object \code{flatlizards}. The second element of \code{flatlizards} is another data frame, \code{predictors}, containing measurements on the observed lizards, including \code{SVL}, which is the snout to vent length. Thus \code{SVL[..]} represents the snout to vent length indexed by lizard (\code{winner} or \code{loser} as appropriate). Finally a random intercept for each lizard is included using the bar notation familiar to users of the \pkg{lme4} package \citep{bate:11}. (Note that a random intercept is the only random effect structure currently implemented in \pkg{BradleyTerry2}.) The fitted model is summarized below: @ <>= summary(lizModel) @ %def The coefficient of snout to vent length is weakly significant; however, the standard deviation of the random effect is quite large, suggesting that this simple model has fairly poor explanatory power. A more appropriate model is considered in the next section. \subsection{Missing values} The contest data may include all possible pairs of players and hence rows of missing data corresponding to players paired with themselves. Such rows contribute no information to the Bradley-Terry model and are simply discarded by \code{BTm}. Where there are missing values in player-specific \emph{predictor} (or \emph{explanatory}) variables which appear in the formula, it will typically be very wasteful to discard all contests involving players for which some values are missing. Instead, such cases are accommodated by the inclusion of one or more parameters in the model. If, for example, player $1$ has one or more of its predictor values $x_{11},\ldots,x_{1p}$ missing, then the combination of Equations~\ref{eq:unstructured} and \ref{eq:structured} above yields \begin{equation} \logit[\pr(1\ \mathrm{beats}\ j)]=\lambda_1 - \left(\sum_{r=1}^p\beta_rx_{jr} + U_j\right), \end{equation} for all other players $j$. This results in the inclusion of a `direct' ability parameter for each player having missing predictor values, in addition to the common coefficients $\beta_1,\ldots,\beta_p$ -- an approach which will be appropriate when the missingness mechanism is unrelated to contest success. The same device can be used also to accommodate any user-specified departures from a structured Bradley-Terry model, whereby some players have their abilities determined by the linear predictor but others do not. In the original analysis of the \code{flatlizards} data \citep{whit:06}, the final model included the first and third principal components of the spectral reflectance from the throat (representing brightness and UV intensity respectively) as well as head length and the snout to vent length seen in our earlier model. The spectroscopy data was missing for two lizards, therefore the ability of these lizards was estimated directly. The following fits this model, with the addition of a random intercept as before: @ <>= lizModel2 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards) summary(lizModel2) @ %def Note that \code{BTm} detects that lizards 96 and 99 have missing values in the specified predictors and automatically includes separate ability parameters for these lizards. This model was found to be the single best model based on the principal components of reflectance and the other predictors available and indeed the standard deviation of the random intercept is much reduced, but still highly significant. Allowing for this significant variation between lizards with the same predictor values produces more realistic (i.e., larger) standard errors for the parameters when compared to the original analysis of \citet{whit:06}. Although this affects the significance of the morphological variables, it does not affect the significance of the principal components, so in this case does not affect the main conclusions of the study. \subsection{Order effect} \label{sec:order} In certain types of application some or all contests have an associated `bias', related to the order in which items are presented to a judge or with the location in which a contest takes place, for example. A natural extension of the Bradley-Terry model (Equation~\ref{eq:unstructured}) is then \begin{equation} \logit[\pr(i\ \mathrm{beats}\ j)]=\lambda_i-\lambda_j + \delta z, \end{equation} where $z=1$ if $i$ has the supposed advantage and $z=-1$ if $j$ has it. (If the `advantage' is in fact a disadvantage, $\delta$ will be negative.) The scores $\lambda_i$ then relate to ability in the absence of any such advantage. As an example, consider the baseball data given in \citet{agre:02}, page 438: @ <>= data("baseball", package = "BradleyTerry2") head(baseball) @ %def The data set records the home wins and losses for each baseball team against each of the 6 other teams in the data set. The \code{head} function is used to show the first 6 records, which are the Milwaukee home games. We see for example that Milwaukee played 7 home games against Detroit and won 4 of them. The `standard' Bradley-Terry model without a home-advantage parameter will be fitted if no formula is specified in the call to \code{BTm}: @ <>= baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") summary(baseballModel1) @ %def The reference team is Baltimore, estimated to be the weakest of these seven, with Milwaukee and Detroit the strongest. In the above, the ability of each team is modelled simply as \code{~ team} where the values of the factor \code{team} are given by \code{home.team} for the first team and \code{away.team} for the second team in each game. To estimate the home-advantage effect, an additional variable is required to indicate whether the team is at home or not. Therefore data frames containing both the team factor and this new indicator variable are required in place of the factors \code{home.team} and \code{away.team} in the call to \code{BTm}. This is achieved here by over-writing the \code{home.team} and \code{away.team} factors in the \code{baseball} data frame: @ <>= baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) @ %def The \code{at.home} variable is needed for both the home team and the away team, so that it can be differenced as appropriate in the linear predictor. With the data organised in this way, the ability formula can now be updated to include the \code{at.home} variable as follows: @ <>= baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) summary(baseballModel2) @ %def \vspace*{-0.3cm} This reproduces the results given on page 438 of \citet{agre:02}: the home team has an estimated odds-multiplier of $\exp(0.3023) = 1.35$ in its favour. \vspace*{-0.2cm} \subsection{More general (contest-specific) predictors} \label{sec:CEMS} The `home advantage' effect is a simple example of a contest-specific predictor. Such predictors are necessarily interactions, between aspects of the contest and (aspects of) the two `players' involved. For more elaborate examples of such effects, see \code{?chameleons} and \code{?CEMS}. The former includes an `experience' effect, which changes through time, on the fighting ability of male chameleons. The latter illustrates a common situation in psychometric applications of the Bradley-Terry model, where \emph{subjects} express preference for one of two \emph{objects} (the `players'), and it is the influence on the results of subject attributes that is of primary interest. As an illustration of the way in which such effects are specified, consider the following model specification taken from the examples in \code{?CEMS}, where data on students' preferences in relation to six European management schools is analysed. \vspace*{-0.3cm} @ <>= data("CEMS", package = "BradleyTerry2") table8.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * LAT[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) @ %def This model reproduces results from Table~8 of \cite{ditt:01} apart from minor differences due to the different treatment of ties. Here the outcome is the binomial frequency of preference for \code{school1} over \code{school2}, with ties counted as half a `win' and half a `loss'. The formula specifies the model for school `ability' or worth. In this formula, the default label `\code{..}' represents the school (with values given by \code{school1} or \code{school2} as appropriate) and \code{student} is a factor specifying the student that made the comparison. The remaining variables in the formula use \proglang{R}'s standard indexing mechanism to include student-specific variables, e.g., \code{WOR}: whether or not the student was in full-time employment, and school-specific variables, e.g., \code{LAT}: whether the school was in a `Latin' city. Thus there are three types of variables: contest-specific (\code{school1}, \code{school2}, \code{student}), subject-specific (\code{WOR}, \code{DEG}, \ldots) and object-specific (\code{LAT}, \code{St.Gallen}, \ldots). These three types of variables are provided in three data frames, contained in the list object \code{CEMS}. \section{Ability scores} \label{sec:ability} The function \code{BTabilities} extracts estimates and standard errors for the log-ability scores $\lambda_1, \ldots,\lambda_K$. These will either be `direct' estimates, in the case of the standard Bradley-Terry model or for players with one or more missing predictor values, or `model-based' estimates of the form $\hat\lambda_i=\sum_{r=1}^p\hat\beta_rx_{ir}$ for players whose ability is predicted by explanatory variables. As a simple illustration, team ability estimates in the home-advantage model for the \code{baseball} data are obtained by: @ <>= BTabilities(baseballModel2) @ %def This gives, for each team, the estimated ability when the team enjoys no home advantage. Similarly, estimates of the fighting ability of each lizard in the \code{flatlizards} data under the model based on the principal components of the spectral reflectance from the throat are obtained as follows: @ <>= head(BTabilities(lizModel2), 4) @ %def % The ability estimates in an unstructured Bradley-Terry model are particularly well suited to presentation using the device of \emph{quasi-variances} \citep{firt:04}. The \pkg{qvcalc} package \citep[][version 0.8-5 or later]{firt:10} contains a function of the same name which does the necessary work: \begin{Sinput} > library("qvcalc") > baseball.qv <- qvcalc(BTabilities(baseballModel2)) > plot(baseball.qv, + levelNames = c("Bal", "Bos", "Cle", "Det", "Mil", "NY", "Tor")) \end{Sinput} % \begin{figure}[t!] \centering \includegraphics[width=0.67\textwidth]{baseball-qvplot.pdf} \caption{Estimated relative abilities of baseball teams.\label{fig:qvplot}} \end{figure} % The `comparison intervals' as shown in Figure~\ref{fig:qvplot} are based on `quasi standard errors', and can be interpreted as if they refer to \emph{independent} estimates of ability for the journals. This has the advantage that comparison between any pair of journals is readily made (i.e., not only comparisons with the `reference' journal). For details of the theory and method of calculation see \citet{firt:04}. \section{Residuals} \label{sec:residuals} There are two main types of residuals available for a Bradley-Terry model object. First, there are residuals obtained by the standard methods for models of class \code{"glm"}. These all deliver one residual for each contest or type of contest. For example, Pearson residuals for the model \code{lizModel2} can be obtained simply by \vspace*{0.2cm} @ <>= res.pearson <- round(residuals(lizModel2), 3) head(cbind(flatlizards$contests, res.pearson), 4) @ %def \vspace*{-0.2cm} More useful for diagnostics on the linear predictor $\sum\beta_rx_{ir}$ are `player'-level residuals, obtained by using the function \code{residuals} with argument \code{type = "grouped"}. These residuals can then be plotted against other player-specific variables. \vspace*{-0.2cm} @ <>= res <- residuals(lizModel2, type = "grouped") # with(flatlizards$predictors, plot(throat.PC2, res)) # with(flatlizards$predictors, plot(head.width, res)) @ %def \vspace*{-0.2cm} These residuals estimate the error in the linear predictor; they are obtained by suitable aggregation of the so-called `working' residuals from the model fit. The \code{weights} attribute indicates the relative information in these residuals -- weight is roughly inversely proportional to variance -- which may be useful for plotting and/or interpretation; for example, a large residual may be of no real concern if based on very little information. Weighted least-squares regression of these residuals on any variable already in the model is null. For example: \vspace*{-0.2cm} @ <>= lm(res ~ throat.PC1, weights = attr(res, "weights"), data = flatlizards$predictors) lm(res ~ head.length, weights = attr(res, "weights"), data = flatlizards$predictors) @ %def %$ \vspace*{-0.2cm} As an illustration of evident \emph{non-null} residual structure, consider the unrealistically simple model \code{lizModel} that was fitted in Section~\ref{sec:covariates} above. That model lacks the clearly significant predictor variable \code{throat.PC3}, and the plot shown in Figure~\ref{fig:residuals} demonstrates this fact graphically: \begin{Sinput} > lizModel.residuals <- residuals(lizModel, type = "grouped") > plot(flatlizards$predictors$throat.PC3, lizModel.residuals) \end{Sinput} % \begin{figure}[t!] \centering \includegraphics[width=0.69\textwidth]{residuals.pdf} \caption{Lizard residuals for the simple model \code{lizModel}, plotted against \code{throat.PC3}.\label{fig:residuals}} \end{figure} % The residuals in the plot exhibit a strong, positive regression slope in relation to the omitted predictor variable \code{throat.PC3}. \section{Model search} \label{sec:model} In addition to \code{update()} as illustrated in preceding sections, methods for the generic functions \code{add1()}, \code{drop1()} and \code{anova()} are provided. These can be used to investigate the effect of adding or removing a variable, whether that variable is contest-specific, such as an order effect, or player-specific; and to compare the fit of nested models. %These can be used in the standard way for model elaboration or specialization, %and their availability also allows the use of \texttt{\color{black} step()} for %automated exploration of a set of candidate player-specific predictors. \section{Setting up the data} \label{sec:data} \subsection{Contest-specific data} \label{sec:contest} The \code{outcome} argument of \code{BTm} represents a binomial response and can be supplied in any of the formats allowed by the \code{glm} function. That is, either a two-column matrix with the columns giving the number of wins and losses (for \code{player1} vs.\ \code{player2}), a factor where the first level denotes a loss and all other levels denote a win, or a binary variable where 0 denotes a loss and 1 denotes a win. Each row represents either a single contest or a set of contests between the same two players. The \code{player1} and \code{player2} arguments are either factors specifying the two players in each contest, or data frames containing such factors, along with any contest-specific variables that are also player-specific, such as the \code{at.home} variable seen in Section~\ref{sec:order}. If given in data frames, the factors identifying the players should be named as specified by the \code{id} argument and should have identical levels, since they represent a particular sample of the full set of players. Thus for the model \code{baseballModel2}, which was specified by the following call: @ <>= baseballModel2$call @ %def the data are provided in the \code{baseball} data frame, which has the following structure: @ <>= str(baseball, vec.len = 2) @ %def In this case \code{home.team} and \code{away.team} are both data frames, with the factor \code{team} specifying the team and the variable \code{at.home} specifying whether or not the team was at home. So the first comparison @ <>= baseball$home.team[1,] baseball$away.team[1,] @ %def is Milwaukee playing at home against Detroit. The outcome is given by @ <>= baseball[1, c("home.wins", "away.wins")] @ %def Contest-specific variables that are \emph{not} player-specific -- for example, whether it rained or not during a contest -- should only be used in interactions with variables that \emph{are} player-specific, otherwise the effect on ability would be the same for both players and would cancel out. Such variables can conveniently be provided in a single data frame along with the \code{outcome}, \code{player1} and \code{player2} data. An offset in the model can be specified by using the \code{offset} argument to \code{BTm}\null. This facility is provided for completeness: the authors have not yet encountered an application where it is needed. To use only certain rows of the contest data in the analysis, the \code{subset} argument may be used in the call to \code{BTm}. This should either be a logical vector of the same length as the binomial response, or a numeric vector containing the indices of rows to be used. \subsection{Non contest-specific data} \label{sec:non-contest} Some variables do not vary by contest directly, but rather vary by a factor that is contest-specific, such as the player ID or the judge making the paired comparison. For such variables, it is more economical to store the data by the levels of the contest-specific factor and use indexing to obtain the values for each contest. The \code{CEMS} example in Section~\ref{sec:CEMS} provides an illustration of such variables. In this example student-specific variables are indexed by \code{student} and school-specific variables are indexed by \code{..}, i.e., the first or second school in the comparison as appropriate. There are then two extra sets of variables in addition to the usual contest-specific data as described in the last section. A good way to provide these data to \code{BTm} is as a list of data frames, one for each set of variables, e.g., @ <>= str(CEMS, vec.len = 2) @ %def The names of the data frames are only used by \code{BTm} if they match the names specified in the \code{player1} and \code{player2} arguments, in which case it is assumed that these are data frames providing the data for the first and second player respectively. The rows of data frames in the list should either correspond to the contests or the levels of the factor used for indexing. Player-specific offsets should be included in the formula by using the \code{offset} function. \subsection{Converting data from a `wide' format} The \code{BTm} function requires data in a `long' format, with one row per contest, provided either directly as in Section~\ref{sec:contest} or via indexing as in Section~\ref{sec:non-contest}. In studies where the same set of paired comparisons are made by several judges, as in a questionnaire for example, the data may be stored in a `wide' format, with one row per judge. As an example, consider the \code{cemspc} data from the \pkg{prefmod} package \citep{hatz:12}, which provides data from the CEMS study in a wide format. Each row corresponds to one student; the first 15 columns give the outcome of all pairwise comparisons between the 6~schools in the study and the last two columns correspond to two of the student-specific variables: \code{ENG} (indicating the student's knowledge of English) and \code{SEX} (indicating the student's gender). The following steps convert these data into a form suitable for analysis with \code{BTm}. First a new data frame is created from the student-specific variables and these variables are converted to factors: @ <>= library("prefmod") student <- cemspc[c("ENG", "SEX")] student$ENG <- factor(student$ENG, levels = 1:2, labels = c("good", "poor")) student$SEX <- factor(student$SEX, levels = 1:2, labels = c("female", "male")) @ %def This data frame is put into a list, which will eventually hold all the necessary data. Then a \code{student} factor is created for indexing the student data to produce contest-level data. This is put in a new data frame that will hold the contest-specific data. @ <>= cems <- list(student = student) student <- gl(303, 1, 303 * 15) #303 students, 15 comparisons contest <- data.frame(student = student) @ %def Next the outcome data is converted to a binomial response, adjusted for ties. The result is added to the \code{contest} data frame. @ <>= win <- cemspc[, 1:15] == 0 lose <- cemspc[, 1:15] == 2 draw <- cemspc[, 1:15] == 1 contest$win.adj <- c(win + draw/2) contest$lose.adj <- c(lose + draw/2) @ %def Then two factors are created identifying the first and second school in each comparison. The comparisons are in the order 1 vs.\ 2, 1 vs.\ 3, 2 vs.\ 3, 1 vs.\ 4, \ldots, so the factors can be created as follows: @ <>= lab <- c("London", "Paris", "Milano", "St. Gallen", "Barcelona", "Stockholm") contest$school1 <- factor(sequence(1:5), levels = 1:6, labels = lab) contest$school2 <- factor(rep(2:6, 1:5), levels = 1:6, labels = lab) @ %def Note that both factors have exactly the same levels, even though only five of the six players are represented in each case. In other words, the numeric factor levels refer to the same players in each case, so that the player is unambiguously identified. This ensures that player-specific parameters and player-specific covariates are correctly specified. Finally the \code{contest} data frame is added to the main list: @ <>= cems$contest <- contest @ %def This creates a single data object that can be passed to the \code{data} argument of \code{BTm}. Of course, such a list could be created on-the-fly as in \code{data = list(contest, student)}, which may be more convenient in practice. \subsection[Converting data from the format required by the earlier BradleyTerry package]{Converting data from the format required by the earlier \pkg{BradleyTerry} package} The \pkg{BradleyTerry} package described in \citet{firt:05} required contest/comparison results to be in a data frame with columns named \code{winner}, \code{loser} and \code{Freq}. The following example shows how \code{xtabs} and \code{countsToBinomial} can be used to convert such data for use with the \code{BTm} function in \pkg{BradleyTerry2}: \begin{Sinput} > library("BradleyTerry") ## the /old/ BradleyTerry package > ## load data frame with columns "winner", "loser", "Freq" > data("citations", package = "BradleyTerry") > ## convert to 2-way table of counts > citations <- xtabs(Freq ~ winner + loser, citations) > ## convert to a data frame of binomial observations > citations.sf <- countsToBinomial(citations) \end{Sinput} The \code{citations.sf} data frame can then be used with \code{BTm} as shown in Section~\ref{citations}. \section[A list of the functions provided in BradleyTerry2]{A list of the functions provided in \pkg{BradleyTerry2}} \label{sec:functions} The standard \R\ help files provide the definitive reference. Here we simply list the main user-level functions and their arguments, as a convenient overview: @ <>= ## cf. prompt options(width = 55) for (fn in getNamespaceExports("BradleyTerry2")) { name <- as.name(fn) args <- formals(fn) n <- length(args) arg.names <- arg.n <- names(args) arg.n[arg.n == "..."] <- "\\dots" is.missing.arg <- function(arg) typeof(arg) == "symbol" && deparse(arg) == "" Call <- paste(name, "(", sep = "") for (i in seq_len(n)) { Call <- paste(Call, arg.names[i], if (!is.missing.arg(args[[i]])) paste(" = ", paste(deparse(args[[i]]), collapse = "\n"), sep = ""), sep = "") if (i != n) Call <- paste(Call, ", ", sep = "") } Call <- paste(Call, ")", sep = "") cat(deparse(parse(text = Call)[[1]], width.cutoff = 50), fill = TRUE) } options(width = 60) @ %def \section{Some final remarks} \label{sec:finalremarks} \subsection[A note on the treatment of ties]{A note on the treatment of ties} The present version of \BT\ provides no sophisticated facilities for handling tied contests/comparisons; the well-known models of \cite{rao:kupp:67} and \cite{davi:70} are not implemented here. At present the \code{BTm} function requires a binary or binomial response variable, the third (`tied') category of response is not allowed. In several of the data examples (e.g., \code{?CEMS}, \code{?springall}, \code{?sound.fields}), ties are handled by the crude but simple device of adding half of a `win' to the tally for each player involved; in each of the examples where this has been done it is found that the result is very similar, after a simple re-scaling, to the more sophisticated analyses that have appeared in the literature. Note that this device when used with \code{BTm} typically gives rise to warnings produced by the back-end \code{glm} function, about non-integer `binomial' counts; such warnings are of no consequence and can be safely ignored. It is likely that a future version of \BT\ will have a more general method for handling ties. \subsection{A note on `contest-specific' random effects} The current version of \BT\ provides facilities for fitting models with random effects in `player-specific' predictor functions, as illustrated in Section~\ref{sec:covariates}. For more general, `contest-specific' random-effect structures, such as random `judge' effects in psychological studies \citep[e.g.,][]{bock:01}, \BT\ provides (through \code{BTm}) the necessary user interface but as yet no back-end calculation. It is hoped that this important generalization can be made successfully in a future version of \BT. \section*{Acknowledgments} This work was supported by the UK Engineering and Physical Sciences Research Council. \begin{thebibliography}{22} \newcommand{\enquote}[1]{``#1''} \providecommand{\natexlab}[1]{#1} \providecommand{\url}[1]{\texttt{#1}} \providecommand{\urlprefix}{URL } \expandafter\ifx\csname urlstyle\endcsname\relax \providecommand{\doi}[1]{doi:\discretionary{}{}{}#1}\else \providecommand{\doi}{doi:\discretionary{}{}{}\begingroup \urlstyle{rm}\Url}\fi \providecommand{\eprint}[2][]{\url{#2}} \bibitem[{Agresti(2002)}]{agre:02} Agresti A (2002). \newblock \emph{Categorical Data Analysis}. \newblock 2nd edition. John Wiley \& Sons. \bibitem[{Bates \emph{et~al.}(2011)Bates, M\"achler, and Bolker}]{bate:11} Bates D, M\"achler M, Bolker B (2011). \newblock \emph{\pkg{lme4}: Linear Mixed-Effects Models Using \proglang{S}4 Classes}. \newblock \proglang{R}~package version~0.999375-42, \urlprefix\url{http://CRAN.R-project.org/package=lme4}. \bibitem[{B\"ockenholt(2001)}]{bock:01} B\"ockenholt U (2001). \newblock \enquote{Hierarchical Modeling of Paired Comparison Data.} \newblock \emph{Psychological Methods}, \textbf{6}(1), 49--66. \bibitem[{Bradley(1984)}]{brad:84} Bradley RA (1984). \newblock \enquote{Paired Comparisons: Some Basic Procedures and Examples.} \newblock In PR~Krishnaiah, PK~Sen (eds.), \emph{Nonparametric Methods}, volume~4 of \emph{Handbook of Statistics}, pp. 299 -- 326. Elsevier. \bibitem[{Bradley and Terry(1952)}]{brad:terr:52} Bradley RA, Terry ME (1952). \newblock \enquote{Rank Analysis of Incomplete Block Designs {I}: {T}he Method of Paired Comparisons.} \newblock \emph{Biometrika}, \textbf{39}, 324--45. \bibitem[{Breslow and Clayton(1993)}]{bres:93} Breslow NE, Clayton DG (1993). \newblock \enquote{Approximate Inference in Generalized Linear Mixed Models.} \newblock \emph{Journal of the American Statistical Association}, \textbf{88}(421), 9--25. \bibitem[{Davidson(1970)}]{davi:70} Davidson RR (1970). \newblock \enquote{On Extending the {B}radley-{T}erry Model to Accommodate Ties in Paired Comparison Experiments.} \newblock \emph{Journal of the American Statistical Association}, \textbf{65}, 317--328. \bibitem[{Dittrich \emph{et~al.}(2001)Dittrich, Hatzinger, and Katzenbeisser}]{ditt:01} Dittrich R, Hatzinger R, Katzenbeisser W (2001). \newblock \enquote{Corrigendum: {M}odelling the Effect of Subject-Specific Covariates in Paired Comparison Studies with an Application to University Rankings.} \newblock \emph{Applied Statistics}, \textbf{50}, 247--249. \bibitem[{Firth(1993)}]{firt:93} Firth D (1993). \newblock \enquote{Bias Reduction of Maximum Likelihood Estimates.} \newblock \emph{Biometrika}, \textbf{80}, 27--38. \bibitem[{Firth(2005)}]{firt:05} Firth D (2005). \newblock \enquote{Bradley-Terry Models in \proglang{R}.} \newblock \emph{Journal of Statistical Software}, \textbf{12}(1), 1--12. \newblock \urlprefix\url{http://www.jstatsoft.org/v12/i01/}. \bibitem[{Firth(2010)}]{firt:10} Firth D (2010). \newblock \emph{\pkg{qvcalc}: Quasi-Variances for Factor Effects in Statistical Models}. \newblock \proglang{R}~package version~0.8-7, \urlprefix\url{http://CRAN.R-project.org/package=qvcalc}. \bibitem[{Firth and {de Menezes}(2004)}]{firt:04} Firth D, {de Menezes} RX (2004). \newblock \enquote{Quasi-Variances.} \newblock \emph{Biometrika}, \textbf{91}, 65--80. \bibitem[{Hatzinger and Dittrich(2012)}]{hatz:12} Hatzinger R, Dittrich R (2012). \newblock \enquote{\pkg{prefmod}: An \proglang{R} Package for Modeling Preferences Based on Paired Comparisons, Rankings, or Ratings.} \newblock \emph{Journal of Statistical Software}, \textbf{48}(10), 1--31. \newblock \urlprefix\url{http://www.jstatsoft.org/v48/i10/}. \bibitem[{Heinze and Schemper(2002)}]{hein:sche:02} Heinze G, Schemper M (2002). \newblock \enquote{A Solution to the Problem of Separation in Logistic Regression.} \newblock \emph{Statistics in Medicine}, \textbf{21}, 2409--2419. \bibitem[{Ihaka and Gentleman(1996)}]{ihak:gent:96} Ihaka R, Gentleman R (1996). \newblock \enquote{\proglang{R}: A Language for Data Analysis and Graphics.} \newblock \emph{Journal of Computational and Graphical Statistics}, \textbf{5}(3), 299--314. \bibitem[{Kosmidis(2007)}]{kosm:07} Kosmidis I (2007). \newblock \emph{\pkg{brglm}: Bias Reduction in Binary-Response GLMs}. \newblock \proglang{R}~package version~0.5-6, \urlprefix\url{http://www.ucl.ac.uk/~ucakiko/software.html}. \bibitem[{Rao and Kupper(1967)}]{rao:kupp:67} Rao PV, Kupper LL (1967). \newblock \enquote{Ties in Paired-Comparison Experiments: {A} Generalization of the {B}radley-{T}erry Model.} \newblock \emph{Journal of the American Statistical Association}, \textbf{62}, 194--204. \bibitem[{{\proglang{R} Development Core Team}(2012)}]{R} {\proglang{R} Development Core Team} (2012). \newblock \emph{\proglang{R}: A Language and Environment for Statistical Computing}. \newblock \proglang{R} Foundation for Statistical Computing, Vienna, Austria. \newblock {ISBN} 3-900051-07-0, \urlprefix\url{http://www.R-project.org/}. \bibitem[{Sham and Curtis(1995)}]{sham:curt:95} Sham PC, Curtis D (1995). \newblock \enquote{An Extended Transmission/Disequilibrium Test ({TDT}) for Multi-Allele Marker Loci.} \newblock \emph{Annals of Human Genetics}, \textbf{59}(3), 323--336. \bibitem[{Stigler(1994)}]{stig:94} Stigler S (1994). \newblock \enquote{Citation Patterns in the Journals of Statistics and Probability.} \newblock \emph{Statistical Science}, \textbf{9}, 94--108. \bibitem[{Turner and Firth(2012)}]{turn:12} Turner H, Firth D (2012). \newblock \enquote{Bradley-Terry Models in \proglang{R}: The \pkg{BradleyTerry2} Package.} \newblock \emph{Journal of Statistical Software}, \textbf{48}(9), 1--21. \newblock \urlprefix\url{http://www.jstatsoft.org/v48/i09/}. \bibitem[{Whiting \emph{et~al.}({2006})Whiting, Stuart-Fox, O'Connor, Firth, Bennett, and Blomberg}]{whit:06} Whiting MJ, Stuart-Fox DM, O'Connor D, Firth D, Bennett NC, Blomberg SP ({2006}). \newblock \enquote{{Ultraviolet Signals Ultra-Aggression in a Lizard}.} \newblock \emph{Animal Behaviour}, \textbf{{72}}, 353--363. \end{thebibliography} \end{document} BradleyTerry2/inst/doc/BradleyTerry.pdf0000644000176200001440000107435413616022414017606 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4809 /Filter /FlateDecode /N 82 /First 662 >> stream x\[s8~?: IVv<8L2;XȒ3uJmTM 7APJB YXaJXaN8AEDD= )uRyRH#n7xEB %=ڽPZ(`UD'"&WhW-tqEˈΖ3$1 mR(t` j"&RaFY zs'x(t\C!5F WE@Nxi 6^8@098 @ cp/"&FxN "C  E%."`,z'Yt4I BJJs,J,5:)T %@(@d@OFl* (),Jǥ2p "EN4L34Ls4Dhr"_ƟMn`x,iě^MA~ZN7e92 F~>4ꪜ(<'j~ԙ`AJ{НWX]I8V'%3 ~#dF"$8g$?,v&D'l4M+i"^86*b_Hb{c!"^K{!em&OΑ!q<bquV  wЛLjX6??|w:x1w=z59u9*u5k0x^ +Gh5SP>d/ 8l[ö7>}#>?_\ppӣo2 Lr  oO_`}]\nf/~{ Hh8Y ]pΪ˞ItjyK58#JV/8{! +WC#2;A RMH51B{E{Nm{,h￩+O;z|yVc_~-泌͚\V:!L NDDN4 gՄ;l>UiﹽYz^U}'g'_#J_*p!6/J8: &_GJ_I`a ;lśQH>֨V+ݖ,#m;;y6y`f9;>cjWSglM_`;]#^w T23`)m4K!o(ClC)Yh/lKz鵠/!0-ʦ3CLeD|+&M/< ni3ERJuƂ "'h(O#2!|n[)=/CzO;JF;(Zy޴fvhSO/ 5Og BWkdqݺfZhZbg;Ь״gXoOJ1:J^M[[1\GuX(SlMU`I呱(. P:zp*sDl,e ']J'3h&H-czߴ {ExX. WJJI*$fmzdP ;=\1=tGuJY0oAa{kkPLT)Bʲv:$[HҜZ:DE҆M9y%_4t0jOxD$h5qm}A3JҢ6 6?y$Kci_O%Hw5̧X-,gX,#6^&IVyl̄5c䂉vidJ'r?.Pٴ"GZf1rn*RIҊh[*ˑ06y[8PI.K޳,ۗDf9d?'48y3]ZSesGr DהMd u''V2g%˟ 84ciH} mfN`u͖?L /OfyL). ޙ%@H=$vJB2c~ۺc5I.Iќ_x>%kG]򨼔JM4'Z6 M,Awj}UOgY5ļ5[;-tqW~֑nH ;>؁rKjg#?"p |:(9V:BQUs V@kV2aarKVҬf[ilW?RG]GԒųweل ZZùշ)t覽(d1NE&0}mffLAggV#{06F)uzst'#S|`(y*9,M=h H>p5t҅N]({<)ɉ)^ȗZ5g yX/zġTOv$a["?M#.8z5~y/˼ίa~IG^?j MXҜT4io18X '%q5,۴hyݻ.W&=:lV^Bgںǝ}}CL}Nh(uS&?# OA*Oe˪A> Q^?2F`$0Ku5܌g%?ZzZ|Z~¬s>g,Y7şm?URAfU+HIjH6%}Iߔ賫GR8ITI4E¢K\G t2.fYn2ϠZa[c{6Lkr]>{FVz2!d@EZǴ7@N%M*W9rXnI!8 'yY,a"KbYacxwQuzOGv/@8ٷ/=w iO{>EݻX6ᏫðܸFu~U崚=u9”xfںpq:~_WOJx;5j㪚,= =yKw-~%4gb;$.FHwߚxa[VزyCܘboE@`U?Dt/8Y Z?+yeUͪaD f|B_Xv箠.{|t|\Ru5z'H&~oVtz'ִ;QUQ,oa|;6F?7`;+% 3Ro1[,eBF껚/% k eVa뵝`kawD!5X?l/X΋ݞ$G`&G|{~R]W|rh|l֫익Sa}0}9BcJK|T=q&b`=dh>Ӌ1GE5.%#.nEըnŧ^].y_9g>3<Oנ|k3lӛ;t~_aˢ$D?MQC'[Lx;-珛jV9A7Wsr3@Xe-ާ/z6-#X4hW*Q4I|/fq .]+ Bd`엢.CS}$3\ʹz<>j07X<eCT nhYwf8荀;TSIh{$~љ4F*sefL= \!}!勪7<=|c7l*hOv~^3e$HA)~CM&_~ IDendstream endobj 84 0 obj << /Filter /FlateDecode /Length 3560 >> stream xڭZs6_P3C Ӈmri3wo!Lh뫔do2 b%rM_er}{})'ʦZfr};QYX̩b1y;UI[b ͮU4,EYh}&Ym_]y* 2ȢA“|S\FX1y1̳te͜+lʹ3 #Q&6lFD%^y[@4d}Ұpt1N 񴁀b5/]S_\"tapZ/QqN+ c\^WQCXIe8bj!'t%M~LfOxex\KK"#Db' }RsDz:g]e7HltNx݉J:sJQRWY^:C[\d{{DpQ*g92;)L y=nstUwvy\,:S 7!j݅K[GSj>􌉭+.[UO#i(a{w>!lEH8x!\ l|z!}Q!S.]jIA* !X 2' >>tOz"ڸa7^7~E&Y14/KY^Wؼ0jpY,FƑpӏWGyu$ GbDZOry#A-lk~.TZ> :Ě{? oGrY>+Xi_ A~N !#z9Ya]ETrKA(i`\<])ľ༷$1i_<ĕ'&,NRuPɃ+%\P8iprK5DU4D*#q><.uz1{8v QvR\J8UoG)uԺ pf{%uoY6l {s~O|l}4lAX\ Ji7Vo"\֙5r]E/{`[VW mwQSD[Sy[=V*VAʿ0+MyL"*-& z͍WDr8YTc}M4Ozz\f1݇I< IxMxt\"|{yBOG"+S%vM82֍L\#kJ-c*M}pũG<>!Wn윓^R=JT9p t,\Em7޿P!\FLȪTe_HS|Ѱ$iCд<{ik&xYL=! (.NM'jׁm$t_ǏJ$WYCQ+v[֖sy--X;m n7/3TKJ =J>j[nC277/e;L!3c2ۣ_6ą5a՞9Eo|$O'pڠc?o$O.>p}_qendstream endobj 85 0 obj << /Type /ObjStm /Length 3216 /Filter /FlateDecode /N 82 /First 716 >> stream xZ[s6~_dvwͬ/$Ӥ6یYKJRN҇%_Jpn,g1=o)aXș9 7ɬ›bNM3F-[<~hImZB`Bx9F)Ƅ<"Njt4P3Dxe 2{S&vqB{eiz&BP.$>)&%4V6LɄe1pP$ ʕu`J[Hɔ!ڤbi DcV.0ք L["\GrG2;PxMLPS0 ,a:=37ka9Rõbւ5 `,s€ ;i@ّI>'d^(lDjX-@"IzaGzh@}% ( \rE:c˒fe,۩m6Y3=,mM{8+ʊe{E]V/vX_諽lFOjzڟ~GhCϟ$Hyrpq(:?B>E &Q(rP3tw+x=xN_^h0]7l mnH5MHHp)a!%Vp@\@&F2 7)^irFÈ}XhdiO} 0XE[`xߐygcsmACvoeGէ 㝢"O;o~Ýw*m-@^Օm=6:b p<)ĕAԮsO`_\]_[.eYpYj{jRDh&|ٻ?^ү&bLln{(ޖi 9\~x'xyӌyY$\(hY]vy?Oo bvWOO?}5)&SEnߘe5,X)#aiY)W4B8ry!:ꓓeՑe=yGQ{Ǽqu05K,;m ,^s5+붜ON'(fʲmEY%lTcG ڈHYX?OOv>s lNiWęh|$(w I7A-\qEsDi=[SYv@.b)e8^zz@l{ rFWmz+I⤤&jyit@mY.˜Fr~SiCQN!4TkMi#G7@lT\[.ıx;*/1RT0WHp{p}R܄`j.R R&ino P @FY_TxKtHO8F?⭢ჂŶHʥt9̀]j_AJmh'VC^4z$|OM=`:H{%-ffv8}$$"YL&EVe,;/*;<;YMi=&kUm݌6벮YVUlϪmҍg0+όeϨ L8ܯ]vAppyǫx=EDd)%VP$0jSbi6&zD"L׈׉-KnsB%QW=P^ŦStS L'uOS97ͨ*螵oIW#G_ai o=Yg}1@UHǷٸz֜D4~E=Bh\}>ѫx~؀'y7Lrƀt=e[C< >EEO_Jendstream endobj 168 0 obj << /Type /ObjStm /Length 2744 /Filter /FlateDecode /N 82 /First 737 >> stream xZ[S8~_ǤuPSSE`H3ILv` xi3nw6; $4Rt>,"Lz dJR]1-QT7*[4Czy/-ZdR#(&(h_ 9P41#8L@!0"2?EQX=1YL  JFjE蘶~LHtOh@M^фJakhB y/e>XX:cQXP11; QJKъޓ?|Oĺ'"DiMRW.>`01mʖQj1i닮ii.W:-]GcRE7xˊդCÑjk9\UGrsxv} zpo>oǂ 'קVQ hkv )(;_{i<&4IP6]ȓ\QA )B3+#(Fq/:brV 5f!>E@^C D/h>dHXp m%3 @;-¹\*2y@(O̖frT!T_;XDI{Ҕ7o6]~ݓ"aUpn fXi]jfZL! _! %w P-e;)JMϖ)s쫉j&b툊 dPڦylj.| #\SF8B])GF QpwiȜ\gB$= $4Yq!bChh2A ӪN19 :}?ݍYwޠv.u]e͜K~MCe!,I#Gz nk;IW2=aPFBTlEVq=+TtՋev!1ebJkkb2F۞De#y:9CY 7&JF K\8d3 kȜSO@Js8e4/ A)|`^zn6@M1PKPo+P1E2tݛf-__M֠Ya8}J%Xs=o~u*u gn7bc9hc=,"T8Gw/)O۱r\hͬ4Y Y }N%(lKm }Uea{SƛiMPa6s!ʂ,Z(nfBWtX$X_$'3c@<jZwcA-H\I 9# @Ef@oy\fvJ䷼i]'9F8w1o1Q)֏ R( e#AI1&P ʤO%NI:}͗*`=&\lw@4`#ZLCe*O2uma][lvm=Om5K]jlD@<쑦C#xg蹣d G&ސ8y !9䊄pI8VytT|?$ѰV$_|=dYE!mƒ؋]%pFuʻfzkGgTԓDnVQ붼8' 벻Xv/o^ wyqrPOK0gyN7ܘM5RudOI3tzXZ|nrU3~co`Xrz7_W IM=T|`"MWͪаbڀE͊Ӷ2d)&u;Y̪%9/'m3gq[QG,'bZڢ9$tZM@&٬\i?[Ovy>+؜6 *9)̋t]7 I:a_U :<4T ժk z;c R[NDt%ɠ)C!%xTwe]LFl ;#eV#u@Odef2w8)[Yܶn.N1y91=F.OXcl7ցUJ: UQ4z !𘟉t-+?i0jxe:r({ԓRb.Mt yb<tb"25 3xzP֖29͆$g^ɺ;d~yճ%Q;;ysSo^b$!&kuc[ ^+gdo~ިuo Ȋg\X|P6`zVZ[r}>1Ţ>ge{EDGctj}>zGa0[75{vi r/^3i ^Gendstream endobj 251 0 obj << /Filter /FlateDecode /Length 2882 >> stream xk۸{~O2։Hz@d@K?(m}I}ENעXxMp3r.ϯ>*KVEe^ů^UUTUy/Ul߾ u8㣠(u"3Ï˕!>_W2 +ctneG=GلZ]YU&,ety <<<I<7!V2u taRXKe^$Ͷ".ppw@g> 0N7 ;괨 vLοuY /=J~U%`+Re&zneȀK''C~6+9gm+e|8nAN:t=1>d*G|Ad]eq URW$#1FD;>ONs2yt 9AB0;$Yo<gQM hoG^'E>(MuQ;=jr2sne3jG|鎼Y 8y8Ef&x)v̡ݜ397w~GA_y19'7o٣R3%w 8@#P3adZhHh~7:^wqw4HwFM xJOE$z'ڟZ?%V =7IROe}t."V#JMa g1ZizJ @T<; yZZ ifApR ib(qɺl>VQ~4+kli{nEǸo=B !/%Kgkkr؟w?"*&)"`'$-ԏ1TӪ< D``3LT,$ny\EA$Ң9wjYs,E ea)HΣX(qφph3"Co̍뜴ϻsي{X:GJ$h@kJ^vk+䓨\~iĺs"__%T:tH;^'p Icה*UYWMbqÞɴ('^dam{t5ހ 9,kz֮yvOrA. ZƅŌ}2&J|7҄[ qlYUt>GICy,cCK9F{VOA%Dĩ:O<($7ʙGhz\H3*I=t(ǵUŴg#)5SFWU49A$Mujd|L*K2'U2=+D$]c=,!)p/LuDF&Ċ:cQrpԔWuE&LYޝ}M.r`IvpT,ʓ˄Y'KR%:ZpQ(/9@7+ {yrpq&dU`3C%aR\(&0f DCJܵsX"ʉH #c,( +h|xt0pxpA }!237\+SԳ" |`<)x`ETfQu*@h{ۄWValY0KB_uBke9u=Aj>]g#iqxH_ J)PZ3i贎E"_{sTǮCP͂㿫ƃW\uF|#IPLx//=kpWpbFuRkw=H[Wo+3M]HOy,o9Sy'ҬTWl+7ScL'[S[,\~_|$Pei)ݩ'p vwQD_OGnE-7o?^ ɆkͬmՐ |%p[&XA(:'iI^vW[2r9 j%>P5XF<ތYgdO&x+#CÌ!_Y ~k~8W1̏*ąόwUІzxyendstream endobj 252 0 obj << /Filter /FlateDecode /Length 2287 >> stream xYKs6ϯP퉪1ăGLTmcݒhH,)nU~ (Ö(@@k0[\/|Xc*KVvN\y&_7qxa2F'ee[Z|y#{e+`I>J'o?g:Uڀh ͛Ld]UӪ(`}Ur;‚: E>%bYe]E9~jr4WR}J7# p̆l]KI8~.Q{&Dtb1Y]LU&NP9c~*UX[J45~qDn er)M~$iAe+g~}nEtv/CKy FT 뮡 lFH  ֖FK;rUU혠d&=)K&VpBًUWlH̐tHد TfwI|6F}F1枢Rx \~=*-r:() /M`-R]{CxO`/mj-E /˼HO3'S(G]6n.v̦s ;QЪ 0zrq\J2~*\n2!ttB(Opjv&"pA/ UM'hr5 f)Vd4XhAn֞ublM}NM79o6fLMil:t8mP;/lGgz„VuZiӲ 7״RY^EPFN9$0j﷔DoNޒapǕK}MڑkI$[pNi7$FDi+V{Se $juW=lW*Dh 2>zG (\IZC5ī!͹i{K۟$%%k U?XzL!i8a>_!0jn5I;1y*[gx]M_IA'n]:`2M%?P@UOQ ?s`Av*y3ϑk!/.r 䟺'idU$]a ! ɉ`kuV: ;pE.rTfˤwO& #/ǖ*g 3CO5OrQ9 2=~mFVָF\/'-*|9DF&fja>f4Z>vC2}vO>Y$nK$8a/CtK.KkVE>.[8en=pϸv6VNSŐ>{;fO24O'ʪZPJ+Ii; Zx&V`MxpUVyakʱ# o"x; S?UO(6U1I1>0D9;>tz(Q} *cnKS/Kk8u jywײ"!Džy./$TW0GV7 -yxȧX?)֍Lt@Lb /o]xd 9Y:n9[}aT[aK},-\-U.eZ),-LJZ6CǠ8zdURlYز SiKkwp#ϰISRP9m~;Gj)T|erի͚'v -Sq^࿯$;au5 U.feRߥlߢ4\+o1郦`՝Ľ3n\UԂW*> stream xڍT. J Rkq-R(X;R_:3gf]Y+{~W>zu-v)+%XȨJ\\<\\7(/1:.s I&kd s(C@_( !E kra`Wtz )L fPHHwpZق2,-vLnnNœ0qf6' vxp:=@\ fi<  xJRR94VӀ l@spp8!P0@M^ˍ `h {@-,  /xj\A.'7WWwvn>.)ӃQUƿ|a?}*L-3c= `\|\/3pc(7oAPj?iݞ@ksiaP)Y< !B\!^`+uO)cP#X }؁\\{Z,D?T৽r XXx?6 0'Ss~k pJy#!?HipF+8N!oswi/ /D^NؿS4PO inv~~ ]\.?v`/0}n id`fs~>'hB* wqM\rg%SFYF+qhT7*4Jvm_ξ-W_꿽[ %ݻ X)˷IiةPYp/&FYbyJ| p]TA̐ hGz+MdƧ4fEl&W 2o>kdoI]B*ŲT ^ty]WFzTPrr{:*$}x+ϝ;tY9qƴN1?2Njtʖ,Z, 3 ! ڙS4q}l1*bp~[ia d%HjNueR䍀̸cX3inA_6gA/lKi0dҾhKKSm%ׅ .0FmtM캻ci|*Qpp1=]nl:sc@,["$*u'Q?nZ8+ ȝV3~4]˕D8 gy=:[~~pe CIx\jG8[:m%yʙ1/Xh^CI2:vI(\uxY.10%j Tc'MW{u[Guwܞwf"a e:d qy(IHgj-MgEhS*W:¶Dqakº_8;œGMRdIKNXmm jM*)IqfИe!(UVRvZX!/ꨡK7pԄz(;)v' ͠Xv#~ 0&K8ⵁU\1^oALR^[.Bއ̯98*񸞽_$%܍d ץrո+wq r'엩:;Id*0 :ĂTHDIإ;YHe-cplfپBa ȣ:%k&#{ږFszmo5k}EL#v*eSgf!ؔP;5d3ْo0BI`<*j֔mM|}8 o~.q'(+zQG?}jƘ"ɤ2Ļ䁾uXMd_#՝eQ9]k qa;+T}6El ,*oy_ϫ-'[%T05Rqe}׷j?_;σm$ȣKJ"u;^|+l1~lj&{/-nw;q,e?ea:4_9D{Ұ='2%se%Q\ByH5[7;vv:e 7beΒ^54@swօN }ny4L3;iZ8[C_lŗo[ zɁ0W(ؐjўΧ,| wËlӆr޿+,kͰbj kieDgchEHAx\|(ȺH:q?<3z%RȘa_3 §:a]E 3oAF\{6;l]$LWܾpsjPO3OA'$SVя0[u1==zTQjպՌK2iI+4C݋>F\6kQrMzt/њb$piIwFmkliDVQ= ؅a ˌAorŞ]`>1!ścuɷĽ͌&"n[$S\҇GZ!i7<-L[Ȋ@6 ]rb ?le ξE~!xj^YC$ޙOCUۇHv\[ez ,tsdn~dNWTBY5no!s:#0,vS5/ԟ[6 qĒj!\:z;Kٓe HQBcUŠ/}#@b$KnnYg{pS Fd#6!_7}_2y8#g59zo>O2T8FYͩ|ʓuаnz[rT\W7?*W'rfZJ ׵dtv:Dŗ^@[GK~O9s9J3/hХ]MOW%̒~o@>%$ލ49s~1!>FHĚ)*&x"wovd4g9ۄwDPI|d"M>5QXEh?,a:~Zm+z']&OG b21G6[p]I,X5[=hcʄ A\Hh^Y>~B)_:"TFainš!Q:z2*IT^$ a A4YQ/yPΒZ@c⡸'Z+20vcrgMjq>1uI%0HǷJrNL`[>{yuB f1R9*TM2ex-J^V:2Ez;bD&Ղ(n6p3qܘ"nN^= L1WݿLvY5<2ፅ5+Z1S\NW\CKD|]a˃( {sA.@9AݺU䧅@%|yC*4&Cr+پ $P}#,r榍027 |h&Ejs/+>+M9#iY}^a!:l}+ ~Y}Z:@f3-D <%Bn)yxS9qCDk.N.]c+녵4#y܅cϕ+Bj(zcqO:W2H3ܤX:Ψ-Bt6}V%R]% * j#ё?slcC1F ϩ_4$YBH5h_zdOE s E9Ov |57I7B.}޿}ꥑ&䢲5zZ*l'Yԧ}'ܢx{@KmT,ȓ7Mv=!Yhy2O 8iBy0ڮCEV{ <'ظte{opˆq^{?;BF#Edo}#=cP/ϴ;@nR!) @h,kDO$Xx8zGla#zz1WAkحwu>ش}YĺqrK; M9m%M-P]~4Ma(ԢALݯ-k)Kg>\ш7-dυ?;R'JRh9wXj-ggA͎PǶ6t,k"B)&0C vj;*:uΧ×R ȹsy $/3w7~Om\#-Ƿ" Q$'$KV#MRn8a..A)y mP3N,GA݃+gy}Rgdo*i;Qѥ TDlNŢ+y R$OhJS~s'W玑(tC^i~ VE~/',àK_κߖHxvR ͪY]ORf^4zt-xInw?ox-[ZF~aba{Zz`æ[|{{ $իZa/ݒ:TVr~؃-Xg[{ |$htl,>zwX^mMĝDWhR$H/3ەXڔVclgԾD箩w{y}RHP.Tnޢҏt%'$Be gK<ޝo7#7O_/?BkܽXqj"D H25CQ~z{8M2IsME)a֠"Ad9 Hx/fzaL&%jFՒU0F []H@&UuKLTZS h;B|xp/k=(DT 30ͣkN79F{xn'6nd0Pj(n/E/̢%K(y,(%O2! ށM01hjm}TZֶXuKd?o P2~8 o B"KԴjT"LܔՐn@CgO>W)yQN}l뱋/SZ34P&df(w_,Y8W-ޱ[KrBL/^@oO+7? :k+)4P=GVhr~ܪs9N3Q5v2Z.o|[Lߢu#rHeŮFniMMr":g4}ަGDSg`Dz Λ cB1>Y|2B_7DXr ~>Tp9KDy4$ѱ A*pߊ؞\]7M;'HCq<;Ob"f TG } ,U0WOɫd鍱َH;_]{FEUA@@Ջ)^?I5R5O>@|Hf. o3zלЀwksڢhhmC,F/ӂI7Gb@ `vàd8r}f?iQ`l}ȵ7$MPunz K||&EHPSR;r)i_x|6Qr.!l85=osɦFTKzoS6(q &>[-XkKGft#-Ff,`2Wl ؠi}zvIKY'P~3LV6!Ƣݪ:M:OG f7Uk.יrm*kB!T3f'vKZ$ijy'ױT_.Iͩ,”;&Jظbbn(R|aT85M<$lv %BuS=aЩ4\a]+FPg4ӵxP;=e@, Uc,]J- 4L~%q8y^ht8"z -۾gWFZ 1rZثy~$w{[-_j0SS%֮b᫑6ϓC[y"+Rл7:>D}/ÇR+GH~;X> /qmEgX )?a3:7 * (@C7M: Ep. EYcHMe*OImOhp8\GsβNnrP*AD-zw(*.^\Phݚ$T({ )wM tbof._ͩ;T߷ȶOrxGxT_Y!N&džJ.UG/[Oϖ kuqÕUmbϐwv"w ;=AV9[ Y}֋!xvV &nDzXQ[WA` 8d$f FGf.gvN-qjnkdY?rؚzX֢ΗI)U/!>ng>Ze1QG輦9^W(c2u"?7aңǪ 3sGRXycՁ\q Ϣ/`+ɽlޏޝj(`)%iiS }?u;=ǖwY T\ysN""?3O"ďnGs+$J_%꿭0OyCd{7LdpU& 68[zYJDJ+;D t)ӶP!;ԄbsFw\Zz/'śmZ|{q*YFKe>Q2r?mf x>RJmE@-g]͝V 4iTsᷭM~LdK#dNq̛_wˁ?-x#X^]^a x'3`g`+YiGsT)#}KMp -0r]^L~9Ih("E*|@)(ҧ?R='q#jľ^zG`0IlMaa6D QvfLH#5 vo~*h~ch{nHu')ZU޳[XTEFVNqr_]L1 _=X6Ǵ9k$0pNyQejV]UTq{Wm)&#=7.s%ZAw׆0в=0W}.pVijso=S̄`s ųW)r'G(!X,<(OLTR3 ͢825ȵt9DBl#W֢̄md랫ן}a|1~vt^Q5q6/ 9MC{7{/'%f !7 եD9b\ KcQ M u6bӛejknДtS`q!mzj2Dkve @j{+#Q8L~edR+/Ul&;#9Vdu99xP_gtF>lBO4~_6Hu:7)9AA > Pendstream endobj 254 0 obj << /Filter /FlateDecode /Length1 2282 /Length2 16293 /Length3 0 /Length 17635 >> stream xڌp  7vVlm^ъmml4Vcjilixbv?sd&Y׍BNB/d 269330D5YLL LL,p@g ;?,D͌dFor ; `ab!ȑ j 41AvfNp" {G[|PP9vٚ9MrFΖfoMl* PPY:;021:1-n@gK)௒FfGP:P;96@3;7;S3G[t,@c 6_"ldb7Ý6fqYgwg:_F6N7#W#ߩąFo[#ى hWѼYTdkkfW~@G3{0;\k;92L].fRڼ~,̜LLL3%_T=V2%~d0+hn b33h 06ft03鯟~{0SoG̨!%!@oU ^zvf33+7 '1^?Xb{U8uhc@ޢOSx $Kc}*)*2'_h@6r`!Z+>4)Cޞ3Q"9QFͭ,yf6(sR􌪜t v>Ud KdC|K%yvc'pwӫ`"qN;i'䤄l΍)(%q/i`5?8^i4x͆t'k|I>/ATw]Mțcӭx{ލG|F1F,RxZxmPCl 6Jچʃڥ%"0<"d8[\x 6qQٍ  L5JGc^Xh$:S4~:I*ap5j︱%r i' SXmӁ{e19$ k LNpm)jCښ*Ls%$.rh)mI5* Cō[eʾVƎFw)UP. EwqNO35*iɆynG ~.Y~hQ;{HķnmE$ji ƀ1\ǪOL7 nVu/@gR±DUC"'1/^%t}1=ןVS˙A(l_h5 }:qd|"nDlBhn]~Xb> :ȅ'?1f urټB=5~"ѿo (12klk_!!kA_-'IE {7zZ:B/Ieh4 "Kw$|++6( Kw?-_ߎs,j_R(Ιdv-K^H}#—yA] &Gt\,9ܼM>Wd#+nDz; }O91d&)b/iP=]1/ `X4@`ޑA .(fIf[ʇ⩭/;$~GB9"߄ٓg@)>B(xUOSYdENlYxȳmW;k\ (/޹Ԅ yK{I2dI8t~3kN}YXm?f_#>"6$WףK \ -M[agSg{Uih oO!{Qr4_塀gs` oFĹ[GzXPʌil_1J12 S]kw+N~XX-0o8yqvݤq3 W;TESǔZz`?tw6ݰT$T;m>^!u -[F_ۼ ýʤ,HfMV#!Y MpRJP5 eL_U0+JodU')Qc>k4f_i n2#Yed-}Kg8W&a/-܈/h!tkٍ,5Gu+*"l#$ޏgƲ mܫU>LI" y8zrְkS Ϗci3{{-rܱ5>:v)7Cǰ?:7HI`>[\%EW#(5pNɷ/?XiBi:A>9.Uןd>Иcf E$LB vos&_ru_G~ &F{|Iq)Ċ2of!UJ T[kh=OvzB 'w,_MX x!t[Y VWmDNMAb!:crI4=@=4}MR*}GUUpx?Al ;vB4ᛡ i+~V*|gʈ4WHDB6`-`MÀRDzyۍq)p>ÖXz[=^cLh 2B#o .n()`G},-}h뱄E&= FRPxjsg/~ɀęLp[Op^s$+?QyM5ћI7-& `<[tE0h=Ru@@g\w|i!gy@))\ȗY\)f4qt1߸ l3<LXgE?~ǘfIOZICFzk|QWVD JǢ~4Ċ÷U~c'}ksUr")rFyLF0t94J}kme"T~HYQȘj{Pـc~2 0ܙM;#YlNv7"@},aYsm;BZm0W&#nIfTڻp\rlG=y6^l]o3obI?_ml+kρ(-fyZYXIҧtvc!q5$[stm[bԿKnV.ÀqErqb|1b:hjNgT:~)4rq'rs }zg.%u~v'A|B))mH!E&@hiEL_*~_-uמ-W N0M}3F(1P[ ̫luw / 7=V[ l%Kk_Zbį tӮMUz7::W$Ѫ-H~=c v5Ia9йcNK2}<8D(;ü@dWCbyX8iT,6ES&4$dL F* $W: %O {-(+B2'#92_Iʻ0 .w~9\h^;mhϲ>,ڞZ)5m;I;%/G,?iV1{#nİygHb٬ly" 0σےLt8@1s-b\`:(3hH:(Q0mB%Ҍd"[>dyrq:{@>UJyLON#ѷ<ƇmTpp]e͓{[v32|c[.FJ&X\SvȒu {+[_B#tzLO:^#`xHǐ(Zy3h8nzg<%L[ne9k e$Хo`jz;jHpTz0hAH֒qN;b$!~J^BŃN$e[jM_c?j0&v ⥈hgv>DrՃc82{^OꇬjsVG %,L\5Cݻp=*WGގMVϸxC̆[c*Z7zNQemul0'>`v#.a[ĂqeH"QOب꼗t5.d[v`K^uWBO'2pmoѧg+K\Q V8uiM䑔zXQM}nfzPL^s/تwL,C58?WqFz2! kGk6 xi]}HO4tR?~͊1$1jcedC@ų,RGIs_!뎂8#A0.y]o~KT@ѱ.#LLDŽ@gJRC0/%l U4h)'& 4zRr%l;q OA [_`mLG9ߝc*APTGB 0Px^9u'}qPSַ/' ZqTm=o7<*ʲhiZjd0"&_`MXV-GBU`u^# &"_EIPgB|;`P+}fg*eppԴbZws4_B̻͂´[^pbWmR6;Wu3׬6_)Vk5ΰ*PYj:# mX>hwcc!>]Ph KWukؠ, 5ȹė0UnTǕ_A&i6J|k'+x'{ϱS=w#]J}}`uH|NJU#`"4068 z^JsRH2KkIaB8ڎd ~f` JrQiX%*B-͖GSφ+k}y8pllWÇYj<~C*3I7 hU3Gci!R0U2X1g)wВw'RR'uI'pz `ʝG0`zaY~J`7Ы"롥)Fے*ޭJa ^}뉨o{@#oa]j`ѓLU:rz$8i{T+mj{/Ig񹹃:Dquџr7d3gO>?Nc(9~{sMEۭn릲Dž77jO҅?MK-r߆·(L~H]u(:Le$X\:si'0k"[HRmvk5 8[%x;tu;ki9O wVl5Op|9e<K%08cߧrƯhߕanxJAPG ~;v5z0WdC50lɠ#硇e8c:wdILEChkȐ_%Wۘl1O{4D sdŎ˺ذ\FF-»0v? p{RacO b1 6HL h&v*OKS*7=du\3vz~W71bjt>jGZj%6u[v7ɲjye !@[[n׈C腋3r>k`6Z3:`OH}VR* EfsHvH-`tpjU_~CU^t%$EnI\{WY|kfls#4`+AJ)!'^#Xi{C:?[#m;n{T/ \n3VjiW*t|aU~tۊQ-iAK*+B 'wEs0ڪP(St2x駉`Fss/kAW>9; lnid'< /[ vpg4v8tRTuYfAZ-&ϥB%M f_11R#]U=e0616j,?ǁE)|Ga</(W[ e<"p`T!7QC$"ɿhCwA(QY8@Y%AgF |/;8L Y_<+~fvxjk)ږQaT5<}íx$:nYGv?0S s)`cTjc|E֐~NM k ݧL魚"{g= 5j\)1kJ$l'0p ǖEocdG׼wg \o҇*EaC(JLa8[:=,tC43Kp%ߟ:I:%P[gRu_s[F6X ͜?۶ڑhcV+!5h1yLL]N%A>gPB3y­w$q'Sf;=Æ_Y en vtcIgtAADRd۽YJWʹNH4G7 5bN> YBqT/Iw \rLܨV$TE(Њ;#$'ϞwE>SJ ֔5HN"i<\pJrcy>G㠘X.oٳ2W)Sa]z]Ӭ|Q됒:I`#`[+B:r Jߺ&:Q6UXu~4scXQl@B5U&冔[^Ha>ˣ{1|@[`Ik l"FK7|Ib{g\|vz(q'R?}%8>ی w[]]ιg-ù,ssب"$Ƶ(͠s?iX{:Zݔ["䊉)v'W̡ɛ~s'Y0`ӺiyOvx6V"|WY{Ǖp(RѭYoޕ8\_a mMSFzZkYM"|ذxl&BlEFJhi8!xu$E,5kB{g=UɝU|!b"QјۢO*i֟lhSAZv*r."|P2BE ;rKܻJ2X 8%(6' 5E(xxlgLN0܂?&Œ&4vXyהB5$ÿ$.D%w͸HY'iJy ,# Ornj%òg1Cl}OWWwX|rRZa7rh1w'yЏCs/U6|}υy$c.%Xœ /30h~kTNOvS!XoxE(^t.5=ɀtڳUI/7#Zܱ 7V[z M^ ZIWkKcj_%HxǎE9-S{rQ9yOY3G8A,' XxTϢ~/!E54Gspt+Zf*6\i֥˸<~Y׮|Y8qN_:"6QAd ,iPZp3#d PoeJ)g ݳE'.4N[]g̶sj7: =!)Mi`CՐ NɥFKK#G{מavw<<$"͋u7^Y:fagr4ufV1wh7?v,z]PM 179nG}TVz8~%f H9 Q6uHVhbIw돃 ݏMS6.qZ TJʈ OJ%^Tx[mPC&v2EfFwwÙiemŒ bk9iz+8^ΎiLy'"lT>j+xNJk.ʈ'-s?%L+DqjT-T6}\8q#2Ј<0o7ҩY0Pb?İhҭ_74g#p)KϞK|ݔ ,{c ܪrq"S ŨeO 䇄rfF[U:Ȋ%(,>& :J{$,EC -f4ދGB'D wqbS9 <·(ulZ_:?m1c;`dІkL)79!}"yt#QTje ;[P PϨāV42qHNÁp>a_Y׃bt"EI&{/nUkBKf VVnp:<;7C?+h [,]g ,1/$K ؐqMm%Ti"M9Scg2(mR)_DNn150k|/yWɢiQ_&È4g+d8*}m=hV/3V4a6<"Ί=_&Cg4)st"N^{0oJΔo/o9X=au8@uQHt ?Ӷ ٷVfMXcLq"wX&/ddmCI\ RB& vwɌs3;L7Qn6I^ ҇塰H-18C׃3Į<jq1C2?!LY'$Ld<=:Gsv XGrNH=# tҺZz%!I] +GToP$nJgq1W|_Ǡ!^NN$ |kO'㓻.*sj*IFZs9/;$÷5lASX\M_Ѕ1럅hZzu˻ >i|2T}(~KcC}XJ_kzxHԙ|6cqL ߃)yH 945!QG8Y}̒WDzN@ihϣQ~|PbA?k>`;zߢjv@Q:h8uHD,L{] #"d 禝:v;#R09D.e_/7fë5oGJAHq‘H^4gʛ8uΝۿ-4VS#PrmtjeȪBjQmqhSXm\*AAOB4 &Zm0Vd4OP 鹆X{*Jf[bSkYYի6:90 >MXXL ,o6\f6Sxq8%x z4O1DMoED{vMD=8?g-p9QIY<+y`Bv炞-)5!?J5Q UX;EtʒB1QZ 떘L/]~OM5sFZO#$/a/Zy4jM&O)"14_ҧ/ݔL3UVck[esC?a2ҙ>I"ĺhi1>ξ@9$WRoDIeop~1:pnb&.##y|ugй6'w@ӓ!Y>4G l֞bvv%!Οp8i|a ԾMrIL(},aVK>hĜdgP6YVp˲DϵV/,N~J xI0WJt-QfU`%;/^2]ďYδ`䒢0$馈~l YYH+L䬳 ۺH5 {LǧB磮5{o9+ r2֤xj Fn~Ni ^,(\ {(==`M)| `^Jh7eB3㨸0lz?;)Hd~܆0 QV#}5̒<%rc l-tӝ/t0r'OuԠu>|h&<>l=E`GaՕ~)yi r@LD|Rhr:UyoѪ J"-iJC+9<xk'E #NW1i<_`8_Qe*zae6v,%+mЏZ,K3*}2g6ޛOcȚJ=L{ƾVzD{eVj9^d<lؿ;<j'׆Rԍjà܏daM_<)Ee*GN",,[=P inݾ (-X)/̕R&y$PHk1خWFqn8flo<tm)*f8 Ii *xU8<~?'z3E OXI?C@cuJ*L@ l|~X=R&AmjS~RvOMC6Q2hGM+^6^ t-g3A}A=m7)os2Z`eN A}y WWSZӻ_h.4=!eOYsGdE^/^SS{/ukM>~ǘHqC+`5įP7?B\Q]ӟ34K!4wMm#mŃ`7LOL%/s?Ȉ1hCmrf f'lt|&9C2 Wfhv%vM)/rj?qeR'm0djdI|0"EǺ#fZ-M?{\&)j2}ݕ5I6AnWBYfBV)J%v2NWMgSͥiq&Y0,&̰}閅.];F/'O7bIћ*[yz.W&>ZFzR+8P60|OSs%cEQJ /ZC5|-F$r#Ufߏo8l["o<{ۦ/h$?Eal <[@wnDGU$4o~P̥)EjASPal*plx#JuWXoB]Ŝr| 1˶jSl{ˈZP:8Z(*~AQjl #rv2ҡ5vD.2,n=! @Z]c=rэ=h#aMb Ю.wb[ꕾ ZA*Lnrl8=dΙש8%$xj*70@6[Cf譫# wvШ˃b*^ې$DU,<ۻڵALW8­϶rT]),#FU >ϘVzXP%e )($bGAYd\{]0#a3±:|qt6cU hRP, _|Jf'Y)M?"[ g_\qjrJ6|q c"|=بv6+otljCa{a@#ӹ2endstream endobj 255 0 obj << /Filter /FlateDecode /Length1 1508 /Length2 7285 /Length3 0 /Length 8285 >> stream xڍWeT\%%f)abn%E[RD:;$/~k֚9gs}fu-.I3)LpsD*R/  03?;0Pp$B?8(&q gN60/, < _D$J qTϐ4 t%  rHPp(P8ZlowBlZH(lv"@ 7ցg-0f6@b 9nfsK.- lP6 aCnh)*`?8 ;ݟѿ!P(p#,p@MNՑA"BlgbzK]< 'gPсnK4-0F8꓁`ۓw} lGj;edݚpY HP`PKM~;̷}xy!淭3 ryy SO[3|`!{et33$Jjk*pn))+Ky gR?bHߞ_E;?\[l~߲W&9' (۸ɹհ< oT]c,1o#v*$ wP?]0uS@廝5sp.({[Yikx s{ٷN3o=mA/9f@_H|7!_@@!̈́VttA v ߺm/9\aPq$G2Ij~>o.R:jJfLH69'p9gRdE F}^Nfˡ;X꺼(KuI6kOn;a!xqK֗HK6(29Koʭ%/~*D/$Qol)n'P) F[d^Df3uUT ȍMQZ]myzԍ>uq$! Ũbp'YsE*&Elx v g ~*. * F Qm#(g>7xjLEzM8/ ߳tGux$hocPȏܛ.hP";X˱g&R1WlA>vKMth3)aziYͿKax/ºHrC/[Yo)XF^؂o+7&˼vgFxʣ|ܿГ{$T^"E<>#' ޙ Un:V蝕ivGT; "9 #A;5+5S.f.Odbx6n*]\~0Y:[20Lg61ǼS(\G|n:/z?C^}֗9YnL+Ma'DK"pHŻ>>y.j= UcKjx]ɦOlM &Ҙi 7&i^Zkvyv#~;30x'OyY}?0SIZK^9>y(?KԎzhJ:@҆D9Z=SqKwA=^b4*/Q&M+Taq$-GRe,egGwJ>U8 gHeDȨ͝ptxԚ#+#UTF*Sq8(jpaHpNTCCYqʫrL6!1qnBH8ez#=;t=x/@ Wyb*InK5ُ`I)B.{*!!3M95YsdZx}[L)ݽ6wJg^~T]L;z?3]!**W'aRnM7ɑXm'x]!HO0caA;^bϪ%C_TIk-eo*%-LցI9uXƵS>EL>}DDioB_V8_NDoA=n`ֽ;fd-%OЕ&C?ŵR)QԒ#0[0g%&]96?e1ZYiJEe#$Wݦp 9yP V[쾵xH̳ 2{wlI/QɋMi/!DVıq]mjo.i r{a:Ty񻼸WT\<%=2$۔UP'A8{zZeLenxw_wNAS%Uˆ & Tx c`5uͱ!ü/ooR &s1+CKQu\b|ڃ)xHthڨ{c]r^Z }$|߲Т~R#} 56οZ+rSK+eR#>cg|kPFKؘjjB6+Ig//K*e;qP, t纀zg2./6h=]2VL,E\(*!9V sOM;[m* =:P¹RP.GL/Qg^4v=2?#=Enxڅ^([a #MÄC!b->FE2$3t=n3A ӘQ̈́PG)|e y2Ox8Im_-dH=V2v"Gŧ1'[ۦ8*\~Ϣ¡,ض)5֕G}s! Y(A\*zmbޛIRiΙ?׃5"R@K/f 1'->L?lY}k}6_34*ݕRzҝP~ _x\ʔk*&*]8-mK3K$&Dee/,j(II˙lYr}œ;$蕏F`%/ܡ8 $r{ d(3IBez5=4gEЁK' ]Nw 18@]߫^&;qÃ-Y9i1?|X7=T|Y=ǣ>9N*wLJx!q⫢E*#|ߡ!IwrTN\HqͻqT6)h:\_b.+vi ݧ`g|?GLK+ kH/LSHqLNzՎRP)|-IJE \vÌ"=*գr}_TͰ-TŲv9--'{Ѻ|{WHNMJK…r^l'yI3@@k<'%<^>udgs{jUa$]LѰ$ܸs|j*%TRlO@w:X$(XXwUL:=i2o:ɐ,m_u}66㵡<,.ogJM9I!6z66*5mj prܵW驴1ޓ>ɺ@i_qOp6{o9^dLlo,=)ʹ(;=s W)j3ͱE_:UA#VV,}+俚XC;HAr*ș# {Vp2`WI%8]$݇rX A;PI+`c;&[iMҳbFۋtn㚮a[ GK'?np,y-It++O` ֛SM2b^ag?ҹixȚ%b49!E!5ئbJ_moO5pZnr -;zuF\>o]ݕXՑMX[\_ +1:Y{yaib^U ru '"{UPEba)`1Hg(`װǗBKl::( d Rbz6.rˊc#3(Au}4Z[Enq$y] K *ȼ<Y|(QY|EGUd!A5#|IGf}'ԙ={jDl 5g?< 5Or{Qfu蠛}`L{7t&[fw+i{8z^&Y Юf!1.GWқ-*j;|9WS]UED?GR~)8(ߴ SaԂ=3%悚A%ka{2{ٯ ;6pڿi痔3Q@xqY*x [*]zMPDE%aP\`|Q.Ȑl& ʬFq^Wu.t2K%9>JDSN?;;T縧}I 3g|"ΔK91 jbaj{9? &h8[` 9׭5LS2Ju}!6%Ѝ" zEa KIN] (Pڞ@3u"Q'Gd̒ƞj*Y&p/HQ~qF&+<#{k5AAܦO>ERg3Z9NĆWH]^##QP}8덅Ye5˞_B&_# :O4Ӣ^x *s&Э0Ͱq#D:"gMTNsLMq,\G*(2ɅO,8X>4ԇ NF&{:)ccˇLeClnȯ'I s GhDs}O}ɡiiS&YZ*q*2bן۽l0+ ]f8Ē hɛ(|O ru')Wq<Ư+3QeG|ѥffWO d[/hTۏU<)7r[ȢzMOYO=s6Gj;es+gҋJ7t"NI~@]7y $j}}烝^e=}-݅=AV `.!κeIJ]A]™g.Q. % ߈xRdq;uFCq.dfhϩNXW†]Tڅs>0CL.ffŵ;z_!wz6I*MWx՚|&݃7C fifZ_0fﰟ 20IV]'~"Aw0a$>G7=+)JvO$j %~ŧTGv`>;,7 )#xnyoVэm%Mx5VcEijBƠ{F.L!@!"iZ6#5Η܇ v?᭹t`lfW7DZ/)Gs9:F`v،ӫ|_,JsU_a1Aot9GLk: JGA;V2 ^f4@ 5^_0s@4oH< 㪬Z₣ҒT3-(YTkV ;IP|N$~v7vlR+ *5aI5#c^q\|#0è42ۄOfX/Vendstream endobj 256 0 obj << /Filter /FlateDecode /Length1 1466 /Length2 6493 /Length3 0 /Length 7487 >> stream xڍt4]׶.K Mc0 cQނ AH(KI<>}^ﳯk>,zvH[ ڪf ٍhvbvDHCm*5Qt 1)%&"QR-D<ٕn(#z\PnHRR;@C!6s q"p!dh7)AAooo 0 fU2@ S1;`G{CP0!<]<v0zw@ p п Bn/jZh4Ex !^ ;u@MQO}P !wU0ǬSFh_Q0 i3#a&h{4UpM9Q@m` ~k!e1Q\@;8 9~m? ^zVo h=PWS@%%/$@""qq!@?AgM= Ww^DgB. o[E.?*3RtqsEp+Z1F^⿩fWftoT E˿Pǿ׬0=]ov=?RE4!Q1_z% '[A}./`Dꩰ@@Jp__wIH=<]]ߊvp7Ah7򏤡ºA'P0ڰՊwWe?scQ?S2CQNJ)]3K\G /0uMOϭ4O~(T|HtHa$>{^>>zJ\_{pt?8*x=6kxrGʜWl a,O'fˍ<:1X3Q(ާ))+gwR<6 F;{fr@߇,*R!&{߽s6+k= aena*'u7[?ɢ+-݇Q,:#~KLMWق[sSgߡU0U,YŴ͸7#]FeQ(.`^PT.<^ y_$lSb㕬}#׬6{o^"qo|/zbGD5Gk9htsYzȵ+M3(czk6CNTB9 w^ߧEд4?)}_pxjP(: + lZzUBQoli'TwC[,i4j_k'9J M,VsX/g[rw>!gMg0ڶ9(GfF0y8w^Z=>Iݝi! r£/;r~rW[oIfzU}ndTج~k[Or'njdRÛ. gHׯ"7 UTo[&(>LpqLg&xkE`Hݾzt2kWW+ I;8rMCw$/g;dBV"e>cGexYcǔ =g[$smX^Q;iGc̞& cF,{)2Gzʼn+Ϻ6^1iTrb[IxuU%\7l+𸖅uW* <t:pQ\ w?a&Ù$m[7F%mwf137QʓBЯ=}E=L8+t^ #%Maԅ7ۄ:|{[z s|)e Дd>oB œbp{IWB~*3VSG[ /3-k:(1۸\BP/GnW_u=١Yǐi?M|d}|f=V2kԮk==(Q,M?N\;|xAx"^StF׶*x-Exp } 71!~V3M0R hf:&S"nqC@Y{Wˬ]%ы~q]x΁nA:W,\2sruo4hA:1,+7>?zc?K%|WgHHmS:;)iMx Yq4%Ewi\\+G&QZ '0`&|gq԰Y+@3ݻY,IE0ʊ@L(:U^R&Xe*3?!z![{cܰN\}QHǪ0 ^E JT/͘g60Q]q<Sʞ̌Bsf,/8MvZ[j}E͚;˲BN/6Hk( ]xIb:wM)8zZU9͖W+ ,yʆtH] R87xo6Ӟ$Sc2Ōg^S_ˣ/-.n(ՂC|LψD1QbQIYd~.e15aՈ[Xa&|^Ub3=_ ةFǾns)Kwf-x"LU10?),sMKMJ[l$ F;LM*2-9\Qbiv 8OH!㎪blaͰԠ8wĬr-,+d1>iHL2"{3q4A^v$&sCԈ#ږ&S Wq:t1 }۫wrz5f\ukM߸wC3dDͰ!ݹ rd.^&<y48As9|'0gN>\jIsRT àwOnGw0HS/^5}Wcje\~@dZBfy]Xvvȧ*/-kr̈m IaDրIKc6OjTʨʃcWz4NZٵ7"9uˮ-Ի#e M5U.H.]s`|xHAFxw;9Q Xjnq Ò){UD.s0U Xu{w~c7ZyǛG8lwN?jܨx. 6ɌD_XLg>zJ%:>"n4d.D +5݂+ u?:IRzf8a?j|OY#J1NH^54A}O+"2t_6N-6qhECP T rhRxvEL_ HY{665/-zLVÇwC%%s)2 ł"byKx:X#clr9bkoj\˶Y5ow9d ֹrK S!&Q*`*2c F"; zg'wPjT #ȥvVouߺk1U._GcdLstTa|`Y$ë'6 6LF)["Y8Ga HmJgx_1,ΑS8/6 5t)'Rw! ^_(~ѹO8{>:ؗʫ所fa ob$9ӰqoTS{y5Lö#Bo*} fh6ޜ:ވ%##_r(sә)QwԽ2rة֎3*CFI|hm?5ܶTwQ޶1's~7Soۍ:i O"mߧ-#fPE^I>i#{:2a (%KkQ |9.o\T&',$ Zf/p"kY.s h +`1x f$k,;\Z|Gސ{ư<*bQ˶U@e*( |\4^eE[\=vCoDRq.Oێ"> ΍c_Lq}Mmvq5)rd$rT'hvȺXY^wC=[lHrUҹʑ6q߀:Ng cS} ׍%oZHy4~M?'-ժg*W mŋ_7qnD"NKN^M#>Ieql~LQ{΅R)>Ix>;ZwcĭF>Mc30৐b7bo7ϦOWylWVg9Gp^^Yo[0h io*d@JEXav*Zٽ$8ѴLJEuE=)?ծzƋIƬl5o5~P N_j2Z7*&`D"7FHݛ EW&eg?4mϴxywk9#k u+ /}jq}R$OiBJx d޳}ĚYChxd e:<7SOtw1Co+n3پS+@h#l+:3p嫬[7#O4C ]Ҏ(l|NQ<rsZy6զo~P*+QB1c ^oℯ`W ;'aCsRwƪtj.Kl?:\_LۺuQςV ԚF9"3X^g.`X˳mYJ4IPygg +|mc5=m!Kϑv sCR[/  'U;1%N5i)Q֏W6d-t3vyK/l65DIg2E9x>Y6ʧQ6FIrs[(`a;*7!S+ -C_1*V'τl hQ@U!K$2)Çxd^LBl^%<~K!YhUJq{'1F+h;纊 û3ݻD~ 2_=$ $ʑ`q*w2SVR Kqq9l1J3s]9_@򖉝3nm WJb[;Tc{!AObw^PoѮՉV.]U zgm[H0=2D?7-nNosPۢXtNR_UM6 $eZB}Ⱥ(6e&GLI'%H†L=ݛӼeyCH*j5s_+LQ?F'z'H[bs +?^1["EZ.w@L G2%G؊gy d&94^IMw\HyR)(@ꮤ=Gt޴qkv0򆄩ψ_&ʒڮmx+51J;bƋeXdB Yú˳fgC&xMX^r#1reYZ6NjӹֲUc+ o>Y%Wu/BMPߛQV֖CGe$΀O 5K_'hFYG4W_Su}]"`XaI^ j6ʱ0 kdmB٤?q C2+vM70`BcI\O'D.{*07;vr|YW(T=,4v2483Vi]6cxKC62a.tURYꭉU}8ÐS7/275[F |kxݩTݲ8l %F \zvGS6vbR$i24D6Tx/n(lqj(fPsOyzgp֌"Rbdml _]2cm">W[ӣNM&2:bP1׍:gpQě~ n-гJQEcqfR5'rײ1h5،ֿg7ߍ~%=N|'eH++~WC[V+Sa= ą1ohg'ek1PW$:Zu2P ܣciͨ#v'D^Pܓ7F- !os!/ 峔~P/8]arvh3Ⱥ1_X&gu{IQvAD6<5L39oJdhTW$p&BEpϥP"4y_R]LYρs;eL> stream xڍT6Lq-R8Hww/^,8ww+NKqwkťh"Z{νyfg.5sFrpDr*<  23AW,/+Ƀ@ 3@##(#$ xA 0WQ< j œ!\f9jk%Պ #"";@ ;4H;V`G. AzWVq;$. s0W[I6N;iЁ nk`'_q2절? 0;W8B Έ{W]u'XO'xy/߁8`Np'`uչHN7숀PG=Em¿CXBH7F0mVp99AC]!V}u0wg%2_P0*t$@$,', Vvy!y~k2 P7 ]_B|mo ` B,!Pg߫!6 gez0k??a,W1<\|.^/ _wg`_yWw;gHׄ;&잺?L7 xG23R|Ov:zKh?gWb }V$~dm) SE(B= ϠH+?i^9B!`+ Y9_#{ni#GA!Cy(8[O Ľ?{Is?? r;Ð.}60W-$V) G@# Qӿ 5_}TDA?"&`'K ~?(!>~G0_Ɂ@z!W^77o X~YWPsmc?-2F)L&ΞW+Uˣhfߥ)r4w^G_EeKo?{w`:,a3Ja,[>gQD8Rֶ}̄>Ok{>'( kvvWdӈl8x).h-$"M3xn{q/ULHbAy~*׹ov3I-IZ-jڭ2&w Y$D%/ʦnFZ GkL:Cd@?,U|uP QX~b<ʩ(q[÷#&iu*y6ێMPA?S֐iC^ctv=7 "ωܠ No :;eY]cHV|2/x2jܝVO}jG~/-g.ZtU;OjB!Id-v #K6T7v7imk7o.dcbxÆZ!8,[*,CrfNҘTO}` o}|N(|!^{Zl!_̚P(ڥ)Z¬*/"e>IKOe˨Kd|,A"|ǦQuC)QWoPc+tg<H"bgr-:Fm0CUxGOww=-6flaYR*z^Aؾ{Ԫ(n]xѺEKjop^rsyAP!Cdͥo7D2[u0$وz^-ՠV"n8׭!+ޒ1wrN (so>cv$Xfo~JC퀡Ff+] Rp|(Mml_ -nmI9.k=؄D;ͣ×E_02Giok_ hxD=(n4s~geBY&j<bXkjI~rhsZeg^YKgG T| nܥ"oW>?mgƣ U TEc}:&:K'.=lSݏF])I%)k%Rn}QskuMS)L庅;{, 0ҚZ7ņ [{PD ,ƬQ!oF)b\Q"[͏+C'm QJrK^^b,U''K.f>p-(' 0_DդL xxOoDbZoHTz}֛Uk4l᳸q˻;kfrdąH߮z=+!% W\WػhfۊK>AkEѴ9H.XJ'U@Xр.W7}ohuQ{6򬩁#y_ 1c=_c]r.aW)B+iqp+$#u#εpgeXO]Y04D39RdMX>FyQwRQj|Ƴh&8}w{2Z,R-it Dl-5T:ʯnچp5 r*ΝiVapַ9?4|y| g"%gR(MTTqBa[~TćQ\ـf92=n2DEr:OH+@0$kVfy͡*#l9p.0{|tǝMKu"j߾jMTo} |Da\_XʁVñ ;ldsNA\QKG*Y&_?~vY%Z?Kʶ%ìy7bq >r,ɣ'bbN9GLCDzoP11R86)As\b%@t8lvЍuD{ Pt2`7Ͳ%E(|RImzMZ$!f"K3A zJL_,Kaj#$ ֦gmK`뺃7S쇚 _OGs[ڊq 9pPĦBtUk2يk]h.+d9dkbݴX灹`_'m_ 2^ o|ND4yL,q?jD)N(upLQKfڑƓ;[b˅aکMh2oeHGcW})-ʳcv.$Og p R<4%i Ὄ= {mG3q|n/ѩKLV 9o! ~8Sb费f;r? .v缰bM]i"k-AwBJ-E /d%DN~ R0e7 &\ڹ0CŶOqX)݂WGqPyc<Ց. #UeDE=MgM.NR9ܟ/OżONZBs?Ľ,8&Zt]^xb 164KкxŻHYHPqgS;hƳE_'a-IPu٧`Ϧ :X&v:b{4#2P3jFŐK\Ywi߾mP,8Ƞ?_ܫz&ZhS̺p# vWav RH{;9 uW^\ξwr/qJ6T)铦@U?u+ wЌ\ljV5ĢkE!iK+bW&V2I8O/<Çdt%.6ըX8" ]Mxq碁pNoF.A ywg2xI}xv8@᭥6шNBsNbXhyF_-jzAeT9)pN9 V$xI==*'oU,~~L~Φq#0=oWˆ*L4j\- XSmVQL.w<گ簬igѱе }ՁLN@aպc91($LN_ͤqpSJYʓUDiݼKUR=Lx636өEǶ2AIE--nÈ'|O.#jRKd#Tw"oӌS<}>F[\rvTT ycO/]XNo-w>l*+=P0܏V}7(#Ͳ)ݱGm*ڝ !'ӓ5u4۩^5yGSjsgN.჌洚L?! ZQx&)ӸJz]  /Y)Jb! z ~kfm^B%PYDVܲG6-MV# ,Bi&sky0y$z|'{2|VXM|T0 ;zcsd*:iqVu=%L.Pu~P=E(=#f[ZԠn-E }7c)*_H}2%<,?}K2R`w-G+swO'ë>%J& ŒjY^J >{K'U}g @]A  f,~Khf:OH3{H\ PbQB;3bﶙ_FuFE!./jIS%1Vlvnd~J>$`;@دr xy),v3K~T8e.ǔ‘rbϢh"m&Hly(bf6T,R0ZGsK)$엢a^S!pg4n9aK:SuPy^G$kV:u+GYII8Dt?aGAK/Θ ]ƾ ?㜛&ɓ_M-J^ 3$ЍΖJ غc)#T2/M\|[ck&Q$7d![:h@] '9g{9Vht:.~dTDS972I欎NvGE !d1eGl V-N[9.r;+~X%@TEcAxީ۰neMOw~( y\?.:B2lToq)\TVn#? LhJlwpAݾ_MgZ!O7Gә\mɐv[xF#(GғO'{VwT,VD3dvfP|XLn0)pR ɂ@x::1c^_rJ1 ~0pI>_ZΤ?t0`CbaR[7äΕͪ .hA5r *~Ek쌃j<}2}Sd}͐I=&:QrVZ|߻ t$ͪ5t06:meB.DH,0G-L{ŀQ?α=+KHD@-8P!ۤ74Li/8c5('*dy o(lK|;BnqsuN23ü9w%Tt֟Z U& ve})7a|3J̩ Y>2G ȬB\| B_y0 Lk=W0Bf%rqpXmdI.(/eb>{][I#v9vq3E^ޝƝUM&ޤ"!\Ewiua-1ϘhCLw8c؇<aΚCxa [y̢~Z@_d'ٕ5I;i(!ZaHd4Y^; K=Ǡ_b_U[?ur\)kcy^mZG[BtMbv&!wv.!ZW&5ڌLNI(qQmHl_7mHfmuYɕhicِV! *V iDΗ[K$T #Fݪ[#M -FNYvb*1y,#_GmtVC?$L"ۡW Hj4@>jFh{뢗LGwA.tqz>Ǘ9>O-iG1shqCR?BXk>Ӝ܅#1_ p0'$}8;->2KC|zn;3m E/? vb<5Xl.E}nvmEB>6GEjܯ_h,Ҩ毲VhZd#?;ʿxٷQ]]ΝuJ̈F:۱"$塳`YGاZ" _Eﱈ8{T2SllˌF~clDX!@ 5rs2Ui!B3% ܊>vi܆&lsdQƿJeXV_,;{|lf3H*`5~VͥNCKʹaO"Zڧ\l31_[w*GTdD4ț=i )4'B5QggCXC>K}>^gʨ0ezW|ʅl-q.)5Y))iuf,>P>yB! * {70`W]ol?)_̀OOmTS*VH 5߾kp <xP" dj>|v3!,oz|%"KE!+;ź)7/E7 k%oI.2Ocr/?+hOk)H i#4}NXTt+9mZvfLt)ҏnBHӤ_9g^!_Mw#ǦZY[᛭y H@(Z2+aXo/̉S?un_W0cZ>=(yv>w[7~i#)[OTQlE|$W@N+& ]nF Xi|j4juf}5W %2@8>әدvV 0=ݟ>Bӷp{|4p;J7;S!zdG RW &\ Y^endstream endobj 258 0 obj << /Filter /FlateDecode /Length1 1445 /Length2 7106 /Length3 0 /Length 8093 >> stream xڍvT6!R*t 0C) 53t7"HI7tw H47{{k}ߚf}5ڜ0s qEҪB adԱE8@r0A\0] `'F q0(@D@"@ "ZTJ0(( stA b rNH:B\l-P*aqDhvh,l!`A Dݹp.3V-C\ _?q0tll0+;@:l- P82j q 7h+ԝ ?`?_gq]_l0G'0j uTj vÐ`7 9 ' #k<u5"2SZJ!PW2. {rY{(ae 5.(g ABB3aawˍ B񵵂 p`7 ?-`ikCm8WG!Vlz^>^#e :x }J &wLJ p D.|YFlWsV0]9e:X,C`F@~ UX ɹ:8?a_$k]H:79jU!UDJZ# l=  ?5[(D !fa|@Hb H!~_/?Z, _vq{ iAHZB<~S!)̾+ ίkp+r@@iovGK..Ȟ3 YU4]TJRsa\p`!:eL3Kf;@r&v-jR'k45|g4r[4毧P'xSMգ G7YEn򏥉UshHqzsHn1_ڼ%Y` HoJΚ [ hn#9X[smidIy_|/eRna<28{ J?Niѵ =ռPI>4v,IhA -Z)䒄-(EsMq8^=q*۽6qӃ3hڢJ;Pt`|Z<!oI6DsGa Y=*Ӳے>N"WI?ug_*xO|#sƻitܫJofaU6-S[ti`oi"[\Y,D&xmP=Qy?߮( 9s\YxEkNk#y'b3'~PEٰ>"8 NBS9؈XoU/6OhnY/-+9ԥCqa- S{uxB.ܪJǡxGeݹuUheZYajz ICjB''!kS9}/ǵd"u~8OeNKͻ110wgKj^y2* dq'U z,E6۹Xɔ WʢPxeJ-^7%ʂ^DZέ_(U }y{mHQݚ$X'BDaE/gcMynmi^uGV;?rE|ʚYF-~[|_S.]˗F ) 8_~HoDv6WKfߣtV=੽ O.XvHY@eZqMo7q)Zl":bM7ٱqϔK]Y{h—㷺cow_V:C>Ln+LLXR0 .a@E,/&p5sBtqe Jhjݴ|-\RY rxtBԋ;R=4ވS\cR\-HbKeM7 J'^p~o^koQŏB:UQk.yJrH9YZYR޴q3OǨOSiLKO=>:JxN3;nCaL4jwG`akaƅҧv=ȤnaF֋^BlļhS];-U{-IDӫEBMrmJ}K&̣=:QZ E}|5NCk9OQ!TGǎOr=8Ykz %tߧg+q{8.,)hfyXY~Acf+ tsṊ&Z a[ ì׸!>-48`A䥱7,NXL5&f̋9HN%EIxsHxsg̎%MOIЛԋ'`leOx:3h߁}:XJ\. |p_18c'!s [;klMe6#F!#tv>wdP;N[[X:+IvK1a_Ԛ MӛDx-M&ЍߍY č>h=,riM~NWavR>F{l(};GЏ8ר偃%sWEV\/K1m,BOdc b0o|y[ :T ŽЬ',2R4k_p-#{X]Cio ##cS9'"% =xKs]dq^Tݖtxr> W z9D~yGtH ǒ͋R,Ռ`a&#i/fKd2Q<3Ln:_i}&͑WY%4h6\Ηka偨RoE~S)bc[V\#hҧ_4` 0ml49߫^&}~c+XZ}l<ė3-a;J9GB`Ҡ$?¥%l7^L$cK &y ^gpE>ҭfxkRm*~+:ѭO{]_D2C{,ˍ\s_'T =w[jO %= v(?f+v Fr 6}k.6f/QW423T Ǚ.4`JH\pU!)m5nP͗]MA2"]}u?ah9Ya`LR[ <0Qpfh'a[$ʠ ;XNɔȫD֥-XbՏU] ;aIbvkWwӟ| V;g+{/{A~)-a ȗ-f-G7aIWؽԍa@;S+ѪʹkK$(c nMز_LX?9?I?,feJ"6tˑH>Yȍ̯97CRW7H9"36bJGQdox,t&odB]8֛rDn.VJglEA݃82LƏ+QE?ĩwh 7# ͋O'b$q7q:v2L^^Yf  {?b/0'r?{&a,h:V=A>eE~R~e{ɽxǺ0jXTsfs䅅L{W =5|vDugt;iR&m,щ cx$ m [ @՚F)5Ky!Ο/S7b~=2)*^ҳWўҲ?ΌxU*hnXF'RYÍχDO<_ xtqJȖ(4`2kyCX5*Z6Y^{QN Eogff:xov0SU!I5h'Ɔ& =Tt7l 8 F*}IO'Q"p и<F_\Oat%ؕmV#S3[~a.r *)ꝓ!51^k:foS%j%tƉ.9}"F=I}Ӣqvnm +?j"ÅLRvP8sGm$`]T렱hcrRB}o9p# eFQTha@>zO6]kF:j)prB I 4\H(0z^JCy,,(X0^;]74S`pMHoYFdlR/ѤFҿ`F>͗.})%͡Z%NLZ/LCku.?[6\"s_->L_e$J*Ǔ>)Ӎ' Xo7P):6 $mDJh&Ԑ% >1zX^* &: =Q|5:Vmx;1{|tYAg%~d+EsS}oIʃ:%' ( \;C\t0fhw?Ft1y9*.K!;/&V]Fc~fέOMQe+Ai*@ =jŚ0״\esd8 ;,]>)Q%7Qy:YUw7li 3 1㹅{'%atgDg6QL32{nmqzv2u" :$OڣbEN=V cU_/50/xg23BW|9$rzvDE #Rkq}鱽E-şnmKvit,[^t^_)nlQQuRE~ę;6UcU+MV InӟQMfJvàwWK>A'""75 DW*@ YN3#;]S-?߭¼:%qV| y$#\\l::&5 ԺF"rygVMp\ܤ}EqEEc !wL5g!9wmfvmxP5O2sYtJ'ER=oaL(thƾԄd\_hиZs5r'#@9npx;%ղnbjΘ"2WY98L~~p59k:qʶ!a墍T{dWwo{c30 0haC#; -X'? oS8WSj M4:1=hرI꾕cy|~)jgOFS衶/VSZ>h^oB@J#cQ3fٚ BˌN#O%gʯabYJD<+C̪-AeR_.zLPf3 Ԇx"31[ꓗoTqmFg=>w]Dܠ/=5/͊n7@7]cHZX`_ܰh*u&f:j#YwrIm%TC[*nW*k9Ա/nhMJT9;xA 1,bDY)N3uo^G>TP",cOzp6?翆endstream endobj 259 0 obj << /Filter /FlateDecode /Length1 2729 /Length2 23510 /Length3 0 /Length 25050 >> stream xڌP #:wwwwgpw A;4kpNd-`Vw?^* Pޕ *`bbe`bbPrm:X9#@h 2nfV33'<1cw+3<@G!lea Ԧ4fnn9:[]-vMmV@Wtuuad`0sappr]@3 v*cYZeWu0w0v@[+S 脛*-Pt,W߽030/ߧ'acSS;Gc{/+{ -(!`lo;t ae1s1urtuap]"4.ۛ:]]~rdm<}Vf濋0ssdTrrJ2Y]LLLܬij;#?NfP~>sP@?+s ;`fe 0ZX2 ;[yt@c0'}mgbjtU?' @`-2NQ2?Jۛ;b j-꿗\  Dd Y9Oῳp? Ѻ@7TͬWk'L/eWeV@%ߏ=h4Z-SУ$fW`l2|Ah #Py~sg`0 68"'Q0A q2% f`XQq@\ ?EqQqQ@\ ?EqQ@\ ?EqXA>c;Gк~/d5@ MMm;rM mS+gS7;s[Шkfa` -lA?~-fw3+3p 0tibG8OP@P? oh X06I;,Ach3ʴu?JuOfvQ{*aA8q9+ $6+?Ce5;? 43lG{̿G0 ; JetxAI\ T*ϵ 35@9A3u1A=AAMCUzX9f)hc-9X׆矦LYtnw{Dz:mq%a- ʭOφq*Sp XujB{/NA629Nn\HJy}ueˣv9d~GGPdBТ]x"NeODl|y^Pcq%!A9H))\Xl+$FBp^mi[>B?PSڈaLYjZj$<0Ym6N&XYAԶ<lywZr?8Y,/H`L+n̓N U:ѥ @8/G<&&.^Q3__*.:6fPm=߂9L:/. p-Yō2>Q禋w]R61^lTb1zo/$/dݝepQ˞LsI?v4$}kvu[^.bypQ.2eS3$sJ`vbp$Dl/ ٩;]c XWѳLJ2i1 E~C0E^oBXoYj2PVPd-C7jzWU#9McjǶR  iGI2vOjѴ!\DP>3\?}'B C`D PPJ&WH6e)H_WqZίץ N.&~;5d`9~ZU5\b vnVva IyGHmY*ژ_*J$!<5TH2 P}2`2e`>б5pdA]dzsR W#H1T}߂Ǔ᧌e13¤ڝ7>,d [^儬W44|.8k$xřto8Syu^ l #Y֍)M] * ^ʵvj hߔBo卫>i-{ c@lg0:Fn1j(lP2+ցBnX4"Z"bֆՇ6.9OzBj&O)qA_lm-3L~VF4&|y0fSf6(r(l*-Ļ؜湘}IGy__3G 卫>0,]A#R^\Z2Axޖ щv2ڮ$B 6&k=GXFr0>h[r+-{yl )vog._1z.u!iS[KF\n.1L|aHDE#}Ma4t1ao8Z(OVϤS9vCkBEGmO:xdKNg>>ULiX+]5E} f>W 8 w.i9 c==l[ÊXLwďgƺ<Bs0}k>.Kah\/^=oJNB3'+s9 pʴ\50BE|.T*[5 CBέρAhUEcՀ>|hsY)ק"b@"blyYg3S._\n}l<=J'FЍ\5ijc1JM9efrh}QW6؀YEm_B I('+A=0ۮ PrIɂPkX YX1FD&OKdE.8}߻Wl;>Lt}Px^ gLgy]85x 沲ėD5,,X'| W[9Q>^2S| IofQU.|%^"0*m`1k"h1Bz<gǨxV~^7ԉ1>Bեq6ȷa]OsPSw\0" U z_E~Ah:%v<5՗P%坭v h0{L9@;tNJ|P,B*ЫQP$T9Z8WxսTWAj9f,!h̰PAc 5EOj>\GIsR^>Z 3s{S&Q agwt0zo$V|`X 4qjʭ3ϰİl74t&9a słp.4U?0fx6̬ W0-; f8 7 BJrlV*OA=t.]|C?֫Gڵ]³֙5.$? BpfHw~ꚪzq K {Y:Uc-66.9]9^weO[ǥeAS[SUvOueYs}ujm;&0Ե(̈P ^mBOɼfҢFA~ppoȣ/lxcA󫚅JcUeT}X}+u?GY&8Nw4k%ӆD>oebSn߃4$>=?H4cV1BfhuD0cÏCU_p+sMYQPAE8NѡESl`Od>@ {_jEuet.jOIQ =x`3.%Bf2G//h(BO6̮3~/pF)Ve]HX}__#ɪ7÷D 2dZD .fGnz#ն l4; ݣS thGXW jMg괾^/j6PzRl k[CiͳgЙC=mF}.Yqp8n6&CUm"s4S-encx_Uo#$i1-N6țvP˲D t߂V' REa"SNpysJ*{뙿?H ~L+V-F6D䶻!W<:B_V_#=rrnӲ=5zn8*v.BS͚xGrX[κ2: Xq~K ߿SsEVu3s-PZ Ilp3h-2( !,M&{(F@^~B|,e=J#Ęi6/“)hQމCS  o?1ɣ.HY&i0=V|F_O[M7%\é2b j2~ZV=[1Zf[ X>۫ v쩤Rӥ^* DJ3 ^h1J{h*bz!ql鑒WSk^^ S.ΐƬbTܗP\Ws1 ='̀V̖Gkj[.̱k[ɝYeӐrj)LڔcVf(k7hN)nLИO8Pi@=1ʕ#KfkOJ8&$s0,g<@&v!=+KTgg7aQ]ω(}5λ]npVZvt9iבn\3U 1Q)|RO ^DEv#SL Xς}R-G(av7 ʒw%BI&DnYs6u*} uE`EĆ^|`mvhL>=JDoBM{搽AfILwd$2֋9q&un#HLTx|'6Ɖ^=۲X &Py $*ܘi_ҁX}4/Aob8a=]p{^#ķz=0s/{>)gԍ1uG-YڋR;CXADh8(9WjA3ŀkG޷l{v25j=8'B)HlфGju6O52:T}68 vz/Ec!]6> lO-% _atAI $ʔ1K~<+~:SUgK.O~YR_f(%p dIy-(]SD"T}æa[uҬWlŢH%Wʕi73s`),>6Qͻn-{59)^|H 5R Tg՛`_DS0*7'vvŽY&=ةʞ'.Xj&d3{lMRn,ڳJ9鼫YNFq K!C5 jYo"g#KHitrtB-#fg"=3fǣsو6:"ƭPsZP#3A M=f [qI%z1F1EH]ķ3 `\~~]6:i3{D)P_}S\T!-u+r-|\=XmqyxFg֜ t'7tj4"HSy^0".4ޗiu1/b7 -!gf黥d[^r֡CmQVE"4?NCůy C,6΅a3scTS4a3'յƫ25[RT;ȼXga[  %dxY9d_Rc{Q 9:օ`pyH>sSLuH%6jG-o5[Mr}%+i@놮CAVtGce$b?GV-H%k'񬐚쌡oaK6%U étj>\&J+Ӗ?N5I÷z֓Mfek9]Z2j*;_6$6'Kt O@:ZeGpw cX@f߁r.).ZPWNT#}Z^Q q#,gl;ݾuz1n4_(СSZ_( f}-l9̑&>ׇC$Mn3MjǣUpZvDhGvaa޶$!OP $zv&uaSj*j3kC$ CdO:>D^{"SW(ީLweH` a5I(X^;x9` E LXww| !7.W x d13goIKD(YT$%߅A], UkΈIly E>[N}Ø%7[n8Нv gKE¼߯*! Bu6` 73Y෫:~I⨻%cM"ŠK410d"̐9?9q"69OJs0.9c{49vRGsX]oV+0XnUL+m+h;8 fyAj{Wxf2ǔ{߹ڤ31N鹿{":2X^i}ƒk._A@"o^:.o"^†l6D$ DN?[Nz6/oQY1;؜49N$U6B^GI3#^gqzh`RhT1~OՄ9 h#ږIo:L/"I;b BȂzJ<$؟F*4Жlmo!HwofLkP4 C]B^+4S.m<>i]W%5Orۺ뚡Z_g|۟m>J/J:3v[`IJLSd}Wty__;Z㜈PJ\5rRTL,B(?Z%0VFdL=Y+W&NM?"2QSp}ɧ Thl.$YiMzkBv@?x\g$KuB 3:8+L=C(?we seƙ_G+{)ޅ/x2! -pcKʁ,|K%Rfw0٫4)ϟ7e;ީ__:k0ݪ[ m خYQ̔*Sw}FriF׸_ U Eꈿ \S_;@[=K%a"2`{7oY䚔;͟2+Vl4 U%_+kDElM ]yo+ ~ےgaR.ƒ4rXn@(i1}ufi Zc D[ qQ=bȜ ~]Hܹ;`9ʏ_ P W8;GYKsKvfcϟ PY\slZ _Gs81=.J*(ɾsP{ 8`_Z֗,-*hb-{ĭr`uPk'"c.;~M6AڼFKk0w'=+,F _ )p?1dNȔk})0}3u9M[[Qi ~zI n&}vVrY P8Н+EO6QW" ɑ]tISQ|+8.}o9Yb;9J,ITpPʼnU!rjeμD! ܎%Dwd: nްP)ul~ uv-4A_$ -GktLlK8 :V/TS4m>U۹C!KkAnq< %"IšY|_v28wdwba# Gfk5ZH.;hw= nX])O?zek֥kӄ|sh^`-H&^4}E*Lg+c;-OYLA\6NmGOgxҽ,B3+ TRBĨoaF/DUЯsMqi4I~I8'/jV3_"ZK~1r6~">ɽ!$$\ι6L}*:yRNg$QaUP]g *-uƉҾ*ь ys|w㸨: D,q6&tq&Mtܻu|u{E=hD9f ݻzr$p \qlNNz}Hͨf/[ލ]ccutdœ$N!Rv*^#Yc&Paxz-? zNpE4w>0=472k Sz^UO~8KJ|.1Vd8*Ц|(-lkSV]$ yL%۱ D36&U ~(^f!2XI[߯*E&۸Z zN9F93 nٿ,~ ;^@ϩ^-S~:+xTV^hʩ(L>kbSU +STXi9>DLMO:?5Gtd!:vj^=79AXU*DKQ;KS)"遤izND?澥ye}cB8u҃jQݎG086W&5~Ze?:F H[jՆnce)!wl -ًYR zv7~Nn?DU@ :7GLU!#`oHA+RJXoGA{.|Oi5o?jr%C$LP9,rZb3%,mjCŽq4らT MSeB_FZ,Z u"SlL*)cB$md9r, C4NfV B,h'pl"-މ0$ "ZGϱ|#O0i $}[|(ޔ ʃҔ]|r<|/p{R;0 !!mW#?gg;m@㼘E5O7%9;4'2EN吲(`LZ1d5X>٢Dfd1kE[p=Y6YswQoNpx=D-$bޞ^ywBҩۂQuwnDΒ~AbЖ0RFhq3d+Cu8 )5:ަf]c\EOڲ:4;oA&Ѯ{Xg2Vˮzw)3YѸ{,W<dHg xG ; " A4f|H$j[ρVjBx͏ =Ŷg5+^K#!q蘅ݟjEJ~|fOlWii3>Y'Gi)@ޭW:/鄝nOZ.y8 mM,k3wJ2ާqpCE&t1n-)w :|7mIVHI<2p~)bsس aLΆ[` 3-mkY޽zӽcV;$K )U^L}RoXz^!V![AOڭ U~ \:.RBEy<3r4j2#q$nrel8PW9֮_L8i뢻'5vkFaRGrkN\Gk'a$p~x嫘02)clK/d;k\Qg d^WYjӵR 聴/C`nm@dpb}X\ܯdXMJϗ7X ՟ͱKdX\g/mcFi}G݉, o) ^=Kħ\uo >@1)&>k|ؤ(,AKX_'q~oGB"<h |KCHg,zΊ0U^MOf|j;9`oglE|h郘HJ3,~^J*EiY>3FHzě', { {Ib:߃ nXdthcO8`''ais}I0pF9 qP=rX\JNN6}}WH=m'h}e6S X҄2̂4@Έ}T,jZ[`F2 u$ ݪ16^\&xK$9oӿR$9֔bo=$pOqC>_7<}!xZ!wN7!:Z<a&jqBŌ͎%~EA7D<Ub`z2c1HsePQ؂f9:kZçvGvD(v}x}BQl(Ay_n UU/)w1H]E z;88N&v6q7J(b}gXp1ar%S/LV>Ս"ȧ2|:=o;m$%~I qwqEh_3Z # ; E5$<\_":1]"웉OWE٩LIQԮ"<h)FL\ueE@Ꮟ9Wb:_ղ@SK`6-י<鮰`V$̭3` -M\S9/1ϡhn:ůME kRMRc> Nb;Յ@$ХY_)DadUg; i&F'HLM!Fa0mNv}yX;-)Bs D]S]sgO0;5Ld!U491Z}WuSmG֯Bb?]r 1+HȻahK:a(e>YcHw{VA  j@ig| !{'W(&yt(ae]f`0l/ɰX/WOQ#/m&Xv {򗂹Si㇁7|ڱnj5ZJm#A 0)s 5Fd|.)2770Ejj 6! +ʬ]9|uAB]_͈d˨zLZp;dzzK:_GΔ WZr ԲW} 91e zȻ ɔa+ILIؔysFCU1NbM@8Q|{x08IҊaA r)3B㙬;-\)v`I$&[ko#QY(EDe8Q~wLF73|u\V'{LhWva+ B$CL{.`&5K}'OsI|ݜ*"Fb`M= @(7*b{:I2Ex VMfmD2J'$N0aDqbOK#0lj(eܕj ,]3}[RD}Cƽ1{edXϮJX <ǦlUpf=iM`vؐneNAF^`dwlk7)0Y=u4X`?e%T i h{7?K/$M~ŽfmGi@73`&5~Hm0O 2 !:벢Ɗ9Sg4 n/AKDFIcx8tٻxQ0 ^ Rʆ1K $Q#cUe;jNw I囑Me u?`¦RX{1w_y5PpyK*~18չM߆AK"Q&Emq]I$n!4-f -j$tD&uaҜ#? 5u:`g4}cG˿,^>*/Hk0#kvp_)40ۊx^B̮n" ԟ L"֤[#}8.^M:'wCL6Lk$L"<3])&E_T5u {X!TMk.)kvw1:qWg=%Թr9W,fG_! 6+@[Nˁk{;=',FSt{rTZ|`۴*o+ ӑ6{O D+tdn'!|e( :1u*7i4b:6SLLHv~&$0^lHG 5COA`'dd!aBt |П3o<4 d0 bfM*JL“e'ݪSV>ȓmqs`S\|ѤWld+aADP~WeU6NRټ䡘X"_w(c$) oF`?Bw:Nr2s' [Wԉq.Z{kv̤P-TB'@S8ƈXSy墇&H3+e#?10T[<;鱍~fKXvWuݱGWoir8h>=AZ/LB%C#\ZOjb~V׎7dYqwJE6Lj;P@~K&J};FNBF^~/պP",e&m$'Mv9׏]9O >QqiMkݨ%kJ_ ,Gl3)ZڠZ Vsʊv9oRlWzn<14=?Jx klL3s[Y^K׾WQޒ `u\P]x.rM$SA#o956'1hmYI-(]pbl 0b3=CW5~ّV:xfCΓpPWs #dE܉X:╻O]m^F$Ǜ$.N#TzbG~LJURh9pZNe.Y$kZo s:O @Z$ .zHFk NV4&GZxa!_Ca52:;R:\ A#RǏ3 /ZZKrpJVd82 ޮ,4f|02+ bFН~FtOt_FBKFկ'-t81f.fpvF  %a]Y8-ǽlZXd1{XN-8BX벯咐.. -ǁչXGuǦUXBS 6T)$_/o[hb}eQX"VAw'gjɪKrPinOkC{UJ%vLvxgtroIF7z oBW\N1lWfs?4Q Q{IY!OXkn^[V)sWd$3{orE&_Qqokɰ'l<.t|#E5JZot̵)E1\3p&_VQh`ܺ]-G!ӿhxM8̙'kV5YY-xrW5w֝[3c5Ѱ}Pr4Jov[ܠQe^BG0 'r3kPv"ޣ&<}ʧ5ưvLy.?0 :}[f2mSkʂN%<,KZ 9!&D!\W։PTE'n:G򺣌! @g@|\sKo} k` =p$h9g7fW.*2mi5VJ^);] \㌬ݤVe Rp?8j).v/2*T, Yj9|L@S6pɃ{aV4'{~I;7 Q2E|"f&C |BRR֏ukʖ`]4l,LxrdGNM>?Y'փaX  I #c Cm; P-V.>_ke'O͋A1WE^*C+^Oxp6E:'| B x~ʇwvݪ䷭Lޱ(G;\fq%+\d]}atV2xq/BDS bFv=,i;'rV`=k xc܄ҳ7jZ<:rcakI^onL_ GԶ > qB(U#G!j-w}nň2,#bϑ^a瀮f4;?hE#p#i'x/Qh8mLbnde&Z޽2P)(hll)J0';ڕ7uL aVE~g>ayLg?KG//,9 yP#F42qڄCVZBEg=-_A;ϬCm N` J(dS=heX@m xޢ/kq%&AċE%gWoԌ@S,F.R1gܒXSdjoU:W8WJW_2G̸9? ]7'lwZt><',ʲ.k,%d/tvD)C/ )ң+0SmEä[w:|; 0sZ@67XH4t*Fh-zV,a,7^MbE=xi;]ݼLKşA$lJzV(KKTK*!+a_1s7t":A"XD2[7|v:FOs.8E3 .Mͬ4{e^)(&eLI E!!<+Ev%82>́),e7DW r4~v<=הwR?%2hqZ~%g2V$>#fp/g9"W@'ڗ },ɲ/%wI~c@eoڽHȊ A2'§G^IAݛ5C>eII Jr; E3DC72#<bCȘ?! Eo4<' @ LGJ C}~O o)F2B`i Ŗ]iW \lNLsLaobSbCLꝩTg9-2ۊAL@wm{T!ae>D[ #B|`tk .v(9pM[P Au:~i_)knYK QA".L}3D(9EXy0<4G}E[ un\ mK=7.HT ~V#Rm[JA7"Z;Cv{5!H87UϐVCԩ4a)YfdmAs1窬9p&XV,utyl@d5tOJ|d\Le\KkMEמsVb:ёڢC2%&G)B39[{ )+Dw{|mLdHўC,lJ+KrI}8 $0n?Z*/|Eh%#]v ƊI<D:1A=dCdT s/پgZE fՌT\dxY#$gр<4&_O)0N"7qƃzm2 & ru w.ڔzv!d1.+ϲi,R73˨8ᡸP#;~\)){51|ҁ);{%nLSrFO||wR%s.vO3hңy\{=N]zz& !|ܦ^zSmIj-4jef}=zy.RH90yLO]43&Jo:g1 Ys0$Ъث)Y-,ELeLg{gӹ1 pjiwBEFQ)3 6j!rJ:y^jOIņY|;/ p㓫PH(jn݄̊ Y=Bt m},+U8\98fF _kx8D\0p0VD0-SQ^ka$n3}0H3hHfJ@4cRNĘG}NwUu:>8w:" /-{+EI&m6/SCc*i(_j/cؔ%|M>vDN&8MG:{`e2ؽk(9'o0.4ӎgN4~'1 QfAI2j Kehܬ` Q79/Fѥ6U[Ҳ-ھcmhLu*wkT݃&Bu"a1 ̱@h]G:-(3i/ =;uƤX~1ChU#b;~ժKC&S? bSle^_Ws} [p'Xo${Jm-"0{YFƬn6/ٸcT&ºǚuh$/ /ĘoME'jb=<{"ƪΩܮ?-&YعM5ի:iUb| ljD)$|VIN͓FTR? zSrFX\XAۊHX i h7Zu;5;S:uE嗭_f\ۺDSǏ ȎܧP.z_ɧy6<ljD`6n.h:xZS+q:\^%%}2ӐWNL !royԆҷ|[=GRPИ5[Hԃ\$`#$%V>J6»+x]/lfünt6dG[ӡp8G'Ls_4}^)Xc@?OX7 pzOLn˶Tb·Q\]7wI_'{EmTNZ]䔱kN%i8~A,g(>v槇O#0\\;1)a(8-&>v *>Ii_H 棛D{wwG#Qendstream endobj 260 0 obj << /Filter /FlateDecode /Length1 1426 /Length2 6520 /Length3 0 /Length 7489 >> stream xڍtT>]J 1Htw 000tt4" p蔖n=s5k}go6&}>YX C%z H(Opa!GAHB40|J$BR#$ w @] ^=ʿNk.P\\9@ X`Mzí!`?\p>G"%<<pg-*#qH?5`QG@<(~>eAV\9=5E [$'= b1^t@Vf ,J s5\҂ pMp3AAkoy_(Az%G &5V}s\567"AA]DlAZI?q_:pWȯ 5U֎o54|Rf 5]B""@uQch`? DPl_.n߈@7 ,@mP&H{?A}Gtnj6 &[Kr~r^%K9"5ɶ,gvIUrq*2˺"<ϷZܰ$+kfcTdkz d|o\|1r]䑟{t+{. lnU߻.16 *b{k=M͌c&;$:9${3zǨC蝏ɊPŴbk + 5 8k>CTëN@69b;ۨ' &jTrJSS"peO՟bVډ;mX5exMZVGچ ?$g-oZh9{q~\I}/cLJK qz& \%i?WpZkΟHitNҲ֦lx_!;\trAʨw>pB55޺W o+rG_d2 i4K>:S!1JHY!V46ChA$d`%.ûG ؄ lZm=x' [_E1gaak =z<D*hۘ ,)4;L0g KX%sII@\C؞圏V~Y#oڃKJX\gî{LKJ6礯7کV4amvw˂ -CO5?Ҭ]ᴌS,9u}"q DC'`a᪩&.4?͈Lm;j(.fhMdd'R3aZh'"5OE0Ɍ#LYN"WqMr0KSF C:ǝ1ۻ oo\+&7"ћ PqRx@2HfAwhض8AFMߠeǩkl$ߗZ.Wn3>S 1a u|7^P6uvggz:"`hA#pi`V(!giK!vWSSl wn 8zs!ůM$oGHD'b-iC7Ž|*y,6CkI׃t9c$B j>n]Q!ܛŃ`y>4QLA8i7Y5?ڌ=0Zvf1jiJW "MܧLxFX҂&z p.;sU"0?RL&ԄްMu9Zl0֤O-k,9)&#{m~t+w./719.r%J~AF|4s$7J R?b$M4ǼZ̍$QGcgxeYGiSĨtЬ S "[4QO+׉G DK| =^܊Ͽ4Y~CgT.tKU;y/USZUT} HތH|{c9n 鬃- 7n>dY.9b%.Oxu b M> =b_;O8r6Xǣ@Tq rl(o &yQK%;8hYm)J6&A[^q^r0V}7G/wf 3E_8iΖG^7wL7Q[?rdlSͽ/4Bxd4wĜ!\dcy@\?a$`4v]zlfQI]hs\E‹*x@Q]f`gޠٺAsF\'5 +W4'dYǗa$op^*RWn9CJHz&5cq;ϗ?ޭ]V;+}/-wXW,m2y],J+:M ?Y{#m49sjys.GRu3E:9}AnrfRkƞSEa™NZp"M˯UuÞVB-Wΰ e{)YՆlD;d.Nd02T)m|RxP "tI3[0Hz,M` @˸6I=U#ٸ v\r:8?,1+ˣ Qa_J~0S 3L֗Ucnӌi;qAZ,D1Lr+BcM ݈J6XZv@<呦-SD٠?F6z^k56q(‡ϱ>X;/RWsۧ>Qo}QZ51{~)pvRDXL~/4G_8| *o?(|\n]G6~cdf#ZZ{}Qs53f~ol?n61ծ}8`m3 ~v ˶Vr%Vj[RŸٙGFcY(_I* du$n=1;!S'Ҁ:n߄wkŰ˼@'ψ?ԾQ?>EZbi͹ކz}r[Mř3uU tST @F*Yv< ḁ (m a|b:$ %7Gt#_DZoR=pڵɕ ]"_Ŷ/K$`Si3 +tIVY7u"l&!(}4Վ-֝YJw_DLo)M*3cܳ"WaѢ ejQq>|jV{N, Emli2[LGM%Vs V5E-pǿcն!,]VLNw9˜\:a.E'?g:'М3}^6#u[~0BԀ%f_\n`#5ae}?̬ L1 :m&:ޱ*_!Q˭Ǟ} Ni&YFt?WJ[ 6:)]1յWQhC7 T+>;ehI|f^OI…e}y2 ͫ8b>QsT]{EV.^Mhe'NCܸǩHtBm} WXѸ̱Ȱ+Lk*ZDn}z!].>bYHxKzVƝ"܎S {yּUo6{<\MiCËaM=wm =v(ek_BlQj~YEAfLe/}Ћ/8)' J&1@~9wu`aJЍ 9v#a~CJ"vvJ_2600VW9? ؊|o)DrxL? (SNO.>QIDyTlS&eV>S U ] /k6LEɂqqLѻlbͳvHyqݕ0=4+)LdC9&^%R4>v.jX.8P~/9}p>^ Je$mz%`r+Q{&!P9gpϥ0 [vZ-dptHսø< AqJ]=nzo= soh,bQy]u7 uw7%o&/t>h1]pz93nKi.nN 3bv Te';p i㛴&bޱJN_ |F_ڧM"8{Vݸg!;hJuˣvO/*uXx;Qs*d{Xz\(?K$xgq#+7C2QшN,7GQ^Ċ]q(9 "uAUSVA}uh`tzՍϾb;]ۻ)d?r}* ۜ U̵mQWв e fifM:_~?4y{2Bn^N(X$#])ptU(uZBe|2."9iGaZ9ق0dO$/0Ҭsh[X;߬I E]);{T7e.Iw߫( '( l\-{\ۮ 1x PW5Up =P3@D=W=o[~-};o6mNAYY/~l6O%zjpg$XLciS ssˎ {'"Zqd4 S1]FeVuBgȿSC聶,;G !}3CA]g[5 ZG_5qݬ&*CܰAс='gY!O4lQPЀPy̩QVX&Zv7>2@8_̰rw] ۯ3罔$y6?\rHh)OEɚ`:NpT;(v+=^PNg1ʣ`ͳa 1w>ϽIJKõ]b-U;d'ߞ\{B <h[ZH>\?ͭial f0M#lܨ&75 ’1endstream endobj 261 0 obj << /Filter /FlateDecode /Length1 1709 /Length2 10369 /Length3 0 /Length 11465 >> stream xڍP-;!$3K 0{Cp 5=K9rϹޫV{55:("ekWTW`e3QSk@ Ѩ P[1 g陨hksXXXXl,,m ( 8Qڹ;@̝5r38@M@6E9 nk8W Zs'';> Օdl`&Dp: eWkh su[S'Wl@lCmsu@b'YO#2'_ѿAmZہlܡ6fS,ـAV  dLc *_98@V{N͒6`q[kk#I@ &p-ml]mwu+Vr%5 ߹l'gX8YLX):")g+??~5/:;=@Y 6KՆ)]El^Y'гDm̞'O3Q @L?횿f:B_0&V=kq|?\g wYI[oqr@ w~FOgQ!n2lcxnrqbM"P?2 nP?}8sZ=7΁AV/`O83r3l >״>/ S9 >oӿsoυ\lϙuH&bz>#1A5 hQ!ʕi{" E{KeWO\='lN}j'n 琭WJ|M3&CGg6]#viZ$!tھۆRSd#f ш0d"v Ѵ2JɩVY* 8R!6΍ޅbFXzʫL;N.y1$V$}4Us/㰺0%؅IOQw /kxi lfSkgRQ ;hV3F@Qi Yt_>~-L_JW7UetbTT cΥ6FݸZ*xH I:BQ1u$)Ju ApT&RWt2C!ӳ}umL_^BjȐ(>at~gX?0lkoVW4f-Z=ubnBj\u?v՛E:8Y*Ԛ2;fncue)(*p~VS!mb? S-1hq[Z:Nd|xt8%%U /RjYKu !kƟpBk=r=OӃK+rN.=ȗ¤|ǥOo՞=Rz©iyu]tԩQɤG5"%.mqI|kxpQ;c~XĨ]H6ij WQP%0h4 +f$V-ߌm'DRx"}O DvH‚DC8 Ztܹ3zE4>p=gdFDi 9څj3E\fĠgýiSO?1}ǔO{O>WIi*z9qc$F\X-OJ:{3 S!7#1K bt 98>o'?෾Y1JJ͛$VbFb:is=>׺K'l0T ;H\FGˠT5Q_@j0 {Sy#Tl}=暱NڄؑO4i.nVX 9$! f78E_z`Dy ,(l f Xm n9,`E*ϔ?IP86ul9a9$zܤ +OS!|%f{-׹!io Z qD& /9jINZaZMj|WT{]cAgnHVM3-p{ju>Zs2Oqm6kUY#t"t.:m &k>2ь{WyYr|׻'f>.A'Ô~k@꾲Hl@qgN(tV ^xYtHm/au>(miCذ>؛%'p%dJxѼPׯ$"ML/WҘϞE;a<@-0H۽NkPʐV]r/O^Ptw=<:*J?-#/4WR--;IJLKf/ $ !,['8*9-и ed|zpֈe!K$/_{meO jNI{f͂}Y_^hgV}/$;PG<{$J">۫Z|L )hEdq;$F].i\!QWImHߦgQ̝_w!^c|xrCwc&n {fMef-Jѱ=_Vܳɲ0?uH/\:i`Dv-AbACv iě btgwNjmo^64ٺ޼nGL~Az6nsU5O#/Կd~^h9lR_wکZՃemJݿm _MDЎתHaHg䚊~lɐ[jnSxV0sl,.E!*GaM9찵$EѸsp:vN%!aN٬|dsR#94s4ۯDK&5guKq~)ͨ Cme4)[w[,-,|V_/}挃R[0*3"s.f_K< f1^ü^h6?9zX8܈K[bRޛmSݖhGYc1q5qdHA$H ݃M _d'qDYZ۪vTԑ9 ʁɛ^I{QH.^*P'wN>* -r6Wqzc!]j骬%yK?U}^ϑ( ewիߟ*m1ϳ&&oij[,(&8it'o~bذ.ʛ0'1esEkt xƈ }<'<?}յd-"0ƪՑA~X (HW8ydJ1@_y|,KI$8q$xQ>&.L/`[E;]|хp8:6\S+=) =Dʠ;ΟXlb!)*϶29ɡr-|eXlPWڕ tYO/ E&fvxd nPow;HyuB_X7ea|%/gr!9ܼ7-镧*22L~|pZ  uczҧ7qw[v)eKř9DA n-xIW4(_rJ@(Q|y`uʨѶJͪ쾝1lmY֠ꧫS*psV.? N`H2;7/L;YU/'mzEpz i2xbG:UfCIO9A_mI'=5#j$w(ZYp" \ufyV_LO0Y1'';c?6eLixYbB`Kμ+B`Va9ĺx,'LYMA2b0RL|J~{ 8e98@n~7NIDc1^B&ElxY?0=\[-q6K<LLjp(/;׹{5Iς0+$R1r0Xnj8*Iz6H36+cGNV qǷ5+紴=ScΈ/SJ<.ڈ4.uBI2 lعEFɱcgM.Ha2_:8*В`} o%>Y{ѥk>'UBӗGbd}љ_(ScoSΏ:RXd!Hr!<9g&l_t[3aV@HMlkM5񓏉[ Ф> #.#kq%h\56&3Ec[O3LWvzLbqƶb$Aa:KڽiF'CQR-2˦ώ;ߞ  2 y9bP2A.-{[ .ڻ&{\9!fB!0rI[hoqxzcHpe'w.x\pZ;VFx 3^A ǽ{Eg/Yr^,7YүG ·Qg? J-Cdg0;pꝩ_: p/%}ۓ Χ.W#ךNɻl眗1<9>0-!"inAJı0HS^j$[^̐^73^gIG̽=e@lpuLI^(KT2&TӃ*?^uܘ|J[z!ǁ_gAdH@nj"!E`R<PǓT2|yW'l0%)k:Ew/X*3 iOKq8$kPJ&ju3TٯEqSƐ`'H$B'w& xyhh.\`>h LЇ@C~j+ϲ`~*\?aexT]lc۪iVy@B\V-ڸا)LQGRDT"f}[KlCQμMk"UAG6;MGw73c3M8DP?'657;[}yד5,=r8 'L췙HX['08d&T)eذ+{>O4ةDimg13- _މ -XyLomi^$12T4s+ f1k=-M3'5:c}p'  xb04/[CK= K4"ЊroA3U etH]7V6vzRkK肭ߎ9$gZ-P#_GB~_W}3jDo>Y g)>kM-[\P& ArK5򴣺S`Tn״1Y<֍XLu^9Յ껏e^)5}w +'cV+1KA֑w" [?c滨&VoBH]栆}`$)`.i~)fK!2S/-@{#›<1[κqǭ˞'G G;H @qsn-`zU17ctZg8n*H xC㢀[❺NUǏ pNӵޫ4W!G )vkbP!+J<23\1hԻ\Sм|h`I4hP衾B(P{'Ϥ$2cByji(y5S\pbLLTT F:G~m eڽn8X1\+R4؏G|0dg& Fٗ-X~ xj]/n[F+r*~3F()42:&8t{Q! RpdV<>aLæ|{^49xmUڷ?%cHx8!1Q&vX%l¶w - 6,c/n8Xsa| t@P#OZa*P!Zӎ/G ҨƇպrjЗ8hl~iSKP:1).ɹ^OJe2<霴XS_:vEp*(EqKsx*[0/?(͂;/ 0W7H;XYf@["Dpx/vC1fQ.&X4| *±([ A6|7.uL_?ϱgGxy.Su耀>|% ir :e DV$FjreYVs K'QSbTB0];e >5xYb {I7P/) rE^,RZU}fPH:d]uHBİF!^)!e D N :޼-@iߓ]tBEJ*7(LT;*hk!̰ڳMhQ (Э4PQn0>jr+=M ^~_Af3S0o &f oiZD-/TY+F,>ǩL̸f,0AL\cߵBЗ;V|20ԗz*\ 5ܗ T-̫ZMF#\xzyd?~oPoKu8k4XӾ/3KNS?M rUrK6y;OY'Q4.,ܤA]*Yuބ 3yrƎmމk;7*F|E+&Dl}Nng":kG"-Y_a֏m(˅Dnܟ%%o6Q%#6/]Ί5֊i^t*<|XD1hԏN :'loĕy2qI`#J!"m[gWbIȍxISHd7FȽM +߮3fD )*y: <^7Q)@+b>YPdјP> 4q|3,ĭa|l.RN5g#'0r% p=X {0ģY*eܯ`,f[auYGDw~wx}'$]>Ϩ0F>YMGr}ލ\N ^ 5n1Y/kEiCEmc`tc0r o^VZcO9p37" 5e"Mb1B{>"j6eh*0ђT\~@y%@r*ZΓFs$VcRslud`y~{aeMUeR,m;%0_i"nՏԋwA6[[zٔIq2!5v27dUx"/46BIJkiSLS\OR.A 6dMI -[kcv=9J0XJ(׬$ZY?=\I>69$Y6=;]qcXtT?ҟvɷ:na^1HZy9AEɞun'QD=OIB/0 n`-M_>oeq>.pg5qMdS4 |Lr4F-ҬQ$Ngzhs)9ߖp;/uNܧƓ4KY+|;S w0-'1@AnԐWT B2Bl㰱/`MFھuK1~o ;-%xU'`s1_1ɛ٩j8˧;@Nǹ~&)]/ń: QI.^-LD\j!KcOow9:|eG7)xjL@*"1{y);E&nKG 8 YFx' q{{7>o I|vܷ$,tJգfh#75QʡjkoalA5 F۟+Qp%` mi;)JbtW<ڲi[1;FwX!S_M[0+G Ihŋwlc+n_lN%4AL_7aj( q&Yc.\rֶځFYuW]"-its(ؕ>LQS8 mE ?tޖ ё^ߓ]Բ9ܒ}*TYޯ:L 44Ē @B)R9o9{`y݊eYeI8eYF}^6'PȣZ" Gݫ1t#DΙQڮ+V6!HiDJߵ W|֏%?~o)W"uIvo|~#B8 ,_Ҧ㳦diXWv5 򾔋5a'"K]v𻟖{:ROc\ly|O_v{Rɦѷ}y?d' @:^psmu"b,dBtC1_4 {B0.9bAᝬ%g*D蚛iQkQhџؤ{QU-`w3!NȥWȖFM/lcvD2wF/(za򐢨ȑs*M[jV_4.\d@u7+ !L2m4"S]ͲiB_vQA<*/٦H!.YƒN\CWđ\9}J 8ڸO,fx#8Lv~0AkM-v90`AtG 1EZf `JĠ h]b3qI=X)jVA[pd@9F:ꈺ%`ꇤsڧV&r# ,̸%ʿ42x87w~V,g</9_eL~ϭ{ :V۹\D6mFrz[Fugț/c#x l~`4eG2$bx)3x0[ փ [^ S[/-VSTD^$,׻y㓞( vX~vioRdͤOz"n\UȄ}c+Lf`h?t͇Y4;`yjW>h%%'nvzs,endstream endobj 262 0 obj << /Filter /FlateDecode /Length1 2588 /Length2 17144 /Length3 0 /Length 18642 >> stream xڌweT\ݲ-\kpww!h;!]u9K}=ݳtV7J f&@ {WFf^ 3BG@tvrFh L2n6 '/ /33 ybVfyF=B~Mi,<<\rLƮ@;PFSc[BPtuueb`4satpxXZT.@gwwc;?1"P,\Ru0w0v@[+S J6=?0?޿Y`ne (J1z~ۺ8ݍlM@"o VjO.V..Vdhq{3Q;; o~bV@SP罘9b{{?w)fnLVNn@iXDd@W3337`N%$j^)Y~Au8:8Á/cw  `G$ B?Asf`o_ͤ*',-BOED<> V66' ߁C/Wi{sϿ?3Rp 0@g9MAX_.ac7' 7[YPealgeAT-Yo1h--@o'L_coﵳ*9Xj ,K5SuUfw`l *V h9̀g+`h99L¿EF&? $q ?$$ 6`@ P>?OSq)A&?OS@ժA(ʮkx@ VPcS+)ښ+(_ v&ԠΙ8A(s?r^ b PtS[,C/!c2ț9Et04VLJ[Z?.b[ ?AzOR& *%/ /bj_Ԝ?9A]XVO*6P&{7;7_ @:_jP]Ԡǯ-;}4<Ί3G[8^H5hfѰuTɟ O P\l],rC t3Z::[PU9bA}w z=^APE:;݂nΠ"5",-8Z7v x0Mq߽#ق0B|S)'`/NSхO$bx!A'%s~R,n#QA ;m q p{C'EjxsE)[e^n1f D/T2:_N0_A DpmiB]=h%+ 4tגd{r~g.eh۷Ob gqs HA'R\'#R1fzf߃;Puua8PMF H (;k$k[LxK7E=v(/.f왺CTI̬<.J˽/(jxjԨ+,.i?0rx0:{G \ dY-*9ۨ<ԝh1K5bkN\/p"c]g:3w}Aq5[a=uCcs\(=Y E r. =QJɝr'|-|X^֬c3q݆&eT&RC3iX H%%a6}D, 6󮣬ꡔ\q7E#P{@]餢Jʱhސ}ƃcy* $v\>ZyݸlT\쉗KPN76[" qqT0A CC=~]MEEܦRuqKiCI-zH oΏ'Oiק=ov_<"ENF`6ǼE_9%e3 hԞGNa)X'Yiyp|`Go"i!i(nÎ2f|z.VWQ*vƳ燦%½<UܣĻz0B:?tXr~ 7fv6 kxxvf׳R:dOP2½H+5uĸR V*{8r+x"h5LA4z֮d;طzf﫠i^]gƆ^,R8n#q\|A}ƌynqw?ߺY@h&\yo2isF1uYnDO_<7ofsҘmԩ,Zh#VIɤ+ 9Ur-=&4:ZˮP=s@8iU״g4'e^#GUEYetoyE=w(F!rL̮Ƣms395 iNմ&~m;d㽻x/x2>ς{)•mU5/ P;n (GZ(%wXR gNҗ.!Hzl:+V[(~Ke}fiBE)Lܼk )1֞CuE ҭ0*z/ə6kPWx&)EU%;L@끙`dk&XBm@7b""0evŤ{3y E/N#Ѿh$IV%㮙8K1jo~ɵnԁaoeW_Օެ{1q}G41l]bfr/_sG&Ou5lKYrl.Vτ4#{I 3ϫ V_zHb^vleuį;:FV8{TP/hNnBwQ蒥 + -q <ōbt- L*Kz$RowG&e`%Iw+LUXoN*{[I tY™pU*٣o?,*kʻ"f@ &Yrq!h%Ad2[|>E27aJ 09h[-]O H"}Ӽw1ȱ.Iܡ={Iΰk)E]XTV-?wA#&w]ڢBdy+%OW wyb?Řd@q6o| NM7w&eKA}si%k7[#35QxOZQ7'5$Q)ErCW:Ĵ~"N/XHbcNouH@|c mW,fV(TIx/'}0@UJQjϦ̨;ܷ%ug*Wle.cWܧCٞgLBbeqzi$(p6_\zAƱ7EH5ugoa4ϗ3 ]^Щv*YA9S^\J1mYxr3MHHI+φY]{)ÁUqC<:vG (wVw7 |N)fVL"Ar'JHrE%@D#:BXWPK߳ls0ItD>6J@Ǒ>] =,\Yki@{|>V>1~av)^ů3؉膆x6\>sdv>_OaT%6p%0OP.qܺ\@rZ0:qy1EzGZl>IejAxȢw-YwXQe9Fצ߹b*oigAkwsPlO;/PIg{%# Et(4-^pV6 AсX ~$+Rua"O;/1׮[)[ݬ'k[0r6*9Ͽ% ‰+ 7-uKDZX9ZS'.!Mbo*XͶ.g?{dnҰ#%-0<~\ȿn8mO~°/Jx2$o(3jwLF&"ό~P{-k}-? L x^=v_ʿH6֨id*v FvCzB_F64~ms_%>UḾu D܂uFd*w}=ZK%,N?rƱjh Oz5D޴bpx\`MxoNXz^.ɧK>zN?&EtQ.S emݲ*6+㜝啻Pۮ3?#hlޯ^ d[ޘUΟjq* Ì1CV>rtKv^+WCpN [Y4Ht.T#n+_`T G)Q)Eh@袥# :F5k[4jXV'}#TzHya<|DZ.~o`Z&Η̴D|A;J޴/i`3ᓢitْ;3ȽXʝ9?Kn]!b5M?fL#Cׄ4XO ]K"YuLx`PJC̰/_PY /[Jy4 8zYyL"]S˜c>||a{ަirV(5HZqqo_7=S|oA@(pٚ W+eu= Cjr`+ F'~'غu~#xb' ੄ʮv|) ۱s"sʳ\,œGjI]w@I Bg-B*}Q]+D xK==_/8ZUHٶ $sʋUewr9gU7) $Q?a@;̈Ⱦ0n&J1+հWw>ϒA!WGf\fr? u4<~?s+Yp>yR?٥uK5S50a`'Q7qX%~~cul/NVYS+Jغv^˯M^:GUYN1nl^.bhAx% VBS-c~V$K@!eKb J_({XMX@b 0r ږ3rRz Q# Qp7 Ոߓ='J6`a%֦0=dQtͲ.!34$EƽdC % >9}ɀj%}ǫvW6d%z3c9BZtB#zqZĮϑT NVt-q6ẗn:]GCVx fyHQ𰮮ۅq\y*g7]Sr{ea*yq mXKN* _RDtV(Po[0 WduIS Sh dwəh1|nn$ j1_{|Z/kir fwy s;Ef̼6bBP{x{Hj7!y_2нW'_S_ǻ0X=\('Z3# \FdKuRI;IŰ9wJ"^3nW ^Õ`rp# {~F_CVENckTNfdz0HT]FpzԀGz*U|5 ";l>KbPa؎&5g\BmD [ޔVQ:𕨬TmSm /yӰwKcb`ȟ?"4N5oUifbdAxdIU al'Cƻb -=_ΑRPrm`L_X ;GB}@~K;kmVQ !Gԭ:M5@^LJ×'?وUC`'[ mmpՠpYUkΆbS>,$MidSG__ "6z;ɗl<,|hUI*Z~öY>,'DRgts=+aeM0Γ列2l+[g|d-44DSperST'gCh~_g[v 0VL8Qr<"W}™I %^=.f&Í-?5e֡} g,vNFr.{0@xO"D@QPIXJ-y0~׮ _ۑ1Ʊ 6c_sܮJ%v]CBrQs>?=Q[Sd? tֲh%X{5-ttaM%ގcNwlᒖCȉ)ŖKׁ,0Ul|؟u`76)b\Y}q>i7GS.ߢbEhpe vϭ{> :N@#rJWyMc"秵a$ڕiƪ1R G_ Q]8 ~ N3 -`q_4\-8Fk]{\GVSxqJA_' ΗS}h3X)l}45 ]~ڰ?;w?K tZ(:BW]-9i R[Af;oB@(F@{N 4!wp8.dyFAact(CL*azgh qKWsfyDOE1z:׋‡uJqqrݏXgcо:,gWNtpG8ÌTAkG%/c-݄ x-l$._عsY(Wֱ] mOf$>ZQbKpMNvU E;ͣ:\$v~@{hRD1E-c9=fP`,N#x|xDFA68p؝olkiDl;|=ѽ ɶZ_Jsn*yvK-N ʁ1켧ωO te_ruNlgnT u.N ;3R_Kȃ>=hټI#Dfd#'Dǝv‹OOI 2p|NƄ5NS-EHi99/Mg3KH )9 >r=J57*\Y" w`C226$QfzIk>$WPS=n;W5zBD%$4# {CHTN;pWO#1%7j#1(iӜ3iLY*1%L C=⇹%o&Y¥LGnM2@r8Z5 "ϏVrZ||)ak8%U%ymWMSxFX:4L"eyLyӀ=DQD `}XJ׆Inj?`=ɘ ǗUuWw61ODI9T;#SOtlV;)`^°[bB$!Vk4Ffvʅj;۹蓅Ct ;9YF%gdDp__LdcF5:4OBv <2`  `Auw+#Pw@xrJ \ 53ٶ֦D$h|_1a1j'e>})kX34t;gi]FY{瀞IYw$Snĺr;oQc``܎TM/PD&51#8NqeNpZ䎦 pCcqM* ycE榸T<;Tz) ~K,TI[mxt ׭N_˺aփDߌ92 \ʴ.s^'T*_Jy\T*NaN\6(.Djc0ԅH6Nd9nnUnbKqgϜpk>)8[4RN7~ I#VSTڠeXjl_6¦CJ+Jt"I5<>` Ϣ3B|1얮HKv}z\rVP =ӝUDOE=7Lv=5Wl*WSkdKAKsw e#z!D:Bc?gEwrV6*!vɎ@{A kĔG˓bkLp=-#m2xc8+X޻pۆU mNN^zTOǘV:@mU0CQM!ֻ_b46E-J=]L5(-oQCt D MmUN` 3cO!.ڧd!_5ʨպ/Ҽ}DN#Z:^S Ȼ|޼:߬xLFVD>X0sonffʋQLOь8Y~]8 1M/!fލBqjy@8lh0irIOH&&Gx)p-_6".H7O,G4_$ 7dmit劣^X7IHwwC~H:,B;vH8-yMfg0cxַ;o,5tv܏琒m~&D7M:!2uc#"gNx `wDznu|"C 9&ӽ,w{IßqO (8. &*cdA/%NXAЩ2^ڳoS+2l6WaY XeSA6>FpwDPNSTxS4h@^5["0EzMaF* X\ϵҼ%tӜv7gL- 7$Ĕ2{,)(3' cЋg5=h4bUOC"}7}Lb.+7xFO Rv&ѝA)L lU$j7!Il%F)Zhs6!v %/t+~>HQ?ygq#a<~G!<~QѬ˂;7H @k?B(vKK|  &,Y/)UU]/!Ub-9)Ck`i 3+ck7_%Eڂ`p!NK7jj2LDgV # 6d ŀ":'3/pNѽ}K{8̮n&( RQI*AU_ʏXZϜ`CC\$KwXkEA?IU\ñ"A+)/UZ#^8]st.CGy*?*\kfX dd} @ïp..مS3wl Wu <Ջ)'}1/z$KN_YEpg;Rr0ٚSr"sk1~!HͶ8~7yv+T엨&p$ӊS%jKʦzMDYW~ޣ(>>>ZxF[i]4 lSt CVGKdƆ..&Ɗ:#B痢kJp~!ϭ^9:_sœ+QY_ `u}ha'0R5(Qg: :Bqd/Ab3t)R|\GŪї%M-͛Y?vպ+? %ڄsgb}D1k+ڒkw GU־k\w~; 빅T*pNdL^KtTsi Oȑ\)^GoL 4q<ʼn6+^Pf(R4GdQ=[`.?  ED7Rj4W,R')bH2 o5t\ O&3^oM/Q YU:d }v>ܴdz-ƍnX¥t#4ßͷ.5y.cneaܦCeZ (~{vz'=r3š~y@'Wc0)f둷j 4Q\pv׉ qM&rHh jFE 4!7N4]D/Dqzv&n3k[=i'XobC"2~m(Qxܐ Yo}˽)~\֒Q)cn >{qF{@ub:=Ԓ`9yBxEZ59M84BcM'GxJ읙|[wyin{$6|êw+ 7z-)G9` S=6bq?S^b՗s%c@ϷRo`59~N.tmC?v16'|Ӡ\ڥ&TAGBCd}&D%o75:y=%@3,|PLR]'xٰBĤ:R~ʽD}a->N!>bT.b_G~\ :Dz 7oooz!}`*G6ao GdWUEbIz\M\ѽTg1=ceUIhŠdLeHjg 9)ľ(U&XmluH8|H$Dz~$7A:l%8 6l z~)EË7  e<Mq s8C7Oes@(ի9$eL>KYPJ{Lm_`Z橊4ט4bMȆW@kHXVer>$#LЈ`Gr{nt@BEl Ѫ:} 2ihO~8b[j$Mr-X``ФS]Ӷ*5{qy݋Ƿp~Cf_$a^dϮ[ogw=RĊQļ&H#%G]y\eL+Zߧ՟äE; b%ћ^%29Vs)2>C!IO9 !M1WuiM4*}wh9,YRpڔXک?t0Ooih"[!X>̧qAmԝ3 ԗkACVIӯmuxҰK! G[ ٔT2L[ToLCnB?:518j3`R`N OB(*_%lLpu:.@3x`몢mxֹ[J-^WT^@Iou.A++6o`7Kxq~o'Od tmLI6^^zPrWLFcYl)B6Dv*˓NdfxD+/2Z} TDG|,B0f8Arذtׄ4o?4; QlXg\b6L1B Đp tɴe݉mȁ%-COg _:} cjH)>aʆq쬤kBXJ,ئyfuL-RD2WvtN=oZMifk(yҩ )Ql ROjKϤUBJ>t^ QR|01s73[]MH8~ igju(Zh3P2~lZpQl?y9a=r>;br`Di hQ NjJRIoG #TQpK|JX:PdpWyPкSf32N\#pU{m|j(\޺| n0,WQAzVtFt$XHHtl'hE=4۟ ɔ?aDNW;2ݡ O~gxzݔ!}3&I:xgHN3MqZܥ~TớHeX;|H/.s.98()ۗqL5GjC"u(7cN 1N %r]Ǧk_*4P x%y%KimCDDLRP_sIq޵xB gȅSaneҍԆꮾ}?s"`ku<[.l_O.wZ_InRNJ'v|mŃxxT!t%qѼ 2sfEO8[7Zlk.mMQRf0GX!>Mq.0 c+pӋvl'ESLP0ƴcZf򩁽es^1w;ٔ`*;:e`ە$G.&{xwQ:p2Qc7 :ZI`w6-<$0rȖНoyR1 -uI 8s_C) j(R&WNM7$ox1!'x8=SsXZH!.&d-g0-׆x$yG{1 9Tȳm?aNgtPÒJGK|Юu($޼3M%y}PkeW}{<^:NXI6ē¤1QAP~dYo{zBEf?Z[ˋ8F;pƧYF..I+a +)P'_dǧuH+ۧ\D_rE]d?ο ?sfw㾍w2N+~nu+ \1H:\)ʫ,¯H_OF9,i܎# 74 E`&K=-4Gfl ]KLڷbȡ{I=P X9R+i6v. 4Q;o"Tz҃5-ydxO;d랰wcw O_ky˫! 8Xބ j,Ɔy,-4vϬ8$h0%V~DNIP:$[񶊵f:(a:t"/N)*9Y4'ڔ@d, C:y7oRYe"+ف${wU||\fG!`l`TR_MHs`? 05Iz=]Bx4$6v .6$sVH> 96qOH0@\8l)@yqfBS$p-- .%~x.B"Sk._JKdʴ2JwM<] ozJhjAKnc~dK%(uf<.V@3κb rumԂ2 mZTs?qd Z?0<4p5&6Uj"Yܥ--xZ'}')3w!jnv|fy,^gɋV(aDp'<њ )N"&wحGEKQUc#wL==r Ŵ[m>")[)Ż'X8ɴ~Ut3Bӱ{$>dz*`G+ACunO4T~DtXYp<<+M`Sv:V Qztd;`n cG~f&c zR*J!0\d/wAs ^\λ%l{N0O$C^ , N`tיBIjɝK8+jC$s;h GEI6O0;cK(n\p#-7QUzRjQ/C{AK\+˸by: Ӑ|?N3@J3g35FTgq8=ZQu3Cb¨ϑ'ɜKol 0[HR?O{X|c@E+Ǚ&EF?DLe+wfTdǣap kKA6Mq!047`~(_w4*w1e(fEoCڤhms^"B"^ +5֟~~ߨ֞V6 ` :\j\PtYyupp ddY& (xTZ-$;g3mIT\A)W%v""c4t"-= X?썷}3*zy7^_R~Q̉c?>=hhtA%LKՈhT[eu2,9i{ N_*EYt]:5)Bsu-z=;,ӯ`=&\DY7-8*LSd/斈M3oB˦\e|2צ.EA9IMٕ$/jM^/&Kuj}σ[cg?|Ԩ t|6N2fm`u608jE 5}&uQa+L*cmjwke [G$B< +af@iPqWaBvbYP3 P}@=~{R%Vbx;6u'|а"5HşYQb\U!"`zذTvVIg$ CUA" ^`p,P',|/'[gXZYiITAR ` 6e"M_/aaA-cn^t\`k Cqtz~87;aee (Ac2R(Vٮas` 8< wejh7~{+%g9xaWKC &Ԍ_!L}&ǂ,gUvsLAVfLryFEIX Zqow.waĤȉ\4D-vlIΤp޽E3)=$.ɺpL7'!x"+_MJ0#Je}5JVXKșw7yP(VTOVzJ[Jtƛ>gZuG4_@:AY"F(艮[XJChOTs7-$b #DU{^-B^V0:Vgi"v r|z+qd9 &P"ɺq9*XFlGD'tXM`qA*nU[B>DKUvwJw*oquG?I< VAG0 V,2Uj14WuQ&j;UBDPoJ,๷D|>0&zBpP}E2s ~'MqӃS#v^mF*fGt?b=`E`:j^o4ҵ=(j+{!pq(d݄n N_)jG,$O1ayLTHA o턗mTj"w(Pd̀yzcM^V: ^ Zza /,AW"NˡgfXů>V0` i  5\ lR:endstream endobj 263 0 obj << /Filter /FlateDecode /Length1 1395 /Length2 6088 /Length3 0 /Length 7043 >> stream xڍwTS6EZt H5t  ;"E@z"""tIGE/9s[Ykg3μdsv0U$/$*B $" 88hؿDHD 1>eA".@!4"Q@e#D"`%/ ,- TpPA;\1+B!.@0 }Q&-(-q@pCy쁿B\a&9=DH7b.p( DP@@6P ;@!+W!8w2 EAp#j }|@C pwPU׀P !w52}VA+!]]aWp x_!G;Mwi(¸9@1$ɂa>P'_K~~1S!݀A`p (OXip(hs#q >@KB@ЯϿ0$G"\| }ʂff"/%@@ 1)`? C5$POghHİ7@PEL)?[Rtq p߿ z1RAbo)쏀u`pOj!I( 1{}`p4k)#=2bAb$j0**(܄ā 5 atiMfƤ1(s rD?zP&|`P(*\\ћvƉ0+kBtʠ͏$IbՉ6!Uk&]E왱},G,+,v GǷFjL QXL1D`ΊdE?66eiޖ2٘7Du-̙w :]7M^) ɻ|k%&T+liNBE붲(AKҋBLJ;5%jO/ / Bg)L>֛Zd6u63%4|, zPG0cƧPR{s}H{7N'wvm`C>E|Ѿf1}ݗl?D=1\hd013l\溝ɲjfm:L!~vDdu˸Q_?g,PVh+搦sBk񸟼^26 eDZo!x!.7^ͪ2w>TKպZw#TG1Riӆ&}'U yI M.b2*8ER/mynLYF)ٚJiIŎ%bZMtSĸ/,׸ؔƣ,i^X%v4+lU<5a>8"PNլS X2 P<*,\X9P[MJ}Hzv[1W%: w<ճR/ris#үش%)C;csݫCeF; eCYWr9mpR5{z>. 2y>KGBEn;[y3e?ߙ{kR:1J}&L(֐h[f5_4N*U0)6ۻ0&8+cC [6p7av]˻ҀVI&"DsT'7id$A+Cqn^~=<(tT"˘ƳLxC5S;J kNF:Ӳ!7'}˭jO~+QCbѕs0q4;e6ʽs;̑6xjE&31):zIK8ћ>~[$J2/w|'uDqJe*;OBՅOI@]ҩo?'tt ?4/,Ҋ |.}nJ+*F8*pnk[ } ^e}yT՗HhjDX]T RKJ|$u.T]X")`N zuE2GQzTn?(nBteeqbU n/MOR6m|вNȑųgyUUJy+\QE7UT^>{(vk*lq]-x#f뵈-Ìg!#&_S?1;!3#)3DktV6=^,oY~^gCgJrċ Oso4ԏ|*RiU iyW Y?jVϔ AI'i@"w4c(kp8x:;/Ͷ٩}R80Z{Mzihͬ**~\l"NI,wMS%$_u{lzziJbpRLcT ݨnJ_X>X-g$6Ǹ>+#H&26C0f`( M y!nNۺs!7zd.i\9SΕ)Y@9?L{e\LzXű9~.ݴd[|GCŘerxdWB?g,רL6t4%=aEGsACcQC[&"3'h!Cg1[d4+j"UvgL B@Rz4"Z8 1EYchd!ZwX-a+ \6˿aM\u!1?n ~@5=I~4S}8|`!%֡\x`=ydMP`EQ&KMߢC[ο*2JeNb$brzOq H${БDs_xHnw{}dVv{4n-.ßS:.q.eÞ1յ:_v1%rw5J!>~fǶ_!-L§u1>jjIzhۇ<4-&ݔt#WsČ#j_og2 feGhԣ5cFϾh^nhdk u Do8 <ғU=}-a@Tėx=Jg")} xZʓl>21Lq*}ymamvO B^R~w/:tT(om*Ǫp2D:Es|BVFwˆIHD'%W|8qwRWd֞?@#z}!u'yA _~5:=aM>vw8qE5ƤcqI+ S|У״ikNsa!܅/tTV>#mmYݴ'\Õ.B?MT:[ƒNz=z~B"؛~~+{n}s+gWeĮ۹$DSe2kNv0A-b7n_d6JqX~u;)+nQ* -#"H(RA#WAu>OՑw^gI~㶪z*iyV$t N)S{_KpDžg(0^p$Ն r rZ4cW(o\`i;̳ {9iF$">Ɉ`~11wl6e ^f}xjk" :{D3mW~җMfd4p49Za\sue"b9TrIa\Ϋu+m\oWe3a1Dlyҟ+a:>k4Ojز^@:v=D)a[֝g%^fJwN sllzWMz{#X"jrZїoyG"||u)MSXJl⫓W]cհ Z}rnU,;N>~0,ݮ'YP}+"^ ē+o2!:jb-2uAa/N`Rmg-v=C~ˆ #ӗT108 ) U_Zܤn4xu}u+)xJa_)띮{[Fj"MգnG|_p~<8yT\<4sڞЉ![J _NY5@x3l_ǓFLrܨ)ɹ(grAE_3\I %~f1"X)zz&bubC! m'R=/Ӥx{ZJTF}؏d"~o"c9NE3B]w/I_F[b$nNV/2р.4kǶ[w`œ׸9D_U[w ҸY׆В5|bPNֲ2k:'x6e\I0_(/7]:|1Y8U@1ķpIQ(915G [ou*sDzE+vu87!,/#8kQ QJD93`;(pBtqst6XtWCVs^s]q>3͹_Z OnzmK9E nS^ntT.:Z-zr\۬/huZ +jS.H7ؿָhhxy puʗm;Iy'kyBXVȓx[2xA&rƪdF-&yz[[ŒQ A^o T7  Ÿ|ON[dQ{ݻLU%=m˝f%/~ۙg &Sp nk nN4x#LɡތG:-tedE <[yEsǬx8!oKv|11iH֟GyA$3:X8&o8Q?/68 -v⻆ 2"Y% /w =NWendstream endobj 264 0 obj << /Filter /FlateDecode /Length1 2088 /Length2 17596 /Length3 0 /Length 18854 >> stream xڌP]҆ !&,][p_%[\/{>W[T|{~{9!#RP2l"r*RLFFzFFfx22dj&@ ?"DM mr `fdO Ȟ j 4A6&d" [7{{<(L\\/Y lr& #lAkhBo`@7㧢J&&&ƀJX4zx29_e `42qx_dclbxP|5Wh>=6dmk`1L_e]i6X98 nRW쁶@jdkc1Y[8:Ohob~n \KhclWN 6@;')ǼLl̜;9_ TlMv2e~d 0}/ hjhdO<h041lb/~{++{1{l} B*rRJ4.Naa+ @`bbfp?x> Z)S_r?*%z\Ffdc4z^"q'+ X޹NS znѕ31:Y_4٘w4+=#@q_]/_f1Q9zübd?!3|8.߼b6F 㿆``oo~`zJc׿@or|_x ` b/ӿ 8 " b%Fb0H!fb0H2=z.޳8)|=b0(|==zgޫ5/@VW_7`|Wd|dߝ/'Gf_d}/m{],YC{!/V?RؾO2QӻPwNww.]?]?ado=>;?L&&&F #!| fVkX]1\}E?އ,KB?~?l35Yj`1Znxsc-7CzN=;:1g16:oVr¦ܛ8%o4?hy6&L{bh`hBc8=5~-0S ד[ ͪ5@t%5T~L+)3o rj%O,Ҝ\s@ξB?מғ2/ԓ?֎Ɔ!{ME V$zԏ|;V+w!M^}K#V[V8[?e*`a/s*/Bs_r'?kd\Ɣjv|ϻ I,bqɮo a>>cvY*@*U[B1gOG 4\F-J҉y g}O>˚WV=I9by}d2 A޹O+xtsq" ڙ?1JlM޼2\%Xro&8r'V{NIX+q G-<1 )%<'}YrL%9.A;2XjklX|iq!c˜3 >:Yf|GoxB6m&)1؜6g~K״;$?@w0@^fA!C|V妴;yˡq>Jx2Y(5*sDTɰ\GD(YfsJJ/,y^rF^=WI/ 6: \$@l ة~҇>[)-| 8։tQs}n3|E}Gͤ!.BpQK m77\@ n1B. E<څִ|Fvv6(e$M7`pQ4uN;G*"6_tU9MnEbVY}y>jXڑ_jeSNe[q_H"=R`<N[<ĢbuaI%&|Z/s+(^}t( r qbF#Cp?lgTWVtsOauTUI|u3A Y+N ? 9 nEˤU|s9$64^;uLO>h,[^=Ox.z5BLW8A(5 ̯eô#Yc5aDدè͒ N>SMM} 3*6Cn?sl{7W}9QAw3 d `'B^E~صuåyCxGL._"b5.^¿2; Xm;*r; ʤt\؈}s]peq'"jjpu/&'a@o- Jyp:|=W9 y7()3) oSl\B2*%uev8Bsvbt"HI2MsoWߵ+X14W'B>L$2oUîм A`V?K]Hf SziաkzPnP jPU-Kԙ$"-hxIKT̊e^ܹufݞk)y*rkNqTb|?,&WL\dڙ>-$e:KUs8>ׅ*oH X\qz $&Y(1APO;H:}3>[t~n l&; &Obu,+ȅEy}yl6>ΕD϶4c6'쇩xyZҦC6͸3=QEP0iu8rD8;O`Y+ptԐwR%́^x7ZR/< 5`1T0ZLS.(2b΁t&Vk]?UTU]Ӈ:},.Tq9a!(F4͔]ܬF2k~s*հ]nKOVgkIP&/r=f,uΓo!cu ["'||{pS bG~]>:yEo{K3\G&$"lQq`ȅJ;]<5R! n@e1w6;zec7k`b{VA*?񙍜8IK}KN[a}ُ 6΂|ozAwe.3׌5x`[bG\Oȕx3\~LOgYnj[CeD[K`PWR j| buƌK@nOxipITgրCa+`W긘!5xwC= CKBB> 󫨚(l0>Hi`}mdTc\.(LلظX>.v1߅b&\D4v'#ӒNsZjm|~ms1`~Tnt9uFhṿ γXE# %[?''il(44Wy@xrBF:l鐨WbA 'j1-ν2*kα䏓@;U=i^1`I^INšx!n/pM͠15i5~jj/BpYu@ sB7s%Eym[޳JSp.닃=@ޢx+bâgM%xB0o0gO&mWU\Bظ{ޓ'o!ÓfVV#n 1gIjl@ 3CdGsCF]l(7q8}BvP+6wQeۘ7RXg9&UuTuC+S _AU8IILAT:@&ֳ+ޭ4 -P0 /wɕ41ǟo8CК!fk0ݕGkɁn7Ъ_r$2!+d/?X)XW6~8_-u!`]w(wO}/aLBHGk+Zҷhua븻'N)6MIgUky\5h ֫u}7|Z' Yu{@y[?WCߏZjN k 5&^󱡿딩*lL:] J{rK+V@)YXN ּˢ;7 x* `"p_>@M"gc |0#6p^`hnq2tH90yE k,_TEܗ@V/%wsA-[^qTRh4Z;۵ Fj(}2"/*72Jm]H4,0dHB OiޯxQ!]<৞(C^02Ұf,-oY'Wy 2+ /8dNU /Ó\ S: Btix"z̋DDBI㩾[ B6|aAc`^qE/Yޖ& `T_PN' T D6NױZ1tk(ALyJxO M\-C.<6LL-W548lPZAy5&P!(LA$-7켘Ǟs'᷍"E ŷipkI"DKࢆ7cJ]-N5O{e_☮#&2hZ: vsy]=*茔!=_STnjJz+qIȨ`$TpXK6~gmﱎC|[ѝFG=4[$k=}͆= 2ų \ i!xom j"E%l'Wd@Sam**޷VPY0Y˜gG]30ϖm1$rşWyێ<:͉RL:zC߶Pq 'bHrY#+w7c9S/Me=1S'R W{2J9rοJ2AUoA|8oYϪNy< -ٟ}3ÓJ$6ΞK%v#FuHِ:/zA @*XO[D.2s(E{r/#7A3/X$TL+V9R?Cgf \*o};0G{VX!1WJK͌H 9pt7=L2sբ]S%QpMq[iل ¬Bx2E/]Vi=cd ֯,;80D':e|Ҥ܃b>͡<`IEiF(;t6T:sX95gw\ [Gؖ rF)2 ٞ4oz>QF0{4=jw~RpY36t=^!6kbg6_m ?eͬ (,kr<5r3gDv~7f|N|.!)zj^X^}ːY̯vg~I)%/+>|LJ b9 bRPY$z"|yn DY˺>͖nZy;[pG^"X`]YDeA*1n ;Oj "I]u ʡup׳#XEoX<ٺ)Ѹ>V,iN@%oa9%6B[ 7xt[tID]HH'2;~W2sG=͏ 'AGaz}dݬD+Dlm5SzHugi6@^d}`RF~Tvz0+nW4^aycH䖣uiEIp 0|ψBzHYz7p< . ?-&M:MmkO "W]2^Y#ײɴՀ!g%Rh̒0{?ʃ/Wcõz MC S/0tI/?euߍUC\1ݗWh$(YE_۫)3E VUJn̲9YYrs^9m1UHg exW= CΊI~.i?չ?7UI'#_p4a-ůǟ(bDIú*]ީX94[ wUW"ý!VQc[:$ =DSɄ'(hv9bKX+O`{B"*Fn|MƍKdz2HR3yJ=3QBhcF2M)Ndz5]hJtǏDEVZj)a;8MՈ.փxl^ A-TӸe[ zcm``R BE׾kaї$Z=/ lח".<kZ0> (GJ;_[(bi>xWm'YhbH?L{زCp`=]žULMʖdOjCB5!/NnvjS;-QILf:1oeFxAE5g>t>QIfH*>T1ynP BjOB'6:$+u/⢯ґm҄sE"q͙#OtH#~.ư諍HDIv 73 J1b;VMf'|EaDvL?,(}uw &po~bh YKtcssjdvs_R4bP$ ek՟YyYz.-<<\iaﱾ9" CXcts@(V_D A Ɛ˷rwVc-Wu`OeBJ2Nd ߠG 45FTݿ |~RM1u(o fxR8sD6#>G~ixo>\)*E~4ؿWH e:H4 &(i:tyN9Zy{n$z8@',A&m GUNGY@Q2sU-qn~9m7ѐA,8T#x7GWO1q4s<|RW NVߤѼzvڳ', ԣpy,Zʓ&DkS;<Ԡ_ü e|a(t}RdHZyPqԡyK?7qѻ']F'yIhXuk;wrW%鞶l:$LX6r ٭˾)_ ){ PNt>)Q^q>PUVGq%jwe _5?8w9)8Qu>C2iJ.p4LjAm_s;lסRa&]$>$H T(, kM!Q~K-4̎R@5۶Fّt\15b7dr.ڹjY:u@B>Ҙ t13]aP*[ 3LȌ _9⧍}ʹYo'TXnEr=R#/ )g{6rй.)l䵍=Yk3.<_o,NՄL GN34pwj\aYћvz-6" h4MJB7~}lP~}NH"$K[, 9ʆamס?4b@j~#8CnƲ3;"= kn5T#r+N;օWOч6F?3>51W^^~^3VȂ/WUPG׏&> ]\=L.z,'zN)Jka3P2|r9>ɣsz}aE;ih?mmq[k7ܫfk)vOSQފ-L%":=5W_m}lCޫ#%(=;Yˠut7Ħ"ĩ@ $#0]p=|0Hn[!. p!.!]G#,2]fJkHD2+гN*f8kmDt/[lE#fVeQ~_hM6U*&xeEi~Ё~ߊ{ G;<؏/("UFT=hxYi:VM68B{ M,J᫱C-Je,¥\oaH-,j"fm¤'I4LVɄ:oWѧߑ3x5@}5P4BI6bfO]6ƄLInӯ#uN4}v갇q/r?CGUh Y 61i-_gSq_aQ֐(~58D>&뎍&ğ¡v66Ҵ$'oYmDp:SRTuw4"sIx$KX羱Izz3uTqT.iaT|zc6/-[} qxbL7r,6\B4M0>c˟_HsQ</gt~lyQ Wd2aoCϽQ*.*". 띗5/j] T߸QpP#~__YfQȊ5}nB)ƺpZK 6 [o_ 74D >%,U'=C羌ep.2|Pŏ,XeraVwPU}~?(}\HEx>z MSri[JUΗqe>(-(nan^ g..U q1$Il /PGɔ0})*6G^.ِ$F64jl꺗֪vxݶ4T,V}4^P.D^bJ SRN‰ABw??FbJ'wZil`S&5-dq-[ +af IۖʞWc%̂Ȉv`. pFtgZPE+ɻ<Xzh4lQX{1 F7 ;q}* [jl2KEܷ >XJr c<fM sze1./-^12u^-'JDk#mvfxpV?=v?fֻ V 6 guN}_щ?S~>,rg;iww9hx-ǵr:6GZ:e}Q`8ԃx_%}u+eR\lu-7sUch OvwF93ZFK_BS wlzxT$YAo֠HGb|u,pC@2ʵ~K T__d#q@W0 )Kt@;cNT2@ZlɀLtTߛn@n4TR靕Mg@^}*#74¹*a7Hc'n:G:|#UeFn/,2} nRW]K>X1%aX6WAy;isa|Šq[Zr! )sҢjAD8=+&j_xO'a* gfpu?eTLFb C9|U4(Ltɏ:U.(@Eȴ6E=բGM'qkHΑsQ*ZPwÃpA,BCqn7i=ޯaםsfa\;1_3'HV [ݿZ1V\Q%LO.,*^r֠18cL d*/xco!7GV].KxX |%CX!aRe]. k[nWi 8BR4(ަ((S >>폅;Cֆ9z0*^&-^[1!H\]d'0*QܲcpYR7BO‰-G*1ގvůf]Vc)FasG&Uo3^}yvd:ᱢ i_WOj4NeO,RCSlv3fEg20HV(^+>qr5,KSʥQUUfrJ.q181j7\!J;#%)caUnFNtV2 ̠,9<Ѽ0b2X j hۡWI -kt$ԭ_Xu e?#|Tb ?T)ZwSSOMm (#A}nqjmlOܜyg:/gK2lRDVRr5t#SN;V.m=޽FV%bʣ@2l= haIx6[INz<_|JQVbC9ɀ-~/#}?W3!Zu9}eg>xj@{wP&+.Q'L&B`x[hWcobs+0flw`Y'&w4è;>ϼyD]A>= `$ ^/'?Љ69hdHGRrkifJ\98}7\2^}l'zf)/^-S7k)e0=x-轱rpnja޸ڄ~@2~нK3f;(hŧm|St~zf?\R'ɸ$H6l3N×MG/|ܭ*eR$iQsQ+TLH& Lr /-Ky赺߹%ܾ氢bab\zCN[gEIxɭn 3\41f@3U8X:&; G)\/kUkg2iP!ҔPLNvz@Ңv';0Ԃ+"*LQ}Wn&i:8qT}<Ἒ0%ch-IS apyzQgnY_5viu2]=-f81 pVH,{۾X04J]7LNMQ9!#j_lO_H*ȭ[?j#=bp,sp=5 Q3AG6SU.4*zeSwg#ƹ;$(ld zXA(qVik55,FΎi;Q(_y7P=yܬ, qj\Xej##-FiaHkvpL9ߐ ~Y݅|Z_oYooPy}f\^;J<*C^T0멐4~+ '-.p}W4-/^qbXxC&ƞxpmı*UA6-:i& +9܅c_b\77pPD2&Jpaѱ :ϭ-q*”Ԙ"w1҅].~\Ҩ{+ZpF(tmC51RV܎t2!8{ӊcFjwDkp[8^ agNWˈ>A%G_^.g@1W3SVU8YT=$HrɝT69a$"GszzYcoZ-Wk>1El!Bp) )s*ՏV74W P#vڝg㪛@l-VKɥa4vRY4t~(Ђvc]#C" ,ft 1.i\K˳ "AZ=4?8m`N r_@ a@㽙-n,`e$+B-D'>=5\?Aij*{u@^GNz㈰%ʍԼhQZqi}5R- e*aMۛ"NZ ks$"YL;V@瀗R)EҤqѥt#-V)(1aW9Ѓ0(H]IHN.OV'֝LymTAV_w x ERjf)&9VSX!b} seW4ϝ12K-_V Suz[D|dTD&PLpua50io=PRŎگ"/{N;q 8GvIo*pC54XRۛ-^)Vtd1ml/2%Wu3'[ѻiUeL5e =l]cSC iWd0V[MP,t,GMb3yCq5=CJoNqPup6.!qfi y M\>R/ͻ{áp],&@Tޠ]:[4@)aǧ;UXN:N+[襐ydBeU) =5_Tzzyv{Εlt#Z_?JS+I+&ϥC^iDsS)49;!# P LbkAaٰZ|x<m"?!64Y3W6hdX{dw,آ謻av3LhwY!4QC0^jt.8R1K #2Tz6 p31J0F4 $ӝg NqՈ\?Āa`hYVN@ƈc XmΨ@X]ΩFQܖ4z'Q#R$ 6R~ք3; ,QD'^>o14{6UF3ٳThJ4MfRBy}zam YbKxwA%@>XtI80o,E,ha7f3cqlrHtʀGrHzO4{K4\hna8elpU?'h ܃Jsqj&󦡬qюӅ@8؇T} ЎES-+덆=[Z8,j:qhѝ&*wѪu @Б6%m|Y8*z$ڶ(2NQcoŰwrEh JVx"s" ֓d$1r2G kLr)("UECFCɵ*muB6` #QZw)`]!-m"׎R@z]7c <,C$Mh UDQi׫$BRh;!# P&nyȦ%KHysUx+uh!]Gv@<"L14o{e6o7;D[D<0gS(ڳ{;,vߚsqCpKmيbsoƄ0?OBF=~{ .&q=PX҄QW{ʍU6JR "k8(`/`` Gc![4hkOS{!5mm*af5, }V1,x_4G Yp׈ u۞=:k?27 g?$`*;XQ;|k`-*,tKO7ޘ?v:jLnioM' e]rC; 9bkwMRϡ]mғendstream endobj 265 0 obj << /Filter /FlateDecode /Length1 2613 /Length2 18786 /Length3 0 /Length 20288 >> stream xڌP cݝ!w?; - ;w{EպwaS{cf&*3B_9<:ގ Q' H&f2ȸY<̜Y9dd?<!  3 c)؃=LL&oo3W1$\mlSGodkihn]]@; okM-]mV v66YhdbblGמX-Y\&֠4ߌv&- ; 4I,of6=b# `fבrqE~#No`"N&o `XҿQ7@#P>O_ʧ}X@F쪿vE7q@\4#7_ clb :SS~2v4 56rUdddb Kf+bQ2ۀf6$ 鿐D̠wbOR􎮠jo]3K?bw3wD J@f`$ZAd5OƠwdvhЃjMl?jPՠ`!F}(l8ظ:$qݮ+ߓdKh45Lf2:;,; g _6@? zjAU t3X8PK\ppNbǞ=@P~E:'ܙ&N.K=& &!V!&g)4Ri>x/;}w}DI tNA]Z!y>iԚ Nyz ~i {`Dоϋz5d x E+R>ƃ{G]X*YҙjQEsyYd.`i/=Pnfs&Hd}OYyko|5^܅GKy>6M-r,]\ɿD9O3Izƣ#'d-9FVًb@[pKg.!\ا? >܉T-F{{VVvRkDl~kId]哣/<4>WOUF ywìǾ2sWdx4TFN 6]*6c08na UǫW1T.'/wwOBivc&+3mrΜRB2Bm JLޛ>7 D@ig}2onJ PŌbb\Ӯ(8,ԟM >Mgt27Zp)t2 YSNE&uDrlIX>Y7o;:c zRǴg^|)Q(92ÁU!P:gS_>ݟ܊R-{c|:|Tl1_mmJ>9E|2hi=_i:?k`򇬤BGLҧ(Zfs<6ܜfNjNU#if#M [i?#=ZJ%L:XvC/`ƺ3#F??H}ʌl2l!d82a!Dʻ$fvٽUe_A%v5:MS29ѵK|/Q 2_l?wܝr]pF[ =-h;Cc(a}=@Vxn.W}qk}k| 6'\CV}Ud%7xJ8{eRoPU/o϶ENiky5!?K"}pS Kֲ B ΂,>D('pj[z,1@7$NM{$BBݙEARR?PadQFp9Mzx/h^ &Ȩ}lYRaȰf'];N Xs_L"XXq0#@{[aA L^ᖅ>tjtg͏|_{s vSTPeZ-wes:ˋOߩSRzP0ZrwzHpc0`'ߋ]n}H.2ݱa25^wOc(&Tro)(kI^qt'nYO6:3e`?ځ2 txmg>G ;NƟr%2!f7_gϬQ?0wȃk>/ [ŒC f?;$^v6S&Zڕو>2ޑQ$*{*@U8Ő.ex8) pտˆr@ ! E1n5 2<&J DkP ud(f/[ѥQ'݉ gfF*\/kg C>!H2o^MRT!Җ' h/s@W@>Yc 9MS/xeh~snsV~/Yvc^2sg *;BIQ 4&Y,Ҽbp04fp} M&"gm- mknLnsSFN0,?dDu3QFSNS#F20&Ov (SiQe0ok% to+(lh(=HŁH=]d^#;=>&گ^"BM$=c&߆aB/3p>@a,GsHT 8 qZΝ/ S O;  xHy!䭼}xL "_ăc<[/o.2A L ΡA43zS ̐JlDLIY\*a >U2^O|AE.8 JЂr Q,.9)I?R ;&99VS&՞' y[ pP"G6оgʗA~zWedt!  vd#mJz8߇Z;_Z!Ɇ3vEr&'|V%'7/ty[MX7:cg+x4=K/4g,Dsez^TC<{Filt/쮛2Ī׏ RX\ZMvS5Qa]f|O]d<꒸f WptG ]t Hn(ZXcC9{tdH_#'^r%*k]w(Zu|ǯ\٧O9ϫDҔ>&ނ)R?b~6}/#nj-!_?$A֟a\4̤ij6ǩ{_EJV$ޕމ)PxA V1Nk䘵:ėȅsT_*6=_Uқ-xޱP^Lq=򾏑L&F7e'V6))9aO_GB5"Ì*pyq(`܈iƠS=wuߥG[̯|MCx\ю ky_|.5i7,sğ 六怰xYބqP2GDw y M:^w(|?%B\F$p)t6edĖnNꊫaf9Aimy gj,0;jINPV#QPK(E:1 wP WHSeRE'YUE|ǔv*wYY_K,HzO(ݩm1a^iGiJw[;fqk&;OLɄ_͹lU35}n62 }WJO/SʧB%SP'Lg(Q}AuWJm-]}u 2K`yw')+x9j* t/jQDxPxN$VƜyNafK"s fŮIbun\YђE=SZ3c O%] q 6qYtC2ns5ɇSop*Jr>[Kݘ'>8M4唿VA)5(ʽ`Χө/ O2N|e=}u~UJG;sx8[ZZb d͉䘂fM)+雾h-?X3vTC>~9 # $LWD]X 0xn4ݘEt-#3d`O[>q^Zlw0K*R#2EG4~oE:hWX96[+ؿ ekWJsGC$jBPFqe(L/s˒5JB5Ñ=؇1婋X740' "#*!wbVp+.(ip[I1yCO_LAw?8eHDFfXC%nw wm Qg+%j϶^HD 75" n5"wlJE{3q Փ3V'ʥUцEUܮї y$pmn6>L?zM;J=~ Ks:/_KS[ԩ<.{hDZ"DEo?W&2͐98gLVCx >=~(d&fKܐGC =(}}& 9et ddF64p 5 ;0yIe-4c%Ȧ Asykvm>u9u3fa~8g=sK '9婻z\M9KF E(;G,,ŏ.pԌ:}B>`zFNH!``w?~2,>01"(s:B$f$딓/80L,K16͐޷V o&p7'fSp$D,z,AWy\^PYճ\P51n08 #^PUL"NC'1B<[zQ⿝`T;Űfb}}qQBfe(@߇m7B[Vc>dT'?UV* rGĪ0Ȍ^!UT4Wuč{NXsQ,7h[DܾkV?7u-:|PbrXcFn*e||nk͛c^ 7q9Ao6e4{M.䩟4q{f2Af(7iidD(f0M,tB梅԰O$;7;YZ2ƛy%L8"uSL%b$,]*:. f{L>.1؋}- 1\=zY[[FK/BJ0)ʰ`vI г>,ʄ.zJitK~jєC/ _@:Դ^}ށ[iԬ1d Z״i 0oUG*\YqYZ2lX-TNt./9iBh6m)#4>!q&Tԙ4-k$cj3gTȏpVZfB"6PBubx`8A;]OsnOOoœ&^u[xR ۃ7 2weImzzձ?b,xְ'Q)%4AZC0j7v]/12&%mςU r :f?)$ e!Luө,SJw/jSϪot|w7ڿ Y.i:ՊΩҦĺJ<*k ͽf[ݬυS;`n7 vmO?*j1oG]LUة3I#vjX/~0 !7" 7+MkۭX$a;/m`6Q#}=-mD۫E0ճAsD&G#Q,43g,*J2:V>f?PoqD=|XM 0(ڠ G{Ob:dmH+pHfdY酷W8!X[:}ʔA5p/M$_Z j:Ϋ^#[AdBuQ\)OPOFAU^YF8rb2&UʆQ]62]~'fɺGARzukLbrw-i޹kx XN*19b1`6~|%6"=2T#"aXt={wAl=9|ǂ~V.Mbr.F O~PT|ԩ|iz/~$zo\oE)/h&lan;;foQlW;lH Xj.R`w~RgmA8\+.\6(Ϋs ;gѣdK_IvGq^j̧ԠKPΡ0"K $\[N:&" =S&+4. ݱ+kYqYǽ1=hȔ;ףcմd̀q,2r8Th1u_LgP-MheG\X%q\l+P68Kf)\ٻ2".~)RO5/6F[>eǎ7gSHR͐d)Ώ+1* .D,N Iɩ'BT(|X kR2 k|VhhL4pȖ5})5: 4X,kq*^:qIc\ΏP3::o/9NՒ/w :h⹄v2;Q,LhVoBRH"L34U z(om>%EܒJtVFAfvyo#ّ Dhm|vQ]VK_v@4*fySyy$MJ88s ֣ſj*WMh+>kqJDb&}qY) z٧ z>+GYB5ju*CJ_Y' $ GEz$0:,N䩘8qQ۫BlyyfkpwtI+|VLY9EL6{<_Nc>Q1";^ցн*a 񟚧V΋Ѻn05=+GBp.r%Qţ&Wz_&c1p4N']DnyS諍LOw b%C2ւJZL[v_~I&ۋ~g(`B*DĿ sV4MYGmºR(O:I=*<^¨\k{acVzo\9sfe/6x55_<ow2T)/j^!xdW%>vL vZ$32f-$*p:{E8Yu}LW>e>E|T3Wf (#asYMd龐Sf(2F+D!t@yϧRi_аk8jDM pb/yPIBC+:A<%O<"8ilh޽UЧ Y#SpҘLa ۹aOY0VPtMΩ|Ɣ-fbc_6~^H)QYOuMw! 1[->zn$^v1e{Sh4Qm֨ Ob9l 6™؝jFh{9[(ogbA릀կ߲ [a0;_&>{`pc/Fi´4i-##}a!1:`XݢEyxTLWϙ#]i-1YDd;K転?4;8SG]%rk:s+{7Dr"{ؙMwWj&Qv: GdB00Yw6[Yvb0ImhIOA | XP#5P`f]1 QgfH=\zt t:C !wbQ̺f*J}rw %.@INkEF A 3=/``){^l Y FVTCR|@"<:Aŗl݄ x_G%jȻ͠-,H w[d*!AE `OE/͏]xH>Y* _;_: u `3=/W՘Z/Ȑ}m"Ѹ@f1UռĵEȠedqS z;k!)P|?[RMow:ᤑZ*)ۈem@D!m:6|j(/Uf{+\|fќD< ] ٧Ln1YTx^hXt@0o׋X8ќgը-`k*>n}McLN\$!F0[/=3r\+OɧI̡הSЪƸQSiT5N訍A4}ϔ.+?ZU[(QdWM0 GCB _CX;l $V+%E\YDVu7CfsˢE;ֵ #M;oM RLxN3[s>.MI8Tk.`Hu!`t>$T#qUG[f6|D#u9Wr:8 xGu6Ò鵧M/L>KH[}(&&/nwk*7D^BIos3jMZhT1 ǼW'j?cO)dlQ<2;4CR@" uZz8^-rWVtѓ,;.'cɜ}T pg3H!B0$hښsc!Qz*/$o/MN%}[J4qX XƮou@],W \x9 ]I #*8b~aϞɾ{e Dz3(XϢaGrEp_ _ ? _LΆ]kìO vm}gO!*j'V+$eeZGmmK_]b5Q*DoL;u@^?bjXsaW8U+y ďu^t['o>nEaP91)fSB ndNLXm3KMlWZD1onUEŋDO/DqAX jer9S]{qt'H"gK]6]ޤD%IިuqI6O#v 2&īBhE?4jW.5b/.!.(rc36LAv ,t8M ,*נ^:$SkdZ[)\ȹvdz?gТAk ^uqZpg^2vQWe˝KBh͏QJ{ўi79j&w'~ܪqҶD^ɳ 9@G|X?\K]XM.aޜ5S;En&̬SF@f̔EK*SQrdC2F=2YkGzTh-bnb'mu)Q%j9wl*2BNHGzEK rD,.1M9Z.V "F% *82p +H"}hN=ej_ԾS\$ l0Ĩ i%JEƙa5"gE)U'LVs{DuvCOi m/*؞qEv/[O:[l4DVI*Xpex:>StjY?\s~)r,y9}2D#T?4k$~ŝMzʸ~*)lp0X'^q(kk 4J?Dbêk|? ƮjsA~Owt&6e0)mT %FA^G/ؘF YrU07S d|ڿ+KNPN\_H uF]ʗ_|Jގ11bC*wd6Ev  #\TOX*~iIUHw-skK*nLǭ|jE~owwuʹy$(?kb/g} M^>+؇/ S" & z}pWoR_^B+53/b.rzi',Cx~\psN%s$#e$2oXdž?[:;TxSE7!kBf:!M9:F fO̩"nxKz`skɹW=ZX1PviBj&*x ;_L [D$Ч/m(g΀H~V3Oh{4h*#zz[q@1122k9WNe_cR%.:.}PL' ٴ{prVIM.@t(U RM|~ 2&CyNZelxAuGE4hjO*5M`Ev^>ڲ~fUbz$:LPɠgn)!6Ȝ߹,wy+5S?ā$@pgPE͛Ś6j>j=B^j8NMUԲcy c9/ǔ0b)K$/u u="ehDc3- d;՛>Kn~l]A"Zhn2I&Xp&'36ߐ ;;{^rI.fZuJo:6fE:C4+?[&lZ^X:[3 tx+v K =-Hp7~dgLcz/^~"ӦC3岽 Kw:9FOSJ+=:e55)7J\/yV4_*Q6`}l,b,8?6_,I$DHkm~vsi~B%&uoM }DoH~mG*Qv=bt-~$~uiͷf@heTՖ('oS7VaMl,`mET| w#ݕ]#pN1>y7S<}.S bs{5jmFm,-i5? HQC=v9>IƷb$?Fm 5+Y֠;­EѻH ;Hx&bȫCD:Ҏ#E]:+ 0<8ޝ$@H L4@T\ʩ"X"Ʌ[,&=.27[ttP:f)@ lxˡBRH'4O`hfbU\ᇕ>'U ʈIqfx5o_yyTqEK=>v.G!G3cvhGy{ j?<|鼻Ci _dvsIZ <7 (H0xӮd$; 6bj 53U0'kg j5;4x]e35Ô"u tHzrM9(o1{avFL<$7:}rm br<hB&U(D9Kfv]c)FzBOyhd:C8~ z+ >bM!rD殮W'&P闣i?i%nm+_ǒی@ hYO]= }S,z6PSٺ–+{k{C]ɝ faf/ +;ë>{$3{@S7C'd6ItιTVN_p.BMeP|VPq(0 ב=wRk<!s"S=dΐtQͷ Ǜ_dݲփ w)\BZ%*|Ku#㟶f\ø\c‘{wTpFBu\7^(GhܳsB}1aNA!dLҝ).LЁdŵTIkfzD;^jf# pΐp@^bN2Emw1hQFEx@B(~Y}"Ō Ҧ]Sb5ޅQm}9bmJmiw'1;ѸGj2(zX)W?,Eŷ3ݶ|qw6ɓW0€ʈ }cUfd ]_?5)t G2T0€75ZCFk{ZVaSrXm}ta~)-"N+u7?>"8`&7YW$?|"IhIPԷ6|Q[FLg%Ur^q]<@Eߋ _#]=V'n0Pw1 ߆tT{ )tMZ-6E"=4*δq^#?r "^Eǯ]x/: j|e䘏;: I;zU'G`$:f3_|5ڢ7chL7ʴYut7ő}ƾd޶JL1W$̂$L%d&zWMWlTpXcخhc1=j^`z0QFȏU 62v=<3jbfȧ#vk t$vTzfD=Nܮ㞷%&2@;N=u)W{ )An>W\^؝b++o(uϺKCYFM[aXua~fo*\:(1el-ʡ&4.Hɓ}Ye&#k|\+}Rb)dSPΏBӲ.⎘ '*C5wRf;wݲ:/iT`:U |I,Z)gD9!˿Vc{Xj:D//1%Ǽ͔Q4>Ĺ}D8jw( ,0 XtɫV쯮kV|cJp:\ZcA?MJkO\|7?Xsρl-T+s]iܯ#36`1TIIYXbK/sO?EL l"A VvdW&̂HOQ7.Q];h\p m$r io2%2uZtvj2 Sx 9>~ =V6IJ}0(jrNQPGl>o4mfjg wPmԶGj q\Px;94W|:K[h- A ~"{reE-{ H3d;(BK |&(G3})'>/=2ꁚpA|W)J>Ew냼3Xʞ0YjGӛOhzFpW߬΋/Ek'_&WJT1YajbO*qg }VQ FڃHoe4MJ< `f2]y>Y&될Dew~l}` ƅFUxH> yo!4 \zɨRg '9:v"ꮫ '-kdu ~́b3~#Yfl _P.c/x8" 8؍E"y-}c ښ# P%ʵֈ=#c :zD ZvMm#׈KnXiv,Xj΋[z5R*su U+l{32XZ*,0R4&%@D[bDl,SX#dlz#YB4pX= t@t#kI4Er`fC~-.pږ)0o)çޙѧoj3$?fBgn(x8(,n/.ǔ)=^rG=V<:$jViwc!X\G6!L܀-A"ul)?]?|A}6R{}.;hl3ӇVN& M0^J}Hֱ=w)1g s.RUh&*$À iԹyֹumJlՇ1u,_ !ո>2s~N$ǝm$qGEl"w/TN6-Xv00#M7Ҳ+} o ciAv"M^F3ԅv\8m(d^ɌDȊJ%]C)}LHdJܚV#<ۜ=qs˒%μBl\1TP$U d={(eOPUbdUu܅~A*(- 嫍Z NwN|,]N[]OJ/tEdDqo>dWĭ'Y6r 8x'D|Ozu[way 4p:|cTIq(9 " : g}V̿۔'fB*PC4\z2:E~#Qg)('[2y?+< BWFi`/czLp\+epsKbz h<XQmv=rv/Ljr qQ'muxsMQ-l<U $N ryT2goQh~PNൔgm׍~ͣcnfKLRkYKDqxmt42rRuz?Lks9gi y}h}P}Ā \{5Cz8͛ hiVWV:\AJ.+z=+IBP#Yn~3=i#^i,`iV{m d$XB^eܱqaT*Rzxd h pT4֗En:Q˸f*i a"e`{ڿ/ʹgdU>pۈaq[Xˆ5iV/r'-"mGrp@|4dW8_\Їm{bl0fQ_<}GU-;vb&5J^{E۔<{T KYvu.BNmTŢ}4:}y/Pi.}OSm"h Bo( `v ̕BT{)FSQmdiU([b{v6hfrUD2Pi9dFPSu3*E-5OʶRV̈e,b=l6Xǃ&'N[>Gʍ pm١PĒg53AeԪvg}o/+|8˭jpÌ 6dBt(,Oloo w(/C+IlMPgM~ `/yJRAU?/mK#`-.}|gxݝQx{0ր<ҘㅺXpFfj d( ݩƨNqJ$ s1Xj8.@- TIql%,#B<2aQuKYEXuk -T9bWÏ{ _"*g ^=.UoW7@K ЂF)\|Pır;7WUVg)͍P4nǾŕo.^^|F |#smׂ4^zJ16@tM^ַN(kd;liw n,zJnFX6b(=ł{J1w `7V!x 1v̦Y"@VU Wi531D bFq %,CP粛rlϘ8endstream endobj 266 0 obj << /Type /ObjStm /Length 1807 /Filter /FlateDecode /N 82 /First 710 >> stream xXKs6WP74qkvL9%I}h!iO.jGa5>ID+tPǗaFLP0$9a 0qZm.ᛄMF%>p Q c=D`ыzb3.D#%ؒ`2 i ]CJM6; |Qep Td 섂Vk uّ b 4{(40|)h@swFAs>4'9UjVz68M{j @&VO44L`478 0L4[0m2g 4{z;'NM98p4GpT gMNcYoѲBFa^X1Ry/,@ΰ ʜp/z^1Q_}%^~/o~C lt2!6R#C$rX[@"CNzQ@Jl i:P)NHrpJȉJd$򿈌cK;M˾{2A_3 U8t6~'Rs|Osnt*J'Sό=W.2 QiL2R)3힯:H5HMX+>z>*QdqQf)Pvf2Bgs5"œ>z4Skx\:UQ}F/k$ySjln/wki~>헻z\6⾭ͪ۶C6z'b|݈vջXb[uuW XWnl}xDR˟u݊=.pFڶ7u[݊.^8zߝ?] aCvL /NTf]_U[/ }F>ʉeDXWeP`fXlP .r?g"eh-YQ|; =rʡt/ gd8{xe]Lqy崉cY(e'˲[z,˅М2o"7G2ci"K,)E> stream xYsF) )*CB*U(CBvHZ[{ivG e5uOREN9B.$r"!%Sx$ӐOK:gyGڰ"Gɩ0dIcQdMNCӐ7"W $i!Tj-0IقV,lH9Xh.4,4, pl4[urh ^9hAG\$Aؑ a9@N+/`[^h+/3 yCzh6^y84[vNh@f05ab0@~=C°0Oax42L:s<- W3h QpOF >|Ca !1H - \KL,\=f-dᡛA9DǏ':jYfZs_ =y2_37t2|D^mXma ~賱C"l-uxxL"4&6B4b6r2ꪯBGwf=o(|e7ʛ$12JKcIbq;$q9=PH!]UVWӎMO0ӳM-q4~Z~`&sQ|ell8mMd-")NGpƆ0*i} Тޝ͚%RE>S6[*>)f3U^֎ĩ9?fkEgoBWWe=5MlJ[oQ;+G =ulg TaOAxqh8LvK`uG@/pOEwV",gy!n g\fIq ʤz+&1%>CYnfA%}Gt۴E}qz;W* ϙFmgUFik}غ+gˏaIwҭhSI'Q uCؠs:#ps*.g8Y6vve}7͑G.nZy <**y@[~Ӵ/i~;HeǒsE˦c6Mq3 _F?k##jq@ZS"O#n{|K=-_Y&W=?a?Xe媮1b$($q")> /ExtGState << >> /Font << /F1 111 0 R /F2 112 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1165 /Filter /FlateDecode >> stream xXMOGϯɁvWU^HQZL%_Wݳ̂єnS[]_^5ܭ{܃K͇] ;)ݵNCϞ秿Nw5ۉa3>vX0-6wns f7?un7rbPCv$[2M 6T,|j8[VKN^мO98<|3x^\`Cj4aJcJ GV:U.;7ǜ|1X.Ыp@DZ.3–FoaSg SIGd*>XvuгF&\zk#,PS6X-w(>Pob=ճƝ9$dߚ(b<ŠILZQڀU1$. \y/Z!i aGyV*U} |!_ӫ`}@24LJKUTr`{ eXpJ- @Mݑ"qT:# VG' 5Zd@4;,! Sޟuwᩓy-& Nhi(#M9gc6'dn2lNC ,2xxl,tNw*tuVUv*W 'l(FՊ ;[Zff#(88kD@皺m(ƪꖊLJ~Cv @ʢoɦUbĕuf0 pU8 (9(ڣDjB}!${tyﻰ*;ur_ -T9/yuH|^KcEbEA}.#9O-ru~w/"6<dž,p'91.<ܹ3B1gڼFt?k"3Ƣfgic5FGpl`^_ͷ[i_AEJ@ǃx^.rN \Uey\q[~dɑ+Z߈ʤ7I@OhR\ySY #m&z"ܣ8g:,#hJX> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 433 0 obj << /Filter /FlateDecode /Length 2051 >> stream xYIoFWRhpfhA6rItsre"(𥿽orF-IS Cp}oa2$/ތ/^_zJ*5,Aqenp17C=oxXh kx#o]u=Ac;7ѵ*hUֈpE"Fi#eωJqtE ~O6+נ$Ӗ{~QھLEC@i:e4imC'Q~U2ƭQG/4r׷Mpu$2T8R&ҊU$ME2R2ufDQV=A?J/ϼ|D[N o}s3KLG̽fg6LY{LpS;41 P-h30 A(<#˩ t}\Xx!*ڸ#ǥ7y{elLeQ`PJȸ 9UY-pHh } w]D`T067w"~Zjմb0!KpZÆWy6 xwbeD ƹ|LqO ?2IH'XBpȱcD$ D]K& ń%Lm&"gOT:QE)߲=sa٠qy'Fs81q# cr7P DgMg<1D Z'O*6z;C/'nׅ3$=Os7:`fٰ%`Ű,iE$WC\ڮ ęvt^fPS>0PYH0#= ʐq0*s:FаS='6/LF)Kj v]4Omr! Bm Ėo"ٶYgڦ؎LˆD\LJ֊zB~$PP@%K{RRM6B ڄfsArjEqQ X63Zy5HRCxL f6$-S%* hlKbo`X$Kd qQM+?&˜6qZla ~j.Ă-kEB3/B\!IԙpmG \8yvdtlS:wbLqv dKr] N5ؚe\הDÔqR煚P R&"LI- % {;ovd'\,*\vYQ, V6SfX=DgÈpP#1琭87LӸ_5"Vyj9M,*J{nDk&9R Gsi:imrZ{(u3m>(fciM}o֧2*6W,Rfw \NC* fSm7؂qioU7i,3J!fq*wr,ŕdXG걇(]\0GKn =g? w{ sj૾l[񕹛aGKqW^r?_E--Ӂ ow2Ieq \U#iRUJnV{{"x{wB*cS9K^k[e'Iup=Ϝ&pI@e1u4Dg@Û^&w{gH& (]'(ªs#[zy0$Ged<>ʺ ^8QW6> stream xY[o7~ϯ+dH5.ME)x4Օ4FrHy;ٴI/\sH,y&4.fy.]fXr篫*eK"4aa mbQ?iy҆KuRVWxXfӅ%-V9Y ?-Obi9p7{&U1URJi1OR uIU:X4+#d.{=[,s-TN_Nw qSYVʏT/,"I2fK['xSB,;+?n oHS OYl>ZA #@<pasȤ#Gw3xQKd%d0~Ҋ2dbݸ9G>KB7@^٤ϲփ7ݜ*jXpκל`g:'6F|h :ebJWX<0] :KIUq}+dU$"9YUQS YjØI"Zz~yGt?DcUOlG Z6O[p" =KPy4E!⺫v?f1;iaN^ܕ&8S46P- ~?"ǃK܄h.g|- aHr]7y^q'4mUI=5^T&`q#7ǎiD Q;یH#JHp"k!E4f ĝޤ׎b7 i2eUfC1.|R2G$,Oy.rM5r:+Gv3G.GS$ ';p9+ވFG&g,/A QГΡ39c2k=˪MP= [dITuSIGYa |͞WJq懊ƣW[#׌'i\9w԰@aN ʷ&ʀ*bA< >s ?DOk1 yDo =iD\4Ф_)?DuC5ubƛO +-GRtbX21$%/qL]Y$_{كz*rݺ:k =99L/::L*%U=?k<+Ł?}hW΅Շ =Cq8/J;<)M97}㡁ep/D$.zL)~p?ԘP1~=L.MY -x"$F/ըFAUꗁ¼H@7M.}݀K/ˈ7|HCÅr2y?faZius\&> CzP_^1[uzTkU)LE#lƦulV^r5Iٳ+{1{_~5#(rW#hT~ޗΈ`ALܟw$wQ/+;xQ0:e"><|ApzA\&;LsO iOO 5endstream endobj 435 0 obj << /Filter /FlateDecode /Length 2748 >> stream xZ{o_( {N,'EpD)G#ڽ]$-33U2YMɻ7g'/O =QI\%-',Iqeb1S]MglZ ;m,|=@"~ l7ѩTqb__,ػb F$B2F!o~x=iڿ~3֖Ҽ5pձ;,.T0 KU:2ؒ2>IB ^禰#^`' 8ӇoJUCfE]i9$-`~-ZO^U"0xͽDz zlr17+TV<=EȈtG##$RQ}S  /@_dH4Ob_'kAfF9>{qL85A'(E^&e0PC䯋jJʈJxbFw[ !FTk\9f ]2--m3,Xhe =X%.XᏉJֱ{MJOsF&=>¡*7Kl#Ea8-*kF1!Xǭ.(>ǫDP, uz"Z\cAe ^X^XMJ7u' |L }u]Y z{˙Єw^p@9]gg]ջPxE؎\e|Tb4_ePt2l#louD{xr[w;ѳFrE]-F?{&@ ';rG9$]&,m+IUOj2=Weޙ"30-0uP58q9ɶVLpr6I( kx[KbtdZ8UFˀ@tX/ekW &LsR_i>Ue&e*ΓѼBÍI}kTIʣ\"kp@zi3ޭ֋WY~R]2 ޚ*cy6(53i+vqWiIϭXMiiI5+ 3]ě~OLZtIa1OJ$!EM&й7w|C/?N_MvCw'4vI69`ĕ #zHe .-<%٢A {J舃# e--=w: eRU 7ߑ?obgȣ,OXFBаnmY/,C%9Y #Ԗb/E $mX'45hL]v.G|/V!VͨzT@8,K{ãOK4;],qczɎEft`no "]#jd-O)4SW c%ڭsVb.N7f޵_ieKNCԉ@L@U.ޥ$c52jGp2a $jƠ5&22BRnڟH2yi}7-} =O t Oq9b΂ ?vur"Bnc9C2w;ˢ՚qkjviߚ,T'2Tpf궲7nd&GQVQgSl(I⻠n3`YaxmYR+ :Kђ(ػh}3 ~λ\g#Y^*.rLh4x0XV tl{T:Xejh(2h]-dX)$|t%E*Yodz@UR:ksy]fISUf;4e2t&̜/դwn?TKTݪ1ݞۇLǰ{WNtlzZGxz[*?\ǦzXnD楠Om OQ1p.Cs-˜0{N{^.PupQww$ٻ|6\Y?MݫvӠ) %I­Q$7}"2 ~2<"-j=CܰI${jd=#y;93sT8.*JCsD̰?LL;}u>|a=/ovigΔw;:78Y8zrRRΞ+靰Ǻ=BO=fQ?3!ffx)|fp9:ǴkOx yp|&a n.[n<zݶL%14՜wAj@cS1Ǿ.<Ի5iI$＄s%iB{<&AR3=q1q@x!^GWf;dufuΦڏGW.Nޱ4_izR~F@%AE1^̑vAr$g>՜oN Eendstream endobj 436 0 obj << /Filter /FlateDecode /Length 2550 >> stream xYIsW9@ X]NŮIe&n9@ (qL AI%=o xʁR^~,}8{wyv>giI.*y:].f:ʟ*e Dhһy5 y]DvS1R$:.e(9g6ÜUZa\kԟU!gܽ2: BW/8,@.'i <¬I\6 97Q~&y}o!GN"B) BSY}$L<)t~k? z^2˝v{A hɉBp# 7,ң3YZO}!H0ftԆQ6447Y[؄N-g3uk/wKoB[Ox~氧A]5fEl%)g=`$H-R !,fh0='&E"y z0'NpH9|ϝE``XG͝UeE8͸&koY3thfZׂ/P:p톗[ ΐuϽK,;-AZTE:I\{mP <AZJ9@a}̖M\G)%#BF7ۋPqhHOIRs2:O|MZ9)N`N`V\zcb2HvLl^Rh{ùS+K&- m60&TRԌޛYdp'2<+Yf* Lre2)5 E,?}ɛƘ3|d\58+밖q|Śd*ƭi*R &˻^w<fOlFkomǎP`0ŋ/ʅ8QYpʶt5UĪOkNdJea+TSq 'S JKvExScEV6[JH_Pujfk]];51LsssH(Hi Ôc/B5,N)r#)OwPNp7Cr[/V ie=7{bīe,M:ϕP*,q^ȫZcL|I ϰO)B:M2si8-@`+d 4[A$o7Lb]W)L[P vk̻ Mxݝ~ٵ$qC~E^ x>F3*0w5μ{w|ǧnl;5 g nсd&IRy@ /#T@}k>Nly:6`[X%R{P&y vN'ݯn軥2d#$\%IKX+{~s+2ŪM.'jЏ5NVqQdbMvg7ũ ~+gHW t:ǸK睻y[Rӄ5r/j&ْR2B eu$?^")LQFKb{₏%=*!e-h:1>'hZ:pGr59\~ :Zu2U`[Ugɇ0B{l^uA7OW˧+N-_ƏB'i_*u/ԯ.8le;pR''&s;NQ(ç<~Na7i1Wϳendstream endobj 437 0 obj << /Filter /FlateDecode /Length 2165 >> stream xiDh4= mZ$s$Nd;fq)0hZHf Q -MWhWt9\'wjQsbn{魣tn,r[ %k^dEmF/XvPSB:Mer5$ڲ6 ^0 YYvqUl{BYq#UymEKt*x;2|/ʢ٭Cxh_)KF5{|59Yϭa*(,{pUkKOa$8Wq3J:Mv!%J;k_{ti2拽]oR\n+笰=s?9JUhqzi]NMf⟛pXuƵ ?T]܆gGHu-QYAypsPptțpʷh޽]Kuw-4nĊ]+r_͡4߳S˦N*gK-nvrQ[\3xby=_L7́^ia!_47?9\GF/YТ;+]duCuZ5٭Ik݇V-H|bֶv#&" ="3{ύkhRQF>4KՏ>t pW$A@]sWL:PD 0pUA +ۭ hyr$0Lod@;g.t.*37Nӣ0-gwk$oCv_n+'SQPhE{2Vi0mf.GHkQhؙ>P FzdeNTJVD̶ƀ$hDfC=33x"]2JRZZm$]lj1) ?oT~L醅Jnh0%-5%q%X$2jT? $B icS?a4@؍.':hoZ08нN3d!V<CYp úPK|K _R*Z'8:LkB7j߷\_4_E1Wi i-VVZԪmHw Q"{N]ϲ:9({>UxVFȸ=1^x2Řȳ?o\/=2-)B';~z *tnBW-y:g^|z= %N=7QX_NWþ^endstream endobj 438 0 obj << /Filter /FlateDecode /Length 3357 >> stream xڭZ[s6~ϯVP;`'nfdwLX˒Wyؿ$;(888:;[eg/\<[]LUYnnJ} 8Y21o۲&Wk B.wzR/u9ܤ;|4L›> _)@y }2b|fj{>5~[68톷!ry'XHGeZMJxMSM9YloW+=6;5e-3Vܼ7~gnd).m_}=~Lp@vp.va N=G{Eihⱹ8a@YFCOyaDqz_y 4 cxݰ.pxN쓞#o6,uZsA띊Hn-0N81x'ʼnf7rm)-TL%516-;`m kۃ!^KѭUk)ȇQ*X`I|b0λH׼jx RwKR^&=0,d72.G弥'aݙQ uF*ghȲ([ݽؘ/Hx rI~q|5vۂ/<rF6Y8݄pQÞ#"vT'tt$K*S)7[A 6Z&}2*Lp1Ԫ_R|LAEHr"X;_WF4Igz ):B <{*!!RHz0^ՇTWSؓ1£Ü x iؠp>݆ C/4+B| U!Ie049WZʭ#2Em q A;6s MD)(c G >hC#"gN:cQ0$Q D3ǯo/1yA&. #(ؼ*{&Mq 8HLX0Pb9MB_( ]XXCՅ@,fчu=GLJUrŸe٪EԨ@T F2U+xN?2k1ak )7z'F/PQe5*eT7vLPޗ<[X`>]` 0~y!u?qYhbc,;1Z&2O'ěSves4Q56jTU> z|C!" 6Dُl hIngG( zE 2  ~_0 T_@J(P23d|um ~l@^W8 UywDӃH4:AwmK U)9updnXgԼz  jT!Ze&M'r=qy Bv^+QO+3O][~n(LbhG#X pGVq@#n2kؤ*mR3Q͏UKTc껆^M*4yH}5iP;*I[Hé 5N$3<,a"n)ҡꕈI!A1 PՉi{&B3oB;Ӽ,̺@yIɠИ˗rW.Eh3Em]^}+zbDzGn Uz?Ԋ*N 'jW(@)朲r~s>x7JإQF(zs._GJeirX/27A ۰8trPiq&1Pӆk='E]O`ő&D&KC}F7PGVelI-='R/cn/ʺ:n۫ĝd̞;?ql‡kNxϼ2unzuKQO2u x*|O$㮁5x̀N~ou2YZ0uX@ $ mYw$]{@=蹖ʭďSc  ǹcWWc<#(zci_-h ܐE #b}F@t/q(Vsu#endstream endobj 439 0 obj << /Filter /FlateDecode /Length 3116 >> stream xZ[o~ϯR rj;;um'-ƒeR.q.o!i9hQ&E.w7Ct //_qj EL.J8unଋ3m?|3 p.pcb{\C墯p1cu?/￑4Ұ4z(B6σ1r06NGՎHa9pʢ_pSfK p\*9A%'c[ ~)p['ۡJ#T|浶wc{ w_X;NVv ޒ[ka4ӏck"IlL$RHM$UlK#ѥ{ij/0`$aLRBP&l(}3O4ǟO(6.rEDkc®6b i&VzK)$V ?&Gq5* R8+|0i5qkVfuA:Z( 7XGv)35oӏ'1:1@MRy'I<}WTodQyMFѵߨg|o?h'M!|힮`OJ>ڑ4hY ) _'ӤỲ0_K2VPj^%-Iz@QI4t @#_\q$劯 +kzwofVxQ7ʞ.|ݚi,J8j \t>t. ЂљuJP>.8ޕOy{x.~9p|>G`VK+y-^x-WEg8Op#?u_T( LI]Q?H|"*9xpt@%"~)sr9}ばqgVY'%lv5CMȶ-2#)ۂVNm+vD0sxىI_g#p/XBҌ4wkij] ] D-6"TqL=wؔN؅&A ՀҫAHo353bSN-B)}š#!J5<<[b3 P42"{TFf]"1@CoQq]!p U ~v't(ΓY"^N<Ĉ ^AxA:sw5?~79:M^ S&jGZ MVPٖc11jqi7Z P[.֩l,2%pzlF2k TR ñyרٸ4J\\_>ΚΩf,W(.*[I}ۆr^Ђ?v# WŚѤ']V5}0ILݯѵZWPdGGhQj'ʟIs;TB٭l^X>-﷤{/(\~r|goe@=*JesFu/>U5)DNN\B {;ע Z?[jiE%al|k,Dji` c"P1E" 8HyHPEkCq7*)|y*6Kڙ>l]ArVr0T6 ]UIOz-3rPŞFdWG%:3\lm/' xVY;S@/܀GK7asJw|Pf "a:o}Im '`X_%0^|-|WXlX Puh02 644YZTXoݾ2s8Ǚ(2ISCd8E*tw/|-x# Vv:/p|Fڊ'[t/5HʞGPZ|r $&4<r5O|8| H+n=c8`ŤD.|T$f[* %I'YIr<$C.n.VyѬ689ILpj3SQSEaǐ`eϴWD䟫Ay@nd&6t?_lԚWeW| wٓw Rt~žoOoL_W|jX Mhgo6?Ygu*` L}^ϫ,I#,zV:Bzt) !DG r_ԂZRqZ>Jj "pϙ>cszlU;ykZXjndSoNe&9/eOHQ[::wu^;8 6ZѦR|V9uRѴ{!eF3>h7w}8/o~{X'eܗ1nMB|ot}endstream endobj 440 0 obj << /Filter /FlateDecode /Length 97 >> stream x31ӳP0P0T06P0P05WH1* ̡2ɹ\N\ \@a.}O_T.}gC.}hCX.OȠl\=%endstream endobj 441 0 obj << /Filter /FlateDecode /Length1 1771 /Length2 11800 /Length3 0 /Length 12935 >> stream xڍP .!hKHw]k8r9jfjޫQihIYA`';0@FMڀɍBGc qGBru; BdWC5@psr * N 7: 5F &)G ؀_3Z` [B0@ @G7v8+b\߃, P:nccBl[ ۫% x rX/Vps7uhavt:y:Yl@7O+d! |uY: / vwn7v7[?z#,e 'ں,^;=|l,hݙC$ͫ5\ O ?x9Tr!~ zmgkzAq ?+pq,m- s?_ z8_ߓ+,N^yZ,_4`pq^~GhwUr*uN)`{AK\sqZ~q.XGWߊ3e::xm\w_wZ]i)A d1ںz,5l!6/`ظ89u,_WN.s[eܯ7 tuz^+p%O8؝Wks~++7C'p 8 A?Ha_^kWr _kkn8l˄Uvw'ki6^6O?Q_eWs{ujҿ'ky_r~ _ s'_񽚻n?1k~+_]V u)y\E[>w+ |[A O,B$خ&JԃmgLlnG?g=b S׏kR)]X[rWO>Gua-If Z;(}yGRdl:O.za;]14rqo=zwWw'R'QqY51 Zsʉ՘hF cl4w;;q :q,'1b+I}]qCryC֛~" ;u!1}"ٵg{F84,J Ȼk0͙jcoqͮp-:1QϹa` zNleT%a#ku;cLWn1\{3v%KQ+l⣮^A~x(Z="]ڪzaeǒp(d6^ybTxQm kT) uVGnc+-tnNMӱ|?'X*-(U ldZS"k&p3TꡤBIߺ^Mw=A7edŌ2'' gՊEnآ8ǮE1eop]|F횋(*`Zi:͟cn4( Уm75f+BSI`|x\`Fi^]F#%l/n]fo˪-dlԭCd48ff,iA"+w\Tq]E.u@ d"89kk6bIz$̸]rA#@e!9RtvrhcR6 ($9S>XԐBi /Dd -948Uh)a'se{Ֆ8~=;>!u-Ze̽rx*ܷ})ـOKpᄼ}MQ[.ic[xo)jH=|r|Cu D:FjihP'nKsfm=c3cQ=50I`+22-aiQS#£Â`" \]nD!^uA2gZ}XI쨃XTc5#) ?ʅ0`VbfSDŽ֊{%d=LbvXB w34vE*^7{R2P*ݚ2RD$+Sfj/cnQ߂I+e5)ZFI o쟎b q,/AzW!ٳ(#Kql},;=p]{'UD@n^vKMZ >Yk>8\Q oZ>VU&M}{^=lh .X왷 lPg/mKySbAd$#_ ay''X"(_-8KY(bG&2?s>2%](D:gZ9vc[TfOM?Hu~/#G$׈a 5DgfYDpRNo!FuӚ#rTdDƔnr/e -s1jE<?^cKlQs7nLWK0{# <.,οCv֖kB!ޑ } tp'80Yͻ5ia~"oTyh[ó@EB RIEN&r?D;ĻP僜?^ݼ8uˎp+VR4*o׬O'ٕJVP犮#x*i;&Տ)0ck;i]Xj)X9uU5([Tnt%B_.-hݒmS@d #vt &[WvrvFo#FQ[U}K+q18DŽ0N$.1: 5+ԖQiūu]r;i^-;ԛ$4}܃D7ڵi"3b5?kEF<2Y*åY)7;DD<P!qW])4qZ,M::ЌL r*KtuԿUzK}\riů.:SUg4-$W_,{o|cŏi+Өdaѣ͕^ZebL]'pB&(奩}>}I(ssChvYf7qjYV3k3$3lΐȊC6![}D+DW95XBGz5o/Hdk8.UK,7OEHHt07L_9~Wc1?-ludɸ+w5XvNLbp\\2aĐgW$51Qq'PeKHQuxa ~$a2>ô|}may1xܷBXK^=^]oeE3B"F/Z~Z^j[=V9t=J҉Wz J:6k_9xLC CU*}xwX8dy*{ǝ H}<:+FK -pgȘTZ*b]ɥǃ|YzI*' xCyW? rtw{EOFZCރ(Yq11Жv!2&CIFt{C:&ϺGAlY֤vL#5 7,xɏ&4ćLdYjwoh3yFbށC9*2.PA[4x{ULjȴ() ?.OAMUEoqH謨K\F-|*zz7 ;HV1=[fVN薪d@H7u? r\vY`asE#[A F4Cnt+- q*d| ZU|%8^g9 ӌQ0SX!-iVJφ/5&)Ωj+_Py10E.v5>\pPdZg~~"g qBާӫ:QlLŅ6_&}Jܯ`a@a;S~NjB+i ]DȘch}tF4CWV /YIʥlidM/Io9RPpNje[iW&m]fVPM<%}SwNi#'Ϗ8Z܀Ϥs& OWHIV-.}n p>]r}[siK2X}. T-VtUoq5AW mL‹ĸX䌲^BB%e6,@|`)(/#2"5znuC@-Lަ:v:[.}4PO3s4)Hěa"8܀/S- %~5 lߪ%+\ݹZETD=i˻l<$ZO-Vtgn 7 ?_RyJLbXPno?K9,p/VAL{-I\w}l@"ג(cmMbKulٳ.XLot \Z]A:!Z?ɘ^i{5y(Q u+6x;Q ~_6ūԸ]7nxCCxA$8E{>qG3a|juB8 Iqߩ[:fE"Bze&jXsٻYcQXH[*Hj^ߓ0;lC,gP4Vf[Ir E_[|^yj69w/noQ2= [Zا֢4FDbrtLlem&I\'HHs-й܁Ud^6/ @w|Xq\ajNINgΜv_@= : fih5JsdWb,acqﶙ2\zYq{~]K7GwNfܨuԉNP-6`quF_馄G)I$P\ro=~jڢ'&<ofop! wi#ڊ?Rc0Kih6P~l%bIwH|<@!Rr4SfqVo:晛#.%R橙rZaNX~Q-$2Y <G##>-޶2m)/lizw5XzuwՑPKB>?\u.b/A"]'2~$"'vSȷk4 RlՆ~+[X蜤vlU)Rh׮%CRΟoȂ;zmXaet`LTE\ pnǗ鼃WoO+>a; k13IYn#1)%!mmN1&=I: b6@hpvy=V'D_x05( B|xSf4↝U_jt2bDcM%15F#Tv6;1[7zrFW壶m!:FEJGZRBvx0;45 9'{IR$*}^E;GѤU1S׍gt*4#G< =ܺسjj֕J4bic!l1e=aU =k F(I#pא>r2O[ʐ܋Zk;KsGpHfMt#\n|B}CiR˯"~?k;zIjM:ޡ{|6;eHP.&N&}jA} U7;ZH*|d3%1k~5 ,CEeV_OӜ, R_gc-FVr%>&0({v#EёLBzXO%k#he)( M^G]]V^V0kOtm[9}xYjy1GMyiɬLZa5'm D|;*"XweH:Vl:цaIt8sKR7T9~K:`QXGgE#rYX%gې<> <[>/ 'CUQ*%7CqFVlAL.P@2ȽoX|Gr9 f* qq4ۻ*uPg.F9;<✱ 6RY݊x9~hOvޤ:;[E2 ' ".aTccuXE1zTɠ{YEY~ Ա_N4K@`v`3wa K[ސ fׄ~7g &J OOe-9Imi4Ck#(;hU*`KTJ}'Oz;Dnʝz=\p,qrb'/֖ RI]~ 1[.†@LfnLjPYFGTGq)6@[Vx׵{ZHR<8{>>ϭb0"ސLΐGd2<ç&rKokm޺;I3Md|ܟP"\Nr)ZaNO:FrKM'9d!_r)jei);Y+OBJ"bb}u֚%ZM ~qgaHG.1_Ut3~a1Mk^퍹@'6خ0uZ&+/qXV~*{VxyH \cp;B5z+m9H P;5|Hb*SmA,w{F9n:+=KwۺLn -2٣"7w* :zٙƷ3[njo; 8JDcl0=\k#3=0{~iBg'1re_kԚ3.?`TjQL(!"6F}-2qd5e2wb [c/~x;5 -R X bq`nT'lNTgߒmE(5ێ{GEӨilg}nQe^[ G{׆[ۛ8=0Tendstream endobj 442 0 obj << /Filter /FlateDecode /Length1 1540 /Length2 8001 /Length3 0 /Length 9019 >> stream xڍweT-n{NwM 44!8 !{@Gf̽xvծ:U:k&:u-.iK9Xd_kyx!p{?,&]0uGmr #j xxDCr 7%u`1BA/@XPߙA*WKG+(@ςw?Eֿ ߹T X1 woM 0XC _G q*se{ =Nx<!. :nar;{#X}|L|KJf-\a]> ZV5^ISsm t?ېpuƟ>#:kpNt')\t|g+ߖrKk~GKkRld'/$kK/Kl~T#EDSJeʥ'_2J >U5'=WĉYMqR>Oݓ.Dz0δ.O~pj2_krhm.'范1MW oޙMDTm`B 'uS5V=AC7<86b#d| rNߠ6"qB˓T2cN<^™ѷ䝫6g^AɮiCU?1SG#r~rr!#8lJϏkɹ!2txɌz ~e?6P:6WN;[L;2恕KsGgǓ*}J\Ĥsri$DN[S07 EoҾLZ㽕 BGG*%G"+!oSf J\CL-[d~Cy0BWOCw341 ycHU 7x%!1'GP:"lڃ7&S9Pg.wFԶ$|Ӯwuz hyͨ@1͍Mv]j8"5qDfQ__#(5td_fy\A*VK,w_J觀mxM "dMQ+^b_kE"mQ FD\\+U'%Y9hrfBl$$!LBb)|M(S1uյS7ԗO!7kn GХLa2644Pщ`R)<,X83-(Atbg#0/fjS!GnЀioV0:J)"z 92j(Ls_=p d1\qڒʣ1u É(X$IU W“$7_v*"Dn{askVYMԿxCRQ/''ȠbOKm@\XGAH@&!.8Eʼn}]kxM'S-֦M]gp17s͝DTT эSAA(Q/%d$K@DHmTvݬ|)Ϗw5sDfȑsL\L3x~wU%u8|AM0KYK徜q$2Zw|EQ3)Y䁋qEІ%o!A]'jǛ7έ?1;u!qRQ ~.cr?z˳m)kV½*Y>wE-v"<Ջ<(j6+o?gwɶ*AZ@?T?bk-AoY'[l_!FbA G::ky5CWrE JKh1q}ъNj7G㩨dye ۧTrG,J5PfG0 u\B5^ф2+ 8Ӭ q0R7HXM~=1op3>>Ӻ1uxtoi+N4GUz%.:͏GD +̐k{0cKnpB?ج0NXae?4-xDA(1Z .e1eBfyćyѻ/w+9ϵ2bC9DK1h ~)wMj֪T|@Zh]7 gF7E2fh?Ldúzf@Rkۧ$|bC1wYIa"k 8bwz##ljW"(,J A(D Z-D~@0Y88{#hڏ dvX*vgM3h@5 /Hs ihiwP*'3;`zPn~\;BoјkC fn%j˧}uξ8"`")~+|PfTߎzBu6qLbPmǵ.h9[2Rq7ؗN4U%ulT`d [IgVZ֭c֜oaAt+0波:4ZKVPTe F5uͷcqƕ/E7nuн9oir$Uwx""D1C?:ݳO >=Yi2㥐}y>8f@pyI|3|dQ.p3J?uNI7\+{z^ֿ'^~ESA٫ӏ9EA7qVϸ(F V` fgP8r:g"8#Bf15;jЁ:%r9`qGG{`\tfA}s~ZDӼgf\rEp+\B2بHzܨnR@/C2}EQ dZK齝s!x 4|ġwP̒ʇJ |B`W Rf6 K)\dhc6YSD(4>mX~xQ$sT-e+Ic tI[(,˛cJ'>H?Ht6vW k2վJ=7qcU}*vh #kd/T ^C ׇfCN NZ9iZ;eqҲ"+ý, E~Pߜ~+=2ЙAt鴖̂l.J]~5hsɁM:'Nu_kLڴo[%~U*J!n"BٝhQ!\h >\y59+eNX uX$v[M9Hjm"X Mܵ꼚d$ٔ8VwɞJVc4Q%lb>Z|0u";d5I/葮g LLI\Z*iAӁS:]nu v&>"E2U`x0 tFӎ;9 q{N=J=z ռtIsMP<] :vBYwn"ש(o_)+&P?G)gA.~~ʁިv 'i4zMq掠jTp *g']CBޏ[tͩ) l+yw)J7&~]) }H~?֕urcN#N`98$ڮ'o>{1#P!.V8<{@t|P6\-v,"W %.58{F!Z0}ՙ(nTd/W܌q)mpEྦ6M<#~b%vx1B o:6+!M=|EڍWL.wݔs*{J1b7Jݬx`nqYȵrxD,%|eŦgQBeKk3M IP99czfmY<+'SyӚ< F1 h[1[$bcoUQQ -(~5 G0aM3rrM*vB6lm -6*Gvs-ХHJ @n5 Do}ST߫KuHe'ֹImg^jri2٩?_Z7v[DxϷ+3El) Dv6 C{OA]Qld}, B]Z8\.f-ֈքCRvr1rZԄwTAc `H@zM./2uۓDjۘ)2!h5 T =p"{0k0֥ -?-#Tnٟ Mdxx}6V>hV`hZ#ʎ?% Zȉ|tﺰZ*|'$λ+eډɽϩeOxn1][s(GtG~(bRdIE-*'Al/d:N" dJM)縨]bsCt ^aܓm>R%$ԫ+sa'-/1uP)%Ac4/SpGw*IQrEB Ⱦp"/Ÿ\][Q;J ڷz ۈ5Z*C]sϸO5\Kܜ zq1.@@lx bUniOA46D^@I 6 ʾT>BZl+*aQ+ϕ]:jCLYLMywc(_^ezޠ[2qoKspsya7vURq8sS3sB ^;{tC!Nady(?CeH䰇tǃ8g^4Ǻ#ʴMօL~[0\J,Q`O~;ׄ*Fcz`'{M^^'̉݁\'N=#Ymԓѥيlj~|k&ٹ,VGyQu"ZIfKa%O]-ZU *\{>4 0al\)Y 6uz ѯ ޹:22˕[u}KWފÂDv(VG)8mFV`%j&,JrBv*,x]ixz:s웝T#BJs$y܀RV *}J;_ʔc}A0Ks YC%ԾMAĪcv{~y^kƇ_s?<$.%|54C㟝ʊd-Kj.{JǤ])yFN5)Ք?dBb)u)f<'kj ϒq ^Zm q qV ٸj&/r{H(Fzʒ8ИhR=w°5>9fǷUݛkLN]j|͢WH#]w 7-h@>ӏN)"_怒fySUH=C,l|Õ/v4]l7.)W[ZΥ-N+W/ M7~c RtO PzOB"mF{QTז)o%ڪҏŸU,`xr: KC_}2+ː'2^˟,X8EVoY>ΊVJ|1@e׋ɔ&0:3rRv^\g+w>`fZQ Jn-AҽIb퐒?mVX(p 2Q=A]]|O7;957G*`bjjd=:ji #^98L7.P&L(ICk5"Q?8O[1Զ(o¦tendstream endobj 443 0 obj << /Filter /FlateDecode /Length1 1385 /Length2 5961 /Length3 0 /Length 6893 >> stream xڍTuXIHO$6fñ9BZA;iDDAIIAJnз~dz纮>χ!=Bbx| 0 @66#8'`3(`0ʧ\AQHE$ P BK p{6PQ>h_@N(,..;(Cá$Pq\uB@C*qqCex^pC{쁿@\`/`90^4 x@0U^ku]a?Zxܟٿ !P(#p Ň!H_@u+!@y} j?7tw>w8ז\2^CbSaЫ"Q^H?ik{W~c$'A Hs¼N~W{c]Q@U`p1h??`0`p$Wn po芄` 7+٣/_GP[S+(X^Q0W@Łb +ANHPNꯡ=dB0 ? WS/ Ϥ@Fp_ '+=hTo)+S@T!tD}pw7^:A?ƿ$#az(w  WJgЇW+fdH(E4+K_ @~>$ sZB~ݪ P4Jf/_oM`0(`r u m<]"N=~ ;Ph}өjCp iE#4R;gQ(h]g0~6B '@&kn;~ў7\/CyM3U֨2oLn ]_:e8R5LG`9c%1?¿ѵ '8S9u}6YwWqׄi쁵RT?mO?c5~;3Y ,Ÿ/+t<-yT(ÇibK xWŚe-lx٢ mequpu}  t};dZ[0Nm۵RзqNO^2PJmJԧޯק{3];l{-<$aO@g6jz.YA Pbە!]hWW.D`Se "&B-Y7 ˬ:|,?~[bqA'ld yi;BnV<1bmp XDg_4X\?)xTM@!&>S U2TKx.'n*.jDHUT1=yzm][־_c=.4$y 'RUHjNܙJY&-P@!i4AA'=paVhzJ˔xWTtF6wrl|#qLhnRٜ躰Iyq -Y[\ ! u%dz˽] "b̧^MӸ K!Htqgw3%K3L@zSYPMB^DsGpLYC:4#DeJE%KOTq 7:wx^2]|$މLrqzn YqB έ7Rig.\cP]Hb(נW45{>Ln!;N yl9'˺5řL &1XgWqc3,xgO !3[NE bDOiaƤ)~r~+v{zkLNfJ%vBSu%u0chd \`vPr}')~֑e6L袂 WF#eu|`'"xtzPp"3lTd^v }tb{b_cۖ/gэ!~hT@zo>TWQ8uC2%TlEI^R<6咎–?.] L,ܓ,~deGS2Ikg Na׈u"oHỌ83ZX9Ckn'~ `,g0#&Y9st{ŪDQBvLekxn>V3]8樃iZ}s 9mK3hSSӍ'n܏RoP<>4۽gE=kQb+cCv >IOJZje Сsqo Y4=H_.`[FkE|י8\\1@tay`۹{!hR-8oZa|ǣ:Qw܊:XL+&yG͵R3l ^[+7ޝKMV,# *ួqv: س-o&:;߯s UW6ͦ\hfH/]D&-zmώ(r$qiKC$.tX+_M^ɅvE}⭜V3kvb̺.6d$9f;wFo}EGfJ,?$xVZH./Մ."N$6h$܅68cM* ҁ.gmULZ -r8%M)=zk`cϾ=PLe]nMtVY-Uɭc6\V/V֝.fg9:y6F<_@CN)&CCiumr$~ lSA~ "b6[2N4#kMO~'eE:ӵlınu];bl( ^IJ\KgH^*;u菉Xxws/YG [a'3=Ƨ'_^y&u gH;1} "EaC/79m[23ueaxBZϨ/ܧnԕX[ :B-3 3h΍o)SOiE_^|(-\n3b_'>wMtĩpl\kLeS*z>!!"K5Mޢ2xDc̰y慯&'yOTW,/0uic^/W 4FA3+ft$o=Qj OҰ&\S;]Z w`ePYcWU {46CVUå.?T lLͨsrx;< I>z]Bw;41)l_sx($XmD aM1.g|asn'D|Ne›_S»0>Q{W&Oū԰x?GmI4w.8xP>?%. ?R&"(|SEFQkFejōGppk&2[Ѱq "Tjح 5rdҠ|> stream xڽ]۸}@HDI)ZrMwŵ@>$9^'EZ>Ef3↳,tzum΢0("fy4,(L:[mf__^s(Dpf Ww(_cF>lhë2I" ~KBAS1bgs$Y!tӻI8ɕ; E/Ml4`M{z5aTL7IyÏ0` NkEhE{"O/`9ifH" #?e[y\0\3Bc ͟3$xnfQd giƙIDTۜڀ$ up&Aw"i%,c1aݡe?ZWaۼf>-\I``$5c朆73a4rZ#?0^ϘV48uHG1R􏱯Kqp1M߹mVPGx8 B GF0Ɉו QjtD>GY2-zQ/w:ViU=XJ(P$E?Y:cHGNlD4gGG2aVgscy*/4s+gnZV"#{Gdn]=w9Kr#9RB#>Q>T7MwuEE/}s4ce!$7wl/тhЍ Sp4=%nu٧ _U0#RCEDDu`t?*ԣՔ jpM'3L&\寿r¬- @L[~*ȝJWzTԲh4>GPfֺ`9u7\Up #EVݮ-C2cwш(j7n.UKk<\gopMJ~`~}X& ۽+ˑ\5KE22|< Qߵi7DmظR✘FRz޷FjO=ڰ_8sbnݪx_M,fEHMXK C3JK6++0$^L(V;oOl;T)A-놉} ;NQ-wwh_G,)عsŷ$o$'=+#X=Blq`{I&>:@uyȁ/9yX6%EM]XZ{g_yYA}E7-,>ܙAay`VG3R{26:վ kg ?,Ȏ(MeNwZj׉;+Ӣ3sdغ/H%iEJD6q7ODj ]Cp}, M¾ -m=ld6y&cFZ0{@x dsn'Ra|VD ؿفi mEJpߛɫSwG0c.f{i$$ ZiWv9fV`oT/ꃄcǀSs5,({)H\6O28uM> OFK}7,N%z x\O<'wP6]2j"u^> %@E0+V{~: kcܻBaN@tTpk$(`5IiSM$7j-y|luMd݃!025-/c4HF19/~D0M |~>#3Yv' Ƹ"V_槗8gJ1&Nqݪ/NF?'xF`:e$ŕ ͔bYb t7aϏIE3VM@v/(cysT[q_EaA(<0e9 s+ooA5G^sW;<\^endstream endobj 445 0 obj << /Filter /FlateDecode /Length 3165 >> stream xۮ#5}":²pXHI͍t23+}v'Ι-T|2Sl!?.Nٴכ3E}w͢+!:Peq “G1HB/siK[WFeYCBF&&F\7"-"L, vod^K`'D}֣K0ˉSչ(Sa(܉22w+VZBPɞJ9v'V{{n!崴dMFhҦ(ƙYUiJo8!*`$ͳv {L.c.)iIui 0͠蹱Mb`Eq^sĶM fCi- -)`?Eg$~ 7 _NUH"!H;29amCv!xb&JC!T#+;rzxB2T!7{5^F @v9)6S}ذ`: S9Tri\Cf n&nUF(9'-ULX= >eԂZz[S1؞\>J+ / pL9Pf]ꌬ PeYQjåYLΕ7 -X!6a޵::ug=X@&ޏ^uEU:㉀ }#ʔVI|31tΤhY^8?pcI x!@t[~aLb) B)JoVYY[sBZEd3Ʀ 6'0:iSW% ŗ:L\:+g;<3eEuJ>=`= 4l$Sj,uYt\F6Y]ZEF?PٳJ{KہzcA "TiY{P'r޽#X"dq#Q +jM7Qtei>(;1 S?[yl~8`I4Q"W{P!˛g{ Pt&ZqAChXeZNZӞ.ØKC{I=xo  -C|O{U#}PIMecM|1E$#\M1Z1J,{d*(2{^G. Ñʽʫ4_AIS祀B/ ЏAuU1 s|AÓTо4|{NߗqVHӏ_Š!Aڬ :_U~2 ]ȝ+׀Y v†߇K ^ѽD_:,F63ܲy=TNTJ@-6?ٵ×8Rr& w!EF}wXB.w'7lqw1z3ڂMnϒ~T QQxi1xRuy<<GQb 7FvY2V#tMb֒&=+[Q#=U2= aǥL.7RDG*qـ #D jxzYJ q}26 ,JډysYWx_/E-#+N:WZ+mԐ/d,镟+t$SgzO>\ŋendstream endobj 446 0 obj << /Filter /FlateDecode /Length 3060 >> stream xZ[ܶ~i#.n.HQE^Y$34k{=7Rv0fGCssrs)7=yjѥNo^^oZi\:6/6?mƓn5Р9ϧ ]W0<ߗ]] 88ϊI4ULT]OZ -ká1UbVM[8{ʄ۪Ui^?'`-Trں5 6buBJ/@^F%xIʒk\2+|;3q~"h&HM߸aIp >(T6(L֟)dƝXaDo|)=6S$nQӛ6َDAt|]fck+Chë߼.q;ekN`xyu'h8Ge⤨錅 ItT(c$'rhH9}xi!4F qs$`ؐr8βv~pu߈4?6"1~'Wxއ$TO NcbS]g6RٖCHЏx#vHO;m5uş)cVVl3LA$.~Y0ZEZGHR5 yhӉ"O0"礴Ne')W#pt!H"t6%tdx՞fA1"bte  SmgP@$jJW<`B B8{ *$H<"J#EKZKc}&KR&j6]tIqb|Hm1{!JT4۰)ILN&='k0+(`z`/͇" )|M"UBq2 #x`L0q8AS>#=Uk}яbUS~?]sg˩ k F i̪R&k$?8EYöm.-TӤI׆Jʡ Sَ,mN#'zJRJxժ{O'}V9zYq}H<#p;Q~9{,kUDz(2c홁1 dl;؁u 2Ը!<~M;Ϸ!v1NhȚkL1m Ё'kR=mC+<6RQ|#ö8-/.ࠡڷ }:4mq[s8أͪRӳ'yyX4+/ Vr|'+<|A% f#m-YѧS69)A֡˥ ,fyE J2,Bc8{L3j3I7, 3H;9? ^k qַzqۥx2ŕ7%z3ړZ3E)4R5mhk-Eo6?k;i)<7͢0V/2a|'W@-5S .O> TۙO(fDU _}Uh֝Ŏ`(} 86ѭ** ׂG$o=4J Au?IS֬ICiN43-<1@DL_)xe3/.흿tHm?AG\1]F;7n.X|^ >:}9NvŻp#-8Pƃ~xA%TyNЏ98UB.ā2@mJ`EFQjUWZuE,:@/۴2Y`.LkL<$X),?MՆ.v)sbK5@yZwsRMӋmv:|w7x=[㠶psoWw&ͫ(Y?jjՄs6(89ɭnٕzmQL#]1_ɔ1KіV3S[ȲjA4ro[IX\Je ǫQ]A-cfnM9z<Ū{%?C%ᱭSYV6̮ ]횱B:)C!"fVfΜPE\'tendstream endobj 447 0 obj << /Filter /FlateDecode /Length 2677 >> stream xk-K._N>ЦQ;:Q yw%EنS>ᬣ*Zɋ/^Daf^Iy<,tݭoam[5z$q]Ip  KW8`דLv_6 Mitj0O"u֬6IY׀Ez,09%b&^8u\ &虂)(0/K%KD1BM`{+|^g(0"N8e5҉ p{-,2?H"KHVYOPΫj LBq_}DT]Gus%,"tOhx] (O#9 0摙\+>H0=^2JBD{"ƭżZ teaV E@&Im'g ;XNzm,CI0K]6W"PeuA/+&(Pa^(ޚ~~&e2ZuaA`'?!_(ɚxd-W٨Dq0!ffL_P#r 7pR1ee& H\(i%nSQM'LUѳ% TH_#E(;ktE\dϫ nMk.JI͒(]Z)Z.r(t@yZRk}z 3M9EB)tICNGxP\{$ }}|gK N3?x2M ZlÂnPv }`',&$΋Z`ܓ3N(4x whsxАwkidue…DunLl$ vEoHT0Y.a}dRk-;9ɀY>C_00)Ʋ u}v@2!bQQ ~↷1Ȩf|1צj9v*k |җXVqi(Z~`˒:s+'_Rl؊=֛4N&)9BՃc54b]J|０ttn GB)$i3R}B}Ux+k_}K]ZJj]r4aA(O?y@.+@;㊱^SI xKfx&74/ѐ%|-\0* )"Td<>yBzLL^_BO,{SU_ L?{Y2҉"Wh?xibNf̔ΤtY|c#䵠o:jjO- UFR_tZRmZ< ȍeҭ Mj+5G,sn5YUf^@~5P[^_ v}|޵]| "Rk;j&,xv'&8NiA0:MQW?rk#W^vMosvpSQ~:oђw5`8e Ǜ*j? 1I+ڒOU}3H9vw~Bgz`v˘NS#j>q^FXl'iTj d_wX%I58ؓwU7:t&7"s\>bL zxk{U:0]4UD@ZAtN okgm=)uX,K]^[ʈ:'g)~Wڈ~Qe?_m+endstream endobj 448 0 obj << /Filter /FlateDecode /Length 2610 >> stream xko6{~/Uе"RkM)z@Z@q-ʖϲ7)ʑ!PDÙ9&I4zvqu"*dv?$Kɬ| ?fsH @[QUgtB>(ᦦ,#QemckǫW!eױX"!-fhy19ux>z1ga0| #~;(m2l" ӳ[XZ YVvݜ`]OMWj7%%7l6R&K !vvXtiNxeZrM$aY vuQƉ0 $f6;n0W.Ƽ< c__6HI,c &[ŧ|>G:*0Nc( 1b5$G {Q4*iS D8J19ë@o%*HLt0: |h Ά'l*W#5F*^0ڥʼn!L i0A'zaGPgIQ]`IA7ըГ<4J#V5Ͳ^֤Q|tQ"ԩ~։180]rϒp _(qI{QmB0LcP.QU#fV>0zp&JYx D都jz2gݛL3k]sRLwF'Ãp.f ܷ"a,W(Uz NvCG]",PiR@JWWu6jMQp#d%[R֜ё/s@)05V%ߑ#3mE*f{. WM pӟÄ?}'GݺDMN>Sv:T5_2JdF'"S+;fle U 4.nBւ\R}1="&Q40.$Km1I^:E|uFG1FPٜGwYxւ+մ\3'8|`cCw\Sn0DS5kI% >^ߺ;h-=F+>VdW~mH=hlr:*2V,nSyrr6son|}:6=aGN]=ri3Vq)ZI5 eQ=xNߥu 3ʄA]_w܍mF֜stUZvW`y]%(G;R&)Y{໫ J>q_AGt9ĮRCwF;f*kI0L(~j>a뤻QdҀ*w>l Vv 4k 9d@ $:Sp C>_֗i lAQ: ~F,uu jp[l2qPVc'ot*^̄GǎCKMO1Yly j !=Çuocq-'h- E0ōEzMy&~[lIESU <Y|IQ8e^^0nC^+{)׼&/riw)n;qjRyG[YL7R[ ,1_n%T^d .$Hi7d+˵]_Wr*܆ݳȟ8PhugXKrVlGu1؝kyJR?:^1J+nzY+[pwݡ<4i+ ]5ܷ"ɰ#iy+hvх@L8nsBOb4O@$ B1z$΅fOLp'Tִ%btfJendstream endobj 449 0 obj << /Filter /FlateDecode /Length 2262 >> stream xZY7~F~x\;%Y܁[{1ʫց 1͟)”dXgReBkf[הG@ٞdXK㭬(#M?. Wya/7h$ח%]ep]1 7n]]۞>[OH *_{e`p&~a,<-H^EIQ:v|?1"[8 gOyUYdHD|™b99;9AB;QoKoB΢ ] }%㎬Sٹ^FzepP BnrѰ2-LpGQ#6qڮmłv$[APv3|W{X4 *08`90Ͱj1 "=O@滏431K;Fho,}BЉvӇْIe71wśCIWy0w zO+C^g8yH`%B2߮`Žamn+f'=+_ iV0Xv1_]SB3ts1A.Ƚ\!`]JxSOH w).ȍ,уBCn|7qc[pgoSV*7gl|Rym#1Ѳ^Ǡ{!s4Q0V 4OjWBGܘP6oVY%8YDd9Au)B{IœuMXptup(䩳IdEPfdoVB뿨.PF h2a$>Z|\Z+GKjK5{Y]hcSk,ȱٓc j{.7+m[38&&r8kV{;ھa$JJg{] #VsqkyNxZ6C)C8fT2G$S.@Z՟j#;էx]z7MV8^83J+\<Q D/Ԥ&x҆h姶j;;+E^w,;|k;o6(߽v3giфf?]F+u*7/gW*D\U6lЅm LԠ,s }>O#_2g'R\ʅ-Ϙ%RaNľȱ!9)?.y"={W= +ѥ@ w gMd Nʥ-P(`''O'Hݔ0˱p`6V3P*8"| V #5X-8gxX(W5vg[9o=O,gћYp?%/ YG}p=o?OYXNn^H!Sk๛0R .{%v6y(֐OUIL}F$H`^>lyJ?Ҧ {+O VWL cmOF>q?#L6UURh nuPYổ{MKh+G> stream xڽko{~/!w"nܵkhH;QTE9Kyh;;;M4DN/<9IETē$'YN&ɛ ?]yPa qP.uuk^N4`pPdGa)t:3F [vr`h:Z߷әز莆 mUDCj0չ`D,'x8,r5$Ӕ֜qOmj:K.h i茉7;_x^$g>mc``2ˣ0Rd01ѹgɕL),Ul#1}}r+4.4?IFߡ%dȊec 2qu-K e_B {h9682Y.gTO|zqrg@7<+U쓲, "mXdkOK;g**GH'9H֞E!O _d-[1y24Lqz# -<ɛOY+ ƆLdq2!b{Łx~,O喈>Qq| Al|le<-T.N䷌hɠv٭(5"8Цn{U.+e3L<~k/ y)e,3j$2/"C>ÂEV(Z '*E‰o]2"{wL{.[q=Wxs;窧F%ECZhL=r=c_ .X2Rdhy_^z JHB]psr؈HN[ѰUwK`5ӃpoQ`UWg\a2AG?_|0yϯD1{åէ0Y"u)beE2XMϱ }0JNՠ,q Z1d7C۱~˱fCUKx۪X^ KԄJ10Үב(KP|I(℈4ս%sU,kk*yﻐtZ=Iqj{L* QjJg j㠤31'іYu;b3'Z}G~yeQ MLrgGPY4ugWҫCcں$=&N^`.ʹuB+j4C!0<]CݼEݑ=1H&0j]݈k3mUaf@%8UsJ!P"ſ ,9@c/SUBQR14#TS=Q8.>2Emf x!>ǭR壱_ZSI[aOsڱ3AӲ6Tб$Qx,?مYFݢHN(dU J=rA'>xdY&Xgc;FF%.07%ֵ[iD@ّ7,㰇zV7:/{jtO( F+-qօ5?+.\5ݍ@{OOu^z̽õp\ރuһ!ɱk+t!uΒG90[_xG@rʋͰ >AX34h5>w0uyTx*SbZmW0};?cbXn>t*Wr{R0aģw#}V,v(LjߤۤIOOtc,\ڽ AJq R(f0:h ܨ[n^8UOH;w_cG޳_ˁ,ʾe?;N,Aݍ4,Ae붘0N]umjt'> stream x]oܸ=b߲( $wK[\ Ekʕv$E%QÙpz/# x{78}@VJgYb P caaG IX$Aly7G23V*+uU"@,bGv$n=q"c&4 &4ۣl]#GTX$g,⊼ά \#k᧓ R .r~&H_9Tv̀-X_GeY +%0{[p&  ^p,lP]LoYBC07< &KFDYF^.fHF*niH.nO +؏H-{\و6?IA @nǵXeXLKJ.˵,0@-'.//Y OTwmkI`;{`燐~q Xt]H%¤pƊ ~w r~;`*eN=Kjs2W^&r* &~G0 ʱ~kq0 ʼnf/,6z:ʲZDv%h?ӧ*2jmEӉ{ Q>yNWڹoJ|I&%oi N'IQHQsIENH1=rMn G\mWj3ɽ8\\z-Nل+<*U@@bv=8xs=nlPHBf*⁋/πYAkB$xYhBtDȔcw5.8ˬ)) Jpכ DeW7Izt&T2!SWl#IN #!`},+DLt`D0!ZFr7vFcGSi"/S(YB^7-`%i~;-JdZ.}njv)]5c=S?Eq&2Tyx~/w"0RZ.aMn(ȭ=ˋp\Ƹf3u$!|+ ;:BgVLQך~-I]Y9W6 ﭯYP ZSQMA+5wh .vؽ%@fVK@p*4Ä=ދ7S#:lnd%%5UVzA_X6={Y; JI/\V Ep([͹v+v}#L4#L3 aޞ.r[V7 :WYdtOwCW=S\kcFZ2};י8KDmw$*Mb Q>eR}خ?KوP֕Y`Oпg%T_RGf| r7Y"t9eTU0$ J3>*jX02rdR Bi+&IҗS iG"OI\I?O9,#q6fI̳ߺM6YaC{! ^LTL\쨊hn$]ϥ/zwBG:ok0ӸPH*:搨t!b䋌7ҥ͜ 'ViKu0uGpP~)xsX,eC=":զkRnrq+%x5C$H{>Tfl`NP9;`ԢcE3D6>߸|F iH:_M9u =|O 0r*cJܹx9}?% 9Zхax@gd^ 3!'Aendstream endobj 452 0 obj << /BBox [ 0 0 504 504 ] /FormType 1 /PTEX.FileName (/tmp/RtmpVKM8YK/Rbuild6d2c69c2d5/BradleyTerry2/vignettes/baseball-qvplot.pdf) /PTEX.InfoDict 235 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F1 236 0 R /F2 237 0 R /F3 238 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 722 /Filter /FlateDecode >> stream xVMo0 WI>V(I:GYfVGOOϔICs` PkRS@NQ0p۸(#O:j$ﮑs)x. Eycц'Xx%yz3xjQ OJa;R>? >G w <4b ,Nڻ}_? *z߮9rPԛgIZQo|;YW_gR1&]2%`q?,o=IEJ8 RhCszI|,R +S̵ODIN|6jQD<;[.K֕3hi#S:I>:yXeA9wa$j&%lbw|v nmWݐCrsŅnW~_xįfwx86dѤnhǺ~Zh|ŗ1 " GP)Ǻl;L}Y-90I0_Ge]SD\NO] 9lj38/\{d.[)M (|T}Zk42ޔO:2$ƔzR̐gf(ߦ3:b(1qt;Ź쪖,=] endstream endobj 453 0 obj << /Filter /FlateDecode /Length 1558 >> stream xڕX[o6~%QaC֦؀ [ᗡPڒcJκ(QldQ|moWkm*t S*5ޅ:YuYT:IUQh`BDWRCe Nv),gQT*eect0éeIx.Qd=OO,ږ*OK'-,b_hl rdi1P̓(!-}2^qw$ygܠJ%Id:Sq`P tP-QJ֭LJq +D-S!)k^&1K =*K2,J3xl؏$itXs^Hp#$?c2zHdDZ`kŁlp{FE̳tI0endstream endobj 454 0 obj << /Filter /FlateDecode /Length 2094 >> stream xi @d4EJ Ii_.@%qT*TqYAq` ԧ 70~iY3L0 >+z-lKQ~OԊ3Zc=yV,\#"XjAyNKqBǹcArlQ5#e, n7X +!D9Ś)e&V ]Aq$F$f8MQPŁ]$;kuœI"gM8AE^tpwj:2V%FkUy^ و ;L!MkxPhe;6DZ!ё- y<3Y&b7 Jf?\+zɦyy1(m)[2֟uw?"m-Z x? EHy9]wU˄= -BEOG=ƫr;Ϣ,ϟ)6=X2U*ذO>/ǴkB'=h$NVq DZTv3,D4|>2z&KIDX`x=v X_ "uk'ĝpBƿh ]GFSbGv*hK wb>[%dJ3&6[k)H:5*I9-F}BiZi%!#%rYAK`.v7\d[s<ǹA.8GCdž2;' !G' ;P$c8Y'lCd V&y zix;۰  ]LFQqurʤ SGɽrqdSʍp;AF1@N)r{4.l,Ѷ\MY"Nja'V22OX؃ie!χ`VPgz:\u>&}qSr_Pkg/P$}G,0$Do?6M'@?~NFOFOExr0gQ.ĦLr6EXuVy_[g P5 {[bt ͦjl8K3%a;xfױ [LE/t{u(Psn{_{kAms?ХkdR_t}?ҵON:'`caAٜrs[EG%쒧mQgëGWyP&k:*=T|M=ԀʨZxo^u:^4+VFJ/G.TIk-K ;1 r2}*/]YܡKZTN)nHw{<^oW޲>u@8'NvAPhs[}UsRa(eȣV>l&LBck~%endstream endobj 455 0 obj << /Filter /FlateDecode /Length 1607 >> stream xڭXIoFWA9vHZ)nMD+,R%%;ίfHtAq88QzY]]<ҩJGۨQ2yEڮ|u]]:3(4M5YW.npόIٔDQ)fZ ocBJ#pjou1lpӇYU\R9Sz^U*67+FV6p06W@ZS81Ғ?'WoYC MLL٥{ )/az4 ̓h |TuVop'|%L cܻA/F0e^rLLv!Qa^9D"n>"9P㫊ѽZt%Y L펴9uVڳtJ:f HY{˵M& (I0YV=ݯsR}ʝ2(af(qume˨T*M$OS*a&w`(ؒI۵A'0PB_hdbAjN': wI!6Se`/ -YrhJAxzX0ơVµ7I)wN=.!/hLs@tn.6 ?uˁg3#y ~<~Jht^ELt=S!X]AHR\a҆^L5u G1l8־]@*xaHASjB s ]Ա_>g5|RAR Qi,3K!Pg3U&7G)2=䃋xcE~7MXd,R@]뺥KX u)<:Ӄ/vK+Lendstream endobj 456 0 obj << /Filter /FlateDecode /Length1 1370 /Length2 5960 /Length3 0 /Length 6892 >> stream xڍwT6R HK7 tw03 ] !-4()%!ݍ}[us]ZD%m(aH.^n @ ~nItma҇!p d `Ma @$7&ȁ=67 A8Lpo7=ߏ5+**;vA0@ 8V;:pk(H'7 wd؀R AC$w񃝡NuGފ@ ~+C )W buwo|+iӿ E(@ 6P_|ˮKiNPDz\ nex@ܒ rYm~ɌOPq@\|yohMcGކp7_w*h2#ۭ~_mͿϿ xAq&ա-gUT\˟0[z"_s}U?q)'Hќ, b92 KVA,qvAhlvS&hQ[$L\ wV\"VE7g脀. +ݺmDǸhdJGfꮫ5w*Cqd۷ޞ|Jp" be(H2(2'c](1G[iuiexE}gmF_CE)"W`|d}hF/jN~0(.5IҪSPbE,f촗oC!vv5!}Yw_,a!o.oqهW؁G[U,JLقdOhBS+B>1| 3^iAK c݇'EB/=${&Q%:(wDq"F4g]L21~by*WH 4:t8|-0B ja)-9'Vuj:0 @{<=- mE ݖJ6rJeCޖ7FcsC;۫MAU-gi@1 ELCӳВe # '%EIP?I{pC2bo7j9>B ]MbeFtsWc ?mO9uJКoD^):4$Fչݣ 9x)&UTǾi1 טmJrHƑH)z!%_B 2~Xrz]Z^|.̣8*oX!YI:4DF:ɢ85鵣v]E+ %r$s۱s(e3C$vol6 Gkч AI9*4Gv;?+$GvoK-$Y-^ayr+!@Yg)ǡ%,gAt\ZM~™ԴzgvQI0l72ʎ_9 LQ`gYS7޴Fwt~n0#7W&DX%/KRTH#P71v,3V\hj$\ۺd`8 XdM:$w*@^EWk'銳#], jL|1܋3iwcݹ7^݈n/Hn>}0Xy'A `?->P*t.WtPD:xX-dL.Z{|J Dr^x@ݻ@Pg ]h9sēSIa/ Id?A9[IP >=~fMk0#(3uVHw BGfo`3ZHڼ)͝۝R*c9kG{?LFOokw-qaKP_з fVd=џoK#3df½̭ eԜC ۂ.pjRUpY˻LXkP~+h;+ӱð<wE&\ǫ8{X͍pNX]ꛃW .s Ke6@FqO 5YH aQCs;N)v x8aN˕SdCЭuop,a2jL@GR+=_v7e2t=3h18P .Q̛dݲ:#cAN([ߦVV=>EN]ZyZL.dk*ƭٗ d:ep9xBr;֋p3V? O&-& |ga0$_/cY##Loz#< a~ɠ?IUD|GֱrwE "Y[7@f|,Lz2͜ߪP dΞ^hBOhggs$t8@6\AubTWj<,Ue_޴ͻ#p_ɂjͥ־3N*C&F:9Տދ:D-XW`/q.R.+DWzJR̾i}.zv:~P/F !-rMN *,P~ ߞ jV_ Yçb4%7h|}Z^O/=+ʊ٫O9XӕnegM^Э2KYTruÛ`T;e U"o6o)cSh4&l&"7%"a wã:mL*yloIkew͚XU@fù))o,].` gmc;uM) _0v! KҜ%G Z\ݯ7GJL|pu+!y]>KR,IyCUrUMӐm3[˲cV-CRJ V>Ԋ Dy>mtU >CH:\wX}s-#5{(^c+)RE;}two$P$$Zڶ膔E0Zq? 2⦓L8uRI1mg21oL)˴R|îrC+`2?,KDIlK-9.hq,ܩ}fjs˨{sS<*{۟:#AZ؏DrZ+nt$% 0Pe+4M+?qbdJѦhi#IXԹ> &CP8vI!Cu3\CVݷ.У&%B]ϓ'>‚^ &sFt':z\͵srKO̺o(J|m=I!Jt.e6 n"V'Gq*OR{8O`̚AYrVD0EW1lL'KVT,IJDlεQNx3etr 8z ;I9kyW++mC\+iy63b6 = ]졯{xlPǽ l+Kz|,G^c ԟ2.j8$hF$\8! d)/de[ o r! mp Ű\2PfŸ4,*8F|Y_WmdL|;+fVll]Wcb$*F/jdZ%̄j,*eHFoTl֙.6ƃ<@;zB~tPV A>/zMY@i.[>wW/ҳ+QȾ: 3𨟿$r bj`Dz0Tq_~0=T$r ޳7 }?@Li eb % :{&22JG{j:&_Q:>/` 5uP]̰q>`}ì֊*Hm#PjV;?M2/&~N6fXHJctFCMʻ,n(ZRD^H3_hI(NY3sa^=nq0FphOLZIL&5Rpv]3S+7a/~Mg%S?Q]);"J^(SJȺT0V HH}<ϗ4Mg@Z/:.{,n5ܘU ?4\0Pb{2# G::6 >[dbAN;zv#&]zU>ص> '^ HDJ~F`7 Ҫ!gC?ʏ׺B7ǭFLZ Go`2*NZ[*&O4J_3֢pؖp]cF+ ajƼcuXameđMAl]5v]2I?T6WTa!+kY7lH "|~1-fv֫̀.b9(&#> stream xڍxTS6ҤJׄ{ｈB$t*Mt頀(U@ EAz/"ʍ~~Zgy白p(9"HZ$X PD&0пq"s DHC Fc0U0CC"pHIHa Po"K 9HEġ91} @RRJP/.Pw̎0`huA=|}}(A<?vCQP/#W};OiDS/ 0"Po# ` 0""E9Hp!~;!C8`p(@]W`8 ap;u0@]T> F `_5 9f5 @~ B0/n/" Go!39C1@ .B60615z =N20'((^4sEa4 C;:: bueQ#7wL--Uu/2( ,@ 8@BB 8`؟(vdpxJqlLfok͕j1sP[dFN=];5߹Ȋ}=dum/LoS-؏`ϕZ?mn"QTڬ)ɹگPXbg*Il%Q8ߧےDUn?S7x ;Y_ɦ(8( pY] ~}8j~>}d?` KI~%vœWM]eǓ8b\k֩!sOQjv-\Д⃩&V>C)rRJ ʅ7˥K,P5K$[emב0NA=2}.mhi7jKj2Hbf@YeN  %1Q%*y<.<rqj"Z+Z?j8:aDZ$=9) Wc(񳐥[%dWM OFp+ѥf"wEjG?W[n=o@jh&wڽڐ$gwҎKZOsf_ѥ6v`QwR|,/Nra(-Y&dqFF9ߩ>+0AxcۆWoTGET N>fպrM?S2Y]dx+r߭D+e470hW`Ⱥz9'DxiT|Eu|q'JU9ɂOk^Bw}:eU٪5gN1VI-5Ru!'R%pMTҺ0Ů˦,u p㆜D}Ob 323Ԫw A1<$>i/y8f]}YàPq7K3"*!cg !> l.fez ˩3>h AU Tb1#XzI(QitDOdI5Pbjc!aqeq3ʓq[ UkEYY+;3QN\*'+v/^(@X$S \7tbD hV)ΘR??"-na% ıg;|5:5ungɱ $<=q32Pʊ-O6zo({`n~&ÄP&q+$HI8K\YbeJ<+nyވ@Hp`DbT#lbpaat`%~E8֡ [Q>ò~1Mz@D"tKa{]Ot!O6+3~W/d1g58'|x%~F^VW,?cFTW}PqM 6 _֭c-W-y;ݝ*qYbhi"~+%88z1~#-Ú{W EcO 'cH9]͒:OOy2{}XX {^@x#iXYڤ|QS%5.%wUs7}F곲[n =Kc³@l{mXd ۽ QzV瑅yA>wn=H*.`MSk<~r'E3f]C+MhvԜJö&x0q~AM#P6u|_f-Z8jDUWݾw @J(K=@)w]Oz]!}Iݞ{A-7XEȾ-=\6( ,GWԿ]mVZKkyӁw֍j(2 C1?4mx V$:vbGӱ\hx$al =@ٟa U= ۷cN6%J]Mz6,{sVO>I>}ݚ}C*fۺibP/Akr_f2$3~iGH}3J?VAB~ >P/=Z9pUC{8"aMiqUT`$tA_ ϫ&vcb@Jy8ά1ϐXS7] )y>*[_2"irϗ "}3GNA[Uջ8O!UE`m ;wFSt/[f-EZgSwcS3GU{Q[Un1`q!UL1$[øg)sS~=[wdQ {$G**H&WJq ^0o wNyqp6v~ڴ='+iAwtT{xVVúH%Y բYePV]ob摻Nfq;aWAr٘3bA=x[l/e,Sy=BkV Q K|&N9̨i|2D"-^82 ,@.a 1B]H CBf= u+avG;J!"e+F],؏ԊZi\(}oؑ8OuՋ)gm)W^|9v4Lvgh#~Ktq腡{LOˬ?LX=+\1dgL0eֻW:G urt8޸;Q)'k,ʭ87(;ܡأϩ$3yKַ/CpRkIsͭij߇f\ei]DI;0:V{aO yE٣'u_. tF': *3##cnԛVZIp_d짩77 4^<]dv6i6F ZMdӓ=eW/:wlΠq?pC]-{_9lPCgХ~u3֐NL )M&TFZU {QSY 4c}1!Y8|P}a7" [[B$/|gy4Dg"0WojQDCbBޱ7i z* ;I3oZ܌TB[fI(h%PjZ Esff""En2)b BBr5Qa*8lI:}J^upOg tðw# S9%h23ogW״: 0>c 7 \v[5*7543GMe_ZXi '\ԲP~|J)ЍNM313 [|2st+)xy\JKF-kV.uT~t*nn-t* b+k8=H!*ҍs)~lug)&F3.Gf},jѠST oD3_V]bu-zȾK٭{t'\L,N$զzU{>$WW= e0[2\UƱ,ĎٮO|s)sR`9 㦁ڟV [#4eAGJf`R8J!bwkL!3x6P86'f KUxqGhiioGd{vT/MR+9m1}=^|BޥbO&)YƩV[f9P5w`CmO3itI`#Fpw#ٟ.&s0bB>sRQaScq7a{8!9'kp pze2z<&vǡ$ ؜84Nh⵮{U ukCk3c͞.7ƚlt^ ntXe׷NmZ f.%Uz=9X~kYG;n1qX^`J^ְYO[H5τ"8WgvXMGd+턮NsW>yzqPN[?gْkI F'x4}g'"_r鏗lKQl"~*xaTќܳR -mӮ r Z-Cy9,ap-N싙QAZ Gm՜EͰ Vv-vp~%O5Aj92" w>p̞>xi;6c{E]|vZk gendstream endobj 458 0 obj << /Type /XRef /Length 248 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 83 0 R /Root 82 0 R /Size 459 /ID [<85d541eef01ccbbc7032977ed2c3f5da><94a34bdda9cab6f8ad6c3309169b3b02>] >> stream xcb&F~0 $8Js?z  3 %ˇqNK>DHs RvdT7@d/X|Գz2_@$ ,=\MK#yǻq4Ƈ;׳ \&kNp._I68"yA$Od\ "H5 R:Kr9XXlX, "Y6%met,{1 endstream endobj startxref 292575 %%EOF BradleyTerry2/inst/doc/BradleyTerry.R0000644000176200001440000002111713615557421017234 0ustar liggesusers### R code from vignette source 'BradleyTerry.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: set_options ################################################### options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE, digits = 7) ################################################### ### code chunk number 2: LoadBradleyTerry2 ################################################### library("BradleyTerry2") ################################################### ### code chunk number 3: CitationData ################################################### data("citations", package = "BradleyTerry2") ################################################### ### code chunk number 4: CitationData2 ################################################### citations ################################################### ### code chunk number 5: countsToBinomial ################################################### citations.sf <- countsToBinomial(citations) names(citations.sf)[1:2] <- c("journal1", "journal2") citations.sf ################################################### ### code chunk number 6: citeModel ################################################### citeModel <- BTm(cbind(win1, win2), journal1, journal2, ~ journal, id = "journal", data = citations.sf) citeModel ################################################### ### code chunk number 7: citeModelupdate ################################################### update(citeModel, refcat = "JASA") ################################################### ### code chunk number 8: citeModelupdate2 ################################################### update(citeModel, br = TRUE) ################################################### ### code chunk number 9: lizModel ################################################### options(show.signif.stars = FALSE) data("flatlizards", package = "BradleyTerry2") lizModel <- BTm(1, winner, loser, ~ SVL[..] + (1|..), data = flatlizards) ################################################### ### code chunk number 10: summarize_lizModel ################################################### summary(lizModel) ################################################### ### code chunk number 11: lizModel2 ################################################### lizModel2 <- BTm(1, winner, loser, ~ throat.PC1[..] + throat.PC3[..] + head.length[..] + SVL[..] + (1|..), data = flatlizards) summary(lizModel2) ################################################### ### code chunk number 12: baseball ################################################### data("baseball", package = "BradleyTerry2") head(baseball) ################################################### ### code chunk number 13: baseballModel ################################################### baseballModel1 <- BTm(cbind(home.wins, away.wins), home.team, away.team, data = baseball, id = "team") summary(baseballModel1) ################################################### ### code chunk number 14: baseballDataUpdate ################################################### baseball$home.team <- data.frame(team = baseball$home.team, at.home = 1) baseball$away.team <- data.frame(team = baseball$away.team, at.home = 0) ################################################### ### code chunk number 15: baseballModelupdate ################################################### baseballModel2 <- update(baseballModel1, formula = ~ team + at.home) summary(baseballModel2) ################################################### ### code chunk number 16: CEMSmodel ################################################### data("CEMS", package = "BradleyTerry2") table8.model <- BTm(outcome = cbind(win1.adj, win2.adj), player1 = school1, player2 = school2, formula = ~ .. + WOR[student] * LAT[..] + DEG[student] * St.Gallen[..] + STUD[student] * Paris[..] + STUD[student] * St.Gallen[..] + ENG[student] * St.Gallen[..] + FRA[student] * London[..] + FRA[student] * Paris[..] + SPA[student] * Barcelona[..] + ITA[student] * London[..] + ITA[student] * Milano[..] + SEX[student] * Milano[..], refcat = "Stockholm", data = CEMS) ################################################### ### code chunk number 17: BTabilities ################################################### BTabilities(baseballModel2) ################################################### ### code chunk number 18: BTabilities2 ################################################### head(BTabilities(lizModel2), 4) ################################################### ### code chunk number 19: residuals ################################################### res.pearson <- round(residuals(lizModel2), 3) head(cbind(flatlizards$contests, res.pearson), 4) ################################################### ### code chunk number 20: BTresiduals ################################################### res <- residuals(lizModel2, type = "grouped") # with(flatlizards$predictors, plot(throat.PC2, res)) # with(flatlizards$predictors, plot(head.width, res)) ################################################### ### code chunk number 21: residualWLS ################################################### lm(res ~ throat.PC1, weights = attr(res, "weights"), data = flatlizards$predictors) lm(res ~ head.length, weights = attr(res, "weights"), data = flatlizards$predictors) ################################################### ### code chunk number 22: baseballModel2_call ################################################### baseballModel2$call ################################################### ### code chunk number 23: str_baseball ################################################### str(baseball, vec.len = 2) ################################################### ### code chunk number 24: first_comparison ################################################### baseball$home.team[1,] baseball$away.team[1,] ################################################### ### code chunk number 25: first_outcome ################################################### baseball[1, c("home.wins", "away.wins")] ################################################### ### code chunk number 26: str_CEMS ################################################### str(CEMS, vec.len = 2) ################################################### ### code chunk number 27: student-specific_data ################################################### library("prefmod") student <- cemspc[c("ENG", "SEX")] student$ENG <- factor(student$ENG, levels = 1:2, labels = c("good", "poor")) student$SEX <- factor(student$SEX, levels = 1:2, labels = c("female", "male")) ################################################### ### code chunk number 28: student_factor ################################################### cems <- list(student = student) student <- gl(303, 1, 303 * 15) #303 students, 15 comparisons contest <- data.frame(student = student) ################################################### ### code chunk number 29: binomial_response ################################################### win <- cemspc[, 1:15] == 0 lose <- cemspc[, 1:15] == 2 draw <- cemspc[, 1:15] == 1 contest$win.adj <- c(win + draw/2) contest$lose.adj <- c(lose + draw/2) ################################################### ### code chunk number 30: school_factors ################################################### lab <- c("London", "Paris", "Milano", "St. Gallen", "Barcelona", "Stockholm") contest$school1 <- factor(sequence(1:5), levels = 1:6, labels = lab) contest$school2 <- factor(rep(2:6, 1:5), levels = 1:6, labels = lab) ################################################### ### code chunk number 31: cems_data ################################################### cems$contest <- contest ################################################### ### code chunk number 32: functions ################################################### ## cf. prompt options(width = 55) for (fn in getNamespaceExports("BradleyTerry2")) { name <- as.name(fn) args <- formals(fn) n <- length(args) arg.names <- arg.n <- names(args) arg.n[arg.n == "..."] <- "\\dots" is.missing.arg <- function(arg) typeof(arg) == "symbol" && deparse(arg) == "" Call <- paste(name, "(", sep = "") for (i in seq_len(n)) { Call <- paste(Call, arg.names[i], if (!is.missing.arg(args[[i]])) paste(" = ", paste(deparse(args[[i]]), collapse = "\n"), sep = ""), sep = "") if (i != n) Call <- paste(Call, ", ", sep = "") } Call <- paste(Call, ")", sep = "") cat(deparse(parse(text = Call)[[1]], width.cutoff = 50), fill = TRUE) } options(width = 60) BradleyTerry2/inst/CITATION0000744000176200001440000000130613436770253015071 0ustar liggesuserscitHeader("To cite BradleyTerry2 in publications use:") citEntry(entry = "Article", title = "Bradley-Terry Models in {R}: The {BradleyTerry2} Package", author = personList(as.person("Heather Turner"), as.person("David Firth")), journal = "Journal of Statistical Software", year = "2012", volume = "48", number = "9", pages = "1--21", url = "https://www.jstatsoft.org/v48/i09/", textVersion = paste("Heather Turner, David Firth (2012).", "Bradley-Terry Models in R: The BradleyTerry2 Package.", "Journal of Statistical Software, 48(9), 1-21.", "URL https://www.jstatsoft.org/v48/i09/.") ) BradleyTerry2/inst/WORDLIST0000744000176200001440000000146213463561560015130 0ustar liggesusersachler Acknowledgments Agresti anova AppVeyor Augrabies Babiker Bal baseballModel Biometrika Bolker Bos br BradleyTerry Breslow brglm broadleyi BTabilities BTglmmPQL BTm casque cauchit CEMS cemspc Chisq citeability Cle com countsToBinomial Crowder Decarli Det DG Dittrich DM doi ECAC ed Edn ENG erry espn etc Fahrmeir flatlizards Gade Gallen GenDavidson github glm GLMM glmmPQL GLMMs gnm Harville Hatzinger Heinze Hobert Ihaka JRSS JSS Katzenbeisser Kosmidis Kousgaard Krishnaiah Kupper LAT levelNames lizModel lme Menezes Mil MJ Modeling Moussalli NC NCAA's nd nonlin numer ockenholt odelling Peto Platysaurus Poisson PQL prefmod PV qv qvcalc radley refcat Ridout RR RX Schemper Schlobotnik Sen soccernet SP springall Springall Springall's stackoverflow Stat SVL TDT th Trento Tutz urls urlstyle useR WOR Xlisp xtabs