fitdistrplus/0000755000176200001440000000000014124575145013016 5ustar liggesusersfitdistrplus/NAMESPACE0000644000176200001440000000422314102173474014231 0ustar liggesusers### Imports import(stats) importFrom("survival", Surv, survfit) importFrom("MASS", kde2d) importFrom("grDevices", colorRampPalette, terrain.colors) importFrom("graphics", abline, axis, hist, hist.default, legend, lines, par, plot, points, polygon, contour, layout, matlines, segments, stripchart, image, pairs, rect, text) importFrom("utils", head, stack, modifyList, tail) importFrom("methods", formalArgs) ### Exports #fitdist class export(fitdist) S3method(summary, fitdist) S3method(plot, fitdist) S3method(print, fitdist) S3method(print, summary.fitdist) S3method(print, quantile.fitdist) S3method(print, gofstat.fitdist) S3method(quantile, fitdist) S3method(logLik, fitdist) S3method(vcov, fitdist) S3method(coef, fitdist) #fitditscens class export(fitdistcens) S3method(summary, fitdistcens) S3method(plot, fitdistcens) S3method(print, fitdistcens) S3method(print, summary.fitdistcens) S3method(print, quantile.fitdistcens) S3method(quantile, fitdistcens) S3method(logLik, fitdistcens) S3method(vcov, fitdistcens) S3method(coef, fitdistcens) export(Surv2fitdistcens) #bootdist class export(bootdist) export(CIcdfplot) S3method(summary, bootdist) S3method(plot, bootdist) S3method(print, bootdist) S3method(print, summary.bootdist) S3method(print, quantile.bootdist) S3method(quantile, bootdist) #bootdistcens class export(bootdistcens) S3method(summary, bootdistcens) S3method(plot, bootdistcens) S3method(print, bootdistcens) S3method(print, summary.bootdistcens) S3method(print, quantile.bootdistcens) S3method(quantile, bootdistcens) #descdist class export(descdist) S3method(print, descdist) #new generic functions [to be removed] #export(loglik) #S3method(loglik, default) #dedicated fit functions export(mledist, mmedist, qmedist, mgedist, msedist) export(detectbound, prefit) #plot functions export(plotdist, plotdistcens) export(llplot, llsurface, llcurve) #graphical comparison export(cdfcomp, denscomp, qqcomp, ppcomp) export(cdfcompcens, qqcompcens, ppcompcens) #quantile functions [to be removed] #export(quantiledist) #export(quantiledistcens) #other functions export(gofstat) ### use dynamic library for C code #useDynLib(fitdistrplus, .registration = TRUE) fitdistrplus/README.md0000644000176200001440000000151314013716612014266 0ustar liggesusers[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/fitdistrplus)](https://cran.r-project.org/package=fitdistrplus) [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/fitdistrplus)](https://cran.r-project.org/package=fitdistrplus) [![R-CMD-check](https://github.com/aursiber/fitdistrplus/workflows/R-CMD-check/badge.svg)](https://github.com/aursiber/fitdistrplus/actions) The stable version of `fitdistrplus` can be installed from CRAN using: ```r install.packages("fitdistrplus") ``` The development version of `fitdistrplus` can be installed from GitHub (`remotes` needed): ```r if (!requireNamespace("remotes", quietly = TRUE)) install.packages("remotes") remotes::install_github("aursiber/fitdistrplus") ``` Finally load the package in your current R session with the following R command: ```r library(fitdistrplus) ``` fitdistrplus/data/0000755000176200001440000000000014067302651013723 5ustar liggesusersfitdistrplus/data/salinity.rda0000644000176200001440000000057413742313702016253 0ustar liggesusers r0b```b`gd`b2Y# '(N,d``c`0 H6@h=4q ` ӸCW9fi+I(mj-TFAiM;6`- w q?vnw(wB… }`u.Bђ$h`5 ӉCjђhJⰗMLG:g &"B4<,}AN}8-:`a/N8Aw{2aʇ3\`^z ==3b#hXy\1 F&GXsS PedIM+)(L(AY_ rX 3&ȕXVaSAٙfitdistrplus/data/dataFAQscale2.rda0000644000176200001440000000036613742313702016751 0ustar liggesusers r0b```b`fba`b2Y# 'MI,Its ,NNI5 ~Wsz`:3 }ͭMa q(Hl 7fuѷdB@x0D?{K,^Y>ѿ*2@7<by~)HOC@F0D{{⿗ }7jfitdistrplus/data/danishmulti.rda0000644000176200001440000012056413742313702016742 0ustar liggesusersu\UO?% !XXnVnElEA.C7

*'6?bs:m>+ q у>A)yEC|hAkD>x!#>Ds0! O((؛(#NE\AGG#nB4isp7>C G7~?~?~F @Dz~111 c"##{m%9v` q"pđ(E$S98v "ڋ-ڋ: ډ)":]D+8A?ڢ&r0 -M["϶QvREDi b؍={"`o."A^>Gsp< ĉS~>`vdccqWrp51FDKv9 q)1N8IDS31>]G'jx_{5Dwv8~cg3;GD#;gr㤝;"į9M;vI?1K`8yU5"ާ8؎;#jq+"}oA =0 D$ZAɈ1A\q~\A;w!cbOs,/r+> - O1>c\GG?GD}8>1xGt sؾAc2DgJVqu xo08`~#bg;`>Гqa "D 08@iACĹ^pX~qy+q;`yFa3 ;Ľ8xxqL+xUDDv#?;?;7;;}e:$q5x?v@v@u@uԁ]KG*9rQﳎgxuDrDr쎈c?DqDq#ÎxtD?r$N #Ŏѿ#z8kяq帋{[AaD:mq1vDs##U^CA:}ђxt|;_:_:bhA̫1vDs~IG7G\:}ґXVϱiQ_8} wNuA9 ADsiL+hA|4 :M NN87'\:9m ޏ0u C~tONGNx_r:AӽV 91tzA\g:} ɣ< CNxr ׍N`"'ЏЏ0uB?rǜ>L`6b. 8ѩxt N:&g!bTATCTGlA|NgWg|Ng?Vםc8H88q&rxu3?q~y3xuFvƼy+VVp'M9xwޏϷ3g+'9q3s|ĸag?Θ:={gSV/;2gSggO;}ggWΘ7;}ٛxvy3޿18eģ99i8{9g"b|r3k~\A/ .w\׽.w\9 *.]8؃ .9qe("!#\0p_.ļyG.s8hO.\p .\0wu +cDK\0n \snbq9q]0nj1`~r8\p:"/._\r1q8y 3.vGļ g\pq. .׸` |R*br8A7B1l҈\[ACT %W|~A\ϸbrukV׹:W|yVpsp[Qĸq_D\/:I\1r/\1ιrp";WsK9q1Ws8y+ebjy+Ei1bs}w| b]1Or狮8A̗\+\15Oq0yQAxAi']9k?<b\u礮?]y+]1nb' /Ma_7|>yno7Cݎp8"n8ϙ0z I7np]v9 >Gv >Wv {bvs np e7O0/u ebvxphb ["1-w0޺auU7n<bV bIwu<]Խ3;9wst<;q1^c\rAܧpp*1Nc\r b|q;Ebq}Wsp "w|y;c1c;w'8hhA 1:cq]/2g9;y9T;V!qV;>/sǸq"1cq8߇}w[A?cy;w7cqA/_s9;>Os!׽ w|yz`|q^k1>z`OhW<1xb~6 >W<7zbA7O8hAC<1xs6O7o<߷6|'<1xzӛA̻q׫O+0.{a< qAy^9I/\zzkqk%1z˄Gs.b]^O0¸ua^.Ss< b|:"~yS/^zA+D\ozYsk^p1_r wc0>z:3q} 5/\gz-/k^30yap镆 fr7< ¸U b#+o%9,9Wo5bݱh޸8Ro3޽8؛O1~xj1u7o98Oqׇ޳[A|ټq=q>p{/js 9o1y#:Eopp_סޘOzc<8m{w+ q718y]b|~Awޏ8VyKby 1Ƽ7s_9y71oϼc8Ac޸x75T!b<8q7ogǼ9w!1Ƽͻc9%>o_GC_NJM^k.xz"X* }@ɍz-]9VBw퐢 ?fDTCY81m9Dn2>*?K u%~D,?^TP[uWG\] mm.!zsF.#=R6>LToLt[}&C(ciQ둏2jFC]Wy~P翮7lDw4~ T&QyNz8xFSMǯ(8ݺ[jV}" {-/m7M8' 2ԁl\uu$g}ݽ'Cnrlmt[1Mo{"޸* xHd]SԈX͇/A=ؽOL/xtbwՇl͡f}RD}_CHvmmzGůR~vfڱDl[Q:P-,7Db;Ùņ~߹2oD+3Y\G(~3&oY[N0WGv|rO[9diPAKm,yb>/{ve=|jѓk?D>a;dɰ>_ wwo||xWouHSC5Pٱ'jTàPMb B{!2d'j?2xLһh̺k.80Th^t?*VzY1eV7C%H5x֒z@H=ٱlOHֲ1*d K(فfDYߑ?Wܟ;R:_"սqzYD@n }iY출Oz?)^p}*Gvf^$R%fseEQBQ|BPՇxn9jbQ>D_KJ=)]_Njil rY=G(/n%kzn3 Tm~ez2;h?"3Y@NW}6OjWtyz|{2֛ Sb~~6AULjNŠWnO]Pufj,r9 Py]ʔPnu!iÉD͗C,ӑNDor\gdIngH Zk(v|멓cֿ+}G]iP$^0*t=o4~ z#fTOg`zCT.}ٰs5T5֋X]YdM"wRyD+fPӏwXw(M5~uENr ^ʏKW.#40W!e,.duYE:{c;51"VO*Ez S#YSû@ޝ?eU[8\wSg`U!l|"rѦ*ۏw,t|RK*'".d-kߜM? :#m!}:/GñiD|hXyA57qGEoY|2{Ҏ_wKzkdT;-4Nz]ظ^YDG2(OHY ٶ:P_Áλ2LӁC"fyW\~\Ӆ(EYP61W#'7g/B|2B@ec٤;n ra4kҮ>UT;~gz?4:D8i~yRV (ܴ%~dbVJD}megvrW֡X?*'&1Yd߃hK| >d#?4"^+dCu)l]vxKnS̃W.d*1Րz(P2MMi3+l!̮(?v ;y[@g%og}`v=gn}b?8pʃK]C!_O{,p9"2HHg_z}_ 5n^&dTg.aO`uX'^_U ~G.k%@~>#CXƌnO9S7րPHè}P/ܵy74Zj/[Y>jʷ'B)D:̞]6B<准sCy.Pqa[PugۍPQp`"̌5T^:Vا~፬e;v\*v ~ޫ63r*BH;Yxb(?u~~2Peh$zO{ ѡr5) :cVA;_)U?0dtςS+w}[[a{6no[ 徜Qyg#TG$6uC_蟜3 쓶~GMyg;@DO7"(V_y[T3)Vt|A瘟]GnǟgvC'Z_~T-: \G?iӘ*8oJH<9ܰgQ6r3QAőwvӍYo>)v/xv\-*AISY(5ǫj/<<c!ץIc"".{SҙD%gsxRW ,= Mr ܶO[6$ v|(8fӞO7~;qA =[Ar)="S_mT{U*F aDaW|T49%+T!oW b%e6ו&g-iwU}|ٽy">r=R!<`gX}:|hx_5Cγt5>;ϕC\T‡e: Hys7"*{\!7ňwxMVy>04]%4]oauF;@[AOOW`in{cRsdIsjuf/SCҞTD䞓P6갵b_{|,k:b0tTDEړǨBW6,,|#q[o@ى!=fr'Z&Fh<`tY]J?xr u$N"-FOz%Sbzv]Cդ؈7[{"D>}d:klO$j;%7Ѵ7ێDzɽ!!zX Fʋg;*LaL;磪CDy/Z@cQ\ӊܳPgaSP4'Glʞ]OC^UwtZe(TL_ Fv1/"A˧/%w w#d:/Q' MVm#ϯB/rd%(+΄٩+ 73TɄ3~Px#CEƫt)Nl&H-^:AV33?hC݋0s-~ssO`F:4J)wӦ1UF##ˊ#>@y!&P~VN>Îtx}a J=vE'%u3>qD l]9|WgTLmp~=h?6>K# (4C#^E󶍶Vr\qJP"NK5;_yzT" {$)%*PlSҮQUP^2}IZ<ʯxacyUZ&ų^&]"8NƢ{{+RyCnU}b!S73{/*?\f"u?sÂ1д{EJw"~AvA7-]֓)vCp Yͦ^n)AByAt|վj& ʏHu 2#$g)`Svm]UN+@5 av6FZI(o2/ gʍ']LVz·ɥ{BQc;*Λ%T>EOOj'%W5㚪ibz藼҈=!༨\>28aoRV@,@K ~qֵU}+>_v~M5J)lj",o2{X"G384~ݱ0c$R>*L)3,쟍t+7~tߪ˞4؂_0 ʔHuʰ>сxy4JC#B* 3 I o~n yv-H7;_jw^#@=Sy?Ӎ`>;7"_G e3Q^^[$d->L4^^ڍʅ(?\// M N3!W8/V~D嚍k,0}(SDrs3<}F!Rc_ŰɁM^bc;?(xe8RiJ/8s^O=@gkP?eݚO'9! BG(moeC&"ߋH;ϝnq'|OZ8M`Pә|xjGiivOz>=-1f:;"wDǫu>fOBy9 G~8 寎%ӖrVcگ|8[ ;3zƹ4sĈ/kG H =cnV@iŝ*G~[F $gA7s/d鉩/\9,y|\yd|$r9'FCmu &4SQ׍dC}>k?؎]/dpdtWd)V-7ț|ߟI%}{CRַ}Bɻ;11~mjVOҝ5@~JHN/ݒH8UJۜcX6W-Dr|WԅʟOG=U<},]~p_}]O(?yvUyS2|"=wܞ+)2kfƿφwz}#a/^[Fʷ-cȯ CuL\%wcfoɂU ƻҰWWB}_m#NubҥvEGEޘ_ /SRw`3Lo A^k=%km5`| gˇRőҸSpGũwD8ݳÈ Y'0Z/JiQdpp-?ҟ`{j=q೫l\αe3;C|ۺFP'jC^P;C9Ryr=?zp)(}JJ}2`}>ߌEd̮>ߋ+R5vʃ꿔O}Cz tuKv̍+HzOܨʮi;_8'IY( ZtqJ}s],3T}2Rp%I#"o:nbɛgC6K;1R5*Qp],>I^xm:-ݠΛG+&:fyw$gdλ|,,~6Q _:s$?u-'k>,ujέzy2Kڬg<)YOHy)c_\i{pυ^wYOVq|:O:/O CDCzuo 5EmWusawd1TԞi?B; J8ڏ"GODl):9\{`r1bwzjUI÷<9v7ڿ=Sv?ҏQcܔ.P dxdI %o8T\P?F2f̟Js<)we@𐪺72hǸ 5-z30:h޽ֳ/>gP'+u鮷Lxt^Q+4VBEon`vX~s7?D@Ȕٻ\И,jG`i.\FC߮ <Rsruڐ81PxHwoKFN:6-qC?8tǛ ~-6Cg.d Gê^u+{M+]qy:4;zeN*"ku>-UF?3Lu{Mڕ;ϩ<}Kisӽbn~}1kjwe=>Orɻ jUl܊Y/ MfX6b+eݾo5y*/rYCmU\rTOZ uCx7s T'u]cQL0 g/2 V{<7K_DH܍}iؼKW"*V|e~ Ϯxۅo'޺^!B`Cbzw%>sdҽCֆo,M/DZ}yX9ý36| /h36mQ}ߴ)H;/%yL&/}7 DeI-^/i3̛o~GG 깬4̤MIGSw ҋQA٭mC\5DZyVi>DȸjܾڣHے}˂S>I'Wf45.$g\UqCbbn-rdWIfT?y1#jJ\^jm@ =Ǫou]CNNF'1 D*D>[yrV}kw /Sqk̠:kyZyI鵑LTk9|}u qAY6LNE_z-K;zI3Π~,_Y{O[I.)Ãcvq(2) kOL_Qx텈}$oA?~:KQ{`maNȻVK"MqO6'~KpAkQ"c"ű;+*Oj?N(H6]њ9.?^| >Y/Fjjjsk^dmyDkzcױ k_v5YOnDEm Ҧ@d~S\  J'>|~J' CRCSߪnF%}#*sΚl }8~Xw+"ti+_ߜwiF=M ׎))GGtoItA:Lb(mǹ=6؟W<PE^2K~yJJ= JqjduOO:O"?Rgdu"toB,9'ZtAJ2䬋_:9&d^qb CuN8?ǣ|Sc(͵Yd# G: 6bIʓqEz-| I7H&CsiON}~(}j?;>SI&U%.gtKl\?"8ox搱sTgk:7[NZx"O,V-7:6$2o2vC4߅@|tG>ۡ B+Cō=%輘{v1c^4Zٙ vz~ݟ]u^k;MN(&ySq|X?*.Q%'=0^iĚw^ӽJv#b,TFoS净A-`ZlNt;hw0dCIV݌.꓈Ku]>rq^=?Cު4yԞ]׽7,g7JחzǗweǴ_yӷg K52> ۱j3TŒ͗c^+6G`-Ku^%ɬ1:e'=|ϡGQyL`Vc\֏qȸ?n3:n~EŚ Jeua׷jo`@SJ]Wvf7y0zT>U;?!/!'U]ʘPiAkg+6=%&Nц/'CfuD^ !o'{?W?χJrPmƋx(=ymcCEyj{CN+e{}!2f#{d~z~ BY5;&}TD$a5KK!-yk7u.6&8y=-4B]%ϡJ8_"I<Ҽ'j um&DqqRhPgJmSko3)"wlbWcF*~8QlZ:+6/ NlWq3M7n/A33숒cErޭPHu#ə+M(F7^rBy5'UXn=7KB{y/L:wهWx_סFۤIT/-x$f'\9eH)cgvK Bn?C?g3"LmAFJKXԲ [MăMzOdHy!ֿH=J@C1k/mSA^5oCUE_]gNP^=>oe_l.ΏU:ASܘQ=zlV_sj ΏtGx.e2%k%g%~N:m.Q;㞇 '$3P>0nocc~\e6Mlp#x~ ZЄH%T&J *3=~E98Yy YYſ?d\7M8W(sfykwe}ţ-fŻ~ծD$~ԏiȉ8/[鿃Mh%TNk+<_c8C~;ҽߌ71W z蔧Gyѝ~lbgP԰^ypnU_?>5{*b_Q_Nc`9v8xЄr|zO~{_FsWH*I-H7 %=/z䑼Һ`b~P9g [y3]d/:bn} ״P>VqRňS(u|nAkgke:kAڕ/8"N_8۟(S!#T=z %yΎݽ~ u;y ;;x;Q 1yP=GP%3 /޼dҋǘV\o"%~,b"w {;]O>skR/6"/!V>f]!")P5{} hjL#jo$mq k B/rj)<3]: :c,ԛi/N]֞Wf3{8KjR=$o 럪j[{^d0t>?x'KS2@5嫌8?r;4u_ʁ7.UsǁsRaq&4#"ZHPqL/H_t\ScFE"񘍟*c^};rِvc9i"pb /@y1&b"d\1uGoS){^[^ct̉DE{•>(\{EƍiܾH_gY?|?zќ"̒rp^ qό,R^a=΄_+`Rͷo9 ))ZU@x4O}v1Sz3$/ 2l zs[Uw_{ !:ai(?/n? yi$}^0f H$~5-6'X{(C,fr4fyzd .lOf,:51zq?O!k L ʵ;'+/ލ?Egm $MͿrr8\wkPʣ,pt=84x$t>G"rrtqL_Oٵ<Y3Jo._CkMdC)u人\Laߛn0 % k,)B?fz%"NIb}AʶEqFCa@ݫ(o&&))zT/1:5}tr l"q_5=|׸G OV_pkG@?Nu+eTԓi4\gX?G \lE/5 */e`R:]0QGQ i8'B2r̓Ʈࣷp.=kGSF͌EOz6u}ۜNCt_AjŏW!F!urt;>hXb}[7H1{ ~p>ɛL$Io>LJ_1>>,R*:[jQ{K|Wcy|'\u9OubyQu =w~!ۊQ+{ByN??a-8F:w#.OHX6P}S{~ 7پ kKn7Ɖ#cICd<M&YQDz8yH8[?BPކ欽[ѽZSIuR_wrCbӤRb!Kx*ibPS+6yxQGXoɗ8ᵳo%D2eX-W{z*͚]׼ZU/VXOf 6K5,,G;hz} 䓍"~ͮX-W/V $q̮9v*gʟΗt[u8;cס6ftlg ђrV̎^>}QL/iڳ{>>fzYMry"b$fקZZ/F٭(Ql_ '&-~!;~DRk}[mrK|K4BJJɼW{p4\]8*'ZX,X )tSsyy}lW/"ΝĖ}~RWClDd.ϧg,xЉPRfKO ~m"Ҷ-GFA\+aR.P/EDʏ~FO$=袶c3)sl?yTLvQf ᚁ[A۷SZ* `4 Y\P7<$y?[{XP@p^D8GOķ褽Pv+8j&eXD:nё?37XPblX3wi"y+ȭ'}3((u]wmG=壺Bz@ʄ%#!T>wQE8 ;7W}Gk&tGJuedI}G;֚ݱq(4:on?d۲xCC #6Ku0aD@xRYEqCt;i1SI/vs+d@#/Iۃkɽ@HG{l[)A i!Xz\%{ƪϓá;o2w엄/ǫ] 1{UWyDv@×Q'$Blٵ'w*9b7 ?ʋHӌ|JPCjL "t\޽rJ;g~{Hq^0(otm![_u#| b?v>r1C%{=yρg0; :~t^-ܚڮ7ȸ-~0IQP`vu0Ӌ$=B6/֑Yy@z%<2Z:"vnΕ,"p?~#OMT{Kֲa g3~?:bX;ws2=N2A= ]qsYC yKܒ' =-qY5"o?dn]OLco/R~1>~ *RG v]?Y}s)ę?V|2bY=)9i; )&XN'mw/ 6 Jڽ:TOi<ӸSP!oo2X⩦ֿ~bYlkWUSjXWe3{ 48wsdv4ʰWJxհe߃3kر5?W %ƜUĔ'g6PhLfvW6nq~ZwuH?v ˾?÷s>Bx;xTmy3Un.*/ZLuwBH1+lx=-4|)qݮcS6y591·'2Tç%"1GK x"ŬmxsCQ$H@m-!:`:f>GtSPD ʓTsAiѭ7|6Q -|*Uu EWZ@g>;q~.7N@6x%ޠy}R/"Cڈu_&}ᾂ*/~{.]X78 oT͉,yqϽrr=FB/]CQʀ+wen$W.xqwv (3ޫa~Kȧ>9f X4ot| AX߀ G ^_эwsh19Q]soOM{ !ʓ)7u*t\z:eϺx rnΙ2N-A^ :D_x# "mUeVF/|4K:%B3X:/{Baْv֥`@c_zGǧu 2]:p[8.ú+h7!an=$|dH8Q6fwX+?oB#{R!y(: ~X,.ﻒS|ُw_WyV$ ;mD|SZ*uι%}鑑1u3 E8VUR.gγTQtN鲥v|1y Etg A=fTw_!S,/jԎ>M=x};b[Z{AR}d뒚/ЬrW1y"]W~.vl/]Bf?\{7οw;;2t<~/ _҃q] "Jrp*$^>(-O V R쟾wvG 퓺wΩ,VbbO&ok׻3yU>ێ'v[Vi;]w/ z$=\=v*rY~J:)1䌤;orD&j6|leũt~]髧OOG3K.f`M;]OT>k.{qu^݂"y }Z\,/'}S:gu pm+쪚ETדWȏ!T =\Yv([2)?L{ 3/2H~h;!3凝bugz&/rB=.JZ192f VĂ='M[ ߂zRKfءJw¥AX~];Qܐi 4u߂я^dm N8We\=T%cad[A=N3KT^^_9DT]*ubxN.i=C5)pa鱂 wcf`~}c:3>)(Aï,?64xz!ۡ 3goPN}|Pğ\VoB:-~6K]b'J᳧(l磏|T +]O7`ZZ)>)8eNK&#p>+|bΗʃkC^zY.]!ndM7V_d9>?cT6dO׫J*%Z]B3NYeo۝GΏW']3CRSy {Ӷd߃*-}ީ .sv=fˁ-OEZAAI$%,z-g_T3lGzeVn9J/!3#6}#tu_ԞO>24Gƹ*){!4t){Փ!led)kP~_woB?!&˚K? "k{:pjt2 |k}͏ȪKޣBO:N G{܀w NPtd4z`9ah}&$l~k* <ȫL^ؿ%$u8j!`v8a ૠUm] #&WEHI%3i{רgi`?x3rAWXx/KuzTKzKf4oU݂%Un $GԨ!:Lڒ9wT֘}o,і };'l<[~h/6~{6gMXSiSzO&'o/uDhڅEw<hK\6׽x`೯ҳz7$p⩠h#"# POK+~fXx|ڹx1vV! F%B+fs >Gf] w!ta8 =ҕCތn!maMmD3>6bԯh=(j39 'ҿAVW/A=]HH^{:9z dL|x󃬲=bL3)cX'{QB;jz1~џ#rgKͱnjEڼ>]`F+N"K_P;|frrqg].nH훌Zg78g"=O텵G9@O~ԾH}_]TuߘR߈'*m7+|gV[VOeek,٨܁k[n_b ~g w/duc|}@Q{!qrnw{5m\lHNJM2O7c:_2`a3NܗvJu$Y"nBKF;ZiNCDM&woH9Z{+i IwZpe%75\@n[G ?DkB]pgm/4i"DQ(%.u'B;J#~хhq\|b&X3-!޶wevg15pRP@D>b]֩Wŋ; w.<왠K} ~$?//,^Tעm9qg mr:9[iz*8IE˦1%ϧ}_ t&;wr*鷱Qt\v?yxx%H~Qc /$ 9vhs(G=PA;`3~njmoeJ>kG}t-!Gz^k J#vihg=;:{o&88/"?jMojPoQ-9rǙ1yeLE?wpBiHa};OM4$|1}tzZb$htU,S+au?;z e>zq_W¬r K!^PFN q5s%C~B$nvx8 Fpk7M>ڷ x4wv:|)l*̧΢ *%vǶuo3CW܅\; 71.a]R3(9h?~Pþgrju|H6WvFPY1mH__sG3ҡtgGfMy:&=~t`= 1Ƨ.ʊX)c!h b,c2hoȱ!sg m{ hT8! Y6rI9LN4r%*'YPW9~ᨧ+<ף~~~2y|"k^1Nywal,;8ŵ1kjA[{oߣ)$kY]l3lBDZkYvPPw`&tn?= IAk?bXVZmUqmD'zmyߟ>nu?H}%*~hzO;}٘Y"ϙuW6{m#w MoИuOfͯb؊=u*qMA- .Y7W#l[CzVƞκo'ط Ztv{oax?RoοzAs~a{ӽ*?7{*ʈсTE>K?3*lya~pKrb#ntu8[?f˿Jo?Qa oʭvFެn{DnBkwRjYg{kڽ18VaA{H כ_O[;MlOw:YCy,\*͌h.u( 惕:Yeq~~vܸ}`kȟGE됶ݧ"y>.#57K/ߛLDlVgn^pxr$x{zt5ZcKCИ#wWS>vOPEKx}{:f^P2?*.w70{ȏ>yԪ~X{DviZl,O>L_k>4tсO__xh.8嵛pæ~˟rbCX٦^NW,ZLΰ~B6o֯9+~S~~Z;fQzDUt=BM.e)h0VJ{>SI֎c~"F|~,{wξ|K1/[f`R'}Gk8u'2(^ӹxwƮz @[savOz"i\EH"ju?/]P;ߊ|yR pnlIwQ#8%(x2KZ^CXg0mlﴞQ?7:O?O?7y~>߻iEIμ o_ _HZ189appY1VR6֗y?"uxEڅD9-ۛ79&wߞOP?3383:_ۣ>i?uu;](?־'"<[H{_=7tW%_Wܿq~Z>]#D t_xYȝq2zDʅ5j"B*ֶ^)Yf\7+0闸mIm[lw{^ԩK%Y{j-kmzс%mV:c3^um}\G,kJ߿'Etd}ԝϵ_릳ϣ۲["DO`Dk JS%T֔ՀagO>wFe⇭^7_' !k{}܃]6˶0>13&litxz!?u:/n gƟ-{ .wr]|r ׌Ύ+fSt#E& Pk{7Þ.o{yGH#\fí/O[{quni+Eڡzʝ}]PFv|NuSj_sav1i@W>^jxS&}uA\)_z&l޲?;_j7|;=w&О-q;cgLyFkrOIJ;Z?A=gz t ZS=ܓNPvwr\q;6L |ui/v3oVڏY?DD[3y8qt+ٷ>y?}_ rzj[}Oȼ6xR JŵZ8UXN9KpnJV :B{5$0;qu5[<_wL]y:>e{Ec=ONzXo8O,"]Sk玖Y`\_D$^[z\.!o߅q?Q}fc^w'=O%+~G qՓ/p 3"_uNNv /JMk| -/]ˋqt=|u^J;,m:k__Y/їss0oCo?S;v'?x_hok+ZmVy3\XrM zf.t{\Y)B/cF*zDv/kz+w8x`?:_rokz_EC-=g_;fǖuTny6K^|qͥΗqm~\~kj4ϡn^+6wfv[Iv {|*P#[}pb==5snctψGP!kӏ/x=;OvDZ>Chs1i!ihvNb@. 9d1QrO-Y zah0+|]?o?A7z(|""oOD^Yoj.ΗqUqgi;FzNz\Cԫt8'-okwO ~j苴 Lnv;"8q xMSREȑOpqA|og>3V1_ :WA^`ꢫ!Wn{mǞ]LMݻ-iFߩuTʮn16Ĉt$N U;}󃺫8M$?H^K$!3eDL^а?qCl>Pa 0O'MHjU'%m,S>Vq-Z7P翶,%, Z$ kKS>IzRP!|j⛍PBE3h̲KW8P3H+euyײGG> g5;R |M!Co<\Smx32j e Z5&wifC:7u-{m "bۑDaUfQv'_.Pq7YGڱnio'b3_><0εd x"|ryڳcE_#bCh=]ΙĬOhڠt>Q;a;Rc[?E4'6$QqQj359UC;-}\Xj0rU셵 L]HiXH潊$O[ǟϱjqP[j>2<]{M["/45jR-9v:uNԼ?MbGk^5]>QeE,#޵@/ҳ'ic=l?u QU|;[_E;ȩu'M+$a ރQok^ϘVq:,Ɵo3XKb3gp,F2nGos9"V>CNMx2D|x4{y*1qv&Dv]"3A"}"x" ]"5:펝Xf-~Cm+_TW>:Cɰ: F{gx!3Yt|2}Ӿ'DǼ9sx*_QE$  t~ W/Txl :8Oۿ[ um$@C9OISgrCu=Ok] dZב L䥬o_D$}{''W^1ߖ**U!7r7"`uʟDPbA^~OՈT@R}fsĚH_Ըׁ\rP9w.9DG6z{}%02\HX-{d%4|5Jsh4w R|E}L5ƒN_aM7&|Oe~n"[uXCz\5!>gزs9Q.Po!PydٹDj@Ps[Èđ~IPoƼ ~~<#ف0-aT.Dfܣ_Aō3W@MfT1OϴkcZŜ&)'\F@ӏm;zưvvɃhqn j1[7?h ;vޭаބw_ 9GT$VFnBz_:y/~' >ACLCՂʜ~3^n__~D5񋓡 \扰nb%^=¿ *d!WZt/ﮉPxP3t0?sD@ekCEρin!:s= m {z۫rp&9 ۥfb]2mgxJtv7D1PQ&(8 UT) M}4X Y[/A|=c. 8kH!W{fl/*$A%s&ʗ؜34Jv>DkCG{-o"bTn*_{.XK~-g"zߠPWWͅ1kW\Wqs^6RNT=V3T՗ZUK;S Ʈw9-"֡߫DU]c 1MyJFW856 %g"r#;rԛ:pqh,Mh\,Tyo̐[??8'x^{KC$YjɍoH5rA'*s͇ {] ~J @cxBy4t[=w;hXbasL~[Dgeaƺ#KLJ_쳟{ M7Bo"}{#Bmz\ZovwcD|FZy8Ƀ_ʏ5y'TQ ʺ<:v=P:G|ڪMdzeӚ7AcG{ןBkI >f a󩵾Ϳ0KǿWF:ȨaC;鴲)2 )y8'b;rwŒn?Cu&Ф8+ZJjC̈ m@UpEezE[Ʃ@iry6:HmBK:Xf "ZQ%~ Uhw[cC{"33")aιek5nGu/> ^ ՞'?{[@$gyL$d+:|p#?~&j׮V> 'Ed  Q uwU=ƾG4Z*|V%Zh̓J 45]׼ZN}_|SR<>Q(*R WVT*eyDS6Oˤ`!_N< ◜?i|)y}\p?"թp B{'K= r&]q0~R% \\"qMc467;62ן|wf{Aūo~\P:4N j'\9*NW"e]k̪=H<}g?7̯$*]e{ljK Pӧ#CacE!n` Z%@%C?ܵv ec eΌq`vQEaTOjtsR4vDYMnx&H^"E,΃G|P-"mB=:fU5kϹ_J:_\]85=6'm߮[*8#wHTi/;w4$jVGV !+\d\&2+\fD U*!ԃ{7Iō N H'2'='d$}!{kDuT"m.r4-%j-H63N!xKNDJ%Aac0?;q>˾kaK$m~qoh:[<ĨDWPgk!_(*IiƍC/pf"#{h^7uqA=i!PSf͝!fB'lrwvZJg>XBy[An>!:OOgO~ث0K~bFT]ӲGJ=l5A'9%t(TIթZIee+fJ^RYB4},ƙLuj>\Tݴ)bBpP hT2"%/DB4ξF6Mnn)4okd6Tx䤴):i'~_([;0z\eD҅_{1?9~L>BAJ"i{Pw`6yw80¥D|MJz]:-e+_*mcP;"%Y<9&U x{JDTQj;֜A^6/;PbV-PSS} sVC(Z>4f(}*X@AeoCwG}p]P:Ih=v_އHN7-O*^pʾ ]2gnTfnxqeDRuaJ]g/q}.㻤qB<-XPC}G >qtNK&xG_0ԏ{;iŷ}5w`SyCuC'HsA"ǙA k,0}(vi#By a="G*1IzQC;DdpbG홈K>UBQԾ=Z1G7-phXA ʛڇ4'&IwI;OΛ՟ؙ恡tL|9=qSG.U9\ _ug)g(s{:<.GX4xSA|;ov`07l޳%X/-BP>%zWw"Ҟ7 ȽQ>H$F,iaAfE.;͉bTx5{D;_K7L D]kfWќ/AU\a˫׉' wpè~.JqH`=12K:R:DKX!JW du9] E Mi <~tx곟MH·8ぇq\X'bot@)}PJ?ϮY7M=^(#)PU$cՈK];ŏDi3~*o#7j&҄Pa#UiF[kf>ɷJ5riqd'Mvyx..jq&tLt5G(6-fDkKPx?4zcȜl} ?ZȔ]cPi~3HO\F+`|S,Qm u_rʣ!~݉#iZyl'|9oWw.gr.M ?IN:4nWz{/|J*_}-gSLj/s7M/HE!f*M d݉OR~൞[(ͺij}2'nDF%R(5#΅S'avB7s_\uj>>gO:+|`OhA D^;߈Tr~Q/CAѬ1QTs<J/+d 70-s駟Zy*:r6<(CS{{g|L%ƗװT枿vZ"n:D~G+3THnB˵W'7o"Y^gOJM^?#X+{ %ÄA=C7`Ք?/}v% D3\3sסPYh˻8(G2?X?ml_(]՘bBͷoJP1c*gjGTN3C:ӝذeiBH8\hGPRwx}? P!?>֐Ct,~R;\;x=(_j=t&g/r61|r;k>[OAW ;2TDo:?xmli8TM]t6fwuWͦ#M^?uΝn49LNs}g"݆/DWV=3F->cׯf׈H=n~QD%}k\U\ Q:ݲAL.}ղ;.u%W ×GKDwVͦ~(Dk*_"r:@}7U띵q\(O]m6uYD,Vmy3DuQjpmK-"R~YtTj]5F ʵS:~4 nCT2{W {H$KwDoX}P[V *UzIRPGfbZqܭ2N{Mwt5D XzqԊ?`Fiz~zo2$]7lލ;Ɲyt'K+̄*?01o_`Ke'N+ZӬH7{:\R@ huI tOB)TVJC߮GMO=k(Igy(hܚy7fG" ^"gy3Z2vC{".?'H:xS"|W^^vEgM̂4O@-{T #2IK$ksǵ^\t(T6bMs7?yBP]R%sQCSqMjILM))*D^)zo]uޙy8t[͘h= JfzNT\5?|68§׋ ҧr$K.Be-Ӏv6>iס¸]_{qk~-{ƺL T6,R F:\6m5? 2N1ߧ9&Hc7 _Ddߙt&݇lẬ-G[אϔQe%6 N#JB9eI Iv.JYKW2;,="Є#O;9.iuK&aZz?B 'gCJG^ԝ|uMB}EB".\ ^>kÚrgTw9FN~#gOyD =|OP/8'Z'\GS')dcf@3;l%F̛xv*Q~8?"^C-~N 2veFDBLLJ|X^#;*>|.[=<5WfO'vz_ UYӆ t]RꙨ,١HS?hG>"Wu+K{`HqMXZ۾\R9!/6q5zu4Wb$;J>]08rFPפ9> ˨͏Ш۪^Ps(NPA${i7y@|ScdI,>[{޾0ǏIDU#`L"PeטR{%,P>AyDO1Q=ՋU@Yw]'ſ=JT i+#<Գ16 勛?Wg'onԷ*iWCZ8$HBL~(2 Pqw;%hr1_7{ܐ6+[u<4$J1)o/>ƵcM}g6:$cz)lާGCuA}~Pe|?2&TK54QCǭ~ݕf W=vz (~}= y.yظm'$bxy r()ۑ'O_mCeI":Wi#N௳wV|GĝήpdL׈ѣeJ^DS2Eqť= 5_CPӵ‘)P$>siO kCu#- #P޼MhO2Kr1T><nr{~|?5B4ݐ)Úx$!<%*EAPYŭ9_[nEtH`uڮT\E+PpKmAiKB~>Zj3&7{Ϲ;ggΪrpoK]_0.hu5`uM<\`5s?MJqk!?>GG39ROɍ] FuF? (D2[w`m)il<J/).]w*/ݣ'zS\ ۼDl~!.pfl G H;U%2`z9#ߚyhvۊdC0oK~zݲ;q[LyljBqoog *ۨLzw[!<?{M)ڜV#bM`_it!FY?5Bu.r[yl)?Ƨo=Ov=$ }gL~KCȫ! <%~6s!Uō1 z~!k89v_9_T$z#B{y?D؉H-ч F gg7yt| ΋i>f )u ׁ%%@Z(kWs38NWlteZn\3tt3 uMfb`*58SS_>sp%ֽ$v }tɜdn8ZESp,m&.2|?ifTYK>;v, >0e:}`]4[ C)IbгC>x'*Q5vQogv}iVQf>W7K=-0{}J/0Gx`O&~P},QFbX.DJ"7iwPrMmk=W0lc+0mWIY~[\&7qů˗Q#3{vw?џwK~;ࣕ.rέ $s'~ fb:pjL)XCjk:$)NgևQSQ" lA dٸ g?O+ qVSfq~Xvg viO0_ri~٫r`1/°g/`lk?y\OILC-Ov1F%崠R{pkO\.ך^Gw`3>1H1?EǢsVykg&8EiU={p_uhPd7Xq2sh &">z腅ń뵨h%ʺk% íCK*r,eG6Pw p3/Į`N'>Y鎾/Ϩ8wQlI0moq]OԞ)(1Jri?XKcg [t˛w J8Cp!~MΉcQ⼆%Y)>hbǣD~|ghz'qS [\>Aƍf& \8(oŸ0X)UV/UvRZ6 ͫs򚀩n+Bq;& (3tߪSI>[O`0MC '+:]$Σ}߱_˧c="I}DDI$nH$J(S>o? 6juky9WWT(/k([_eA~q,}ePQ <֪Ա W?'Sfitdistrplus/data/danishuni.rda0000644000176200001440000004163513742313702016404 0ustar liggesusersu\TgF@J PEQTlnnb:4 s߻{fg}ЧPׁ@$ DvY# \,t=b13|(g3F0p7c π eT1<[3 Lx ,WX ;>@0 Na ca<\ b&{$@Y1CY x<})y9D"gsd' 0Dm@ʰ؏!%p,S'10\.W2<&LQgɧ3 Qg do%*KƼ'1/{u'cyϷ1Eڃn )`Ki 6-)؁a2D _RFK $%ļ$;$ JB'S0)W^SP)/)K mL:2 t4"Xa0 S1 aXamZ"_R 0`8l"R"R?ȟA` 1 t)uÉd0cJ.+5 )5LdaR X7S7 |MG~eIՁz049`&N4w^/CA?O aXuNk6.`؆!K ?HuЁ  G1HCMQi!i .3\p-C VpÝ 'i@I! OCn M<M:N>f5 uG״/@q_PuL }ZbԿ: oŞ ^\,3D݋UBXq]u/n& ;2°D őu\u\ (Fcb}c8D0g1/1t@ׁnQ @Գ,> Oo1q1q1]F`XŨ{1C5bbԵ+FŨ[1TQbԣ'e:LG=A騳t騫tUz ^zIG?2uu0=a;tn +7~+ez?QGҧ2g@G8.f!u:-l:*u&0!t;bLQ‡.Q驠!|u:s:.:tOH|߃X'QoSӱN@[z&CC D0Dc"2-ؿ`]N%X$w%b4QwSI Q QR Oҋ!7 R L2!# |dr }d!Cԓu$$Y!u I, Af)9}/Q@P ! ! }n $# |u$&:&:&P?2`:f*сG!A!N*bINJ=zޠPRRԫRRO) J [S&)WiKag Þ JJJ~JoJQRR)-Υ%: \01pu\:M)tE!tF }ϕb&@#`p qG &RISRK៥XXRYu[eu[RYRRRik#[B@{I')G ? E_+z.e}0 #ú.ʠ;2ɠ;Ҡ'ð qCVaA /eBd A >B!@~ z$} $>0N;d)| } z%—Ƞ[22 lX":" BGd'2ytCBOd 0> } #K32 "p/$~Fgdei | :!Ngde l l2 2D?#A_dD3C22WȰ&3143ɠ3B[-D!1}6]{@܋7Cr?g+9y:9_' 3l°Y l&ɱ! %9$9$9M% bB` ɡsH99:':'O×_XH_$>Gp9C|/9ȡ_ri>IO{/C'bx/qP$\:(W2_㾠}&G'~J~}}CC%C-C=d%ɟ rʡrʡr4yi EBT 9}N_g_a 蠢C 4HE=EE##;tN}ZH|h:g z*:@@EOvc=U` *%? 20!S@c0.+/+ O_ Ot[i[X0U,c}ft]~V?+ ] 0>+ #+b_Y^+N3+ CeWY]V@ R9eUiXq}1CUXUdUUcU@o[]tUT*J zTBoJJJ)sJJ@%N n)WJ蒲-C4e{B%e}Q?UB_JqJrá %+c%|z('Jr*X0!|D~:.%ex:>>O}r;Ý w= 2( ~(_Lf /VB%tFyaJ+%~nJD%|z(%E!E }Q`~RUUBooSAwTe** **?F ,A%gؐah SATq*8tP(p%UB'Uv)]K tS?NTQ 2YGBUG| :>* :f2U*-TwUدSUU_ TBT+Juq'UAT_RW$ o*Jx5G [*Pރ)'_bNRAT:PBߩ~p@}:UnE ؏S;3D?F?F?vgg_Cu-uB1u& og[1n)Qݩv. ս@35E ]Qo2Dߦnq_@ PC/ԓK 4uC~Ijgj'5zF?oR/Sc?M}45tE =Q_ѷ7@쫩Ըߨިw1ި3LbRC55F}aN?jujZOӎ!:AAz:AaLbLe`K=gi >LT~T=լbBo5k1k4S tS~Ta~Ss!tSjgj4 4 qA}~Azikoik:E_h1 a=B?J |}Mۆa[mGJ gӢ_{3~%?Cv tN ߨiCZExчj'C-tP BJ Q;a!tL~T =¯ikw ߃3-tL ¿igZC5oZ6X|84bu}3'>Hڝι$OqMMo?]w6Riii+vlA+'fS>_ kN6*Dӊ|qh u'{$H6 !ۭnE^tl)8b:w% ݰ)p;p9Nsh-#:Z}^$R{Ծ `LbrZ㟑O,jA2FW麓ȏIAЯ:G]AvùqҲg I{fSWɵ'x(Os¯/zyHNC˹?rÃٟi]N-$ى׵ 7Ɉܓy<-8iynvVlwV/\HQmM*HKk|Qyމ vMR>x$y֢>hJE}eRi{>'m((ht_tGZN[pjZj}ǃéCT+BWQA3jE7Ԫ1vo7 R4ͨ XZ( 9~U;Η{!zG;U]Aa~$`!\|mj_頍ӪNkF:<..wT/俨C4ڧǨP,~]_?aqmsɸZw7/amȰf`BAV#)gd'*xru^|%)|\+uXEݷ&R֥r>Ui_kn'9N0zhn"/[g@h+RtꝔ.I6lyN嶼nײcT~fQgPk5{SA=SH~/QA8Sj}¿>C֜ϋf^PaME (gmU8Ism鏓#|n,==_B:qw{QFr|Nj2_SCf8S]U2b^-۠_2m#oPǼ@1Y~ͨ~vw6NJ'C?oOnw, W/ԾܧzpChKh;±]ݻ쨬ƋGTttwGʒ.mGQg 淪 76!N;F +O JywwA^ bJew uVpJMvnv]lQp v}t:uxpU>'Nf-W@V;[h 2)du*y긼{$8R ǩVŰ>]X>~&=(f!*z7cmrs'Si*\YğnwNsh|tRuhcդ3&76w]v9/nA҇܎Q_X=^lVJ%G}>CfLR=7ּ;l ? u|3N`LZ2W$~:`^;Ĵ0jة'u6Fl id=#Z+]o^7->)yO;Pgz.܏kto$9_}Ԓs݃AOon// |z )5q{'RafFyf ;>3:Ta9~#-5*d]wD *i/gcQ7wKLNY|-{!Kh|ȷ:tx6 [j4 vɥOm={4JLxJ+]1^g;uD{HμȍCzSQ~ycgNLxCsۂS/e^ozU|=b{$'5Dt9 Ո}LEUnx.>ES?=8 ajK/{GoɩS{p^w*,?3Iݪ=y{T^hяOK/i"mT8d1EI/uϓmzjR͓X֛]3em_ub3宏1ti{+Yxr9޴B xhkKgF?w)0uwI/U㽨Cos~NҀn9qiaZjMb-sb4+ԫ- l%ƾzf韊O}k>z%{gm{z6v^uwQ?1R.Fxy^}9¸ܦѱ'1*v?l)Sn-ߩ]d(9fu[2ǿy dg>U;5ϓ-$OMCǖTHw]꾋 .v:o/)w$71{Y9?\dY\DoGcB*7L-}-}ޔ!ԥ^|s(HA*ɼlA2ws| /Y.$.&[ZN7`ǧɽ-6gƊO/}XBμٚ1yײ$?(Ww@ ?4E];w8dUwd 7>?ŽHdEowGTqpág ssvHeO}"{*TTޱ;Ȝ2O3W?³jשcMsut`۹5?d d5P$sDiʝd=j"N2ZNr>󝜨톈."\kuJEW:Yނ1t0<;>Grޟ]560Roއ~Ĵb TT|D.R-qikWi: ZCaM6}CF-끥q[[$նY'ϰ%y iы <{=r<K|]_5Ɋ0;WDq/a:G w@r2^>):vC4:'Xzs7ߎ *"ޱOk4S^nSO}#5 Fŭ]2/fiabYl}qtE'QwFAP4 xM~"Yzz$8.uF۵]rHrZ Qdz.{uE0B -{ş O_wQ5Gbk קxM:qU4(T2$Fׇۺ0 ]vÞTY:vvhbpҭ$<` =PD}+lq2k7$׶?D2']˺2);?D~p;Rы*k˖ɽop~'+G{MԞkIO\wc%pv'Z⣏P'MCjh6cchWe"=s_y[>67)'d:>M޾L+1IvQ>]i)M#9z!ޓ =Z3,>̍= Y7{.|\~k qDt@S焴Hf'9{ ާr! ۏ]^wY)#Y7zjY^H +?G60:`^2+oDI#UFrN.Ňx;/1YjR4m֌Po_=7u,?E:p›<˞JϨҒ $EWQ:anW'QkG)S᥁=Mϛ)KV~>muCr 2h/mGEy%F-ZZ/ć:\j7n|A/:LCQg7n2-J:]Ͳm}'|rs[?AYi s㪴ujX6m 絵!N36s&_gzK=F"_hZÐ_?Vb_hZF=''w~8|C\~Ps&-}Lm@t>tLOt±~nRS_= 80-}"\+CmSN絖;;~䡖I z-neDߋsmUߛ5ӨԴrakPY%-zZ'MZGqu= S5rlR_pǔ8C\l :PǰQЦUm6.yHtXxlݶnI=чrx;K_\XR~$ڑڎܔ1i)u/x͔FR,SC혪$Cq I&mŕz.nbqg Sj!8K}JH5בc/ t6$ɈivK]#&YF6u7@yOٹzڮ:XqD[٠91qy)U|Wbœ"/̫+^cw?vuRg*<'b> ȵ5ƍuE7! !zěO`ͺSꉛ?Cl˼E-qD>e1%v>Znj>|1A<3=BY2KE]䏏#yxmꏋ nZ򼸀kf]௻dbjGLK KElчތ<f9-/-wz$ףMό=h6Q6w&c/O=|ҟ1ǭoSy1y]#z,]~&碑\4NRwF2,iI*ş Ysǡ !~jYmBÁsWh;w=iCtCqY癣c7L|^Z<|#|Ќ㙇;i<_@<:)d>Esc^Nǽc{%g~O !a]ʑuV7bzuc8-ގ@tˎ|_N&@o"/vtQi4ݼP)|%\+bD?uýI~*͏7gfCaE\f>sT *tcMKOl9uNX9-7/kᶙ7Ǭ3)+Z-zgxu9f :S'+MV?2i.|ܲ1e;[WS5kHx~zQc?wqe/Ehone6LM}S:uqd~:mxjȰg#IF'[v]${YB<~^K߼,[ܼRsF݂:M]~uGف&qGW}n]] KDw}$3QOpmK@i!?<.Kl}Pf$wͅ/ Ï_췅};7zЛYVOu]b`zkbhy|Gjyi 9Hֽ3&)Ǒ JR3G\]V=F3C nԎḄGD7bZMg[Cb>FqhG/.Vō6;+}vh6O$CetzٹL۟\7\[Tkї:.n2Q'y1Eo3 ZV8L39x{2BZ%t^RZy^Eis3?S@}ɬu`dMqb~LՊ+r^&W?}$gs1:gז}n&Yy󆵥v4x׷> ےX5m7.yĘظ(W1" ?ybַK4tÚN:S{QN$nxIvjWm} 'מ௻pr{[tq?_H~|dfS~o©;% KW ۮ[[+N[*H59?u[|5^x8UPG1^ݕm5'Z;rO{$^ &۾rr̘$ڦl#ƮG>Qь' %8Q5#S禜Zőy?dz80tF-/ H+; bRpO0~\&ci*t Σuy~dǬ!ҝ$}J,]v+H?kfhsymvx_^4Km${jh>{fyv?jRh;}6g"@9Soտ_?]*<%ƛ;8fuCM¡unrCJkl8) y}8 qqUIa$;Nu # nQOJuױ``{yږ>ԦFOt3Pu'Tt۵MܦMЖ$/qK1[n<:];c07[_V#^NEGجnŀc뿧8S HnDjγ!N|f՚>{!՚e~zGSQ]̄nG L2;[ʪu}v(/~,}MB\?a?j΍WDtMRFbjfGU nZ(':[=M1ߍ?][ -H3ΑYiù|d-t).߉~w)'PѼ&"~ԕ #&Gjrw޿u*(}M c_FSY3ۇsfo/vqJto}31*V 'NT p_Æî| C4gw/ T#gpjlȮ]9f>ِYm ykod( taWnY:b^#>h9Ք;\; [>T1ݼSoi%^ׇT#)cT &yjWuP9PUw$ߥpVÉ~b\^ FNuunEPGy-?9n>W.tnģ窐=3;I6Js]e=ד UyҚdMpK>Xyj36-::Ivu ^Et-4m_Wn{InФx'=5Sףe{n7{Vv 3It\ѿd49nFdih}[mƈYeV[0'MNbIa p܉{Cf.p@2EjoNtALq'Z SG.nꙸfİháV&6!F`?u*1֏'C&RE5|sIERbxX==$uؓ]59x= YΟbtGrH;Ŭ{:t0Lԝnv@=l;׏.kcۓEkϺ?esf\̤d*kOu叔1}_ۿB>i7.ˀ$SlZJ0Ǹ2tQϞT(JV]k`|{}Jq`Z^{zH }͸G}zdݘqeW/TB=cɩToӷJbpr؁O盟Sˍ$ e\Cׄfje*1-L5v>wV*?jpc91ɱv?Y-=S~jMtN("߳M.P$_t|G}Ρ|C-/~ՇgZv{WquIEX<WyzC/h֯,zf񺓧?v]$6~Zέꌹ=(mhMٴZ=NcVQ?/>sm?˞Q{x;NK:IK5$O0qV3?cݭ["\Np)Wgottaэ^tN!7jq-<;pqo٠8188:Gtm&O&WݚME+sY$3='c{v@ ,w'k1VIEFKKډ6TRKMs[5)zEꂸԎu{s&ɲ=gN#XzO$I6 l+'y}XgێC]L0ӵRA;lUFinP,~$xYa+1wlƑ<DõRJ';a,1]I_}cb\{kjs~ݞSZQuuߑD?2[3Q?8D Un\?5X\ېr[iv40~RP_~ԩBJ+ hR5bwu Ý_aYÞ'S9S'<5.j7q8˜o픩lѵa.X}wțDq敋}0|!&c^Yɵŝ?7~;}z_q烣fMaJᒔgZ~i |Ʌ| )3~-qyui_/Vm}8Wͱ#ZONܭ1?w;v$wv%\ǖ'Q-~5O*QĈ'lr51c+|s#8;=6Mk!N^ԮyĈԕ=ae9v01~DQ~--{ZFV)>uDWu!$}}ݗ 7Pmދ?/f.O3Sn^!֟d:]eI3Pw<7uӍV{Y|N鴴1U_91qtx㧋Njmcy}Yt`kԥL%GWy[\:Ņ{ݗ{.2ʼnK[6ɞ˴Q;[mjnpCt閮 yuS~Qv|:CLii?_P{в6¼<$3٭}|sa!m&"Rj96цۮϣ^mIБW~-/x2e4sn9Vr:OEĹ[SfrB<_Wy}CܐG2b}>ݦZ>2mzKMoOQy퍢"z3F;oBk*ifitdistrplus/data/toxocara.rda0000644000176200001440000000026113742313702016230 0ustar liggesusers r0b```b`RL@& `bN (ɯON,Jd``)f‚ÁY ١an b ]EXX5XΚZ 5&ȖWZ(\>L @LI,F7+%$Q/DŽㄚfitdistrplus/data/fremale.rda0000644000176200001440000000313414067302651016027 0ustar liggesusersV PSW()(Vam:KDI !TQQERpaJiTKE)@łԍk[7\CgLN޻˹W} IqO$jV6 {paNH];x fVx)ɘM@5J2*u+t )9diWQYg.s%q|%ֶE~RHkU_nzL +PVܥ ]w)s?q|Rٶua[Xu/l?,lrrfB^tbTTE$AV 4'a-JL 0We$} FtsܠOT{κ4!v?y(H^;p*q؂JZk'An%ݩP㾬}gOJWRmZ &TEIls0%%KJcZrz8z]  B+{K 6bHLqW5vE~|PH^+w+g饭LPE=ao0|9qPOϔUCYHvh{] ~U{V)Xm}4̄];<9sݚofNy6j1׏nitd(%|{L:´lfk=>OX_u H+P͎>z@?S}I_@m<.e 5Օ:rcs)h]!> pǯɑPtn<T|EAD-:AGy+D|@Pr?sK: &gh's抒P8۩q uoʧs󬰘 r흠:WCXM ]@ߞ3 ! l{2#\2 fATpUucm`$wo;+-vLfiO )Ag4\V뵑nq],^M&>3 6[mL`995%weukؐ7"(enZ768AQ]2f rn5^{u\>b;"q5>ʀgކwӘu_gn-&Luo;`!8abgpVͣkU{Ki;!};`Niϲ 44^"u83+' ,HYŐljbN!{ù V˧ @s>2tDg3mXx%wm=c Px+>VH,k _o[w5Gh Y0<66mۙ81H.~ 'c~]z{ov^_-D裸 a{Q6c R^-vpέKU !քs\%z]nrLsO( 姟dW"xhIBռ?[Vk7>GT..~D}+K/2U͖n.ݘxi=$)VYYꯌ@ iÂrQ" E0ܪAW> G!"du .+Aeg M(! 4#ȓBEex~??!2@*4 =3uulPN\O$6N͌u}2Pp= 6U7KƬ${%LP@y~|$_9Sf2bWL.c̯f{sx|aB;Ϫ!PI 4M닄(p?U!2:sP\=Wdk61T .L04W<,S/n9g `Z!}V4c\;Vm؂@ܞGmVŜ٘5F}fCb`ʅZrtU-/? K]C]nB #4GTr>DZj /mh&!6MWDSSukaǔۢ윤Jڌؖȋ [Ogl),LX[b2;u7ϋ-8mI|o>D7 E+!b#%TfD! خ@?W/\+)eC9Ր OvX6@ĸE"h$wQ%M+'?sD4{'T>?YV O?&;rGNXFS$SG0o7;ͳ+;a.NDd=ds#%`Y mE_C\UEx(yQp':]61<CL|z{xӜ,dGE!+^`u[y' 4z3b>7_(}S扇 }uŭN Kù4Y*v&F؟v \0 y1g BdNB#o.`^ǏZzޜӣGu* =MB$> RM`1f$Έ9.Ӻ<ŎJ7֗eEUƳ!›wFubc v-di$UsZ bٻ)fwǞc&Ep| uChC:}܋Xs5e-{,1ȕ(g;wR!>E|ֱBqo8XZNcw-0mN_Ҏg˙+`jJݣ^0oHp[~Z|)^YF c}?E&4ct4v5< (_?|ryBqnZ6Fv FC4FhKFUze=%t?čixs>) LLQƤh=*a-fß}/  zw#ёY֦NGo,1c|ɔ '0/ 5fau%X['YLXCGEcV`H:gY,ks9^}=[0z9O/f*)ӝE y'J÷}[7{MaI;}î{W9*! e]QxwZH_K{|ʨxm@őK$%(c>L__O(Yc }b|)W͓LFg!On,S]4 Om'=IHar[b׮qry*(8/ ptA WuV$M^Ԏ9>UG>:9cP5,/&ٱGP* |4&,+!-%ojڭ{vC (k1ox0CLN4 k~XB\5muA=CVwqt={?}F;3A+MLHfɸF5:>Aܣ,J>ݽ汊y8k@gTp*Ց>ؓ΁"&mJ e > )Kv!B5'fL.^deZ<9i)M'L_h#WŗXh)0| ?LP,!0|c<_Nzb^P $'&{`_ף8y3G q mUS.ϾftܳS| <0zG]zTqxO2dD_bPg1ۉoRF4:b< Y |M0+GIퟄ@~lR9dϙ_ 6-YUqa.ݛU$T]Ghpuy\(W\yrry %s" 35DZb-Koc"huX2_^?̿ Ix:-z|vaY{T@i#pb=z V=*!:df^ƭ)LtUmA0yȭb> Y !+w''O:>:?B|NM<5V}|3㠄k1.}H_^ۺBϮh!te_&&>ym>R<c6N*&aPvnɫ =1Zbb%A|s+C>/tTHoˣiNGCLu9WK0*@==}1&m 'b'sŜA\A !H.bi^ {Oap 'xQ 7L,re"?3eCawZoUuqH2gv\Xx8||=z+(o怷r`m?V(l ,ilĢ,svGA}g믱?'6$6:N1|⽇ {Sޘ}9Uncz*xkN@dFr>m&HĬ:4!o3.. [A2O;x5:>cI1U[IbJ/g.oiD!O*<&Im(qsދ ߙAV RInyk? ?SG *"9Bp,3/Q04sPWSl8A$~!? 7]c jfaBVx lʌ"Éd'A﷙jWE%>=,f( "Dp<RuCfQ@zvfIC@s{O;Nq:KG/Faki9H|wDyA=bkޗ}qOs!ȄGvH+$tĩF.7L_R nd%$x?R W5csOe.(Lu\Yª*, 08=H rdMXu!עt,&6Ļ:>D:L_$XAMsο*4Hv^g! y3oƘ eL7~Dǽ w0T%f;ԧu#'x3 aGp|uu2z9wX;@cH5u|7úoF#4o~ZUuboAzЎgV:qrO?g`jcmGbRi;rKr^C9wڵkDtloj1oH"#_wE/FN&|"I̷l~wY##SP  Eܫo|DeEC |KkO uzkrl/[.Yyl 8<}s W߁8a` O g[o{rVtc?Pk>}H7;sNa˯Lz➧>'?HGs1Zu4r_i?H*,&q۩:'yb%փ%xI,`rHa )#=)"R9.Ő[/W0z *U?]D/]?΁bd.4?s|s(M$jEg:hwֽAqA-TX>&%.}^\?n_$?\-cvK^_d)_kf.unUn,%i]JVBe$x6Ȁq 81%}3Ro@==g7T:HAP0ȧtAw2Ե@c)#?[ 3EƤ ? Lfo^Bֿ DeEFr.Ӣ}SVz% YѵV>fi)! 1;7U |#޷ zQÑZuG,؜>[60< NßU}ugRam,2+\x4s,5cf٩#j!#qÔ",*`4\vsebVfV1li\Pe$XryB{MpL#,ֲȡ6l0`AY,4+ x rs eZEoHNDqdLWerV~Xr]l >;mRl2^[,l/!S^@P0{K 3M\ۨ/?s3|9HBwKEy HkȘ1P/ٝ5qu1DսzRmGjxۇ08S[7=Y b@j4g0Bi=꯯{-5:KȮͳZqKL;~.Z%x|6A(iQ2!be=]|wB߲Nf?d =|eBY?LJHBG{6n ήC~ݔ@O9l6ig ]6z8ĵoҬE HocsLvYނb vzgs:M& 9w<.P]lw [vnGPmx"fXr@.|B[(H4=5cz=E~:)^Vw#_"}vv|ףLb ?fv7vX*څa'=Ĕ5PYKmfJ> {]!FD_`oUm4h&qFn ![=dOBZb6kݨN6ihUb}r.hX+SjA/R`^@,ep=Ÿ=]m؜%  ㈊IJfo( ubnw|g[ǀc9P {@#yWNTYmT{Hm aam~?jrvt^K-Ao 0Sg+6Miȿ7!ߠND=0^;M[_I G=^INcZ|ʪt!QpY~JX%+yX3E!Uؖ;-f/ C9%v:㡃QނiEJV|쇬Fo$FUgq/d0A‘$Hg<*pr?菄X~>x m!DW6I'n_׌ smL.NJ\ǝ/k N̝|9~dtAbx[mTv5ߥbh㰦/bLhz/>8/l @wqxu뽋ZT P8. T q:L.)WߋsR.$TcE (sV7IȇMRor *m"}T(8/O5B SLӐk^"Na|& 4wsA5^.H|jN# S6cy(|K҂>m-*7JoH3o#>L+Bb Ҕ}'>nEWjh1hq!뀜‡EI?mgdmq2ߺ$)l 9#1 U ν167ރ%_/B~[2; 0F*`7f ex_3~ \qf$4PM mCU F}=7_EE5 FbPؠuB#7+0sj𹞗Sn'nG!HʞS>hAבhXk1^ _S@&E 8ޓM$"'\΅س;Cz"3&Di_@KVco1ګ!T鿄>dʮ4XA}Ý*K \#$ rOل,G!2%*<6f4oJYm Ӥ30 /)\}kmv5H^l^(whZe ztn|,͙ɏvA00 r'dCܥChjZn^5b܆8a\~Dip5k&ȋ@vd!;A*U'K=$ ?.I(1#G!%Zn|՟ȭR|2Xy*>Cn̨w 0TZgMf3ݒ/`]7(!5M@&G7 F5QVhU7N2&?|" Y 2:߾:qqҍWeJCޛB|:5hy:o}]'_=:-w`ЏM7cĴQo+0LUrvbTSX'lInY w"v#Q*-*#1Uiew9';\IB]Fn\؍ ]L<`n;%CoWypf-&ٚ"?#/Bp)U{.$xaiPl&u=e0}W:(Hϑ(Loz@a-aH ^۰qQ*D+Ymފ(?)`@ L[ h^y[Ծm=uro,}l|Sn~֍5k H'#*;V(./`x˷ wk2xTIl_cy1:E'lwnקypTJoȏ .|=sSgt1c8닃;g͟OIc FF 땑g`Kֱ:;<2T][yʥ YCW p9DZY> >#z{CVN?/p:I3M-uZR[) ^Ghόpޮ(t۰{*[ $û丩"+7%Mn|O3fC` Rf|PeBsֽN&mB@Xx9t%?VKL=oz0GoX?8'2ֿ9~Ռz{yhns;Uz0}suGt+tRӀ}wZKZ31bןC-eEuk(<B`. wCfϧ-t@ˏMnq 񏧲Cߌ{H}h먖mn)W-yуFf_Y{ѓdpt ﮃDYwu(,G ~qP,96^+wk_4 ˪{<[Wa Nf>1K WI+Ѽ9# g^3Z}x| DyqQ*J%ҁ;Mm[/E^[H.LZhVU\gTC[\et2hSYnjsGcvґ9$h͔)٘ >=<)z ?eѰN*'tf.=Z,8AVc%zY$>[AOqC3jXJ"14jao2D0oΔBՑXTp:j` 5jGU{$@`iq:%p8DKE s֣+]kR&C&ɰ"w9xsqt."]d_|Ҏqt#:_'LcbMN,-~3p~ V>XEz2op`ԭo?1R#U7\Un%]cǓcqf u0Ì>V$H(6о v¼h>dGuJ0m ]U~ë{c#鲴Z16*L>¸??I~O.X\4,.1m$|#׹)W+6_8D&2s@p%iH;7\[7ꨃz:vWц/ȥP:7pn92D^Vv^%lX{׾BTIsfZ Ѕ鬙A$m{DHBO}(ZrR3rG^a!4qOqZtOq^" fY4%_1}p'x!krN6G7a~;D7JS*%.a|˔J^hSMypH$ 3wy#,N9j|,XSbRS`h T-0ZOG9`}*W? Rd/ae0I5j h49\Q^k ķ ѥI!Mvy>ay2 ᫂($xwg7O:<9OXn~<qa=mtϦ:55,1>s%1VL{A Ĥ:{F\\l1{15ft܃Qڀ[ }f4t\I DZDGwGmD#di*Ax00:}26qL>w.ݺC?,N*cP-dr#CǮ6q`ȫ.3iB`L Oi>X&6,o=;> փI;œsYIp/~j٩ȪI24˚r+8*tY!7LPb&<ł@8,/Q3`msPL?r `6CKG0ldjh4xɋ@p jY3FՄ2*(4].ڗ`[ű㶃հlo^mhizƽ`Ά0қbm?_tYlQpkÏd,96 W K imhiv3l> vԔ=4LIpgy:o1Ts䍋Wj?(Q7AD-l5FO\Ww50/;"l'1l͕Z }R&({ qN#X^^ v(-X< De!Wxl"ބ| i} 4C3LCw}Z0D_s^)7ߎU#>u;vsEȲ|CT9j˛5ʽKZDs ۑ>1ۺfiu{xU_,LnMKrH & ^J_~Ǭqq?A`W3{Q2^ׄCoc\ezh$A!݇eu,g1?9`uR|;)M恝dw;WE[dš Lx cI%~&QF& vA#;P[0ڇ{&iJurmHA rN)14Rj#/CTEvAJ!λ?:c\<φ8/%?G }_/evao71ChOYQ<Ѹof:<7LZבA+ H\^}Q6UkQѶjȕD \oW-l Q6#!xm`lj^x2\J{F20bc'+U,6="\Jކ 2 1q(Z}}0qUH;*Hx|({*A)Sク)wd_rЧJjre\1U$B؋=_;X}M_"-EUC';ٗ$ZK.> )l] 0b\Qc8g(Mo#OeC4Q+cd g Pp(0=.,jV0Řh/c{|mV9Кrjyb <1E]qd*U]%]d F6cP{y~9cSnۈ<PakoY!֐A38wʛZ 5Z))(cLf'TMt u1ܽT+}N JMok:R^ڋi:>\0sL╺fR, y1L:ٞeW贝?;yEMdۇ74'^{ {BF$%) ~Ry$ZYi^!łwĕ CקnCw{#'O$"[IXev<ĐkZC؜kb8FCQ#+k4a9oX_rqg81nZ@j*Fi^a^A(>rH%?Q { +~L1{1E(y¶<ծ`܋ndpPdWO|A|^joHl^B_`;JZN|MΘ܂T?h o|e– [bY~*dD% 3oOBQW PIIg:c;$Nk0u8~\\ramMu-laI80r>}=߆~iיP>&y^;KC 7RG<1B72 [8wnd~pb;YZrbWaxT%8>Ʒ;;ŷPSMR^ҚէAȁƔbw,nM!ˠ_6|DQ-%Q~,u<5fWђa~u=qmT8i5=Tr]bڶa Xf*,Y%/GY _^,jOzJ p{H|HȬԏn*-~D6rȍ ҊnNUF3?an^|["& F菶`o14]~qfQs{!bp}@dfcXcolMw|$8`xuM!8*Nʢ IyœL܋/4;UM`;4ЇE*vh4"aw z`O-kOhv'WY;h7#u'x{A'=(QIGaPE eZJ s$xІL7;~)qppSLzqK_3V LpWO.zy)ĵPgKw=bVz~'&jF̣rqHoGwՓQ*+P줯Ře*3ݩM y{!fzI#fߵl ׮@&ۑXnL%عu(1hYO_#L#0}gu[^Z0%[$и~ Eҕr0yJ-C2(w&zz-t{z'KH)i,ufAi̗P_h /?,RvvMavpҗ> ib3!+TLg҉3ZMM^}PČJō r+O8Q\̪Xcn\'4z~xF-hy4x{; lS6[xw;i9.Smlv؁{RL.  ./>Ȇ>_CC>v7}wGo%=.{ۅ7"Qt\|׍XT\ {D j*u ܶ)B& ӧxX2Oۄ#巟A1MV@NcWS EΞj3_^XnX.ZGld'[N5zM9W~Kn\I3QҵR&rlQW@qxs8( u_^?t'S>w@~H>=;xu~ ]o'0!YUqFz72l!(:0g2^dꅂ'̯A)s_(y^_ _%0=6=/[!=Ay^EG_Vk@ mu[;2 }o\;׻Oܺ$yGW!"+t{*7]6nr]\P# -@:5 ["Oӿ| '!$z^oiUAdrsl*~)Į ;!DR]+DWa\iGH:luɟId j{FxySĆx1"0} D.AH /cYci+8bίADdo+ 1>ƴ׺B>틫}϶yA\orMp%DF3343?q_EV [u?PւݗxbĻ+dsع+BSKMu* 2|ޘ tX-dA/v%hڇ$4x-^F8x f,;CxI1l{.S64Tə&F785c9 AoWէ@#ß;kH ՙzbem1́ҏXۮ^ ["e zy{H;e)6GК!(d=|IG0vF-GXڍM:zEc>kBt0N//gi%t6>5yj79k0z_Y.$L+{>S@=!YLx? +yپ08|t\<$ 2j0iN*I"+0Ayc 4dUB,n%!_MXj^Ot7<\p@Cb6z=(_ KXhcF3|S J찹~z{fM6 ׯJ/KVi 0|.\_<6>FGث1|Mx,W6cҍp!d#$ t{Coٴ+9Ǻ} PY*dfhInki- ’-tk5"B#5}@dǖZл,Grʝ>G3D@SH580V^~,5]Uj`G]v#WzS-tVySiZol@F<*p">`;;i7VǩBb菿sa3]!{ݮp"?} [nzxbiS>?+ ܎`MFldh- 7I]Yy35i-xZ7N`spy(5gTiB(S{J o?Jb 33"r#Cav1 S</Īѿ.(Ő_\[~J Kͦ=lem[6AR`!ͩE/<-ntyz#݈3Bo(VW!+b|ιe=kH-h*a@7U L{y^3>lQ@@=s12(Wp tĘJF?v1IiF#̰[£ x_|#1IJr& j|Dov Ait ;%,zg~xݱd1%$r~MCGcnYexO'?cr $RaNtkm 0sg Uh^ $B ikK4cnTnw0vGM[PQĩ×0Z)RG3(- jqB{(Պ OMO +[= *7}OEP1rcZHqMmGޫsph!ӽHXWxw6k0̥t4ow-DmgBy.빳GC0voPΏ{ MZ[x&IyJ=9ji@SCe-w㔆 |}~| F\ALéj{ϟx>Xy =DUe!Dcw3S\ubmKu|ήCmq!QW;\խ{(WxLN'0@q3JX^p-BbR+rcGUhI~1+/<yUŨ9d\hV+0jDf0a%tQq $/kFrLβ̗^Zޭ@ o:&~e&ľ?BstN%S섈f F`va7*aW>h'#)}1cL&+%Ѻ= 9b4#| YLTf =z p}F9'`*Pڡheؑg?E!v%wӚT^\Cb̉h1ys̾k _!AndV6RrJ0HO0f^z)CduOk"ނi5)cR!?'k_&a\m*HM< ţ$Lq)rg&za J F9|s&%k?//otIIm yL3|N6Dc|v9Y1~5yϴ`&1xu'u p'uo*o>&)`Tz HbR7jWG Hz%EȸlaSܞ~O@v ">JGJ]zN!$|2o#>ljv9 K,,ïGi3>'t.\~s9voO,Y[1g=T :d &k іhJ-ۍqϦ'\i> 64 P%)ݢ9HJ[4>05Hz؎Q扢CJCW`*?t<}QeGfMHW @0}uLa mE4;WkV.F_)흝W l )$sh1IeL֌}?c1:OEi.йv6'7TFfMQ٭hoS_kGz$lϲp6q2&L4VGz7e/}ABN[p ӷQCSݳ;w @ݺbYj[gG\~*:TjDwk1d HYR,̥@I'w .A8BО]qH~hi_2- DHW?Z@h/,s̕}J'0@X Ѯ\&LJ9iΞ՗Tbr4>[c&)ev2B%50T:Х2 :6OkĽ50/v:R"f=>dvolGlzڒ\P/' HK}暘&}nكuKYj.;9n>RbI}7{N?UC |EOdn%)va'ƹ{zu`st_'[v%Z(egMñ~s ibRfRh{ds07O!sŹ<$wxM0yvE|JP-u!pU~O6][<ˁt޿*#z-sqAF`xK-AoZoP ׶EouU5$z=/ ]i>\wv)[y#l $G86hHwߦOU&dL qa|ϥ`7%/a2A?m9Dˮ"m e) 3,e~u -7z,=1-UUAH2oCTefZP#G ;G‹vr=7H$ i_ x,cfݭ}NG_"dQT *^^YQ{.}u,S<tT4!w( 7& 7#aUM/)0\ՍR <UGի2(6BP7OYdxkCtaap,jܥ^=kCBMshRQﴆIopP އ_e.2 w8S54vqK SE u+nK;f0\gWFjnӠ9[ֳ{2o3ҪkezdONLȣD>ju#M:y 0$ 1@=1Q@̲=Riߌ"rfN%hnp3q+ڭ.G [vxDN9V]OKވLE:9pԦ n]Sφଡ଼drY <[Nls,X}ٲas 370",:qvbv: NG:Ս/̧s!ax= ?r X }@NL*x ~%op*#o8@ߩ$u}u ķ3jwU6c/}ʏ!~rAO)ȟ=.8&'RCE{f0!aj\cfitdistrplus/data/smokedfish.rda0000644000176200001440000000033113742313702016542 0ustar liggesusers r0b```b`RL@& `bN *NMI,```d`@}(=4i%U׉TA (6'b ͇g柁Qt2h=4Ic3PDf>Z ŚZ d0@*' KNjZ LAQfzF .΢r=N^ '$Ì׊)%ziE@@?,Kfitdistrplus/data/groundbeef.rda0000644000176200001440000000065613742313702016540 0ustar liggesusers VJ@4஠0.JARkJMZ BcO˗5NeNq^,LOΝpx =Vڀnmmi"$Tơ7g'8xf\!;Ea?"H8 ]}]o$p]Enc/88g.纸^MyތCݼ7?KuE*=c>K~Oon9#})\>~:wL~BB+ف>cF=KS^Ɨ>Ua͜sK_+\D8W5w4r̃<|}ҾJuE~ܭߛOU{&q WIH vk,I?6g {u eYjveԋ5Mafitdistrplus/data/endosulfan.rda0000644000176200001440000000340114076546417016561 0ustar liggesusersWϏIXB3뱱y+l8L]]TW/PCr!oPr\ "$DAH_U,vd%hzz_UgN->t; {O]ygu: s,t`\jBNºuP,I>{&g0y}n ^vU?H }Z7xr> &/oRy" K:+g%91ϐ<~i)x~,nA@'?ٿI$j_+{}'y,?P߇I:꒜ɯc~'/'a_kWzz|'!~_&}_yzgOÿQO]LNW` ƽCf+fI :Muh!aB#bV(||[ c*AJ6Jdα Fk7m"AM?z&, 4FTit⑫ nC5N4s1u8_#d2T 1R-L%~ސӃYF\m$"e"XJOM:)&uUjKnjyb[8S."qkEo[q(gיm]"]챼IHOmTRw̔izmp(k*͑{Mr߅[bό3wEZ> oXPE8PI{dHt6, *&۪pEH;@OLQ5sڧm˞r m;XRQH4&[њLiΨӮ RjV68Q-r:J.+'.\g5#D_/&.Qe6MhCq:ĵ(*%WUɭDa)D9QVZv\on0:ze+d58W ն\o& & ֕Ֆ.lLyEUu "lp`#Fpo̽[nS~oD<fitdistrplus/data/fluazinam.rda0000644000176200001440000000033113742313702016374 0ustar liggesusers r0b```b`@& `bNN)MKe``+d`a40pp8gB0ì BO1:AB7@u?g,ac0pi''0@^{?HE0{| ۋ H-2dIM+)(L(AוX JI,IK+Ez0xAO@UUfitdistrplus/data/dataFAQscale1.rda0000644000176200001440000000133513742313702016745 0ustar liggesusers],Ι+&*#*I*{d9_lw_)?QkØFcaJ#jS'.?BD#0ɯ??z{ޏx #Ah3C[2jE0jBC8QثV!l, 헫ܓ&|:b, 3؞I*:;QyXD? x jAW%K6k@_h׷C~Z% :7JZP س.cH9lF6?>ᱹSE (䯶>!Bc%KҸB0 0} \code{\link{contour}} (2D-plot) is used to add \code{nlev} contours. By default the range of values explored for each estimated parameter is of 2 standard error around the mle estimate but this range can be expanded (or contracted) using the argument \code{expansion}. } \seealso{ See \code{\link{llsurface}} and \code{\link{llcurve}} for manual (log)likelihood plots (surface ou curve) and \code{\link{plot}}, \code{\link{contour}}, \code{\link{image}} for classic plotting functions. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) a distribution with one parameter # x <- rexp(50) fite <- fitdist(x, "exp") llplot(fite) llplot(fite, col = "red", fit.show = TRUE) llplot(fite, col = "red", fit.show = TRUE, loglik = FALSE) # (2) a distribution with two parameters # data(groundbeef) serving <- groundbeef$serving fitg <- fitdist(serving, "gamma") llplot(fitg) \dontrun{ llplot(fitg, expansion = 2) llplot(fitg, pal.col = heat.colors(100), fit.show = TRUE) llplot(fitg, back.col = FALSE, nlev = 25, fit.show = TRUE) } # (3) a distribution with two parameters with one fixed # fitg2 <- fitdist(serving, "gamma", fix.arg = list(rate = 0.5)) llplot(fitg2, fit.show = TRUE) # (4) a distribution with three parameters # \dontrun{ data(endosulfan) ATV <-endosulfan$ATV library("actuar") fBurr <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) llplot(fBurr) llplot(fBurr, back.col = FALSE, fit.show = TRUE, fit.pch = 16) llplot(fBurr, nlev = 0, pal.col = rainbow(100), lseq = 100) } # (5) a distribution with two parameters fitted on censored data # data(salinity) fsal <- fitdistcens(salinity, "lnorm") llplot(fsal, fit.show = TRUE) llplot(fsal, fit.show = TRUE, loglik = FALSE) } \keyword{ distribution } fitdistrplus/man/groundbeef.Rd0000644000176200001440000000216313742313702016174 0ustar liggesusers\name{groundbeef} \alias{groundbeef} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Ground beef serving size data set } \description{ Serving sizes collected in a French survey, for ground beef patties consumed by children under 5 years old. } \usage{ data(groundbeef) } %- maybe also 'usage' for other objects documented here. \format{ \code{groundbeef} is a data frame with 1 column (serving: serving sizes in grams) } \source{ Delignette-Muller, M.L., Cornu, M. 2008. Quantitative risk assessment for \emph{Escherichia coli} O157:H7 in frozen ground beef patties consumed by young children in French households. \emph{International Journal of Food Microbiology}, \bold{128}, 158-164. } %\references{ } \examples{ # (1) load of data # data(groundbeef) # (2) description and plot of data # serving <- groundbeef$serving descdist(serving) plotdist(serving) # (3) fit of a Weibull distribution to data # fitW <- fitdist(serving,"weibull") summary(fitW) plot(fitW) gofstat(fitW) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/CIcdfplot.Rd0000644000176200001440000002465014102173423015723 0ustar liggesusers\name{CIcdfplot} \alias{CIcdfplot} \title{Empirical cumulative distribution function with pointwise confidence intervals on probabilities or on quantiles} \description{ \code{cdfband} plots the empirical cumulative distribution function with the bootstraped pointwise confidence intervals on probabilities of on quantiles. } \usage{ CIcdfplot(b, CI.output, CI.type = "two.sided", CI.level = 0.95, CI.col = "red", CI.lty = 2, CI.fill = NULL, CI.only = FALSE, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datapch, datacol, fitlty, fitcol, fitlwd, horizontals = TRUE, verticals = FALSE, do.points = TRUE, use.ppoints = TRUE, a.ppoints = 0.5, name.points = NULL, lines01 = FALSE, plotstyle = "graphics", \dots) } \arguments{ \item{b}{One \code{"bootdist"} object.} \item{CI.output}{ The quantity on which (bootstraped) bootstraped confidence intervals are computed: either \code{"probability"} or \code{"quantile"}).} \item{CI.type}{ Type of confidence intervals : either \code{"two.sided"} or one-sided intervals (\code{"less"} or \code{"greater"}).} \item{CI.level}{ The confidence level.} \item{CI.col}{the color of the confidence intervals.} \item{CI.lty}{the line type of the confidence intervals.} \item{CI.fill}{a color to fill the confidence area. Default is \code{NULL} corresponding to no filling.} \item{CI.only}{A logical whether to plot empirical and fitted distribution functions or only the confidence intervals. Default to \code{FALSE}.} \item{xlim}{The \eqn{x}-limits of the plot.} \item{ylim}{The \eqn{y}-limits of the plot.} \item{xlogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{x}-axis.} \item{ylogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{y}-axis.} \item{main}{A main title for the plot, see also \code{\link{title}}.} \item{xlab}{A label for the \eqn{x}-axis, defaults to a description of \code{x}.} \item{ylab}{A label for the \eqn{y}-axis, defaults to a description of \code{y}.} \item{datapch}{An integer specifying a symbol to be used in plotting data points, see also \code{\link{points}} (only for non censored data).} \item{datacol}{A specification of the color to be used in plotting data points.} \item{fitcol}{A (vector of) color(s) to plot fitted distributions. If there are fewer colors than fits they are recycled in the standard fashion.} \item{fitlty}{A (vector of) line type(s) to plot fitted distributions/densities. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fitlwd}{A (vector of) line size(s) to plot fitted distributions/densities. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{horizontals}{If \code{TRUE}, draws horizontal lines for the step empirical cdf function (only for non censored data). See also \code{\link{plot.stepfun}}.} \item{verticals}{If \code{TRUE}, draws also vertical lines for the empirical cdf function. Only taken into account if \code{horizontals=TRUE} (only for non censored data).} \item{do.points}{logical; if \code{TRUE}, also draw points at the x-locations. Default is TRUE (only for non censored data).} \item{use.ppoints}{If \code{TRUE}, probability points of the empirical distribution are defined using function \code{\link{ppoints}} as \code{(1:n - a.ppoints)/(n - 2a.ppoints + 1)} (only for non censored data). If \code{FALSE}, probability points are simply defined as \code{(1:n)/n}. This argument is ignored for discrete data.} \item{a.ppoints}{If \code{use.ppoints=TRUE}, this is passed to function \code{\link{ppoints}} (only for non censored data).} \item{name.points}{Label vector for points if they are drawn i.e. if do.points = TRUE (only for non censored data).} \item{lines01}{A logical to plot two horizontal lines at \code{h=0} and \code{h=1} for \code{cdfcomp}.} \item{plotstyle}{\code{"graphics"} or \code{"ggplot"}. If \code{"graphics"}, the display is built with \code{\link{graphics}} functions. If \code{"ggplot"}, a graphic object output is created with \code{ggplot2} functions (the \code{ggplot2} package must be installed).} \item{\dots}{Further graphical arguments passed to \code{matlines} or \code{polygon}, respectively when \code{CI.fill=FALSE} and \code{CI.fill=TRUE}.} } \details{ \code{CIcdfplot} provides a plot of the empirical distribution using \code{\link{cdfcomp}} or \code{\link{cdfcompcens}}, with bootstraped pointwise confidence intervals on probabilities (y values) or on quantiles (x values). Each interval is computed by evaluating the quantity of interest (probability associated to an x value or quantile associated to an y value) using all the bootstraped values of parameters to get a bootstraped sample of the quantity of interest and then by calculating percentiles on this sample to get a confidence interval (classically 2.5 and 97.5 percentiles for a 95 percent confidence level). If \code{CI.fill != NULL}, then the whole confidence area is filled by the color \code{CI.fill} thanks to the function \code{polygon}, otherwise only borders are drawn thanks to the function \code{matline}. Further graphical arguments can be passed to these functions using the three dots arguments \code{\dots}. } \seealso{ See also \code{\link{cdfcomp}}, \code{\link{cdfcompcens}}, \code{\link{bootdist}} and \code{\link{quantile}}. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang and Marie-Laure Delignette-Muller. } \examples{ # We choose a low number of bootstrap replicates in order to satisfy CRAN running times # constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. if (requireNamespace ("ggplot2", quietly = TRUE)) {ggplotEx <- TRUE} # (1) Fit of an exponential distribution # set.seed(123) s1 <- rexp(50, 1) f1 <- fitdist(s1, "exp") b1 <- bootdist(f1, niter= 11) #voluntarily low to decrease computation time # plot 95 percent bilateral confidence intervals on y values (probabilities) CIcdfplot(b1, CI.level= 95/100, CI.output = "probability") if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", plotstyle = "ggplot") # plot of the previous intervals as a band CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.fill = "pink", CI.col = "red") if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.fill = "pink", CI.col = "red", plotstyle = "ggplot") # plot of the previous intervals as a band without empirical and fitted dist. functions CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.only = TRUE, CI.fill = "pink", CI.col = "red") if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.only = TRUE, CI.fill = "pink", CI.col = "red", plotstyle = "ggplot") # same plot without contours CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.only = TRUE, CI.fill = "pink", CI.col = "pink") if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "probability", CI.only = TRUE, CI.fill = "pink", CI.col = "pink", plotstyle = "ggplot") # plot 95 percent bilateral confidence intervals on x values (quantiles) CIcdfplot(b1, CI.level= 95/100, CI.output = "quantile") if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "quantile", plotstyle = "ggplot") # plot 95 percent unilateral confidence intervals on quantiles CIcdfplot(b1, CI.level = 95/100, CI.output = "quant", CI.type = "less", CI.fill = "grey80", CI.col = "black", CI.lty = 1) if (ggplotEx) CIcdfplot(b1, CI.level = 95/100, CI.output = "quant", CI.type = "less", CI.fill = "grey80", CI.col = "black", CI.lty = 1, plotstyle = "ggplot") CIcdfplot(b1, CI.level= 95/100, CI.output = "quant", CI.type = "greater", CI.fill = "grey80", CI.col = "black", CI.lty = 1) if (ggplotEx) CIcdfplot(b1, CI.level= 95/100, CI.output = "quant", CI.type = "greater", CI.fill = "grey80", CI.col = "black", CI.lty = 1, plotstyle = "ggplot") # (2) Fit of a normal distribution on acute toxicity log-transformed values of # endosulfan for nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5, 10 and 20 percent quantile # values of the fitted distribution, which are called the 5, 10, 20 percent hazardous # concentrations (HC5, HC10, HC20) in ecotoxicology, with their # confidence intervals, from a small number of bootstrap # iterations to satisfy CRAN running times constraint and plot of the band # representing pointwise confidence intervals on any quantiles (any HCx values) # For practical applications, we recommend to use at least niter=501 or niter=1001. # data(endosulfan) log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) namesATV <- subset(endosulfan, group == "NonArthroInvert")$taxa fln <- fitdist(log10ATV, "norm") bln <- bootdist(fln, bootmethod ="param", niter=101) quantile(bln, probs = c(0.05, 0.1, 0.2)) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlim = c(0,5), name.points=namesATV) if (ggplotEx) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlim = c(0,5), name.points=namesATV, plotstyle = "ggplot") # (3) Same type of example as example (2) from ecotoxicology # with censored data # data(salinity) log10LC50 <-log10(salinity) fln <- fitdistcens(log10LC50,"norm") bln <- bootdistcens(fln, niter=101) (HC5ln <- quantile(bln,probs = 0.05)) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)",xlim=c(0.5,2),lines01 = TRUE) if (ggplotEx) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)",xlim=c(0.5,2),lines01 = TRUE, plotstyle = "ggplot") # zoom around the HC5 CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1)) abline(h = 0.05, lty = 2) # line corresponding to a CDF of 5 percent if (ggplotEx) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1), plotstyle = "ggplot") + ggplot2::geom_hline(yintercept = 0.05, lty = 2) # line corresponding to a CDF of 5 percent } \keyword{ distribution } fitdistrplus/man/smokedfish.Rd0000644000176200001440000000331213742313702016205 0ustar liggesusers\name{smokedfish} \alias{smokedfish} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Contamination data of Listeria monocytogenes in smoked fish } \description{ Contamination data of \emph{Listeria monocytogenes} in smoked fish on the Belgian market in the period 2005 to 2007. } \usage{ data(smokedfish) } %- maybe also 'usage' for other objects documented here. \format{ \code{smokedfish} is a data frame with 2 columns named left and right, describing each observed value of \emph{Listeria monocytogenes} concentration (in CFU/g) as an interval. The left column contains either NA for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either NA for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. } \source{ Busschaert, P., Geereard, A.H., Uyttendaele, M., Van Impe, J.F., 2010. Estimating distributions out of qualitative and (semi) quantitative microbiological contamination data for use in risk assessment. \emph{International Journal of Food Microbiology}. \bold{138}, 260-269. } %\references{ } \examples{ # (1) load of data # data(smokedfish) # (2) plot of data in CFU/g # plotdistcens(smokedfish) # (3) plot of transformed data in log10[CFU/g] # Clog10 <- log10(smokedfish) plotdistcens(Clog10) # (4) Fit of a normal distribution to data in log10[CFU/g] # fitlog10 <- fitdistcens(Clog10,"norm") summary(fitlog10) plot(fitlog10) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/salinity.Rd0000644000176200001440000000533313742313702015712 0ustar liggesusers\name{salinity} \alias{salinity} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Species-Sensitivity Distribution (SSD) for salinity tolerance } \description{ 72-hour acute salinity tolerance (LC50 values) of riverine macro-invertebrates. } \usage{ data(salinity) } %- maybe also 'usage' for other objects documented here. \format{ \code{salinity} is a data frame with 2 columns named left and right, describing each observed LC50 value (in electrical condutivity, millisiemens per centimeter) as an interval. The left column contains either NA for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either NA for right censored observations, the right bound of the interval for interval censored observations, or the observed value for noncensored observations. } \source{ Kefford, B.J., Nugegoda, D., Metzeling, L., Fields, E. 2006. Validating species sensitivity distributions using salinity tolerance of riverine macroinvertebrates in the southern Murray-darling Basin (Vitoria, Australia). \emph{Canadian Journal of Fisheries and Aquatic Science}, \bold{63}, 1865-1877. } %\references{ } \examples{ # (1) load of data # data(salinity) # (2) plot of data using Turnbull cdf plot # log10LC50 <-log10(salinity) plotdistcens(log10LC50) # (3) fit of a normal and a logistic distribution to data in log10 # (classical distributions used for species sensitivity # distributions, SSD, in ecotoxicology)) # and visual comparison of the fits using Turnbull cdf plot # fln <- fitdistcens(log10LC50,"norm") summary(fln) fll <- fitdistcens(log10LC50,"logis") summary(fll) cdfcompcens(list(fln,fll),legendtext=c("normal","logistic"), xlab = "log10(LC50)",xlim=c(0.5,2),lines01 = TRUE) # (4) estimation of the 5 percent quantile value of # the normal fitted distribution (5 percent hazardous concentration : HC5) # with its two-sided 95 percent confidence interval calculated by # non parametric bootstrap # from a small number of bootstrap iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # # in log10(LC50) bln <- bootdistcens(fln, niter=101) HC5ln <- quantile(bln,probs = 0.05) # in LC50 10^(HC5ln$quantiles) 10^(HC5ln$quantCI) # (5) estimation of the HC5 value # with its one-sided 95 percent confidence interval (type "greater") # # in log10(LC50) HC5lnb <- quantile(bln, probs = 0.05,CI.type="greater") # in LC50 10^(HC5lnb$quantiles) 10^(HC5lnb$quantCI) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/plotdistcens.Rd0000644000176200001440000001777413742313702016605 0ustar liggesusers\name{plotdistcens} \alias{plotdistcens} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot of empirical and theoretical distributions for censored data} \description{ Plots an empirical distribution for censored data with a theoretical one if specified. } \usage{ plotdistcens(censdata, distr, para, leftNA = -Inf, rightNA = Inf, NPMLE = TRUE, Turnbull.confint = FALSE, NPMLE.method = "Wang", \dots) } \arguments{ \item{censdata}{ A dataframe of two columns respectively named \code{left} and \code{right}, describing each observed value as an interval. The \code{left} column contains either \code{NA} for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The \code{right} column contains either \code{NA} for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. } \item{distr}{ A character string \code{"name"} naming a distribution, for which the corresponding density function \code{dname} and the corresponding distribution function \code{pname} must be defined, or directly the density function.} \item{para}{ A named list giving the parameters of the named distribution. This argument may be omitted only if \code{distr} is omitted. } \item{leftNA}{ the real value of the left bound of left censored observations : \code{-Inf} or a finite value such as \code{0} for positive data for example.} \item{rightNA}{ the real value of the right bound of right censored observations : \code{Inf} or a finite value such as a realistic maximum value.} \item{NPMLE}{ if TRUE an NPMLE (nonparametric maximum likelihood estimate) technique is used to estimate the cdf curve of the censored data and previous arguments \code{leftNA} and \code{rightNA} are not used (see details)} \item{Turnbull.confint}{ if TRUE confidence intervals will be added to the Turnbull plot. In that case NPMLE.method is forced to \code{"Turnbull.middlepoints"}} \item{NPMLE.method}{Three NPMLE techniques are provided, \code{"Wang"}, the default one, rewritten from the package npsurv using function constrOptim from the package stats for optimisation, \code{"Turnbull.middlepoints"}, an older one which is implemented in the package survival and \code{"Turnbull.intervals"} that uses the same Turnbull algorithm from the package survival but associates an interval to each equivalence class instead of the middlepoint of this interval (see details). Only \code{"Wang"} and \code{"Turnbull.intervals"} enable the derivation of a Q-Q plot and a P-P plot.} \item{\dots}{ further graphical arguments passed to other methods. The title of the plot can be modified using the argument \code{main} only for the CDF plot.} } \details{ If \code{NPMLE} is \code{TRUE}, and \code{NPMLE.method} is \code{"Wang"} , empirical distributions are plotted in cdf using either the constrained Newton method (Wang, 2008) or the hierarchical constrained Newton method (Wang, 2013) to compute the overall empirical cdf curve. If \code{NPMLE} is \code{TRUE}, and \code{NPMLE.method} is \code{"Turnbull.intervals"} , empirical are plotted in cdf using the EM approach of Turnbull (Turnbull, 1974). In those two cases, grey rectangles represent areas where the empirical distribution function is not unique. In cases where a theoretical distribution is specified, two goodness-of-fit plots are also provided, a Q-Q plot (plot of the quantiles of the theoretical fitted distribution (x-axis) against the empirical quantiles of the data) and a P-P plot (i.e. for each value of the data set, plot of the cumulative density function of the fitted distribution (x-axis) against the empirical cumulative density function (y-axis)). Grey rectangles in a Q-Q plot or a P-P plot also represent areas of non uniqueness of empirical quantiles or probabilities, directly derived from non uniqueness areas of the empirical cumulative distribution. If \code{NPMLE} is \code{TRUE}, and \code{NPMLE.method} is \code{"Turnbull.middlepoints"}, empirical and, if specified, theoretical distributions are plotted in cdf using the EM approach of Turnbull (Turnbull, 1974) to compute the overall empirical cdf curve, with confidence intervals if \code{Turnbull.confint} is \code{TRUE}, by calls to functions \code{\link{survfit}} and \code{\link{plot.survfit}} from the \code{survival} package. If \code{NPMLE} is \code{FALSE} empirical and, if specified, theoretical distributions are plotted in cdf, with data directly reported as segments for interval, left and right censored data, and as points for non-censored data. Before plotting, observations are ordered and a rank r is associated to each of them. Left censored observations are ordered first, by their right bounds. Interval censored and non censored observations are then ordered by their mid-points and, at last, right censored observations are ordered by their left bounds. If \code{leftNA} (resp. \code{rightNA}) is finite, left censored (resp. right censored) observations are considered as interval censored observations and ordered by mid-points with non-censored and interval censored data. It is sometimes necessary to fix \code{rightNA} or \code{leftNA} to a realistic extreme value, even if not exactly known, to obtain a reasonable global ranking of observations. After ranking, each of the n observations is plotted as a point (one x-value) or a segment (an interval of possible x-values), with an y-value equal to r/n, r being the rank of each observation in the global ordering previously described. This second method may be interesting but is certainly less rigorous than the other methods that should be prefered. } \seealso{ \code{\link{plotdist}}, \code{\link{survfit.formula}}. } \references{ Turnbull BW (1974), \emph{Nonparametric estimation of a survivorship function with doubly censored data}. Journal of American Statistical Association, 69, 169-173. Wang Y (2008), \emph{Dimension-reduced nonparametric maximum likelihood computation for interval-censored data}. Computational Statistics & Data Analysis, 52, 2388-2402. Wang Y and Taylor SM (2013), \emph{Efficient computation of nonparametric survival functions via a hierarchical mixture formulation}. Statistics and Computing, 23, 713-725. Wang, Y., & Fani, S. (2018), \emph{Nonparametric maximum likelihood computation of a U-shaped hazard function}. Statistics and Computing, 28(1), 187-200. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } %\note{ } \examples{ # (1) Plot of an empirical censored distribution (censored data) as a CDF # using the default Wang method # data(smokedfish) d1 <- as.data.frame(log10(smokedfish)) plotdistcens(d1) # (2) Add the CDF of a normal distribution # plotdistcens(d1, "norm", para=list(mean = -1.6, sd = 1.5)) # (3) Various plots of the same empirical distribution # # default Wang plot with representation of equivalence classess plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Wang") # same plot but using the Turnbull alorithm from the package survival plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Wang") # Turnbull plot with middlepoints (as in the package survival) plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Turnbull.middlepoints") # Turnbull plot with middlepoints and confidence intervals plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Turnbull.middlepoints", Turnbull.confint = TRUE) # with intervals and points plotdistcens(d1,rightNA=3, NPMLE = FALSE) # with intervals and points # defining a minimum value for left censored values plotdistcens(d1,leftNA=-3, NPMLE = FALSE) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/gofstat.Rd0000644000176200001440000001776213742313702015536 0ustar liggesusers\name{gofstat} \alias{gofstat} \alias{print.gofstat.fitdist} \title{ Goodness-of-fit statistics} \description{ Computes goodness-of-fit statistics for parametric distributions fitted to a same non-censored data set. } \usage{ gofstat(f, chisqbreaks, meancount, discrete, fitnames=NULL) \method{print}{gofstat.fitdist}(x, \dots) } \arguments{ \item{f}{ An object of class \code{"fitdist"}, output of the function \code{fitdist}, or a list of \code{"fitdist"} objects.} \item{chisqbreaks}{ A numeric vector defining the breaks of the cells used to compute the chi-squared statistic. If omitted, these breaks are automatically computed from the data in order to reach roughly the same number of observations per cell, roughly equal to the argument \code{meancount}, or sligthly more if there are some ties. } \item{meancount}{ The mean number of observations per cell expected for the definition of the breaks of the cells used to compute the chi-squared statistic. This argument will not be taken into account if the breaks are directly defined in the argument \code{chisqbreaks}. If \code{chisqbreaks} and \code{meancount} are both omitted, \code{meancount} is fixed in order to obtain roughly \eqn{(4n)^{2/5}} cells with \eqn{n} the length of the dataset. } \item{discrete}{If \code{TRUE}, only the Chi-squared statistic and information criteria are computed. If missing, \code{discrete} is passed from the first object of class \code{"fitdist"} of the list \code{f}.} \item{fitnames}{A vector defining the names of the fits.} \item{x}{An object of class \code{"fitdist"}. } \item{\dots}{Further arguments to be passed to generic functions.} } \details{ Goodness-of-fit statistics are computed. The Chi-squared statistic is computed using cells defined by the argument \code{chisqbreaks} or cells automatically defined from data, in order to reach roughly the same number of observations per cell, roughly equal to the argument \code{meancount}, or sligthly more if there are some ties. The choice to define cells from the empirical distribution (data), and not from the theoretical distribution, was done to enable the comparison of Chi-squared values obtained with different distributions fitted on a same data set. If \code{chisqbreaks} and \code{meancount} are both omitted, \code{meancount} is fixed in order to obtain roughly \eqn{(4n)^{2/5}} cells, with \eqn{n} the length of the data set (Vose, 2000). The Chi-squared statistic is not computed if the program fails to define enough cells due to a too small dataset. When the Chi-squared statistic is computed, and if the degree of freedom (nb of cells - nb of parameters - 1) of the corresponding distribution is strictly positive, the p-value of the Chi-squared test is returned. For continuous distributions, Kolmogorov-Smirnov, Cramer-von Mises and Anderson-Darling and statistics are also computed, as defined by Stephens (1986). An approximate Kolmogorov-Smirnov test is performed by assuming the distribution parameters known. The critical value defined by Stephens (1986) for a completely specified distribution is used to reject or not the distribution at the significance level 0.05. Because of this approximation, the result of the test (decision of rejection of the distribution or not) is returned only for data sets with more than 30 observations. Note that this approximate test may be too conservative. For data sets with more than 5 observations and for distributions for which the test is described by Stephens (1986) for maximum likelihood estimations (\code{"exp"}, \code{"cauchy"}, \code{"gamma"} and \code{"weibull"}), the Cramer-von Mises and Anderson-darling tests are performed as described by Stephens (1986). Those tests take into account the fact that the parameters are not known but estimated from the data by maximum likelihood. The result is the decision to reject or not the distribution at the significance level 0.05. Those tests are available only for maximum likelihood estimations. Only recommended statistics are automatically printed, i.e. Cramer-von Mises, Anderson-Darling and Kolmogorov statistics for continuous distributions and Chi-squared statistics for discrete ones ( \code{"binom"}, \code{"nbinom"}, \code{"geom"}, \code{"hyper"} and \code{"pois"} ). Results of the tests are not printed but stored in the output of the function. } \value{ \code{gof.stat} returns an object of class \code{"gofstat.fitdist"} with following components, \item{ chisq }{ a named vector with the Chi-squared statistics or \code{NULL} if not computed} \item{ chisqbreaks }{ common breaks used to define cells in the Chi-squared statistic } \item{ chisqpvalue }{ a named vector with the p-values of the Chi-squared statistic or \code{NULL} if not computed} \item{ chisqdf }{ a named vector with the degrees of freedom of the Chi-squared distribution or \code{NULL} if not computed } \item{ chisqtable }{ a table with observed and theoretical counts used for the Chi-squared calculations } \item{ cvm }{ a named vector of the Cramer-von Mises statistics or \code{"not computed"} if not computed } \item{ cvmtest }{ a named vector of the decisions of the Cramer-von Mises test or \code{"not computed"} if not computed } \item{ ad }{ a named vector with the Anderson-Darling statistics or \code{"not computed"} if not computed } \item{ adtest }{ a named vector with the decisions of the Anderson-Darling test or \code{"not computed"} if not computed } \item{ ks }{ a named vector with the Kolmogorov-Smirnov statistic or \code{"not computed"} if not computed } \item{ kstest }{ a named vector with the decisions of the Kolmogorov-Smirnov test or \code{"not computed"} if not computed } \item{aic}{a named vector with the values of the Akaike's Information Criterion.} \item{bic}{a named vector with the values of the Bayesian Information Criterion.} \item{discrete}{the input argument or the automatic definition by the function from the first object of class \code{"fitdist"} of the list in input.} \item{nbfit}{Number of fits in argument.} } \seealso{ \code{\link{fitdist}}. } \references{ Cullen AC and Frey HC (1999), \emph{Probabilistic techniques in exposure assessment}. Plenum Press, USA, pp. 81-155. Stephens MA (1986), \emph{Tests based on edf statistics}. In Goodness-of-fit techniques (D'Agostino RB and Stephens MA, eds), Marcel Dekker, New York, pp. 97-194. Venables WN and Ripley BD (2002), \emph{Modern applied statistics with S}. Springer, New York, pp. 435-446. Vose D (2000), \emph{Risk analysis, a quantitative guide}. John Wiley & Sons Ltd, Chischester, England, pp. 99-143. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) fit of two distributions to the serving size data # by maximum likelihood estimation # and comparison of goodness-of-fit statistics # data(groundbeef) serving <- groundbeef$serving (fitg <- fitdist(serving, "gamma")) gofstat(fitg) (fitln <- fitdist(serving, "lnorm")) gofstat(fitln) gofstat(list(fitg, fitln)) # (2) fit of two discrete distributions to toxocara data # and comparison of goodness-of-fit statistics # data(toxocara) number <- toxocara$number fitp <- fitdist(number,"pois") summary(fitp) plot(fitp) fitnb <- fitdist(number,"nbinom") summary(fitnb) plot(fitnb) gofstat(list(fitp, fitnb),fitnames = c("Poisson","negbin")) # (3) Use of Chi-squared results in addition to # recommended statistics for continuous distributions # set.seed(1234) x4 <- rweibull(n=1000,shape=2,scale=1) # fit of the good distribution f4 <- fitdist(x4,"weibull") # fit of a bad distribution f4b <- fitdist(x4,"cauchy") gofstat(list(f4,f4b),fitnames=c("Weibull", "Cauchy")) } \keyword{ distribution } fitdistrplus/man/detectbound.Rd0000644000176200001440000000276713742313702016366 0ustar liggesusers\name{detectbound} \alias{detectbound} \title{ Detect bounds for density function} \description{ Manual detection of bounds of parameter of a density function/ } \usage{ detectbound(distname, vstart, obs, fix.arg=NULL, echo=FALSE) } \arguments{ \item{distname}{ A character string \code{"name"} naming a distribution for which the corresponding density function \code{dname} must be classically defined. } \item{vstart}{A named vector giving the initial values of parameters of the named distribution. } \item{obs}{ A numeric vector for non censored data. } \item{fix.arg}{An optional named vector giving the values of fixed parameters of the named distribution. Default to \code{NULL}.} \item{echo}{A logical to show some traces.} } \details{ This function manually tests the following bounds : -1, 0, and 1. } \value{ \code{detectbound} returns a 2-row matrix with the lower bounds in the first row and the upper bounds in the second row. } \seealso{ \code{\link{fitdist}}. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang and Marie-Laure Delignette-Muller. } \examples{ #case where the density returns a Not-an-Numeric value. detectbound("exp", c(rate=3), 1:10) detectbound("binom", c(size=3, prob=1/2), 1:10) detectbound("nbinom", c(size=3, prob=1/2), 1:10) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/bootdistcens.Rd0000644000176200001440000001552513742313702016562 0ustar liggesusers\name{bootdistcens} \alias{bootdistcens} \alias{plot.bootdistcens} \alias{print.bootdistcens} \alias{summary.bootdistcens} \title{ Bootstrap simulation of uncertainty for censored data} \description{ Uses nonparametric bootstrap resampling in order to simulate uncertainty in the parameters of the distribution fitted to censored data. } \usage{ bootdistcens(f, niter = 1001, silent = TRUE, parallel = c("no", "snow", "multicore"), ncpus) \method{print}{bootdistcens}(x, \dots) \method{plot}{bootdistcens}(x, \dots) \method{summary}{bootdistcens}(object, \dots) } \arguments{ \item{f}{ An object of class \code{"fitdistcens"}, output of the \code{\link{fitdistcens}} function.} \item{niter}{ The number of samples drawn by bootstrap.} \item{silent}{A logical to remove or show warnings and errors when bootstraping.} \item{parallel}{The type of parallel operation to be used, \code{"snow"} or \code{"multicore"} (the second one not being available on Windows), or \code{"no"} if no parallel operation.} \item{ncpus}{Number of processes to be used in parallel operation : typically one would fix it to the number of available CPUs.} \item{x}{ An object of class \code{"bootdistcens"}.} \item{object}{ An object of class \code{"bootdistcens"}.} \item{\dots}{ Further arguments to be passed to generic methods.} } \details{ Samples are drawn by nonparametric bootstrap (resampling with replacement from the data set). On each bootstrap sample the function \code{\link{mledist}} is used to estimate bootstrapped values of parameters. When \code{\link{mledist}} fails to converge, \code{NA} values are returned. Medians and 2.5 and 97.5 percentiles are computed by removing \code{NA} values. The medians and the 95 percent confidence intervals of parameters (2.5 and 97.5 percentiles) are printed in the summary. If inferior to the whole number of iterations, the number of iterations for which \code{\link{mledist}} converges is also printed in the summary. The plot of an object of class \code{"bootdistcens"} consists in a scatterplot or a matrix of scatterplots of the bootstrapped values of parameters. It uses the function \code{\link{stripchart}} when the fitted distribution is characterized by only one parameter, and the function \code{\link{plot}} in other cases. In these last cases, it provides a representation of the joint uncertainty distribution of the fitted parameters. It is possible to accelerate the bootstrap using parallelization. We recommend you to use \code{parallel = "multicore"}, or \code{parallel = "snow"} if you work on Windows, and to fix \code{ncpus} to the number of available processors. } \value{ \code{bootdistcens} returns an object of class \code{"bootdistcens"}, a list with 6 components, \item{estim}{ a data frame containing the bootstrapped values of parameters.} \item{converg}{ a vector containing the codes for convergence of the iterative method used to estimate parameters on each bootstraped data set.} \item{method}{ A character string coding for the type of resampling : in this case \code{"nonparam"} as it is the only available method for censored data. } \item{nbboot}{ The number of samples drawn by bootstrap.} \item{CI}{ bootstrap medians and 95 percent confidence percentile intervals of parameters. } \item{fitpart}{ The object of class \code{"fitdistcens"} on which the bootstrap procedure was applied.} Generic functions: \describe{ \item{\code{print}}{ The print of a \code{"bootdistcens"} object shows the bootstrap parameter estimates. If inferior to the whole number of bootstrap iterations, the number of iterations for which the estimation converges is also printed. } \item{\code{summary}}{ The summary provides the median and 2.5 and 97.5 percentiles of each parameter. If inferior to the whole number of bootstrap iterations, the number of iterations for which the estimation converges is also printed in the summary. } \item{\code{plot}}{ The plot shows the bootstrap estimates with the \code{\link{stripchart}} function for univariate parameters and \code{\link{plot}} function for multivariate parameters. } } } \seealso{ See \code{\link{fitdistrplus}} for an overview of the package. \code{\link{fitdistcens}}, \code{\link{mledist}}, \code{\link{quantile.bootdistcens}} for another generic function to calculate quantiles from the fitted distribution and its bootstrap results and \code{\link{CIcdfplot}} for adding confidence intervals on quantiles to a CDF plot of the fitted distribution. } \references{ Cullen AC and Frey HC (1999), \emph{Probabilistic techniques in exposure assessment}. Plenum Press, USA, pp. 181-241. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } %\note{ } \examples{ # We choose a low number of bootstrap replicates in order to satisfy CRAN running times # constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # (1) Fit of a normal distribution to fluazinam data in log10 # followed by nonparametric bootstrap and calculation of quantiles # with 95 percent confidence intervals # data(fluazinam) (d1 <-log10(fluazinam)) f1 <- fitdistcens(d1, "norm") b1 <- bootdistcens(f1, niter = 101) b1 summary(b1) plot(b1) quantile(b1) CIcdfplot(b1, CI.output = "quantile") # (2) Estimation of the mean of the normal distribution # by maximum likelihood with the standard deviation fixed at 1 # using the argument fix.arg # followed by nonparametric bootstrap # and calculation of quantiles with 95 percent confidence intervals # f1b <- fitdistcens(d1, "norm", start = list(mean = 1),fix.arg = list(sd = 1)) b1b <- bootdistcens(f1b, niter = 101) summary(b1b) plot(b1b) quantile(b1b) # (3) comparison of sequential and parallel versions of bootstrap # to be tried with a greater number of iterations (1001 or more) # \dontrun{ niter <- 1001 data(fluazinam) d1 <-log10(fluazinam) f1 <- fitdistcens(d1, "norm") # sequential version ptm <- proc.time() summary(bootdistcens(f1, niter = niter)) proc.time() - ptm # parallel version using snow require(parallel) ptm <- proc.time() summary(bootdistcens(f1, niter = niter, parallel = "snow", ncpus = 4)) proc.time() - ptm # parallel version using multicore (not available on Windows) ptm <- proc.time() summary(bootdistcens(f1, niter = niter, parallel = "multicore", ncpus = 4)) proc.time() - ptm } } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/graphcomp.Rd0000644000176200001440000003520014102210303016012 0ustar liggesusers\name{graphcomp} \alias{graphcomp} \alias{cdfcomp} \alias{denscomp} \alias{qqcomp} \alias{ppcomp} \title{Graphical comparison of multiple fitted distributions (for non-censored data)} \description{ \code{cdfcomp} plots the empirical cumulative distribution against fitted distribution functions, \code{denscomp} plots the histogram against fitted density functions, \code{qqcomp} plots theoretical quantiles against empirical ones, \code{ppcomp} plots theoretical probabilities against empirical ones. Only \code{cdfcomp} is able to plot fits of a discrete distribution. } \usage{ cdfcomp(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datapch, datacol, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, horizontals = TRUE, verticals = FALSE, do.points = TRUE, use.ppoints = TRUE, a.ppoints = 0.5, name.points = NULL, lines01 = FALSE, discrete, add = FALSE, plotstyle = "graphics", fitnbpts = 101, \dots) denscomp(ft, xlim, ylim, probability = TRUE, main, xlab, ylab, datacol, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "topright", ylegend = NULL, demp = FALSE, dempcol = "black", plotstyle = "graphics", discrete, fitnbpts = 101, fittype="l", \dots) qqcomp(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fitpch, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, use.ppoints = TRUE, a.ppoints = 0.5, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, plotstyle = "graphics", \dots) ppcomp(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fitpch, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, use.ppoints = TRUE, a.ppoints = 0.5, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, plotstyle = "graphics", \dots) } \arguments{ \item{ft}{One \code{"fitdist"} object or a list of objects of class \code{"fitdist"}.} \item{xlim}{The \eqn{x}-limits of the plot.} \item{ylim}{The \eqn{y}-limits of the plot.} \item{xlogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{x}-axis.} \item{ylogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{y}-axis.} \item{main}{A main title for the plot. See also \code{\link{title}}.} \item{xlab}{A label for the \eqn{x}-axis, defaults to a description of \code{x}.} \item{ylab}{A label for the \eqn{y}-axis, defaults to a description of \code{y}.} \item{datapch}{An integer specifying a symbol to be used in plotting data points. See also \code{\link{par}}.} \item{datacol}{A specification of the color to be used in plotting data points. See also \code{\link{par}}.} \item{fitcol}{A (vector of) color(s) to plot fitted distributions. If there are fewer colors than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fitlty}{A (vector of) line type(s) to plot fitted distributions/densities. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fitlwd}{A (vector of) line size(s) to plot fitted distributions/densities. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fitpch}{A (vector of) line type(s) to plot fitted quantiles/probabilities. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fittype}{The type of plot for fitted probabilities in the case of discrete distributions: possible types are \code{"p"} for points, \code{"l"} for lines and \code{"o"} for both overplotted (as in \code{\link{plot.default}}). \code{fittype} is not used for non-discrete distributions.} \item{fitnbpts}{A numeric for the number of points to compute fitted probabilities or cumulative probabilities. Default to \code{101}.} \item{addlegend}{If \code{TRUE}, a legend is added to the plot.} \item{legendtext}{A character or expression vector of length \eqn{\ge 1} to appear in the legend. See also \code{\link{legend}}.} \item{xlegend, ylegend}{The \eqn{x} and \eqn{y} coordinates to be used to position the legend. They can be specified by keyword. If \code{plotstyle = "graphics"}, see \code{\link{xy.coords}} and \code{\link{legend}}. If \code{plotstyle = "ggplot"}, the \code{xlegend} keyword must be one of \code{top}, \code{bottom}, \code{left}, or \code{right}. See also \code{guide_legend} in \code{ggplot2}} \item{horizontals}{If \code{TRUE}, draws horizontal lines for the step empirical cumulative distribution function (ecdf). See also \code{\link{plot.stepfun}}.} \item{verticals}{If \code{TRUE}, draws vertical lines for the empirical cumulative distribution function (ecdf). Only taken into account if \code{horizontals=TRUE}.} \item{do.points}{If \code{TRUE} (by default), draws points at the x-locations. For large dataset (n > 1e4), \code{do.points} is ignored and no point is drawn.} \item{use.ppoints}{If \code{TRUE}, probability points of the empirical distribution are defined using function \code{\link{ppoints}} as \code{(1:n - a.ppoints)/(n - 2a.ppoints + 1)}. If \code{FALSE}, probability points are simply defined as \code{(1:n)/n}. This argument is ignored for discrete data.} \item{a.ppoints}{If \code{use.ppoints=TRUE}, this is passed to the \code{\link{ppoints}} function.} \item{name.points}{Label vector for points if they are drawn i.e. if do.points = TRUE (only for non censored data).} \item{lines01}{A logical to plot two horizontal lines at \code{h=0} and \code{h=1} for \code{cdfcomp}.} \item{line01}{A logical to plot an horizontal line \eqn{y=x} for \code{qqcomp} and \code{ppcomp}.} \item{line01col, line01lty}{Color and line type for \code{line01}. See also \code{\link{par}}.} \item{demp}{A logical to add the empirical density on the plot, using the \code{\link{density}} function.} \item{dempcol}{A color for the empirical density in case it is added on the plot (\code{demp=TRUE}).} \item{ynoise}{A logical to add a small noise when plotting empirical quantiles/probabilities for \code{qqcomp} and \code{ppcomp}.} \item{probability}{A logical to use the probability scale for \code{denscomp}. See also \code{\link{hist}}.} \item{discrete}{If \code{TRUE}, the distributions are considered discrete. When missing, \code{discrete} is set to \code{TRUE} if at least one object of the list \code{ft} is discrete.} \item{add}{If \code{TRUE}, adds to an already existing plot. If \code{FALSE}, starts a new plot. This parameter is not available when \code{plotstyle = "ggplot"}.} \item{plotstyle}{\code{"graphics"} or \code{"ggplot"}. If \code{"graphics"}, the display is built with \code{\link{graphics}} functions. If \code{"ggplot"}, a graphic object output is created with \code{ggplot2} functions (the \code{ggplot2} package must be installed).} \item{\dots}{Further graphical arguments passed to graphical functions used in \code{cdfcomp}, \code{denscomp}, \code{ppcomp} and \code{qqcomp} when \code{plotstyle = "graphics"}. When \code{plotstyle = "ggplot"}, these arguments are only used by the histogram plot (\code{\link{hist}}) in the \code{denscomp} function. When \code{plotstyle = "ggplot"}, the graphical output can be customized with relevant \code{ggplot2} functions after you store your output.} } \details{ \code{cdfcomp} provides a plot of the empirical distribution and each fitted distribution in cdf, by default using the Hazen's rule for the empirical distribution, with probability points defined as \code{(1:n - 0.5)/n}. If \code{discrete} is \code{TRUE}, probability points are always defined as \code{(1:n)/n}. For large dataset (\code{n > 1e4}), no point is drawn but the line for \code{ecdf} is drawn instead. Note that when \code{horizontals, verticals and do.points} are \code{FALSE}, no empirical point is drawn, only the fitted cdf is shown. \code{denscomp} provides a density plot of each fitted distribution with the histogram of the data for conyinuous data. When \code{discrete=TRUE}, distributions are considered as discrete, no histogram is plotted but \code{demp} is forced to \code{TRUE} and fitted and empirical probabilities are plotted either with vertical lines \code{fittype="l"}, with single points \code{fittype="p"} or both lines and points \code{fittype="o"}. \code{ppcomp} provides a plot of the probabilities of each fitted distribution (\eqn{x}-axis) against the empirical probabilities (\eqn{y}-axis) by default defined as \code{(1:n - 0.5)/n} (data are assumed continuous). For large dataset (\code{n > 1e4}), lines are drawn instead of pointss and customized with the \code{fitpch} parameter. \code{qqcomp} provides a plot of the quantiles of each theoretical distribution (\eqn{x}-axis) against the empirical quantiles of the data (\eqn{y}-axis), by default defining probability points as \code{(1:n - 0.5)/n} for theoretical quantile calculation (data are assumed continuous). For large dataset (\code{n > 1e4}), lines are drawn instead of points and customized with the \code{fitpch} parameter. By default a legend is added to these plots. Many graphical arguments are optional, dedicated to personalize the plots, and fixed to default values if omitted. } \seealso{ See \code{\link{plot}}, \code{\link{legend}}, \code{\link{ppoints}}, \code{\link{plot.stepfun}} for classic plotting functions. See \code{\link{CIcdfplot}} and \code{\link{plotdist}} for other plot functions of fitdistrplus. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang, Marie-Laure Delignette-Muller and Aurelie Siberchicot. } \examples{ # (1) Plot various distributions fitted to serving size data # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving, "weibull") fitln <- fitdist(serving, "lnorm") fitg <- fitdist(serving, "gamma") cdfcomp(list(fitW, fitln, fitg), horizontals = FALSE) cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE) cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, verticals = TRUE, datacol = "purple") cdfcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", ylab = "F", xlim = c(0, 250), xlegend = "center", lines01 = TRUE) denscomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), xlegend = "topright") ppcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlegend = "bottomright", line01 = TRUE) qqcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlegend = "bottomright", line01 = TRUE, xlim = c(0, 300), ylim = c(0, 300), fitpch = 16) # (2) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa flnMGEKS <- fitdist(ATV, "lnorm", method = "mge", gof = "KS") flnMGEAD <- fitdist(ATV, "lnorm", method = "mge", gof = "AD") flnMGEADL <- fitdist(ATV, "lnorm", method = "mge", gof = "ADL") flnMGEAD2L <- fitdist(ATV, "lnorm", method = "mge", gof = "AD2L") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale = TRUE, main = "fits of a lognormal dist. using various GOF dist.", legendtext = c("MGE KS", "MGE AD", "MGE ADL", "MGE AD2L"), verticals = TRUE, xlim = c(1, 100000), name.points=taxaATV) qqcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main = "fits of a lognormal dist. using various GOF dist.", legendtext = c("MGE KS", "MGE AD", "MGE ADL", "MGE AD2L"), xlogscale = TRUE, ylogscale = TRUE) ppcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main = "fits of a lognormal dist. using various GOF dist.", legendtext = c("MGE KS", "MGE AD", "MGE ADL", "MGE AD2L")) # (3) Plot normal and logistic distributions fitted by # maximum likelihood estimation # using various plotting positions in cdf plots # data(endosulfan) log10ATV <-log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") fll <- fitdist(log10ATV, "logis") # default plot using Hazen plotting position: (1:n - 0.5)/n cdfcomp(list(fln, fll), legendtext = c("normal", "logistic"), xlab = "log10ATV") # plot using mean plotting position (named also Gumbel plotting position) # (1:n)/(n + 1) cdfcomp(list(fln, fll),legendtext = c("normal", "logistic"), xlab = "log10ATV", use.ppoints = TRUE, a.ppoints = 0) # plot using basic plotting position: (1:n)/n cdfcomp(list(fln, fll),legendtext = c("normal", "logistic"), xlab = "log10ATV", use.ppoints = FALSE) # (4) Comparison of fits of two distributions fitted to discrete data # data(toxocara) number <- toxocara$number fitp <- fitdist(number, "pois") fitnb <- fitdist(number, "nbinom") cdfcomp(list(fitp, fitnb), legendtext = c("Poisson", "negative binomial")) denscomp(list(fitp, fitnb),demp = TRUE, legendtext = c("Poisson", "negative binomial")) denscomp(list(fitp, fitnb),demp = TRUE, fittype = "l", dempcol = "black", legendtext = c("Poisson", "negative binomial")) denscomp(list(fitp, fitnb),demp = TRUE, fittype = "p", dempcol = "black", legendtext = c("Poisson", "negative binomial")) denscomp(list(fitp, fitnb),demp = TRUE, fittype = "o", dempcol = "black", legendtext = c("Poisson", "negative binomial")) # (5) Customizing of graphical output and use of ggplot2 # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving, "weibull") fitln <- fitdist(serving, "lnorm") fitg <- fitdist(serving, "gamma") if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fitW, fitln, fitg), plotstyle = "ggplot") cdfcomp(list(fitW, fitln, fitg), plotstyle = "ggplot") qqcomp(list(fitW, fitln, fitg), plotstyle = "ggplot") ppcomp(list(fitW, fitln, fitg), plotstyle = "ggplot") } # customizing graphical output with graphics denscomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), xlegend = "topright", addlegend = FALSE) # customizing graphical output with ggplot2 if (requireNamespace ("ggplot2", quietly = TRUE)) { dcomp <- denscomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), xlab = "serving sizes (g)", xlim = c(0, 250), xlegend = "topright", plotstyle = "ggplot", breaks = 20, addlegend = FALSE) dcomp + ggplot2::theme_minimal() + ggplot2::ggtitle("Ground beef fits") } } \keyword{ distribution } fitdistrplus/man/fluazinam.Rd0000644000176200001440000000513013742313702016037 0ustar liggesusers\name{fluazinam} \alias{fluazinam} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Species-Sensitivity Distribution (SSD) for Fluazinam } \description{ 48-hour acute toxicity values (EC50 values) for exposure of macroinvertebrates and zooplancton to fluazinam. } \usage{ data(fluazinam) } %- maybe also 'usage' for other objects documented here. \format{ \code{fluazinam} is a data frame with 2 columns named left and right, describing each observed EC50 value (in micrograms per liter) as an interval. The left column contains either NA for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either NA for right censored observations, the right bound of the interval for interval censored observations, or the observed value for noncensored observations. } \source{ Hose, G.C., Van den Brink, P.J. 2004. The species sensitivity distribution approach compared to a microcosm study: A case study with the fungicide fluazinam. \emph{Ecotoxicology and Environmental Safety}, \bold{73}, 109-122. } %\references{ } \examples{ # (1) load of data # data(fluazinam) # (2) plot of data using Turnbull cdf plot # log10EC50 <-log10(fluazinam) plotdistcens(log10EC50) # (3) fit of a lognormal and a logistic distribution to data # (classical distributions used for species sensitivity # distributions, SSD, in ecotoxicology) # and visual comparison of the fits using Turnbull cdf plot # fln <- fitdistcens(log10EC50,"norm") summary(fln) fll <- fitdistcens(log10EC50,"logis") summary(fll) cdfcompcens(list(fln,fll),legendtext=c("normal","logistic"), xlab = "log10(EC50)") # (4) estimation of the 5 percent quantile value of # the normal fitted distribution (5 percent hazardous concentration : HC5) # with its two-sided 95 percent confidence interval calculated by # non parametric bootstrap # with a small number of iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # # in log10(EC50) bln <- bootdistcens(fln, niter=101) HC5ln <- quantile(bln, probs = 0.05) # in EC50 10^(HC5ln$quantiles) 10^(HC5ln$quantCI) # (5) estimation of the HC5 value # with its one-sided 95 percent confidence interval (type "greater") # # in log10(EC50) HC5lnb <- quantile(bln,probs = 0.05,CI.type="greater") # in LC50 10^(HC5lnb$quantiles) 10^(HC5lnb$quantCI) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/mmedist.Rd0000644000176200001440000002356313742313702015525 0ustar liggesusers\name{mmedist} \alias{mmedist} \alias{mme} \title{ Matching moment fit of univariate distributions} \description{ Fit of univariate distributions by matching moments (raw or centered) for non censored data. } \usage{ mmedist(data, distr, order, memp, start = NULL, fix.arg = NULL, optim.method = "default", lower = -Inf, upper = Inf, custom.optim = NULL, weights = NULL, silent = TRUE, gradient = NULL, checkstartfix=FALSE, \dots) } \arguments{ \item{data}{A numeric vector for non censored data.} \item{distr}{A character string \code{"name"} naming a distribution (see 'details').} \item{order}{A numeric vector for the moment order(s). The length of this vector must be equal to the number of parameters to estimate.} \item{memp}{A function implementing empirical moments, raw or centered but has to be consistent with \code{distr} argument (and \code{weights} argument). See details below. } \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). } \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated.} \item{optim.method}{ \code{"default"} or optimization method to pass to \code{\link{optim}}. } \item{lower}{ Left bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{upper}{ Right bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{custom.optim}{a function carrying the optimization .} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector with strictly positive integers (typically the number of occurences of each observation). If non-\code{NULL}, weighted MME is used, otherwise ordinary MME.} \item{silent}{A logical to remove or show warnings when bootstraping.} \item{gradient}{A function to return the gradient of the squared difference for the \code{"BFGS"}, \code{"CG"} and \code{"L-BFGS-B"} methods. If it is \code{NULL}, a finite-difference approximation will be used, see details.} \item{checkstartfix}{A logical to test starting and fixed values. Do not change it.} \item{\dots}{further arguments passed to the \code{\link{optim}}, \code{\link{constrOptim}} or \code{custom.optim} function.} } \details{ The argument \code{distr} can be one of the base R distributions: \code{"norm"}, \code{"lnorm"}, \code{"exp"} and \code{"pois"}, \code{"gamma"}, \code{"logis"}, \code{"nbinom"} , \code{"geom"}, \code{"beta"} and \code{"unif"}. In that case, no other arguments than \code{data} and \code{distr} are required, because the estimate is computed by a closed-form formula. For distributions characterized by one parameter (\code{"geom"}, \code{"pois"} and \code{"exp"}), this parameter is simply estimated by matching theoretical and observed means, and for distributions characterized by two parameters, these parameters are estimated by matching theoretical and observed means and variances (Vose, 2000). Note that for these closed-form formula, \code{fix.arg} cannot be used and \code{start} is ignored. The argument \code{distr} can also be the distribution name as long as a corresponding \code{mdistr} function exists, e.g. \code{"pareto"} if \code{"mpareto"} exists. In that case arguments arguments \code{order} and \code{memp} have to be supplied in order to carry out the matching numerically, by minimization of the sum of squared differences between observed and theoretical moments. Optionnally other arguments can be supplied to control optimization (see the 'details' section of \code{\link{mledist}} for details about arguments for the control of optimization). In that case, \code{fix.arg} can be used and \code{start} is taken into account. For non closed-form estimators, \code{memp} must be provided to compute empirical moments. When \code{weights=NULL}, this function must have two arguments \code{x, order}: \code{x} the numeric vector of the data and \code{order} the order of the moment. When \code{weights!=NULL}, this function must have three arguments \code{x, order, weights}: \code{x} the numeric vector of the data, \code{order} the order of the moment, \code{weights} the numeric vector of weights. See examples below. Optionally, a vector of \code{weights} can be used in the fitting process. By default (when \code{weigths=NULL}), ordinary MME is carried out, otherwise the specified weights are used to compute (raw or centered) weighted moments. For closed-form estimators, weighted mean and variance are computed by \code{\link[Hmisc:wtd.stats]{wtd.mean}} and \code{\link[Hmisc:wtd.stats]{wtd.var}} from the \code{Hmisc} package. When a numerical minimization is used, weighted are expected to be computed by the \code{memp} function. It is not yet possible to take into account weighths in functions \code{plotdist}, \code{plotdistcens}, \code{plot.fitdist}, \code{plot.fitdistcens}, \code{cdfcomp}, \code{cdfcompcens}, \code{denscomp}, \code{ppcomp}, \code{qqcomp}, \code{gofstat} and \code{descdist} (developments planned in the future). This function is not intended to be called directly but is internally called in \code{\link{fitdist}} and \code{\link{bootdist}} when used with the matching moments method. } \value{ \code{mmedist} returns a list with following components, \item{estimate}{ the parameter estimates.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error. } \item{value}{the minimal value reached for the criterion to minimize.} \item{hessian}{ a symmetric matrix computed by \code{\link{optim}} as an estimate of the Hessian at the solution found or computed in the user-supplied optimization function. } \item{optim.function}{(if appropriate) the name of the optimization function used for maximum likelihood.} \item{optim.method}{(if appropriate) when \code{\link{optim}} is used, the name of the algorithm used, the field \code{method} of the \code{custom.optim} function otherwise.} \item{fix.arg}{the named list giving the values of parameters of the named distribution that must kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} \item{counts}{A two-element integer vector giving the number of calls to the log-likelihood function and its gradient respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to log-likelihood function to compute a finite-difference approximation to the gradient. \code{counts} is returned by \code{\link{optim}} or the user-supplied function or set to \code{NULL}.} \item{optim.message}{A character string giving any additional information returned by the optimizer, or \code{NULL}. To understand exactly the message, see the source code.} \item{loglik}{ the log-likelihood value. } \item{method}{either \code{"closed formula"} or the name of the optimization method.} \item{order}{ the order of the moment(s) matched.} \item{memp}{ the empirical moment function.} } \seealso{ \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}}, \code{\link{fitdist}},\code{\link{fitdistcens}}, \code{\link{optim}}, \code{\link{bootdistcens}} and \code{\link{bootdist}}. } \references{ Evans M, Hastings N and Peacock B (2000), \emph{Statistical distributions}. John Wiley and Sons Inc. Vose D (2000), \emph{Risk analysis, a quantitative guide}. John Wiley & Sons Ltd, Chischester, England, pp. 99-143. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) basic fit of a normal distribution with moment matching estimation # set.seed(1234) n <- 100 x1 <- rnorm(n=n) mmedist(x1, "norm") #weighted w <- c(rep(1, n/2), rep(10, n/2)) mmedist(x1, "norm", weights=w)$estimate # (2) fit a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=30,lambda = 2) mmedist(x2, "pois") # (3) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=100,shape1=5, shape2=10) mmedist(x3, "beta") # (4) fit a Pareto distribution # \dontrun{ require(actuar) #simulate a sample x4 <- rpareto(1000, 6, 2) #empirical raw moment memp <- function(x, order) mean(x^order) memp2 <- function(x, order, weights) sum(x^order * weights)/sum(weights) #fit by MME mmedist(x4, "pareto", order=c(1, 2), memp=memp, start=list(shape=10, scale=10), lower=1, upper=Inf) #fit by weighted MME w <- rep(1, length(x4)) w[x4 < 1] <- 2 mmedist(x4, "pareto", order=c(1, 2), memp=memp2, weights=w, start=list(shape=10, scale=10), lower=1, upper=Inf) } } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/dataFAQ.Rd0000644000176200001440000000074713742313702015323 0ustar liggesusers\name{dataFAQ} \alias{dataFAQ} \alias{dataFAQlog1} \alias{dataFAQscale1} \alias{dataFAQscale2} \docType{data} \title{Datasets for the FAQ} \description{ Datasets used in the FAQ vignette. } \usage{ data(dataFAQlog1) data(dataFAQscale1) data(dataFAQscale2) } \format{ \code{dataFAQlog1} \code{dataFAQscale1} \code{dataFAQscale2} are vectors of numeric data. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/prefit.Rd0000644000176200001440000001204513742313702015345 0ustar liggesusers\name{prefit} \alias{prefit} \title{Pre-fitting procedure} \description{ Search good starting values } \usage{ prefit(data, distr, method = c("mle", "mme", "qme", "mge"), feasible.par, memp=NULL, order=NULL, probs=NULL, qtype=7, gof=NULL, fix.arg=NULL, lower, upper, weights=NULL, silent=TRUE, \dots) } \arguments{ \item{data}{A numeric vector.} \item{distr}{A character string \code{"name"} naming a distribution for which the corresponding density function \code{dname}, the corresponding distribution function \code{pname} and the corresponding quantile function \code{qname} must be defined, or directly the density function.} \item{method}{A character string coding for the fitting method: \code{"mle"} for 'maximum likelihood estimation', \code{"mme"} for 'moment matching estimation', \code{"qme"} for 'quantile matching estimation' and \code{"mge"} for 'maximum goodness-of-fit estimation'.} \item{feasible.par}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). It may not be into account for closed-form formulas.} \item{order}{A numeric vector for the moment order(s). The length of this vector must be equal to the number of parameters to estimate.} \item{memp}{A function implementing empirical moments, raw or centered but has to be consistent with \code{distr} argument (and \code{weights} argument).} \item{probs}{A numeric vector of the probabilities for which the quantile matching is done. The length of this vector must be equal to the number of parameters to estimate.} \item{qtype}{The quantile type used by the R \code{\link{quantile}} function to compute the empirical quantiles, (default 7 corresponds to the default quantile method in R).} \item{gof}{A character string coding for the name of the goodness-of-fit distance used : "CvM" for Cramer-von Mises distance,"KS" for Kolmogorov-Smirnov distance, "AD" for Anderson-Darling distance, "ADR", "ADL", "AD2R", "AD2L" and "AD2" for variants of Anderson-Darling distance described by Luceno (2006).} \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated by this maximum likelihood procedure. The use of this argument is not possible if \code{method="mme"} and a closed-form formula is used.} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector. If non-\code{NULL}, weighted MLE is used, otherwise ordinary MLE.} \item{silent}{A logical to remove or show warnings.} \item{lower}{Lower bounds on the parameters.} \item{upper}{Upper bounds on the parameters.} \item{\dots}{Further arguments to be passed to generic functions, or to one of the functions \code{"mledist"}, \code{"mmedist"}, \code{"qmedist"} or \code{"mgedist"} depending of the chosen method. See \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}} for details on parameter estimation.} } \details{ Searching good starting values is achieved by transforming the parameters (from their constraint interval to the real line) of the probability distribution. Indeed, \itemize{ \item positive parameters in \eqn{(0,Inf)} are transformed using the logarithm (typically the scale parameter \code{sd} of a normal distribution, see \link{Normal}), \item parameters in \eqn{(1,Inf)} are transformed using the function \eqn{log(x-1)}, \item probability parameters in \eqn{(0,1)} are transformed using the logit function \eqn{log(x/(1-x))} (typically the parameter \code{prob} of a geometric distribution, see \link{Geometric}), \item negative probability parameters in \eqn{(-1,0)} are transformed using the function \eqn{log(-x/(1+x))}, \item real parameters are of course not transformed at all, typically the \code{mean} of a normal distribution, see \link{Normal}. } Once parameters are transformed, an optimization is carried out by a quasi-Newton algorithm (typically BFGS) and then we transform them back to original parameter value. } \value{ A named list. } \seealso{ See \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}} for details on parameter estimation. See \code{\link{fitdist}} for the main procedure. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang and Marie-Laure Delignette-Muller. } \examples{ # (1) fit of a gamma distribution by maximum likelihood estimation # x <- rgamma(1e3, 5/2, 7/2) prefit(x, "gamma", "mle", list(shape=3, scale=3), lower=-Inf, upper=Inf) } \keyword{ distribution } fitdistrplus/man/endosulfan.Rd0000644000176200001440000000577314076546311016231 0ustar liggesusers\name{endosulfan} \alias{endosulfan} \docType{data} \title{Species Sensitivity Distribution (SSD) for endosulfan} \description{ Summary of 48- to 96-hour acute toxicity values (LC50 and EC50 values) for exposure of Australian an Non-Australian taxa to endosulfan. } \usage{ data(endosulfan) } \format{ \code{endosulfan} is a data frame with 4 columns, named ATV for Acute Toxicity Value (geometric mean of LC50 ou EC50 values in micrograms per liter), Australian (coding for Australian or another origin), group (arthropods, fish or non-arthropod invertebrates) and taxa. } \source{ Hose, G.C., Van den Brink, P.J. 2004. Confirming the Species-Sensitivity Distribution Concept for Endosulfan Using Laboratory, Mesocosms, and Field Data. \emph{Archives of Environmental Contamination and Toxicology}, \bold{47}, 511-520. } \examples{ # (1) load of data # data(endosulfan) # (2) plot and description of data for non Australian fish in decimal logarithm # log10ATV <-log10(subset(endosulfan,(Australian == "no") & (group == "Fish"))$ATV) plotdist(log10ATV) descdist(log10ATV,boot=1000) # (3) fit of a normal and a logistic distribution to data in log10 # (classical distributions used for SSD) # and visual comparison of the fits # fln <- fitdist(log10ATV,"norm") summary(fln) fll <- fitdist(log10ATV,"logis") summary(fll) cdfcomp(list(fln,fll),legendtext=c("normal","logistic"), xlab="log10ATV") denscomp(list(fln,fll),legendtext=c("normal","logistic"), xlab="log10ATV") qqcomp(list(fln,fll),legendtext=c("normal","logistic")) ppcomp(list(fln,fll),legendtext=c("normal","logistic")) gofstat(list(fln,fll), fitnames = c("lognormal", "loglogistic")) # (4) estimation of the 5 percent quantile value of # logistic fitted distribution (5 percent hazardous concentration : HC5) # with its two-sided 95 percent confidence interval calculated by # parametric bootstrap # with a small number of iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # # in log10(ATV) bll <- bootdist(fll,niter=101) HC5ll <- quantile(bll,probs = 0.05) # in ATV 10^(HC5ll$quantiles) 10^(HC5ll$quantCI) # (5) estimation of the 5 percent quantile value of # the fitted logistic distribution (5 percent hazardous concentration : HC5) # with its one-sided 95 percent confidence interval (type "greater") # calculated by # nonparametric bootstrap # with a small number of iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # # in log10(ATV) bllnonpar <- bootdist(fll,niter=101,bootmethod = "nonparam") HC5llgreater <- quantile(bllnonpar,probs = 0.05, CI.type="greater") # in ATV 10^(HC5llgreater$quantiles) 10^(HC5llgreater$quantCI) # (6) fit of a logistic distribution # by minimizing the modified Anderson-Darling AD2L distance # cf. ?mgedist for definition of this distance # fllAD2L <- fitdist(log10ATV,"logis",method="mge",gof="AD2L") summary(fllAD2L) plot(fllAD2L) } \keyword{datasets} fitdistrplus/man/qmedist.Rd0000644000176200001440000001764513742313702015535 0ustar liggesusers\name{qmedist} \alias{qmedist} \alias{qme} \title{ Quantile matching fit of univariate distributions} \description{ Fit of univariate distribution by matching quantiles for non censored data. } \usage{ qmedist(data, distr, probs, start = NULL, fix.arg = NULL, qtype = 7, optim.method = "default", lower = -Inf, upper = Inf, custom.optim = NULL, weights = NULL, silent = TRUE, gradient = NULL, checkstartfix=FALSE, \dots) } \arguments{ \item{data}{ A numeric vector for non censored data. } \item{distr}{ A character string \code{"name"} naming a distribution for which the corresponding quantile function \code{qname} and the corresponding density distribution \code{dname} must be classically defined. } \item{probs}{A numeric vector of the probabilities for which the quantile matching is done. The length of this vector must be equal to the number of parameters to estimate.} \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). } \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated.} \item{qtype}{The quantile type used by the R \code{\link{quantile}} function to compute the empirical quantiles, (default 7 corresponds to the default quantile method in R).} \item{optim.method}{ \code{"default"} or optimization method to pass to \code{\link{optim}}. } \item{lower}{ Left bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{upper}{ Right bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{custom.optim}{a function carrying the optimization.} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector with strictly positive integers (typically the number of occurences of each observation). If non-\code{NULL}, weighted QME is used, otherwise ordinary QME.} \item{silent}{A logical to remove or show warnings when bootstraping.} \item{gradient}{A function to return the gradient of the squared difference for the \code{"BFGS"}, \code{"CG"} and \code{"L-BFGS-B"} methods. If it is \code{NULL}, a finite-difference approximation will be used, see details.} \item{checkstartfix}{A logical to test starting and fixed values. Do not change it.} \item{\dots}{further arguments passed to the \code{\link{optim}}, \code{\link{constrOptim}} or \code{custom.optim} function.} } \details{ The \code{qmedist} function carries out the quantile matching numerically, by minimization of the sum of squared differences between observed and theoretical quantiles. Note that for discrete distribution, the sum of squared differences is a step function and consequently, the optimum is not unique, see the FAQ. The optimization process is the same as \code{\link{mledist}}, see the 'details' section of that function. Optionally, a vector of \code{weights} can be used in the fitting process. By default (when \code{weigths=NULL}), ordinary QME is carried out, otherwise the specified weights are used to compute weighted quantiles used in the squared differences. Weigthed quantiles are computed by \code{\link[Hmisc:wtd.stats]{wtd.quantile}} from the \code{Hmisc} package. It is not yet possible to take into account weighths in functions \code{plotdist}, \code{plotdistcens}, \code{plot.fitdist}, \code{plot.fitdistcens}, \code{cdfcomp}, \code{cdfcompcens}, \code{denscomp}, \code{ppcomp}, \code{qqcomp}, \code{gofstat} and \code{descdist} (developments planned in the future). This function is not intended to be called directly but is internally called in \code{\link{fitdist}} and \code{\link{bootdist}}. } \value{ \code{qmedist} returns a list with following components, \item{estimate}{ the parameter estimates.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error. } \item{value}{the minimal value reached for the criterion to minimize.} \item{hessian}{ a symmetric matrix computed by \code{\link{optim}} as an estimate of the Hessian at the solution found or computed in the user-supplied optimization function. } \item{optim.function}{the name of the optimization function used for maximum likelihood.} \item{optim.method}{when \code{\link{optim}} is used, the name of the algorithm used, the field \code{method} of the \code{custom.optim} function otherwise.} \item{fix.arg}{the named list giving the values of parameters of the named distribution that must kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} \item{counts}{A two-element integer vector giving the number of calls to the log-likelihood function and its gradient respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to log-likelihood function to compute a finite-difference approximation to the gradient. \code{counts} is returned by \code{\link{optim}} or the user-supplied function or set to \code{NULL}.} \item{optim.message}{A character string giving any additional information returned by the optimizer, or \code{NULL}. To understand exactly the message, see the source code.} \item{loglik}{ the log-likelihood value. } \item{probs}{ the probability vector on which quantiles are matched. } } \seealso{ \code{\link{mmedist}}, \code{\link{mledist}}, \code{\link{mgedist}}, \code{\link{fitdist}} for other estimation methods and \code{\link{quantile}} for empirical quantile estimation in R. } \references{ Klugman SA, Panjer HH and Willmot GE (2012), \emph{Loss Models: From Data to Decissions}, 4th edition. Wiley Series in Statistics for Finance, Business and Economics, p. 253. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang and Marie Laure Delignette-Muller. } \examples{ # (1) basic fit of a normal distribution # set.seed(1234) x1 <- rnorm(n=100) qmedist(x1, "norm", probs=c(1/3, 2/3)) # (2) defining your own distribution functions, here for the Gumbel # distribution for other distributions, see the CRAN task view dedicated # to probability distributions dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) qgumbel <- function(p, a, b) a - b*log(-log(p)) qmedist(x1, "gumbel", probs=c(1/3, 2/3), start=list(a=10,b=5)) # (3) fit a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=30,lambda = 2) qmedist(x2, "pois", probs=1/2) # (4) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=100,shape1=5, shape2=10) qmedist(x3, "beta", probs=c(1/3, 2/3)) # (5) fit frequency distributions on USArrests dataset. # x4 <- USArrests$Assault qmedist(x4, "pois", probs=1/2) qmedist(x4, "nbinom", probs=c(1/3, 2/3)) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/fitdist.Rd0000644000176200001440000005677513742313702015544 0ustar liggesusers\name{fitdist} \alias{fitdist} \alias{plot.fitdist} \alias{print.fitdist} \alias{summary.fitdist} \alias{logLik.fitdist} \alias{vcov.fitdist} \alias{coef.fitdist} \title{ Fit of univariate distributions to non-censored data} \description{ Fit of univariate distributions to non-censored data by maximum likelihood (mle), moment matching (mme), quantile matching (qme) or maximizing goodness-of-fit estimation (mge). The latter is also known as minimizing distance estimation. Generic methods are \code{print}, \code{plot}, \code{summary}, \code{quantile}, \code{logLik}, \code{vcov} and \code{coef}. } \usage{ fitdist(data, distr, method = c("mle", "mme", "qme", "mge", "mse"), start=NULL, fix.arg=NULL, discrete, keepdata = TRUE, keepdata.nb=100, \dots) \method{print}{fitdist}(x, \dots) \method{plot}{fitdist}(x, breaks="default", \dots) \method{summary}{fitdist}(object, \dots) \method{logLik}{fitdist}(object, \dots) \method{vcov}{fitdist}(object, \dots) \method{coef}{fitdist}(object, \dots) } \arguments{ \item{data}{A numeric vector.} \item{distr}{A character string \code{"name"} naming a distribution for which the corresponding density function \code{dname}, the corresponding distribution function \code{pname} and the corresponding quantile function \code{qname} must be defined, or directly the density function.} \item{method}{A character string coding for the fitting method: \code{"mle"} for 'maximum likelihood estimation', \code{"mme"} for 'moment matching estimation', \code{"qme"} for 'quantile matching estimation', \code{"mge"} for 'maximum goodness-of-fit estimation' and \code{"mse"} for 'maximum spacing estimation'.} \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). It may not be into account for closed-form formulas.} \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated by this maximum likelihood procedure. The use of this argument is not possible if \code{method="mme"} and a closed-form formula is used.} \item{keepdata}{a logical. If \code{TRUE}, dataset is returned, otherwise only a sample subset is returned.} \item{keepdata.nb}{When \code{keepdata=FALSE}, the length (>1) of the subset returned.} \item{discrete}{ If TRUE, the distribution is considered as discrete. If \code{discrete} is missing, \code{discrete} is automaticaly set to \code{TRUE} when \code{distr} belongs to \code{"binom"}, \code{"nbinom"}, \code{"geom"}, \code{"hyper"} or \code{"pois"} and to \code{FALSE} in the other cases. It is thus recommended to enter this argument when using another discrete distribution. This argument will not directly affect the results of the fit but will be passed to functions \code{\link{gofstat}}, \code{\link{plotdist}} and \code{\link{cdfcomp}}. } \item{x}{An object of class \code{"fitdist"}. } \item{object}{An object of class \code{"fitdist"}. } \item{breaks}{If \code{"default"} the histogram is plotted with the function \code{hist} with its default breaks definition. Else \code{breaks} is passed to the function \code{hist}. This argument is not taken into account with discrete distributions: \code{"binom"}, \code{"nbinom"}, \code{"geom"}, \code{"hyper"} and \code{"pois"}. } \item{\dots}{Further arguments to be passed to generic functions, or to one of the functions \code{"mledist"}, \code{"mmedist"}, \code{"qmedist"} or \code{"mgedist"} depending of the chosen method. See \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}} for details on parameter estimation.} } \details{ It is assumed that the \code{distr} argument specifies the distribution by the probability density function, the cumulative distribution function and the quantile function (d, p, q). The four possible fitting methods are described below: \describe{ \item{When \code{method="mle"}}{ Maximum likelihood estimation consists in maximizing the log-likelihood. A numerical optimization is carried out in \code{\link{mledist}} via \code{optim} to find the best values (see \code{\link{mledist}} for details). } \item{When \code{method="mme"}}{ Moment matching estimation consists in equalizing theoretical and empirical moments. Estimated values of the distribution parameters are computed by a closed-form formula for the following distributions : \code{"norm"}, \code{"lnorm"}, \code{"pois"}, \code{"exp"}, \code{"gamma"}, \code{"nbinom"}, \code{"geom"}, \code{"beta"}, \code{"unif"} and \code{"logis"}. Otherwise the theoretical and the empirical moments are matched numerically, by minimization of the sum of squared differences between observed and theoretical moments. In this last case, further arguments are needed in the call to \code{fitdist}: \code{order} and \code{memp} (see \code{\link{mmedist}} for details). } \item{When \code{method = "qme"}}{ Quantile matching estimation consists in equalizing theoretical and empirical quantile. A numerical optimization is carried out in \code{\link{qmedist}} via \code{optim} to minimize of the sum of squared differences between observed and theoretical quantiles. The use of this method requires an additional argument \code{probs}, defined as the numeric vector of the probabilities for which the quantile(s) is(are) to be matched (see \code{\link{qmedist}} for details). } \item{When \code{method = "mge"}}{ Maximum goodness-of-fit estimation consists in maximizing a goodness-of-fit statistics. A numerical optimization is carried out in \code{\link{mgedist}} via \code{optim} to minimize the goodness-of-fit distance. The use of this method requires an additional argument \code{gof} coding for the goodness-of-fit distance chosen. One can use the classical Cramer-von Mises distance (\code{"CvM"}), the classical Kolmogorov-Smirnov distance (\code{"KS"}), the classical Anderson-Darling distance (\code{"AD"}) which gives more weight to the tails of the distribution, or one of the variants of this last distance proposed by Luceno (2006) (see \code{\link{mgedist}} for more details). This method is not suitable for discrete distributions. } \item{When \code{method = "mse"}}{ Maximum goodness-of-fit estimation consists in maximizing the average log spacing. A numerical optimization is carried out in \code{\link{msedist}} via \code{optim}. } } By default, direct optimization of the log-likelihood (or other criteria depending of the chosen method) is performed using \code{\link{optim}}, with the "Nelder-Mead" method for distributions characterized by more than one parameter and the "BFGS" method for distributions characterized by only one parameter. The optimization algorithm used in \code{\link{optim}} can be chosen or another optimization function can be specified using \dots argument (see \code{\link{mledist}} for details). \code{start} may be omitted (i.e. \code{NULL}) for some classic distributions (see the 'details' section of \code{\link{mledist}}). Note that when errors are raised by \code{optim}, it's a good idea to start by adding traces during the optimization process by adding \code{control=list(trace=1, REPORT=1)} in \dots argument. Once the parameter(s) is(are) estimated, \code{fitdist} computes the log-likelihood for every estimation method and for maximum likelihood estimation the standard errors of the estimates calculated from the Hessian at the solution found by \code{optim} or by the user-supplied function passed to mledist. By default (\code{keepdata = TRUE}), the object returned by \code{fitdist} contains the data vector given in input. When dealing with large datasets, we can remove the original dataset from the output by setting \code{keepdata = FALSE}. In such a case, only \code{keepdata.nb} points (at most) are kept by random subsampling \code{keepdata.nb}-2 points from the dataset and adding the minimum and the maximum. If combined with \code{\link{bootdist}}, and use with non-parametric bootstrap be aware that bootstrap is performed on the subset randomly selected in \code{fitdist}. Currently, the graphical comparisons of multiple fits is not available in this framework. Weighted version of the estimation process is available for \code{method = "mle", "mme", "qme"} by using \code{weights=\dots}. See the corresponding man page for details. Weighted maximum GOF estimation (when \code{method = "mge"}) is not allowed. It is not yet possible to take into account weighths in functions \code{plotdist}, \code{plot.fitdist}, \code{cdfcomp}, \code{denscomp}, \code{ppcomp}, \code{qqcomp}, \code{gofstat} and \code{descdist} (developments planned in the future). NB: if your data values are particularly small or large, a scaling may be needed before the optimization process. See example (14) in this man page and examples (14,15) in the test file of the package. Please also take a look at the \code{Rmpfr} package available on CRAN for numerical accuracy issues. } \value{ \code{fitdist} returns an object of class \code{"fitdist"}, a list with the following components: \item{estimate}{ the parameter estimates.} \item{method}{ the character string coding for the fitting method : \code{"mle"} for 'maximum likelihood estimation', \code{"mme"} for 'matching moment estimation', \code{"qme"} for 'matching quantile estimation' \code{"mge"} for 'maximum goodness-of-fit estimation' and \code{"mse"} for 'maximum spacing estimation'.} \item{sd}{ the estimated standard errors, \code{NA} if numerically not computable or \code{NULL} if not available.} \item{cor}{ the estimated correlation matrix, \code{NA} if numerically not computable or \code{NULL} if not available.} \item{vcov}{ the estimated variance-covariance matrix, \code{NULL} if not available.} \item{loglik}{ the log-likelihood.} \item{aic}{ the Akaike information criterion.} \item{bic}{ the the so-called BIC or SBC (Schwarz Bayesian criterion).} \item{n}{ the length of the data set.} \item{data}{ the data set.} \item{distname}{ the name of the distribution.} \item{fix.arg}{ the named list giving the values of parameters of the named distribution that must be kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{dots}{ the list of further arguments passed in \dots to be used in \code{\link{bootdist}} in iterative calls to \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}} or \code{NULL} if no such arguments.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}}/\code{\link{constrOptim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error.} \item{discrete}{ the input argument or the automatic definition by the function to be passed to functions \code{\link{gofstat}}, \code{\link{plotdist}} and \code{\link{cdfcomp}}. } \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} Generic functions: \describe{ \item{\code{print}}{ The print of a \code{"fitdist"} object shows few traces about the fitting method and the fitted distribution. } \item{\code{summary}}{ The summary provides the parameter estimates of the fitted distribution, the log-likelihood, AIC and BIC statistics and when the maximum likelihood is used, the standard errors of the parameter estimates and the correlation matrix between parameter estimates. } \item{\code{plot}}{ The plot of an object of class "fitdist" returned by \code{fitdist} uses the function \code{\link{plotdist}}. An object of class "fitdist" or a list of objects of class "fitdist" corresponding to various fits using the same data set may also be plotted using a cdf plot (function \code{\link{cdfcomp}}), a density plot(function \code{\link{denscomp}}), a density Q-Q plot (function \code{\link{qqcomp}}), or a P-P plot (function \code{\link{ppcomp}}). } \item{\code{logLik}}{ Extracts the estimated log-likelihood from the \code{"fitdist"} object. } \item{\code{vcov}}{ Extracts the estimated var-covariance matrix from the \code{"fitdist"} object (only available When \code{method = "mle"}). } \item{\code{coef}}{ Extracts the fitted coefficients from the \code{"fitdist"} object. } } } \seealso{ See \code{\link{fitdistrplus}} for an overview of the package. See \code{\link{mledist}}, \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}}, \code{\link{msedist}} for details on parameter estimation. See \code{\link{gofstat}} for goodness-of-fit statistics. See \code{\link{plotdist}}, \code{\link{graphcomp}}, \code{\link{CIcdfplot}} for graphs (with or without uncertainty and/or multiple fits). See \code{\link{llplot}} for (log-)likelihood plots in the neighborhood of the fitted value. See \code{\link{bootdist}} for bootstrap procedures and \code{\link{fitdistcens}} for censored-data fitting methods. See \code{\link{optim}} for base R optimization procedures. See \code{\link{quantile.fitdist}}, another generic function, which calculates quantiles from the fitted distribution. See \code{\link{quantile}} for base R quantile computation. } \references{ Cullen AC and Frey HC (1999), \emph{Probabilistic techniques in exposure assessment}. Plenum Press, USA, pp. 81-155. Venables WN and Ripley BD (2002), \emph{Modern applied statistics with S}. Springer, New York, pp. 435-446. Vose D (2000), \emph{Risk analysis, a quantitative guide}. John Wiley & Sons Ltd, Chischester, England, pp. 99-143. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) fit of a gamma distribution by maximum likelihood estimation # data(groundbeef) serving <- groundbeef$serving fitg <- fitdist(serving, "gamma") summary(fitg) plot(fitg) plot(fitg, demp = TRUE) plot(fitg, histo = FALSE, demp = TRUE) cdfcomp(fitg, addlegend=FALSE) denscomp(fitg, addlegend=FALSE) ppcomp(fitg, addlegend=FALSE) qqcomp(fitg, addlegend=FALSE) # (2) use the moment matching estimation (using a closed formula) # fitgmme <- fitdist(serving, "gamma", method="mme") summary(fitgmme) # (3) Comparison of various fits # fitW <- fitdist(serving, "weibull") fitg <- fitdist(serving, "gamma") fitln <- fitdist(serving, "lnorm") summary(fitW) summary(fitg) summary(fitln) cdfcomp(list(fitW, fitg, fitln), legendtext=c("Weibull", "gamma", "lognormal")) denscomp(list(fitW, fitg, fitln), legendtext=c("Weibull", "gamma", "lognormal")) qqcomp(list(fitW, fitg, fitln), legendtext=c("Weibull", "gamma", "lognormal")) ppcomp(list(fitW, fitg, fitln), legendtext=c("Weibull", "gamma", "lognormal")) gofstat(list(fitW, fitg, fitln), fitnames=c("Weibull", "gamma", "lognormal")) # (4) defining your own distribution functions, here for the Gumbel distribution # for other distributions, see the CRAN task view # dedicated to probability distributions # dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) qgumbel <- function(p, a, b) a-b*log(-log(p)) fitgumbel <- fitdist(serving, "gumbel", start=list(a=10, b=10)) summary(fitgumbel) plot(fitgumbel) # (5) fit discrete distributions (Poisson and negative binomial) # data(toxocara) number <- toxocara$number fitp <- fitdist(number,"pois") summary(fitp) plot(fitp) fitnb <- fitdist(number,"nbinom") summary(fitnb) plot(fitnb) cdfcomp(list(fitp,fitnb)) gofstat(list(fitp,fitnb)) # (6) how to change the optimisation method? # data(groundbeef) serving <- groundbeef$serving fitdist(serving, "gamma", optim.method="Nelder-Mead") fitdist(serving, "gamma", optim.method="BFGS") fitdist(serving, "gamma", optim.method="SANN") # (7) custom optimization function # \dontrun{ #create the sample set.seed(1234) mysample <- rexp(100, 5) mystart <- list(rate=8) res1 <- fitdist(mysample, dexp, start= mystart, optim.method="Nelder-Mead") #show the result summary(res1) #the warning tell us to use optimise, because the Nelder-Mead is not adequate. #to meet the standard 'fn' argument and specific name arguments, we wrap optimize, myoptimize <- function(fn, par, ...) { res <- optimize(f=fn, ..., maximum=FALSE) #assume the optimization function minimize standardres <- c(res, convergence=0, value=res$objective, par=res$minimum, hessian=NA) return(standardres) } #call fitdist with a 'custom' optimization function res2 <- fitdist(mysample, "exp", start=mystart, custom.optim=myoptimize, interval=c(0, 100)) #show the result summary(res2) } # (8) custom optimization function - another example with the genetic algorithm # \dontrun{ #set a sample fit1 <- fitdist(serving, "gamma") summary(fit1) #wrap genoud function rgenoud package mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values=par, ...) standardres <- c(res, convergence=0) return(standardres) } #call fitdist with a 'custom' optimization function fit2 <- fitdist(serving, "gamma", custom.optim=mygenoud, nvars=2, Domains=cbind(c(0, 0), c(10, 10)), boundary.enforcement=1, print.level=1, hessian=TRUE) summary(fit2) } # (9) estimation of the standard deviation of a gamma distribution # by maximum likelihood with the shape fixed at 4 using the argument fix.arg # data(groundbeef) serving <- groundbeef$serving f1c <- fitdist(serving,"gamma",start=list(rate=0.1),fix.arg=list(shape=4)) summary(f1c) plot(f1c) # (10) fit of a Weibull distribution to serving size data # by maximum likelihood estimation # or by quantile matching estimation (in this example # matching first and third quartiles) # data(groundbeef) serving <- groundbeef$serving fWmle <- fitdist(serving, "weibull") summary(fWmle) plot(fWmle) gofstat(fWmle) fWqme <- fitdist(serving, "weibull", method="qme", probs=c(0.25, 0.75)) summary(fWqme) plot(fWqme) gofstat(fWqme) # (11) Fit of a Pareto distribution by numerical moment matching estimation # \dontrun{ require(actuar) #simulate a sample x4 <- rpareto(1000, 6, 2) #empirical raw moment memp <- function(x, order) mean(x^order) #fit fP <- fitdist(x4, "pareto", method="mme", order=c(1, 2), memp="memp", start=list(shape=10, scale=10), lower=1, upper=Inf) summary(fP) plot(fP) } # (12) Fit of a Weibull distribution to serving size data by maximum # goodness-of-fit estimation using all the distances available # \dontrun{ data(groundbeef) serving <- groundbeef$serving (f1 <- fitdist(serving, "weibull", method="mge", gof="CvM")) (f2 <- fitdist(serving, "weibull", method="mge", gof="KS")) (f3 <- fitdist(serving, "weibull", method="mge", gof="AD")) (f4 <- fitdist(serving, "weibull", method="mge", gof="ADR")) (f5 <- fitdist(serving, "weibull", method="mge", gof="ADL")) (f6 <- fitdist(serving, "weibull", method="mge", gof="AD2R")) (f7 <- fitdist(serving, "weibull", method="mge", gof="AD2L")) (f8 <- fitdist(serving, "weibull", method="mge", gof="AD2")) cdfcomp(list(f1, f2, f3, f4, f5, f6, f7, f8)) cdfcomp(list(f1, f2, f3, f4, f5, f6, f7, f8), xlogscale=TRUE, xlim=c(8, 250), verticals=TRUE) denscomp(list(f1, f2, f3, f4, f5, f6, f7, f8)) } # (13) Fit of a uniform distribution using maximum likelihood # (a closed formula is used in this special case where the loglikelihood is not defined), # or maximum goodness-of-fit with Cramer-von Mises or Kolmogorov-Smirnov distance # set.seed(1234) u <- runif(50, min=5, max=10) fumle <- fitdist(u, "unif", method="mle") summary(fumle) plot(fumle) gofstat(fumle) fuCvM <- fitdist(u, "unif", method="mge", gof="CvM") summary(fuCvM) plot(fuCvM) gofstat(fuCvM) fuKS <- fitdist(u, "unif", method="mge", gof="KS") summary(fuKS) plot(fuKS) gofstat(fuKS) # (14) scaling problem # the simulated dataset (below) has particularly small values, hence without scaling (10^0), # the optimization raises an error. The for loop shows how scaling by 10^i # for i=1,...,6 makes the fitting procedure work correctly. set.seed(1234) x2 <- rnorm(100, 1e-4, 2e-4) for(i in 0:6) cat(i, try(fitdist(x2*10^i, "cauchy", method="mle")$estimate, silent=TRUE), "\n") # (15) Fit of a normal distribution on acute toxicity values of endosulfan in log10 for # nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5 percent quantile value of # the fitted distribution (which is called the 5 percent hazardous concentration, HC5, # in ecotoxicology) and estimation of other quantiles. # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") quantile(fln, probs = 0.05) quantile(fln, probs = c(0.05, 0.1, 0.2)) # (16) Fit of a triangular distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # \dontrun{ set.seed(1234) require(mc2d) t <- rtriang(100, min=5, mode=6, max=10) fCvM <- fitdist(t, "triang", method="mge", start = list(min=4, mode=6,max=9), gof="CvM") fKS <- fitdist(t, "triang", method="mge", start = list(min=4, mode=6,max=9), gof="KS") cdfcomp(list(fCvM,fKS)) } # (17) fit a non classical discrete distribution (the zero inflated Poisson distribution) # \dontrun{ require(gamlss.dist) set.seed(1234) x <- rZIP(n = 30, mu = 5, sigma = 0.2) plotdist(x, discrete = TRUE) fitzip <- fitdist(x, "ZIP", start = list(mu = 4, sigma = 0.15), discrete = TRUE, optim.method = "L-BFGS-B", lower = c(0, 0), upper = c(Inf, 1)) summary(fitzip) plot(fitzip) fitp <- fitdist(x, "pois") cdfcomp(list(fitzip, fitp)) gofstat(list(fitzip, fitp)) } # (18) examples with distributions in actuar (predefined starting values) # \dontrun{ require(actuar) x <- c(2.3,0.1,2.7,2.2,0.4,2.6,0.2,1.,7.3,3.2,0.8,1.2,33.7,14., 21.4,7.7,1.,1.9,0.7,12.6,3.2,7.3,4.9,4000.,2.5,6.7,3.,63., 6.,1.6,10.1,1.2,1.5,1.2,30.,3.2,3.5,1.2,0.2,1.9,0.7,17., 2.8,4.8,1.3,3.7,0.2,1.8,2.6,5.9,2.6,6.3,1.4,0.8) #log logistic ft_llogis <- fitdist(x,'llogis') x <- c(0.3837053, 0.8576858, 0.3552237, 0.6226119, 0.4783756, 0.3139799, 0.4051403, 0.4537631, 0.4711057, 0.5647414, 0.6479617, 0.7134207, 0.5259464, 0.5949068, 0.3509200, 0.3783077, 0.5226465, 1.0241043, 0.4384580, 1.3341520) #inverse weibull ft_iw <- fitdist(x,'invweibull') } } \keyword{ distribution } fitdistrplus/man/toxocara.Rd0000644000176200001440000000220513742313702015671 0ustar liggesusers\name{toxocara} \alias{toxocara} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Parasite abundance in insular feral cats } \description{ Toxocara cati abundance in feral cats living on Kerguelen island. } \usage{ data(toxocara) } %- maybe also 'usage' for other objects documented here. \format{ \code{toxocara} is a data frame with 1 column (number: number of parasites in digestive tract) } \source{ Fromont, E., Morvilliers, L., Artois, M., Pontier, D. 2001. Parasite richness and abundance in insular and mainland feral cats. \emph{Parasitology}, \bold{123}, 143-151. } %\references{ } \examples{ # (1) load of data # data(toxocara) # (2) description and plot of data # number <- toxocara$number descdist(number,discrete=TRUE,boot=1000) plotdist(number,discrete=TRUE) # (3) fit of a Poisson distribution to data # fitp <- fitdist(number,"pois") summary(fitp) plot(fitp) # (4) fit of a negative binomial distribution to data # fitnb <- fitdist(number,"nbinom") summary(fitnb) plot(fitnb) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/mgedist.Rd0000644000176200001440000002045513742313702015514 0ustar liggesusers\name{mgedist} \alias{mgedist} \alias{mge} \title{ Maximum goodness-of-fit fit of univariate continuous distributions} \description{ Fit of univariate continuous distribution by maximizing goodness-of-fit (or minimizing distance) for non censored data. } \usage{ mgedist(data, distr, gof = "CvM", start = NULL, fix.arg = NULL, optim.method = "default", lower = -Inf, upper = Inf, custom.optim = NULL, silent = TRUE, gradient = NULL, checkstartfix=FALSE, \dots) } \arguments{ \item{data}{ A numeric vector for non censored data. } \item{distr}{ A character string \code{"name"} naming a distribution for which the corresponding quantile function \code{qname} and the corresponding density distribution \code{dname} must be classically defined. } \item{gof}{A character string coding for the name of the goodness-of-fit distance used : \code{"CvM"} for Cramer-von Mises distance, \code{"KS"} for Kolmogorov-Smirnov distance, \code{"AD"} for Anderson-Darling distance, \code{"ADR"}, \code{"ADL"}, \code{"AD2R"}, \code{"AD2L"} and \code{"AD2"} for variants of Anderson-Darling distance described by Luceno (2006).} \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). } \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated.} \item{optim.method}{ \code{"default"} or optimization method to pass to \code{\link{optim}}. } \item{lower}{ Left bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{upper}{ Right bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{custom.optim}{a function carrying the optimization.} \item{silent}{A logical to remove or show warnings when bootstraping.} \item{gradient}{A function to return the gradient of the gof distance for the \code{"BFGS"}, \code{"CG"} and \code{"L-BFGS-B"} methods. If it is \code{NULL}, a finite-difference approximation will be used.} \item{checkstartfix}{A logical to test starting and fixed values. Do not change it.} \item{\dots}{further arguments passed to the \code{\link{optim}}, \code{\link{constrOptim}} or \code{custom.optim} function.} } \details{ The \code{mgedist} function numerically maximizes goodness-of-fit, or minimizes a goodness-of-fit distance coded by the argument \code{gof}. One may use one of the classical distances defined in Stephens (1986), the Cramer-von Mises distance (\code{"CvM"}), the Kolmogorov-Smirnov distance (\code{"KS"}) or the Anderson-Darling distance (\code{"AD"}) which gives more weight to the tails of the distribution, or one of the variants of this last distance proposed by Luceno (2006). The right-tail AD (\code{"ADR"}) gives more weight only to the right tail, the left-tail AD (\code{"ADL"}) gives more weight only to the left tail. Either of the tails, or both of them, can receive even larger weights by using second order Anderson-Darling Statistics (using \code{"AD2R"}, \code{"AD2L"} or \code{"AD2"}). The optimization process is the same as \code{\link{mledist}}, see the 'details' section of that function. This function is not intended to be called directly but is internally called in \code{\link{fitdist}} and \code{\link{bootdist}}. This function is intended to be used only with continuous distributions and weighted maximum goodness-of-fit estimation is not allowed. NB: if your data values are particularly small or large, a scaling may be needed before the optimization process. See example (4). } \value{ \code{mgedist} returns a list with following components, \item{estimate}{ the parameter estimates.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error. } \item{value}{the minimal value reached for the criterion to minimize.} \item{hessian}{ a symmetric matrix computed by \code{\link{optim}} as an estimate of the Hessian at the solution found or computed in the user-supplied optimization function. } \item{optim.function}{the name of the optimization function used for maximum likelihood.} \item{optim.method}{when \code{\link{optim}} is used, the name of the algorithm used, the field \code{method} of the \code{custom.optim} function otherwise.} \item{fix.arg}{the named list giving the values of parameters of the named distribution that must kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} \item{counts}{A two-element integer vector giving the number of calls to the log-likelihood function and its gradient respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to log-likelihood function to compute a finite-difference approximation to the gradient. \code{counts} is returned by \code{\link{optim}} or the user-supplied function or set to \code{NULL}.} \item{optim.message}{A character string giving any additional information returned by the optimizer, or \code{NULL}. To understand exactly the message, see the source code.} \item{loglik}{ the log-likelihood value. } \item{gof}{ the code of the goodness-of-fit distance maximized. } } \seealso{ \code{\link{mmedist}}, \code{\link{mledist}}, \code{\link{qmedist}}, \code{\link{fitdist}} for other estimation methods. } \references{ Luceno A (2006), \emph{Fitting the generalized Pareto distribution to data using maximum goodness-of-fit estimators}. Computational Statistics and Data Analysis, 51, 904-917. Stephens MA (1986), \emph{Tests based on edf statistics}. In Goodness-of-fit techniques (D'Agostino RB and Stephens MA, eds), Marcel Dekker, New York, pp. 97-194. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) Fit of a Weibull distribution to serving size data by maximum # goodness-of-fit estimation using all the distances available # data(groundbeef) serving <- groundbeef$serving mgedist(serving, "weibull", gof="CvM") mgedist(serving, "weibull", gof="KS") mgedist(serving, "weibull", gof="AD") mgedist(serving, "weibull", gof="ADR") mgedist(serving, "weibull", gof="ADL") mgedist(serving, "weibull", gof="AD2R") mgedist(serving, "weibull", gof="AD2L") mgedist(serving, "weibull", gof="AD2") # (2) Fit of a uniform distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # set.seed(1234) u <- runif(100,min=5,max=10) mgedist(u,"unif",gof="CvM") mgedist(u,"unif",gof="KS") # (3) Fit of a triangular distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # \dontrun{ require(mc2d) set.seed(1234) t <- rtriang(100,min=5,mode=6,max=10) mgedist(t,"triang",start = list(min=4, mode=6,max=9),gof="CvM") mgedist(t,"triang",start = list(min=4, mode=6,max=9),gof="KS") } # (4) scaling problem # the simulated dataset (below) has particularly small values, hence without scaling (10^0), # the optimization raises an error. The for loop shows how scaling by 10^i # for i=1,...,6 makes the fitting procedure work correctly. set.seed(1234) x2 <- rnorm(100, 1e-4, 2e-4) for(i in 6:0) cat(i, try(mgedist(x*10^i,"cauchy")$estimate, silent=TRUE), "\n") } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/msedist.Rd0000644000176200001440000002261413750075653015540 0ustar liggesusers\name{msedist} \alias{msedist} \alias{mse} \title{Maximum spacing estimation of univariate distributions} \description{ Fit of univariate distribution by maximizing (log) spacings for non censored data. } \usage{ msedist(data, distr, phidiv="KL", power.phidiv=NULL, start = NULL, fix.arg = NULL, optim.method = "default", lower = -Inf, upper = Inf, custom.optim = NULL, weights=NULL, silent = TRUE, gradient = NULL, checkstartfix=FALSE, \dots) } \arguments{ \item{data}{ A numeric vector for non censored data. } \item{distr}{ A character string \code{"name"} naming a distribution for which the corresponding quantile function \code{qname} and the corresponding density distribution \code{dname} must be classically defined. } \item{phidiv}{A character string coding for the name of the phi-divergence used : \code{"KL"} for Kullback-Leibler information (corresponds to classic maximum spacing estimation), \code{"J"} for Jeffreys' divergence, \code{"R"} for Renyi's divergence, \code{"H"} for Hellinger distance, \code{"V"} for Vajda's measure of information, see details.} \item{power.phidiv}{If relevant, a numeric for the power used in some phi-divergence : should be \code{NULL} when \code{phidiv="KL"} or \code{phidiv="J"} , should be positive and different from 1 when \code{phidiv="R"}, should be greater or equal to 1 when \code{phidiv="H"} or \code{phidiv="V"}, see details.} \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). } \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated.} \item{optim.method}{ \code{"default"} or optimization method to pass to \code{\link{optim}}. } \item{lower}{ Left bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{upper}{ Right bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{custom.optim}{a function carrying the optimization.} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector with strictly positive integers (typically the number of occurences of each observation). If non-\code{NULL}, weighted MSE is used, otherwise ordinary MSE.} \item{silent}{A logical to remove or show warnings when bootstraping.} \item{gradient}{A function to return the gradient of the gof distance for the \code{"BFGS"}, \code{"CG"} and \code{"L-BFGS-B"} methods. If it is \code{NULL}, a finite-difference approximation will be used.} \item{checkstartfix}{A logical to test starting and fixed values. Do not change it.} \item{\dots}{further arguments passed to the \code{\link{optim}}, \code{\link{constrOptim}} or \code{custom.optim} function.} } \details{ The \code{msedist} function numerically maximizes a phi-divergence function of spacings, where spacings are the differences of the cumulative distribution function evaluated at the sorted dataset. The classical maximum spacing estimation (MSE) was introduced by Cheng and Amin (1986) and Ranneby (1984) independently where the phi-diverence is the logarithm, see Anatolyev and Kosenok (2005) for a link between MSE and maximum likelihood estimation. MSE was generalized by Ranneby and Ekstrom (1997) by allowing different phi-divergence function. Generalized MSE maximizes \deqn{ S_n(\theta)=\frac{1}{n+1}\sum_{i=1}^{n+1} \phi\left(F(x_{(i)}; \theta)-F(x_{(i-1)}; \theta) \right), }{ S_n(\theta)= sum(i=1,..,n+1; \phi(F(x_(i); \theta)-F(x_(i-1); \theta))) / (n+1), } where \eqn{F(;\theta)} is the parametric distribution function to be fitted, \eqn{\phi} is the phi-divergence function, \eqn{x_{(1)}<\dots0, \alpha\neq 1 }{ \phi(x)=x^\alpha*sign(1-\alpha) with 0<\alpha<1 or 1 <\alpha } \item Hellinger distance (when \code{phidiv="H"} and \code{power.phidiv=p}) \deqn{\phi(x)=-|1-x^{1/p}|^p \textrm{ with } p\ge 1 }{ \phi(x)=-|1-x^(1/p)|^p with p\ge 1 } \item Vajda's measure of information (when \code{phidiv="V"} and \code{power.phidiv=beta}) \deqn{\phi(x)=-|1-x|^\beta \textrm{ with } \beta\ge 1 }{ \phi(x)=-|1-x|^\beta with \beta\ge 1 } } The optimization process is the same as \code{\link{mledist}}, see the 'details' section of that function. This function is not intended to be called directly but is internally called in \code{\link{fitdist}} and \code{\link{bootdist}}. This function is intended to be used only with non-censored data. NB: if your data values are particularly small or large, a scaling may be needed before the optimization process, see \code{\link{mledist}}'s examples. } \value{ \code{msedist} returns a list with following components, \item{estimate}{ the parameter estimates.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error. } \item{value}{the minimal value reached for the criterion to minimize.} \item{hessian}{ a symmetric matrix computed by \code{\link{optim}} as an estimate of the Hessian at the solution found or computed in the user-supplied optimization function. } \item{optim.function}{the name of the optimization function used for maximum likelihood.} \item{optim.method}{when \code{\link{optim}} is used, the name of the algorithm used, the field \code{method} of the \code{custom.optim} function otherwise.} \item{fix.arg}{the named list giving the values of parameters of the named distribution that must kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} \item{counts}{A two-element integer vector giving the number of calls to the log-likelihood function and its gradient respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to log-likelihood function to compute a finite-difference approximation to the gradient. \code{counts} is returned by \code{\link{optim}} or the user-supplied function or set to \code{NULL}.} \item{optim.message}{A character string giving any additional information returned by the optimizer, or \code{NULL}. To understand exactly the message, see the source code.} \item{loglik}{ the log-likelihood value.} \item{phidiv}{The character string coding for the name of the phi-divergence used either \code{"KL"}, \code{"J"}, \code{"R"}, \code{"H"} or \code{"V"}.} \item{power.phidiv}{Either \code{NULL} or a numeric for the power used in the phi-divergence.} } \seealso{ \code{\link{mmedist}}, \code{\link{mledist}}, \code{\link{qmedist}}, \code{\link{mgedist}}, \code{\link{fitdist}} for other estimation methods. } \references{ Anatolyev, S., and Kosenok, G. (2005). \emph{An alternative to maximum likelihood based on spacings}. Econometric Theory, 21(2), 472-476. Cheng, R.C.H. and N.A.K. Amin (1983) \emph{Estimating parameters in continuous univariate distributions with a shifted origin}. Journal of the Royal Statistical Society Series B 45, 394-403. Ranneby, B. (1984) \emph{The maximum spacing method: An estimation method related to the maximum likelihood method}. Scandinavian Journal of Statistics 11, 93-112. Ranneby, B. and Ekstroem, M. (1997). \emph{Maximum spacing estimates based on different metrics}. Umea universitet. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) Fit of a Weibull distribution to serving size data by maximum # spacing estimation # data(groundbeef) serving <- groundbeef$serving msedist(serving, "weibull") # (2) Fit of an exponential distribution # set.seed(123) x1 <- rexp(1e3) #the convergence is quick msedist(x1, "exp", control=list(trace=0, REPORT=1)) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/fremale.Rd0000644000176200001440000000153114067302651015467 0ustar liggesusers\name{fremale} \alias{fremale} \docType{data} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Fictive survival dataset of a french Male population } \description{ 100 male individuals randomly taken from \code{frefictivetable} in \code{CASdatasets} package } \usage{ data(fremale) } %- maybe also 'usage' for other objects documented here. \format{ \code{fremale} is a data frame with 3 columns names \code{AgeIn}, \code{AgeOut} respectively for entry age and exit age; \code{Death} a binary dummy: 1 indicating the death of the individual; 0 a censored observation. } \references{ See full dataset \code{frefictivetable} of \code{CASdatasets} at \url{http://dutangc.perso.math.cnrs.fr/RRepository/} } \examples{ # (1) load of data # data(fremale) summary(fremale) } \keyword{ datasets }% at least one, from doc/KEYWORDS fitdistrplus/man/graphcompcens.Rd0000644000176200001440000002153613750266146016722 0ustar liggesusers\name{graphcompcens} \alias{graphcompcens} \alias{cdfcompcens} \alias{denscompcens} \alias{qqcompcens} \alias{ppcompcens} \title{Graphical comparison of multiple fitted distributions for censored data} \description{ \code{cdfcompcens} plots the empirical cumulative distribution against fitted distribution functions, \code{qqcompcens} plots theoretical quantiles against empirical ones, \code{ppcompcens} plots theoretical probabilities against empirical ones. } \usage{ cdfcompcens(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datacol, fillrect, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, lines01 = FALSE, Turnbull.confint = FALSE, NPMLE.method = "Wang", add = FALSE, plotstyle = "graphics", \dots) qqcompcens(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fillrect, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, NPMLE.method = "Wang", plotstyle = "graphics", \dots) ppcompcens(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fillrect, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, NPMLE.method = "Wang", plotstyle = "graphics", \dots) } \arguments{ \item{ft}{One \code{"fitdistcens"} object or a list of objects of class \code{"fitdistcens"}.} \item{xlim}{The \eqn{x}-limits of the plot.} \item{ylim}{The \eqn{y}-limits of the plot.} \item{xlogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{x}-axis.} \item{ylogscale}{If \code{TRUE}, uses a logarithmic scale for the \eqn{y}-axis.} \item{main}{A main title for the plot, see also \code{\link{title}}.} \item{xlab}{A label for the \eqn{x}-axis, defaults to a description of \code{x}.} \item{ylab}{A label for the \eqn{y}-axis, defaults to a description of \code{y}.} \item{datacol}{A specification of the color to be used in plotting data points.} \item{fillrect}{A specification of the color to be used for filling rectanges of non uniqueness of the empirical cumulative distribution (only used if \code{NPMLE.method} is equal to \code{"Wang"} in \code{cdfcompcens}). Fix it to \code{NA} if you do not want to fill the rectangles.} \item{fitcol}{A (vector of) color(s) to plot fitted distributions. If there are fewer colors than fits they are recycled in the standard fashion.} \item{fitlty}{A (vector of) line type(s) to plot fitted distributions. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{fitlwd}{A (vector of) line size(s) to plot fitted distributions. If there are fewer values than fits they are recycled in the standard fashion. See also \code{\link{par}}.} \item{addlegend}{If \code{TRUE}, a legend is added to the plot.} \item{legendtext}{A character or expression vector of length \eqn{\geq 1} to appear in the legend, see also \code{\link{legend}}.} \item{xlegend, ylegend}{The \eqn{x} and \eqn{y} coordinates to be used to position the legend. They can be specified by keyword. If \code{plotstyle = "graphics"}, see \code{\link{xy.coords}} and \code{\link{legend}}. If \code{plotstyle = "ggplot"}, the \code{xlegend} keyword must be one of \code{top}, \code{bottom}, \code{left}, or \code{right}. See also \code{guide_legend} in \code{ggplot2}} \item{lines01}{A logical to plot two horizontal lines at \code{h=0} and \code{h=1} for \code{cdfcompcens}.} \item{Turnbull.confint}{ if TRUE confidence intervals will be added to the Turnbull plot. In that case NPMLE.method is forced to \code{"Turnbull"}} \item{NPMLE.method}{Three NPMLE techniques are provided, \code{"Wang"}, the default one, rewritten from the package npsurv using function constrOptim from the package stats for optimisation, \code{"Turnbull.middlepoints"}, an older one which is implemented in the package survival and \code{"Turnbull.intervals"} that uses the same Turnbull algorithm from the package survival but associates an interval to each equivalence class instead of the middlepoint of this interval (see details). Only \code{"Wang"} and \code{"Turnbull.intervals"} enable the derivation of a Q-Q plot and a P-P plot.} \item{add}{If \code{TRUE}, adds to an already existing plot. If \code{FALSE}, starts a new plot. This parameter is not available when \code{plotstyle = "ggplot"}.} \item{line01}{A logical to plot an horizontal line \eqn{y=x} for \code{qqcompcens} and \code{ppcompcens}.} \item{line01col, line01lty}{Color and line type for \code{line01}. See also \code{\link{par}}.} \item{ynoise}{A logical to add a small noise when plotting empirical quantiles/probabilities for \code{qqcompcens} and \code{ppcompcens}. \code{ynoise} is only used when various fits are plotted with the \code{"graphics"} \code{plotstyle}. Facets are used instead with the \code{"ggplot"} \code{plotstyle}.} \item{plotstyle}{\code{"graphics"} or \code{"ggplot"}. If \code{"graphics"}, the display is built with \code{\link{graphics}} functions. If \code{"ggplot"}, a graphic object output is created with \code{ggplot2} functions (the \code{ggplot2} package must be installed). In \code{"cdfcompcens"}, \code{"ggplot"} graphics are only available with \code{"Wang"} NPMLE technique.} \item{\dots}{Further graphical arguments passed to graphical functions used in \code{cdfcompcens}, \code{ppcompcens} and \code{qqcompcens}.} } \details{ See details of \code{\link{plotdistcens}} for a detailed description of provided goddness-of-fit plots. } \seealso{ \code{\link{plotdistcens}}, \code{\link{survfit.formula}}, \code{\link{legend}} and \code{\link{par}}. } \references{ Turnbull BW (1974), \emph{Nonparametric estimation of a survivorship function with doubly censored data}. Journal of American Statistical Association, 69, 169-173. Wang Y (2008), \emph{Dimension-reduced nonparametric maximum likelihood computation for interval-censored data}. Computational Statistics & Data Analysis, 52, 2388-2402. Wang Y and Taylor SM (2013), \emph{Efficient computation of nonparametric survival functions via a hierarchical mixture formulation}. Statistics and Computing, 23, 713-725. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) Plot various distributions fitted to bacterial contamination data # data(smokedfish) Clog10 <- log10(smokedfish) fitsfn <- fitdistcens(Clog10,"norm") summary(fitsfn) fitsfl <- fitdistcens(Clog10,"logis") summary(fitsfl) dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) qgumbel <- function(p,a,b) a-b*log(-log(p)) fitsfg<-fitdistcens(Clog10,"gumbel",start=list(a=-3,b=3)) summary(fitsfg) # CDF plot cdfcompcens(list(fitsfn,fitsfl,fitsfg)) cdfcompcens(list(fitsfn,fitsfl,fitsfg),datacol="orange",fillrect = NA, legendtext=c("normal","logistic","Gumbel"), main="bacterial contamination fits", xlab="bacterial concentration (CFU/g)",ylab="F", xlegend = "bottom",lines01 = TRUE) # alternative Turnbull plot for the empirical cumulative distribution # (default plot of the previous versions of the package) cdfcompcens(list(fitsfn,fitsfl,fitsfg), NPMLE.method = "Turnbull.middlepoints") # customizing graphical output with ggplot2 if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcompcens <- cdfcompcens(list(fitsfn,fitsfl,fitsfg),datacol="orange",fillrect = NA, legendtext=c("normal","logistic","Gumbel"), xlab="bacterial concentration (CFU/g)",ylab="F", xlegend = "bottom",lines01 = TRUE, plotstyle = "ggplot") cdfcompcens + ggplot2::theme_minimal() + ggplot2::ggtitle("Bacterial contamination fits") } # PP plot ppcompcens(list(fitsfn,fitsfl,fitsfg)) ppcompcens(list(fitsfn,fitsfl,fitsfg), ynoise = FALSE) par(mfrow = c(2,2)) ppcompcens(fitsfn) ppcompcens(fitsfl) ppcompcens(fitsfg) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcompcens(list(fitsfn,fitsfl,fitsfg), plotstyle = "ggplot") ppcompcens(list(fitsfn,fitsfl,fitsfg), plotstyle = "ggplot", fillrect = c("lightpink", "lightblue", "lightgreen"), fitcol = c("red", "blue", "green")) } # QQ plot qqcompcens(list(fitsfn,fitsfl,fitsfg)) qqcompcens(list(fitsfn,fitsfl,fitsfg), ynoise = FALSE) par(mfrow = c(2,2)) qqcompcens(fitsfn) qqcompcens(fitsfl) qqcompcens(fitsfg) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcompcens(list(fitsfn,fitsfl,fitsfg), ynoise = FALSE, plotstyle = "ggplot") qqcompcens(list(fitsfn,fitsfl,fitsfg), ynoise = FALSE, plotstyle = "ggplot", fillrect = c("lightpink", "lightblue", "lightgreen"), fitcol = c("red", "blue", "green")) } } \keyword{distribution} fitdistrplus/man/quantile.Rd0000644000176200001440000001655214033777164015717 0ustar liggesusers\name{quantile} \alias{quantile} \alias{quantile.fitdist} \alias{quantile.fitdistcens} \alias{quantile.bootdist} \alias{quantile.bootdistcens} \alias{print.quantile.fitdist} \alias{print.quantile.fitdistcens} \alias{print.quantile.bootdist} \alias{print.quantile.bootdistcens} \title{Quantile estimation from a fitted distribution} \description{ Quantile estimation from a fitted distribution, optionally with confidence intervals calculated from the bootstrap result. } \usage{ \method{quantile}{fitdist}(x, probs = seq(0.1, 0.9, by=0.1), \dots) \method{quantile}{fitdistcens}(x, probs = seq(0.1, 0.9, by=0.1), \dots) \method{quantile}{bootdist}(x, probs = seq(0.1, 0.9, by=0.1),CI.type = "two.sided", CI.level = 0.95, \dots) \method{quantile}{bootdistcens}(x, probs = seq(0.1, 0.9, by=0.1),CI.type = "two.sided", CI.level = 0.95, \dots) \method{print}{quantile.fitdist}(x, \dots) \method{print}{quantile.fitdistcens}(x, \dots) \method{print}{quantile.bootdist}(x, \dots) \method{print}{quantile.bootdistcens}(x, \dots) } \arguments{ \item{x}{ An object of class \code{"fitdist"}, \code{"fitdistcens"}, \code{"bootdist"}, \code{"bootdistcens"} or \code{"quantile.fitdist"}, \code{"quantile.fitdistcens"}, \code{"quantile.bootdist"}, \code{"quantile.bootdistcens"} for the \code{print} generic function. } \item{probs}{ A numeric vector of probabilities with values in [0, 1] at which quantiles must be calculated.} \item{CI.type}{ Type of confidence intervals : either \code{"two.sided"} or one-sided intervals (\code{"less"} or \code{"greater"}).} \item{CI.level}{ The confidence level.} \item{\dots}{Further arguments to be passed to generic functions.} } \details{ Quantiles of the parametric distribution are calculated for each probability specified in \code{probs}, using the estimated parameters. When used with an object of class \code{"bootdist"} or \code{"bootdistcens"}, percentile confidence intervals and medians etimates are also calculated from the bootstrap result. If \code{CI.type} is \code{two.sided}, the \code{CI.level} two-sided confidence intervals of quantiles are calculated. If \code{CI.type} is \code{less} or \code{greater}, the \code{CI.level} one-sided confidence intervals of quantiles are calculated. The print functions show the estimated quantiles with percentile confidence intervals and median estimates when a bootstrap resampling has been done previously, and the number of bootstrap iterations for which the estimation converges if it is inferior to the whole number of bootstrap iterations. } \value{ \code{quantile} returns a list with 2 components (the first two described below) when called with an object of class \code{"fitdist"} or \code{"fitdistcens"} and 8 components (described below) when called with an object of class \code{"bootdist"} or \code{"bootdistcens"} : \item{quantiles}{ a dataframe containing the estimated quantiles for each probability value specified in the argument \code{probs} (one row, and as many columns as values in \code{probs}).} \item{probs}{the numeric vector of probabilities at which quantiles are calculated.} \item{bootquant }{ A data frame containing the bootstraped values for each quantile (many rows, as specified in the call to \code{\link{bootdist}} in the argument \code{niter}, and as many columns as values in \code{probs})} \item{quantCI}{ If \code{CI.type} is \code{two.sided}, the two bounds of the \code{CI.level} percent two.sided confidence interval for each quantile (two rows and as many columns as values in \code{probs}). If \code{CI.type} is \code{less}, right bound of the \code{CI.level} percent one.sided confidence interval for each quantile (one row). If \code{CI.type} is \code{greater}, left bound of the \code{CI.level} percent one.sided confidence interval for each quantile (one row). } \item{quantmedian}{Median of bootstrap estimates (per probability).} \item{CI.type}{ Type of confidence interval: either \code{"two.sided"} or one-sided intervals (\code{"less"} or \code{"greater"}).} \item{CI.level}{ The confidence level.} \item{nbboot}{ The number of samples drawn by bootstrap.} \item{nbconverg}{ The number of iterations for which the optimization algorithm converges.} } \seealso{ \code{\link{fitdist}}, \code{\link{bootdist}}, \code{\link{fitdistcens}}, \code{\link{bootdistcens}} and \code{\link{CIcdfplot}}. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) Fit of a normal distribution on acute toxicity log-transformed values of # endosulfan for nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5, 10 and 20 percent quantile # values of the fitted distribution, which are called the 5, 10, 20 percent hazardous # concentrations (HC5, HC10, HC20) in ecotoxicology, followed with calculations of their # confidence intervals with various definitions, from a small number of bootstrap # iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") quantile(fln, probs = c(0.05, 0.1, 0.2)) bln <- bootdist(fln, bootmethod="param", niter=101) quantile(bln, probs = c(0.05, 0.1, 0.2)) quantile(bln, probs = c(0.05, 0.1, 0.2), CI.type = "greater") quantile(bln, probs = c(0.05, 0.1, 0.2), CI.level = 0.9) # (2) Draw of 95 percent confidence intervals on quantiles of the # previously fitted distribution # cdfcomp(fln) q1 <- quantile(bln, probs = seq(0,1,length=101)) points(q1$quantCI[1,],q1$probs,type="l") points(q1$quantCI[2,],q1$probs,type="l") # (2b) Draw of 95 percent confidence intervals on quantiles of the # previously fitted distribution # using the NEW function CIcdfplot # CIcdfplot(bln, CI.output = "quantile", CI.fill = "pink") # (3) Fit of a distribution on acute salinity log-transformed tolerance # for riverine macro-invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5, 10 and 20 percent quantile # values of the fitted distribution, which are called the 5, 10, 20 percent hazardous # concentrations (HC5, HC10, HC20) in ecotoxicology, followed with calculations of # their confidence intervals with various definitions. # from a small number of bootstrap iterations to satisfy CRAN running times constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # data(salinity) log10LC50 <-log10(salinity) flncens <- fitdistcens(log10LC50,"norm") quantile(flncens, probs = c(0.05, 0.1, 0.2)) blncens <- bootdistcens(flncens, niter = 101) quantile(blncens, probs = c(0.05, 0.1, 0.2)) quantile(blncens, probs = c(0.05, 0.1, 0.2), CI.type = "greater") quantile(blncens, probs = c(0.05, 0.1, 0.2), CI.level = 0.9) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/mledist.Rd0000644000176200001440000003250213750075653015526 0ustar liggesusers\name{mledist} \alias{mledist} \alias{mle} \title{ Maximum likelihood fit of univariate distributions} \description{ Fit of univariate distributions using maximum likelihood for censored or non censored data. } \usage{ mledist(data, distr, start = NULL, fix.arg = NULL, optim.method = "default", lower = -Inf, upper = Inf, custom.optim = NULL, weights = NULL, silent = TRUE, gradient = NULL, checkstartfix=FALSE, \dots) } \arguments{ \item{data}{ A numeric vector for non censored data or a dataframe of two columns respectively named \code{left} and \code{right}, describing each observed value as an interval for censored data. In that case the \code{left} column contains either \code{NA} for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The \code{right} column contains either \code{NA} for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. } \item{distr}{ A character string \code{"name"} naming a distribution for which the corresponding density function \code{dname} and the corresponding distribution function \code{pname} must be classically defined. } \item{start}{A named list giving the initial values of parameters of the named distribution or a function of data computing initial values and returning a named list. This argument may be omitted (default) for some distributions for which reasonable starting values are computed (see details). } \item{fix.arg}{An optional named list giving the values of fixed parameters of the named distribution or a function of data computing (fixed) parameter values and returning a named list. Parameters with fixed value are thus NOT estimated by this maximum likelihood procedure.} \item{optim.method}{ \code{"default"} (see details) or an optimization method to pass to \code{\link{optim}}. } \item{lower}{Left bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{upper}{ Right bounds on the parameters for the \code{"L-BFGS-B"} method (see \code{\link{optim}}). } \item{custom.optim}{a function carrying the MLE optimisation (see details).} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector with strictly positive integers (typically the number of occurences of each observation). If non-\code{NULL}, weighted MLE is used, otherwise ordinary MLE.} \item{silent}{A logical to remove or show warnings when bootstraping.} \item{gradient}{A function to return the gradient of the log-likelihood for the \code{"BFGS"}, \code{"CG"} and \code{"L-BFGS-B"} methods. If it is \code{NULL}, a finite-difference approximation will be used, see details.} \item{checkstartfix}{A logical to test starting and fixed values. Do not change it.} \item{\dots}{further arguments passed to the \code{\link{optim}}, \code{\link{constrOptim}} or \code{custom.optim} function.} } \details{ This function is not intended to be called directly but is internally called in \code{\link{fitdist}} and \code{\link{bootdist}} when used with the maximum likelihood method and \code{\link{fitdistcens}} and \code{\link{bootdistcens}}. It is assumed that the \code{distr} argument specifies the distribution by the probability density function and the cumulative distribution function (d, p). The quantile function and the random generator function (q, r) may be needed by other function such as \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}}, \code{\link{fitdist}},\code{\link{fitdistcens}}, \code{\link{bootdistcens}} and \code{\link{bootdist}}. For the following named distributions, reasonable starting values will be computed if \code{start} is omitted (i.e. \code{NULL}) : \code{"norm"}, \code{"lnorm"}, \code{"exp"} and \code{"pois"}, \code{"cauchy"}, \code{"gamma"}, \code{"logis"}, \code{"nbinom"} (parametrized by mu and size), \code{"geom"}, \code{"beta"}, \code{"weibull"} from the \code{stats} package; \code{"invgamma"}, \code{"llogis"}, \code{"invweibull"}, \code{"pareto1"}, \code{"pareto"}, \code{"lgamma"}, \code{"trgamma"}, \code{"invtrgamma"} from the \code{actuar} package. Note that these starting values may not be good enough if the fit is poor. The function uses a closed-form formula to fit the uniform distribution. If \code{start} is a list, then it should be a named list with the same names as in the d,p,q,r functions of the chosen distribution. If \code{start} is a function of data, then the function should return a named list with the same names as in the d,p,q,r functions of the chosen distribution. The \code{mledist} function allows user to set a fixed values for some parameters. As for \code{start}, if \code{fix.arg} is a list, then it should be a named list with the same names as in the d,p,q,r functions of the chosen distribution. If \code{fix.arg} is a function of data, then the function should return a named list with the same names as in the d,p,q,r functions of the chosen distribution. When \code{custom.optim=NULL} (the default), maximum likelihood estimations of the distribution parameters are computed with the R base \code{\link{optim}} or \code{\link{constrOptim}}. If no finite bounds (\code{lower=-Inf} and \code{upper=Inf}) are supplied, \code{\link{optim}} is used with the method specified by \code{optim.method}. Note that \code{optim.method="default"} means \code{optim.method="Nelder-Mead"} for distributions with at least two parameters and \code{optim.method="BFGS"} for distributions with only one parameter. If finite bounds are supplied (among \code{lower} and \code{upper}) and \code{gradient != NULL}, \code{\link{constrOptim}} is used. If finite bounds are supplied (among \code{lower} and \code{upper}) and \code{gradient == NULL}, \code{\link{constrOptim}} is used when \code{optim.method="Nelder-Mead"}; \code{\link{optim}} is used when \code{optim.method="L-BFGS-B"} or \code{"Brent"}; in other case, an error is raised (same behavior as \code{\link{constrOptim}}). When errors are raised by \code{\link{optim}}, it's a good idea to start by adding traces during the optimization process by adding \code{control=list(trace=1, REPORT=1)}. If \code{custom.optim} is not \code{NULL}, then the user-supplied function is used instead of the R base \code{\link{optim}}. The \code{custom.optim} must have (at least) the following arguments \code{fn} for the function to be optimized, \code{par} for the initialized parameters. Internally the function to be optimized will also have other arguments, such as \code{obs} with observations and \code{ddistname} with distribution name for non censored data (Beware of potential conflicts with optional arguments of \code{custom.optim}). It is assumed that \code{custom.optim} should carry out a MINIMIZATION. Finally, it should return at least the following components \code{par} for the estimate, \code{convergence} for the convergence code, \code{value} for \code{fn(par)}, \code{hessian}, \code{counts} for the number of calls (function and gradient) and \code{message} (default to \code{NULL}) for the error message when \code{custom.optim} raises an error, see the returned value of \code{\link{optim}}. See examples in \code{\link{fitdist}} and \code{\link{fitdistcens}}. Optionally, a vector of \code{weights} can be used in the fitting process. By default (when \code{weigths=NULL}), ordinary MLE is carried out, otherwise the specified weights are used to balance the log-likelihood contributions. It is not yet possible to take into account weights in functions \code{plotdist}, \code{plotdistcens}, \code{plot.fitdist}, \code{plot.fitdistcens}, \code{cdfcomp}, \code{cdfcompcens}, \code{denscomp}, \code{ppcomp}, \code{qqcomp}, \code{gofstat}, \code{descdist}, \code{bootdist}, \code{bootdistcens} and \code{mgedist}. (developments planned in the future). NB: if your data values are particularly small or large, a scaling may be needed before the optimization process. See Example (7). } \value{ \code{mledist} returns a list with following components, \item{estimate}{ the parameter estimates.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}}/\code{\link{constrOptim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error. } \item{value}{the minimal value reached for the criterion to minimize.} \item{hessian}{a symmetric matrix computed by \code{\link{optim}} as an estimate of the Hessian at the solution found or computed in the user-supplied optimization function. It is used in \code{fitdist} to estimate standard errors. } \item{optim.function}{the name of the optimization function used for maximum likelihood.} \item{optim.method}{when \code{\link{optim}} is used, the name of the algorithm used, the field \code{method} of the \code{custom.optim} function otherwise.} \item{fix.arg}{the named list giving the values of parameters of the named distribution that must kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} \item{counts}{A two-element integer vector giving the number of calls to the log-likelihood function and its gradient respectively. This excludes those calls needed to compute the Hessian, if requested, and any calls to log-likelihood function to compute a finite-difference approximation to the gradient. \code{counts} is returned by \code{\link{optim}} or the user-supplied function or set to \code{NULL}.} \item{optim.message}{A character string giving any additional information returned by the optimizer, or \code{NULL}. To understand exactly the message, see the source code.} \item{loglik}{the log-likelihood value.} \item{method}{\code{"closed formula"} if appropriate otherwise \code{NULL}.} } \seealso{ \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}}, \code{\link{fitdist}},\code{\link{fitdistcens}} for other estimation methods, \code{\link{optim}}, \code{\link{constrOptim}} for optimization routines, \code{\link{bootdistcens}} and \code{\link{bootdist}} for bootstrap, and \code{\link{llplot}} for plotting the (log)likelihood. } \references{ Venables WN and Ripley BD (2002), \emph{Modern applied statistics with S}. Springer, New York, pp. 435-446. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) basic fit of a normal distribution with maximum likelihood estimation # set.seed(1234) x1 <- rnorm(n=100) mledist(x1,"norm") # (2) defining your own distribution functions, here for the Gumbel distribution # for other distributions, see the CRAN task view dedicated to probability distributions dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) mledist(x1,"gumbel",start=list(a=10,b=5)) # (3) fit of a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=30,lambda = 2) mledist(x2,"pois") # (4) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=100,shape1=5, shape2=10) mledist(x3,"beta") # (5) fit frequency distributions on USArrests dataset. # x4 <- USArrests$Assault mledist(x4, "pois") mledist(x4, "nbinom") # (6) fit a continuous distribution (Gumbel) to censored data. # data(fluazinam) log10EC50 <-log10(fluazinam) # definition of the Gumbel distribution dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) qgumbel <- function(p,a,b) a-b*log(-log(p)) mledist(log10EC50,"gumbel",start=list(a=0,b=2),optim.method="Nelder-Mead") # (7) scaling problem # the simulated dataset (below) has particularly small values, # hence without scaling (10^0), # the optimization raises an error. The for loop shows how scaling by 10^i # for i=1,...,6 makes the fitting procedure work correctly. set.seed(1234) x2 <- rnorm(100, 1e-4, 2e-4) for(i in 6:0) cat(i, try(mledist(x*10^i, "cauchy")$estimate, silent=TRUE), "\n") # (17) small example for the zero-modified geometric distribution # dzmgeom <- function(x, p1, p2) p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) #pdf x2 <- c(2, 4, 0, 40, 4, 21, 0, 0, 0, 2, 5, 0, 0, 13, 2) #simulated dataset initp1 <- function(x) list(p1=mean(x == 0)) #init as MLE mledist(x2, "zmgeom", fix.arg=initp1, start=list(p2=1/2)) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/danish.Rd0000644000176200001440000000432313742313702015322 0ustar liggesusers\name{danish} \alias{danish} \alias{danishuni} \alias{danishmulti} \docType{data} \title{ Danish reinsurance claim dataset } \description{ The univariate dataset was collected at Copenhagen Reinsurance and comprise 2167 fire losses over the period 1980 to 1990. They have been adjusted for inflation to reflect 1985 values and are expressed in millions of Danish Krone. The multivariate data set is the same data as above but the total claim has been divided into a building loss, a loss of contents and a loss of profits. } \usage{ data(danishuni) data(danishmulti) } \format{ \code{danishuni} contains two columns: \describe{ \item{\code{Date}}{The day of claim occurence.} \item{\code{Loss}}{The total loss amount in millions of Danish Krone (DKK).} } \code{danishmulti} contains five columns: \describe{ \item{\code{Date}}{The day of claim occurence.} \item{\code{Building}}{The loss amount (mDKK) of the building coverage.} \item{\code{Contents}}{The loss amount (mDKK) of the contents coverage.} \item{\code{Profits}}{The loss amount (mDKK) of the profit coverage.} \item{\code{Total}}{The total loss amount (mDKK).} } All columns are numeric except Date columns of class Date. } \source{ Embrechts, P., Kluppelberg, C. and Mikosch, T. (1997) \emph{Modelling Extremal Events for Insurance and Finance}. Berlin: Springer. } \references{ Dataset used in McNeil (1996), \emph{Estimating the Tails of Loss Severity Distributions using Extreme Value Theory}, ASTIN Bull. Davison, A. C. (2003) \emph{Statistical Models}. Cambridge University Press. Page 278. } \examples{ # (1) load of data # data(danishuni) # (2) plot and description of data # plotdist(danishuni$Loss) # (3) load of data # data(danishmulti) # (4) plot and description of data # idx <- sample(1:NROW(danishmulti), 10) barplot(danishmulti$Building[idx], col = "grey25", ylim = c(0, max(danishmulti$Total[idx])), main = "Some claims of danish data set") barplot(danishmulti$Content[idx], add = TRUE, col = "grey50", axes = FALSE) barplot(danishmulti$Profits[idx], add = TRUE, col = "grey75", axes = FALSE) legend("topleft", legend = c("Building", "Content", "Profits"), fill = c("grey25", "grey50", "grey75")) } \keyword{datasets} fitdistrplus/man/plotdist.Rd0000644000176200001440000001257213742313702015723 0ustar liggesusers\name{plotdist} \alias{plotdist} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plot of empirical and theoretical distributions for non-censored data} \description{ Plots an empirical distribution (non-censored data) with a theoretical one if specified. } \usage{ plotdist(data, distr, para, histo = TRUE, breaks = "default", demp = FALSE, discrete, \dots) } \arguments{ \item{data}{ A numeric vector. } \item{distr}{ A character string \code{"name"} naming a distribution for which the corresponding density function \code{dname}, the corresponding distribution function \code{pname} and the corresponding quantile function \code{qname} must be defined, or directly the density function. This argument may be omitted only if \code{para} is omitted. } \item{para}{ A named list giving the parameters of the named distribution. This argument may be omitted only if \code{distr} is omitted. } \item{histo}{A logical to plot the histogram using the \code{\link{hist}} function.} \item{breaks}{ If \code{"default"} the histogram is plotted with the function \code{hist} with its default breaks definition. Else \code{breaks} is passed to the function \code{hist}. This argument is not taken into account if \code{discrete} is \code{TRUE}. } \item{demp}{A logical to plot the empirical density on the first plot (alone or superimposed on the histogram depending of the value of the argument \code{histo}) using the \code{\link{density}} function.} \item{discrete}{ If TRUE, the distribution is considered as discrete. If both \code{distr} and \code{discrete} are missing, \code{discrete} is set to \code{FALSE}. If \code{discrete} is missing but not \code{distr}, \code{discrete} is set to \code{TRUE} when \code{distr} belongs to \code{"binom"}, \code{"nbinom"},\code{"geom"}, \code{"hyper"} or \code{"pois"}. } \item{\dots}{ further graphical arguments passed to graphical functions used in plotdist.} } \details{ Empirical and, if specified, theoretical distributions are plotted in density and in cdf. For the plot in density, the user can use the arguments \code{histo} and \code{demp} to specify if he wants the histogram using the function \code{\link{hist}}, the density plot using the function \code{\link{density}}, or both (at least one of the two arguments must be put to \code{"TRUE"}). For continuous distributions, the function \code{\link{hist}} is used with its default breaks definition if \code{breaks} is \code{"default"} or passing \code{breaks} as an argument if it differs from \code{"default"}. For continuous distribution and when a theoretical distribution is specified by both arguments \code{distname} and \code{para}, Q-Q plot (plot of the quantiles of the theoretical fitted distribution (x-axis) against the empirical quantiles of the data) and P-P plot (i.e. for each value of the data set, plot of the cumulative density function of the fitted distribution (x-axis) against the empirical cumulative density function (y-axis)) are also given (Cullen and Frey, 1999). The function \code{\link{ppoints}} (with default parameter for argument a) is used for the Q-Q plot, to generate the set of probabilities at which to evaluate the inverse distribution. NOTE THAT FROM VERSION 0.4-3, \code{\link{ppoints}} is also used for P-P plot and cdf plot for continuous data. To personalize the four plots proposed for continuous data, for example to change the plotting position, we recommend the use of functions \code{\link{cdfcomp}}, \code{\link{denscomp}}, \code{\link{qqcomp}} and \code{\link{ppcomp}}. } \seealso{ \code{\link{graphcomp}}, \code{\link{descdist}}, \code{\link{hist}}, \code{\link{plot}}, \code{\link{plotdistcens}} and \code{\link{ppoints}}. } \references{ Cullen AC and Frey HC (1999), \emph{Probabilistic techniques in exposure assessment}. Plenum Press, USA, pp. 81-155. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } %\note{ } \examples{ # (1) Plot of an empirical distribution with changing # of default line types for CDF and colors # and optionally adding a density line # set.seed(1234) x1 <- rnorm(n=30) plotdist(x1) plotdist(x1,demp = TRUE) plotdist(x1,histo = FALSE, demp = TRUE) plotdist(x1, col="blue", type="b", pch=16) plotdist(x1, type="s") # (2) Plot of a discrete distribution against data # set.seed(1234) x2 <- rpois(n=30, lambda = 2) plotdist(x2, discrete=TRUE) plotdist(x2, "pois", para=list(lambda = mean(x2))) plotdist(x2, "pois", para=list(lambda = mean(x2)), lwd="2") # (3) Plot of a continuous distribution against data # xn <- rnorm(n=100, mean=10, sd=5) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn))) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn)), pch=16) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn)), demp = TRUE) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn)), histo = FALSE, demp = TRUE) # (4) Plot of serving size data # data(groundbeef) plotdist(groundbeef$serving, type="s") # (5) Plot of numbers of parasites with a Poisson distribution data(toxocara) number <- toxocara$number plotdist(number, discrete = TRUE) plotdist(number,"pois",para=list(lambda=mean(number))) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/bootdist.Rd0000644000176200001440000002256113742313702015707 0ustar liggesusers\name{bootdist} \alias{bootdist} \alias{plot.bootdist} \alias{print.bootdist} \alias{summary.bootdist} \title{ Bootstrap simulation of uncertainty for non-censored data} \description{ Uses parametric or nonparametric bootstrap resampling in order to simulate uncertainty in the parameters of the distribution fitted to non-censored data. } \usage{ bootdist(f, bootmethod = "param", niter = 1001, silent = TRUE, parallel = c("no", "snow", "multicore"), ncpus) \method{print}{bootdist}(x, \dots) \method{plot}{bootdist}(x, main = "Bootstrapped values of parameters", enhance = FALSE, trueval = NULL, rampcol = NULL, nbgrid = 100, nbcol = 100, \dots) \method{summary}{bootdist}(object, \dots) } \arguments{ \item{f}{ An object of class \code{"fitdist"}, output of the \code{\link{fitdist}} function.} \item{bootmethod}{ A character string coding for the type of resampling : \code{"param"} for a parametric resampling and \code{"nonparam"} for a nonparametric resampling of data.} \item{niter}{ The number of samples drawn by bootstrap. } \item{silent}{A logical to remove or show warnings and errors when bootstraping.} \item{parallel}{The type of parallel operation to be used, \code{"snow"} or \code{"multicore"} (the second one not being available on Windows), or \code{"no"} if no parallel operation.} \item{ncpus}{Number of processes to be used in parallel operation : typically one would fix it to the number of available CPUs.} \item{x}{ An object of class \code{"bootdist"}. } \item{object}{ An object of class \code{"bootdist"}. } \item{main}{an overall title for the plot: see \code{\link{title}}, default to \code{"Bootstrapped values of parameters"}.} \item{enhance}{a logical to get an enhanced plot.} \item{trueval}{when relevant, a numeric vector with the true value of parameters (for backfitting purposes).} \item{rampcol}{colors to interpolate; must be a valid argument to \code{\link[grDevices]{colorRampPalette}()}.} \item{nbgrid}{Number of grid points in each direction. Can be scalar or a length-2 integer vector.} \item{nbcol}{an integer argument, the required number of colors} \item{\dots}{ Further arguments to be passed to generic methods } } \details{ Samples are drawn by parametric bootstrap (resampling from the distribution fitted by \code{\link{fitdist}}) or nonparametric bootstrap (resampling with replacement from the data set). On each bootstrap sample the function \code{\link{mledist}} (or \code{\link{mmedist}}, \code{\link{qmedist}}, \code{\link{mgedist}} according to the component \code{f$method} of the object of class \code{"fitdist"}) is used to estimate bootstrapped values of parameters. When that function fails to converge, \code{NA} values are returned. Medians and 2.5 and 97.5 percentiles are computed by removing \code{NA} values. The medians and the 95 percent confidence intervals of parameters (2.5 and 97.5 percentiles) are printed in the summary. If inferior to the whole number of iterations, the number of iterations for which the function converges is also printed in the summary. By default (when \code{enhance=FALSE}), the plot of an object of class \code{"bootdist"} consists in a scatterplot or a matrix of scatterplots of the bootstrapped values of parameters. It uses the function \code{\link{stripchart}} when the fitted distribution is characterized by only one parameter, the function \code{\link{plot}} when there are two paramters and the function \code{\link{pairs}} in other cases. In these last cases, it provides a representation of the joint uncertainty distribution of the fitted parameters. When \code{enhance=TRUE}, a personalized plot version of \code{\link{pairs}} is used where upper graphs are scatterplots and lower graphs are heatmap image using \code{\link{image}} based on a kernel based estimator for the 2D density function (using \code{kde2d} from MASS package). Arguments \code{rampcol}, \code{nbgrid}, \code{nbcol} can be used to customize the plots. Defautls values are \code{rampcol=c("green", "yellow", "orange", "red")}, \code{nbcol=100} (see \code{\link[grDevices]{colorRampPalette}()}), \code{nbgrid=100} (see \code{kde2d}). In addition, when fitting parameters on simulated datasets for backtesting purposes, an additional argument \code{trueval} can be used to plot a cross at the true value. It is possible to accelerate the bootstrap using parallelization. We recommend you to use \code{parallel = "multicore"}, or \code{parallel = "snow"} if you work on Windows, and to fix \code{ncpus} to the number of available processors. } \value{ \code{bootdist} returns an object of class \code{"bootdist"}, a list with 6 components, \item{estim}{ a data frame containing the bootstrapped values of parameters.} \item{converg}{ a vector containing the codes for convergence obtained if an iterative method is used to estimate parameters on each bootstraped data set (and 0 if a closed formula is used).} \item{method}{ A character string coding for the type of resampling : \code{"param"} for a parametric resampling and \code{"nonparam"} for a nonparametric resampling. } \item{nbboot}{ The number of samples drawn by bootstrap.} \item{CI}{ bootstrap medians and 95 percent confidence percentile intervals of parameters. } \item{fitpart}{ The object of class \code{"fitdist"} on which the bootstrap procedure was applied.} Generic functions: \describe{ \item{\code{print}}{ The print of a \code{"bootdist"} object shows the bootstrap parameter estimates. If inferior to the whole number of bootstrap iterations, the number of iterations for which the estimation converges is also printed. } \item{\code{summary}}{ The summary provides the median and 2.5 and 97.5 percentiles of each parameter. If inferior to the whole number of bootstrap iterations, the number of iterations for which the estimation converges is also printed in the summary. } \item{\code{plot}}{ The plot shows the bootstrap estimates with \code{\link{stripchart}} function for univariate parameters and \code{\link{plot}} function for multivariate parameters. } } } \seealso{ See \code{\link{fitdistrplus}} for an overview of the package. \code{\link{fitdist}}, \code{\link{mledist}}, \code{\link{qmedist}}, \code{\link{mmedist}}, \code{\link{mgedist}}, \code{\link{quantile.bootdist}} for another generic function to calculate quantiles from the fitted distribution and its bootstrap results and \code{\link{CIcdfplot}} for adding confidence intervals on quantiles to a CDF plot of the fitted distribution. } \references{ Cullen AC and Frey HC (1999), \emph{Probabilistic techniques in exposure assessment}. Plenum Press, USA, pp. 181-241. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # We choose a low number of bootstrap replicates in order to satisfy CRAN running times # constraint. # For practical applications, we recommend to use at least niter=501 or niter=1001. # (1) Fit of a gamma distribution to serving size data # using default method (maximum likelihood estimation) # followed by parametric bootstrap # data(groundbeef) x1 <- groundbeef$serving f1 <- fitdist(x1, "gamma") b1 <- bootdist(f1, niter=51) print(b1) plot(b1) plot(b1, enhance=TRUE) summary(b1) quantile(b1) CIcdfplot(b1, CI.output = "quantile") # (2) non parametric bootstrap on the same fit # b1b <- bootdist(f1, bootmethod="nonparam", niter=51) summary(b1b) quantile(b1b) # (3) Fit of a normal distribution on acute toxicity values of endosulfan in log10 for # nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5 percent quantile value of # the fitted distribution, what is called the 5 percent hazardous concentration (HC5) # in ecotoxicology, with its two-sided 95 percent confidence interval calculated by # parametric bootstrap # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") bln <- bootdist(fln, bootmethod = "param", niter=51) quantile(bln, probs = c(0.05, 0.1, 0.2)) # (4) comparison of sequential and parallel versions of bootstrap # to be tried with a greater number of iterations (1001 or more) # \dontrun{ niter <- 1001 data(groundbeef) x1 <- groundbeef$serving f1 <- fitdist(x1, "gamma") # sequential version ptm <- proc.time() summary(bootdist(f1, niter = niter)) proc.time() - ptm # parallel version using snow require(parallel) ptm <- proc.time() summary(bootdist(f1, niter = niter, parallel = "snow", ncpus = 4)) proc.time() - ptm # parallel version using multicore (not available on Windows) ptm <- proc.time() summary(bootdist(f1, niter = niter, parallel = "multicore", ncpus = 4)) proc.time() - ptm } } \keyword{ distribution }fitdistrplus/man/fitdistcens.Rd0000644000176200001440000003114013742313702016370 0ustar liggesusers\name{fitdistcens} \alias{fitdistcens} \alias{plot.fitdistcens} \alias{print.fitdistcens} \alias{summary.fitdistcens} \alias{logLik.fitdistcens} \alias{vcov.fitdistcens} \alias{coef.fitdistcens} \title{Fitting of univariate distributions to censored data} \description{ Fits a univariate distribution to censored data by maximum likelihood. } \usage{ fitdistcens(censdata, distr, start=NULL, fix.arg=NULL, keepdata = TRUE, keepdata.nb=100, \dots) \method{print}{fitdistcens}(x, \dots) \method{plot}{fitdistcens}(x, \dots) \method{summary}{fitdistcens}(object, \dots) \method{logLik}{fitdistcens}(object, \dots) \method{vcov}{fitdistcens}(object, \dots) \method{coef}{fitdistcens}(object, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{censdata}{ A dataframe of two columns respectively named \code{left} and \code{right}, describing each observed value as an interval. The \code{left} column contains either \code{NA} for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The \code{right} column contains either \code{NA} for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. } \item{distr}{ A character string \code{"name"} naming a distribution, for which the corresponding density function \code{dname} and the corresponding distribution function \code{pname} must be defined, or directly the density function.} \item{start}{ A named list giving the initial values of parameters of the named distribution. This argument may be omitted for some distributions for which reasonable starting values are computed (see the 'details' section of \code{\link{mledist}}). } \item{fix.arg}{ An optional named list giving the values of parameters of the named distribution that must be kept fixed rather than estimated by maximum likelihood. } \item{x}{ an object of class \code{"fitdistcens"}. } \item{object}{ an object of class \code{"fitdistcens"}. } \item{keepdata}{a logical. If \code{TRUE}, dataset is returned, otherwise only a sample subset is returned.} \item{keepdata.nb}{When \code{keepdata=FALSE}, the length of the subset returned.} \item{\dots}{ further arguments to be passed to generic functions, to the function \code{plotdistcens} in order to control the type of ecdf-plot used for censored data, or to the function \code{mledist} in order to control the optimization method.} } \details{ Maximum likelihood estimations of the distribution parameters are computed using the function \code{\link{mledist}}. By default direct optimization of the log-likelihood is performed using \code{\link{optim}}, with the "Nelder-Mead" method for distributions characterized by more than one parameter and the "BFGS" method for distributions characterized by only one parameter. The algorithm used in \code{\link{optim}} can be chosen or another optimization function can be specified using \dots argument (see \code{\link{mledist}} for details). \code{start} may be omitted (i.e. \code{NULL}) for some classic distributions (see the 'details' section of \code{\link{mledist}}). Note that when errors are raised by \code{optim}, it's a good idea to start by adding traces during the optimization process by adding \code{control=list(trace=1, REPORT=1)} in \dots argument. The function is not able to fit a uniform distribution. With the parameter estimates, the function returns the log-likelihood and the standard errors of the estimates calculated from the Hessian at the solution found by \code{optim} or by the user-supplied function passed to mledist. By default (\code{keepdata = TRUE}), the object returned by \code{fitdist} contains the data vector given in input. When dealing with large datasets, we can remove the original dataset from the output by setting \code{keepdata = FALSE}. In such a case, only \code{keepdata.nb} points (at most) are kept by random subsampling \code{keepdata.nb}-4 points from the dataset and adding the component-wise minimum and maximum. If combined with \code{\link{bootdistcens}}, be aware that bootstrap is performed on the subset randomly selected in \code{fitdistcens}. Currently, the graphical comparisons of multiple fits is not available in this framework. Weighted version of the estimation process is available for \code{method = "mle"} by using \code{weights=\dots}. See the corresponding man page for details. It is not yet possible to take into account weighths in functions plotdistcens, plot.fitdistcens and cdfcompcens (developments planned in the future). } \value{ \code{fitdistcens} returns an object of class \code{"fitdistcens"}, a list with the following components: \item{estimate}{ the parameter estimates.} \item{method}{ the character string coding for the fitting method : only \code{"mle"} for 'maximum likelihood estimation'.} \item{sd}{ the estimated standard errors.} \item{cor}{ the estimated correlation matrix, \code{NA} if numerically not computable or \code{NULL} if not available.} \item{vcov}{ the estimated variance-covariance matrix, \code{NULL} if not available.} \item{loglik}{ the log-likelihood.} \item{aic}{ the Akaike information criterion.} \item{bic}{ the the so-called BIC or SBC (Schwarz Bayesian criterion).} \item{censdata}{ the censored data set.} \item{distname}{ the name of the distribution.} \item{fix.arg}{ the named list giving the values of parameters of the named distribution that must be kept fixed rather than estimated by maximum likelihood or \code{NULL} if there are no such parameters. } \item{fix.arg.fun}{the function used to set the value of \code{fix.arg} or \code{NULL}.} \item{dots}{ the list of further arguments passed in \dots to be used in \code{bootdistcens} to control the optimization method used in iterative calls to \code{mledist} or \code{NULL} if no such arguments.} \item{convergence}{ an integer code for the convergence of \code{\link{optim}}/\code{\link{constrOptim}} defined as below or defined by the user in the user-supplied optimization function. \code{0} indicates successful convergence. \code{1} indicates that the iteration limit of \code{\link{optim}} has been reached. \code{10} indicates degeneracy of the Nealder-Mead simplex. \code{100} indicates that \code{\link{optim}} encountered an internal error.} \item{discrete}{always \code{FALSE}.} \item{weights}{the vector of weigths used in the estimation process or \code{NULL}.} Generic functions: \describe{ \item{\code{print}}{ The print of a \code{"fitdist"} object shows few traces about the fitting method and the fitted distribution. } \item{\code{summary}}{ The summary provides the parameter estimates of the fitted distribution, the log-likelihood, AIC and BIC statistics, the standard errors of the parameter estimates and the correlation matrix between parameter estimates. } \item{\code{plot}}{ The plot of an object of class \code{"fitdistcens"} returned by \code{fitdistcens} uses the function \code{\link{plotdistcens}}. } \item{\code{logLik}}{ Extracts the estimated log-likelihood from the \code{"fitdistcens"} object. } \item{\code{vcov}}{ Extracts the estimated var-covariance matrix from the \code{"fitdistcens"} object (only available When \code{method = "mle"}). } \item{\code{coef}}{ Extracts the fitted coefficients from the \code{"fitdistcens"} object. } } } \seealso{ See \code{\link{fitdistrplus}} for an overview of the package. \code{\link{plotdistcens}}, \code{\link{optim}}, \code{\link{mledist}}, \code{\link{fitdist}} and \code{\link{quantile.fitdistcens}} for another generic function to calculate quantiles from the fitted distribution. } \references{ Venables WN and Ripley BD (2002), \emph{Modern applied statistics with S}. Springer, New York, pp. 435-446. Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } %\note{ } \examples{ # (1) Fit of a lognormal distribution to bacterial contamination data # data(smokedfish) fitsf <- fitdistcens(smokedfish,"lnorm") summary(fitsf) # default plot using the Wang technique (see ?plotdiscens for details) plot(fitsf) # plot using the Turnbull algorithm (see ?plotdiscens for details) # with confidence intervals for the empirical distribution plot(fitsf, NPMLE = TRUE, NPMLE.method = "Turnbull", Turnbull.confint = TRUE) # basic plot using intervals and points (see ?plotdiscens for details) plot(fitsf, NPMLE = FALSE) # plot of the same fit using the Turnbull algorithm in logscale cdfcompcens(fitsf,main="bacterial contamination fits", xlab="bacterial concentration (CFU/g)",ylab="F", addlegend = FALSE,lines01 = TRUE, xlogscale = TRUE, xlim = c(1e-2,1e2)) # zoom on large values of F cdfcompcens(fitsf,main="bacterial contamination fits", xlab="bacterial concentration (CFU/g)",ylab="F", addlegend = FALSE,lines01 = TRUE, xlogscale = TRUE, xlim = c(1e-2,1e2),ylim=c(0.4,1)) # (2) Fit of a normal distribution on acute toxicity values # of fluazinam (in decimal logarithm) for # macroinvertebrates and zooplancton, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology # data(fluazinam) log10EC50 <-log10(fluazinam) fln <- fitdistcens(log10EC50,"norm") fln summary(fln) plot(fln) # (3) defining your own distribution functions, here for the Gumbel distribution # for other distributions, see the CRAN task view dedicated to # probability distributions # dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) qgumbel <- function(p,a,b) a-b*log(-log(p)) fg <- fitdistcens(log10EC50,"gumbel",start=list(a=1,b=1)) summary(fg) plot(fg) # (4) comparison of fits of various distributions # fll <- fitdistcens(log10EC50,"logis") summary(fll) cdfcompcens(list(fln,fll,fg),legendtext=c("normal","logistic","gumbel"), xlab = "log10(EC50)") # (5) how to change the optimisation method? # fitdistcens(log10EC50,"logis",optim.method="Nelder-Mead") fitdistcens(log10EC50,"logis",optim.method="BFGS") fitdistcens(log10EC50,"logis",optim.method="SANN") # (6) custom optimisation function - example with the genetic algorithm # \dontrun{ #wrap genoud function rgenoud package mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values=par, ...) standardres <- c(res, convergence=0) return(standardres) } # call fitdistcens with a 'custom' optimization function fit.with.genoud <- fitdistcens(log10EC50,"logis", custom.optim=mygenoud, nvars=2, Domains=cbind(c(0,0), c(5, 5)), boundary.enforcement=1, print.level=1, hessian=TRUE) summary(fit.with.genoud) } # (7) estimation of the mean of a normal distribution # by maximum likelihood with the standard deviation fixed at 1 using the argument fix.arg # flnb <- fitdistcens(log10EC50, "norm", start = list(mean = 1),fix.arg = list(sd = 1)) # (8) Fit of a lognormal distribution on acute toxicity values of fluazinam for # macroinvertebrates and zooplancton, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5 percent quantile value of # the fitted distribution (which is called the 5 percent hazardous concentration, HC5, # in ecotoxicology) and estimation of other quantiles. data(fluazinam) log10EC50 <-log10(fluazinam) fln <- fitdistcens(log10EC50,"norm") quantile(fln, probs = 0.05) quantile(fln, probs = c(0.05, 0.1, 0.2)) # (9) Fit of a lognormal distribution on 72-hour acute salinity tolerance (LC50 values) # of riverine macro-invertebrates using maximum likelihood estimation data(salinity) log10LC50 <-log10(salinity) fln <- fitdistcens(log10LC50,"norm") plot(fln) } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/Surv2fitdistcens.Rd0000644000176200001440000001230514075737424017347 0ustar liggesusers\name{Surv2fitdistcens} \alias{Surv2fitdistcens} \title{Handling of data formated as in the survival package for use in fitdistcens()} \description{ Provide a function to prepare a data frame needed by fitdistcens() from data classically coded when using the Surv() function of the survival package } \usage{ Surv2fitdistcens(time, time2, event, type=c('right', 'left', 'interval', 'interval2')) } \arguments{ \item{time}{for right censored data, this is the follow up time. For interval data, the first argument is the starting time for the interval.} \item{event}{The status indicator, normally \code{0}=alive, \code{1}=dead. Other choices are \code{TRUE/FALSE} (\code{TRUE} = death) or \code{1/2} (\code{2}=death). For interval censored data, the status indicator is \code{0}=right censored, \code{1}=event at time, \code{2}=left censored, \code{3}=interval censored. For factor data, assume that it has only two levels with the second level coding death.} \item{time2}{ending time of the interval for interval censored. Intervals are assumed to be open on the left and closed on the right, (start, end].} \item{type}{character string specifying the type of censoring. Possible values are \code{"right"}, \code{"left"}, \code{"interval"}, \code{"interval2"}.} } \details{ \code{Surv2fitdistcens} makes a \code{data.frame} with two columns respectively named \code{left} and \code{right}, describing each observed value as an interval as required in fitdistcens(): the \code{left} column contains either \code{NA} for left-censored observations, the left bound of the interval for interval-censored observations, or the observed value for non-censored observations. The right column contains either \code{NA} for right-censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. } \value{ \code{Surv2fitdistcens} returns a data.frame with two columns respectively named \code{left} and \code{right}. } \seealso{ See \code{\link{fitdistrplus}} for an overview of the package. See \code{\link{fitdistcens}} for fitting of univariate distributions to censored data and \code{\link{fremale}} for the full dataset used in examples below. See \code{\link[survival:Surv]{Surv}} for survival objects which use the same arguments. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Christophe Dutang and Marie-Laure Delignette-Muller. } %\note{ } \examples{ # (1) randomized fictive survival data - right-censored # origdata <- data.frame(rbind( c( 43.01, 55.00, 0), c( 36.37, 47.17, 0), c( 33.10, 34.51, 0), c( 71.00, 81.15, 1), c( 80.89, 81.91, 1), c( 67.81, 78.48, 1), c( 73.98, 76.92, 1), c( 53.19, 54.80, 1))) colnames(origdata) <- c("AgeIn", "AgeOut", "Death") # add of follow-up time (for type = "right" in Surv()) origdata$followuptime <- origdata$AgeOut - origdata$AgeIn origdata ### use of default survival type "right" # in Surv() survival::Surv(time = origdata$followuptime, event = origdata$Death, type = "right") # for fitdistcens() Surv2fitdistcens(origdata$followuptime, event = origdata$Death, type = "right") # use of survival type "interval" # in Surv() survival::Surv(time = origdata$followuptime, time2 = origdata$followuptime, event = origdata$Death, type = "interval") # for fitdistcens() Surv2fitdistcens(time = origdata$followuptime, time2 = origdata$followuptime, event = origdata$Death, type = "interval") # use of survival type "interval2" origdata$survivalt1 <- origdata$followuptime origdata$survivalt2 <- origdata$survivalt1 origdata$survivalt2[1:3] <- Inf origdata survival::Surv(time = origdata$survivalt1, time2 = origdata$survivalt2, type = "interval2") Surv2fitdistcens(origdata$survivalt1, time2 = origdata$survivalt2, type = "interval2") # (2) Other examples with various left, right and interval censored values # # with left censored data (d1 <- data.frame(time = c(2, 5, 3, 7), ind = c(0, 1, 1, 1))) survival::Surv(time = d1$time, event = d1$ind, type = "left") Surv2fitdistcens(time = d1$time, event = d1$ind, type = "left") (d1bis <- data.frame(t1 = c(2, 5, 3, 7), t2 = c(2, 5, 3, 7), censtype = c(2, 1, 1, 1))) survival::Surv(time = d1bis$t1, time2 = d1bis$t2, event = d1bis$censtype, type = "interval") Surv2fitdistcens(time = d1bis$t1, time2 = d1bis$t2, event = d1bis$censtype, type = "interval") # with interval, left and right censored data (d2 <- data.frame(t1 = c(-Inf, 2, 3, 4, 3, 7), t2 = c(2, 5, 3, 7, 8, Inf))) survival::Surv(time = d2$t1, time2 = d2$t2, type = "interval2") Surv2fitdistcens(time = d2$t1, time2 = d2$t2, type = "interval2") (d2bis <- data.frame(t1 = c(2, 2, 3, 4, 3, 7), t2 = c(2, 5, 3, 7, 8, 7), censtype = c(2,3,1,3,3,0))) survival::Surv(time = d2bis$t1, time2 = d2bis$t2, event = d2bis$censtype, type = "interval") Surv2fitdistcens(time = d2bis$t1, time2 = d2bis$t2, event = d2bis$censtype, type = "interval") } \keyword{ distribution }% at least one, from doc/KEYWORDS fitdistrplus/man/logLik-surface.Rd0000644000176200001440000001142113742313702016720 0ustar liggesusers\name{logLiksurface} \alias{llsurface} \alias{llcurve} \title{(Log)likelihood surfaces or (log)likelihood curves} \description{ \code{llsurface} plots the likelihood surface for distributions with two or more parameters, \code{llcurve} plots the likelihood curve for distributions with one or more parameters. } \usage{ llsurface(data, distr, plot.arg, min.arg, max.arg, lseq = 50, fix.arg = NULL, loglik = TRUE, back.col = TRUE, nlev = 10, pal.col = terrain.colors(100), weights = NULL, \dots) llcurve(data, distr, plot.arg, min.arg, max.arg, lseq = 50, fix.arg = NULL, loglik = TRUE, weights = NULL, \dots) } \arguments{ \item{data}{A numeric vector for non censored data or a dataframe of two columns respectively named left and right, describing each observed value as an interval for censored data. In that case the left column contains either NA for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either NA for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations.} \item{distr}{A character string "name" naming a distribution for which the corresponding density function dname and the corresponding distribution function pname must be classically defined.} \item{plot.arg}{a two-element vector with the names of the two parameters that will vary for \code{llsurface}, only one element for \code{llcurve}.} \item{min.arg}{a two-element vector with lower plotting bounds for \code{llsurface}, only one element for \code{llcurve}.} \item{max.arg}{a two-element vector with upper plotting bounds for \code{llsurface}, only one element for \code{llcurve}.} \item{lseq}{length of sequences of parameters.} \item{fix.arg}{a named list with fixed value of other parameters.} \item{loglik}{a logical to plot log-likelihood or likelihood function.} \item{back.col}{logical (for llsurface only). Contours are plotted with a background gradient of colors if TRUE.} \item{nlev}{number of contour levels to plot (for llsurface only).} \item{pal.col}{Palette of colors. Colors to be used as back (for llsurface only).} \item{weights}{an optional vector of weights to be used in the fitting process. Should be \code{NULL} or a numeric vector with strictly positive values (classically the number of occurences of each observation).} \item{\dots}{Further graphical arguments passed to graphical functions.} } \details{ These two function are not intended to be called directly but is internally called in \code{\link{llplot}}. \code{llsurface} plots the likelihood surface for distributions with two varying parameters and other parameters fixed. When \code{back.col}, \code{\link{image}} (2D-plot) is used. When \code{nlev > 0}, \code{\link{contour}} (2D-plot) is used to add \code{nlev} contours. \code{llcurve} plots the likelihood curve for distributions with one varying parameter and other parameters fixed. } \seealso{ See \code{\link{llplot}} for an automatic (log)likelihood plots (surface ou curve) of an object of class \code{"fitdist"} or \code{"fitdistcens"} and \code{\link{plot}}, \code{\link{contour}}, \code{\link{image}} for classic plotting functions. } \references{ Delignette-Muller ML and Dutang C (2015), \emph{fitdistrplus: An R Package for Fitting Distributions}. Journal of Statistical Software, 64(4), 1-34. } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } \examples{ # (1) loglikelihood or likelihood curve # n <- 100 set.seed(1234) x <- rexp(n) llcurve(data = x, distr = "exp", plot.arg = "rate", min.arg = 0, max.arg = 4) llcurve(data = x, distr = "exp", plot.arg = "rate", min.arg = 0, max.arg = 4, loglik = FALSE) llcurve(data = x, distr = "exp", plot.arg = "rate", min.arg = 0, max.arg = 4, main = "log-likelihood for exponential distribution", col = "red") abline(v = 1, lty = 2) # (2) loglikelihood surface # x <- rnorm(n, 0, 1) llsurface(data =x, distr="norm", plot.arg=c("mean", "sd"), min.arg=c(-1, 0.5), max.arg=c(1, 3/2), back.col = FALSE, main="log-likelihood for normal distribution") llsurface(data =x, distr="norm", plot.arg=c("mean", "sd"), min.arg=c(-1, 0.5), max.arg=c(1, 3/2), main="log-likelihood for normal distribution", nlev = 20, pal.col = heat.colors(100),) points(0, 1, pch="+", col="red") llsurface(data =x, distr="norm", plot.arg=c("mean", "sd"), min.arg=c(-1, 0.5), max.arg=c(1, 3/2), main="log-likelihood for normal distribution", nlev = 0, back.col = TRUE, pal.col = rainbow(100, s = 0.5, end = 0.8)) points(0, 1, pch="+", col="black") } \keyword{ distribution } fitdistrplus/man/fitdistrplus.Rd0000644000176200001440000000740214067272020016607 0ustar liggesusers\name{fitdistrplus-package} \alias{fitdistrplus} \alias{fitdistrplus-package} \title{Overview of the \pkg{fitdistrplus} package} \description{ The idea of this package emerged in 2008 from a collaboration between JB Denis, R Pouillot and ML Delignette who at this time worked in the area of quantitative risk assessment. The implementation of this package was a part of a more general project named "Risk assessment with R" gathering different packages and hosted in \href{https://r-forge.r-project.org/projects/riskassessment/}{R-forge}. The \pkg{fitdistrplus} package was first written by ML Delignette-Muller and made available in \href{https://cran.r-project.org/package=fitdistrplus}{CRAN} on 2009 and presented at the \href{https://www.r-project.org/conferences/useR-2009/}{2009 useR conference} in Rennes. A few months after, C Dutang joined the project by starting to participate to the implementation of the \pkg{fitdistrplus} package. The package has also been presented at the \href{https://www.r-project.org/conferences/useR-2011/}{2011 useR conference} and at the 2eme rencontres R in 2013 (https://r2013-lyon.sciencesconf.org/). Three vignettes are available within the package: \itemize{ \item a \href{../doc/paper2JSS.pdf}{general overview} of the package published in the \href{https://www.jstatsoft.org/article/view/v064i04}{Journal of Statistical Software}, \item a html document answering the most \href{../doc/FAQ.html}{Frequently Asked Questions}, \item a html document presenting a \href{../doc/Optimalgo.html}{benchmark of optimization algorithms} when finding parameters. } The \pkg{fitdistrplus} package is a general package that aims at helping the fit of univariate parametric distributions to censored or non-censored data. The two main functions are \code{\link{fitdist}} for fit on non-censored data and \code{\link{fitdistcens}} for fit on censored data. The choice of candidate distributions to fit may be helped using functions \code{\link{descdist}} and \code{\link{plotdist}} for non-censored data and \code{\link{plotdistcens}} for censored data). Using functions \code{\link{fitdist}} and \code{\link{fitdistcens}}, different methods can be used to estimate the distribution parameters: \itemize{ \item maximum likelihood estimation by default (\code{\link{mledist}}), \item moment matching estimation (\code{\link{mmedist}}), \item quantile matching estimation (\code{\link{qmedist}}), \item maximum goodness-of-fit estimation (\code{\link{mgedist}}). } For classical distributions initial values are automatically calculated if not provided by the user. Graphical functions \code{\link{plotdist}} and \code{\link{plotdistcens}} can be used to help a manual calibration of initial values for parameters of non-classical distributions. Function \code{\link{prefit}} is proposed to help the definition of good starting values in the special case of constrained parameters. In the case where maximum likelihood is chosen as the estimation method, function \code{\link{llplot}} enables to visualize loglikelihood contours. The goodness-of-fit of fitted distributions (a single fit or multiple fits) can be explored using different graphical functions (\code{\link{cdfcomp}}, \code{\link{denscomp}}, \code{\link{qqcomp}} and \code{\link{ppcomp}} for non-censored data and \code{\link{cdfcompcens}} for censored data). Goodness-of-fit statistics are also provided for non-censored data using function \code{\link{gofstat}}. Bootstrap is proposed to quantify the uncertainty on parameter estimates (functions \code{\link{bootdist}} and \code{\link{bootdistcens}}) and also to quantify the uncertainty on CDF or quantiles estimated from the fitted distribution (\code{\link{quantile}} and \code{\link{CIcdfplot}}). } \author{ Marie-Laure Delignette-Muller and Christophe Dutang. } fitdistrplus/DESCRIPTION0000644000176200001440000000431714124575145014531 0ustar liggesusersPackage: fitdistrplus Title: Help to Fit of a Parametric Distribution to Non-Censored or Censored Data Version: 1.1-6 Authors@R: c(person("Marie-Laure", "Delignette-Muller", role = "aut", email = "marielaure.delignettemuller@vetagro-sup.fr"), person("Christophe", "Dutang", role = "aut", email = "christophe.dutang@ensimag.fr"), person("Regis", "Pouillot", role = "ctb"), person("Jean-Baptiste", "Denis", role = "ctb"), person("Aurelie", "Siberchicot", role = c("aut", "cre"), email = "aurelie.siberchicot@univ-lyon1.fr")) Description: Extends the fitdistr() function (of the MASS package) with several functions to help the fit of a parametric distribution to non-censored or censored data. Censored data may contain left censored, right censored and interval censored values, with several lower and upper bounds. In addition to maximum likelihood estimation (MLE), the package provides moment matching (MME), quantile matching (QME), maximum goodness-of-fit estimation (MGE) and maximum spacing estimation (MSE) methods (available only for non-censored data). Weighted versions of MLE, MME, QME and MSE are available. See e.g. Casella & Berger (2002), Statistical inference, Pacific Grove, for a general introduction to parametric estimation. Depends: R (>= 3.5.0), MASS, grDevices, survival, methods Imports: stats Suggests: actuar, rgenoud, mc2d, gamlss.dist, knitr, ggplot2, GeneralizedHyperbolic, rmarkdown, Hmisc VignetteBuilder: knitr BuildVignettes: true License: GPL (>= 2) Encoding: UTF-8 URL: https://lbbe.univ-lyon1.fr/fr/fitdistrplus, https://github.com/aursiber/fitdistrplus BugReports: https://github.com/aursiber/fitdistrplus/issues Contact: Marie-Laure Delignette-Muller or Christophe Dutang NeedsCompilation: no Packaged: 2021-09-28 10:38:11 UTC; siberchicot Author: Marie-Laure Delignette-Muller [aut], Christophe Dutang [aut], Regis Pouillot [ctb], Jean-Baptiste Denis [ctb], Aurelie Siberchicot [aut, cre] Maintainer: Aurelie Siberchicot Repository: CRAN Date/Publication: 2021-09-28 11:20:05 UTC fitdistrplus/build/0000755000176200001440000000000014124570223014105 5ustar liggesusersfitdistrplus/build/vignette.rds0000644000176200001440000000051014124570223016440 0ustar liggesusers}R9O0vPԍTe"jbX$Ee`1}ޕ) q02j47|LU.;iD^l6ɚ=T0]B WQr\cNrLߑuA[ARPs+r¯R@DKALUK M."#Lqiq :Fr]Y(8ә8oS)?(C7`f1% 1NiA _N GK"yƷdWsiB+6҇ywHS{dkh \" fitdistrplus/tests/0000755000176200001440000000000014076514245014160 5ustar liggesusersfitdistrplus/tests/t-logLik-vcov-coef.R0000644000176200001440000000076413742313702017653 0ustar liggesuserslibrary(fitdistrplus) # (1) basic fit of a gamma distribution by maximum likelihood estimation # data(groundbeef) serving <- groundbeef$serving fitg <- fitdist(serving, "gamma") logLik(fitg) vcov(fitg) coef(fitg) fitg <- fitdist(serving, "gamma", method="mme") logLik(fitg) vcov(fitg) coef(fitg) # (2) Fit of a lognormal distribution to bacterial contamination data # data(smokedfish) fitsf <- fitdistcens(smokedfish,"lnorm") logLik(fitsf) vcov(fitsf) coef(fitsf) fitdistrplus/tests/t-plotdistcens.R0000644000176200001440000000430713742313702017255 0ustar liggesuserslibrary(fitdistrplus) # (1) Plot of an empirical censored distribution (censored data) as a CDF # using the default Turnbull method # data(smokedfish) plotdistcens(smokedfish) d1 <- as.data.frame(log10(smokedfish)) plotdistcens(d1) # (2) Add the CDF of a normal distribution and QQ and PP plots # plotdistcens(smokedfish,"lnorm", para=list(meanlog=-3.6,sdlog=3.5)) plotdistcens(d1,"norm", para=list(mean=-1.6,sd=1.5)) # (3) Various plots of the same empirical distribution # # default Wang plot plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Wang") plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Wang", lwd = 3, main = "Wang ECDF plot") # Turnbull plot plotdistcens(d1, NPMLE = TRUE, NPMLE.method = "Turnbull", col = "red", main = "Turnbull ECDF plot") plotdistcens(d1,Turnbull = TRUE) # deprecated way to do it # Turnbull plot with confidence intervals plotdistcens(d1,NPMLE = TRUE, NPMLE.method = "Turnbull", Turnbull.confint = TRUE) plotdistcens(d1,Turnbull = TRUE,Turnbull.confint = TRUE) # deprecated way to do it # with intervals and points plotdistcens(d1,NPMLE = FALSE) plotdistcens(d1,NPMLE = FALSE, col = "red", lwd = 2) plotdistcens(d1,rightNA=3, NPMLE = FALSE) plotdistcens(d1,rightNA=3, Turnbull = FALSE) # deprecated way to do it # with intervals and points # defining a minimum value for left censored values plotdistcens(d1,leftNA=-3, NPMLE = FALSE) # (4) Goodness-of-fit plots for the same dataset after logarithmic transformation # with a lognormal distribution, successively using the three proposed methods # d3 <- smokedfish plotdistcens(d3,"lnorm",para=list(meanlog=-3.6,sdlog=3.5), main = "Wang plot") plotdistcens(d3,"lnorm",para=list(meanlog=-3.6,sdlog=3.5), NPMLE.method = "Turnbull", main = "Turnbull plot") plotdistcens(d3,"lnorm",para=list(meanlog=-3.6,sdlog=3.5), NPMLE = FALSE, leftNA=0, main = "Plot of ordered intervals") # Test with the salinity data set # data(salinity) log10LC50 <-log10(salinity) plotdistcens(log10LC50) plotdistcens(log10LC50, NPMLE.method = "Turnbull") plotdistcens(log10LC50, NPMLE = FALSE) fn <- fitdistcens(log10LC50,"norm") fl <- fitdistcens(log10LC50,"logis") plot(fn) plot(fl) fitdistrplus/tests/t-llplot.R0000644000176200001440000000374613742313702016056 0ustar liggesusersrequire(fitdistrplus) visualize <- FALSE # TRUE for manual tests with visualization of results nsample <- 10000 nsample <- 10 # (1) tests with the Burr distribution (three parameters) # if(any(installed.packages()[, "Package"] == "actuar")) { require(actuar) data(endosulfan) ATV <-endosulfan$ATV library("actuar") fBurr <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) llplot(fBurr) fBurr2 <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1), fix.arg = list(rate = 1.5)) llplot(fBurr2) fBurr3 <- fitdist(ATV, "burr", start = list(shape1 = 0.3, rate = 1), fix.arg = list(shape2 = 1.5)) llplot(fBurr3) } # (2) An example on discrete data with or without weights # set.seed(1234) x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) f1 <- fitdist(x, "pois") f2 <- fitdist(xval, "pois", weights = xtab) f1$estimate f2$estimate # should give the same llplot(f1, fit.show = TRUE) llplot(f2, fit.show = TRUE) # should give the same llplot(f1, loglik = FALSE, fit.show = TRUE) llplot(f2, loglik = FALSE,fit.show = TRUE) # should give the same # (3) An example on censored data with or without weights # if(visualize) { data(salinity) salinity.unique <- unique(salinity) string.unique <- paste(salinity.unique$left, salinity.unique$right) string.salinity <- paste(salinity$left, salinity$right) nobs <- nrow(salinity.unique) salinity.weights <- numeric(nobs) for (i in 1:nobs) { salinity.weights[i] <- length(which(string.salinity == string.unique[i])) } cbind(salinity.unique, salinity.weights) (fa <- fitdistcens(salinity, "lnorm")) (fb <- fitdistcens(salinity.unique, "lnorm", weights = salinity.weights)) llplot(fa, fit.show = TRUE) llplot(fb, fit.show = TRUE) # should give the same llplot(fa, fit.show = TRUE, loglik = FALSE) llplot(fb, fit.show = TRUE, loglik = FALSE) # should give the same }fitdistrplus/tests/t-qqcomp.R0000644000176200001440000001745114050660542016046 0ustar liggesuserslibrary(fitdistrplus) # ?qqcomp visualize <- FALSE # TRUE for manual tests with visualization of results nsample <- 1000 nsample <- 10 # (1) Plot various distributions fitted to serving size data # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving, "weibull") fitln <- fitdist(serving, "lnorm") fitg <- fitdist(serving, "gamma") #sanity checks try(qqcomp("list(fitW, fitln, fitg)"), silent = TRUE) try(qqcomp(list(fitW, fitln, fitg, a = 1)), silent = TRUE) #real call qqcomp(list(fitW, fitln, fitg)) qqcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "Theo.", ylab = "serving sizes (g)", xlim = c(0, 250)) qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlogscale=TRUE) qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", ylogscale=TRUE) qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", ylim=c(1, 250), xlim=c(1, 250), fitpch=c("+", "-", ".")) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(fitW, fitln, fitg), plotstyle = "ggplot") } if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlim = c(0,250), plotstyle = "ggplot") qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlogscale=TRUE, plotstyle = "ggplot") qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", ylogscale=TRUE, plotstyle = "ggplot") qqcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", ylim=c(1, 250), xlim=c(1, 250), fitpch=c("+", "-", "."), plotstyle = "ggplot") } # (2) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # data(endosulfan) ATV <-subset(endosulfan, group == "NonArthroInvert")$ATV flnMGEKS <- fitdist(ATV,"lnorm",method="mge",gof="KS") flnMGEAD <- fitdist(ATV,"lnorm",method="mge",gof="AD") flnMGEADL <- fitdist(ATV,"lnorm",method="mge",gof="ADL") flnMGEAD2L <- fitdist(ATV,"lnorm",method="mge",gof="AD2L") llfit <- list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L) qqcomp(llfit, main="fits of a lognormal dist. using various GOF dist.") qqcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L")) qqcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2")) qqcomp(llfit, ynoise=FALSE, xlogscale=TRUE, ylogscale=TRUE, xlim=c(10,100000), ylim=c(10,100000)) qqcomp(flnMGEKS, xlogscale=TRUE, xlim=c(10,100000)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { qqcomp(llfit, main="fits of a lognormal dist. using various GOF dist.", plotstyle = "ggplot") qqcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), plotstyle = "ggplot") qqcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), plotstyle = "ggplot") qqcomp(llfit, ynoise=FALSE, xlogscale=TRUE, ylogscale=TRUE, xlim=c(10,100000), ylim=c(10,100000), plotstyle = "ggplot") qqcomp(flnMGEKS, xlogscale=TRUE, xlim=c(10,100000), plotstyle = "ggplot") } # (3) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # if (visualize) { x1 <- c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4,13.2,8.4,6.3,8.9,5.2,10.9,14.4) n1 <- length(x1) dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) qgumbel <- function(p, a, b) a - b*log(-log(p)) f1 <- mledist(x1, "norm") f2 <- mledist(x1, "gumbel", start = list(a = 10, b = 5)) f3 <- mledist(x1, "exp") xx1 <- qnorm(1:n1/n1, f1$estimate[1], f1$estimate[2]) xx2 <- qgumbel(1:n1/n1, f2$estimate[1], f2$estimate[2]) xx3 <- qexp(1:n1/n1, f3$estimate[1]) xlim <- c(xx1, xx2, xx3) xlim <- range(xlim[which(is.finite(xlim))]) # graph 1 plot(xx1, sort(x1), col="red", xlim = xlim) points(xx2, sort(x1), col = "green") points(xx3, sort(x1), col = "blue") legend("bottomright", pch = 1, leg = c("Normal","Gumbel","Exp"), col = c("red", "green", "blue")) # graph 2 f1 <- fitdist(x1,"norm") f2 <- fitdist(x1,"gumbel",start=list(a=10,b=5)) f3 <- fitdist(x1, "exp") qqcomp(list(f1, f2, f3), fitcol=c("red","green","blue"), ynoise = FALSE, legendtext = c("Normal","Gumbel","Exp")) # graph 3 if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2, f3), fitcol=c("red","green","blue"), ynoise = FALSE, legendtext = c("Normal","Gumbel","Exp"), plotstyle = "gg") } } # (4) normal mixture # #mixture of two normal distributions #density dnorm2 <- function(x, poid, m1, s1, m2, s2) poid*dnorm(x, m1, s1) + (1-poid)*dnorm(x, m2, s2) #numerical approximate quantile function qnorm2 <- function(p, poid, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, poid, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-1000, 1000), prob=pr)$minimum) } #distribution function pnorm2 <- function(q, poid, m1, s1, m2, s2) poid*pnorm(q, m1, s1) + (1-poid)*pnorm(q, m2, s2) #basic normal distribution set.seed(1234) x2 <- c(rnorm(nsample, 5), rnorm(nsample, 10)) #MLE fit fit1 <- fitdist(x2, "norm2", "mle", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0)) fit2 <- fitdist(x2, "norm2", "qme", probs=c(1/6, 1/4, 1/3, 1/2, 2/3), start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) fit3 <- fitdist(x2, "norm2", "mge", gof="AD", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) qqcomp(list(fit1, fit2, fit3), fitpch=rep(".", 3), fitcol=c("green", "red", "blue")) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { qqcomp(list(fit1, fit2, fit3), fitpch=rep(".", 3), fitcol=c("green", "red", "blue"), plotstyle = "gg") } # (5) large data # { n <- 2e4 # n <- 1e2 x <- rlnorm(n) f1 <- fitdist(x, "lnorm") f2 <- fitdist(x, "exp") qqcomp(list(f1, f2), fitpch=2) qqcomp(list(f1, f2), fitlwd=4) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2), fitpch=2, plotstyle = "gg") qqcomp(list(f1, f2), fitlwd=2, plotstyle = "gg") } } # (6) test legend labels # if (visualize) { serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitW2 <- fitdist(serving,"weibull", method="qme", probs=c(1/3,2/3)) fitW3 <- fitdist(serving,"weibull", method="qme", probs=c(1/2,2/3)) fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") qqcomp(list(fitW, fitln, fitg)) #distrib qqcomp(list(fitW, fitW2, fitln, fitg)) #distrib+method qqcomp(list(fitW, fitW2, fitW3, fitln, fitg)) #distrib+method+num if (requireNamespace ("ggplot2", quietly = TRUE)) qqcomp(list(fitW, fitW2, fitW3, fitln, fitg), plotstyle = "ggplot") #distrib+method+num } fitdistrplus/tests/t-weird-ppcomp-cens.R0000644000176200001440000000760513742313702020102 0ustar liggesuserslibrary(fitdistrplus) visualize <- FALSE # TRUE for manual tests with visualization of results set.seed(123) n <- 20 if (visualize) { # (1) test ppcomp/ppcompcens on a good example # x <- rlnorm(n, 0, 1) dx <- data.frame(left=x, right=x) dx$right[1:(n/2)*2] <- NA dx$left[2:(n/4)*4-1] <- NA f1 <- fitdist(x, "lnorm") f1c <- fitdistcens(dx, "lnorm") f3 <- fitdist(x, "lnorm", fix.arg=list(sdlog=1)) f3c <- fitdistcens(dx, "lnorm", fix.arg=list(sdlog=1)) par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(f1) ppcompcens(f1c) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(f1, plotstyle = "ggplot") ppcompcens(f1c, plotstyle = "ggplot") } #test log-scale par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(f1, xlogscale = TRUE, ylogscale = TRUE) ppcompcens(f1c, xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1)) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(f1, xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") ppcompcens(f1c, xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") } # (2) test ppcomp/ppcompcens on a weird example # f2 <- fitdist(x, "unif") f2c <- fitdistcens(dx, "unif") par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(list(f1, f2, f3)) ppcompcens(list(f1c, f2c, f3c)) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2, f3), plotstyle = "ggplot") ppcompcens(list(f1c, f2c, f3c), plotstyle = "ggplot") } #test log-scale par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1)) ppcompcens(list(f1c, f2c, f3c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1)) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") ppcompcens(list(f1c, f2c, f3c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") } #test y noise par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(list(f1, f2, f3)) ppcomp(list(f1, f2, f3), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2, f3), plotstyle = "ggplot") ppcomp(list(f1, f2, f3), ynoise=FALSE, plotstyle = "ggplot") } par(mfrow=1:2, mar=c(4,4,2,1)) ppcompcens(list(f1c, f2c, f3c)) ppcompcens(list(f1c, f2c, f3c), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcompcens(list(f1c, f2c, f3c), ynoise=FALSE, plotstyle = "ggplot") } #test log-scale y-noise par(mfrow=1:2, mar=c(4,4,2,1)) ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1)) ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") ppcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") } par(mfrow=1:2, mar=c(4,4,2,1)) ppcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1)) ppcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") ppcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, xlim=c(.1, 1), ylim=c(.1, 1), plotstyle = "ggplot") } }fitdistrplus/tests/t-manageparam.R0000644000176200001440000000335613742313702017016 0ustar liggesuserslibrary(fitdistrplus) manageparam <- fitdistrplus:::manageparam obs1 <- rnorm(10) s1 <- NULL s2 <- list("mean"=2, "sd"=3) s3 <- function(x) list("mean"=1.01*mean(x)) s4 <- list("mean"=1) f1 <- NULL f2 <- list("sd"=3) f3 <- function(x) list("sd"=1.01*sd(x)) f4 <- list("toto"=2) #no error manageparam(s1, f1, obs1, "norm") manageparam(s2, f1, obs1, "norm") manageparam(s3, f1, obs1, "norm") manageparam(s1, f2, obs1, "norm") manageparam(s1, f3, obs1, "norm") #raise error try(manageparam(matrix(3), f1, obs1, "norm")) try(manageparam(function(x) c("a"=33), f1, obs1, "norm")) try(manageparam(function(x) list(33), f1, obs1, "norm")) try(manageparam(NULL, list(mean=1, sd=1), obs1, "norm")) #no error checkparamlist <- fitdistrplus:::checkparamlist myformal <- names(formals("dnorm")) res <- manageparam(s1, f1, obs1, "norm") checkparamlist(res$start.arg, res$fix.arg, myformal) res <- manageparam(s1, f2, obs1, "norm") checkparamlist(res$start.arg, res$fix.arg, myformal) res <- manageparam(s1, f3, obs1, "norm") checkparamlist(res$start.arg, res$fix.arg, myformal) res <- manageparam(s2, f1, obs1, "norm") checkparamlist(res$start.arg, res$fix.arg, myformal) #raise errors res <- manageparam(s1, f4, obs1, "norm") try(checkparamlist(res$start.arg, res$fix.arg, myformal)) res <- manageparam(s2, f2, obs1, "norm") try(checkparamlist(res$start.arg, res$fix.arg, myformal)) res <- manageparam(s2, f3, obs1, "norm") try(checkparamlist(res$start.arg, res$fix.arg, myformal)) #no error fitdist(obs1, "norm", start=NULL, fix.arg=NULL) fitdist(obs1, "norm", start=NULL, fix.arg=f3) #raise error try(fitdist(obs1, "norm", start=NULL, fix.arg=f4)) try(fitdist(obs1, "norm", start=s2, fix.arg=f2)) try(fitdist(obs1, "norm", start=s2, fix.arg=f3)) fitdistrplus/tests/t-mledist-paramsupport.R0000644000176200001440000000307614050660542020740 0ustar liggesuserslibrary(fitdistrplus) set.seed(1234) nsample <- 10 # (1) uniform distribution fit - no fixed value #manual check dunif2 <- function(x, min, max) dunif(x, min, max) punif2 <- function(q, min, max) punif(q, min, max) x1 <- runif(nsample, 3, 5) L <- function(a, b, obs) prod(dunif(obs, min=a, max=b)) l <- Vectorize(L, "a") curve(l(x, b=5, obs=x1), from=1, to=3) f1 <- fitdist(x1, "unif") f2 <- fitdist(x1, "unif2", start=list(min=0, max=10), lower=c(-Inf, max(x1)), upper=c(min(x1), Inf)) c(logLik(f1), logLik(f2)) delta <- .2 llsurface(x1, "unif", plot.arg = c("min", "max"), min.arg=c(1, 5-delta), max.arg=c(3+delta, 7), main="likelihood surface for uniform") abline(v=3, h=5, col="red", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="violet") points(f2$estimate[1], f2$estimate[2], pch="o", col="blue") # (2) uniform distribution fit - fixed value f3 <- fitdist(x1, "unif", fix.arg=list(min=2.5)) logLik(f3) llcurve(x1, "unif", plot.arg="max", min.arg = 5-delta, max.arg=7) f4 <- fitdist(x1, "unif", fix.arg=list(max=5.5)) logLik(f4) # (3) four parameter beta - also known as PERT distribution require(mc2d) x2 <- rpert(2*nsample, 0, 1, 2, 3) f1 <- fitdist(x2, "pert", start=list(min=-1, mode=0, max=10, shape=1), lower=c(-Inf, -Inf, max(x2), 0), upper=c(min(x2), Inf, Inf, Inf)) f2 <- fitdist(x2, "pert", start=list(mode=1, shape=1), lower=c(-Inf, 0), upper=c(Inf, Inf), fix.arg=list(min=min(x2)-1e-6, max=max(x2)+1e-6)) gofstat(list(f1,f2)) cdfcomp(list(f1,f2)) fitdistrplus/tests/t-mledist-cens.R0000644000176200001440000000376713742313702017142 0ustar liggesuserslibrary(fitdistrplus) # (1) fit a user-defined continuous distribution (Gumbel) to censored data. # data(fluazinam) log10EC50 <-log10(fluazinam) # definition of the Gumbel distribution dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) qgumbel <- function(p,a,b) a-b*log(-log(p)) mledist(log10EC50, "gumbel", start=list(a=0,b=2), optim.method="Nelder-Mead") mledist(log10EC50, "gumbel", start=list(a=0,b=2)) #default NM # (2) test optimization arguments to censored data MLE. # mledist(log10EC50, "lnorm", optim.method="BFGS") mledist(log10EC50, "lnorm", optim.method="Nelder") #optim() is used mledist(log10EC50, "lnorm", optim.method="L-BFGS-B", lower=0) mledist(log10EC50, "lnorm", optim.method="BFGS", lower=0) #a simple warning #constrOptim() is used mledist(log10EC50, "lnorm", optim.method="Nelder", lower=0) mledist(log10EC50, "lnorm", lower=0) #error # (3) weighted MLE # xleft <- c(-1.8, -0.6, -0.1, 0.07, 0.14, 1, 1.2, 1.2, 1.2) xright <- c(-1.8, -0.6, -0.1, 0.07, 0.14, 1, NA, NA, NA) d <- data.frame(left = xleft, right = xright) f1 <- mledist(d, "norm") dbis <- data.frame(left = c(-1.8, -0.6, -0.1, 0.07, 0.14, 1, 1.2), right = c(-1.8, -0.6, -0.1, 0.07, 0.14, 1, NA)) f2 <- mledist(dbis, "norm", weights = c(rep(1,6),3)) # f1 and f2 must give quite the same results (only starting values differ) f1$estimate f2$estimate # (4) test the definition of fix.arg/start.arg as functions # if defined as functions, start.arg and fix.arg must be # functions of pseudo data (output pseudo of cens2pseudo()) mledist(d, "norm", start = function(x) list(mean = 0, sd = 1))$estimate mledist(d, "norm", start = function(x) list(mean = mean(x), sd = 1))$estimate mledist(d, "norm", fix.arg = function(x) list(mean = 0))$estimate mledist(d, "norm", fix.arg = function(x) list(mean = 0.544))$estimate mledist(d, "norm", fix.arg = function(x) list(mean = mean(x)))$estimate fitdistrplus/tests/t-prefit.R0000644000176200001440000000225114050660542016027 0ustar liggesusersrequire(fitdistrplus) nsample <- 10 # (1) gamma x <- rgamma(nsample, 5/2, 7/2) prefit(x, "gamma", "mle", list(shape=3, scale=3), lower=-Inf, upper=Inf, silent=TRUE, control=list(trace=1, REPORT=1)) prefit(x, "gamma", "mle", list(shape=1, scale=1), lower=-Inf, upper=Inf, silent=TRUE) prefit(x, "gamma", "mle", list(shape=3), fix.arg=list(scale=7/2), lower=-Inf, upper=Inf, silent=TRUE) prefit(x, "gamma", "qme", list(shape=1, scale=1), probs=1:2/3, lower=-Inf, upper=Inf, silent=TRUE) prefit(x, "gamma", "mge", list(shape=1, scale=1), gof="CvM", lower=-Inf, upper=Inf, silent=TRUE) prefit(x, "gamma", "mge", list(shape=1, scale=1), gof="AD", lower=-Inf, upper=Inf, silent=TRUE) # (2) geometric x <- rgeom(nsample, 1/7) prefit(x, "geom", "mle", list(prob=1/2), lower=-Inf, upper=Inf, silent=TRUE) tbx <- table(x) prefit(as.numeric(names(tbx)), "geom", "mle", list(prob=1/2), lower=-Inf, upper=Inf, silent=TRUE, weights=tbx) prefit(x, "geom", "qme", list(prob=1/2), probs=1/2, lower=-Inf, upper=Inf) # (3) Pareto require(actuar) x <- rpareto(nsample, 6, 2) prefit(x, "pareto", "mme", list(shape=10, scale=10), order=1:2, memp=function(x, order) mean(x^order), lower=-Inf, upper=Inf) fitdistrplus/tests/t-detectbound.R0000644000176200001440000000176113742313702017043 0ustar liggesusersrequire(fitdistrplus) #case where the density returns a Not-an-Numeric value. detectbound("gamma", c(shape=3, scale=3), 1:10, echo=TRUE) detectbound("logis", c(location=3, scale=3), 1:10) detectbound("geom", c(prob=1/2), 1:10) #test rate-scale arg detectbound("gamma", c(shape=1, scale=3), 1:10) detectbound("gamma", c(shape=1, rate=1/3), 1:10) x1 <- c(NaN, 1:3) x2 <- c(1:4) x3 <- c(NaN, NaN) is.nan(x1) && !is.nan(x2) is.nan(x3) && !is.nan(x2) #case where the density returns a Not-an-Numeric value and one parameter is fixed. detectbound("gamma", c(shape=3), 1:10, fix.arg=c(scale=3)) #case where the density returns an error rather than a Not-an-Numeric value. dgeom2 <- function(x, prob, log=FALSE) { stopifnot(prob >= 0 && prob <= 1) dgeom(x, prob, log) } detectbound("geom2", c(prob=1/2), 1:10) #case where the density returns a Not-an-Numeric value for actuar package require(actuar) detectbound("burr", c(shape1=3, shape2=3, rate=1), 1:10) detectbound("llogis", c(shape=3, rate=1), 1:10) fitdistrplus/tests/t-util-npsurv-mainfunction.R0000644000176200001440000001735514050660542021551 0ustar liggesuserslibrary(fitdistrplus) vizualise <- FALSE mytrace <- 1 mytrace <- 0 #------------------------------------------------- # example with right censoring from package npsurv ap <- cbind(L=c(1:15, 1:15), R=c(1:15, rep(Inf, 15)), count=c(456, 226, 152, 171, 135, 125, 83, 74, 51, 42, 43, 34, 18, 9, 6, 39, 22, 23, 24, 107, 133, 102, 68, 64, 45, 53, 33, 27, 23, 30)) dim(ap) resap <- fitdistrplus:::npsurv.minimal(ap, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") #------------------------------------------------ # example with left censoring from package npsurv ap <- cbind(L=c(1:15, rep(-Inf, 15)), R=c(1:15, 1:15), count=c(456, 226, 152, 171, 135, 125, 83, 74, 51, 42, 43, 34, 18, 9, 6, 39, 22, 23, 24, 107, 133, 102, 68, 64, 45, 53, 33, 27, 23, 30)) dim(ap) resap <- fitdistrplus:::npsurv.minimal(ap, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") if(vizualise) { #------------------------------------------------------------------------------------------------- # example with interval censoring from package npsurv leading to 16 maximal intersection intervals ap <- cbind(L=c(0:14,1:15), R=c(1:15, rep(Inf, 15)), count=c(456, 226, 152, 171, 135, 125, 83, 74, 51, 42, 43, 34, 18, 9, 6, 39, 22, 23, 24, 107, 133, 102, 68, 64, 45, 53, 33, 27, 23, 30)) dim(ap) ap.x2 <- fitdistrplus:::icendata(ap, w=1) ap.x <- rbind(cbind(ap.x2$t, ap.x2$t), ap.x2$o) ap.Delta <- fitdistrplus:::Deltamatrix(ap.x) #cbind(ap.Delta$left, unique(ap.x[,"L"])) resap <- fitdistrplus:::npsurv.minimal(ap, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") # if(FALSE) # { # require(npsurv) # rescheck <- npsurv::npsurv(ap, w=1, maxit=100, tol=1e-6, verb=3) # c(resap$ll, rescheck$ll) # # cbind(resap$f$left, rescheck$f$left) # cbind(resap$f$right, rescheck$f$right) # cbind(resap$f$p, rescheck$f$p) # sum(abs(resap$f$p- rescheck$f$p)) # } #---------------------------------------------------------------------------------- # example with interval censoring leading to a single maximal intersection interval LR <- matrix(1:100, ncol=2) cnt <- round(1000*pgeom(1:NROW(LR)-1, prob=1/10, lower=FALSE)) fakedata <- cbind(L=LR[,1], R=LR[,2], count=cnt) fakedata.x2 <- fitdistrplus:::icendata(fakedata, w=1) fakedata.x2.x <- rbind(cbind(fakedata.x2$t, fakedata.x2$t), fakedata.x2$o) fakedata.x2.Delta <- fitdistrplus:::Deltamatrix(fakedata.x2.x) # a single vector resfk <- fitdistrplus:::npsurv.minimal(fakedata, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") #--------------------------------------------------------------------------------------- # geometric example with interval censoring leading to 50 maximal intersection intervals LR <- matrix(1:100, ncol=2, byrow = TRUE) theop <- dgeom(1:NROW(LR)-1, prob=1/10) cnt <- round(1000*pgeom(1:NROW(LR)-1, prob=1/10, lower=FALSE)) fakedata <- cbind(L=LR[,1], R=LR[,2], count=cnt) fakedata.x2 <- fitdistrplus:::icendata(fakedata, w=1) fakedata.x2.x <- rbind(cbind(fakedata.x2$t, fakedata.x2$t), fakedata.x2$o) fakedata.x2.Delta <- fitdistrplus:::Deltamatrix(fakedata.x2.x) #is diagonal resfk <- fitdistrplus:::npsurv.minimal(fakedata, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") head(cbind(optimized=resfk$f$p, theoretical=theop)) #---------------------------------------------------------------------------------------- # multimodal example with interval censoring leading to 50 maximal intersection intervals LR <- matrix(1:100, ncol=2, byrow = TRUE) cnt <- round(450*dgeom(1:NROW(LR)-1, prob=1/10) +550*dbinom(1:NROW(LR)-1, size=NROW(LR), prob=4/5)) theop <- cnt/sum(cnt) fakedata <- cbind(L=LR[,1], R=LR[,2], count=cnt) fakedata.x2 <- fitdistrplus:::icendata(fakedata, w=1) fakedata.x2.x <- rbind(cbind(fakedata.x2$t, fakedata.x2$t), fakedata.x2$o) fakedata.x2.Delta <- fitdistrplus:::Deltamatrix(fakedata.x2.x) #is diagonal resfk <- fitdistrplus:::npsurv.minimal(fakedata, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") head(cbind(optimized=resfk$f$p, theoretical=theop[1:resfk$m])) #---------------------------------------------------------------------------------------- # multimodal example with interval censoring leading to 43 maximal intersection intervals n <- 100 set.seed(123) LR <- sample.int(n) LR <- cbind(LR, LR+sample.int(n)/10) cnt <- 1+round(450*dgeom(1:NROW(LR)-1, prob=1/10) +550*dbinom(1:NROW(LR)-1, size=NROW(LR), prob=4/5)) theop <- cnt/sum(cnt) fakedata <- cbind(L=LR[,1], R=LR[,2], count=cnt) fakedata.x2 <- fitdistrplus:::icendata(fakedata, w=1) fakedata.x2.x <- rbind(cbind(fakedata.x2$t, fakedata.x2$t), fakedata.x2$o) fakedata.x2.Delta <- fitdistrplus:::Deltamatrix(fakedata.x2.x) str(fakedata.x2.Delta) resfk <- fitdistrplus:::npsurv.minimal(fakedata, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") # if(FALSE) # { # require(npsurv) # rescheck <- npsurv::npsurv(fakedata, w=1, maxit=100, tol=1e-6, verb=3) # c(resfk$ll, rescheck$ll) # # cbind(resfk$f$left, rescheck$f$left) # cbind(resfk$f$right, rescheck$f$right) # cbind(resfk$f$p, rescheck$f$p) # sum(abs(resfk$f$p- rescheck$f$p)) # } #---------------------------------------------------------------------------------------- # simulated example with interval censoring leading to 258 maximal intersection intervals set.seed(1232) ns <- 500 ns <- 100 r <- rnorm(ns) d8 <- data.frame(left = r, right = r) delta <- rlnorm(ns) icensored <- rbinom(ns, size = 1, prob = 0.2) Lcensored <- rbinom(ns, size = 1, prob = 0.2*(1 - icensored)) Rcensored <- rbinom(ns, size = 1, prob = 0.3*(1 - icensored)*(1 - Lcensored)) # icensored + Lcensored + Rcensored d8$left <- d8$left * (1 - Lcensored) + (-1000) * Lcensored d8$right <- d8$right * (1 - Rcensored) + (1000) * Rcensored d8$right <- d8$right + delta * icensored d8$right[d8$right == 1000] <- +Inf d8$left[d8$left == -1000] <- -Inf d8.x2 <- fitdistrplus:::icendata(d8, w=1) d8.x2.x <- rbind(cbind(d8.x2$t, d8.x2$t), d8.x2$o) d8.x2.Delta <- fitdistrplus:::Deltamatrix(d8.x2.x) str(d8.x2.Delta) system.time( resd8 <- fitdistrplus:::npsurv.minimal(d8, w=1, maxit=100, tol=1e-6, verb=mytrace, pkg="stats") ) # if(FALSE) # { # require(npsurv) # d8bis <- d8 # d8bis$left[is.na(d8bis$left)] <- -Inf # d8bis$right[is.na(d8bis$right)] <- Inf # # rescheck <- npsurv::npsurv(d8bis, w=1, maxit=100, tol=1e-6, verb=3) # c(resd8$ll, rescheck$ll) # # cbind(resd8$f$left, rescheck$f$left) # cbind(resd8$f$right, rescheck$f$right) # head(cbind(resd8$f$p, rescheck$f$p)) # sum(abs(resd8$f$p- rescheck$f$p)) # } #------------------------------------------------------ # crash example with wrong interval censoring intervals set.seed(1232) ns <- 100 r <- rnorm(ns) d8 <- data.frame(left = r, right = r) delta <- rlnorm(ns) icensored <- rbinom(ns, size = 1, prob = 0.2) Lcensored <- rbinom(ns, size = 1, prob = 0.2*(1 - icensored)) Rcensored <- rbinom(ns, size = 1, prob = 0.3*(1 - icensored)*(1 - Lcensored)) # icensored + Lcensored + Rcensored d8$left <- d8$left * (1 - Lcensored) + (-1000) * Lcensored d8$right <- d8$right * (1 - Rcensored) + (1000) * Rcensored d8$right <- d8$right + delta * icensored d8$right[d8$right == 1000] <- -Inf d8$left[d8$left == -1000] <- +Inf try(resd8 <- fitdistrplus:::npsurv.minimal(d8, w=1, maxit=100, tol=1e-6, verb=2, pkg="stats")) }fitdistrplus/tests/t-qqcompcens.R0000644000176200001440000000541313742313702016712 0ustar liggesuserslibrary(fitdistrplus) visualize <- FALSE # TRUE for manual tests with visualization of results data(smokedfish) fitsf <- fitdistcens(smokedfish,"lnorm") plot(fitsf) qqcompcens(fitsf) qqcompcens(fitsf, fillrect = NA) qqcompcens(fitsf, fitcol = "black") qqcompcens(fitsf, fitcol = "black", fillrect = NA) qqcompcens(fitsf, ylim = c(0,150)) qqcompcens(fitsf, xlim = c(0,150)) qqcompcens(fitsf, xlim = c(0,150), ylim = c(0, 120)) if (requireNamespace("ggplot2", quietly = TRUE)) { qqcompcens(fitsf, plotstyle = "ggplot") } if (requireNamespace("ggplot2", quietly = TRUE) & visualize) { qqcompcens(fitsf, fillrect = NA, plotstyle = "ggplot") qqcompcens(fitsf, fitcol = "black", plotstyle = "ggplot") qqcompcens(fitsf, fitcol = "black", fillrect = NA, plotstyle = "ggplot") qqcompcens(fitsf, ylim = c(0,150), plotstyle = "ggplot") qqcompcens(fitsf, xlim = c(0,150), plotstyle = "ggplot") qqcompcens(fitsf, xlim = c(0,150), ylim = c(0, 120), plotstyle = "ggplot") } if (visualize) { data(fluazinam) log10EC50 <-log10(fluazinam) fln <- fitdistcens(log10EC50,"norm") plot(fln) qqcompcens(fln) if (requireNamespace("ggplot2", quietly = TRUE)) { qqcompcens(fln, plotstyle = "ggplot") } } data(salinity) log10LC50 <-log10(salinity) plotdistcens(log10LC50) plotdistcens(log10LC50, NPMLE = FALSE) fn <- fitdistcens(log10LC50,"norm") fl <- fitdistcens(log10LC50,"logis") plot(fn) plot(fl) qqcompcens(fn) qqcompcens(fl) qqcompcens(list(fn, fl)) qqcompcens(list(fn, fl), fitlwd = c(5, 2)) if (requireNamespace("ggplot2", quietly = TRUE)) { qqcompcens(list(fn, fl), plotstyle = "ggplot") qqcompcens(list(fn, fl), plotstyle = "ggplot", fitlwd = c(5, 2)) } if (requireNamespace("ggplot2", quietly = TRUE) & visualize) { qqcompcens(fl, plotstyle = "ggplot") qqcompcens(fn, plotstyle = "ggplot") } require(actuar) data(salinity) fln <- fitdistcens(salinity,"lnorm") fll <- fitdistcens(salinity,"llogis") plot(fln) par(mfrow = c(2,1)) qqcompcens(fln) qqcompcens(fll) par(mfrow = c(1,1)) qqcompcens(list(fln, fll)) qqcompcens(list(fln, fll), ynoise = FALSE) qqcompcens(list(fln, fll), fitcol = c("blue", "orange")) qqcompcens(list(fln, fll), xlogscale = TRUE, ylogscale = TRUE) qqcompcens(list(fln, fll), ylogscale = TRUE) qqcompcens(list(fln, fll), xlogscale = TRUE, ynoise = FALSE) if (requireNamespace("ggplot2", quietly = TRUE) & visualize) { qqcompcens(list(fln, fll), plotstyle = "ggplot") qqcompcens(list(fln, fll), ynoise = FALSE, plotstyle = "ggplot") qqcompcens(list(fln, fll), fitcol = c("blue", "orange"), plotstyle = "ggplot") qqcompcens(list(fln, fll), xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") qqcompcens(list(fln, fll), ylogscale = TRUE, plotstyle = "ggplot") qqcompcens(list(fln, fll), xlogscale = TRUE, ynoise = FALSE, plotstyle = "ggplot") } fitdistrplus/tests/t-denscomp.R0000644000176200001440000003306014050660542016350 0ustar liggesuserslibrary(fitdistrplus) # ?denscomp visualize <- FALSE # TRUE for manual test with visualization of plots nsample <- 1000 nsample <- 10 # (1) Plot various distributions fitted to serving size data # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") #sanity checks try(denscomp("list(fitW, fitln, fitg)",horizontals = FALSE), silent=TRUE) try(denscomp(list(fitW, fitln, fitg, a=1),horizontals = FALSE), silent=TRUE) #real call denscomp(list(fitW, fitln, fitg), probability = TRUE) denscomp(list(fitW, fitln, fitg), probability = FALSE) if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fitW, fitln, fitg), probability=TRUE, plotstyle = "ggplot") denscomp(list(fitW, fitln, fitg), probability=FALSE, plotstyle = "ggplot") } #test ylim argument denscomp(list(fitW, fitln, fitg), probability=TRUE, ylim=c(0, .05)) denscomp(list(fitW, fitln, fitg), probability=FALSE, ylim=c(0, 100)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(fitW, fitln, fitg), probability=TRUE, ylim=c(0, .05), plotstyle = "ggplot") denscomp(list(fitW, fitln, fitg), probability=FALSE, ylim=c(0, 100), plotstyle = "ggplot") } #test xlim, legend, main, demp denscomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F",xlim = c(0,250), xlegend = "topright", demp=TRUE) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F",xlim = c(0,250), xlegend = "topright", demp=TRUE, plotstyle = "ggplot") } # (2) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # data(endosulfan) ATV <-subset(endosulfan, group == "NonArthroInvert")$ATV flnMGEKS <- fitdist(ATV,"lnorm",method="mge",gof="KS") flnMGEAD <- fitdist(ATV,"lnorm",method="mge",gof="AD") flnMGEADL <- fitdist(ATV,"lnorm",method="mge",gof="ADL") flnMGEAD2L <- fitdist(ATV,"lnorm",method="mge",gof="AD2L") llfit <- list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L) denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.") if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.", plotstyle = "ggplot") } denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L")) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), plotstyle = "ggplot") } denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2")) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), plotstyle = "ggplot") } denscomp(llfit, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), datacol="grey") if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(llfit, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), datacol="grey", plotstyle = "ggplot") } denscomp(flnMGEKS, xlim=c(10,100000)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) denscomp(flnMGEKS, xlim=c(10,100000), plotstyle = "ggplot") # (3) # # if (visualize) { x1 <- c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4,13.2,8.4,6.3,8.9,5.2,10.9,14.4) x <- seq(0, 1.1*max(x1), length=100) dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(x,a,b) exp(-exp((a-x)/b)) f1 <- mledist(x1,"norm") f2 <- mledist(x1,"gumbel", start = list(a = 10, b = 5)) f3 <- mledist(x1, "exp") # graph 1 hist(x1, 10, prob=TRUE) lines(x, dnorm(x, f1$estimate[1], f1$estimate[2]), col="red") lines(x, dgumbel(x, f2$estimate[1], f2$estimate[2]), col="green") lines(x, dexp(x, f3$estimate[1]), col="blue") legend("topright", lty=1, leg = c("Normal", "Gumbel", "Exp"), col = c("red", "green", "blue")) # graph 2 f1 <- fitdist(x1,"norm") f2 <- fitdist(x1,"gumbel", start = list(a = 10, b = 5)) f3 <- fitdist(x1, "exp") denscomp(list(f1, f2, f3), xlim = c(0, 30), fitlty = 1, legendtext = c("Normal","Gumbel","Exp")) # graph 3 if (requireNamespace ("ggplot2", quietly = TRUE)) denscomp(list(f1, f2, f3), xlim = c(0, 30), fitlty = 1, legendtext = c("Normal","Gumbel","Exp"), breaks = 12, plotstyle = "ggplot") } # (4) normal mixture # if (visualize) { #mixture of two normal distributions #density dnorm2 <- function(x, poid, m1, s1, m2, s2) poid*dnorm(x, m1, s1) + (1-poid)*dnorm(x, m2, s2) #numerical approximate quantile function qnorm2 <- function(p, poid, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, poid, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-1000, 1000), prob=pr)$minimum) } #distribution function pnorm2 <- function(q, poid, m1, s1, m2, s2) poid*pnorm(q, m1, s1) + (1-poid)*pnorm(q, m2, s2) #basic normal distribution set.seed(1234) x2 <- c(rnorm(nsample, 5), rnorm(nsample, 10)) #MLE fit fit1 <- fitdist(x2, "norm2", "mle", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0)) fit2 <- fitdist(x2, "norm2", "qme", probs=c(1/6, 1/4, 1/3, 1/2, 2/3), start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) fit3 <- fitdist(x2, "norm2", "mge", gof="AD", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) denscomp(list(fit1, fit2, fit3)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) denscomp(list(fit1, fit2, fit3), plotstyle = "ggplot") } # (5) large data # if (visualize) { n <- 1e4 x <- rnorm(n) f <- fitdist(x, "norm") denscomp(f) denscomp(f, demp=TRUE) if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(f, plotstyle = "ggplot") denscomp(f, demp=TRUE, plotstyle = "ggplot") } } # (6) graphical parameters # if (visualize) { # 'graphics' plot style denscomp(list(fit1, fit2, fit3), plotstyle = "gr") denscomp(list(fit1, fit2, fit3), title = "Fitted distribution") denscomp(list(fit1, fit2, fit3), main = "Fitted distribution", addlegend = F, demp = T, dempcol = "purple") # 'ggplot' plot style if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fit1, fit2, fit3), plotstyle = "gg") denscomp(list(fit1, fit2, fit3), plotstyle = "ggplot", breaks = 20, pro = F) dcomp <- denscomp(list(fit1, fit2, fit3), plotstyle = "gg", demp = T) dcomp + ggplot2::theme_minimal() + ggplot2::ggtitle("Histogram and\ntheoretical densities") dcomp + ggplot2::guides(colour = ggplot2::guide_legend("Fitted distribution"), linetype = ggplot2::guide_legend("Fitted distribution")) } } # (7) test legend labels # if (visualize) { serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitW2 <- fitdist(serving,"weibull", method="qme", probs=c(1/3,2/3)) fitW3 <- fitdist(serving,"weibull", method="qme", probs=c(1/2,2/3)) fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") denscomp(list(fitW, fitln, fitg)) #distrib denscomp(list(fitW, fitW2, fitln, fitg)) #distrib+method denscomp(list(fitW, fitW2, fitW3, fitln, fitg)) #distrib+method+num if (requireNamespace ("ggplot2", quietly = TRUE)) denscomp(list(fitW, fitW2, fitW3, fitln, fitg), plotstyle = "ggplot") #distrib+method+num } # (8) discrete distrib # x <- c(rpois(nsample, 5), rbinom(nsample, 12, 2/3)) fpois <- fitdist(x, "pois") fgeo <- fitdist(x, "geom") fnbinom <- fitdist(x, "nbinom") par(mar=c(4,4,2,1)) denscomp(list(fpois, fnbinom, fgeo), probability = TRUE) denscomp(list(fpois, fnbinom, fgeo), probability = FALSE) denscomp(list(fpois, fnbinom, fgeo), fittype="o") denscomp(list(fpois, fnbinom, fgeo), fittype="p") # 'ggplot' plot style if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { denscomp(list(fpois, fnbinom, fgeo), plotstyle="ggplot", probability = TRUE) denscomp(list(fpois, fnbinom, fgeo), plotstyle="ggplot", probability = FALSE) denscomp(list(fpois, fnbinom, fgeo), fittype="o", plotstyle="ggplot") denscomp(list(fpois, fnbinom, fgeo), fittype="p", plotstyle="ggplot") } # test the call to any() fpois$discrete <- fnbinom$discrete <- FALSE denscomp(list(fpois, fnbinom, fgeo)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) denscomp(list(fpois, fnbinom, fgeo), plotstyle="ggplot") #test the forced usage fgeo$discrete <- FALSE denscomp(list(fpois, fnbinom, fgeo), discrete=TRUE) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) denscomp(list(fpois, fnbinom, fgeo), discrete=TRUE, plotstyle="ggplot") if (visualize) { x <- c(rpois(nsample, 30), rbinom(nsample, 12, 2/3)) fpois <- fitdist(x, "pois") fgeo <- fitdist(x, "geom") fnbinom <- fitdist(x, "nbinom") #3 types of plot of probability mass function par(mar=c(4,4,2,1)) denscomp(list(fpois, fnbinom, fgeo)) #fittype = "l" denscomp(list(fpois, fnbinom, fgeo), fittype = "p") denscomp(list(fpois, fnbinom, fgeo), fittype = "o") if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fpois, fnbinom, fgeo), plotstyle="ggplot") #fittype = "l" denscomp(list(fpois, fnbinom, fgeo), fittype = "p", plotstyle="ggplot") denscomp(list(fpois, fnbinom, fgeo), fittype = "o", plotstyle="ggplot") } } # (9) examples with user specified regular of irregular breaks in the histogram # in probability or not # if (visualize) { # two plots with user specified regular breaks in probability or not # hist(serving, breaks = seq(0,200,50)) denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), breaks = seq(0,200,50)) denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), probability = FALSE, breaks = seq(0,200,50)) # with ggplot2 denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), plotstyle = "ggplot", breaks = seq(0,200,50)) denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), probability = FALSE, plotstyle = "ggplot", breaks = seq(0,200,50)) # two plots with irregular breaks in probability or not # hist(serving, breaks = c(0, 20, 50, 100, 200, 300)) denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), breaks = c(0, 20, 50, 100, 200, 300)) # hist(serving, breaks = c(0, 20, 50, 100, 200, 300), probability = FALSE) try(denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), breaks = c(0, 20, 50, 100, 200, 300), probability = FALSE)) # with ggplot2 denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), breaks = c(0, 20, 50, 100, 200, 300), plotstyle = "ggplot") ##### ggplot2 does not take into account non-equidistant breaks !!!!!!!!!!!!!!!! try(denscomp(list(fitW, fitln, fitg), addlegend = FALSE, main = "ground beef fits", xlab = "serving sizes (g)", xlim = c(0, 250), breaks = c(0, 20, 50, 100, 200, 300), probability = FALSE, plotstyle = "ggplot")) } # (10) fitlty, fitlwd for discrete x <- c(rpois(nsample, 30), rbinom(nsample, 12, 2/3)) fpois <- fitdist(x, "pois") fgeo <- fitdist(x, "geom") fnbinom <- fitdist(x, "nbinom") denscomp(list(fpois, fnbinom, fgeo), fitlty = 2, fitlwd = 3:1) denscomp(list(fpois, fnbinom, fgeo), fittype = "o", fitlwd = 3:1) if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fpois, fnbinom, fgeo), plotstyle = "ggplot", fitlty = 2, fitlwd = 3:1) denscomp(list(fpois, fnbinom, fgeo), plotstyle = "ggplot", fittype = "o", fitlty = 1, fitlwd = 3:1) } # (11) fitlty, fitlwd for non discrete denscomp(list(fitW, fitln, fitg), fitlty = 1, fitlwd = 3:1) denscomp(list(fitW, fitln, fitg), fitlty = 1, fitlwd = 1:3, fitcol = c(1:2, 7)) if (requireNamespace ("ggplot2", quietly = TRUE)) { denscomp(list(fitW, fitln, fitg), plotstyle = "ggplot", fitlty = 1, fitlwd = 3:1) denscomp(list(fitW, fitln, fitg), plotstyle = "ggplot", fitlty = 1, fitlwd = 1:3, fitcol = c(1:2, 7)) } fitdistrplus/tests/t-util-testdensity.R0000644000176200001440000000467413742313702020103 0ustar liggesuserslibrary(fitdistrplus) testdpqfun <- fitdistrplus:::testdpqfun ##### first argument ##### #a data.frame of TRUE and "" testdpqfun("exp", start=c(rate=1)) #a data.frame with error messages dEXP <- function(y, rate) dexp(x, rate) pEXP <- function(y, rate) pexp(x, rate) qEXP <- function(y, rate) qexp(x, rate) testdpqfun("EXP", start=c(rate=1)) ##### existence ##### #a data.frame of TRUE and "" testdpqfun("exp", start=c(rate=1)) #a data.frame with error messages testdpqfun("exp2", start=c(rate=1)) ##### void vector ##### dexp2 <- function(x, rate) ifelse(length(x)==0, stop("zero input"), dexp(x,rate)) dexp3 <- function(x, rate) ifelse(length(x)==0, NA, dexp(x,rate)) #TRUE testdpqfun("exp", "d", c(rate=1)) #error message testdpqfun("exp2", "d", c(rate=1)) #error message testdpqfun("exp3", "d", c(rate=1)) ##### inconsistent value ##### pexp2 <- function(q, rate) { res <- pexp(q, rate) if(any(is.nan(res))) stop("NaN values") res } pexp3 <- function(q, rate) { res <- pexp(q, rate) if(any(is.infinite(q))) stop("Inf values") res } #TRUE testdpqfun("exp", "p", c(rate=1)) #error message testdpqfun("exp2", "p", c(rate=1)) #error message testdpqfun("exp3", "p", c(rate=1)) ##### missing value ##### qexp2 <- function(p, rate) { res <- qexp(p, rate) if(any(is.na(res))) stop("NA values") res } qexp3 <- function(p, rate) { res <- qexp(p, rate) res[!is.na(res)] } #TRUE testdpqfun("exp", "q", c(rate=1)) #error message testdpqfun("exp2", "q", c(rate=1)) #error message testdpqfun("exp3", "q", c(rate=1)) ##### inconsistent parameter ##### dnorm2 <- function(x, mean, sd) { if(sd < 0) stop("negative param") else dnorm(x,mean,sd) } #TRUE testdpqfun("norm", "d", c(mean=1, sd=1)) #error message testdpqfun("norm2", "d", c(mean=1, sd=1)) ##### inconsistent name ##### dnorm2 <- function(x, mean=0, sd=1, ...) dnorm(x, mean, sd) dnorm3 <- dnorm2 pnorm3 <- pnorm qnorm3 <- qnorm #TRUE testdpqfun("norm", "d", c(mean=1, sd=1)) #error message testdpqfun("norm2", "d", c(mean=1, sd=1)) #a data.frame with error messages testdpqfun("norm", c("d", "p", "q"), c(mean=1, sd=1)) testdpqfun("norm2", c("d", "p", "q"), c(mean=1, sd=1)) testdpqfun("norm3", c("d", "p", "q"), c(mean=1, sd=1)) x <- rnorm(100) fitdist(x, "norm") #ok fitdist(x, "norm2", start=list(mean=1, sd=1)) #pnorm2 not defined fitdist(x, "norm3", start=list(mean=1, sd=1)) #The dnorm3 function should return raise an error when names are incorrectly named fitdistrplus/tests/t-fitdistcens.R0000644000176200001440000000477014050660542017065 0ustar liggesuserslibrary(fitdistrplus) nsample <- 500 nsample <- 10 visualize <- FALSE # TRUE for manual tests with visualization of results set.seed(1234) # (6) custom optimisation function - example with the genetic algorithm # data(fluazinam) log10EC50 <-log10(fluazinam) #wrap genoud function rgenoud package mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values=par, ...) standardres <- c(res, convergence=0) return(standardres) } # call fitdistcens with a 'custom' optimization function fit.with.genoud <- fitdistcens(log10EC50, "logis", custom.optim=mygenoud, nvars=2, start=list(location=0, scale=1), Domains=cbind(c(0,0), c(5, 5)), boundary.enforcement=1, print.level=1, hessian=TRUE) summary(fit.with.genoud) # (9) check keepdata # if (visualize) # LONG TO RUN ON CRAN AND NEEDS VISALIZATION OF RESULTS { set.seed(1234) x <- rexp(1e3, 5) # x <- data.frame(left=x, right=x+rexp(x, 1/2)) x <- data.frame(left=x, right=x) f1 <- fitdistcens(x, "exp", keepdata=FALSE) f2 <- fitdistcens(x, "exp", keepdata=TRUE) f1$censdata f2$censdata plot(f1) plot(f2) } # (9) fixing parameters # x <- rexp(nsample, 5) x <- data.frame(left=x, right=x+.1) f1 <- fitdistcens(x, "gamma", fix.arg=list(shape=1.5)) f1 f1$fix.arg f1 <- fitdistcens(x, "gamma", fix.arg=function(x) list(shape=1.5)) f1 f1$fix.arg.fun # (10) weights # data(salinity) salinity.unique <- unique(salinity) string.unique <- paste(salinity.unique$left, salinity.unique$right) string.salinity <- paste(salinity$left, salinity$right) nobs <- nrow(salinity.unique) salinity.weights <- numeric(nobs) for (i in 1:nobs) { salinity.weights[i] <- length(which(string.salinity == string.unique[i])) } cbind(salinity.unique, salinity.weights) (fa <- fitdistcens(salinity, "lnorm")) (fb <- fitdistcens(salinity.unique, "lnorm", weights = salinity.weights)) # should give the same results # (11) check the warning messages when using weights in the fit followed by functions # that do not yet take weights into account # with an example to be used later to see if weights are well taken into account # x <- rexp(100, 5) x <- sort(x) x <- data.frame(left=x, right=x+.1) (f <- fitdistcens(x, "gamma", weights=c(rep(10, 50), rep(1, 50)))) try(plot(f)) try(cdfcompcens(f)) (f2 <- fitdistcens(x, "weibull", weights=c(rep(10, 50), rep(1, 50)))) try(cdfcompcens(list(f, f2))) try(bootdistcens(f)) fitdistrplus/tests/t-lnL-surf.R0000644000176200001440000000374713742313702016253 0ustar liggesuserslibrary(fitdistrplus) nsample <- 1000 nsample <- 10 #(1) beta distribution # x <- rbeta(nsample, 3, 3/4) llsurface(data = x, distr = "beta", plot.arg=c("shape1", "shape2"), min.arg=c(0.1, 0.1), max.arg=c(7, 3)) llsurface(data = x, distr = "beta", plot.arg=c("shape1", "shape2"), min.arg=c(0.1, 0.1), max.arg=c(7, 3), back.col = FALSE ) points(3, 3/4, pch="+", col="red") llcurve(data = x, distr = "beta", plot.arg = "shape1", min.arg = 0.1, max.arg = 7, fix.arg = list(shape2 = 3/4), lseq=100, col = "blue") llcurve(data = x, distr = "beta", plot.arg = "shape2", min.arg = 0.1, max.arg = 7, fix.arg = list(shape1 = 3), lseq=100, col = "red") #test psi <- function(x) digamma(x) grbetalnl <- function(x, a, b) c(log(x)-psi(a)+psi(a+b), log(1-x)-psi(b)+psi(a+b)) grbetalnl(x, 3, 4) grlnL <- function(par, obs, ...) -rowSums(sapply(obs, function(x) grbetalnl(x, a=par[1], b=par[2]))) rowSums(sapply(x, function(x) grbetalnl(x, 3, 4))) grlnL(c(3, 4), x) grlnL(c(3, 3/4), x) ctr <- list(trace=0, REPORT=1, maxit=1000) bfgs_gr <- mledist(x, dist="beta", optim.method="BFGS", gr=grlnL, control=ctr) bfgs <- mledist(x, dist="beta", optim.method="BFGS", control=ctr) cg_gr <- mledist(x, dist="beta", optim.method="CG", gr=grlnL, control=ctr) cg <- mledist(x, dist="beta", optim.method="CG", control=ctr) nm_gr <- mledist(x, dist="beta", optim.method="Nelder", gr=grlnL, control=ctr) nm <- mledist(x, dist="beta", optim.method="Nelder", control=ctr) getval <- function(x) c(x$estimate, loglik=x$loglik, x$counts) cbind(NM=getval(nm), NMgrad=getval(nm_gr), CG=getval(cg), CGgrad=getval(cg_gr), BFGS=getval(bfgs), BFGSgrad=getval(bfgs_gr)) llsurface(data = x, distr = "beta", plot.arg = c("shape1", "shape2"), min.arg = c(0.1, 0.1), max.arg = c(7, 3), pal.col = heat.colors(50)) points(bfgs$estimate[1], bfgs$estimate[2], pch="+", col="red") points(3, 3/4, pch="x", col="green") fitdistrplus/tests/t-bootdist.R0000644000176200001440000002102014050660542016360 0ustar liggesuserslibrary(fitdistrplus) #We choose a low number of bootstrap replicates in order to satisfy CRAN running times constraint. #For practical application, we recommend to use nbboot=501 or nbboot=1001. nbboot <- 1001 nbboot <- 11 nsample <- 100 nsample <- 10 visualize <- FALSE # TRUE for manual tests with visualization of results # (1) Fit of a gamma distribution to serving size data # using default method (maximum likelihood estimation) # followed by parametric bootstrap # data(groundbeef) serving <- groundbeef$serving f1 <- fitdist(serving, "gamma") b1 <- bootdist(f1, niter=nbboot, silent=TRUE) b1 <- bootdist(f1, niter=nbboot, silent=FALSE) print(lapply(b1, head)) plot(b1) summary(b1) # (1) bis test new plot arguments #for new graph functions f1 <- fitdist(rgamma(nsample, 2, 3), "gamma") b1 <- bootdist(f1, niter=nbboot, silent=TRUE) plot(b1) plot(b1, trueval = c(2, 3)) plot(b1, enhance=TRUE) plot(b1, enhance=TRUE, trueval = c(2, 3)) plot(b1, enhance=TRUE, rampcol=c("blue", "green"), nbgrid=15, nbcol=15) if(any(installed.packages()[, "Package"] == "actuar") && visualize) { require(actuar) set.seed(123) f1 <- fitdist(rburr(nsample, 2, 3, 1), "burr", start=list(shape1=10, shape2=10, rate=1)) b1 <- bootdist(f1, niter=nbboot, silent=TRUE) plot(b1) plot(b1, trueval = c(2, 3, 1)) plot(b1, enhance=TRUE) plot(b1, enhance=TRUE, trueval = c(2, 3, 1)) } # (3) estimation of the rate of a gamma distribution # by maximum likelihood with the shape fixed at 4 using the argument fix.arg # followed by parametric bootstrap # f1c <- fitdist(serving, "gamma", start=list(rate=0.1), fix.arg=list(shape=4)) b1c <- bootdist(f1c, niter=nbboot) summary(b1c) # (4) fit of a gamma distribution to serving size data # by quantile matching estimation (in this example matching # first and third quartiles) followed by parametric bootstrap # f1d <- fitdist(serving, "gamma", method="qme", probs=c(0.25, 0.75)) b1d <- bootdist(f1d, niter=nbboot) summary(b1d) # (5) fit of a gamma distribution with control of the optimization # method, followed by parametric bootstrap # if(visualize) { # check ERROR on aarch64-apple-darwin20.4.0 (64-bit) (2021/05/12) set.seed(1234) f1e <- fitdist(serving, "gamma", optim.method="L-BFGS-B", lower=c(0, 0)) b1e <- bootdist(f1e, niter=nbboot) summary(b1e) } # (6) fit of a discrete distribution by matching moment estimation # (using a closed formula) followed by parametric bootstrap # set.seed(1234) x2 <- rpois(nsample, lambda = 5) f2 <- fitdist(x2, "pois", method="mme") b2 <- bootdist(f2, niter=nbboot) plot(b2,pch=16) summary(b2) # (7) Fit of a uniform distribution using the Cramer-von Mises distance # followed by parametric bootstrap # if(visualize) { x3 <- runif(nsample, min=5, max=10) f3 <- fitdist(x3, "unif", method="mge", gof="CvM") b3 <- bootdist(f3, bootmethod="param", niter=nbboot) summary(b3) plot(b3) } # (9) fit of a Weibull distribution to serving size data by maximum likelihood # estimation or by quantile matching estimation (in this example matching # first and third quartiles) followed by parametric bootstrap # fWmle <- fitdist(serving, "weibull") bWmle <- bootdist(fWmle, niter=nbboot) summary(bWmle) quantile(bWmle, probs=c(0.25, 0.75)) fWqme <- fitdist(serving, "weibull", method="qme", probs=c(0.25, 0.75)) bWqme <- bootdist(fWqme, niter=nbboot) summary(bWqme) quantile(bWqme, probs=c(0.25, 0.75)) # (10) Fit of a Pareto distribution by numerical moment matching estimation # followed by parametric bootstrap # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LONG TO RUN !!!!!!!!!!!!!!!!!!!!!!!! # if (visualize) { if(any(installed.packages()[, "Package"] == "actuar")) { require(actuar) #simulate a sample x4 <- rpareto(nsample, 6, 2) memp <- function(x, order) ifelse(order == 1, mean(x), sum(x^order)/length(x)) f4 <- fitdist(x4, "pareto", "mme", order=1:2, start=list(shape=10, scale=10), lower=1, memp="memp", upper=50) b4 <- bootdist(f4, niter=nbboot) summary(b4) b4npar <- bootdist(f4, niter=nbboot, bootmethod="nonparam") summary(b4npar) } } # (11) Fit of a Burr distribution (3 parameters) using MLE # followed by parametric boostrap # !!!!!!!!!!!!!!!! LONG TO RUN !!!!!!!!!!!!!!!!!! # if (visualize) { if(any(installed.packages()[, "Package"] == "actuar")) { require(actuar) data(danishuni) fdan <- fitdist(danishuni$Loss, "burr", method="mle", start=list(shape1=5, shape2=5, rate=10), lower=0+1e-1, control=list(trace=0)) bdan <- bootdist(fdan, bootmethod="param", niter=nbboot) summary(bdan) plot(bdan) cdfcomp(fdan, xlogscale=TRUE) } } # (12) Fit of a Triangular distribution (3 parameters) using MLE # followed by parametric boostrap, with crashes of optim # if(any(installed.packages()[, "Package"] == "mc2d")) { require(mc2d) set.seed(1234) x4 <- rtriang(100,min=0,mode=4,max=20) # nsample not used : does not converge if the sample is too small fit4t<-fitdist(x4,dtriang,start=list(min=0,mode=4,max=20)) summary(fit4t) b4t<-bootdist(fit4t,niter=nbboot) b4t plot(b4t) summary(b4t) quantile(b4t) } # (13) Fit of a Pareto and a Burr distribution, with bootstrap on the Burr distribution # # if(visualize) { data(endosulfan) ATV <-endosulfan$ATV plotdist(ATV) descdist(ATV,boot=nbboot) fln <- fitdist(ATV, "lnorm") summary(fln) gofstat(fln) # use of plotdist to find good reasonable initial values for parameters plotdist(ATV, "pareto", para=list(shape=1, scale=500)) fP <- fitdist(ATV, "pareto", start=list(shape=1, scale=500)) summary(fP) gofstat(fP) # definition of the initial values from the fit of the Pareto # as the Burr distribution is the Pareto when shape2 == 1 fB <- fitdist(ATV, "burr", start=list(shape1=0.3, shape2=1, rate=1)) summary(fB) gofstat(fB) cdfcomp(list(fln,fP,fB),xlogscale=TRUE) qqcomp(list(fln,fP,fB),xlogscale=TRUE,ylogscale=TRUE) ppcomp(list(fln,fP,fB),xlogscale=TRUE,ylogscale=TRUE) denscomp(list(fln,fP,fB)) # without great interest as hist does accept argument log="x" # comparison of HC5 values (5 percent quantiles) quantile(fln,probs=0.05) quantile(fP,probs=0.05) quantile(fB,probs=0.05) # bootstrap for the Burr distribution bfB <- bootdist(fB,niter=nbboot) plot(bfB) } # (14) relevant example for zero modified geometric distribution # dzmgeom <- function(x, p1, p2) { p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) } pzmgeom <- function(q, p1, p2) { p1 * (q >= 0) + (1-p1)*pgeom(q-1, p2) } rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } x2 <- rzmgeom(nsample, 1/2, 1/10) f2 <- fitdist(x2, "zmgeom", method="mle", fix.arg=function(x) list(p1=mean(x == 0)), start=list(p2=1/2)) b2 <- bootdist(f2, niter=nbboot) plot(b2) f3 <- fitdist(x2, "zmgeom", method="mle", start=list(p1=1/2, p2=1/2)) b3 <- bootdist(f3, niter=nbboot) plot(b3, enhance=TRUE) # (15) does fixing p1 reduce bias of estimating p2? summary(b2$estim[, "p2"] - 1/10) summary(b3$estim[, "p2"] - 1/10) par(mfrow=c(1, 2)) hist(b2$estim[, "p2"] - 1/10, breaks=100, xlim=c(-.015, .015)) hist(b3$estim[, "p2"] - 1/10, breaks=100, xlim=c(-.015, .015)) par(mfrow=c(1, 1)) # (16) efficiency of parallel operation if (visualize) { niter <- 1001 data(groundbeef) serving <- groundbeef$serving f1 <- fitdist(serving, "gamma") alltime <- matrix(NA, 9, 5) colnames(alltime) <- c("user.self", "sys.self", "elapsed", "user.child", "sys.child" ) rownames(alltime) <- c("base R", paste("snow", 1:4), paste("multicore", 1:4)) alltime[1,] <- system.time(res <- bootdist(f1, niter = niter)) for (cli in 1:4) { cat("\nnb cluster", cli, "\n") #ptm <- proc.time() alltime[cli+1,] <- system.time(res <- bootdist(f1, niter = niter, parallel = "snow", ncpus = cli)) print(summary(res)) #print(proc.time() - ptm) } # not available on Windows if(.Platform$OS.type == "unix") for (cli in 1:4) { cat("\nnb cluster", cli, "\n") #ptm <- proc.time() alltime[cli+5,] <- system.time(res <- bootdist(f1, niter = niter, parallel = "multicore", ncpus = cli)) print(summary(res)) #print(proc.time() - ptm) } alltime } # (17) bootdist with weights (not yet available, test of error message) # x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) (f1 <- fitdist(x, "pois")) (f2 <- fitdist(xval, "pois", weights = xtab)) summary(bootdist(f1, niter = nbboot)) try(summary(bootdist(f2, niter = nbboot))) # not yet developed fitdistrplus/tests/t-init-actuar.R0000644000176200001440000000260013742313702016754 0ustar liggesusersif(FALSE) { require(fitdistrplus) #test actuar initialization start.arg.default <- fitdistrplus:::start.arg.default #burr library(actuar) alpha <- 3 x <- rburr(1000, alpha, 4, .1) initburr <- function(x) { pi <- 1:3/4 qi <- 1-pi xi <- as.numeric(quantile(x, probs=pi)) y <- log(xi[2])/log(xi[1]/xi[2]) y1 <- log(xi[3]/xi[2])/log(xi[2]/xi[1]) y2 <- log(xi[1]/xi[3])/log(xi[2]/xi[1]) f <- function(eta) (qi[1]^eta-1)^y1*(qi[2]^eta-1)^y2*(qi[3]^eta-1) - 1 eta <- try(uniroot(f, c(-10, -1e-6))$root, silent=TRUE) if(class(eta) == "try-error") eta <- -1 alpha <- -1/eta lambda <- (qi[1]^eta-1)^y*(qi[2]^eta-1)^(-y-1) gamma <- log(lambda*(qi[1]^eta-1))/log(xi[1]) theta <- lambda^(1/gamma) list(shape1=alpha, shape2=gamma, rate=1/theta) } initburr(x) #fitdist(x, "burr", lower=0, start=initburr(x)) #transformed gamma x <- rtrgamma(1000, 3, 2, .1) start1 <- start.arg.default(x, "trgamma") plot(ecdf(x)) curve(ptrgamma(x, start1$shape1, start1$shape2, start1$rate), add=TRUE, lty=2) #fitdist(x, "trgamma", lower=0) #inverse transformed gamma y <- rinvtrgamma(1000, 3, 2, .1) start1 <- start.arg.default(y, "invtrgamma") plot(ecdf(y)) curve(pinvtrgamma(x, start1$shape1, start1$shape2, start1$rate), add=TRUE, lty=2) #fitdist(y, "invtrgamma") } fitdistrplus/tests/t-getparam.R0000644000176200001440000000035713742313702016343 0ustar liggesuserslibrary(fitdistrplus) computegetparam <- fitdistrplus:::computegetparam computegetparam(names(formals(dgamma))) computegetparam(names(formals(pgamma))) computegetparam(names(formals(qgamma))) computegetparam(names(formals(dnbinom))) fitdistrplus/tests/t-mledist-nocens.R0000644000176200001440000002525713742313702017475 0ustar liggesuserslibrary(fitdistrplus) # (1) basic fit of a normal distribution with maximum likelihood estimation # set.seed(1234) x1 <- rnorm(n=100) mledist(x1,"norm") # (2) defining your own distribution functions, here for the Gumbel distribution # for other distributions, see the CRAN task view dedicated to probability distributions dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) mledist(x1,"gumbel",start=list(a=10,b=5), silent=TRUE) mledist(x1,"gumbel",start=list(a=10,b=5), silent=FALSE) # (3) fit a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=30,lambda = 2) mledist(x2,"pois") # (4) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=100,shape1=5, shape2=10) mledist(x3,"beta") # (5) fit frequency distributions on USArrests dataset. # x4 <- USArrests$Assault mledist(x4, "pois", silent=TRUE) mledist(x4, "pois", silent=FALSE) mledist(x4, "nbinom") # (6) scaling problem # the simulated dataset (below) has particularly small values, hence without scaling (10^0), # the optimization raises an error. The for loop shows how scaling by 10^i # for i=1,...,6 makes the fitting procedure work correctly. set.seed(1234) x2 <- rnorm(100, 1e-4, 2e-4) for(i in 6:0) cat(i, try(mledist(x*10^i, "cauchy")$estimate, silent=TRUE), "\n") # (7) scaling problem # x <- c(-0.00707717, -0.000947418, -0.00189753, -0.000474947, -0.00190205, -0.000476077, 0.00237812, 0.000949668, 0.000474496, 0.00284226, -0.000473149, -0.000473373, 0, 0, 0.00283688, -0.0037843, -0.0047506, -0.00238379, -0.00286807, 0.000478583, 0.000478354, -0.00143575, 0.00143575, 0.00238835, 0.0042847, 0.00237248, -0.00142281, -0.00142484, 0, 0.00142484, 0.000948767, 0.00378609, -0.000472478, 0.000472478, -0.0014181, 0, -0.000946522, -0.00284495, 0, 0.00331832, 0.00283554, 0.00141476, -0.00141476, -0.00188947, 0.00141743, -0.00236351, 0.00236351, 0.00235794, 0.00235239, -0.000940292, -0.0014121, -0.00283019, 0.000472255, 0.000472032, 0.000471809, -0.0014161, 0.0014161, -0.000943842, 0.000472032, -0.000944287, -0.00094518, -0.00189304, -0.000473821, -0.000474046, 0.00331361, -0.000472701, -0.000946074, 0.00141878, -0.000945627, -0.00189394, -0.00189753, -0.0057143, -0.00143369, -0.00383326, 0.00143919, 0.000479272, -0.00191847, -0.000480192, 0.000960154, 0.000479731, 0, 0.000479501, 0.000958313, -0.00383878, -0.00240674, 0.000963391, 0.000962464, -0.00192586, 0.000481812, -0.00241138, -0.00144963) #only i == 0, no scaling, should not converge. for(i in 6:0) cat(i, try(mledist(x*10^i, "cauchy")$estimate, silent=TRUE), "\n") # (8) normal mixture # #mixture of two normal distributions #density dnorm2 <- function(x, w, m1, s1, m2, s2) w*dnorm(x, m1, s1) + (1-w)*dnorm(x, m2, s2) #numerically-approximated quantile function qnorm2 <- function(p, w, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, w, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-20, 30), prob=pr)$minimum) } #distribution function pnorm2 <- function(q, w, m1, s1, m2, s2) w*pnorm(q, m1, s1) + (1-w)*pnorm(q, m2, s2) #basic normal distribution x <- c(rnorm(1000, 5), rnorm(1000, 10)) #MLE fit fit1 <- mledist(x, "norm2", start=list(w=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0)) # (9) fit a Pareto and log-logistic distributions # if(any(installed.packages()[,"Package"] == "actuar")) { require(actuar) #simulate a sample x4 <- rpareto(1000, 6, 2) #fit mledist(x4, "pareto", start=list(shape=10, scale=10), lower=1, upper=Inf) #simulate a sample x4 <- rllogis(1000, 6, 2) #fit mledist(x4, "llogis", start=list(shape=10, rate=1), lower=1, upper=Inf) } # (10) custom optim for exponential distribution # if(any(installed.packages()[,"Package"] == "rgenoud") && FALSE) { mysample <- rexp(1000, 5) mystart <- list(rate=8) fNM <- mledist(mysample, "exp", optim.method="Nelder-Mead") fBFGS <- mledist(mysample, "exp", optim.method="BFGS") fLBFGSB <- mledist(mysample, "exp", optim.method="L-BFGS-B", lower=0) fSANN <- mledist(mysample, "exp", optim.method="SANN") fCG <- try(mledist(mysample, "exp", optim.method="CG") ) if(class(fCG) == "try-error") fCG <- list(estimate=NA) #the warning tell us to use optimise... #to meet the standard 'fn' argument and specific name arguments, we wrap optimize, myoptimize <- function(fn, par, ...) { res <- optimize(f=fn, ..., maximum=FALSE) c(res, convergence=0, value=res$objective, par=res$minimum, hessian=NA) } foptimize <- mledist(mysample, "exp", start=mystart, custom.optim=myoptimize, interval=c(0, 100)) library(rgenoud) #wrap genoud function rgenoud package mygenoud <- function(fn, par, ...) { res <- genoud(fn, starting.values=par, ...) c(res, convergence=0, counts=NULL) } fgenoud <- mledist(mysample, "exp", start=mystart, custom.optim= mygenoud, nvars=1, Domains=cbind(0, 10), boundary.enforcement=1, hessian=TRUE, print.level=0) c(NM=fNM$estimate, BFGS=fBFGS$estimate, LBFGSB=fLBFGSB$estimate, SANN=fSANN$estimate, CG=fCG$estimate, optimize=foptimize$estimate, fgenoud=fgenoud$estimate) } # (11) custom optim for gamma distribution # if(any(installed.packages()[,"Package"] == "rgenoud") && FALSE) { mysample <- rgamma(1000, 5, 3) mystart <- c(shape=10, rate=10) fNM <- mledist(mysample, "gamma", optim.method="Nelder-Mead") fBFGS <- mledist(mysample, "gamma", optim.method="BFGS") fLBFGSB <- mledist(mysample, "gamma", optim.method="L-BFGS-B", lower=0) fSANN <- mledist(mysample, "gamma", optim.method="SANN") fCG <- try( mledist(mysample, "gamma", optim.method="CG", control=list(maxit=1000)) ) if(class(fCG) == "try-error") fCG <- list(estimate=NA) fgenoud <- mledist(mysample, "gamma", start=mystart, custom.optim= mygenoud, nvars=2, Domains=cbind(c(0,0), c(100,100)), boundary.enforcement=1, hessian=TRUE, print.level=0) cbind(NM=fNM$estimate, BFGS=fBFGS$estimate, LBFGSB=fLBFGSB$estimate, SANN=fSANN$estimate, CG=fCG$estimate, fgenoud=fgenoud$estimate) data(groundbeef) fNM <- mledist(groundbeef$serving, "gamma", optim.method="Nelder-Mead") fBFGS <- mledist(groundbeef$serving, "gamma", optim.method="BFGS") fLBFGSB <- mledist(groundbeef$serving, "gamma", optim.method="L-BFGS-B", lower=0) fSANN <- mledist(groundbeef$serving, "gamma", optim.method="SANN") fCG <- try( mledist(groundbeef$serving, "gamma", optim.method="CG", control=list(maxit=10000)) ) if(class(fCG) == "try-error") fCG <- list(estimate=NA) fgenoud <- mledist(groundbeef$serving, "gamma", start=list(shape=4, rate=1), custom.optim= mygenoud, nvars=2, max.generations=10, Domains=cbind(c(0,0), c(10,10)), boundary.enforcement=1, hessian=TRUE, print.level=0, P9=10) cbind(NM=fNM$estimate, BFGS=fBFGS$estimate, LBFGSB=fLBFGSB$estimate, SANN=fSANN$estimate, CG=fCG$estimate, fgenoud=fgenoud$estimate) } # (12) test error messages # dnorm2 <- function(x, a) "NA" x <- rexp(10) #should get a one-line error res <- mledist(x, "norm2", start=list(a=1)) #as in attr(try(log("a"), silent=TRUE), "condition") # (13) weighted MLE # n <- 1e6 n <- 1e2 x <- rpois(n, 10) xtab <- table(x) xval <- sort(unique(x)) f1 <- mledist(x, "pois", start=list(lambda=mean(x)), optim.method="Brent", lower=0, upper=100, control=list(trace=1)) f2 <- mledist(xval, "pois", weights=xtab, start=list(lambda=mean(x))) f1$estimate f2$estimate #should be identical #test discrete distrib f2 <- try(mledist(xval, "pois", weights=1:length(xval), start=list(lambda=mean(x)))) #test non integer weights f2 <- try(mledist(xval, "pois", weights=rep(1/3, length(xval)), start=list(lambda=mean(x)))) f2 <- try(mledist(1:10, "pois", weights=c(rep(1, 9), 1.001), start=list(lambda=mean(x)))) f2 <- try(mledist(1:10, "pois", weights=c(rep(1, 9), 1.0000001), start=list(lambda=mean(x)))) # (14) no convergence # n <- 1e2 x <- c(rep(0, n), rpois(n, 10), rpois(n, 50)) mledist(x, "pois", optim.method="Nelder-Mead", control=list(maxit=10)) # (15) basic fit of a normal distribution with new fix.arg/start.arg # set.seed(1234) x1 <- rnorm(n=100) #correct usage mledist(x1,"norm") mledist(x1,"norm", start=function(x) list(mean=0, sd=1)) mledist(x1,"norm", fix.arg=function(x) list(mean=mean(x))) mledist(x1,"norm", fix.arg=list(mean=1/2)) mledist(x1,"norm", fix.arg=list(mean=1/2), start=list(sd=1)) mledist(x1,"norm", fix.arg=function(x) list(mean=0), start=list(sd=1)) mledist(x1,"norm", fix.arg=function(x) list(mean=mean(x)), start=list(sd=1)) #wrong usage (see text message in util-checkparam.R) try( mledist(x1,"norm", start=list(a=1/2)) ) #t3 try( mledist(x1,"norm", start=function(x) list(a=0, b=1)) ) #t3 try( mledist(x1,"norm", fix.arg=list(a=1/2)) ) #t4 try( mledist(x1,"norm", fix.arg=function(x) list(a=0), start=list(sd=1)) ) #t4 try( mledist(x1,"norm", start=matrix(1/2)) ) #t1 try( mledist(x1,"norm", fix.arg=matrix(1/2)) ) #t0 try( mledist(x1,"norm", fix.arg=matrix(1/2), start=matrix(1/2)) ) #t2 try( mledist(x1,"norm", fix.arg=function(x) list(mean=mean(x), sd=2), start=list(sd=1)) ) #t5 dabcnorm <- function(x, mean, sd) 1 try( mledist(x1,"abcnorm", fix.arg=function(x) list(mean=mean(x))) ) #t8 # (16) relevant example for zero modified geometric distribution # dzmgeom <- function(x, p1, p2) { p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) } rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } # check # dzmgeom(0:5, 1/2, 1/10) x2 <- rzmgeom(100, 1/2, 1/10) x3 <- rzmgeom(100, 1/3, 1/10) x4 <- rzmgeom(100, 1/4, 1/10) table(x2) #this is the MLE which converges almost surely and in distribution to the true value. initp1 <- function(x) list(p1=mean(x == 0)) mledist(x2, "zmgeom", fix.arg=initp1, start=list(p2=1/2))[c("estimate", "fix.arg")] mledist(x3, "zmgeom", fix.arg=initp1, start=list(p2=1/2))[c("estimate", "fix.arg")] mledist(x4, "zmgeom", fix.arg=initp1, start=list(p2=1/2))[c("estimate", "fix.arg")] # (17) test the component optim.message x <- rnorm(100) #change parameter to obtain unsuccessful convergence mledist(x, "norm", control=list(maxit=2), start=list(mean=1e5, sd=1), optim.method="L-BFGS-B", lower=0) # (18) management of bounds in optim/constrOptim x <- rexp(100) mledist(x, "exp") #optim, BFGS mledist(x, "exp", optim.method="Brent", lower=0, upper=100) #optim, Brent mledist(x, "exp", optim.method="Nelder-Mead") #optim, Nelder-Mead mledist(x, "exp", lower=0, optim.method="Nelder-Mead") #constrOptim, Nelder-Mead mledist(x, "exp", lower=0, optim.method="BFGS") #optim, L-BFGS-B x <- rbeta(100, 3/2, 7/3) mledist(x, "beta", optim.method="Nelder") #optim, Nelder-Mead mledist(x, "beta", lower=0, optim.method="Nelder-Mead") #constrOptim, Nelder-Mead #as the result of optim(c(-1.2,1), fr, method = "Nelder-Mead", hessian=TRUE, gr=NULL, lower=-Inf, upper=Inf) from optim() example mledist(x, "beta", lower=0, optim.method="BFGS") #optim, L-BFGS-B fitdistrplus/tests/t-cvg-algo.R0000644000176200001440000001003514050660542016234 0ustar liggesusers if(FALSE) { library(fitdistrplus) #(1) beta distribution # n <- 100 set.seed(12345) x <- rbeta(n, 3, 3/4) psi <- function(x) digamma(x) grbetalnl <- function(x, a, b) c(log(x)-psi(a)+psi(a+b), log(1-x)-psi(b)+psi(a+b)) #grbetalnl(x, 3, 4) grlnL <- function(par, obs, ...) -rowSums(sapply(obs, function(x) grbetalnl(x, a=par[1], b=par[2]))) #rowSums(sapply(x, function(x) grbetalnl(x, 3, 4))) #grlnL(c(3, 4), x) #grlnL(c(3, 3/4), x) constrOptim2 <- function(par, fn, gr=NULL, ui, ci, ...) constrOptim(theta=unlist(par), f=fn, grad=gr, ui=ui, ci=ci, ...) #control parameters ctr <- list(trace=3, REPORT=1, maxit=1000) ctr <- list(trace=0, REPORT=1, maxit=1000) bfgs_gr$time <- system.time(bfgs_gr <- mledist(x, dist="beta", optim.method="BFGS", gr=grlnL, control=ctr))[3] bfgs <- mledist(x, dist="beta", optim.method="BFGS", control=ctr) lbfgs_gr <- mledist(x, dist="beta", optim.method="L-BFGS-B", gr=grlnL, control=ctr, lower=c(0,0)) lbfgs <- mledist(x, dist="beta", optim.method="L-BFGS-B", control=ctr, lower=c(0,0)) cg_gr <- mledist(x, dist="beta", optim.method="CG", gr=grlnL, control=ctr) cg <- mledist(x, dist="beta", optim.method="CG", control=ctr) nm_gr <- mledist(x, dist="beta", optim.method="Nelder", gr=grlnL, control=ctr) nm <- mledist(x, dist="beta", optim.method="Nelder", control=ctr) constr_nm_gr <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="Nelder", gr=grlnL, control=ctr) constr_nm <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="Nelder", control=ctr) constr_bfgs_gr <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="BFGS", gr=grlnL, control=ctr) constr_bfgs <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="BFGS", control=ctr) constr_cg_gr <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="CG", gr=grlnL, control=ctr) constr_cg <- mledist(x, dist="beta", custom.optim=constrOptim2, ui = diag(2), ci = c(0, 0), optim.method="CG", control=ctr) lnL <- function(par, fix.arg, obs, ddistnam) { fitdistrplus:::loglikelihood(par, fix.arg, obs, ddistnam, weights = rep(1, NROW(obs))) } constrOptim2(c(shape1=1, shape2=1), lnL, obs=x, fix.arg=NULL, ddistnam="dbeta", ui = diag(2), ci = c(0, 0)) #no log dbeta3 <- function(x, shape1, shape2) dbeta(x, shape1, shape2) #Ripley trick : param transform dbeta2 <- function(x, shape1, shape2, log) dbeta(x, exp(shape1), exp(shape2), log=log) pbeta2 <- function(q, shape1, shape2, log.p) pbeta(q, exp(shape1), exp(shape2), log.p=log.p) bfgs2 <- mledist(x, dist="beta2", optim.method="BFGS", control=ctr, start=list(shape1=0, shape2=0)) bfgs3 <- mledist(x, dist="beta3", optim.method="BFGS", control=ctr, start=list(shape1=1, shape2=1)) getval <- function(x) c(x$estimate, loglik=x$loglik, x$counts) getval2 <- function(x) c(exp(x$estimate), loglik=x$loglik, x$counts) cbind(trueval=c(3, 3/4, lnL(c(3, 3/4), NULL, x, "dbeta"), NA, NA), NM=getval(nm), NMgrad=getval(nm_gr), constr_NM=getval(constr_nm), constr_NMgrad=getval(constr_nm_gr), CG=getval(cg), CGgrad=getval(cg_gr), constr_CG=getval(constr_cg), constr_CGgrad=getval(constr_cg_gr), BFGS=getval(bfgs), BFGSgrad=getval(bfgs_gr), constr_BFGS=getval(constr_bfgs), constr_BFGSgrad=getval(constr_bfgs_gr), BFGS_exp=getval2(bfgs2), BFGS_nolog=getval(bfgs3)) llsurface(min.arg=c(0.1, 0.1), max.arg=c(7, 3), plot.arg=c("shape1", "shape2"), lseq=50, data=x, distr="beta") points(bfgs$estimate[1], bfgs$estimate[2], pch="+", col="red") points(3, 3/4, pch="x", col="green") } fitdistrplus/tests/t-parallel.R0000644000176200001440000000216513742313702016336 0ustar liggesusersvisualize <- FALSE # TRUE for manual tests with visualization of results if(visualize) { library(parallel) #fonction basique evaluant la moyenne empirique d'un echantillon gaussien f <- function(i) mean(rnorm(1e4, mean=i)) #exemple simple glist <- 1:20 cl <- parallel::makeCluster(2) system.time( res <- parallel::parLapply(cl, glist, f) ) parallel::stopCluster(cl) #exemple en faisant varier le nombre de coeurs et le nombre de simulations nbsimu <- 10^(1:2) cores <- 1:4 cores <- 1:getOption("cl.cores", 2) partime <- matrix(NA, length(nbsimu), length(cores)+1) colnames(partime) <- c("R", paste("core",cores)) rownames(partime) <- paste("n", nbsimu, sep="=") partime[, 1] <- sapply(1:length(nbsimu), function(i) system.time(lapply(1:nbsimu[i], f))[3]) for(j in 1:length(cores)) { print(cores[j]) cl <- parallel::makeCluster(cores[j]) partime[, j+1] <- sapply(1:length(nbsimu), function(i) system.time(parallel::parLapply(cl, 1:nbsimu[i], f))[3]) parallel::stopCluster(cl) } partime }fitdistrplus/tests/t-ppcompcens.R0000644000176200001440000000447013742313702016712 0ustar liggesuserslibrary(fitdistrplus) visualize <- FALSE # TRUE for manual tests with visualization of results data(smokedfish) fitsf <- fitdistcens(smokedfish,"lnorm") plot(fitsf) ppcompcens(fitsf) ppcompcens(fitsf, fillrect = NA) ppcompcens(fitsf, fitcol = "black") ppcompcens(fitsf, fitcol = "black", fillrect = NA) ppcompcens(fitsf, ylim = c(0.4,1)) ppcompcens(fitsf, xlim = c(0.4,1)) ppcompcens(fitsf, xlim = c(0.4,1), ylim = c(0,1)) ppcompcens(fitsf, xlim = c(0.5,0.99), xlogscale = TRUE) try(ppcompcens(fitsf, xlogscale = TRUE)) if (requireNamespace("ggplot2", quietly = TRUE)) { ppcompcens(fitsf, plotstyle = "ggplot") } if (requireNamespace("ggplot2", quietly = TRUE) & visualize) { ppcompcens(fitsf, fillrect = NA, plotstyle = "ggplot") ppcompcens(fitsf, fitcol = "black", plotstyle = "ggplot") ppcompcens(fitsf, fitcol = "black", fillrect = NA, plotstyle = "ggplot") ppcompcens(fitsf, ylim = c(0.4,1), plotstyle = "ggplot") ppcompcens(fitsf, xlim = c(0.4,1), plotstyle = "ggplot") ppcompcens(fitsf, xlim = c(0.4,1), ylim = c(0,1), plotstyle = "ggplot") ppcompcens(fitsf, xlim = c(0.5,0.99), xlogscale = TRUE, plotstyle = "ggplot") } if (visualize) { data(fluazinam) log10EC50 <-log10(fluazinam) fln <- fitdistcens(log10EC50,"norm") plot(fln) if (requireNamespace("ggplot2", quietly = TRUE)) { ppcompcens(fln, plotstyle = "ggplot") } } data(salinity) log10LC50 <-log10(salinity) fn <- fitdistcens(log10LC50,"norm") fl <- fitdistcens(log10LC50,"logis") ppcompcens(list(fn, fl)) ppcompcens(list(fn, fl), fitlwd = c(5, 2)) if (visualize) { plotdistcens(log10LC50) plotdistcens(log10LC50, NPMLE = FALSE) plot(fn) plot(fl) ppcompcens(fn) ppcompcens(fl) ppcompcens(list(fn, fl), ynoise = FALSE) ppcompcens(list(fn, fl), xlogscale = TRUE, xlim = c(0.01, 0.6)) } if (requireNamespace ("ggplot2", quietly = TRUE) ) { ppcompcens(list(fn, fl), plotstyle = "ggplot", fitcol = "red") ppcompcens(list(fn, fl), plotstyle = "ggplot", fitlwd = c(5, 2)) } if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { ppcompcens(fn, plotstyle = "ggplot") ppcompcens(fl, plotstyle = "ggplot") ppcompcens(list(fn, fl), plotstyle = "ggplot", fitcol = "red") ppcompcens(list(fn, fl), ynoise = FALSE, plotstyle = "ggplot") ppcompcens(list(fn, fl), xlogscale = TRUE, xlim = c(0.01, 0.6), plotstyle = "ggplot") } fitdistrplus/tests/t-fitdist.R0000644000176200001440000002626414050660542016216 0ustar liggesuserslibrary(fitdistrplus) nbboot <- 100 nbboot <- 10 nsample <- 100 nsample <- 10 visualize <- FALSE # TRUE for manual tests with visualization of results # (1) basic fit of a gamma distribution by maximum likelihood estimation # data(groundbeef) serving <- groundbeef$serving fitg <- fitdist(serving, "gamma") summary(fitg) plot(fitg) cdfcomp(fitg, addlegend=FALSE) #check names names(fitdist(serving, "gamma", optim.method="Brent", lower=0, upper=10, fix.arg=list(shape=2))$estimate) names(fitdist(serving, "gamma", optim.method="Nelder-Mead")$estimate) names(fitdist(serving, "gamma", optim.method="BFGS")$estimate) # names(fitdist(serving, "gamma", optim.method="CG", start=list(shape=4, rate=1/20))$estimate) if(visualize) { # check ERROR on aarch64-apple-darwin20.4.0 (64-bit) (2021/05/12) set.seed(1234) names(fitdist(serving, "gamma", optim.method="L-BFGS-B", lower=0)$estimate) } # (7) custom optimization function # #create the sample set.seed(1234) mysample <- rexp(nsample, 5) mystart <- list(rate=8) res1 <- fitdist(mysample, dexp, start= mystart, optim.method="Nelder-Mead") #show the result summary(res1) #the warning tell us to use optimise, because the Nelder-Mead is not adequate. #to meet the standard 'fn' argument and specific name arguments, we wrap optimize, myoptimize <- function(fn, par, ...) { res <- optimize(f=fn, ..., maximum=FALSE) #assume the optimization function minimize standardres <- c(res, convergence=0, value=res$objective, par=res$minimum, hessian=NA) return(standardres) } #call fitdist with a 'custom' optimization function res2 <- fitdist(mysample, dexp, start=mystart, custom.optim=myoptimize, interval=c(0, 100)) #show the result summary(res2) # (8) custom optimization function - another example with the genetic algorithm # if(any(installed.packages()[,"Package"] == "rgenoud") && visualize) { #set a sample fit1 <- fitdist(serving, "gamma") summary(fit1) #wrap genoud function rgenoud package mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values=par, ...) standardres <- c(res, convergence=0, counts=NULL) return(standardres) } #call fitdist with a 'custom' optimization function fit2 <- fitdist(serving, "gamma", custom.optim=mygenoud, nvars=2, start=as.list(fit1$estimate), Domains=cbind(c(0, 0), c(10, 10)), boundary.enforcement=1, print.level=0, hessian=TRUE) summary(fit2) } # (11) Fit of a Pareto distribution by numerical moment matching estimation # if(any(installed.packages()[,"Package"] == "actuar") && visualize) { require(actuar) #simulate a sample set.seed(1234) x4 <- rpareto(nsample, 6, 2) #empirical raw moment memp <- function(x, order) ifelse(order == 1, mean(x), sum(x^order)/length(x)) #fit fP <- fitdist(x4, "pareto", method="mme", order=c(1, 2), memp="memp", start=list(shape=10, scale=10), lower=1, upper=Inf) summary(fP) plot(fP) } # (14) scaling problem - too small values # if (visualize) # LONG TO RUN ON CRAN { x2 <- c(-0.00707717, -0.000947418, -0.00189753, -0.000474947, -0.00190205, -0.000476077, 0.00237812, 0.000949668, 0.000474496, 0.00284226, -0.000473149, -0.000473373, 0, 0, 0.00283688, -0.0037843, -0.0047506, -0.00238379, -0.00286807, 0.000478583, 0.000478354, -0.00143575, 0.00143575, 0.00238835, 0.0042847, 0.00237248, -0.00142281, -0.00142484, 0, 0.00142484, 0.000948767, 0.00378609, -0.000472478, 0.000472478, -0.0014181, 0, -0.000946522, -0.00284495, 0, 0.00331832, 0.00283554, 0.00141476, -0.00141476, -0.00188947, 0.00141743, -0.00236351, 0.00236351, 0.00235794, 0.00235239, -0.000940292, -0.0014121, -0.00283019, 0.000472255, 0.000472032, 0.000471809, -0.0014161, 0.0014161, -0.000943842, 0.000472032, -0.000944287, -0.00094518, -0.00189304, -0.000473821, -0.000474046, 0.00331361, -0.000472701, -0.000946074, 0.00141878, -0.000945627, -0.00189394, -0.00189753, -0.0057143, -0.00143369, -0.00383326, 0.00143919, 0.000479272, -0.00191847, -0.000480192, 0.000960154, 0.000479731, 0, 0.000479501, 0.000958313, -0.00383878, -0.00240674, 0.000963391, 0.000962464, -0.00192586, 0.000481812, -0.00241138, -0.00144963) for(i in 6:0) { cat("\nscaling", 10^i, "\n") res <- try(mledist(x2*10^i, "cauchy"), silent=TRUE) if(class(res) == "try-error") print(res) else { cat("estimate\n") print(res$estimate) cat("Hessian\n") print(res$hessian) } } } # (15) scaling problem - too big values # if (visualize) # LONG TO RUN ON CRAN { x1 <- c( 1401928684, 1413455609, 1432458425, 1436910475, 1494883250, 1565770323, 1577486458, 1568908053, 1606424896, 1632264979, 1780495643, 1865525923, 2035689865, 2141429306, 2335443964, 2465661689, 2563368221, 2845012431, 2949890881, 3180645942, 3309009836, 3618581152, 4109197451, 4064662257, 4028375795, 4176781983, 4303024833, 4493470109 ) for(i in 0:5) { cat("\nscaling", 10^(-2*i), "\n") res <- mledist(x1*10^(-2*i), "norm") Hm1 <- try(solve(res$hessian), silent=TRUE) if(class(Hm1) == "try-error") print(Hm1) else { cat("estimate\n") print(res$estimate) cat("Hessian\n") print(res$hessian) cat("inverse Hessian\n") print(Hm1) } } fitdist(x1, "norm") fitdist(x1*1e-6, "norm") } # (16) Fit of a lognormal distribution on acute toxicity values of endosulfan for # nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5 percent quantile value of # the fitted distribution, what is called the 5 percent hazardous concentration (HC5) # in ecotoxicology, with its two-sided 95 percent confidence interval calculated by # parametric bootstrap # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") quantile(fln, probs = 0.05) # (17) Fit of a triangular distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # if(any(installed.packages()[,"Package"] == "mc2d") && visualize) { set.seed(1234) require(mc2d) t <- rtriang(100,min=5,mode=6,max=10) # nsample not used : does not converge with a too small sample fCvM <- fitdist(t,"triang",method="mge",start = list(min=4, mode=6,max=9),gof="CvM") fKS <- fitdist(t,"triang",method="mge",start = list(min=4, mode=6,max=9),gof="KS") cdfcomp(list(fCvM,fKS)) } # (18) gumbel distribution # dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) qgumbel <- function(p, a, b) a-b*log(-log(p)) data(danishuni) fitdist(danishuni$Loss, "gumbel", start=list(a=5, b=10)) # (19) check the 'start' argument # if (FALSE) # NO INTEREST WITHOUT VISUALIZATION OF THE RESULT { #create the sample mysample <- rexp(nsample, 5) mystart2 <- list(rate2=8) mystart3 <- list(8) try( fitdist(mysample, dexp, start= mystart2, method="mle") ) try( fitdist(mysample, dexp, start= mystart3, method="mle") ) try( fitdist(mysample, dexp, start= mystart2, method="mme") ) try( fitdist(mysample, dexp, start= mystart3, method="mme") ) try( fitdist(mysample, dexp, start= mystart2, method="qme", probs=1/2) ) try( fitdist(mysample, dexp, start= mystart3, method="qme", probs=1/2) ) try( fitdist(mysample, dexp, start= mystart2, method="mge", gof="AD") ) try( fitdist(mysample, dexp, start= mystart3, method="mge", gof="AD") ) } # (20) example with dexgauss # would require to suggest the package gamlss.dist in the Description file # #if(any(installed.packages()[,"Package"] == "gamlss.dist")) #{ # require(gamlss.dist) # set.seed(1234) # a=rexGAUS(100,mu=500,sigma=50,nu=75) # fitdist(a,dexGAUS,start=list(mu=median(a),sigma=sqrt(var(a)/2),nu=sqrt(var(a)/2))) #} # (21) check the 'keepdata' argument # if (visualize) # REQUIRES VISUALIZATION OF THE RESULTS { #create the sample x <- rexp(1e6, 5) summary(x) f1 <- fitdist(x, "exp", keepdata=FALSE) f2 <- fitdist(x, "exp", keepdata=TRUE) par(mfrow=c(1,2)) cdfcomp(f1) cdfcomp(f2) } # (22) relevant example for zero modified geometric distribution # dzmgeom <- function(x, p1, p2) { p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) } pzmgeom <- function(q, p1, p2) { p1 * (q >= 0) + (1-p1)*pgeom(q-1, p2) } rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } x2 <- rzmgeom(nsample, 1/2, 1/10) table(x2) #this is the MLE which converges almost surely and in distribution to the true value. initp1 <- function(x) list(p1=mean(x == 0)) fitdist(x2, "zmgeom", start=list(p1=1/2, p2=1/2)) f2 <- fitdist(x2, "zmgeom", fix.arg=initp1, start=list(p2=1/2)) print(f2) summary(f2) f2 <- fitdist(x2, "zmgeom", fix.arg=list(p1=1/2), start=list(p2=1/2)) print(f2) summary(f2) # (23) check the use of weights with MLE # set.seed(1234) x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) f1 <- fitdist(x, "pois") f2 <- fitdist(xval, "pois", weights = xtab) f1$estimate f2$estimate #should be identical # (24) check the use of weights with other methods # set.seed(1234) x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) (f1 <- fitdist(x, "norm", method = "mle")) (f2 <- fitdist(xval, "norm", weights = xtab, method = "mle")) (f1 <- fitdist(x, "norm", method = "mme")) (f2 <- fitdist(xval, "norm", weights = xtab, method = "mme")) (f1 <- fitdist(x, "norm", method = "qme", probs=c(1/4, 3/4))) (f2 <- fitdist(xval, "norm", method = "qme", weights = xtab, probs=c(1/4, 3/4) )) fitdist(x, "norm", method="mge", gof = "CvM") try(fitdist(xval, "norm", method="mge", gof = "CvM", weights = xtab)) # not yet developped # (24b) check the use of weights with qme with a discrete distribution # set.seed(1234) x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) (f1 <- fitdist(x, "pois", method = "qme", probs=c(1/2))) (f2 <- fitdist(xval, "pois", method = "qme", weights = xtab, probs=c(1/2) )) # similar to f1 fitdist(xval, "pois", method = "qme", weights = xtab, probs=c(1/2), optim.method="SANN", control=list(maxit=1000)) # fitdist(x, "pois", method = "qme", probs=c(1/2), optim.method="SANN", control=list(maxit=1000)) # should be similar # should give similar results for big samples # (25) check the warning messages when using weights in the fit followed by functions # that do not yet take weights into account # with an example to be used later to see if weights are well taken into account # if(visualize) { x3 <- rnorm(100) # this sample size must be fixed here (see next lines, 50+50) x3 <- sort(x3) (f <- fitdist(x3, "norm", method="mle", weights= c(rep(1, 50), rep(2, 50)))) try(plot(f)) try(cdfcomp(f)) (f2 <- fitdist(x3, "logis", method="mle", weights= c(rep(1, 50), rep(2, 50)))) try(cdfcomp(list(f,f2))) try(denscomp(f)) try(denscomp(list(f,f2))) try(ppcomp(f)) try(ppcomp(list(f,f2))) try(qqcomp(f)) try(qqcomp(list(f,f2))) try(gofstat(f)) try(gofstat(list(f,f2))) try(bootdist(f)) }fitdistrplus/tests/t-startfixarg-overall.R0000644000176200001440000001205613742313702020542 0ustar liggesuserslibrary(fitdistrplus) # (1) non-censored data (continuous) # s1 <- NULL s2 <- list("mean"=2) s0 <- list("mean"=2, "sd"=1) s3 <- function(x) list("mean"=1.01*mean(x)) s4 <- function(x) list("mean"=1.01*mean(x), "sd"=sd(x)) f1 <- NULL f2 <- list("sd"=3) f3 <- function(x) list("sd"=1.01*sd(x)) x <- rnorm(1000) #redefine normal distribution for better check dnorm2 <- dnorm pnorm2 <- pnorm qnorm2 <- qnorm rnorm2 <- rnorm mnorm2 <- function(order, mean, sd) ifelse(order == 1, mean, sd^2) memp <- function(x, order) mean(x^order) # both NULL mf1 <- mledist(x, "norm", start=s1, fix.arg=f1) mf1 <- mmedist(x, "norm", start=s1, fix.arg=f1) mf1 <- qmedist(x, "norm", start=s1, fix.arg=f1, probs=1:2/3) mf1 <- mgedist(x, "norm", start=s1, fix.arg=f1) fit1 <- fitdist(x, "norm", start=s1, fix.arg=f1) boot1 <- bootdist(fit1, niter=10) # both named list mf1 <- mledist(x, "norm2", start=s2, fix.arg=f2) mf1 <- mmedist(x, "norm2", start=s2, fix.arg=f2, order=1, memp=memp) mf1 <- qmedist(x, "norm2", start=s2, fix.arg=f2, probs=1/3) mf1 <- mgedist(x, "norm2", start=s2, fix.arg=f2) fit1 <- fitdist(x, "norm2", start=s2, fix.arg=f2) boot1 <- bootdist(fit1, niter=10) # named list and NULL mf1 <- mledist(x, "norm2", start=s0, fix.arg=f1) mf1 <- mmedist(x, "norm2", start=s0, fix.arg=f1, order=1:2, memp=memp) mf1 <- qmedist(x, "norm2", start=s0, fix.arg=f1, probs=1:2/3) mf1 <- mgedist(x, "norm2", start=s0, fix.arg=f1) fit1 <- fitdist(x, "norm2", start=s0, fix.arg=f1) boot1 <- bootdist(fit1, niter=10) # NULL and named list mf1 <- mledist(x, "norm", start=s1, fix.arg=f2) mf1 <- qmedist(x, "norm", start=s1, fix.arg=f2, probs=1/3) mf1 <- mgedist(x, "norm", start=s1, fix.arg=f2) fit1 <- fitdist(x, "norm", start=s1, fix.arg=f2) boot1 <- bootdist(fit1, niter=10) # both function mf1 <- mledist(x, "norm2", start=s3, fix.arg=f3) mf1 <- mmedist(x, "norm2", start=s3, fix.arg=f3, order=1, memp=memp) mf1 <- qmedist(x, "norm2", start=s3, fix.arg=f3, probs=1/3) mf1 <- mgedist(x, "norm2", start=s3, fix.arg=f3) fit1 <- fitdist(x, "norm2", start=s3, fix.arg=f3) boot1 <- bootdist(fit1, niter=10) # function and NULL mf1 <- mledist(x, "norm2", start=s4, fix.arg=f1) mf1 <- mmedist(x, "norm2", start=s4, fix.arg=f1, order=1:2, memp=memp) mf1 <- qmedist(x, "norm2", start=s4, fix.arg=f1, probs=1:2/3) mf1 <- mgedist(x, "norm2", start=s4, fix.arg=f1) fit1 <- fitdist(x, "norm2", start=s4, fix.arg=f1) boot1 <- bootdist(fit1, niter=10) # NULL and function mf1 <- mledist(x, "norm", start=s1, fix.arg=f3) mf1 <- qmedist(x, "norm", start=s1, fix.arg=f3, probs=1/3) mf1 <- mgedist(x, "norm", start=s1, fix.arg=f3) fit1 <- fitdist(x, "norm", start=s1, fix.arg=f3) boot1 <- bootdist(fit1, niter=10) # should raise error for too less parameters try(mgedist(x, "norm", start=s2, fix.arg=f1)) try(fitdist(x, "norm", start=s2, fix.arg=f1)) # should raise error for too much parameters try(mgedist(x, "norm", start=s0, fix.arg=f2)) try(fitdist(x, "norm", start=s0, fix.arg=f2)) # should raise error for NA value try(mgedist(x, "norm", start=s1, fix.arg=list(sd=NA))) try(fitdist(x, "norm", start=list(sd=NA))) # should raise error for inconsistent parameter try(mgedist(x, "norm", start=function(x) list("toto"=1))) try(fitdist(x, "norm", fix=list(toto=2))) #test unset arguments dbeta2<-function(x, shape1, ncp2) dbeta(x, shape1, shape1, ncp2) x <- rbeta(1e2, 3, 3) try(fitdist(x, "beta2", start=list(shape1=2))) dbeta3<-function(x, shape1, ncp2=0) dbeta(x, shape1, shape1, ncp2) fitdist(x, "beta3", start=list(shape1=2)) # (2) censored data # data(salinity) log10LC50 <-log10(salinity) s1 <- NULL s2 <- list("mean"=2) s0 <- list("mean"=2, "sd"=1) s3 <- function(x) list("mean"=mean(x)) f1 <- NULL f2 <- list("sd"=3) f3 <- function(x) list("sd"=sd(x)) fitdistcens(log10LC50, "norm", start=s1, fix.arg = f1) fitdistcens(log10LC50, "norm", start=s1, fix.arg = f2) fitdistcens(log10LC50, "norm", start=s2, fix.arg = f2) fitdistcens(log10LC50, "norm", start=s0, fix.arg = f1) fitdistcens(log10LC50, "norm", start=s3, fix.arg = f2) fitdistcens(log10LC50, "norm", start=s3, fix.arg = f3) fitdistcens(log10LC50, "norm", start=s1, fix.arg = f3) fit1 <- fitdistcens(log10LC50, "norm", start=s1, fix.arg = f1) boot1 <- bootdistcens(fit1, niter = 10) fit1 <- fitdistcens(log10LC50, "norm", start=s3, fix.arg = f2) boot1 <- bootdistcens(fit1, niter = 10) fit1 <- fitdistcens(log10LC50, "norm", start=s2, fix.arg = f3) boot1 <- bootdistcens(fit1, niter = 10) # (3) non-censored data (discrete) # n <- 200 trueval <- c("size"=10, "prob"=3/4, "mu"=10/3) x <- rnbinom(n, trueval["size"], trueval["prob"]) mledist(x, "nbinom") fitdist(x, "nbinom") # (4) non-censored data (continuous) external distributions # data("endosulfan") ATV <-endosulfan$ATV fendo.ln <- fitdist(ATV, "lnorm") fendo.g <- fitdist(ATV, "gamma", start=list(shape=2, scale=1), lower=0) require("actuar") fendo.ll <- fitdist(ATV, "llogis", start = list(shape = 1, scale = 500)) fendo.P <- fitdist(ATV, "pareto", start = list(shape = 1, scale = 500)) fendo.B <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) fitdistrplus/tests/t-msedist.R0000644000176200001440000001300214050660542016202 0ustar liggesuserslibrary(fitdistrplus) nboot <- 1000 nboot <- 10 nsample <- 10 set.seed(123) #manual implementation geomeanspacing <- function(pdist, obs, ...) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Di <- pdist(sx[-1], ...) - pdist(sx[-n], ...) mean(log(Di)) } #-------------------------------------------------------- # exponential sample x1 <- rexp(nsample) lam <- seq(0.1, 2, length=51) Sn <- sapply(lam, function(x) geomeanspacing(pexp, obs=x1, rate=x)) Dn <- function(theta) -geomeanspacing(pexp, obs=x1, rate=theta[1]) #theoretical optimum Dn(1/mean(x1)) #check curve behavior par(mar=c(4,4,2,1)) plot(lam, Sn, type="l", xlab="theta", main="Average spacing logarithm") abline(v=1, col="green") abline(v=msedist(x1, "exp")$estimate, lty=2, col="blue") legend("bottomright", lty=1:2, col=c("green", "blue"), leg=c("theoretical value", "fitted value")) msedist(x1, "exp", control=list(trace=0, REPORT=1)) mse_exp <- fitdist(x1, "exp", method="mse") plot(mse_exp) summary(mse_exp) gofstat(mse_exp) mse_exp_boot <- bootdist(mse_exp, niter = nboot) plot(mse_exp_boot) abline(v=1, col="green") abline(v=msedist(x1, "exp")$estimate, lty=2, col="blue") legend("bottomright", lty=1:2, col=c("green", "blue"), leg=c("theoretical value", "fitted value")) # library(BMT) # x <- rBMT(1e3, 1/4, 3/4) # # BMTfit.mpse(x) # fitdist(x, "BMT", method="mse", start=list(p3=1/2, p4=1/2, p1=-1/2, p2=1/2), lower=c(0, 0, -Inf, 0), # upper=c(1,1,0, Inf)) # pBMT(x, p3=1/2, p4=1/2, p1=-1/2, p2=1/2) #-------------------------------------------------------- # lognormal sample x1 <- rlnorm(nsample, 0, 1) mu <- seq(-1, 1, length=51) Sn <- sapply(mu, function(x) geomeanspacing(plnorm, obs=x1, mean=x, sd=1)) Dn <- function(theta) -geomeanspacing(plnorm, obs=x1, mean=theta[1], sd=theta[2]) plot(mu, Sn, type="l") abline(v=0) optim(c(2,2), Dn) msedist(x1, "lnorm", control=list(trace=0, REPORT=1)) mse_lnorm <- fitdist(x1, "lnorm", method="mse") mle_lnorm <- fitdist(x1, "lnorm", method="mle") plot(mse_lnorm) summary(mse_lnorm) cdfcomp(list(mse_lnorm, mle_lnorm)) gofstat(list(mse_lnorm, mle_lnorm)) mse_lnorm_boot <- bootdist(mse_lnorm, niter = nboot) par(mar=c(4,4,2,1)) plot(mse_lnorm_boot, enhance = TRUE, trueval=c(0,1)) #-------------------------------------------------------- # Pareto sample library(actuar) x1 <- rburr(nsample, 2,2,2) Dn <- function(theta) -geomeanspacing(pburr, obs=x1, shape1=theta[1], shape2=theta[2], rate=theta[3]) Dn(c(1,1,10)) optim(c(1,1,10), Dn) msedist(x1, "burr", start=list(shape1=1, shape2=1, rate=10), control=list(trace=0, REPORT=1)) mse_burr <- fitdist(x1, "burr", method="mse", start=list(shape1=1, shape2=1, rate=10)) mle_burr <- fitdist(x1, "burr", method="mle", start=list(shape1=1, shape2=1, rate=10)) plot(mse_burr) summary(mse_burr) cdfcomp(list(mse_burr, mle_burr)) gofstat(list(mse_burr, mle_burr)) mse_burr_boot <- bootdist(mse_burr, niter = pmin(nboot,100)) plot(mse_burr_boot, enhance = TRUE, trueval=c(2,2,2)) #-------------------------------------------------------- # Poisson sample x1 <- rpois(nsample, 15) geomeanSpacingUnique <- function(pdist, obs, ...) { sx <- c(-Inf, unique(sort(obs)), Inf) n <- length(sx) Di <- pdist(sx[-1], ...) - pdist(sx[-n], ...) mean(log(Di)) } geomeanSpacingWeight <- function(pdist, obs, weights, ...) { sx <- c(-Inf, unique(sort(obs)), Inf) weights <- c(1, weights) n <- length(sx) Di <- pdist(sx[-1], ...) - pdist(sx[-n], ...) mean(weights*log(Di)) } DnUnique <- function(theta) -geomeanSpacingUnique(ppois, obs=x1, lambda=theta[1]) DnWeight <- function(theta, weights) -geomeanSpacingWeight(ppois, obs=x1, lambda=theta[1], weights=weights) optimize(DnWeight, c(1, 30), weights=as.numeric(table(x1))) optimize(DnUnique, c(1, 30)) optimize(Dn, c(1, 30)) #does not converge mle_pois1 <- fitdist(x1, "pois", method="mle") #no weight mse_pois1 <- fitdist(x1, "pois", method="mse") #with weight mse_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", weights=as.numeric(table(x1))) plot(mse_pois1) plot(mse_pois2) summary(mse_pois1) gofstat(mse_pois1) gofstat(mse_pois2) par(mfrow=c(1,1)) cdfcomp(list(mle_pois1, mse_pois1), addlegend = FALSE, fitlty = 1) curve(ppois(x, lambda=mse_pois2$estimate), type="s", col="blue", add=TRUE) legend("bottomright", lty=1, col=c("red", "green", "blue"), leg=c("MLE", "MSE no weight", "MSE with weight")) #-------------------------------------------------------- # real dataset # library(CASdatasets) # data("ushustormloss") # x <- ushustormloss$Normalized.CL05 # # plot(Normalized.CL05 ~ Year, data=ushustormloss, type="h", main="Normalized Hurricane Damages in United States") # # mse_burr <- fitdist(x, "burr", method="mse", start=list(shape1=1, shape2=1, rate=10), lower=0) # mle_burr0 <- fitdist(x, "burr", method="mle", start=list(shape1=1, shape2=1, rate=10), lower=0) # # cbind(MSE=coef(mse_burr), MLE=coef(mle_burr0)) # # # setwd("~/Desktop/") # par(mar=c(4,4,2,1)) # pdf("Ushustorm-cdfcomp.pdf", 6, 6) # cdfcomp(list(mse_burr, mle_burr0), xlogscale = TRUE, do.points = FALSE) # dev.off() # pdf("Ushustorm-qqcomp.pdf", 6, 6) # qqcomp(list(mse_burr, mle_burr0), xlogscale=TRUE, ylogscale=TRUE) # dev.off() # pdf("Ushustorm-ppcomp.pdf", 6, 6) # ppcomp(list(mse_burr, mle_burr0)) # dev.off() # # gofstat(list(mse_burr, mle_burr0)) # # mse_iburr <- fitdist(x, "invburr", method="mse", start=list(shape1=1, shape2=1, rate=10), lower=0) # mle_iburr0 <- fitdist(x, "invburr", method="mle", start=list(shape1=1, shape2=1, rate=10), lower=0) # # gofstat(list(mse_iburr, mle_iburr0)) # cdfcomp(list(mse_iburr, mle_iburr0)) fitdistrplus/tests/t-gen-max-spacing-estim.R0000644000176200001440000001026014050660542020632 0ustar liggesuserslibrary(fitdistrplus) set.seed(123) nsample <- 10 #-------------------------------------------------------- # exponential sample x1 <- rexp(nsample) mseKL_exp <- msedist(x1, "exp") mseJ_exp <- msedist(x1, "exp", phidiv = "J") mseR2_exp <- msedist(x1, "exp", phidiv = "R", power.phidiv=2) mseR1o2_exp <- msedist(x1, "exp", phidiv = "R", power.phidiv=1/2) mseH3o2_exp <- msedist(x1, "exp", phidiv = "H", power.phidiv=3/2) mseV3o2_exp <- msedist(x1, "exp", phidiv = "V", power.phidiv=3/2) c(true=1, mseKL_exp$estimate, mseJ_exp$estimate, mseR2_exp$estimate, mseR1o2_exp$estimate, mseH3o2_exp$estimate, mseV3o2_exp$estimate) mseKL_exp <- fitdist(x1, "exp", method="mse", phidiv="KL") mseJ_exp <- fitdist(x1, "exp", method="mse", phidiv = "J") mseR2_exp <- fitdist(x1, "exp", method="mse", phidiv = "R", power.phidiv=2) mseR1o2_exp <- fitdist(x1, "exp", method="mse", phidiv = "R", power.phidiv=1/2) mseH3o2_exp <- fitdist(x1, "exp", method="mse", phidiv = "H", power.phidiv=3/2) mseV3o2_exp <- fitdist(x1, "exp", method="mse", phidiv = "V", power.phidiv=3/2) gofstat(list(mseKL_exp, mseJ_exp, mseR2_exp, mseR1o2_exp, mseH3o2_exp, mseV3o2_exp)) cdfcomp(list(mseKL_exp, mseJ_exp, mseR2_exp, mseR1o2_exp, mseH3o2_exp, mseV3o2_exp), do.points=FALSE, legendtext = c("Kullback-Leibler", "Jeffreys", "Renyi alpha=2", "Renyi alpha=1/2", "Hellinger p=3/2", "Vajda beta=3/2")) qqcomp(list(mseKL_exp, mseJ_exp, mseR2_exp, mseR1o2_exp, mseH3o2_exp, mseV3o2_exp), legendtext = c("Kullback-Leibler", "Jeffreys", "Renyi alpha=2", "Renyi alpha=1/2", "Hellinger p=3/2", "Vajda beta=3/2")) denscomp(list(mseKL_exp, mseJ_exp, mseR2_exp, mseR1o2_exp, mseH3o2_exp, mseV3o2_exp), demp = TRUE, legendtext = c("Kullback-Leibler", "Jeffreys", "Renyi alpha=2", "Renyi alpha=1/2", "Hellinger p=3/2", "Vajda beta=3/2")) #defensive test try(msedist(x1, "exp", phidiv="ABC")) try(msedist(x1, "exp", phidiv="K", power.phidiv = "a")) try(msedist(x1, "exp", phidiv="J", power.phidiv = "a")) try(msedist(x1, "exp", phidiv="R", power.phidiv = 0)) try(msedist(x1, "exp", phidiv="R", power.phidiv = 1:10)) try(msedist(x1, "exp", phidiv="H", power.phidiv = 0)) try(msedist(x1, "exp", phidiv="H", power.phidiv = 1:10)) #-------------------------------------------------------- # Poisson sample x1 <- rpois(nsample, lambda=15) #no weight mseKL_pois1 <- fitdist(x1, "pois", method="mse", phidiv="KL") mseJ_pois1 <- fitdist(x1, "pois", method="mse", phidiv = "J") mseR2_pois1 <- fitdist(x1, "pois", method="mse", phidiv = "R", power.phidiv=2) mseR1o2_pois1 <- fitdist(x1, "pois", method="mse", phidiv = "R", power.phidiv=1/2) mseH3o2_pois1 <- fitdist(x1, "pois", method="mse", phidiv = "H", power.phidiv=3/2) mseV3o2_pois1 <- fitdist(x1, "pois",method="mse", phidiv = "V", power.phidiv=3/2) #with weight mseKL_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", phidiv="KL", weights=as.numeric(table(x1))) mseJ_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", phidiv = "J", weights=as.numeric(table(x1))) mseR2_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", phidiv = "R", power.phidiv=2, weights=as.numeric(table(x1))) mseR1o2_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", phidiv = "R", power.phidiv=1/2, weights=as.numeric(table(x1))) mseH3o2_pois2 <- fitdist(unique(sort(x1)), "pois", method="mse", phidiv = "H", power.phidiv=3/2, weights=as.numeric(table(x1))) mseV3o2_pois2 <- fitdist(unique(sort(x1)), "pois",method="mse", phidiv = "V", power.phidiv=3/2, weights=as.numeric(table(x1))) #taking into account partially unbias the estimation of the true cdf cdfcomp(list(mseKL_pois1, mseJ_pois1, mseR2_pois1), do.points=FALSE, fitlty=1, legendtext = c("Kullback-Leibler", "Jeffreys", "Renyi alpha=2")) cdfcomp(list(mseKL_pois2, mseJ_pois2, mseR2_pois2), do.points=FALSE, add=TRUE, fitlty=2, addlegend = FALSE, datacol="white") cdfcomp(list(mseR1o2_pois1, mseH3o2_pois1, mseV3o2_pois1), do.points=FALSE, fitlty=1, legendtext = c("Renyi alpha=1/2", "Hellinger p=3/2", "Vajda beta=3/2")) cdfcomp(list(mseR1o2_pois2, mseH3o2_pois2, mseV3o2_pois2), do.points=FALSE, add=TRUE, fitlty=2, addlegend = FALSE, datacol="white") fitdistrplus/tests/t-qme-discrete.R0000644000176200001440000000226614050660542017126 0ustar liggesuserslibrary(fitdistrplus) set.seed(1234) nsample <- 10 #Poisson x <- rpois(nsample, lambda=7.5) L2 <- function(lam) (qpois(1/2, lambda = lam) - median(x))^2 curve(L2(x), 5, 9, xlab=expression(lambda), ylab=expression(L2(lambda)), main="squared differences", n=201) fitdist(x, "pois", method="qme", probs=1/2, start=list(lambda=2), control=list(trace=1, REPORT=1)) fitdist(x, "pois", method="qme", probs=1/2, start=list(lambda=6.8), control=list(trace=1, REPORT=1)) fitdist(x, "pois", method="qme", probs=1/2, start=list(lambda=15), control=list(trace=1, REPORT=1)) fitdist(x, "pois", method="qme", optim.method="SANN", probs=1/2, start=list(lambda=2), control=list(trace=1, REPORT=100)) fitdist(x, "pois", method="qme", optim.method="SANN", probs=1/2, start=list(lambda=17), control=list(trace=1, REPORT=100)) #Geometric x <- rgeom(nsample, 1/3) L2 <- function(p) (qgeom(1/2, p) - median(x))^2 curve(L2(x), 0.10, 0.95, xlab=expression(p), ylab=expression(L2(p)), main="squared differences", n=301) fitdist(x, "geom", method="qme", probs=1/2, start=list(prob=1/2), control=list(trace=1, REPORT=1)) fitdist(x, "geom", method="qme", probs=1/2, start=list(prob=1/20), control=list(trace=1, REPORT=1)) fitdistrplus/tests/t-fitdist-customoptim.R0000644000176200001440000000220714050660542020566 0ustar liggesusersvisualize <- FALSE # TRUE for manual tests with visualization of results require(fitdistrplus) myoptimize <- function(fn,par,ui,ci,...){ res <- constrOptim(f=fn,theta=par,method="Nelder-Mead",ui=ui,ci=ci, ...) standardres <- c(res,convergence=0,value=res$objective,par=res$minimum,hessian=NA) return(standardres) } #one parameter example x <- rexp(100) #binding example fitdist(x, "exp", custom.optim=myoptimize, ui=1, ci=2, start=list(rate=10)) fitdist(x, "exp", lower= 2, optim.method="L-BFGS-B") #two parameter example if(visualize) { # check ERROR on aarch64-apple-darwin20.4.0 (64-bit) (2021/05/12) x <- rbeta(100, pi, 1/pi) set.seed(1234) fitdist(x, "beta") #binding example fitdist(x, "beta", custom.optim=myoptimize, ui=rbind(1,1), ci=c(1/2,1/2), start=list(shape1=5, shape2=5)) fitdist(x, "beta", lower= c(1/2,1/2), optim.method="L-BFGS-B") } #true example library(GeneralizedHyperbolic) args(dnig) x <- rnig(100, 3, 1/2, 1/2, 1/4) ui<-rbind(c(0,1,0,0),c(0,0,1,0),c(0,0,1,-1),c(0,0,1,1)) ci<-c(0,0,0,0) fitdist(x, "nig", custom.optim=myoptimize, ui=ui, ci=ci, start=list(mu = 0, delta = 1, alpha = 1, beta = 0)) fitdistrplus/tests/t-plotdist.R0000644000176200001440000000225214050660542016401 0ustar liggesuserslibrary(fitdistrplus) nsample <- 10 # (1) Plot of an empirical distribution with changing # of default line types for CDF and colors # and optionally adding a density line # set.seed(1234) x1 <- rnorm(n=nsample) plotdist(x1) plotdist(x1, col="blue", type="b", pch=16) plotdist(x1, type="s") plotdist(x1, demp = TRUE) plotdist(x1,demp = TRUE, adjust = 1.5) # (2) Plot of a discrete distribution against data # set.seed(1234) x2 <- rpois(n=nsample, lambda = 2) plotdist(x2, discrete=TRUE) plotdist(x2, "pois", para=list(lambda = mean(x2))) plotdist(x2, "pois", para=list(lambda = mean(x2)), lwd="2") # (3) Plot of a continuous distribution against data # xn <- rnorm(n=nsample, mean=10, sd=5) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn))) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn)), pch=16) plotdist(xn, "norm", para=list(mean=mean(xn), sd=sd(xn)), pch=16, demp = TRUE) # (4) Plot of serving size data # data(groundbeef) plotdist(groundbeef$serving, type="s") # (5) Plot of numbers of parasites with a Poisson distribution data(toxocara) number <- toxocara$number plotdist(number, discrete = TRUE) plotdist(number,"pois",para=list(lambda=mean(number))) fitdistrplus/tests/t-qmedist.R0000644000176200001440000000577614050660542016223 0ustar liggesuserslibrary(fitdistrplus) nsample <- 10 # (1) basic fit of a normal distribution # set.seed(1234) x1 <- rnorm(n=nsample) qmedist(x1, "norm", probs=c(1/3, 2/3)) # (2) defining your own distribution functions, here for the Gumbel # distribution for other distributions, see the CRAN task view dedicated # to probability distributions dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) qgumbel <- function(p, a, b) a - b*log(-log(p)) qmedist(x1, "gumbel", probs=c(1/3, 2/3), start=list(a=10,b=5)) # (3) fit a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=nsample,lambda = 2) qmedist(x2, "pois", probs=1/2) # (4) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=nsample, shape1=5, shape2=10) qmedist(x3, "beta", probs=c(1/3, 2/3)) # (5) fit frequency distributions on USArrests dataset. # x4 <- USArrests$Assault qmedist(x4, "pois", probs=1/2) qmedist(x4, "nbinom", probs=c(1/3, 2/3)) # (6) normal mixture # #mixture of two normal distributions #density dnorm2 <- function(x, poid, m1, s1, m2, s2) poid*dnorm(x, m1, s1) + (1-poid)*dnorm(x, m2, s2) #numerically approximate quantile function qnorm2 <- function(p, poid, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, poid, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-20, 30), prob=pr)$minimum) } #distribution function pnorm2 <- function(q, poid, m1, s1, m2, s2) poid*pnorm(q, m1, s1) + (1-poid)*pnorm(q, m2, s2) #basic normal distribution x <- c(rnorm(nsample, 5), rnorm(nsample, 10)) #QME fit2 <- qmedist(x, "norm2", probs=c(1/6, 1/4, 1/3, 1/2, 2/3), start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) # (7) test error messages # dnorm3 <- qnorm3 <- function(x, a) "NA" x <- rexp(nsample) #should get a one-line error res <- qmedist(x, "norm3", start=list(a=1), probs=1/2) #as in attr(try(log("a"), silent=TRUE), "condition") # (8) weighted QME # n <- 1e6 x <- rpois(nsample, 10) xtab <- table(x) xval <- sort(unique(x)) f1 <- qmedist(x, "pois", start=list(lambda=mean(x)), lower=0, upper=100, probs=1/2) #, control=list(trace=1, REPORT=1) f2 <- qmedist(xval, "pois", weights=xtab, start=list(lambda=mean(x)), probs=1/2) f1$estimate f2$estimate #should be identical x <- rexp(nsample) f3 <- qmedist(x, "exp", probs=1/2) w4 <- c(rep(1, nsample/2), round(sqrt(1:(nsample/2)))) f4 <- qmedist(x, "exp", weights=w4, probs=1/2) f3$estimate f4$estimate f3$loglik f4$loglik median(x) median(tail(x, 50)) #try non integer weights try(qmedist(x, "exp", weights=c(rep(1, n/2), sqrt(1:(n/2))), probs=1/2)) # (9) test the component optim.message x <- rnorm(nsample) #change parameter to obtain unsuccessful convergence qmedist(x, "norm", probs=1:2/3, control=list(maxit=2), start=list(mean=1e5, sd=1), optim.method="L-BFGS-B", lower=0) # (10) test bounds x <- rnorm(nsample) qmedist(x, "norm", probs=1:2/3, optim.method="L-BFGS-B", lower=c(-Inf, 0)) #via optim qmedist(x, "norm", probs=1:2/3, optim.method="Nelder", lower=c(-Inf, 0)) #via constrOptim fitdistrplus/tests/t-bootdistcens.R0000644000176200001440000000535614050660542017247 0ustar liggesuserslibrary(fitdistrplus) nbboot <- 101 nbboot <- 11 nsample <- 10 visualize <- FALSE # TRUE for manual tests with visualization of results # (1) Fit of a normal distribution to fluazinam data in log10 # followed by nonparametric bootstrap # data(fluazinam) (d1 <-log10(fluazinam)) f1 <- fitdistcens(d1, "norm") b1 <- bootdistcens(f1, niter = nbboot, silent=TRUE) b1 <- bootdistcens(f1, niter = nbboot, silent=FALSE) b1 summary(b1) plot(b1) # (3) Estimation of the standard deviation of a normal distribution # by maximum likelihood with the mean fixed at 0.1 using the argument fix.arg # followed by nonparametric bootstrap # f1b <- fitdistcens(d1, "norm", start=list(sd=1.5), fix.arg=list(mean=0.1)) b1b <- bootdistcens(f1b, niter=nbboot) summary(b1b) plot(b1b) # (4) Comparison of fitdist and fitdistcens and bootdist and bootdistcens # for non censored data x1<-c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4, 13.2,8.4,6.3,8.9,5.2,10.9,14.4) fx1<-fitdist(x1,"norm",method="mle") cx1<-bootdist(fx1,bootmethod="nonparam", niter=nbboot) xx1<-data.frame(left=x1,right=x1) fxx1<-fitdistcens(xx1,"norm") summary(fx1) summary(fxx1) cdfcomp(fx1) cdfcompcens(fxx1) cxx1<-bootdistcens(fxx1, niter=nbboot) summary(cx1) summary(cxx1) # (5) fixing parameters # set.seed(1234) x <- rexp(nsample, 5) x <- data.frame(left=x, right=x+.1) f1 <- fitdistcens(x, "gamma", fix.arg=list(shape=1.5)) b1 <- bootdistcens(f1, niter=nbboot) plot(b1) f1 <- fitdistcens(x, "gamma", fix.arg=function(x) list(shape=1.5)) b1 <- bootdistcens(f1, niter=nbboot) plot(b1) # (6) efficiency of parallel operation if (visualize) # too long to run on CRAN and forbidden due to parallel computing { niter <- 5001 data(fluazinam) d1 <-log10(fluazinam) f1 <- fitdistcens(d1, "norm") for (cli in 1:4) { print(cli) ptm <- proc.time() print(summary(bootdistcens(f1, niter = niter, parallel = "snow", ncpus = cli))) print(proc.time() - ptm) } # not available on Windows for (cli in 1:4) { print(cli) ptm <- proc.time() print(summary(bootdistcens(f1, niter = niter, parallel = "multicore", ncpus = cli))) print(proc.time() - ptm) } } # (5) with weights (not yet available, test of error message) # data(salinity) salinity.unique <- unique(salinity) string.unique <- paste(salinity.unique$left, salinity.unique$right) string.salinity <- paste(salinity$left, salinity$right) nobs <- nrow(salinity.unique) salinity.weights <- numeric(nobs) for (i in 1:nobs) { salinity.weights[i] <- length(which(string.salinity == string.unique[i])) } cbind(salinity.unique, salinity.weights) (fa <- fitdistcens(salinity, "lnorm")) (fb <- fitdistcens(salinity.unique, "lnorm", weights = salinity.weights)) # should give the same results summary(bootdistcens(fa, niter = nbboot)) fitdistrplus/tests/t-CIcdfplot.R0000644000176200001440000001310414100261274016377 0ustar liggesuserslibrary(fitdistrplus) nbboot <- 201 nbboot <- 10 if (requireNamespace ("ggplot2", quietly = TRUE)) {ggplotEx <- TRUE} # (1) Fit of a gamma distribution # set.seed(123) s1 <- rgamma(20, 3, 2) f1 <- fitdist(s1, "gamma") b1 <- bootdist(f1, niter=nbboot, silent=TRUE) plot(b1) quantile(b1) par(mfrow=c(1,2)) CIcdfplot(b1, CI.level=95/100, CI.output = "probability", CI.fill="grey80", CI.col="black") CIcdfplot(b1, CI.level=95/100, CI.output = "quantile", datacol="blue") if(ggplotEx) CIcdfplot(b1, CI.level=95/100, CI.output = "probability", CI.fill="grey80", CI.col="black", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=95/100, CI.output = "quantile", datacol="blue", plotstyle = "ggplot") par(mfrow=c(1,2)) CIcdfplot(b1, CI.level=85/100, CI.output = "probability") CIcdfplot(b1, CI.level=85/100, CI.output = "quantile") if(ggplotEx) CIcdfplot(b1, CI.level=85/100, CI.output = "probability", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=85/100, CI.output = "quantile", plotstyle = "ggplot") par(mfrow=c(1,2)) CIcdfplot(b1, CI.level=90/100, CI.output = "probability") CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "less", CI.fill="grey85", verticals=TRUE, datacol="blue", do.points=FALSE) if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "less", CI.fill="grey85", verticals=TRUE, datacol="blue", do.points=FALSE, plotstyle = "ggplot") par(mfrow=c(1,2)) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.type = "greater") CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "greater", CI.fill="grey90", datacol="blue", datapch=21) if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.type = "greater", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "greater", CI.fill="grey90", datacol="blue", datapch=21, plotstyle = "ggplot") par(mfrow=c(1,1)) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.col="black", CI.type = "less", CI.fill="grey90") CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "less", CI.fill="grey90", verticals=TRUE, datacol="blue", do.points=FALSE) CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="grey90", CI.type = "less", CI.fill="grey90", verticals=TRUE, datacol="blue", do.points=FALSE, CI.only=TRUE) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.col="grey85", CI.type = "less", CI.fill="grey90", CI.only = TRUE) CIcdfplot(b1, CI.output = "probability", fitlty=3, fitlwd=4) if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.col="black", CI.type = "less", CI.fill="grey90", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="black", CI.type = "less", CI.fill="grey90", verticals=TRUE, datacol="blue", do.points=FALSE, plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "quantile", CI.col="grey90", CI.type = "less", CI.fill="grey90", verticals=TRUE, datacol="blue", do.points=FALSE, CI.only=TRUE, plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.level=90/100, CI.output = "probability", CI.col="grey85", CI.type = "less", CI.fill="grey90", CI.only = TRUE, plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b1, CI.output = "probability", fitlty=3, fitlwd=4, plotstyle = "ggplot") # (2) an example from ecotoxicology # with censored data # data(salinity) log10LC50 <-log10(salinity) fln <- fitdistcens(log10LC50,"norm") bln <- bootdistcens(fln, niter=nbboot) (HC5ln <- quantile(bln,probs = 0.05)) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)",xlim=c(0.5,2),lines01 = TRUE) if(ggplotEx) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)",xlim=c(0.5,2),lines01 = TRUE, plotstyle = "ggplot") # zoom around the HC5 with CI on quantiles CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1)) abline(h = 0.05, lty = 1) if(ggplotEx) CIcdfplot(bln, CI.output = "quantile", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1), plotstyle = "ggplot") + ggplot2::geom_hline(yintercept = 0.05) # zoom around the HC5 with CI on probabilities CIcdfplot(bln, CI.output = "probability", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1)) abline(h = 0.05, lty = 1) if(ggplotEx) CIcdfplot(bln, CI.output = "probability", CI.fill = "lightblue", CI.col = "blue", xlab = "log10(LC50)", lines01 = TRUE, xlim = c(0.8, 1.5), ylim = c(0, 0.1), plotstyle = "ggplot") + ggplot2::geom_hline(yintercept = 0.05) # (3) An example where the difference between "probability" # and "quantile" is clear on the plot # set.seed(123) s3 <- rgamma(5, 3, 10) f3 <- fitdist(s3, "norm") b3 <- bootdist(f3, niter=nbboot, silent=TRUE) par(mfrow=c(1,2)) CIcdfplot(b3, CI.level=90/100, CI.output = "probability") CIcdfplot(b3, CI.level=90/100, CI.output = "quantile") if(ggplotEx) CIcdfplot(b3, CI.level=90/100, CI.output = "probability", plotstyle = "ggplot") if(ggplotEx) CIcdfplot(b3, CI.level=90/100, CI.output = "quantile", plotstyle = "ggplot") #some ideas from http://edild.github.io/ssd/ fitdistrplus/tests/t-Surv2fitdistcens.R0000644000176200001440000000050414075737424020031 0ustar liggesusersrequire(fitdistrplus) data("fremale") # fremale test fremale.cens <- Surv2fitdistcens(fremale$AgeIn, fremale$AgeOut, fremale$Death) f1 <- fitdistcens(fremale.cens, "norm") f2 <- fitdistcens(fremale.cens, "logis") f3 <- fitdistcens(fremale.cens, "cauchy") cdfcompcens(list(f1, f2, f3)) sapply(list(f1, f2, f3), logLik) fitdistrplus/tests/t-descdist.R0000644000176200001440000000213514050660542016341 0ustar liggesuserslibrary(fitdistrplus) nbboot <- 100 nbboot <- 10 nsample <- 10 # (1) Description of a sample from a normal distribution # with and without uncertainty on skewness and kurtosis estimated by bootstrap # set.seed(1234) x1 <- rnorm(nsample) descdist(x1) descdist(x1,boot=nbboot) # (2) Description of a sample from a beta distribution # with uncertainty on skewness and kurtosis estimated by bootstrap # with changing of default colors # descdist(rbeta(nsample,shape1=0.05,shape2=1),boot=nbboot, obs.col="blue",boot.col="orange") # (3) Description of a sample from a gamma distribution # with uncertainty on skewness and kurtosis estimated by bootstrap # without plotting # descdist(rgamma(nsample,shape=2,rate=1),boot=nbboot,graph=FALSE) # (3) Description of a sample from a Poisson distribution # with uncertainty on skewness and kurtosis estimated by bootstrap # descdist(rpois(nsample,lambda=2),discrete=TRUE,boot=nbboot) # (4) Description of serving size data # with uncertainty on skewness and kurtosis estimated by bootstrap # data(groundbeef) serving <- groundbeef$serving descdist(serving, boot=nbboot) fitdistrplus/tests/t-quantiledist.R0000644000176200001440000000506113742313702017246 0ustar liggesuserslibrary(fitdistrplus) nbboot <- 1001 nbboot <- 10 # (1) Fit of a normal distribution on acute toxicity log-transformed values of endosulfan for # nonarthropod invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5, 10 and 20 percent quantile values of # the fitted distribution, which are called the 5, 10, 20 percent hazardous concentrations (HC5, HC10, HC20) # in ecotoxicology, followed with calculations of their confidence intervals with various definitions. # data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV log10ATV <- log10(subset(endosulfan, group == "NonArthroInvert")$ATV) fln <- fitdist(log10ATV, "norm") quantile(fln, probs = c(0.05, 0.1, 0.2)) bln <- bootdist(fln, niter=nbboot, bootmethod="param") quantile(bln, probs = c(0.05, 0.1, 0.2)) quantile(bln, probs = c(0.05, 0.1, 0.2), CI.type = "greater") quantile(bln, probs = c(0.05, 0.1, 0.2), CI.level = 0.9) # (2) Fit of a distribution on acute salinity log-transformed tolerance # for riverine macro-invertebrates, using maximum likelihood estimation # to estimate what is called a species sensitivity distribution # (SSD) in ecotoxicology, followed by estimation of the 5, 10 and 20 percent quantile values of # the fitted distribution, which are called the 5, 10, 20 percent hazardous concentrations (HC5, HC10, HC20) # in ecotoxicology, followed with calculations of their confidence intervals with various definitions. # data(salinity) log10LC50 <-log10(salinity) flncens <- fitdistcens(log10LC50,"norm") quantile(flncens, probs = c(0.05, 0.1, 0.2)) blncens <- bootdistcens(flncens,niter=nbboot) quantile(blncens, probs = c(0.05, 0.1, 0.2)) quantile(blncens, probs = c(0.05, 0.1, 0.2), CI.type = "greater") quantile(blncens, probs = c(0.05, 0.1, 0.2), CI.level = 0.9) # (3) Estimation of quantiles of the fitted distribution (fln) # and two-sided 95 percent confidence intervals for various # probabilities using non-parametric bootstrap with 101 iterations # bln.np <- bootdist(fln, bootmethod = "nonparam", niter = nbboot) quantile(bln.np, probs = c(0.05, 0.1, 0.2)) # (4) Fit of a loglogistic distribution on the same acute toxicity values and # estimation of the 5 percent quantile (HC5) of the fitted distribution # and associated two-sided 95 percent confidence interval # fll <- fitdist(log10ATV, "logis") bll <- bootdist(fll, bootmethod = "param", niter = nbboot) # in log10(ATV) HC5ll <- quantile(bll, probs = 0.05) HC5ll # in ATV 10^(HC5ll$basequant) 10^(HC5ll$quantCI) fitdistrplus/tests/t-mmedist.R0000644000176200001440000001307114050660542016202 0ustar liggesuserslibrary(fitdistrplus) nsample <- 10 # (1) basic fit of a normal distribution with moment matching estimation # set.seed(1234) x1 <- rnorm(n=nsample) mmedist(x1,"norm") try(mmedist(x1,"norm", fix.arg=list(mean=0))) # (2) fit a discrete distribution (Poisson) # set.seed(1234) x2 <- rpois(n=nsample, lambda = 2) mmedist(x2,"pois") # (3) fit a finite-support distribution (beta) # set.seed(1234) x3 <- rbeta(n=nsample, shape1=5, shape2=10) mmedist(x3,"beta") # (4) fit a Pareto distribution # if(any(installed.packages()[, "Package"] == "actuar")) { require(actuar) #simulate a sample x4 <- rpareto(nsample, 6, 2) #empirical raw moment memp <- function(x, order) mean(x^order) #fit mmedist(x4, "pareto", order=c(1, 2), memp=memp, start=c(shape=10, scale=10), lower=1, upper=Inf) mmedist(x4, "pareto", order=1, memp=memp, start=list(shape=10), fix.arg=list(scale=1.5), lower=2, upper=Inf) mmedist(x4, "pareto", order=1, memp=memp, start=function(x) list(shape=10), fix.arg=list(scale=1.5), lower=2, upper=Inf) mmedist(x4, "pareto", order=1, memp=memp, start=list(shape=10), fix.arg=function(x) list(scale=1.5), lower=2, upper=Inf) #weights memp2 <- function(x, order, weights) sum(x^order * weights)/sum(weights) w <- rep(1, length(x4)) w[x4 < 1] <- 2 mmedist(x4, "pareto", order=c(1, 2), memp=memp2, weights=w, start=list(shape=10, scale=10), lower=1, upper=Inf) #fit data(danishuni) fparedanishMME <- mmedist(danishuni$Loss, "pareto", order=1:2, memp=memp, start=c(shape=10, scale=10), lower=2+1e-6, upper=Inf) c(theo = mpareto(1, fparedanishMME$estimate[1], fparedanishMME$estimate[2]), emp = memp(danishuni$Loss, 1)) c(theo = mpareto(2, fparedanishMME$estimate[1], fparedanishMME$estimate[2]), emp = memp(danishuni$Loss, 2)) } # (5) fit a lognormal distribution # f1 <- mledist(x3, "lnorm") #previously mmedist was the same as mledist f2 <- mmedist(x3, "lnorm") n <- length(x3) s2 <- log(1+var(x3)/mean(x3)^2*(n-1)/n) mu <- log(mean(x3)) - s2/2 cbind(c(mu, s2), f2$estimate) c(truestim=exp(mu+s2/2), jensen=as.numeric(exp(f1$estimate["meanlog"]+f1$estimate["sdlog"]^2/2)), emp=mean(x3)) c(truestim=exp(2*mu+s2)*(exp(s2)-1), jensen=as.numeric(exp(2*f1$estimate["meanlog"]+f1$estimate["sdlog"]^2)*(exp(f1$estimate["sdlog"]^2)-1)), emp=var(x3)*(n-1)/n) # (6) test error messages # mnorm3 <- dnorm3 <- function(x, a) "NA" x <- rnorm(nsample) #should get a one-line error res <- mmedist(x, "norm3", start=list(a=1), order=1, memp=function(x, order) mean(x)) #as in attr(try(log("a"), silent=TRUE), "condition") # (7) fit of a normal distribution with weighted moment matching estimation # n <- nsample w <- c(rep(1, n/2), rep(10, n/2)) mmedist(x1, "norm", weights=w)$estimate #check sum(w*x1)/sum(w) fitdistrplus:::wtd.mean(x1, w) sum(w*(x1-sum(w*x1)/sum(w))^2)/sum(w) fitdistrplus:::wtd.var(x1, w) mmedist(exp(x1), "lnorm", weights=w)$estimate #test non integer weights try(mmedist(x1, "norm", weights=rep(1/3, length(x1)))) try(mmedist(1:10, "pois", weights=c(rep(1, 9), 1.001), start=list(lambda=mean(x)))) try(mmedist(1:10, "pois", weights=c(rep(1, 9), 1.0000001), start=list(lambda=mean(x)))) # (8) fit of a neg binom distribution with weighted moment matching estimation # x4 <- rnbinom(nsample, 5, 1/2) table(x4) w <- rep(1, length(x4)) w[x4 > 5] <- 2 mmedist(x4, "nbinom", weights=w)$estimate mmedist(x4, "nbinom", weights=NULL)$estimate # (9) relevant example for zero modified geometric distribution # rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } dzmgeom <- function(x, p1, p2) { p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) } mgeom <- function(order, prob) { if(order == 1) (1-prob)/(prob) else if(order == 2) (2-3*prob+prob^2)/prob^2 else stop("not yet implemented") } if(FALSE) { c(mean(rgeom(1e4, 1/6)), mgeom(1, 1/6)) c(mean(rgeom(1e4, 1/6)^2), mgeom(2, 1/6)) } mzmgeom <- function(order, p1, p2) #raw moment { if(order == 1) (1-p1)*( mgeom(1, p2) + 1 ) + p1*0 #mean else if(order == 2) (1-p1)*( mgeom(2, p2)+ 2*mgeom(1, p2)+1) + p1*0 #E(X^2) else stop("not yet implemented") } if(FALSE) { c(mean(rzmgeom(1e4, 1/3, 1/6)), mzmgeom(1, 1/3, 1/6)) c(mean(rzmgeom(1e4, 1/3, 1/6)^2), mzmgeom(2, 1/3, 1/6)) } memp1 <- function(x, order) mean(x^order) memp2 <- function(x, order, weights) sum(x^order * weights)/sum(weights) x5 <- rzmgeom(nsample, 1/3, 1/6) w <- rep(1, length(x5)) w[x5 > 5] <- 2 mmedist(x5, "zmgeom", order=1:2, memp=memp1, start=list(p1=mean(x5 == 0), p2=1/mean(x5[x5 > 0])), lower=0.01, upper=0.99)$estimate mmedist(x5, "zmgeom", order=1:2, memp=memp2, start=list(p1=mean(x5 == 0), p2=1/mean(x5[x5 > 0])), weights=w)$estimate mmedist(x5, "zmgeom", order=1:2, memp=memp1, start=list(p1=mean(x5 == 0), p2=1/mean(x5[x5 > 0])), lower=0.01, upper=0.99)$loglik mmedist(x5, "zmgeom", order=1:2, memp=memp2, start=list(p1=mean(x5 == 0), p2=1/mean(x5[x5 > 0])), weights=w)$loglik # (10) bounds # if(any(installed.packages()[, "Package"] == "actuar")) { require(actuar) #simulate a sample x4 <- rpareto(nsample, 6, 2) #empirical raw moment memp <- function(x, order) mean(x^order) #fit mmedist(x4, "pareto", order=c(1, 2), memp=memp, start=c(shape=10, scale=10), lower=1, upper=Inf, optim.method = "L-BFGS-B") #L-BFGS-B via optim mmedist(x4, "pareto", order=c(1, 2), memp=memp, start=c(shape=10, scale=10), lower=1, upper=Inf, optim.method = "Nelder") #Nelder Mead via constrOptim } fitdistrplus/tests/t-ppcomp.R0000644000176200001440000001752214050660542016043 0ustar liggesuserslibrary(fitdistrplus) # ?ppcomp visualize <- FALSE # TRUE for manual tests with visualization of results nsample <- 1000 nsample <- 10 # (1) Plot various distributions fitted to serving size data # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving, "weibull") fitln <- fitdist(serving, "lnorm") fitg <- fitdist(serving, "gamma") # sanity checks try(ppcomp("list(fitW, fitln, fitg)"), silent = TRUE) try(ppcomp(list(fitW, fitln, fitg, a = 1)), silent = TRUE) # real call ppcomp(list(fitW, fitln, fitg)) ppcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlim = c(0, 1/2)) ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlogscale=TRUE, line01=FALSE) ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", ylogscale=TRUE, line01=FALSE) ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", ylim=c(1e-3, 1), xlim=c(1e-3, 1), fitpch=c("+", "-", ".")) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(fitW, fitln, fitg), plotstyle = "ggplot") } if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlim = c(0, 1/2), plotstyle = "ggplot") ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", xlogscale=TRUE, line01=FALSE, plotstyle = "ggplot") ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", xlab="Theo.", ylab="serving sizes (g)", ylogscale=TRUE, line01=FALSE, plotstyle = "ggplot") ppcomp(list(fitW, fitln, fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits", ylim=c(1e-3, 1), xlim=c(1e-3, 1), fitpch=c("+", "-", "."), plotstyle = "ggplot") } # (2) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # data(endosulfan) ATV <-subset(endosulfan, group == "NonArthroInvert")$ATV flnMGEKS <- fitdist(ATV,"lnorm",method="mge",gof="KS") flnMGEAD <- fitdist(ATV,"lnorm",method="mge",gof="AD") flnMGEADL <- fitdist(ATV,"lnorm",method="mge",gof="ADL") flnMGEAD2L <- fitdist(ATV,"lnorm",method="mge",gof="AD2L") llfit <- list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L) ppcomp(llfit, main="fits of a lognormal dist. using various GOF dist.") ppcomp(llfit, xlegend="topleft", xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L")) ppcomp(llfit, xlegend="topleft", xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2")) ppcomp(llfit, ynoise=FALSE, xlogscale=TRUE, ylogscale=TRUE, xlim=c(1e-3,1), ylim=c(1e-3,1)) ppcomp(flnMGEKS) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { ppcomp(llfit, main="fits of a lognormal dist. using various GOF dist.", plotstyle = "ggplot") ppcomp(llfit, xlegend="topleft", xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), plotstyle = "ggplot") ppcomp(llfit, xlegend="topleft", xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), plotstyle = "ggplot") ppcomp(llfit, ynoise=FALSE, xlogscale=TRUE, ylogscale=TRUE, xlim=c(1e-3,1), ylim=c(1e-3,1), plotstyle = "ggplot") ppcomp(flnMGEKS, plotstyle = "ggplot") } # (3) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # if (visualize) { x1 <- c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4,13.2,8.4,6.3,8.9,5.2,10.9,14.4) n1 <- length(x1) dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) f1 <- mledist(x1, "norm") f2 <- mledist(x1, "gumbel", start = list(a = 10, b = 5)) f3 <- mledist(x1, "exp") xx1 <- pnorm(sort(x1), f1$estimate[1], f1$estimate[2]) xx2 <- pgumbel(sort(x1), f2$estimate[1], f2$estimate[2]) xx3 <- pexp(sort(x1), f3$estimate[1]) xlim <- c(xx1, xx2, xx3) xlim <- range(xlim[which(is.finite(xlim))]) # graph 1 plot(xx1, 1:n1/n1, col = "red", xlim = xlim) points(xx2, 1:n1/n1, col = "green") points(xx3, 1:n1/n1, col = "blue") legend("bottomright", pch = 1, leg = c("Normal","Gumbel","Exp"), col = c("red","green","blue")) # graph 2 f1 <- fitdist(x1,"norm") f2 <- fitdist(x1,"gumbel",start=list(a=10,b=5)) f3 <- fitdist(x1, "exp") ppcomp(list(f1, f2, f3), fitcol=c("red","green","blue"), ynoise = FALSE, legendtext = c("Normal","Gumbel","Exp")) # graph 3 if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2, f3), fitcol=c("red","green","blue"), ynoise = FALSE, legendtext = c("Normal","Gumbel","Exp"), plotstyle = "gg") } } # (4) normal mixture # #mixture of two normal distributions #density dnorm2 <- function(x, poid, m1, s1, m2, s2) poid*dnorm(x, m1, s1) + (1-poid)*dnorm(x, m2, s2) #numerical approximate quantile function qnorm2 <- function(p, poid, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, poid, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-1000, 1000), prob=pr)$minimum) } #distribution function pnorm2 <- function(q, poid, m1, s1, m2, s2) poid*pnorm(q, m1, s1) + (1-poid)*pnorm(q, m2, s2) #basic normal distribution set.seed(1234) x2 <- c(rnorm(nsample, 5), rnorm(nsample, 10)) #MLE fit fit1 <- fitdist(x2, "norm2", "mle", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0)) fit2 <- fitdist(x2, "norm2", "qme", probs=c(1/6, 1/4, 1/3, 1/2, 2/3), start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) fit3 <- fitdist(x2, "norm2", "mge", gof="AD", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) ppcomp(list(fit1, fit2, fit3), fitpch=rep(".", 3), fitcol=c("green", "red", "blue")) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { ppcomp(list(fit1, fit2, fit3), fitpch=rep(".", 3), fitcol=c("green", "red", "blue"), plotstyle = "gg") } # (5) large data # if (visualize) { n <- 2e4 x <- rlnorm(n) f1 <- fitdist(x, "lnorm") f2 <- fitdist(x, "exp") ppcomp(list(f1, f2), fitpch=3) ppcomp(list(f1, f2), fitlwd=2) if (requireNamespace ("ggplot2", quietly = TRUE)) { ppcomp(list(f1, f2), fitpch=3, plotstyle = "ggplot") ppcomp(list(f1, f2), fitlwd=2, plotstyle = "ggplot") } } # (6) test legend labels # if (visualize) { serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitW2 <- fitdist(serving,"weibull", method="qme", probs=c(1/3,2/3)) fitW3 <- fitdist(serving,"weibull", method="qme", probs=c(1/2,2/3)) fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") ppcomp(list(fitW, fitln, fitg)) #distrib ppcomp(list(fitW, fitW2, fitln, fitg)) #distrib+method ppcomp(list(fitW, fitW2, fitW3, fitln, fitg)) #distrib+method+num if (requireNamespace ("ggplot2", quietly = TRUE)) ppcomp(list(fitW, fitW2, fitW3, fitln, fitg), plotstyle = "ggplot") #distrib+method+num } fitdistrplus/tests/t-fitbench.R0000644000176200001440000000122714050660542016322 0ustar liggesusersif(FALSE) { require(fitdistrplus) x <- rgamma(1e3, shape=3/2, rate= 1/2) initval <- unlist(fitdistrplus:::start.arg.default(x, "gamma")) fitdistrplus:::fitbench(x, "gamma", "mle") fitdistrplus:::fitbench(x, "gamma", "mle", lower=0) # grgam(1:2, x) # grgamlnl(x[1], shape=1, rate=2) # grgamlnl(x[1:2], shape=1, rate=2) fitdistrplus:::fitbench(x, "gamma", "mle", grad=fitdistrplus:::grlnlgamma) fitdistrplus:::fitbench(x, "gamma", "mle", grad=fitdistrplus:::grlnlgamma, lower=0) #mledist(x, "gamma", grad=grgam, lower=0, optim.method = "CG") #mledist(x, "gamma", grad=grgam, lower=0, optim.method = "BFGS") } fitdistrplus/tests/t-util-npmle.R0000644000176200001440000001573714050660542016641 0ustar liggesuserslibrary(fitdistrplus) compare.plotdistcens <- function(d) { par(mfrow = c(2,2)) plotdistcens(d, NPMLE.method = "Turnbull.middlepoints") plotdistcens(d, NPMLE.method = "Turnbull.intervals") plotdistcens(d, NPMLE.method = "Wang") } compare.npmle <- function(d) { npmleT <- fitdistrplus:::npmle(d, method = "Turnbull.intervals") npmleW <- fitdistrplus:::npmle(d, method = "Wang") print(npmleT) print(npmleW) cat("nb of intervals for Turnbull: ", nrow(npmleT), "\n") cat("nb of intervals for Wang: ", nrow(npmleW), "\n") xmin <- min(c(npmleT$left[is.finite(npmleT$left)],npmleT$left[is.finite(npmleT$left)])) xmax <- max(c(npmleT$right[is.finite(npmleT$right)],npmleT$right[is.finite(npmleT$right)])) par(mfrow = c(2, 1)) plot(npmleT$left, npmleT$p, xlim = c(xmin, xmax), main = "left") points(npmleW$left, npmleW$p, col = "red", pch = 4) plot(npmleT$right, npmleT$p, xlim = c(xmin, xmax), main = "right") points(npmleW$right, npmleW$p, col = "red", pch = 4) } #### Comparison of plotdistcens with different NPMLE methods if(FALSE) { # d1 = trivial case with only interval censored data d1 <- data.frame(left = c(1, 2, 3, 4, 3, 7), right = c(2, 5, 3, 7, 8, 9)) d <- d1 par(mfrow = c(2,2)) compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "norm") fb <- fitdistcens(d, "logis") par(mfrow = c(2,2)) cdfcompcens(list(fa, fb), NPMLE.method = "Turnbull.middlepoints") cdfcompcens(list(fa, fb), NPMLE.method = "Turnbull.intervals") cdfcompcens(list(fa, fb), NPMLE.method = "Wang") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d2 = case with left and right censored data data(smokedfish) d2 <- smokedfish d <- d2 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "lnorm") fb <- fitdistcens(d, "gamma") par(mfrow = c(2,2)) cdfcompcens(list(fa, fb), NPMLE.method = "Turnbull.middlepoints") cdfcompcens(list(fa, fb), NPMLE.method = "Turnbull.intervals") cdfcompcens(list(fa, fb), NPMLE.method = "Wang") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d3 = case with also rigth censored data d3 <- data.frame(left = c(-1.4, 1.18, -1.4, 2, -1.4, 0), right = c(1, 1.18, 2, NA, 0, 2)) d <- d3 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "norm") fb <- fitdistcens(d, "logis") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d4 = case with also right censored data # with differences between the algorithms by the way they polish # the ECDF function, by putting some masses to zero. require(actuar) data(fluazinam) d4 <- fluazinam d <- d4 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "lnorm") fb <- fitdistcens(d, "llogis") par(mfrow = c(1,2)) cdfcompcens(list(fa, fb), NPMLE.method = "Turnbull.intervals") cdfcompcens(list(fa, fb), NPMLE.method = "Wang") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d5 a random example with exact values set.seed(123) r <- rnorm(10) d5 <- data.frame(left = r, right = r) d <- d5 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "norm") fb <- fitdistcens(d, "logis") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d7 = bigger dataset with also rigth censored data data(salinity) d7 <- log10(salinity) d <- d7 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "logis") fb <- fitdistcens(d, "norm") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d8 = an random example with all types of data (a small one) # set.seed(1234) # check OK # set.seed(1231) # check OK set.seed(1232) ns <- 25 r <- rnorm(ns) d8 <- data.frame(left = r, right = r) delta <- rlnorm(ns) icensored <- rbinom(ns, size = 1, prob = 0.2) Lcensored <- rbinom(ns, size = 1, prob = 0.2*(1 - icensored)) Rcensored <- rbinom(ns, size = 1, prob = 0.3*(1 - icensored)*(1 - Lcensored)) # icensored + Lcensored + Rcensored d8$left <- d8$left * (1 - Lcensored) + (-1000) * Lcensored d8$right <- d8$right * (1 - Rcensored) + (1000) * Rcensored d8$right <- d8$right + delta * icensored d8$right[d8$right == 1000] <- NA d8$left[d8$left == -1000] <- NA d8 d <- d8 compare.plotdistcens(d) compare.npmle(d) fa <- fitdistcens(d, "logis") fb <- fitdistcens(d, "norm") par(mfrow = c(1,2)) ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") ppcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Turnbull.intervals") qqcompcens(list(fa, fb), ynoise = FALSE, NPMLE.method = "Wang") # d8 = an random example with all types of data (a big one) # set.seed(1234) # check OK # set.seed(1231) # check OK set.seed(1232) ns <- 500 # ns <- 5000 r <- rnorm(ns) d8 <- data.frame(left = r, right = r) delta <- rlnorm(ns) icensored <- rbinom(ns, size = 1, prob = 0.2) Lcensored <- rbinom(ns, size = 1, prob = 0.2*(1 - icensored)) Rcensored <- rbinom(ns, size = 1, prob = 0.3*(1 - icensored)*(1 - Lcensored)) # icensored + Lcensored + Rcensored d8$left <- d8$left * (1 - Lcensored) + (-1000) * Lcensored d8$right <- d8$right * (1 - Rcensored) + (1000) * Rcensored d8$right <- d8$right + delta * icensored d8$right[d8$right == 1000] <- NA d8$left[d8$left == -1000] <- NA d <- d8 par(mfrow = c(2,2)) system.time(plotdistcens(d, NPMLE.method = "Turnbull.middlepoints")) system.time(plotdistcens(d, NPMLE.method = "Turnbull.intervals")) system.time(plotdistcens(d, NPMLE.method = "Wang")) } fitdistrplus/tests/t-cdfcomp.R0000644000176200001440000003260514102205434016150 0ustar liggesuserslibrary(fitdistrplus) # ?cdfcomp visualize <- FALSE # TRUE for manual tests with visualization of results nsample <- 1000 nsample <- 10 # (1) Plot various distributions fitted to serving size data # data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") #sanity checks try(cdfcomp("list(fitW, fitln, fitg)",horizontals = FALSE), silent=TRUE) try(cdfcomp(list(fitW, fitln, fitg, a=1),horizontals = FALSE), silent=TRUE) #real call cdfcomp(list(fitW, fitln, fitg), horizontals = FALSE) cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE) cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, lines01 = TRUE) cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, verticals = TRUE, datacol = "grey") if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcomp(list(fitW, fitln, fitg), horizontals = FALSE, plotstyle = "ggplot") } if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, plotstyle = "ggplot") cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, lines01 = TRUE, plotstyle = "ggplot") cdfcomp(list(fitW, fitln, fitg), horizontals = TRUE, verticals = TRUE, datacol = "grey", plotstyle = "ggplot") } cdfcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", ylab = "F(g)", xlim = c(0, 250), ylim = c(.5, 1)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", ylab = "F(g)", xlim = c(0, 250), ylim = c(.5, 1), plotstyle = "ggplot") } cdfcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", ylab = "F(g)", xlogscale = TRUE) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), main = "ground beef fits", xlab = "serving sizes (g)", ylab = "F(g)", xlogscale = TRUE, plotstyle = "ggplot") } cdfcomp(list(fitW,fitln,fitg),legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F(g)", xlogscale=TRUE, ylogscale=TRUE, ylim=c(.005, .99)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fitW,fitln,fitg),legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F(g)", xlogscale=TRUE, ylogscale=TRUE, ylim=c(.005, .99), plotstyle = "ggplot") } cdfcomp(list(fitW,fitln,fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F(g)",xlim = c(0,250), xlegend = "topleft") if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fitW,fitln,fitg), legendtext=c("Weibull","lognormal","gamma"), main="ground beef fits",xlab="serving sizes (g)", ylab="F(g)",xlim = c(0,250), xlegend = "topleft", plotstyle = "ggplot") } # (2) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # data(endosulfan) ATV <-subset(endosulfan, group == "NonArthroInvert")$ATV taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa flnMGEKS <- fitdist(ATV,"lnorm",method="mge",gof="KS") flnMGEAD <- fitdist(ATV,"lnorm",method="mge",gof="AD") flnMGEADL <- fitdist(ATV,"lnorm",method="mge",gof="ADL") flnMGEAD2L <- fitdist(ATV,"lnorm",method="mge",gof="AD2L") llfit <- list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L) cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE,main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L")) cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE,main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), horizontals=FALSE, datapch="+") cdfcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=paste("MGE", c("KS","AD","ADL","AD2L")), fitcol="grey35", fitlty="dotted", horizontals=FALSE, datapch=21, datacol="grey30") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, verticals=TRUE, xlim=c(10,100000), datapch=21) cdfcomp(flnMGEKS, xlogscale=TRUE, verticals=TRUE, xlim=c(10,100000)) cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, verticals=TRUE, xlim=c(1,100000), datapch=21, name.points=taxaATV) cdfcomp(flnMGEKS, xlogscale=TRUE, verticals=TRUE, xlim=c(1,100000), name.points=taxaATV) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, main = "fits of a lognormal dist. using various GOF dist.", plotstyle = "ggplot") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE,main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), plotstyle = "ggplot") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE,main="fits of a lognormal dist. using various GOF dist.", legendtext=c("MGE KS","MGE AD","MGE ADL","MGE AD2L"), fitcol=c("black", "darkgreen", "yellowgreen", "yellow2"), horizontals=FALSE, datapch="+", plotstyle = "ggplot") cdfcomp(llfit, xlogscale=TRUE, main="fits of a lognormal dist. using various GOF dist.", legendtext=paste("MGE", c("KS","AD","ADL","AD2L")), fitcol="grey35", fitlty="dotted", horizontals=FALSE, datapch=21, datacol="grey30", plotstyle = "ggplot") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, verticals=TRUE, xlim=c(10,100000), datapch=21, plotstyle = "ggplot") cdfcomp(flnMGEKS, xlogscale=TRUE, verticals=TRUE, xlim=c(10,100000), plotstyle = "ggplot") cdfcomp(list(flnMGEKS, flnMGEAD, flnMGEADL, flnMGEAD2L), xlogscale=TRUE, verticals=TRUE, xlim=c(1,100000), datapch=21, name.points=taxaATV, plotstyle = "ggplot") cdfcomp(flnMGEKS, xlogscale=TRUE, verticals=TRUE, xlim=c(1,100000), name.points=taxaATV, plotstyle = "ggplot") } # (3) Plot normal and logistic distributions fitted by # maximum likelihood estimation # using various plotting positions in cdf plots # if (visualize) { data(endosulfan) log10ATV <-log10(subset(endosulfan, group == "NonArthroInvert")$ATV) taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa fln <- fitdist(log10ATV, "norm") fll <- fitdist(log10ATV, "logis") # default plot using Hazen plotting position: (1:n - 0.5)/n cdfcomp(list(fln, fll), legendtext = c("normal", "logistic"), xlab = "log10ATV", name.points=taxaATV, xlim = c(0,5)) if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcomp(list(fln, fll), legendtext = c("normal", "logistic"),xlab = "log10ATV", name.points=taxaATV, xlim=c(0,5), plotstyle = "ggplot") } # plot using mean plotting position (named also Gumbel plotting position) # (1:n)/(n + 1) cdfcomp(list(fln,fll),legendtext=c("normal","logistic"),xlab="log10ATV", use.ppoints = TRUE, a.ppoints = 0) if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcomp(list(fln,fll),legendtext=c("normal","logistic"),xlab="log10ATV", use.ppoints = TRUE, a.ppoints = 0, plotstyle = "ggplot") } # plot using basic plotting position: (1:n)/n cdfcomp(list(fln,fll),legendtext=c("normal","logistic"),xlab="log10ATV", use.ppoints = FALSE) if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcomp(list(fln,fll),legendtext=c("normal","logistic"),xlab="log10ATV", use.ppoints = FALSE, plotstyle = "ggplot") } } # (4) Plot lognormal distributions fitted by # maximum goodness-of-fit estimation # using various distances (data plotted in log scale) # if (visualize) { x1 <- c(6.4,13.3,4.1,1.3,14.1,10.6,9.9,9.6,15.3,22.1,13.4,13.2,8.4,6.3,8.9,5.2,10.9,14.4) x <- seq(0, 1.1*max(x1), length=100) dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) f1 <- mledist(x1, "norm") f2 <- mledist(x1, "gumbel", start = list(a = 10, b = 5)) f3 <- mledist(x1, "exp") # graph 1 plot(ecdf(x1)) lines(x, pnorm(x, f1$estimate[1], f1$estimate[2]), col = "red") lines(x, pgumbel(x, f2$estimate[1], f2$estimate[2]), col = "green") lines(x, pexp(x, f3$estimate[1]), col = "blue") legend("bottomright", lty = 1, leg = c("Normal", "Gumbel", "Exp"), col = c("red", "green", "blue")) # graph 2 f1 <- fitdist(x1, "norm") f2 <- fitdist(x1, "gumbel", start = list(a = 10, b = 5)) f3 <- fitdist(x1, "exp") cdfcomp(list(f1, f2, f3), xlim=range(x), fitcol = c("red", "green", "blue"), fitlty = 1, legendtext = c("Normal", "Gumbel", "Exp")) cdfcomp(list(f1, f2, f3), xlim=range(x), fitcol = c("red", "green", "blue"), fitlty = 1, fitlwd = (1:3)*2, legendtext = c("Normal", "Gumbel", "Exp")) # graph 3 if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcomp(list(f1, f2, f3), xlim=range(x), fitcol=c("red","green","blue"), fitlty = 1, legendtext = c("Normal", "Gumbel", "Exp"), plotstyle = "ggplot") cdfcomp(list(f1, f2, f3), xlim=range(x), fitcol=c("red","green","blue"), fitlty = 1, fitlwd = 1:3, legendtext = c("Normal", "Gumbel", "Exp"), plotstyle = "ggplot") } } # (5) normal mixture # # mixture of two normal distributions # density dnorm2 <- function(x, poid, m1, s1, m2, s2) poid*dnorm(x, m1, s1) + (1-poid)*dnorm(x, m2, s2) # numerically approximate quantile function qnorm2 <- function(p, poid, m1, s1, m2, s2) { L2 <- function(x, prob) (prob - pnorm2(x, poid, m1, s1, m2, s2))^2 sapply(p, function(pr) optimize(L2, c(-1000, 1000), prob=pr)$minimum) } # distribution function pnorm2 <- function(q, poid, m1, s1, m2, s2) poid*pnorm(q, m1, s1) + (1-poid)*pnorm(q, m2, s2) # basic normal distribution set.seed(1234) x2 <- c(rnorm(nsample, 5), rnorm(nsample, 10)) # MLE fit fit1 <- fitdist(x2, "norm2", "mle", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0)) fit2 <- fitdist(x2, "norm2", "qme", probs=c(1/6, 1/4, 1/3, 1/2, 2/3), start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) fit3 <- fitdist(x2, "norm2", "mge", gof="AD", start=list(poid=1/3, m1=4, s1=2, m2=8, s2=2), lower=c(0, 0, 0, 0, 0), upper=c(1/2, Inf, Inf, Inf, Inf)) cdfcomp(list(fit1, fit2, fit3), datapch=".") cdfcomp(list(fit1, fit2, fit3), datapch=".", xlim=c(6, 8), ylim=c(.4, .55)) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fit1, fit2, fit3), datapch=".", plotstyle = "ggplot") cdfcomp(list(fit1, fit2, fit3), datapch=".", xlim=c(6, 8), ylim=c(.4, .55), plotstyle = "ggplot") } # (6) discrete example # set.seed(1234) x3 <- rpois(20, 10) fit1 <- fitdist(x3, "pois", "mle") fit2 <- fitdist(x3, "nbinom", "qme", probs=c(1/3, 2/3)) cdfcomp(list(fit1, fit2), datapch=21, horizontals=FALSE) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(list(fit1, fit2), datapch=21, horizontals=FALSE, plotstyle = "ggplot") } # (7) large dataset # if (visualize) { n <- 1e4 f1 <- fitdist(rlnorm(n), "lnorm") cdfcomp(f1, do.points=TRUE) cdfcomp(f1, do.points=FALSE) cdfcomp(f1, horizontals = FALSE, verticals = FALSE, do.points = FALSE) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { cdfcomp(f1, do.points = TRUE, plotstyle = "ggplot") cdfcomp(f1, do.points = FALSE, plotstyle = "ggplot") cdfcomp(f1, horizontals = FALSE, verticals = FALSE, do.points = FALSE, plotstyle = "ggplot") } } # (8) argument add (must give the same plot (except colors) as ex. 6) # set.seed(1234) x3 <- rpois(nsample, 10) fit1 <- fitdist(x3, "pois", "mle") cdfcomp(fit1, fitcol = "red", horizontals=FALSE, addlegend = FALSE) fit2 <- fitdist(x3, "nbinom", "qme", probs=c(1/3, 2/3)) cdfcomp(fit2, fitcol = "blue", horizontals=FALSE, addlegend = FALSE, add = TRUE) cdfcomp(list(fit1, fit2), horizontals=FALSE, addlegend = FALSE, fitcol=c("red", "blue")) if (requireNamespace ("ggplot2", quietly = TRUE) & visualize) { # the argument add is not available when plotstyle = "ggplot" cdfcomp(list(fit1, fit2), fitcol = c("red", "blue"), fitlty = 1, horizontals = FALSE, addlegend = FALSE, plotstyle = "ggplot") } # (9) test legend labels # if (visualize) { serving <- groundbeef$serving fitW <- fitdist(serving,"weibull") fitW2 <- fitdist(serving,"weibull", method="qme", probs=c(1/3,2/3)) fitW3 <- fitdist(serving,"weibull", method="qme", probs=c(1/2,2/3)) fitln <- fitdist(serving,"lnorm") fitg <- fitdist(serving,"gamma") cdfcomp(list(fitW, fitln, fitg)) #distrib cdfcomp(list(fitW, fitW2, fitln, fitg)) #distrib+method cdfcomp(list(fitW, fitW2, fitW3, fitln, fitg)) #distrib+method+num if (requireNamespace ("ggplot2", quietly = TRUE)) cdfcomp(list(fitW, fitW2, fitW3, fitln, fitg), plotstyle = "ggplot") #distrib+method+num } fitdistrplus/tests/t-cdfcompcens.R0000644000176200001440000000615713742313702017033 0ustar liggesuserslibrary(fitdistrplus) visualize <- FALSE # TRUE for manual tests with visualization of results # (1) Plot various distributions fitted to bacterial contamination data # data(smokedfish) Clog10 <- log10(smokedfish) fitsfn <- fitdistcens(Clog10,"norm") fitsfl <- fitdistcens(Clog10,"logis") dgumbel <- function(x,a,b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q,a,b) exp(-exp((a-q)/b)) qgumbel <- function(p,a,b) a-b*log(-log(p)) fitsfg <- fitdistcens(Clog10, "gumbel", start=list(a=-3,b=3)) cdfcompcens(list(fitsfn,fitsfl,fitsfg)) cdfcompcens(list(fitsfn,fitsfl,fitsfg), fitlty=1, fitlwd=3) # Same plot in y logscale cdfcompcens(list(fitsfn, fitsfl, fitsfg), NPMLE.method = "Turnbull", ylogscale = TRUE, ylim=c(.5, .99)) cdfcompcens(list(fitsfn, fitsfl, fitsfg), NPMLE.method = "Wang", ylogscale = TRUE, ylim=c(.5, .99)) if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcompcens(list(fitsfn,fitsfl,fitsfg), plotstyle = "ggplot") cdfcompcens(list(fitsfn,fitsfl,fitsfg), plotstyle = "ggplot", fitlty=1, fitlwd=3) cdfcompcens(list(fitsfn,fitsfl,fitsfg), datacol="grey", legendtext=c("normal","logistic","Gumbel"), main="bacterial contamination fits", xlab="bacterial concentration (CFU/g)", ylab="F", xlegend = "center", lines01 = TRUE, plotstyle = "ggplot") # Same plot in y logscale cdfcompcens(list(fitsfn, fitsfl, fitsfg), NPMLE.method = "Wang", ylogscale = TRUE, ylim=c(.5, .99), plotstyle = "ggplot") } # Use of x logscale if (visualize) { if(any(installed.packages()[,"Package"] == "actuar")) { require(actuar) data(smokedfish) fln <- fitdistcens(smokedfish,"lnorm") fll <- fitdistcens(smokedfish,"llogis") cdfcompcens(list(fln, fll)) cdfcompcens(list(fln, fll), xlogscale = TRUE) cdfcompcens(list(fln, fll), xlogscale = TRUE, xlim = c(0.01, 1000)) cdfcompcens(list(fln, fll), NPMLE.method = "Turnbull", xlogscale = TRUE, xlim = c(0.01, 1000)) if (requireNamespace ("ggplot2", quietly = TRUE)) { cdfcompcens(list(fln, fll), plotstyle = "ggplot") cdfcompcens(list(fln, fll), xlogscale = TRUE, plotstyle = "ggplot") cdfcompcens(list(fln, fll), xlogscale = TRUE, xlim = c(0.01, 1000), plotstyle = "ggplot") } } # same plot using argument add cdfcompcens(fitsfn, addlegend = FALSE, fitcol = "red") cdfcompcens(fitsfl, addlegend = FALSE, fillrect = NA, fitcol = "green", add = TRUE) cdfcompcens(fitsfg, addlegend = FALSE, fillrect = NA, fitcol = "blue", add = TRUE) cdfcompcens(list(fitsfn, fitsfl, fitsfg), addlegend = FALSE, fitcol = 2:4, fitlty = 1, plotstyle = "ggplot") cdfcompcens(list(fitsfn, fitsfl, fitsfg), addlegend = FALSE, fitcol = 2:4, fitlty = 1, plotstyle = "ggplot") } # Test on the salinity data set # data(salinity) log10LC50 <-log10(salinity) plotdistcens(log10LC50) plotdistcens(log10LC50, NPMLE = FALSE) fn <- fitdistcens(log10LC50,"norm") fl <- fitdistcens(log10LC50,"logis") plot(fn) plot(fl) cdfcompcens(list(fn, fl)) if (requireNamespace("ggplot2", quietly = TRUE)) { cdfcompcens(list(fn, fl), plotstyle = "ggplot") } fitdistrplus/tests/t-mgedist.R0000644000176200001440000000700214050660542016171 0ustar liggesuserslibrary(fitdistrplus) nsample <- 10 # (1) Fit of a Weibull distribution to serving size data by maximum # goodness-of-fit estimation using all the distances available # data(groundbeef) serving <- groundbeef$serving mgedist(serving, "weibull", gof="CvM") mgedist(serving, "weibull", gof="CvM", silent = FALSE) mgedist(serving, "weibull", gof="KS") mgedist(serving, "weibull", gof="AD") mgedist(serving, "weibull", gof="ADR") mgedist(serving, "weibull", gof="ADL") mgedist(serving, "weibull", gof="AD2R") mgedist(serving, "weibull", gof="AD2L") mgedist(serving, "weibull", gof="AD2") # (2) Fit of a uniform distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # set.seed(1234) u <- runif(nsample, min=5, max=10) mgedist(u, "unif", gof="CvM") mgedist(u, "unif", gof="KS") # (3) Fit of a triangular distribution using Cramer-von Mises or # Kolmogorov-Smirnov distance # require(mc2d) set.seed(1234) t <- rtriang(nsample, min=5, mode=6, max=10) mgedist(t, "triang", start = list(min=4, mode=6,max=9), gof="CvM") mgedist(t, "triang", start = list(min=4, mode=6,max=9), gof="KS") # (4) scaling problem # the simulated dataset (below) has particularly small values, hence without scaling (10^0), # the optimization raises an error. The for loop shows how scaling by 10^i # for i=1,...,6 makes the fitting procedure work correctly. if(FALSE) { set.seed(1234) x2 <- rnorm(nsample, 1e-4, 2e-4) for(i in 6:0) cat(i, try(mgedist(x2*10^i,"cauchy")$estimate, silent=TRUE), "\n") } # (5) scaling problem # if(FALSE) { x <- c(-0.00707717, -0.000947418, -0.00189753, -0.000474947, -0.00190205, -0.000476077, 0.00237812, 0.000949668, 0.000474496, 0.00284226, -0.000473149, -0.000473373, 0, 0, 0.00283688, -0.0037843, -0.0047506, -0.00238379, -0.00286807, 0.000478583, 0.000478354, -0.00143575, 0.00143575, 0.00238835, 0.0042847, 0.00237248, -0.00142281, -0.00142484, 0, 0.00142484, 0.000948767, 0.00378609, -0.000472478, 0.000472478, -0.0014181, 0, -0.000946522, -0.00284495, 0, 0.00331832, 0.00283554, 0.00141476, -0.00141476, -0.00188947, 0.00141743, -0.00236351, 0.00236351, 0.00235794, 0.00235239, -0.000940292, -0.0014121, -0.00283019, 0.000472255, 0.000472032, 0.000471809, -0.0014161, 0.0014161, -0.000943842, 0.000472032, -0.000944287, -0.00094518, -0.00189304, -0.000473821, -0.000474046, 0.00331361, -0.000472701, -0.000946074, 0.00141878, -0.000945627, -0.00189394, -0.00189753, -0.0057143, -0.00143369, -0.00383326, 0.00143919, 0.000479272, -0.00191847, -0.000480192, 0.000960154, 0.000479731, 0, 0.000479501, 0.000958313, -0.00383878, -0.00240674, 0.000963391, 0.000962464, -0.00192586, 0.000481812, -0.00241138, -0.00144963) #only i == 0, no scaling, should not converge. for(i in 6:0) cat(i, try(mgedist(x*10^i,"cauchy")$estimate, silent=TRUE), "\n") } # (6) test error messages # dnorm2 <- pnorm2 <- function(x, a) "NA" x <- rexp(10) #should get a one-line error res <- mgedist(x, "norm2", start=list(a=1)) #as in attr(try(log("a"), silent=TRUE), "condition") # (7) test the component optim.message x <- rnorm(1000) #change parameter to obtain unsuccessful convergence mgedist(x, "norm", control=list(maxit=2), start=list(mean=1e5, sd=1), optim.method="L-BFGS-B", lower=0) # (8) test bounds x <- rnorm(1000) mgedist(x, "norm", optim.method="L-BFGS-B", lower=c(-Inf, 0)) #optim and L-BFGS-B mgedist(x, "norm", optim.method="Nelder", lower=c(-Inf, 0)) fitdistrplus/tests/t-startingvalues.R0000644000176200001440000000316013742313702017611 0ustar liggesuserslibrary(fitdistrplus) library(actuar) x <- c(3.1334614, 1.0300544, 0.8839272, 0.7503320, 1.9378476, 1.7571313, 0.5369516, 3.1181863, 1.7412457, 1.1514215, 1.6252670, 1.3333488, 3.0594471, 1.0479867, 0.4466562, 0.4387154, 1.5234127, 1.5476924, 1.3279816, 1.3978141) ft_igam <- fitdist(x, "invgamma") x <- c(2.3,0.1,2.7,2.2,0.4,2.6,0.2,1.,7.3,3.2,0.8,1.2,33.7,14., 21.4,7.7,1.,1.9,0.7,12.6,3.2,7.3,4.9,4000.,2.5,6.7,3.,63., 6.,1.6,10.1,1.2,1.5,1.2,30.,3.2,3.5,1.2,0.2,1.9,0.7,17., 2.8,4.8,1.3,3.7,0.2,1.8,2.6,5.9,2.6,6.3,1.4,0.8) ft_llogis <- fitdist(x,"llogis") x <- c(0.3837053, 0.8576858, 0.3552237, 0.6226119, 0.4783756, 0.3139799, 0.4051403, 0.4537631, 0.4711057, 0.5647414, 0.6479617, 0.7134207, 0.5259464, 0.5949068, 0.3509200, 0.3783077, 0.5226465, 1.0241043, 0.4384580, 1.3341520) ft_iw <- fitdist(x,"invweibull") x <- c(2.06832800, 0.80102221, 9.32589765, 4.31776597, 1.10230717, 2.06120589, 1.17598984, 0.49806928, 27.25326920, 0.03468531, 1.92468452, 0.07877918, 0.58094911, 0.31080116, 3.86929105, 1.05732456, 3.06687014, 7.48990404, 0.18640324, 2.50568830) #equivalent to Pareto type 2 ft_par2 <- fitdist(x, "pareto") x <- c(1.083905, 1.266773, 1.044362, 1.557070, 1.227676, 1.195054, 1.241101, 1.224004, 1.014631, 1.173721, 1.051038, 1.104520, 1.133755, 1.051605, 1.081230, 1.123193, 1.005997, 1.044696, 1.155369, 1.039439) #equivalent to Pareto type 1 ft_par1 <-fitdist(x, "pareto1", upper=c(Inf, min(x)), fix.arg=list(min = 1), control=list(trace=1, REPORT=1), silent=FALSE) fitdistrplus/tests/t-gofstat.R0000644000176200001440000000313214075476130016211 0ustar liggesuserslibrary(fitdistrplus) # (1) fit of two distributions by maximum likelihood estimation # to the serving size data # and comparison of goodness-of-fit statistics # data(groundbeef) serving <- groundbeef$serving (fitg <- fitdist(serving, "gamma")) gg <- gofstat(fitg) (fitln <- fitdist(serving, "lnorm")) gn <- gofstat(fitln) gofstat(list(fitg, fitln)) # (2) fit of two discrete distributions to toxocara data # and comparison of goodness-of-fit statistics # data(toxocara) number <- toxocara$number fitp <- fitdist(number, "pois") summary(fitp) plot(fitp) gp <- gofstat(fitp) gp fitnb <- fitdist(number, "nbinom") summary(fitnb) plot(fitnb) gnb <- gofstat(fitnb) gnb gofstat(list(fitp, fitnb)) attributes(gofstat(list(fitp, fitnb))) # (3) Use of Chi-squared results in addition to # recommended statistics for continuous distributions # set.seed(1234) x4 <- rweibull(n=10,shape=2,scale=1) # fit of the good distribution f4 <- fitdist(x4, "weibull") g4 <- gofstat(f4, meancount=10) print(g4) # fit of a bad distribution f4b <- fitdist(x4, "cauchy") g4b <- gofstat(f4b, meancount=10) print(g4b) # (4) estimation of the standard deviation of a normal distribution # by maximum likelihood with the mean fixed at 10 using the argument fix.arg # f1b <- fitdist(serving, "norm", start=list(sd=5), fix.arg=list(mean=10), lower=0) gofstat(f1b) # (5) Use on a small data set (less than 10 observations) # no pb identified # set.seed(1234) x5a <- rweibull(n=4,shape=2,scale=1) f5a <- fitdist(x5a, "weibull") (g5a <- gofstat(f5a)) x5b <- rpois(n = 4, lambda = 1) f5b <- fitdist(x5b, "pois") (g5b <- gofstat(f5b)) fitdistrplus/tests/t-weird-qqcomp-cens.R0000644000176200001440000000635213742313702020102 0ustar liggesuserslibrary(fitdistrplus) set.seed(123) n <- 20 visualize <- FALSE # TRUE for manual tests with visualization of results if (visualize) { # (1) test qqcomp/qqcompcens on a good example # x <- rlnorm(n, 0, 1) dx <- data.frame(left=x, right=x) dx$right[1:(n/2)*2] <- NA dx$left[2:(n/4)*4-1] <- NA f1 <- fitdist(x, "lnorm") f1c <- fitdistcens(dx, "lnorm") f3 <- fitdist(x, "lnorm", fix.arg=list(sdlog=1)) f3c <- fitdistcens(dx, "lnorm", fix.arg=list(sdlog=1)) par(mfrow=1:2) qqcomp(f1) qqcompcens(f1c) par(mfrow = c(1,1)) if(requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(f1, plotstyle = "ggplot") qqcompcens(f1c, plotstyle = "ggplot") } #test log-scale par(mfrow=1:2, mar=c(4,4,2,1)) qqcomp(f1, xlogscale = TRUE, ylogscale = TRUE) qqcompcens(f1c, xlogscale = TRUE, ylogscale = TRUE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(f1, xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") qqcompcens(f1c, xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") } # (2) test qqcomp/qqcompcens on a weird example # f2 <- fitdist(x, "unif") f2c <- fitdistcens(dx, "unif") par(mfrow=1:2, mar=c(4,4,2,1)) qqcomp(list(f1, f2, f3)) qqcompcens(list(f1c, f2c, f3c)) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2, f3), plotstyle = "ggplot") qqcompcens(list(f1c, f2c, f3c), plotstyle = "ggplot") } #test log-scale par(mfrow=1:2, mar=c(4,4,2,1)) qqcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE) qqcompcens(list(f1c, f2c, f3c), xlogscale = TRUE, ylogscale = TRUE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") qqcompcens(list(f1c, f2c, f3c), xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") } #test y noise par(mfrow=1:2, mar=c(4,4,2,1)) qqcomp(list(f1, f2, f3)) qqcomp(list(f1, f2, f3), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2, f3), ynoise=FALSE, plotstyle = "ggplot") } par(mfrow=1:2, mar=c(4,4,2,1)) qqcompcens(list(f1c, f2c, f3c)) qqcompcens(list(f1c, f2c, f3c), ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcompcens(list(f1c, f2c, f3c), plotstyle = "ggplot") } #test log-scale y-noise par(mfrow=1:2, mar=c(4,4,2,1)) qqcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE) qqcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcomp(list(f1, f2, f3), xlogscale = TRUE, ylogscale = TRUE, ynoise=FALSE, plotstyle = "ggplot") } par(mfrow=1:2, mar=c(4,4,2,1)) qqcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE) qqcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, ynoise=FALSE) par(mfrow = c(1,1)) if (requireNamespace ("ggplot2", quietly = TRUE)) { qqcompcens(list(f1c, f2c), xlogscale = TRUE, ylogscale = TRUE, plotstyle = "ggplot") } } fitdistrplus/vignettes/0000755000176200001440000000000014124570223015016 5ustar liggesusersfitdistrplus/vignettes/FAQ.Rmd0000644000176200001440000017007314124541154016102 0ustar liggesusers--- title: Frequently Asked Questions author: Marie Laure Delignette Muller, Christophe Dutang date: '`r Sys.Date()`' output: html_vignette: toc: yes number_sections: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Frequently Asked Questions} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r setup, echo=FALSE, message=FALSE, warning=FALSE} require(fitdistrplus) set.seed(1234) options(digits = 3) ``` # Questions regarding distributions ## How do I know the root name of a distribution? The root name of a probability distribution is the `name` which is used the `d`, `p`, `q`, `r` functions. For base R distributions, the root names are given in R-intro : https://cran.r-project.org/doc/manuals/R-intro.html#Probability-distributions. For example, you must use `"pois"` for the Poisson distribution and **not** `"poisson"`. ## How do I find "non standard" distributions? For non-standard distributions, you can either find a package implementing them or define by yourself. A comprehensive list of non-standard distributions is given in the Distributions task view https://CRAN.R-project.org/view=Distributions. Here are some two examples of user-defined distributions. A third example (shifted exponential) is given in FAQ 3.5.4. * The Gumbel distribution ```{r, eval=FALSE} dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) qgumbel <- function(p, a, b) a-b*log(-log(p)) data(groundbeef) fitgumbel <- fitdist(groundbeef$serving, "gumbel", start=list(a=10, b=10)) ``` * The zero-modified geometric distribution ```{r, eval=FALSE} dzmgeom <- function(x, p1, p2) p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) pzmgeom <- function(q, p1, p2) p1 * (q >= 0) + (1-p1)*pgeom(q-1, p2) rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } x2 <- rzmgeom(1000, 1/2, 1/10) fitdist(x2, "zmgeom", start=list(p1=1/2, p2=1/2)) ``` ## How do I set (or find) initial values for non standard distributions? As documented, we provide initial values for the following distributions: `"norm"`, `"lnorm"`, `"exp"`, `"pois"`, `"cauchy"`, `"gamma`", `"logis"`, `"nbinom"`, `"geom"`, `"beta"`, `"weibull"` from the `stats` package; `"invgamma"`, `"llogis"`, `"invweibull"`, `"pareto1"`, `"pareto"`, `"lgamma"`, `"trgamma"`, `"invtrgamma"` from the `actuar` package. Look first at statistics and probability books such as * different volumes of N. L. Johnson, S. Kotz and N. Balakrishnan books, e.g. **Continuous Univariate Distributions, Vol. 1**, * **Thesaurus of univariate discrete probability distributions** by G. Wimmer and G. Altmann. * **Statistical Distributions** by M. Evans, N. Hastings, B. Peacock. * **Distributional Analysis with L-moment Statistics using the R Environment for Statistical Computing** by W. Asquith. If not available, find initial values by equalling theoretical and empirical quartiles. The graphical function `plotdist()` and `plotdistcens()` can also be used to assess the suitability of starting values : by an iterative manual process you can move parameter values so as to obtain a distribution that roughly fits the data and take these parameter values as starting values for the real fit. You may also consider the `prefit()` function to find initial values especially in case where parameters are constrained. ## Is it possible to fit a distribution with at least 3 parameters? Yes, an example with the Burr distribution is detailed in the JSS paper. We reproduce it very quickly here. ```{r, message=FALSE} data("endosulfan") library("actuar") fendo.B <- fitdist(endosulfan$ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) summary(fendo.B) ``` ## Why there are differences between MLE and MME for the lognormal distribution? We recall that the lognormal distribution function is given by $$ F_X(x) = \Phi\left(\frac{\log(x)-\mu}{\sigma} \right), $$ where $\Phi$ denotes the distribution function of the standard normal distribution. We know that $E(X) = \exp\left( \mu+\frac{1}{2} \sigma^2 \right)$ and $Var(X) = \exp\left( 2\mu+\sigma^2\right) (e^{\sigma^2} -1)$. The MME is obtained by inverting the previous formulas, whereas the MLE has the following explicit solution $$ \hat\mu_{MLE} = \frac{1}{n}\sum_{i=1}^n \log(x_i),~~ \hat\sigma^2_{MLE} = \frac{1}{n}\sum_{i=1}^n (\log(x_i) - \hat\mu_{MLE})^2. $$ Let us fit a sample by MLE and MME. The fit looks particularly good in both cases. ```{r, fig.height=3, fig.width=6} x3 <- rlnorm(1000) f1 <- fitdist(x3, "lnorm", method="mle") f2 <- fitdist(x3, "lnorm", method="mme") par(mfrow=1:2) cdfcomp(list(f1, f2), do.points=FALSE, xlogscale = TRUE, main = "CDF plot") denscomp(list(f1, f2), demp=TRUE, main = "Density plot") ``` Let us compare the theoretical moments (mean and variance) given the fitted values ($\hat\mu,\hat\sigma$), that is $$ E(X) = \exp\left( \hat\mu+\frac{1}{2} \hat\sigma^2 \right), Var(X) = \exp\left( 2\hat\mu+\hat\sigma^2\right) (e^{\hat\sigma^2} -1). $$ ```{r} c("E(X) by MME"=as.numeric(exp(f2$estimate["meanlog"]+f2$estimate["sdlog"]^2/2)), "E(X) by MLE"=as.numeric(exp(f1$estimate["meanlog"]+f1$estimate["sdlog"]^2/2)), "empirical"=mean(x3)) c("Var(X) by MME"=as.numeric(exp(2*f2$estimate["meanlog"]+f2$estimate["sdlog"]^2)*(exp(f2$estimate["sdlog"]^2)-1)), "Var(X) by MLE"=as.numeric(exp(2*f1$estimate["meanlog"]+f1$estimate["sdlog"]^2)*(exp(f1$estimate["sdlog"]^2)-1)), "empirical"=var(x3)) ``` From a MLE point of view, a lognormal sample $x_1,\dots,x_n$ is equivalent to handle a normal sample $\log(x_1),\dots,\log(x_n)$. However, it is well know by the Jensen inequality that $E(X) = E(\exp(\log(X))) \geq \exp(E(\log(X)))$ implying the MME estimates provides better moment estimates than with MLE. ## Can I fit a distribution with positive support when data contains negative values? The answer is no: you cannot fit a distribution with positive support (say gamma distribution) when data contains negative values. ```{r} set.seed(1234) x <- rnorm(100, mean = 1, sd = 0.5) (try(fitdist(x, "exp"))) ``` It is irrelevant to do such fit. If you really need to use that distribution, you have two options: either to remove negative values (not recommended) or to shift the data. ```{r} fitdist(x[x >= 0], "exp") fitdist(x - min(x), "exp") ``` ## Can I fit a finite-support distribution when data is outside that support? The answer is no: you cannot fit a distribution with finite-support (say beta distribution) when data is outside $[0,1]$. ```{r} set.seed(1234) x <- rnorm(100, mean = 0.5, sd = 0.25) (try(fitdist(x, "beta"))) ``` It is irrelevant to do such a fit. If you really need to use that distribution, you have two ways to tackle this issue: either to remove impossible values (not recommended) or to shift/scale the data. ```{r} fitdist(x[x > 0 & x < 1], "beta") fitdist((x - min(x)*1.01) / (max(x) * 1.01 - min(x) * 1.01), "beta") ``` ## Can I fit truncated distributions? The answer is yes: but the fitting procedure must be carried out carefully. Let $X$ be the original untruncated random variable. The truncated variable is the conditionnal random variable $Y = X ~\vert~ l< X = low) * (x <= upp) } ptexp <- function(q, rate, low, upp) { PU <- pexp(upp, rate=rate) PL <- pexp(low, rate=rate) (pexp(q, rate)-PL) / (PU-PL) * (q >= low) * (q <= upp) + 1 * (q > upp) } n <- 200 x <- rexp(n); x <- x[x > .5 & x < 3] f1 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x))) f2 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=.5, upp=3)) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, xlim=c(0, 3.5)) ``` ## Can I fit truncated inflated distributions? The answer is yes: but the fitting procedure must be carried out carefully. Let $X$ be the original untruncated random variable. The truncated variable is $Y = \max(\min(X, u), l)$ with $ly>l} + 1_{y>u}$. There is no density (w.r.t. the Lebesgues measure) since there are two probability masses $P(Y=l)= P(X\leq l)>0$ and $P(Y=u)=P(X>u)>0$. However, the density function with respect to the measure $m(x)= \delta_l(x)+\delta_u(x)+\lambda(x)$ is $$ f_Y(y) = \left\{\begin{array}{ll} F_X(l) & \text{if } y=l \\ f_X(y) & \text{if } l\min_i y_i$ or $u<\max_i y_i$ and increasing with respect to $l$ in $]-\infty, \min_i y_i]$ and decreasing with respect to $u$ in $[\max_i y_i,+\infty[$. So the maximum of $L$ is reached at $l=\min_i y_i$ and $u=\max_i y_i$. The MLE of $\theta$ is then obtained by maximizing the log-likelihood $\log(L(l, \theta, u))$ with $u=\max_i Y_i$ and $l=\min_i Y_i$. Let us illustrate truncated distribution with the truncated exponential distribution. The log-likelihood is particularly bad-shaped. ```{r, message=FALSE, fig.height=4, fig.width=8} dtiexp <- function(x, rate, low, upp) { PU <- pexp(upp, rate=rate, lower.tail = FALSE) PL <- pexp(low, rate=rate) dexp(x, rate) * (x >= low) * (x <= upp) + PL * (x == low) + PU * (x == upp) } ptiexp <- function(q, rate, low, upp) pexp(q, rate) * (q >= low) * (q <= upp) + 1 * (q > upp) n <- 100; x <- pmax(pmin(rexp(n), 3), .5) # the loglikelihood has a discontinous point at the solution par(mar=c(4,4,2,1), mfrow=1:2) llcurve(x, "tiexp", plot.arg="low", fix.arg = list(rate=2, upp=5), min.arg=0, max.arg=.5, lseq=200) llcurve(x, "tiexp", plot.arg="upp", fix.arg = list(rate=2, low=0), min.arg=3, max.arg=4, lseq=200) ``` The first method directly maximizes the log-likelihood $L(l, \theta, u)$; the second method maximizes the log-likelihood $L(\theta)$ assuming that $u=\hat u$ and $l=\hat l$ are known. Inside $[0.5,3]$, the CDF are correctly estimated in both methods but the first method does not succeed to estimate the true value of the bounds $l,u$. ```{r, fig.height=4, fig.width=6} (f1 <- fitdist(x, "tiexp", method="mle", start=list(rate=3, low=0, upp=20))) (f2 <- fitdist(x, "tiexp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x)))) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, addlegend=FALSE, xlim=c(0, 3.5)) curve(ptiexp(x, 1, .5, 3), add=TRUE, col="blue", lty=3) legend("bottomright", lty=1:3, col=c("red", "green", "blue", "black"), leg=c("full MLE", "MLE fixed arg", "true CDF", "emp. CDF")) ``` ## Can I fit a uniform distribution? The uniform distribution $\mathcal U(a,b)$ has only support parameters since the density does not have a scale or a shape parameter $f_U(u) = \frac{1}{b-a}1_{[a,b]}(u)$. For this distribution, we should not maximize the log-likelihood but only the likelihood. Let $(x_i)_i$ be i.i.d. observations from $\mathcal U(a,b)$ distribution. The likelihood is $$ L(a,b) = \prod_{i=1}^n \frac{1}{b-a} 1_{[a,b]}(x_i) = 1_{a\leq x_i \leq b, i=1,\dots,n} \frac{1}{b-a}^n = 1_{a\leq \min_i x_i} 1_{\max_i x_i \leq b} \frac{1}{b-a}^n $$ Hence $a\mapsto L(a,b)$ for any fixed $b\in]\max_i x_i, +\infty[$ is increasing on $]-\infty, \min_i x_i]$, similarly $b\mapsto L(a,b)$ is decreasing for any fixed $a$. This leads to $\min_i x_i$ and $\max_i x_i$ to be the MLE of the uniform distribution. We should notice that the likelihood function $L$ is defined on $\mathbb R^2$ yet it cancels outside $S=]-\infty, \min_i x_i]\times]\max_i x_i, +\infty[$. Hence, the log-likelihood is undefined outside $S$, which is an issue when maximizing the log-likelihood. For these reasons, `fitdist(data, dist="unif", method="mle")` uses the explicit form of the MLE for this distribution. Here is an example below ```{r, fig.height=4, fig.width=6} trueval <- c("min"=3, "max"=5) x <- runif(n=500, trueval[1], trueval[2]) f1 <- fitdist(x, "unif") delta <- .01 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(min(x)-2*delta, max(x)-delta), max.arg=c(min(x)+delta, max(x)+2*delta), main="likelihood surface for uniform", loglik=FALSE) abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) delta <- .2 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(3-2*delta, 5-delta), max.arg=c(3+delta, 5+2*delta), main="log-likelihood surface for uniform") abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) ``` Maximizing the log-likelihood is harder and can be done by defining a new density function. Appropriate starting values and parameters bound must be supplied. Using the closed-form expression (as in `fitdist()`) or maximizing the log-likelihood (with `unif2`) lead to very similar results. ```{r} dunif2 <- function(x, min, max) dunif(x, min, max) punif2 <- function(q, min, max) punif(q, min, max) f2 <- fitdist(x, "unif2", start=list(min=0, max=10), lower=c(-Inf, max(x)), upper=c(min(x), Inf)) print(c(logLik(f1), logLik(f2)), digits=7) print(cbind(coef(f1), coef(f2)), digits=7) ``` ## Can I fit a beta distribution with the same shape parameter? Yes, you can wrap the density function of the beta distribution so that there is a only one shape parameter. Here is an example of a concave density. ```{r} x <- rbeta(1000, 3, 3) dbeta2 <- function(x, shape, ...) dbeta(x, shape, shape, ...) pbeta2 <- function(q, shape, ...) pbeta(q, shape, shape, ...) fitdist(x, "beta2", start=list(shape=1/2)) ``` Another example with a U-shaped density. ```{r} x <- rbeta(1000, .3, .3) fitdist(x, "beta2", start=list(shape=1/2), optim.method="L-BFGS-B", lower=1e-2) ``` ## How to estimate support parameter? the case of the four-parameter beta Let us consider the four-parameter beta distribution, also known as the PERT distribution, defined by the following density for $x\in [a,c]$ $f_X(x) = (x-a)^{\alpha-1} (c-x)^{\beta-1}/C_N$ with $C_N$ a normalizing constant and $\alpha=1+d(b-a)/(c-a)$, $\beta=1+d(c-b)/(c-a)$. $a,c$ are support parameters, $b\in]a,c[$ is the mode and $d$ the shape parameter. As for uniform distribution, one can show that the MLE of $a$ and $c$ are respectively the sample minimum and maximum. The code below illustrates the strategy using partial closed formula with `fix.arg` and the full numerical search of MLE. NB: on small sample size, the latter has generally better goodness-of-fit statistics; a small positive number is added or subtracted when fixing the support parameters $a$ and $c$ to sample minimum and maximum. ```{r, message=FALSE, fig.height=4, fig.width=6} require(mc2d) x2 <- rpert(n=2e2, min=0, mode=1, max=2, shape=3/4) eps <- sqrt(.Machine$double.eps) f1 <- fitdist(x2, "pert", start=list(min=-1, mode=0, max=10, shape=1), lower=c(-Inf, -Inf, -Inf, 0), upper=c(Inf, Inf, Inf, Inf)) f2 <- fitdist(x2, "pert", start=list(mode=1, shape=1), fix.arg=list(min=min(x2)-eps, max=max(x2)+eps), lower=c(min(x2), 0), upper=c(max(x2), Inf)) gofstat(list(f1,f2)) cdfcomp(list(f1,f2)) print(cbind(coef(f1), c(f2$fix.arg["min"], coef(f2)["mode"], f2$fix.arg["max"], coef(f2)["shape"])), digits=7) ``` # Questions regarding goodness-of-fit tests and statistics ## Where can we find the results of goodness-of-fit tests ? Results of goodness-of-fit tests are not printed but are given in the object returned by `gofstat()` and you can have access to them as described in the example below. Nevertheless, p-values are not given for every test. For Anderson-Darling (ad), Cramer von Mises (cvm) and Kolomogorov (ks), only the decision (rejection of H0 or not) is given, when available (see FAQ 2.3 for more details). ```{r, fig.height=3, fig.width=6} set.seed(1234) x <- rgamma(n = 100, shape = 2, scale = 1) # fit of the good distribution fgamma <- fitdist(x, "gamma") # fit of a bad distribution fexp <- fitdist(x, "exp") g <- gofstat(list(fgamma, fexp), fitnames = c("gamma", "exp")) denscomp(list(fgamma, fexp), legendtext = c("gamma", "exp")) # results of the tests ## chi square test (with corresponding table with theoretical and observed counts) g$chisqpvalue g$chisqtable ## Anderson-Darling test g$adtest ## Cramer von Mises test g$cvmtest ## Kolmogorov-Smirnov test g$kstest ``` ## Is it reasonable to use goodness-of-fit tests to validate the fit of a distribution ? In the first versions of fitdistrplus, when they were available, the results of the GOF tests (AD, KS, CvM) were automatically printed. We decided to suppress this automatic printing when we realized that some users had some difficulties to interpret the results of those tests and sometimes misused them. Goodness-of-fit tests often appear as objective tools to decide wether a fitted distribution well describes a data set. **But they are not !** It would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it (see FAQ 2.2.1). And it would not be reasonable at all any more to validate a distribution because goodness-of-fit tests do not reject it (see FAQ 2.2.2). A fitted distribution should be evaluated using graphical methods (goodness-of-fit graphs automatically provided in our package by plotting the result of the fit (output of `fitdist()` or `fitdistcens()` and the complementary graphs that help to compare different fits - see `?graphcomp`). We really think it is the most appropriate way to evaluate the adequacy of a fit and we are not the only ones to recommend it. You can find the same type of recommendations in reference books : * **Probabilistic techniques in exposure assessment - a handbook dealing with variability and uncertainty in models and inputs** by A.C. Cullen and H.C. Frey. * **Application of uncertainty analysis to ecological risks of pesticides** by W.J. Warren-Hicks and A. Hart. * **Statistical inference** by G. Casella and R.L. Berger * **Loss models: from data to decision** by S.A. Klugman and H.H. Panjer and G.E. Willmot Moreover, the selection of a distribution should also be driven by knowledge of underlying processes when available. For example when a variable cannot be negative, one would be very cautious while fitting a normal distribution, that potentially gives negative values, even if the observed data of this variable seem well fitted by a normal distribution. ### Should I reject a distribution because a goodness-of-fit test rejects it ? No it would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it, especially in the case of big samples. In the real life, as soon as you have a sufficient amount of data, you will reject the fitted distribution. We know that a model cannot perfectly describe real data, and generally the true question is to find the better distribution among a pool of simple parametric distributions to describe the data, so to compare different models (see FAQ 2.4 and 2.5 for corresponding questions). To illustre this point let us comment the example presented below. We drew two samples from the same Poisson distribution with a mean parameter equal to 100. In many applications, for this value of its parameter, the Poisson distribution would be considered to be well approximated by a normal distribution. Testing the fit (here using a Kolmogorov-Smirnov test ) of the normal distribution on a sample of 100 observations would not reject the normal fit, while testing it on a sample of 10000 observations would reject it, while both samples come from the same distribution. ```{r, fig.height=3, fig.width=6} set.seed(1234) x1 <- rpois(n = 100, lambda = 100) f1 <- fitdist(x1, "norm") g1 <- gofstat(f1) g1$kstest x2 <- rpois(n = 10000, lambda = 100) f2 <- fitdist(x2, "norm") g2 <- gofstat(f2) g2$kstest par(mfrow=1:2) denscomp(f1, demp = TRUE, addlegend = FALSE, main = "small sample") denscomp(f2, demp = TRUE, addlegend = FALSE, main = "big sample") ``` ### Should I accept a distribution because goodness-of-fit tests do not reject it ? No, it would not be reasonable at all to validate a distribution because goodness-of-fit tests do not reject it. Like all the other hypothesis tests, goodness-of-fit tests lack of statistical power when the sample size is not so high. And the different goodness-of-fit tests are not equally sensitive to different types of deviation between empirical and fitted distributions. For example the Kolmogorov-Smirnov test is sensitive when distributions differ in a global fashion near the centre of the distribution. The Anderson-Darling test will be more sensitive when distributions differ in their tails, and the Cramer von Mises will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions. The sensitivity of a chi square test will depend on the definition of classes, and even if we propose a default definition of classes when the user does not provide classes, this choice is not obvious and could impact the results of the test. This test is more appropriate when data are discrete, even if they are modelled by a continuous distribution, as in the following example. Two samples of respective sizes 500 and 50 are drawn from a Poisson distribution of mean parameter equal to 1 (not a sufficiently high value to consider that the Poisson distribution could be approximated by a normal one). Using a Kolmogorov-Smirnov test, for the small sample the normal fit is rejected only for the bigger sample. It is not rejected with the smaller sample even if the fit could be rejected after a simple visual confrontation of the distributions. In that particular case, the chi square test with classes defined by default would have rejected te normal fit for both samples. ```{r, fig.height=3, fig.width=6} set.seed(1234) x3 <- rpois(n = 500, lambda = 1) f3 <- fitdist(x3, "norm") g3 <- gofstat(f3) g3$kstest x4 <- rpois(n = 50, lambda = 1) f4 <- fitdist(x4, "norm") g4 <- gofstat(f4) g4$kstest par(mfrow=1:2) denscomp(f3, addlegend = FALSE, main = "big sample") denscomp(f4, addlegend = FALSE, main = "small sample") ``` ```{r} g3$chisqtable g3$chisqpvalue g4$chisqtable g4$chisqpvalue ``` ## Why all goodness-of-fit tests are not available for every distribution ? The Chi-squared test is available for any distribution but one must be conscious that its result depends on the definition of cells in which observed data are grouped, and a correct definition is not possible with a too small sample. Concerning the Kolmogorov-Smirnov test, it is proposed for any continuous distribution, but with a critical value corresponding to the comparison of the empirical distribution to a fully specified distribution. As the distribution is not fully known for a fitted distribution, the result of this test is subject to caution, but there is no general asymptotic theory for the Kolmogorov-Smirnov statistics in case of a fitted distribution. Nevertheless, one can use Monte Carlo methods to conduct Kolmgorov-Smirnov goodness-of-fit tests in cases when the sample is used to estimate model parameters. Such a method is implemented in the R package `KScorrect` for a variety of continuous distributions. Such an asymptotic theory was proposed for quadratic statistics for some distributions (Anderson-Darling, Cramer von Mises). The reference book we used on this subject (**Tests based on edf statistics** by Stephens MA in **Goodness-of-fit techniques** by D'Agostino RB and Stephens MA) proposes critical values of those statistics for a some classical distributions (exponential, gamma, Weibull, logistic, Cauchy, normal and lognormal). But the asymptotic theory about these statistics also depends on the way the parameters are estimated. And as they were not estimated by maximum likelihood for Cauchy, normal and lognormal distributions in the results reported by Stephens, we only propose the results of the Anderson-Darling and Cramer von Mises using those results for exponential, gamma, Weibull, logistic distributions. The user can refer to the cited books and use the proposed formula to estimate the parameters of Cauchy, normal and lognormal distributions and apply the tests using critical values given in the book. R packages `goftest` and `ADGofTest` could also be explored by users who would like to apply Anderson-Darling and Cramer von Mises tests on other distributions. But at this time we are not sure that the case where parameters are unknown (estimated by maximum likelihood) is tackled in those two packages. Concerning the development of our package, rather than develoing further more goodness-of-fit tests we made the choice to develop graphical tools to help to appreciate the quality of a fit and to compare the fits of different distributions on a same data set (see FAQ 2.2 for argumentation). ## How can we use goodness-of-fit statistics to compare the fit of different distributions on a same data set ? Goodness-of-fit statistics based on the empirical distribution function (Kolmogorov-Smirnov, Anderson-Darling and Cramer von Mises) may be used to measure a distance between the fitted distribution and the empirical distribution. So if one wants to compare the fit of various distributions on the same data set, the smaller are those statistics the better. The Kolmogorov-Smirnov statistics will be sensitive when distributions differ in a global fashion near the centre of the distribution while the Anderson-Darling statistics will be more sensitive when distributions differ in their tails, and the Cramer von Mises statistics will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions. But as mentioned in the main vignette of our package, the use of the Anderson-Darling to compare the fit of different distributions is subject to caution due to the the weighting of the quadratic distance between fitted and empirical distribution functions that depends on the parametric distribution. Moreover, statistics based on the empirical distribution function do not penalize distributions with a greater number of parameters and as those are generally more flexible, this could induce over-fitting. Goodness-fo-fit statistics based on information criteria (AIC, BIC) correspond to deviance penalized by the complexity of the model (the number of parameters of the distribution), and so the smaller the better. As more generic statistics, they are not adapted to focus on a part of the fitted distribution, but they take into account the complexity of the distribution and thus could help to prevent overfitting. ## Can we use a test to compare the fit of two distributions on a same data set ? In our package we did not implement such a test but for **two nested distributions** (when one is a special case of the other one, e.g. exponential and gamma distributions) a likelihood ratio test can be easily implemented using the loglikelihood provided by `fitdist` or `fitdistcens`. Denoting $L$ the maximum likelihood obtained with the complete distribution and $L_0$ the one obtained with the simplified distribution, when the sample size increases, $- 2 ln(\frac{L_0}{L}) = 2 ln(L) - 2 ln(L_0)$ tends to a Chi squared distribution degrees of freedom equal to the difference on the numbers of parameters characterizing the **two nested distributions**. You will find below an example of such a test. ```{r} set.seed(1234) g <- rgamma(100, shape = 2, rate = 1) (f <- fitdist(g, "gamma")) (f0 <- fitdist(g, "exp")) L <- logLik(f) k <- length(f$estimate) # number of parameters of the complete distribution L0 <- logLik(f0) k0 <- length(f0$estimate) # number of parameters of the simplified distribution (stat <- 2*L - 2*L0) (critical_value <- qchisq(0.95, df = k - k0)) (rejected <- stat > critical_value) ``` Such a test can also be used for fits on censored data. ## Can we get goodness-of-fit statistics for a fit on censored data ? Function `gofstat` is not yet proposed in our package for fits on censored data but to develop one is among one of our objectives in the future. Published works on goodness-of-fit statistics based on the empirical distribution function for censored data generally focused on data containing only one type of censoring (e.g. right censored data in survival data). Build such statistics in the general case, with data containing in the same time (right, left and interval censoring), remains tricky. Nevertheless, it is possible for any type of censored data, to use information criteria (AIC and BIC given in the summary of an object of class `fitdistcens`) to compare the fits of various distributions to a same data set. # Questions regarding optimization procedures ## How to choose optimization method? If you want to perform optimization without bounds, `optim()` is used. You can try the derivative-free method Nelder-Mead and the Hessian-free method BFGS. If you want to perform optimization with bounds, only two methods are available without providing the gradient of the objective function: Nelder-Mead via `constrOptim()` and bounded BFGS via `optim()`. In both cases, see the help of `mledist()` and the vignette on optimization algorithms. ## The optimization algorithm stops with error code 100. What shall I do? First, add traces by adding `control=list(trace=1, REPORT=1)`. Second, try to set bounds for parameters. Third, find better starting values (see FAQ 1.3). ## Why distribution with a `log` argument may converge better? Say, we study the shifted lognormal distribution defined by the following density $$ f(x) = \frac{1}{x \sigma \sqrt{2 \pi}} \exp\left(- \frac{(\ln (x+\delta)- \mu)^2}{2\sigma^2}\right) $$ for $x>-\delta$ where $\mu$ is a location parameter, $\sigma$ a scale parameter and $\delta$ a boundary parameter. Let us fit this distribution on the dataset `y` by MLE. We define two functions for the densities with and without a `log` argument. ```{r} dshiftlnorm <- function(x, mean, sigma, shift, log = FALSE) dlnorm(x+shift, mean, sigma, log=log) pshiftlnorm <- function(q, mean, sigma, shift, log.p = FALSE) plnorm(q+shift, mean, sigma, log.p=log.p) qshiftlnorm <- function(p, mean, sigma, shift, log.p = FALSE) qlnorm(p, mean, sigma, log.p=log.p)-shift dshiftlnorm_no <- function(x, mean, sigma, shift) dshiftlnorm(x, mean, sigma, shift) pshiftlnorm_no <- function(q, mean, sigma, shift) pshiftlnorm(q, mean, sigma, shift) ``` We now optimize the minus log-likelihood. ```{r} data(dataFAQlog1) y <- dataFAQlog1 D <- 1-min(y) f0 <- fitdist(y+D, "lnorm") start <- list(mean=as.numeric(f0$estimate["meanlog"]), sigma=as.numeric(f0$estimate["sdlog"]), shift=D) # works with BFGS, but not Nelder-Mead f <- fitdist(y, "shiftlnorm", start=start, optim.method="BFGS") summary(f) ``` If we don't use the `log` argument, the algorithms stalls. ```{r, error=FALSE} f2 <- try(fitdist(y, "shiftlnorm_no", start=start, optim.method="BFGS")) print(attr(f2, "condition")) ``` Indeed the algorithm stops because at the following value, the log-likelihood is infinite. ```{r} sum(log(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) log(prod(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) sum(dshiftlnorm(y, 0.16383978, 0.01679231, 1.17586600, TRUE )) ``` There is something wrong in the computation. Only the R-base implementation using `log` argument seems reliable. This happens the C-base implementation of `dlnorm` takes care of the log value. In the file `../src/nmath/dlnorm.c` in the R sources, we find the C code for `dlnorm` ```{r, eval=FALSE, echo=TRUE} double dlnorm(double x, double meanlog, double sdlog, int give_log) { double y; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(meanlog) || ISNAN(sdlog)) return x + meanlog + sdlog; #endif if(sdlog <= 0) { if(sdlog < 0) ML_ERR_return_NAN; // sdlog == 0 : return (log(x) == meanlog) ? ML_POSINF : R_D__0; } if(x <= 0) return R_D__0; y = (log(x) - meanlog) / sdlog; return (give_log ? -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) : M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)); /* M_1_SQRT_2PI = 1 / sqrt(2 * pi) */ } ``` In the last four lines with the logical condtion `give_log?`, we see how the `log` argument is handled: * when log=TRUE, we use $-(\log(\sqrt{2\pi}) + y^2/2+\log(x\sigma))$ ```{r, eval=FALSE, echo=TRUE} -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) ``` * when log=FALSE, we use $\sqrt{2\pi} *\exp( y^2/2)/(x\sigma))$ (and then the logarithm outside `dlnorm`) ```{r, eval=FALSE, echo=TRUE} M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)) ``` Note that the constant $\log(\sqrt{2\pi})$ is pre-computed in the C macro `M_LN_SQRT_2PI`. In order to sort out this problem, we use the `constrOptim` wrapping `optim` to take into account linear constraints. This allows also to use other optimization methods than L-BFGS-B (low-memory BFGS bounded) used in optim. ```{r} f2 <- fitdist(y, "shiftlnorm", start=start, lower=c(-Inf, 0, -min(y)), optim.method="Nelder-Mead") summary(f2) print(cbind(BFGS=f$estimate, NelderMead=f2$estimate)) ``` Another possible would be to perform all computations with higher precision arithmetics as implemented in the package `Rmpfr` using the MPFR library. ## What to do when there is a scaling issue? Let us consider a dataset which has particular small values. ```{r} data(dataFAQscale1) head(dataFAQscale1) summary(dataFAQscale1) ``` The only way to sort out is to multiply the dataset by a large value. ```{r} for(i in 6:0) cat(10^i, try(mledist(dataFAQscale1*10^i, "cauchy")$estimate), "\n") ``` Let us consider a dataset which has particular large values. ```{r} data(dataFAQscale2) head(dataFAQscale2) summary(dataFAQscale2) ``` The only way to sort out is to multiply the dataset by a small value. ```{r} for(i in 0:5) cat(10^(-2*i), try(mledist(dataFAQscale2*10^(-2*i), "cauchy")$estimate), "\n") ``` ## How do I set bounds on parameters when optimizing? ### Setting bounds for scale parameters Consider the normal distribution $\mathcal{N}(\mu, \sigma^2)$ defined by the density $$ f(x) = \frac{1}{\sqrt{2\pi\sigma^2}}\exp\left(-\frac{(x-\mu)^2}{2\sigma^2}\right), x\in\mathbb{R}, $$ where $\mu$ is a location parameter such that $\mu\in\mathbb{R}$, $\sigma^2$ is a scale parameter such that $\sigma^2>0$. Therefore when optimizing the log-likelihood or the squared differences or the GoF statistics. Setting a lower bound for the scale parameter is easy with `fitdist`: just use the `lower` argument. ```{r scalenormal, echo=TRUE, warning=FALSE} set.seed(1234) x <- rnorm(1000, 1, 2) fitdist(x, "norm", lower=c(-Inf, 0)) ``` ### Setting bounds for shape parameters Consider the Burr distribution $\mathcal B(\mu, \sigma^2)$ defined by the density $$ f(x) = \frac{a b (x/s)^b}{x [1 + (x/s)^b]^{a + 1}}, x\in\mathbb{R}, $$ where $a,b$ are shape parameters such that $a,b>0$, $s$ is a scale parameter such that $s>0$. ```{r shapeburr, echo=TRUE, warning=FALSE} x <- rburr(1000, 1, 2, 3) fitdist(x, "burr", lower=c(0, 0, 0), start=list(shape1 = 1, shape2 = 1, rate = 1)) ``` ### Setting bounds for probability parameters Consider the geometric distribution $\mathcal G(p)$ defined by the mass probability function $$ f(x) = p(1-p)^x, x\in\mathbb{N}, $$ where $p$ is a probability parameter such that $p\in[0,1]$. ```{r probgeom, echo=TRUE, warning=FALSE} x <- rgeom(1000, 1/4) fitdist(x, "geom", lower=0, upper=1) ``` ### Setting bounds for boundary parameters Consider the shifted exponential distribution $\mathcal E(\mu,\lambda)$ defined by the mass probability function $$ f(x) = \lambda \exp(-\lambda(x-\mu)), x>\mu, $$ where $\lambda$ is a scale parameter such that $\lambda>0$, $\mu$ is a boundary (or shift) parameter such that $\mu\in\mathbb{R}$. When optimizing the log-likelihood, the boundary constraint is $$ \forall i=1,\dots,n, x_i>\mu \Rightarrow \min_{i=1,\dots,n} x_i > \mu \Leftrightarrow \mu > -\min_{i=1,\dots,n} x_i. $$ Note that when optimizing the squared differences or the GoF statistics, this constraint may not be necessary. Let us do it in R. ```{r shiftexp, echo=TRUE, warning=FALSE} dsexp <- function(x, rate, shift) dexp(x-shift, rate=rate) psexp <- function(x, rate, shift) pexp(x-shift, rate=rate) rsexp <- function(n, rate, shift) rexp(n, rate=rate)+shift x <- rsexp(1000, 1/4, 1) fitdist(x, "sexp", start=list(rate=1, shift=0), lower= c(0, -min(x))) ``` ### Setting linear inequality bounds For some distributions, bounds between parameters are not independent. For instance, the normal inverse Gaussian distribution ($\mu, \delta, \alpha, \beta$ parametrization) has the following parameter constraints, which can be reformulated as a linear inequality: $$ \left\{ \begin{array}{l}\alpha > 0\\ \delta >0\\ \alpha > |\beta|\end{array} \right. \Leftrightarrow \underbrace{ \left( \begin{matrix} 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 1 & -1 \\ 0 & 0 & 1 & 1 \\ \end{matrix} \right) }_{ui} \left( \begin{matrix} \mu\\ \delta\\ \alpha \\ \beta \\ \end{matrix} \right) \geq \underbrace{ \left( \begin{matrix} 0\\ 0\\ 0 \\ 0 \\ \end{matrix} \right)}_{ci}. $$ These constraints can be carried out via `constrOptim()` and the arguments `ci` and `ui`. Here is an example ```{r, message=FALSE} library(GeneralizedHyperbolic) myoptim <- function(fn, par, ui, ci, ...) { res <- constrOptim(f=fn, theta=par, method="Nelder-Mead", ui=ui, ci=ci, ...) c(res, convergence=res$convergence, value=res$objective, par=res$minimum, hessian=res$hessian) } x <- rnig(1000, 3, 1/2, 1/2, 1/4) ui <- rbind(c(0,1,0,0), c(0,0,1,0), c(0,0,1,-1), c(0,0,1,1)) ci <- c(0,0,0,0) fitdist(x, "nig", custom.optim=myoptim, ui=ui, ci=ci, start=list(mu = 0, delta = 1, alpha = 1, beta = 0)) ``` ## How works quantile matching estimation for discrete distributions? Let us consider the geometric distribution with values in $\{0,1,2,3,\dots\}$. The probability mass function, the cumulative distribution function and the quantile function are $$ P(X=x)= p (1-p)^{\lfloor x\rfloor}, F_X(x) = 1- (1-p)^{\lfloor x\rfloor}, F_X^{-1}(q) = \left\lfloor\frac{\log(1-q)}{\log(1-p)}\right\rfloor. $$ Due to the integer part (floor function), both the distribution function and the quantile function are step functions. ```{r, fig.height=3, fig.width=6} pgeom(0:3, prob=1/2) qgeom(c(0.3, 0.6, 0.9), prob=1/2) par(mar=c(4,4,2,1), mfrow=1:2) curve(pgeom(x, prob=1/2), 0, 10, n=301, main="c.d.f.") curve(qgeom(x, prob=1/2), 0, 1, n=301, main="q.f.") ``` Now we study the QME for the geometric distribution. Since we have only one parameter, we choose one probabiliy, $p=1/2$. The theoretical median is the following integer $$ F_X^{-1}(1/2) = \left\lfloor\frac{\log(1/2)}{\log(1-p)}\right\rfloor. $$ Note that the theoretical median for a discrete distribution is an integer. Empirically, the median may not be an integer. Indeed for an even length dataset, the empirical median is $$ q_{n,1/2} = \frac{x_{n/2}^\star + x_{n/2+1}^\star}{2}, $$ where $x_{1}^\star<\dots ## Is it possible to add the names of the observations in a goodness-of-fit plot, e.g. the names of the species in the plot of the Species Sensitivity Distribution (SSD) classically used in ecotoxicology ? An argument named `name.points` can be used in functions `cdfcomp` or `CIcdfcomp` to pass a label vector for observed points so as to add the names of the points on the left of each point. This option is available only for ECDF goodness-of-fit plots and only for non censored data. This option can be used as below, for example, to name the species in the classical plot of the Species Sensitivity Distributions (SSD) in ecotoxicology. ```{r, fig.height= 6, fig.width= 6, warning = FALSE} data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa f <- fitdist(ATV, "lnorm") cdfcomp(f, xlogscale = TRUE, main = "Species Sensitivty Distribution", xlim = c(1, 100000), name.points = taxaATV, addlegend = FALSE, plotstyle = "ggplot") ``` # Questions regarding (left, right and/or interval) censored data ## How to code censored data in `fitdistrplus` ? Censored data must be rpresented in the package by a dataframe of two columns respectively named left and right, describing each observed value as an interval. The left column contains either `NA` for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either `NA` for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. This type of representation corresponds to the coding names `"interval2"` in function `Surv` of the package `survival`. There is no other way to represent censored data in `fitdistrplus` but the function Surv2fitdistcens() can be used to help you to format data for use in fitdistcens() from one of the format used in the survival package (see the help page of Surv2fitdistcens()). You have a toy example below. ```{r} dtoy <- data.frame(left = c(NA, 2, 4, 6, 9.7, 10), right = c(1, 3, 7, 8, 9.7, NA)) dtoy ``` ## How do I prepare the input of `fitdistcens()` with `Surv2fitdistcens()`? Let us consider a classical right-censored dataset for human life: twenty values randomly chosen from the `canlifins` dataset of `CASdatasets` package. We refer to the help of `Surv2fitdistcens()` for other censoring types. ```{r} exitage <- c(81.1,78.9,72.6,67.9,60.1,78.3,83.4,66.9,74.8,80.5,75.6,67.1, 75.3,82.8,70.1,85.4,74,70,71.6,76.5) death <- c(0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0) ``` When performing survival analysis, it is very common to use `Surv()` function from package `survival` to handle different types of censoring. In order to ease the use of `fitdistcens()`, a dedicated function `Surv2fitdistcens()` has been implemented with arguments similar to the ones of `Surv()`. ```{r} svdata <- Surv2fitdistcens(exitage, event=death) ``` Let us now fit two simple distributions. ```{r, fig.height= 4, fig.width= 6} flnormc <- fitdistcens(svdata, "lnorm") fweic <- fitdistcens(svdata, "weibull") cdfcompcens(list(fweic, flnormc), xlim=range(exitage), xlegend = "topleft") ``` ## How to represent an empirical distribution from censored data ? The representation of an empirical distribution from censored data is not a trivial problem. One can simply represent each observation as an interval at an y-value defined by the rank of the observation as done below using function `plotdistcens`. This representation can be interesting to visualize the raw data, but it remains difficult to correctly order the observations in any case (see the example below on the right using data `smokedfish`). ```{r, fig.height= 4, fig.width= 8} par(mfrow = c(1,2), mar = c(3, 4, 3, 0.5)) plotdistcens(dtoy, NPMLE = FALSE) data(smokedfish) dsmo <- log10(smokedfish) plotdistcens(dsmo, NPMLE = FALSE) ``` Many authors worked on the development of algorithms for **non parametric maximum likelihood estimation (NPMLE)** of the **empirical cumulative distribution function (ECDF)** from interval censored data (including left and right censored data that can be considered as interval censored data with one bound at infinity). In old versions of `fitdistrplus` we used the Turnbull algorithm using calls to functions of the package `survival`. Even if this Turnbull algorithm is still available in the package, the default plot now uses the function `npsurv` of the package `npsurv`. This package provides more performant algorithms developped by Yong Wang (see references cited in the help page of `plotdistcens`). Due to lack of maintenance of this package we were forced to rewrite their main functions in our package, using another optimization function. The same ECDF plot was also implemented in our using the Turnbull algorithm of survival (see below). ```{r, fig.height= 6, fig.width= 6} par(mfrow = c(2, 2), mar = c(3, 4, 3, 0.5)) # Turnbull algorithm with representation of middle points of equivalence classes plotdistcens(dsmo, NPMLE.method = "Turnbull.middlepoints", xlim = c(-1.8, 2.4)) # Turnbull algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Turnbull.intervals") # Wang algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Wang") ``` As you can see in the above example, the new implementation of NPMLE provides a different type of plot for the ECDF, representing by filled rectangles the zones of non-uniqueness of the NPMLE ECDF. Indeed an NPMLE algorithm generally proceeds in two steps. 1. The first step aims at identifying **equivalence classes** (also named in the litterture **Turnbull intervals** or **maximal intersection intervals** or **innermost intervals** or **maximal cliques** of the data). Equivalences classess are points/intervals under which the NPMLE ECDF may change. Equivalence classes have been shown to correspond to regions between a left bound of an interval (named L in the following plot on a the previous toy example) immediately followed by a right bound of an interval (named R in the following plot). An equivalence class may be of null length (for example at each non censored value). 2. The second step aims at assigning a **probability mass** to each equivalence class, which may be zero on some classes. The NPMLE is unique only up to these equivalence classes and this **non uniqueness** of the NPMLE ECDF is represented by **filled rectangles**. Various NPMLE algorithms are implemented in the packages **Icens**, **interval** and **npsurv**. They are more or less performant and all of them do not enable the handling of other data than survival data, especially with left censored observations. ```{r, echo = FALSE, fig.height= 4, fig.width= 8} d <- data.frame(left = c(NA, 2, 4, 6, 9.5, 10), right = c(1, 3, 7, 8, 9.5, NA)) addbounds <- function(d) { xbounds <- c(d$left, d$right) xboundsnotNA <- xbounds[!is.na(xbounds)] abline(v = xboundsnotNA, col = "grey") } addLR <- function(d) { Lbounds <- d$left[!is.na(d$left)] Rbounds <- d$right[!is.na(d$right)] range <- range(c(Lbounds,Rbounds)) eps <- (range[2] - range[1]) * 0.01 text(x = Lbounds-eps, y = 0.05, labels = "L", col = "red", cex = 0.75) text(x = Rbounds+eps, y = 0.05, labels = "R", col = "red", cex = 0.75) } addeq <- function(deq) { left <- deq$left left[is.na(left)] <- -100 right <- deq$right right[is.na(right)] <- 100 rect(left, -2, right, 2, density = 10) } par(mfrow = c(2,1), mar = c(2, 4, 3, 0.5)) # First step plotdistcens(d, NPMLE = FALSE, lwd = 2, col = "blue", main = "Step 1 : identification of equivalence classes") addbounds(d) addLR(d) deq <- data.frame(left = c(NA, 2, 6, 9.5, 10), right = c(1, 3, 7,9.5, NA)) addeq(deq) # Second step plotdistcens(d, lwd = 2, main = "Step 2 : estimation of mass probabilities") ``` ## How to assess the goodness-of-fit of a distribution fitted on censored data ? The only available method in `fitdistrplus` to fit distributions on censored data is the maximum likelihood estimation (MLE). Once a distribution is fitted using `fitdistcens`, AIC and BIC values can be found in the `summary` of the object of class `fitdistcens` returned by the function. Those values can be used to compare the fit of various distributions on a same dataset. Function `gofstat` is not yet proposed in our package for fits on censored data but we plan to develop it in the future with the calculation of other goodness-of-fit statistics for censored data. ```{r} fnorm <- fitdistcens(dsmo,"norm") flogis <- fitdistcens(dsmo,"logis") # comparison of AIC values summary(fnorm)$aic summary(flogis)$aic ``` Considering goodness-of-fit plots, the generic `plot` function of an object of class `fitdistcens`provides three plots, one in CDF using the NPMLE ECDF plot (by default using the Wang prepresentation, see previous part for details), a Q-Q plot and a P-P plot simply derived from the Wang plot of the ECDF, with filled rectangles indicating non uniqueness of the NPMLE ECDF. ```{r, fig.height= 6, fig.width= 6} par(mar = c(2, 4, 3, 0.5)) plot(fnorm) ``` Functions `cdfcompcens()`, `qqcompens()` and `ppcompcens()` can be used to individualize and personnalize CDF, Q-Q and P-P goodness-of-fit plots and/or to compare the fit of various distributions on a same dataset. ```{r, fig.height= 4, fig.width= 4} cdfcompcens(list(fnorm, flogis), fitlty = 1) qqcompcens(list(fnorm, flogis)) ppcompcens(list(fnorm, flogis)) ``` Considering Q-Q plots and P-P plots, it may be easier to compare various fits by splitting the plots as below which is done automatically using the `plotstyle` `ggplot` in `qqcompens()` and `ppcompcens()` but can also be done manually with the `plotstyle` `graphics`. ```{r, fig.height= 4, fig.width= 8} qqcompcens(list(fnorm, flogis), lwd = 2, plotstyle = "ggplot", fitcol = c("red", "green"), fillrect = c("pink", "lightgreen"), legendtext = c("normal distribution", "logistic distribution")) ``` fitdistrplus/vignettes/Optimalgo.Rmd0000644000176200001440000004315113762162350017426 0ustar liggesusers--- title: Which optimization algorithm to choose? author: Marie Laure Delignette Muller, Christophe Dutang date: '`r Sys.Date()`' output: html_vignette: toc: true number_sections: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Which optimization algorithm to choose?} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r setup, echo=FALSE, message=FALSE, warning=FALSE} require(fitdistrplus) require(knitr) #for kable() function set.seed(12345) options(digits = 3) ``` # Quick overview of main optimization methods We present very quickly the main optimization methods. Please refer to **Numerical Optimization (Nocedal \& Wright, 2006)** or **Numerical Optimization: theoretical and practical aspects (Bonnans, Gilbert, Lemarechal \& Sagastizabal, 2006)** for a good introduction. We consider the following problem $\min_x f(x)$ for $x\in\mathbb{R}^n$. ## Derivative-free optimization methods The Nelder-Mead method is one of the most well known derivative-free methods that use only values of $f$ to search for the minimum. It consists in building a simplex of $n+1$ points and moving/shrinking this simplex into the good direction. 1. set initial points $x_1, \dots, x_{n+1}$. 2. order points such that $f(x_1)\leq f(x_2)\leq\dots\leq f(x_{n+1})$. 3. compute $x_o$ as the centroid of $x_1, \dots, x_{n}$. 4. Reflection: + compute the reflected point $x_r = x_o + \alpha(x_o-x_{n+1})$. + **if** $f(x_1)\leq f(x_r)1$, once initiated by $d_1 = -g(x_1)$. $\beta_k$ are updated according a scheme: * $\beta_k = \frac{ g_k^T g_k}{g_{k-1}^T g_{k-1} }$: Fletcher-Reeves update, * $\beta_k = \frac{ g_k^T (g_k-g_{k-1} )}{g_{k-1}^T g_{k-1}}$: Polak-Ribiere update. There exists also three-term formula for computing direction $d_k = -g(x_k) + \beta_k d_{k-1}+\gamma_{k} d_t$ for $tt+1$ otherwise $\gamma_k=0$ if $k=t$. See Yuan (2006) for other well-known schemes such as Hestenses-Stiefel, Dixon or Conjugate-Descent. The three updates (Fletcher-Reeves, Polak-Ribiere, Beale-Sorenson) of the (non-linear) conjugate gradient are available in `optim`. ### Computing the stepsize $t_k$ Let $\phi_k(t) = f(x_k + t d_k)$ for a given direction/iterate $(d_k, x_k)$. We need to find conditions to find a satisfactory stepsize $t_k$. In literature, we consider the descent condition: $\phi_k'(0) < 0$ and the Armijo condition: $\phi_k(t) \leq \phi_k(0) + t c_1 \phi_k'(0)$ ensures a decrease of $f$. Nocedal \& Wright (2006) presents a backtracking (or geometric) approach satisfying the Armijo condition and minimal condition, i.e. Goldstein and Price condition. * set $t_{k,0}$ e.g. 1, $0 < \alpha < 1$, * **Repeat** until Armijo satisfied, + $t_{k,i+1} = \alpha \times t_{k,i}$. * **end Repeat** This backtracking linesearch is available in `optim`. ## Benchmark To simplify the benchmark of optimization methods, we create a `fitbench` function that computes the desired estimation method for all optimization methods. This function is currently not exported in the package. ```{r, echo=TRUE, eval=FALSE} fitbench <- function(data, distr, method, grad=NULL, control=list(trace=0, REPORT=1, maxit=1000), lower=-Inf, upper=+Inf, ...) ``` ```{r, echo=FALSE} fitbench <- fitdistrplus:::fitbench ``` # Numerical illustration with the beta distribution ## Log-likelihood function and its gradient for beta distribution ### Theoretical value The density of the beta distribution is given by $$ f(x; \delta_1,\delta_2) = \frac{x^{\delta_1-1}(1-x)^{\delta_2-1}}{\beta(\delta_1,\delta_2)}, $$ where $\beta$ denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. We recall that $\beta(a,b)=\Gamma(a)\Gamma(b)/\Gamma(a+b)$. There the log-likelihood for a set of observations $(x_1,\dots,x_n)$ is $$ \log L(\delta_1,\delta_2) = (\delta_1-1)\sum_{i=1}^n\log(x_i)+ (\delta_2-1)\sum_{i=1}^n\log(1-x_i)+ n \log(\beta(\delta_1,\delta_2)) $$ The gradient with respect to $a$ and $b$ is $$ \nabla \log L(\delta_1,\delta_2) = \left(\begin{matrix} \sum\limits_{i=1}^n\ln(x_i) - n\psi(\delta_1)+n\psi( \delta_1+\delta_2) \\ \sum\limits_{i=1}^n\ln(1-x_i)- n\psi(\delta_2)+n\psi( \delta_1+\delta_2) \end{matrix}\right), $$ where $\psi(x)=\Gamma'(x)/\Gamma(x)$ is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. ### `R` implementation As in the `fitdistrplus` package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in `grlnL`. Both the log-likelihood and its gradient are not exported. ```{r} lnL <- function(par, fix.arg, obs, ddistnam) fitdistrplus:::loglikelihood(par, fix.arg, obs, ddistnam) grlnlbeta <- fitdistrplus:::grlnlbeta ``` ## Random generation of a sample ```{r, fig.height=4, fig.width=4} #(1) beta distribution n <- 200 x <- rbeta(n, 3, 3/4) grlnlbeta(c(3, 4), x) #test hist(x, prob=TRUE) lines(density(x), col="red") curve(dbeta(x, 3, 3/4), col="green", add=TRUE) legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ``` ## Fit Beta distribution Define control parameters. ```{r} ctr <- list(trace=0, REPORT=1, maxit=1000) ``` Call `mledist` with the default optimization function (`optim` implemented in `stats` package) with and without the gradient for the different optimization methods. ```{r} unconstropt <- fitbench(x, "beta", "mle", grad=grlnlbeta, lower=0) ``` In the case of constrained optimization, `mledist` permits the direct use of `constrOptim` function (still implemented in `stats` package) that allow linear inequality constraints by using a logarithmic barrier. Use a exp/log transformation of the shape parameters $\delta_1$ and $\delta_2$ to ensure that the shape parameters are strictly positive. ```{r} dbeta2 <- function(x, shape1, shape2, log) dbeta(x, exp(shape1), exp(shape2), log=log) #take the log of the starting values startarg <- lapply(fitdistrplus:::start.arg.default(x, "beta"), log) #redefine the gradient for the new parametrization grbetaexp <- function(par, obs, ...) grlnlbeta(exp(par), obs) * exp(par) expopt <- fitbench(x, distr="beta2", method="mle", grad=grbetaexp, start=startarg) #get back to original parametrization expopt[c("fitted shape1", "fitted shape2"), ] <- exp(expopt[c("fitted shape1", "fitted shape2"), ]) ``` Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one). ## Results of the numerical investigation Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (`-B` stands for bounded version), (2) the original parametrization with the (true) gradient (`-B` stands for bounded version and `-G` for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (`-G` stands for gradient). ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt))], digits=3) ``` Using `llsurface`, we plot the log-likehood surface around the true value (green) and the fitted parameters (red). ```{r, fig.width=4, fig.height=4} llsurface(min.arg=c(0.1, 0.1), max.arg=c(7, 3), plot.arg=c("shape1", "shape2"), nlev=25, plot.np=50, data=x, distr="beta", back.col = FALSE) points(unconstropt[1,"BFGS"], unconstropt[2,"BFGS"], pch="+", col="red") points(3, 3/4, pch="x", col="green") ``` We can simulate bootstrap replicates using the `bootdist` function. ```{r, fig.width=4, fig.height=4} b1 <- bootdist(fitdist(x, "beta", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=3, h=3/4, col="red", lwd=1.5) ``` # Numerical illustration with the negative binomial distribution ## Log-likelihood function and its gradient for negative binomial distribution ### Theoretical value The p.m.f. of the Negative binomial distribution is given by $$ f(x; m,p) = \frac{\Gamma(x+m)}{\Gamma(m)x!} p^m (1-p)^x, $$ where $\Gamma$ denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. There exists an alternative representation where $\mu=m (1-p)/p$ or equivalently $p=m/(m+\mu)$. Thus, the log-likelihood for a set of observations $(x_1,\dots,x_n)$ is $$ \log L(m,p) = \sum_{i=1}^{n} \log\Gamma(x_i+m) -n\log\Gamma(m) -\sum_{i=1}^{n} \log(x_i!) + mn\log(p) +\sum_{i=1}^{n} {x_i}\log(1-p) $$ The gradient with respect to $m$ and $p$ is $$ \nabla \log L(m,p) = \left(\begin{matrix} \sum_{i=1}^{n} \psi(x_i+m) -n \psi(m) + n\log(p) \\ mn/p -\sum_{i=1}^{n} {x_i}/(1-p) \end{matrix}\right), $$ where $\psi(x)=\Gamma'(x)/\Gamma(x)$ is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. ### `R` implementation As in the `fitdistrplus` package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in `grlnL`. ```{r} grlnlNB <- function(x, obs, ...) { m <- x[1] p <- x[2] n <- length(obs) c(sum(psigamma(obs+m)) - n*psigamma(m) + n*log(p), m*n/p - sum(obs)/(1-p)) } ``` ## Random generation of a sample ```{r, fig.height=4, fig.width=4} #(1) beta distribution n <- 200 trueval <- c("size"=10, "prob"=3/4, "mu"=10/3) x <- rnbinom(n, trueval["size"], trueval["prob"]) hist(x, prob=TRUE, ylim=c(0, .3)) lines(density(x), col="red") points(min(x):max(x), dnbinom(min(x):max(x), trueval["size"], trueval["prob"]), col="green") legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ``` ## Fit a negative binomial distribution Define control parameters and make the benchmark. ```{r} ctr <- list(trace=0, REPORT=1, maxit=1000) unconstropt <- fitbench(x, "nbinom", "mle", grad=grlnlNB, lower=0) unconstropt <- rbind(unconstropt, "fitted prob"=unconstropt["fitted mu",] / (1+unconstropt["fitted mu",])) ``` In the case of constrained optimization, `mledist` permits the direct use of `constrOptim` function (still implemented in `stats` package) that allow linear inequality constraints by using a logarithmic barrier. Use a exp/log transformation of the shape parameters $\delta_1$ and $\delta_2$ to ensure that the shape parameters are strictly positive. ```{r} dnbinom2 <- function(x, size, prob, log) dnbinom(x, exp(size), 1/(1+exp(-prob)), log=log) #transform starting values startarg <- fitdistrplus:::start.arg.default(x, "nbinom") startarg$mu <- startarg$size / (startarg$size+startarg$mu) startarg <- list(size=log(startarg[[1]]), prob=log(startarg[[2]]/(1-startarg[[2]]))) #redefine the gradient for the new parametrization Trans <- function(x) c(exp(x[1]), plogis(x[2])) grNBexp <- function(par, obs, ...) grlnlNB(Trans(par), obs) * c(exp(par[1]), plogis(x[2])*(1-plogis(x[2]))) expopt <- fitbench(x, distr="nbinom2", method="mle", grad=grNBexp, start=startarg) #get back to original parametrization expopt[c("fitted size", "fitted prob"), ] <- apply(expopt[c("fitted size", "fitted prob"), ], 2, Trans) ``` Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one). ## Results of the numerical investigation Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (`-B` stands for bounded version), (2) the original parametrization with the (true) gradient (`-B` stands for bounded version and `-G` for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (`-G` stands for gradient). ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt))], digits=3) ``` Using `llsurface`, we plot the log-likehood surface around the true value (green) and the fitted parameters (red). ```{r, fig.width=4, fig.height=4} llsurface(min.arg=c(5, 0.3), max.arg=c(15, 1), plot.arg=c("size", "prob"), nlev=25, plot.np=50, data=x, distr="nbinom", back.col = FALSE) points(unconstropt["fitted size","BFGS"], unconstropt["fitted prob","BFGS"], pch="+", col="red") points(trueval["size"], trueval["prob"], pch="x", col="green") ``` We can simulate bootstrap replicates using the `bootdist` function. ```{r, fig.width=4, fig.height=4} b1 <- bootdist(fitdist(x, "nbinom", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=trueval["size"], h=trueval["mu"], col="red", lwd=1.5) ``` # Conclusion Based on the two previous examples, we observe that all methods converge to the same point. This is rassuring. However, the number of function evaluations (and the gradient evaluations) is very different from a method to another. Furthermore, specifying the true gradient of the log-likelihood does not help at all the fitting procedure and generally slows down the convergence. Generally, the best method is the standard BFGS method or the BFGS method with the exponential transformation of the parameters. Since the exponential function is differentiable, the asymptotic properties are still preserved (by the Delta method) but for finite-sample this may produce a small bias. fitdistrplus/vignettes/paper2JSS.Rnw0000644000176200001440000021727614067272025017303 0ustar liggesusers\documentclass{article} % sweave commands for vignette %\VignetteIndexEntry{Fit parametric distributions on non-censored or censored data} %\VignettePackage{fitdistrplus} %\VignetteKeyword{distribution} %%% %%% TITLE: fitdistrplus: an R Package for Fitting Distributions %%% AUTHORS: Marie Laure Delignette Muller*, Christophe Dutang %%% * Corresponding author %%% AFFILIATION: LBBE, Université Claude Bernard Lyon 1, Lyon, France %%% ADDRESS: VetAgro Sup Campus Vétérinaire de Lyon %%% 1, avenue Bourgelat %%% 69820 MARCY L'ETOILE, France %%% PHONE: +33 4 78 87 27 40 %%% FAX: +33 4 78 87 27 12 %%% EMAIL: marielaure.delignettemuller@vetagro-sup.fr %%% \usepackage{amsmath,amsthm,amssymb} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} %\usepackage[english]{babel} %% need no \usepackage{Sweave} \usepackage{color, graphics} \usepackage[a4paper, textwidth=18cm, textheight=27cm]{geometry} \newcommand{\sigle}{\textsc} \newcommand{\pkg}{\textbf} %defined in jss.cls \newcommand{\code}{\texttt} %defined in jss.cls \newcommand{\proglang}{\textsf} %defined in jss.cls %layout \newcommand{\HRuleTop}{\noindent\rule{\linewidth}{.5pt}} \newcommand{\HRuleBottom}{\rule{\linewidth}{.5pt}} \usepackage{natbib,url} %\usepackage[hyperfootnotes=false]{hyperref} \author{ Marie Laure Delignette-Muller \\ Universit\'e de Lyon\\ Christophe Dutang \\ Universit\'e de Strasbourg} %\Plainauthor{Marie Laure Delignette-Muller} \title{\pkg{fitdistrplus}: An \proglang{R} Package for Fitting Distributions} %\Plaintitle{fitdistrplus: an R Package for Fitting Distributions} \date{October 2014 \footnote{Paper accepted in the Journal of Statistical Software} (revised in May 2020)} %quantile matching, maximum goodness-of-fit, distributions, R} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{50} %% \Issue{9} %% \Month{June} %% \Year{2012} %% \Submitdate{2012-09-04} %% \Acceptdate{2012-09-04} % \Address{ % Marie Laure Delignette-Muller \\ % Universit\'e de Lyon\\ % Universit\'e Lyon 1, CNRS, UMR5558, Laboratoire de Biom\'etrie et Biologie \'evolutive\\ % VetAgro Sup, Campus V\'et\'erinaire de Lyon \\ % 1, avenue Bourgelat \\ % 69820 MARCY L'ETOILE\\ % France \\ % E-mail: \email{marielaure.delignettemuller@vetagro-sup.fr} \\ % URL: \url{http://lbbe.univ-lyon1.fr/-Delignette-Muller-Marie-Laure-.html} % } % \newcommand{\Sconcordance}[1]{% % \ifx\pdfoutput\undefined% % \csname newcount\endcsname\pdfoutput\fi% % \ifcase\pdfoutput\special{#1}% % \else% % \begingroup% % \pdfcompresslevel=0% % \immediate\pdfobj stream{#1}% % \pdfcatalog{/SweaveConcordance \the\pdflastobj\space 0 R}% % \endgroup% % \fi} \begin{document} \SweaveOpts{concordance=TRUE} \maketitle \begin{abstract}% \HRuleTop\\ The package \pkg{fitdistrplus} provides functions for fitting univariate distributions to different types of data (continuous censored or non-censored data and discrete data) and allowing different estimation methods (maximum likelihood, moment matching, quantile matching and maximum goodness-of-fit estimation). Outputs of \code{fitdist} and \code{fitdistcens} functions are S3 objects, for which kind generic methods are provided, including \code{summary}, \code{plot} and \code{quantile}. This package also provides various functions to compare the fit of several distributions to a same data set and can handle bootstrap of parameter estimates. Detailed examples are given in food risk assessment, ecotoxicology and insurance contexts.\\ \HRuleBottom \end{abstract} \textit{Keywords}: {probability distribution fitting, bootstrap, censored data, maximum likelihood, moment matching, quantile matching, maximum goodness-of-fit, distributions, \proglang{R}} %\Plainkeywords{probability distribution fitting, bootstrap, censored data, maximum likelihood, moment matching, %, prefix.string=figs/jss %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section{Introduction} \label{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Fitting distributions to data is a very common task in statistics and consists in choosing a probability distribution modelling the random variable, as well as finding parameter estimates for that distribution. This requires judgment and expertise and generally needs an iterative process of distribution choice, parameter estimation, and quality of fit assessment. In the \proglang{R} \citep{R13} package \pkg{MASS} \citep{MASS}, maximum likelihood estimation is available via the \code{fitdistr} function; other steps of the fitting process can be done using other \proglang{R} functions \citep{Ricci05}. In this paper, we present the \proglang{R} package \pkg{fitdistrplus} \citep{fitdistrplus} implementing several methods for fitting univariate parametric distribution. A first objective in developing this package was to provide \proglang{R} users a set of functions dedicated to help this overall process. The \code{fitdistr} function estimates distribution parameters by maximizing the likelihood function using the \code{optim} function. No distinction between parameters with different roles (e.g., main parameter and nuisance parameter) is made, as this paper focuses on parameter estimation from a general point-of-view. In some cases, other estimation methods could be prefered, such as maximum goodness-of-fit estimation (also called minimum distance estimation), as proposed in the \proglang{R} package \pkg{actuar} with three different goodness-of-fit distances \citep{actuarJSS}. While developping the \pkg{fitdistrplus} package, a second objective was to consider various estimation methods in addition to maximum likelihood estimation (MLE). Functions were developped to enable moment matching estimation (MME), quantile matching estimation (QME), and maximum goodness-of-fit estimation (MGE) using eight different distances. Moreover, the \pkg{fitdistrplus} package offers the possibility to specify a user-supplied function for optimization, useful in cases where classical optimization techniques, not included in \code{optim}, are more adequate. In applied statistics, it is frequent to have to fit distributions to censored data \citep{kleinmoeschberger03, helsel05,busschaertetal10,lehaetal11,commeauetal12}. The \pkg{MASS} \code{fitdistr} function does not enable maximum likelihood estimation with this type of data. Some packages can be used to work with censored data, especially survival data \citep{survival,hiranoetal94,jordan05}, but those packages generally focus on specific models, enabling the fit of a restricted set of distributions. A third objective is thus to provide \proglang{R} users a function to estimate univariate distribution parameters from right-, left- and interval-censored data. Few packages on \sigle{CRAN} provide estimation procedures for any user-supplied parametric distribution and support different types of data. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{distrMod} package \citep{distrModJSS} provides an object-oriented (S4) implementation of probability models and includes distribution fitting procedures for a given minimization criterion. This criterion is a user-supplied function which is sufficiently flexible to handle censored data, yet not in a trivial way, see Example M4 of the \pkg{distrMod} vignette. The fitting functions \code{MLEstimator} and \code{MDEstimator} return an S4 class for which a coercion method to class mle is provided so that the respective functionalities (e.g., \code{confint} and \code{logLik}) from package \pkg{stats4} are available, too. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In \pkg{fitdistrplus}, we chose to use the standard S3 class system for its understanding by most \proglang{R} users. When designing the \pkg{fitdistrplus} package, we did not forget to implement generic functions also available for S3 classes. Finally, various other packages provide functions to estimate the mode, the moments or the L-moments of a distribution, see the reference manuals of \pkg{modeest}, \pkg{lmomco} and \pkg{Lmoments} packages. This manuscript reviews the various features of version 1.0-2 of \pkg{fitdistrplus}. The package is available from the Comprehensive \proglang{R} Archive Network at \url{http://cran.r-project.org/package=fitdistrplus}. The development version of the package is located at \proglang{R}-forge as one package of the project ``Risk Assessment with \proglang{R}'' (\url{https://r-forge.r-project.org/projects/riskassessment/}). The paper is organized as follows: Section \ref{fitnoncenscont} presents tools for fitting continuous distributions to classic non-censored data. Section \ref{advtopic} deals with other estimation methods and other types of data, before Section \ref{ccl} concludes. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Fitting distributions]{Fitting distributions to continuous non-censored data}\label{fitnoncenscont} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Choice of candidate distributions} \label{Choice} For illustrating the use of various functions of the \pkg{fitdistrplus} package with continuous non-censored data, we will first use a data set named \code{groundbeef} which is included in our package. This data set contains pointwise values of serving sizes in grams, collected in a French survey, for ground beef patties consumed by children under 5 years old. It was used in a quantitative risk assessment published by \cite{Delignette08}. %%% R code set default options for all R schunks <>= options(digits = 4, prompt="R> ", SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) set.seed(1234) @ %%% R code <>= library("fitdistrplus") data("groundbeef") str(groundbeef) @ Before fitting one or more distributions to a data set, it is generally necessary to choose good candidates among a predefined set of distributions. This choice may be guided by the knowledge of stochastic processes governing the modelled variable, or, in the absence of knowledge regarding the underlying process, by the observation of its empirical distribution. To help the user in this choice, we developed functions to plot and characterize the empirical distribution. First of all, it is common to start with plots of the empirical distribution function and the histogram (or density plot), which can be obtained with the \code{plotdist} function of the \pkg{fitdistrplus} package. This function provides two plots (see Figure~\ref{plotdistcont}): the left-hand plot is by default the histogram on a density scale (or density plot of both, according to values of arguments \code{histo} and \code{demp}) and the right-hand plot the empirical cumulative distribution function (CDF). %%% R code <>= plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) @ \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[htb!] \centering %%% R code <>= plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) @ \caption{Histogram and CDF plots of an empirical distribution for a continuous variable (serving size from the \code{groundbeef} data set) as provided by the \code{plotdist} function.} \label{plotdistcont} \end{figure} In addition to empirical plots, descriptive statistics may help to choose candidates to describe a distribution among a set of parametric distributions. Especially the skewness and kurtosis, linked to the third and fourth moments, are useful for this purpose. A non-zero skewness reveals a lack of symmetry of the empirical distribution, while the kurtosis value quantifies the weight of tails in comparison to the normal distribution for which the kurtosis equals 3. The skewness and kurtosis and their corresponding unbiased estimator \citep{casellaberger02} from a sample $(X_i)_i \stackrel{\text{i.i.d.}}{\sim} X$ with observations $(x_i)_i$ are given by \begin{equation} \label{skewness} sk(X) = \frac{E[(X-E(X))^3]}{Var(X)^{\frac{3}{2}}}~,~ \widehat{sk}=\frac{\sqrt{n(n-1)}}{n-2}\times\frac{m_{3}}{m_{2}^{\frac{3}{2}}}, \end{equation} \begin{equation} \label{kurtosis} kr(X) = \frac{E[(X-E(X))^4]}{Var(X)^{2}}~,~ \widehat{kr}=\frac{n-1}{(n-2)(n-3)}((n+1) \times \frac{m_{4}}{m_{2}^{2}}-3(n-1)) + 3, \end{equation} where $m_{2}$, $m_{3}$, $m_{4}$ denote empirical moments defined by $m_{k}=\frac{1}{n}\sum_{i=1}^n(x_{i}-\overline{x})^{k}$, with $x_{i}$ the $n$ observations of variable $x$ and $\overline{x}$ their mean value. The \code{descdist} function provides classical descriptive statistics (minimum, maximum, median, mean, standard deviation), skewness and kurtosis. By default, unbiased estimations of the three last statistics are provided. Nevertheless, the argument \code{method} can be changed from \code{"unbiased"} (default) to \code{"sample"} to obtain them without correction for bias. A skewness-kurtosis plot such as the one proposed by \cite{Cullen99} is provided by the \code{descdist} function for the empirical distribution (see Figure~\ref{Cullenplotcont} for the \code{groundbeef} data set). On this plot, values for common distributions are displayed in order to help the choice of distributions to fit to data. For some distributions (normal, uniform, logistic, exponential), there is only one possible value for the skewness and the kurtosis. Thus, the distribution is represented by a single point on the plot. For other distributions, areas of possible values are represented, consisting in lines (as for gamma and lognormal distributions), or larger areas (as for beta distribution). Skewness and kurtosis are known not to be robust. In order to take into account the uncertainty of the estimated values of kurtosis and skewness from data, a nonparametric bootstrap procedure \citep{efrontibshirani94} can be performed by using the argument \code{boot}. %to an integer above 10. Values of skewness and kurtosis are computed on bootstrap samples (constructed by random sampling with replacement from the original data set) and reported on the skewness-kurtosis plot. Nevertheless, the user needs to know that skewness and kurtosis, like all higher moments, have a very high variance. This is a problem which cannot be completely solved by the use of bootstrap. The skewness-kurtosis plot should then be regarded as indicative only. The properties of the random variable should be considered, notably its expected value and its range, as a complement to the use of the \code{plotdist} and \code{descdist} functions. Below is a call to the \code{descdist} function to describe the distribution of the serving size from the \code{groundbeef} data set and to draw the corresponding skewness-kurtosis plot (see Figure~\ref{Cullenplotcont}). Looking at the results on this example with a positive skewness and a kurtosis not far from 3, the fit of three common right-skewed distributions could be considered, Weibull, gamma and lognormal distributions. %%% R code <>= descdist(groundbeef$serving, boot = 1000) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb] \centering %%% R code <>= descdist(groundbeef$serving, boot = 1000) @ \caption{Skewness-kurtosis plot for a continuous variable (serving size from the \code{groundbeef} data set) as provided by the \code{descdist} function.} \label{Cullenplotcont} \end{figure} \newpage \subsection[Maximum likelihood]{Fit of distributions by maximum likelihood estimation} \label{FIT} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Once selected, one or more parametric distributions $f(.\vert \theta)$ (with parameter $\theta\in\mathbb{R}^d$) may be fitted to the data set, one at a time, using the \code{fitdist} function. Under the i.i.d. sample assumption, distribution parameters $\theta$ are by default estimated by maximizing the likelihood function defined as: \begin{equation} \label{likelihood} L(\theta)=\prod_{i=1}^n f(x_{i}\vert \theta) \end{equation} with $x_{i}$ the $n$ observations of variable $X$ and $f(.\vert \theta)$ the density function of the parametric distribution. The other proposed estimation methods are described in Section~\ref{Alternatives}. The \code{fitdist} function returns an S3 object of class \code{"fitdist"} for which \code{print}, \code{summary} and \code{plot} functions are provided. The fit of a distribution using \code{fitdist} assumes that the corresponding \code{d}, \code{p}, \code{q} functions (standing respectively for the density, the distribution and the quantile functions) are defined. Classical distributions are already defined in that way in the \pkg{stats} package, e.g., \code{dnorm}, \code{pnorm} and \code{qnorm} for the normal distribution (see \code{?Distributions}). Others may be found in various packages (see the CRAN task view: Probability Distributions at \url{https://CRAN.R-project.org/view=Distributions}). Distributions not found in any package must be implemented by the user as \code{d}, \code{p}, \code{q} functions. In the call to \code{fitdist}, a distribution has to be specified via the argument \code{dist} either by the character string corresponding to its common root name used in the names of \code{d}, \code{p}, \code{q} functions (e.g., \code{"norm"} for the normal distribution) or by the density function itself, from which the root name is extracted (e.g., \code{dnorm} for the normal distribution). Numerical results returned by the \code{fitdist} function are (1) the parameter estimates, (2) the estimated standard errors (computed from the estimate of the Hessian matrix at the maximum likelihood solution), (3) the loglikelihood, (4) Akaike and Bayesian information criteria (the so-called AIC and BIC), and (5) the correlation matrix between parameter estimates. Below is a call to the \code{fitdist} function to fit a Weibull distribution to the serving size from the \code{groundbeef} data set. %%% R code <>= fw <- fitdist(groundbeef$serving, "weibull") summary(fw) @ The plot of an object of class \code{"fitdist"} provides four classical goodness-of-fit plots \citep{Cullen99} presented on Figure~\ref{groundbeef:comp}: \begin{itemize} \item a density plot representing the density function of the fitted distribution along with the histogram of the empirical distribution, \item a CDF plot of both the empirical distribution and the fitted distribution, \item a Q-Q plot representing the empirical quantiles (y-axis) against the theoretical quantiles (x-axis) \item a P-P plot representing the empirical distribution function evaluated at each data point (y-axis) against the fitted distribution function (x-axis). \end{itemize} For CDF, Q-Q and P-P plots, the probability plotting position is defined by default using Hazen's rule, with probability points of the empirical distribution calculated as \code{(1:n - 0.5)/n}, as recommended by \cite{Blom}. This plotting position can be easily changed (see the reference manual for details \citep{fitdistrplus}). % using the arguments %\code{use.ppoints} and \code{a.ppoints}. When \code{use.ppoints = TRUE}, %the argument \code{a.ppoints} is passed to the \code{ppoints} function from the \pkg{stats} package to %define the %probability points of the empirical distribution as \code{(1:n - a.ppoints)/(n - 2a.ppoints + 1)}. %When \code{use.ppoints = FALSE}, the probability points are simply defined as \code{1:n / n}. Unlike the generic \code{plot} function, the \code{denscomp}, \code{cdfcomp}, \code{qqcomp} and \code{ppcomp} functions enable to draw separately each of these four plots, in order to compare the empirical distribution and multiple parametric distributions fitted on a same data set. These functions must be called with a first argument corresponding to a list of objects of class \code{fitdist}, and optionally further arguments to customize the plot (see the reference manual for lists of arguments that may be specific to each plot \citep{fitdistrplus}). In the following example, we compare the fit of a Weibull, a lognormal and a gamma distributions to the \code{groundbeef} data set (Figure~\ref{groundbeef:comp}). %%% R code <>= fg <- fitdist(groundbeef$serving, "gamma") fln <- fitdist(groundbeef$serving, "lnorm") par(mfrow = c(2, 2)) plot.legend <- c("Weibull", "lognormal", "gamma") denscomp(list(fw, fln, fg), legendtext = plot.legend) qqcomp(list(fw, fln, fg), legendtext = plot.legend) cdfcomp(list(fw, fln, fg), legendtext = plot.legend) ppcomp(list(fw, fln, fg), legendtext = plot.legend) @ \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[htb!] \centering <>= par(mfrow=c(2, 2)) denscomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) qqcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) cdfcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) ppcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) @ \caption{Four Goodness-of-fit plots for various distributions fitted to continuous data (Weibull, gamma and lognormal distributions fitted to serving sizes from the \code{groundbeef} data set) as provided by functions \code{denscomp}, \code{qqcomp}, \code{cdfcomp} and \code{ppcomp}.} \label{groundbeef:comp} \end{figure} The density plot and the CDF plot may be considered as the basic classical goodness-of-fit plots. The two other plots are complementary and can be very informative in some cases. The Q-Q plot emphasizes the lack-of-fit at the distribution tails while the P-P plot emphasizes the lack-of-fit at the distribution center. In the present example (in Figure~\ref{groundbeef:comp}), none of the three fitted distributions correctly describes the center of the distribution, but the Weibull and gamma distributions could be prefered for their better description of the right tail of the empirical distribution, especially if this tail is important in the use of the fitted distribution, as it is in the context of food risk assessment. The data set named \code{endosulfan} will now be used to illustrate other features of the \pkg{fitdistrplus} package. This data set contains acute toxicity values for the organochlorine pesticide endosulfan (geometric mean of LC50 ou EC50 values in $\mu g.L^{-1}$), tested on Australian and non-Australian laboratory-species \citep{Hose04}. In ecotoxicology, a lognormal or a loglogistic distribution is often fitted to such a data set in order to characterize the species sensitivity distribution (SSD) for a pollutant. A low percentile of the fitted distribution, generally the 5$\%$ percentile, is then calculated and named the hazardous concentration 5$\%$ (HC5). It is interpreted as the value of the pollutant concentration protecting 95$\%$ of the species \citep{Posthuma2010}. But the fit of a lognormal or a loglogistic distribution to the whole \code{endosulfan} data set is rather bad (Figure~\ref{endo:comp}), especially due to a minority of very high values. The two-parameter Pareto distribution and the three-parameter Burr distribution (which is an extension of both the loglogistic and the Pareto distributions) have been fitted. Pareto and Burr distributions are provided in the package \pkg{actuar}. Until here, we did not have to define starting values (in the optimization process) as reasonable starting values are implicity defined within the \code{fitdist} function for most of the distributions defined in \proglang{R} (see \code{?fitdist} for details). For other distributions like the Pareto and the Burr distribution, initial values for the distribution parameters have to be supplied in the argument \code{start}, as a named list with initial values for each parameter (as they appear in the \code{d}, \code{p}, \code{q} functions). Having defined reasonable starting values\footnote{%---- The \code{plotdist} function can plot any parametric distribution with specified parameter values in argument \code{para}. It can thus help to find correct initial values for the distribution parameters in non trivial cases, by iterative calls if necessary (see the reference manual for examples \citep{fitdistrplus}). }, %---- various distributions can be fitted and graphically compared. On this example, the function \code{cdfcomp} can be used to report CDF values in a logscale so as to emphasize discrepancies on the tail of interest while defining an HC5 value (Figure~\ref{endo:comp}). %%% R code <>= data("endosulfan") ATV <-endosulfan$ATV fendo.ln <- fitdist(ATV, "lnorm") library("actuar") fendo.ll <- fitdist(ATV, "llogis", start = list(shape = 1, scale = 500)) fendo.P <- fitdist(ATV, "pareto", start = list(shape = 1, scale = 500)) fendo.B <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE, legendtext = c("lognormal", "loglogistic", "Pareto", "Burr")) @ % qqcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale=TRUE, ylogscale=TRUE, % legendtext = c("lognormal","loglogistic","Pareto","Burr")) \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering <>= cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE,legendtext = c("lognormal","loglogistic","Pareto","Burr")) @ %qqcomp(list(fendo.ln,fendo.ll,fendo.P,fendo.B),xlogscale=TRUE,ylogscale=TRUE, % legendtext = c("lognormal","loglogistic","Pareto","Burr")) \caption{CDF plot to compare the fit of four distributions to acute toxicity values of various organisms for the organochlorine pesticide endosulfan (\code{endosulfan} data set) as provided by the \code{cdfcomp} function, with CDF values in a logscale to emphasize discrepancies on the left tail.} \label{endo:comp} \end{figure} None of the fitted distribution correctly describes the right tail observed in the data set, but as shown in Figure~\ref{endo:comp}, the left-tail seems to be better described by the Burr distribution. Its use could then be considered to estimate the HC5 value as the $5\%$ quantile of the distribution. This can be easily done using the \code{quantile} generic function defined for an object of class \code{"fitdist"}. Below is this calculation together with the calculation of the empirical quantile for comparison. %%% R code <>= quantile(fendo.B, probs = 0.05) quantile(ATV, probs = 0.05) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In addition to the ecotoxicology context, the \code{quantile} generic function is also attractive in the actuarial--financial context. In fact, the value-at-risk $VAR_\alpha$ is defined as the $1-\alpha$-quantile of the loss distribution and can be computed with \code{quantile} on a \code{"fitdist"} object. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The computation of different goodness-of-fit statistics is proposed in the \pkg{fitdistrplus} package in order to further compare fitted distributions. The purpose of goodness-of-fit statistics aims to measure the distance between the fitted parametric distribution and the empirical distribution: e.g., the distance between the fitted cumulative distribution function $F$ and the empirical distribution function $F_{n}$. When fitting continuous distributions, three goodness-of-fit statistics are classicaly considered: Cramer-von Mises, Kolmogorov-Smirnov and Anderson-Darling statistics \citep{Stephens86}. Naming $x_{i}$ the $n$ observations of a continuous variable $X$ arranged in an ascending order, Table \ref{tabKSCvMAD} gives the definition and the empirical estimate of the three considered goodness-of-fit statistics. They can be computed using the function \code{gofstat} as defined by Stephens \citep{Stephens86}. <>= gofstat(list(fendo.ln, fendo.ll, fendo.P, fendo.B), fitnames = c("lnorm", "llogis", "Pareto", "Burr")) @ \begin{table}[htb!] \begin{center} \begin{tabular}{lll} \hline Statistic & General formula & Computational formula\\ \hline Kolmogorov-Smirnov & $\sup|F_{n}(x) - F(x)|$ & $\max(D^{+},D^{-})$ with\\ (KS) & & $D^{+}=\max\limits_{i=1,\dots,n}\left(\frac{i}{n} - F_i\right)$ \\ & & $D^{-}=\max\limits_{i=1,\dots,n}\left(F_{i}-\frac{i-1}{n}\right)$ \\ \hline Cramer-von Mises & n $\int_{-\infty}^{\infty}(F_{n}(x) - F(x))^2 dx$ & $\frac{1}{12n} + \sum\limits_{i=1}^n \left(F_i-\frac{2i-1}{2n} \right)^{2}$\\ (CvM)&&\\ % cvm <- 1/(12*n) + sum( ( theop - (2 * seq(1:n) - 1)/(2 * n) )^2 ) \hline Anderson-Darling & n $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2}{F(x) (1 - F(x))} dx$ & $-n -\frac{1}{n}\sum\limits_{i=1}^n (2i-1)\log(F_i(1-F_{n+1-i}))$ \\ (AD) & & \\ % ad <- - n - mean( (2 * seq(1:n) - 1) * (log(theop) + log(1 - rev(theop))) ) \hline where $F_i\stackrel{\triangle}{=} F(x_i)$ \end{tabular} \caption{Goodness-of-fit statistics as defined by Stephens \citep{Stephens86}.} \label{tabKSCvMAD} \end{center} \end{table} %\newpage As giving more weight to distribution tails, the Anderson-Darling statistic is of special interest when it matters to equally emphasize the tails as well as the main body of a distribution. This is often the case in risk assessment \citep{Cullen99,Vose10}. For this reason, this statistics is often used to select the best distribution among those fitted. Nevertheless, this statistics should be used cautiously when comparing fits of various distributions. Keeping in mind that the weighting of each CDF quadratic difference depends on the parametric distribution in its definition (see Table \ref{tabKSCvMAD}), Anderson-Darling statistics computed for several distributions fitted on a same data set are theoretically difficult to compare. Moreover, such a statistic, as Cramer-von Mises and Kolmogorov-Smirnov ones, does not take into account the complexity of the model (i.e., parameter number). It is not a problem when compared distributions are characterized by the same number of parameters, but it could systematically promote the selection of the more complex distributions in the other case. Looking at classical penalized criteria based on the loglikehood (AIC, BIC) seems thus also interesting, especially to discourage overfitting. In the previous example, all the goodness-of-fit statistics based on the CDF distance are in favor of the Burr distribution, the only one characterized by three parameters, while AIC and BIC values respectively give the preference to the Burr distribution or the Pareto distribution. The choice between these two distributions seems thus less obvious and could be discussed. Even if specifically recommended for discrete distributions, the Chi-squared statistic may also be used for continuous distributions (see Section~\ref{otherdata} and the reference manual for examples \citep{fitdistrplus}). \subsection[Uncertainty]{Uncertainty in parameter estimates} \label{Uncertainty} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The uncertainty in the parameters of the fitted distribution can be estimated by parametric or nonparametric bootstraps using the \code{boodist} function for non-censored data \citep{efrontibshirani94}. This function returns the bootstrapped values of parameters in an S3 class object which can be plotted to visualize the bootstrap region. The medians and the 95 percent confidence intervals of parameters (2.5 and 97.5 percentiles) are printed in the summary. When inferior to the whole number of iterations (due to lack of convergence of the optimization algorithm for some bootstrapped data sets), the number of iterations for which the estimation converges is also printed in the summary. The plot of an object of class \code{"bootdist"} consists in a scatterplot or a matrix of scatterplots of the bootstrapped values of parameters providing a representation of the joint uncertainty distribution of the fitted parameters. Below is an example of the use of the \code{bootdist} function with the previous fit of the Burr distribution to the \code{endosulfan} data set (Figure~\ref{fig:bootstrap}). %%% R code <>= bendo.B <- bootdist(fendo.B, niter = 1001) @ <>= summary(bendo.B) plot(bendo.B) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering <>= plot(bendo.B) @ \caption{Bootstrappped values of parameters for a fit of the Burr distribution characterized by three parameters (example on the \code{endosulfan} data set) as provided by the plot of an object of class \code{"bootdist"}.} \label{fig:bootstrap} \end{figure} Bootstrap samples of parameter estimates are useful especially to calculate confidence intervals on each parameter of the fitted distribution from the marginal distribution of the bootstraped values. It is also interesting to look at the joint distribution of the bootstraped values in a scatterplot (or a matrix of scatterplots if the number of parameters exceeds two) in order to understand the potential structural correlation between parameters (see Figure~\ref{fig:bootstrap}). The use of the whole bootstrap sample is also of interest in the risk assessment field. Its use enables the characterization of uncertainty in distribution parameters. It can be directly used within a second-order Monte Carlo simulation framework, especially within the package \pkg{mc2d} \citep{mc2d}. One could refer to \cite{Pouillot10} for an introduction to the use of \pkg{mc2d} and \pkg{fitdistrplus} packages in the context of quantitative risk assessment. The bootstrap method can also be used to calculate confidence intervals on quantiles of the fitted distribution. For this purpose, a generic \code{quantile} function is provided for class \code{bootdist}. By default, $95\%$ percentiles bootstrap confidence intervals of quantiles are provided. Going back to the previous example from ecotoxicolgy, this function can be used to estimate the uncertainty associated to the HC5 estimation, for example from the previously fitted Burr distribution to the \code{endosulfan} data set. %%% R code <>= quantile(bendo.B, probs = 0.05) @ \begin{small} <>= quantile(bendo.B, probs = 0.05) @ \end{small} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Advanced topics}\label{advtopic} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[Alternative estimation]{Alternative methods for parameter estimation} \label{Alternatives} This subsection focuses on alternative estimation methods. One of the alternative for continuous distributions is the maximum goodness-of-fit estimation method also called minimum distance estimation method \citep{Stephens86,actuarJSS}. In this package this method is proposed with eight different distances: the three classical distances defined in Table~\ref{tabKSCvMAD}, or one of the variants of the Anderson-Darling distance proposed by \cite{Luceno06} and defined in Table~\ref{modifiedAD}. The right-tail AD gives more weight to the right-tail, the left-tail AD gives more weight only to the left tail. Either of the tails, or both of them, can receive even larger weights by using second order Anderson-Darling Statistics. \begin{table}[htb!] \begin{center} \begin{tabular}{lll} \hline Statistic & General formula & Computational formula\\ \hline Right-tail AD & $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{1 - F(x)} dx$ & $\frac{n}{2} -2\sum\limits_{i=1}^nF_i -\frac{1}{n}\sum\limits_{i=1}^n(2i-1)ln(\overline F_{n+1-i})$ \\ (ADR) & &\\ \hline Left-tail AD & $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(F(x))} dx$ & $-\frac{3n}{2} +2\sum\limits_{i=1}^nF_i -\frac{1}{n}\sum\limits_{i=1}^n(2i-1)ln(F_i)$ \\ (ADL) & &\\ \hline Right-tail AD & $ad2r=\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(1 - F(x))^{2}} dx$ & $ad2r=2\sum\limits_{i=1}^nln(\overline F_i) +\frac{1}{n}\sum\limits_{i=1}^n \frac{2i-1}{\overline F_{n+1-i}}$ \\ 2nd order (AD2R) & &\\ \hline Left-tail AD & $ad2l=\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(F(x))^{2}} dx$ & $ad2l=2\sum\limits_{i=1}^nln(F_i) +\frac{1}{n}\sum\limits_{i=1}^n\frac{2i-1}{F_i}$ \\ 2nd order (AD2L) & &\\ \hline AD 2nd order & $ad2r+ad2l$ & $ad2r+ad2l$ \\ (AD2) & &\\ \hline where $F_i\stackrel{\triangle}{=} F(x_{i})$; & $\overline F_i\stackrel{\triangle}{=}1-F(x_{i})$ \end{tabular} \caption{Modified Anderson-Darling statistics as defined by \cite{Luceno06}.} \label{modifiedAD} \end{center} \end{table} To fit a distribution by maximum goodness-of-fit estimation, one needs to fix the argument \code{method} to \code{"mge"} in the call to \code{fitdist} and to specify the argument \code{gof} coding for the chosen goodness-of-fit distance. This function is intended to be used only with continuous non-censored data. Maximum goodness-of-fit estimation may be useful to give more weight to data at one tail of the distribution. In the previous example from ecotoxicology, we used a non classical distribution (the Burr distribution) to correctly fit the empirical distribution especially on its left tail. In order to correctly estimate the 5$\%$ percentile, we could also consider the fit of the classical lognormal distribution, but minimizing a goodness-of-fit distance giving more weight to the left tail of the empirical distribution. In what follows, the left tail Anderson-Darling distances of first or second order are used to fit a lognormal to \code{endosulfan} data set (see Figure~\ref{plotfitMGE}). %%% R code <>= fendo.ln.ADL <- fitdist(ATV, "lnorm", method = "mge", gof = "ADL") fendo.ln.AD2L <- fitdist(ATV, "lnorm", method = "mge", gof = "AD2L") cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", xlegend = "bottomright", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order")) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering %%% R code <>= cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order"), xlegend = "bottomright") @ \caption{Comparison of a lognormal distribution fitted by MLE and by MGE using two different goodness-of-fit distances : left-tail Anderson-Darling and left-tail Anderson Darling of second order (example with the \code{endosulfan} data set) as provided by the \code{cdfcomp} function, with CDF values in a logscale to emphasize discrepancies on the left tail.} \label{plotfitMGE} \end{figure} Comparing the $5\%$ percentiles (HC5) calculated using these three fits to the one calculated from the MLE fit of the Burr distribution, we can observe, on this example, that fitting the lognormal distribution by maximizing left tail Anderson-Darling distances of first or second order enables to approach the value obtained by fitting the Burr distribution by MLE. %%% R code <>= (HC5.estimates <- c( empirical = as.numeric(quantile(ATV, probs = 0.05)), Burr = as.numeric(quantile(fendo.B, probs = 0.05)$quantiles), lognormal_MLE = as.numeric(quantile(fendo.ln, probs = 0.05)$quantiles), lognormal_AD2 = as.numeric(quantile(fendo.ln.ADL, probs = 0.05)$quantiles), lognormal_AD2L = as.numeric(quantile(fendo.ln.AD2L, probs = 0.05)$quantiles))) @ %\subsubsection{Moment matching estimation} %\label{MME} %%%%%%%%%% The moment matching estimation (MME) is another method commonly used to fit parametric distributions \citep{Vose10}. MME consists in finding the value of the parameter $\theta$ that equalizes the first theoretical raw moments of the parametric distribution to the corresponding empirical raw moments as in Equation~(\ref{moments}): \begin{equation} \label{moments} E(X^{k}|\theta)=\frac{1}{n}\sum_{i=1}^{n}x_{i}^{k} , \end{equation} for $k=1,\ldots,d$, with $d$ the number of parameters to estimate and $x_{i}$ the $n$ observations of variable $X$. For moments of order greater than or equal to 2, it may also be relevant to match centered moments. Therefore, we match the moments given in Equation~(\ref{centmoments}): \begin{equation} \label{centmoments} E(X\vert \theta) = \overline{x} ~,~ E\left((X-E(X))^{k}|\theta\right)=m_k, \text{ for } k=2,\ldots,d, \end{equation} where $m_k$ denotes the empirical centered moments. This method can be performed by setting the argument \code{method} to \code{"mme"} in the call to \code{fitdist}. The estimate is computed by a closed-form formula for the following distributions: normal, lognormal, exponential, Poisson, gamma, logistic, negative binomial, geometric, beta and uniform distributions. In this case, for distributions characterized by one parameter (geometric, Poisson and exponential), this parameter is simply estimated by matching theoretical and observed means, and for distributions characterized by two parameters, these parameters are estimated by matching theoretical and observed means and variances \citep{Vose10}. For other distributions, the equation of moments is solved numerically using the \code{optim} function by minimizing the sum of squared differences between observed and theoretical moments (see the \pkg{fitdistrplus} reference manual for technical details \citep{fitdistrplus}). A classical data set from the Danish insurance industry published in \cite{mcneil97} will be used to illustrate this method. In \pkg{fitdistrplus}, the data set is stored in \code{danishuni} for the univariate version and contains the loss amounts collected at Copenhagen Reinsurance between 1980 and 1990. In actuarial science, it is standard to consider positive heavy-tailed distributions and have a special focus on the right-tail of the distributions. In this numerical experiment, we choose classic actuarial distributions for loss modelling: the lognormal distribution and the Pareto type II distribution \citep{Klugmanetal09}. The lognormal distribution is fitted to \code{danishuni} data set by matching moments implemented as a closed-form formula. On the left-hand graph of Figure~\ref{fig:danish:mme}, the fitted distribution functions obtained using the moment matching estimation (MME) and maximum likelihood estimation (MLE) methods are compared. The MME method provides a more cautious estimation of the insurance risk as the MME-fitted distribution function (resp. MLE-fitted) underestimates (overestimates) the empirical distribution function for large values of claim amounts. %%% R code <>= data("danishuni") str(danishuni) fdanish.ln.MLE <- fitdist(danishuni$Loss, "lnorm") fdanish.ln.MME <- fitdist(danishuni$Loss, "lnorm", method = "mme", order = 1:2) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend = c("lognormal MLE", "lognormal MME"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) @ \setkeys{Gin}{width=0.9\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start=list(shape=10, scale=10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method="mme", order=1:2, memp="memp", start=list(shape=10, scale=10), lower=c(2+1e-6,2+1e-6), upper=c(Inf,Inf)) par(mfrow=c(1, 2)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend=c("lognormal MLE", "lognormal MME"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend=c("Pareto MLE", "Pareto MME"), main="Fitting a Pareto distribution", xlogscale=TRUE, datapch=20) @ \caption{Comparison between MME and MLE when fitting a lognormal or a Pareto distribution to loss data from the \code{danishuni} data set.} \label{fig:danish:mme} \end{figure} In a second time, a Pareto distribution, which gives more weight to the right-tail of the distribution, is fitted. As the lognormal distribution, the Pareto has two parameters, which allows a fair comparison. %The Burr distribution (with its three parameters) would lead to a better fit. We use the implementation of the \pkg{actuar} package providing raw and centered moments for that distribution (in addition to \code{d}, \code{p}, \code{q} and \code{r} functions \citep{actuar12}. Fitting a heavy-tailed distribution for which the first and the second moments do not exist for certain values of the shape parameter requires some cautiousness. This is carried out by providing, for the optimization process, a lower and an upper bound for each parameter. The code below calls the L-BFGS-B optimization method in \code{optim}, since this quasi-Newton allows box constraints\footnote{That is what the B stands for.}. We choose match moments defined in Equation~(\ref{moments}), and so a function for computing the empirical raw moment (called \code{memp} in our example) is passed to \code{fitdist}. For two-parameter distributions (i.e., $d=2$), Equations~(\ref{moments}) and (\ref{centmoments}) are equivalent. <>= library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start = list(shape = 10, scale = 10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method = "mme", order = 1:2, memp = "memp", start = list(shape = 10, scale = 10), lower = c(2+1e-6, 2+1e-6), upper = c(Inf, Inf)) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend = c("Pareto MLE", "Pareto MME"), main = "Fitting a Pareto distribution", xlogscale = TRUE, datapch = ".") gofstat(list(fdanish.ln.MLE, fdanish.P.MLE, fdanish.ln.MME, fdanish.P.MME), fitnames = c("lnorm.mle", "Pareto.mle", "lnorm.mme", "Pareto.mme")) @ As shown on Figure~\ref{fig:danish:mme}, MME and MLE fits are far less distant (when looking at the right-tail) for the Pareto distribution than for the lognormal distribution on this data set. Furthermore, for these two distributions, the MME method better fits the right-tail of the distribution from a visual point of view. This seems logical since empirical moments are influenced by large observed values. In the previous traces, we gave the values of goodness-of-fit statistics. Whatever the statistic considered, the MLE-fitted lognormal always provides the best fit to the observed data. Maximum likelihood and moment matching estimations are certainly the most commonly used method for fitting distributions \citep{Cullen99}. Keeping in mind that these two methods may produce very different results, the user should be aware of its great sensitivity to outliers when choosing the moment matching estimation. This may be seen as an advantage in our example if the objective is to better describe the right tail of the distribution, but it may be seen as a drawback if the objective is different. %\subsubsection{Quantile matching estimation} %\label{QME} %%%%%%%%%% Fitting of a parametric distribution may also be done by matching theoretical quantiles of the parametric distributions (for specified probabilities) against the empirical quantiles (\cite{Tse2009}). The equality of theoretical and empirical qunatiles is expressed by Equation~(\ref{quantiles}) below, which is very similar to Equations~(\ref{moments}) and (\ref{centmoments}): \begin{equation} \label{quantiles} F^{-1}(p_{k}|\theta)=Q_{n,p_{k}} \end{equation} for $k=1,\ldots,d$, with $d$ the number of parameters to estimate (dimension of $\theta$ if there is no fixed parameters) and $Q_{n,p_{k}}$ the empirical quantiles calculated from data for specified probabilities $p_{k}$. Quantile matching estimation (QME) is performed by setting the argument \code{method} to \code{"qme"} in the call to \code{fitdist} and adding an argument \code{probs} defining the probabilities for which the quantile matching is performed. The length of this vector must be equal to the number of parameters to estimate (as the vector of moment orders for MME). Empirical quantiles are computed using the \code{quantile} function of the \pkg{stats} package using \code{type=7} by default (see \code{?quantile} and \cite{hyndmanfan96}). But the type of quantile can be easily changed by using the \code{qty} argument in the call to the \code{qme} function. The quantile matching is carried out numerically, by minimizing the sum of squared differences between observed and theoretical quantiles. %%% R code <>= fdanish.ln.QME1 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(1/3, 2/3)) fdanish.ln.QME2 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(8/10, 9/10)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend = c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) @ Above is an example of fitting of a lognormal distribution to \code{danishuni} data set by matching probabilities $(p_1= 1/3, p_2=2/3)$ and $(p_1= 8/10, p_2=9/10)$. As expected, the second QME fit gives more weight to the right-tail of the distribution. %, despite we do not choose the Pareto type-II distribution. Compared to the maximum likelihood estimation, the second QME fit best suits the right-tail of the distribution, whereas the first QME fit best models the body of the distribution. The quantile matching estimation is of particular interest when we need to focus around particular quantiles, e.g., $p=99.5\%$ in the Solvency II insurance context or $p=5\%$ for the HC5 estimation in the ecotoxicology context. \setkeys{Gin}{width=0.5\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend=c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) @ \caption{Comparison between QME and MLE when fitting a lognormal distribution to loss data from the \code{danishuni} data set.} \label{fig:danish:qme} \end{figure} %\clearpage \subsection[Customizing optimization]{Customization of the optimization algorithm} \label{Customization} %%%%%%%%%% Each time a numerical minimization is carried out in the \code{fitdistrplus} package, the \code{optim} function of the \pkg{stats} package is used by default with the \code{"Nelder-Mead"} method for distributions characterized by more than one parameter and the \code{"BFGS"} method for distributions characterized by only one parameter. Sometimes the default algorithm fails to converge. It is then interesting to change some options of the \code{optim} function or to use another optimization function than \code{optim} to minimize the objective function. The argument \code{optim.method} can be used in the call to \code{fitdist} or \code{fitdistcens}. It will internally be passed to \code{mledist}, \code{mmedist}, \code{mgedist} or \code{qmedist}, and to \code{optim} (see \code{?optim} for details about the different algorithms available). Even if no error is raised when computing the optimization, changing the algorithm is of particular interest to enforce bounds on some parameters. For instance, a volatility parameter $\sigma$ is strictly positive $\sigma>0$ and a probability parameter $p$ lies in $p\in [0,1]$. This is possible by using arguments \code{lower} and/or \code{upper}, for which their use automatically forces \code{optim.method="L-BFGS-B"}. Below are examples of fits of a gamma distribution $\mathcal{G}(\alpha, \lambda)$ to the \code{groundbeef} data set with various algorithms. Note that the conjugate gradient algorithm (\code{"CG"}) needs far more iterations to converge (around 2500 iterations) compared to other algorithms (converging in less than 100 iterations). %%% R code <>= data("groundbeef") fNM <- fitdist(groundbeef$serving, "gamma", optim.method = "Nelder-Mead") fBFGS <- fitdist(groundbeef$serving, "gamma", optim.method = "BFGS") fSANN <- fitdist(groundbeef$serving, "gamma", optim.method = "SANN") fCG <- try(fitdist(groundbeef$serving, "gamma", optim.method = "CG", control = list(maxit = 10000))) if(class(fCG) == "try-error") fCG <- list(estimate = NA) @ It is also possible to use another function than \code{optim} to minimize the objective function by specifying by the argument \code{custom.optim} in the call to \code{fitdist}. It may be necessary to customize this optimization function to meet the following requirements. (1) \code{custom.optim} function must have the following arguments: \code{fn} for the function to be optimized and \code{par} for the initialized parameters. (2) \code{custom.optim} should carry out a MINIMIZATION and must return the following components: \code{par} for the estimate, \code{convergence} for the convergence code, \code{value=fn(par)} and \code{hessian}. Below is an example of code written to wrap the \code{genoud} function from the \pkg{rgenoud} package in order to respect our optimization ``template''. The \pkg{rgenoud} package implements the genetic (stochastic) algorithm. %%% R code <>= mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values = par, ...) standardres <- c(res, convergence = 0) return(standardres) } @ The customized optimization function can then be passed as the argument \code{custom.optim} in the call to \code{fitdist} or \code{fitdistcens}. The following code can for example be used to fit a gamma distribution to the \code{groundbeef} data set. Note that in this example various arguments are also passed from \code{fitdist} to \code{genoud} : \code{nvars}, \code{Domains}, \code{boundary.enforcement}, \code{print.level} and \code{hessian}. The code below compares all the parameter estimates ($\hat\alpha$, $\hat\lambda$) by the different algorithms: shape $\alpha$ and rate $\lambda$ parameters are relatively similar on this example, roughly 4.00 and 0.05, respectively. %%% R code <>= fgenoud <- mledist(groundbeef$serving, "gamma", custom.optim = mygenoud, nvars = 2, max.generations = 10, Domains = cbind(c(0,0), c(10,10)), boundary.enforcement = 1, hessian = TRUE, print.level = 0, P9 = 10) cbind(NM = fNM$estimate, BFGS = fBFGS$estimate, SANN = fSANN$estimate, CG = fCG$estimate, fgenoud = fgenoud$estimate) @ %\newpage \subsection[Other types of data]{Fitting distributions to other types of data} \label{otherdata} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \emph{This section was modified since the publication of this vignette in the Journal of Statistical Software in order to include new goodness-of-fit plots for censored and discrete data.} Analytical methods often lead to semi-quantitative results which are referred to as censored data. Observations only known to be under a limit of detection are left-censored data. Observations only known to be above a limit of quantification are right-censored data. Results known to lie between two bounds are interval-censored data. These two bounds may correspond to a limit of detection and a limit of quantification, or more generally to uncertainty bounds around the observation. Right-censored data are also commonly encountered with survival data \citep{kleinmoeschberger03}. A data set may thus contain right-, left-, or interval-censored data, or may be a mixture of these categories, possibly with different upper and lower bounds. Censored data are sometimes excluded from the data analysis or replaced by a fixed value, which in both cases may lead to biased results. A more recommended approach to correctly model such data is based upon maximum likelihood \citep{kleinmoeschberger03,helsel05}. Censored data may thus contain left-censored, right-censored and interval-censored values, with several lower and upper bounds. Before their use in package \pkg{fitdistrplus}, such data must be coded into a dataframe with two columns, respectively named \code{left} and \code{right}, describing each observed value as an interval. The \code{left} column contains either \code{NA} for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The \code{right} column contains either \code{NA} for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. To illustrate the use of package \pkg{fitdistrplus} to fit distributions to censored continous data, we will use another data set from ecotoxicology, included in our package and named \code{salinity}. This data set contains acute salinity tolerance (LC50 values in electrical conductivity, $mS$.$cm^{-1}$) of riverine macro-invertebrates taxa from the southern Murray-Darling Basin in Central Victoria, Australia \citep{kefford07}. %%% R code <>= data("salinity") str(salinity) @ %\subsubsection{Graphical display of the observed distribution} %\label{censored:graph} %%%%%%%%%% Using censored data such as those coded in the \code{salinity} data set, the empirical distribution can be plotted using the \code{plotdistcens} function. In older versions of the package, by default this function used the Expectation-Maximization approach of \cite{Turnbull74} to compute the overall empirical cdf curve with optional confidence intervals, by calls to \code{survfit} and \code{plot.survfit} functions from the \pkg{survival} package. Even if this representation is always available (by fixing the argument \code{NPMLE.method} to \code{"Turnbull.middlepoints"}), now the default plot of the empirical cumulative distribution function (ECDF) explicitely represents the regions of non uniqueness of the NPMLE ECDF. The default computation of those regions of non uniqueness and their associated masses uses the non parametric maximum likelihood estimation (NPMLE) approach developped by Wang \citep{Wang2007, Wang2008, Wang2013, Wang2018}. Figure~\ref{cdfcompcens} shows on the top left the new plot of data together with two fitted distributions. Grey filled rectangles in such a plot represent the regions of non uniqueness of the NPMLE ECDF. A less rigorous but sometimes more illustrative plot can be obtained by fixing the argument \code{NPMLE} to \code{FALSE} in the call to \code{plotdistcens} (see Figure~\ref{plotdistcens} for an example and the help page of Function \code{plotdistcens} for details). This plot enables to see the real nature of censored data, as points and intervals, but the difficulty in building such a plot is to define a relevant ordering of observations. %%% R code %<>= %plotdistcens(salinity) %@ %%% R code <>= plotdistcens(salinity, NPMLE = FALSE) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering %%% R code <>= plotdistcens(salinity, NPMLE = FALSE) @ \caption{Simple plot of censored raw data (72-hour acute salinity tolerance of riverine macro-invertebrates from the \code{salinity} data set) as ordered points and intervals.} \label{plotdistcens} \end{figure} %\subsubsection{Maximum likelihood estimation} %\label{censored:MLE} %%%%%%%%%% As for non censored data, one or more parametric distributions can be fitted to the censored data set, one at a time, but using in this case the \code{fitdistcens} function. This function estimates the vector of distribution parameters $\theta$ by maximizing the likelihood for censored data defined as: \begin{equation} \label{likelihoodC} \begin{array}{lll} L(\theta)&=&\prod_{i=1}^{N_{nonC}} f(x_{i}|\theta) \times \prod_{j=1}^{N_{leftC}} F(x^{upper}_{j}|\theta) \\ & & \times \prod_{k=1}^{N_{rightC}} (1- F(x^{lower}_{k}|\theta)) \times \prod_{m=1}^{N_{intC}} (F(x^{upper}_{m}|\theta)- F(x^{lower}_{j}|\theta)) \end{array} \end{equation} with $x_{i}$ the $N_{nonC}$ non-censored observations, $x^{upper}_{j}$ upper values defining the $N_{leftC}$ left-censored observations, $x^{lower}_{k}$ lower values defining the $N_{rightC}$ right-censored observations, $[x^{lower}_{m} ; x^{upper}_{m}]$ the intervals defining the $N_{intC}$ interval-censored observations, and F the cumulative distribution function of the parametric distribution \citep{kleinmoeschberger03,helsel05}. As \code{fitdist}, \code{fitdistcens} returns the results of the fit of any parametric distribution to a data set as an S3 class object that can be easily printed, summarized or plotted. For the \code{salinity} data set, a lognormal distribution or a loglogistic can be fitted as commonly done in ecotoxicology for such data. As with \code{fitdist}, for some distributions (see \cite{fitdistrplus} for details), it is necessary to specify initial values for the distribution parameters in the argument \code{start}. The \code{plotdistcens} function can help to find correct initial values for the distribution parameters in non trivial cases, by a manual iterative use if necessary. %%% R code <>= fsal.ln <- fitdistcens(salinity, "lnorm") fsal.ll <- fitdistcens(salinity, "llogis", start = list(shape = 5, scale = 40)) summary(fsal.ln) summary(fsal.ll) @ Computations of goodness-of-fit statistics have not yet been developed for fits using censored data but the quality of fit can be judged using Akaike and Schwarz's Bayesian information criteria (AIC and BIC) and the goodness-of-fit CDF plot, respectively provided when summarizing or plotting an object of class \code{"fitdistcens"}. Functions \code{cdfcompcens}, \code{qqcompcens} and \code{ppcompcens} can also be used to compare the fit of various distributions to the same censored data set. Their calls are similar to the ones of \code{cdfcomp}, \code{qqcomp} and \code{ppcomp}. Below are examples of use of those functions with the two fitted distributions to the \code{salinity} data set (see Figure~\ref{cdfcompcens}). When \code{qqcompcens} and \code{ppcompcens} are used with more than one fitted distribution, the non uniqueness rectangles are not filled and a small noise is added on the y-axis in order to help the visualization of various fits. But we rather recommend the use of the \code{plotstyle} \code{ggplot} of \code{qqcompcens} and \code{ppcompcens} to compare the fits of various distributions as it provides a clearer plot splitted in facets (see \code{?graphcompcens}). %%% R code <>= par(mfrow=c(2, 2)) cdfcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic ")) qqcompcens(fsal.ln, legendtext = "lognormal") ppcompcens(fsal.ln, legendtext = "lognormal") qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), main = "Q-Q plot with 2 dist.") @ \setkeys{Gin}{width=0.8\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= par(mfrow=c(2, 2)) cdfcompcens(list(fsal.ln, fsal.ll), legendtext=c("lognormal", "loglogistic ")) qqcompcens(fsal.ln, legendtext = "lognormal") ppcompcens(fsal.ln, legendtext = "lognormal") qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), main = "Q-Q plot with 2 dist.") @ \caption{Some goodness-of-fit plots for fits of a lognormal and a loglogistic distribution to censored data: LC50 values from the \code{salinity} data set.} \label{cdfcompcens} \end{figure} Function \code{bootdistcens} is the equivalent of \code{bootdist} for censored data, except that it only proposes nonparametric bootstrap. Indeed, it is not obvious to simulate censoring within a parametric bootstrap resampling procedure. The generic function \code{quantile} can also be applied to an object of class \code{"fitdistcens"} or \code{"bootdistcens"}, as for continuous non-censored data. In addition to the fit of distributions to censored or non censored continuous data, our package can also accomodate discrete variables, such as count numbers, using the functions developped for continuous non-censored data. These functions will provide somewhat different graphs and statistics, taking into account the discrete nature of the modeled variable. The discrete nature of the variable is automatically recognized when a classical distribution is fitted to data (binomial, negative binomial, geometric, hypergeometric and Poisson distributions) but must be indicated by fixing argument \code{discrete} to \code{TRUE} in the call to functions in other cases. The \code{toxocara} data set included in the package corresponds to the observation of such a discrete variable. Numbers of \emph{Toxocara cati} parasites present in digestive tract are reported from a random sampling of feral cats living on Kerguelen island \citep{Fromont01}. We will use it to illustrate the case of discrete data. %%% R code <>= data("toxocara") str(toxocara) @ The fit of a discrete distribution to discrete data by maximum likelihood estimation requires the same procedure as for continuous non-censored data. As an example, using the \code{toxocara} data set, Poisson and negative binomial distributions can be easily fitted. %%% R code <>= (ftoxo.P <- fitdist(toxocara$number, "pois")) (ftoxo.nb <- fitdist(toxocara$number, "nbinom")) @ For discrete distributions, the plot of an object of class \code{"fitdist"} simply provides two goodness-of-fit plots comparing empirical and theoretical distributions in density and in CDF. Functions \code{cdfcomp} and \code{denscomp} can also be used to compare several plots to the same data set, as follows for the previous fits (Figure~\ref{plotdiscfit}). <>= par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) @ \setkeys{Gin}{width=0.9\textwidth} %default \begin{figure}[htb] \centering <>= par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) @ \caption{Comparison of the fits of a negative binomial and a Poisson distribution to numbers of \emph{Toxocara cati} parasites from the \code{toxocara} data set.} \label{plotdiscfit} \end{figure} When fitting discrete distributions, the Chi-squared statistic is computed by the \code{gofstat} function using cells defined by the argument \code{chisqbreaks} or cells automatically defined from the data in order to reach roughly the same number of observations per cell. This number is roughly equal to the argument \code{meancount}, or sligthly greater if there are some ties. The choice to define cells from the empirical distribution (data), and not from the theoretical distribution, was done to enable the comparison of Chi-squared values obtained with different distributions fitted on a same data set. If arguments \code{chisqbreaks} and \code{meancount} are both omitted, \code{meancount} is fixed in order to obtain roughly $(4n)^{2/5}$ cells, with $n$ the length of the data set \citep{Vose10}. Using this default option the two previous fits are compared as follows, giving the preference to the negative binomial distribution, from both Chi-squared statistics and information criteria: %%% R code <>= gofstat(list(ftoxo.P, ftoxo.nb), fitnames = c("Poisson", "negative binomial")) @ \section{Conclusion} \label{ccl} %%%%%%%%%% The \proglang{R} package \pkg{fitdistrplus} allows to easily fit distributions. Our main objective while developing this package was to provide tools for helping \proglang{R} users to fit distributions to data. We have been encouraged to pursue our work by feedbacks from users of our package in various areas as food or environmental risk assessment, epidemiology, ecology, molecular biology, genomics, bioinformatics, hydraulics, mechanics, financial and actuarial mathematics or operations research. Indeed, this package is already used by a lot of practionners and academics for simple MLE fits \citep{jaloustreetal11,saketal11,kochetal12,marquetouxetal12, scholletal12,suuronenetal12,varoetal12,mandletal13,mala2013publi,nadarajahbakar2013,simoetal13, westphalfitch13,wayland13,vianaetal13,wu13,staggeetal13,fiorellietal13,tikoleetal13, voigtetal14}, for MLE fits and goodness-of-fit statistics \citep{tarnczi11,bagariaetal12,benavidesetal12,breitbach12,Pouillot10,vaninsky13}, for MLE fits and bootstrap \citep{croucheretal12,meheustetal12,orellanoetal12,telloetal12,hoelzeretal12, prosseretal13,Zhang2013,Rigaux2014}, for MLE fits, bootstrap and goodness-of-fit statistics \citep{larrasetal13}, for MME fit \citep{luangkesornetal12,callauetal13,satoetal13}, for censored MLE and bootstrap \citep{lehaetal11,poulliotetal12,jongenburgeretal12, commeauetal12,contrerasetal2013}, for graphic analysing in \citep{anandetal12}, for grouped-data fitting methods \citep{fusteinercostafreda12} or more generally \citep{busschaertetal10,eling12, sosaetal2013,srinivasanetal2013,meyeretal13,Guillier2013471,Daelmanetal13, eiketal13,Wu2:2013,drakeetal2014}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{fitdistrplus} package is complementary with the \pkg{distrMod} package \citep{distrModJSS}. \pkg{distrMod} provides an even more flexible way to estimate distribution parameters but its use requires a greater initial investment to learn how to manipulate the \texttt{S4} classes and methods developed in the \texttt{distr}-family packages. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Many extensions of the \pkg{fitdistrplus} package are planned in the future: we target to extend to censored data some methods for the moment only available for non-censored data, especially concerning goodness-of-fit evaluation and fitting methods. We will also enlarge the choice of fitting methods for non-censored data, by proposing new goodness-of-fit distances (e.g., distances based on quantiles) for maximum goodness-of-fit estimation and new types of moments (e.g., limited expected values) for moment matching estimation. At last, we will consider the case of multivariate distribution fitting. \section{Acknowledgments} \label{merci} %%%%%%%%%% The package would not have been at this stage without the stimulating contribution of R\'egis Pouillot and Jean-Baptiste Denis, especially for its conceptualization. We also want to thank R\'egis Pouillot for his very valuable comments on the first version of this paper. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The authors gratefully acknowledges the two anonymous referees and the Editor for useful and constructive comments. The remaining errors, of course, should be attributed to the authors alone. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \bibliographystyle{apalike} \bibliography{jssfitdistrplus} \end{document} fitdistrplus/vignettes/jssfitdistrplus.bib0000644000176200001440000012405313742313702020757 0ustar liggesusers%% This BibTeX bibliography file was created using BibDesk. %% http://bibdesk.sourceforge.net/ %% Created for Christophe Dutang at 2013-05-15 16:49:04 +0200 %% Saved with string encoding Unicode (UTF-8) @manual{R13, Address = {Vienna, Austria}, Author = {{\proglang{R} Development Core Team}}, Title = {\proglang{R}: A Language and Environment for Statistical Computing}, Url = {http://www.R-project.org/}, Year = {2013}} @article{hyndmanfan96, Author = {R.J. Hyndman and Y. Fan}, Date-Modified = {2013-05-15 16:18:15 +0200}, Journal = {The American Statistician}, Pages = {361-365}, Title = {{Sample Quantiles in Statistical Packages}}, Volume = {50}, Year = {1996}} @book{casellaberger02, Author = {G. Casella and R.L. Berger}, Date-Modified = {2013-05-15 16:09:07 +0200}, Edition = {2nd}, Publisher = {Duxbury Thomson Learning}, Title = {Statistical Inference}, Year = {2002}} @book{efrontibshirani94, Author = {B. Efron and R.J. Tibshirani}, Date-Added = {2013-03-25 08:56:42 +0100}, Date-Modified = {2013-05-15 16:10:02 +0200}, Edition = {1st}, Publisher = {Chapman \& Hall}, Title = {An Introduction to the Bootstrap}, Year = {1994}} @article{kefford07, Author = {B.J. Kefford and E.J. Fields and C. Clay and D. Nugegoda}, Date-Added = {2013-03-06 21:41:48 +0100}, Date-Modified = {2013-05-15 16:20:52 +0200}, Journal = {Marine and Freshwater Research}, Pages = {1019-1031}, Title = {{Salinity Tolerance of Riverine Macroinvertebrates from the Southern Murray-Darling Basin}}, Volume = {58}, Year = {2007}} @book{helsel05, Author = {D.R. Helsel}, Date-Added = {2013-03-11 16:55:34 +0100}, Date-Modified = {2013-03-11 16:55:34 +0100}, Edition = {1st}, Publisher = {John Wiley \& Sons}, Title = {Nondetects and Data Analysis: Statistics for Censored Environmental Data}, Year = {2005}} @book{kleinmoeschberger03, Author = {J.P. Klein and M.L. Moeschberger}, Date-Added = {2013-03-06 21:37:34 +0100}, Date-Modified = {2013-03-06 21:38:47 +0100}, Edition = {2nd}, Publisher = {Springer-Verlag}, Title = {Survival Analysis: Techniques for Censored and Truncated Data}, Year = {2003}} @article{jordan05, Author = {D. Jordan}, Date-Added = {2013-03-06 18:21:50 +0100}, Date-Modified = {2013-05-15 16:20:35 +0200}, Journal = {Preventive Veterinary Medicine}, Number = {1-2}, Pages = {59-73}, Title = {Simulating the Sensitivity of Pooled-sample Herd Tests for Fecal Salmonella in Cattle}, Volume = {70}, Year = {2005}} @article{hiranoetal94, Author = {S.S. Hirano and M.K. Clayton and C.D. Upper}, Date-Added = {2013-03-06 18:15:38 +0100}, Date-Modified = {2013-05-15 16:18:01 +0200}, Journal = {Phytopathology}, Number = {9}, Pages = {934-940}, Title = {{Estimation of and Temporal Changes in Means and Variances of Populations of \emph{Pseudomonas syringae} on Snap Bean Leaflets}}, Volume = {84}, Year = {1994}} @manual{actuar12, Author = {Goulet, V.}, Date-Added = {2012-11-07 17:28:38 +0100}, Date-Modified = {2013-05-15 16:44:30 +0200}, Note = {\proglang{R}~package version~1.1-5}, Title = {\pkg{actuar}: An \proglang{R} Package for Actuarial Science}, Url = {http://CRAN.R-project.org/package=actuar}, Year = 2012, Bdsk-Url-1 = {http://www.actuar-project.org}} @article{mcneil97, Author = {A.J. McNeil}, Date-Added = {2012-11-02 18:47:05 +0100}, Date-Modified = {2013-05-15 16:18:38 +0200}, Journal = {ASTIN Bulletin}, Number = {1}, Pages = {117-137}, Title = {Estimating the Tails of Loss Severity Distributions Using Extreme Value Theory}, Volume = {27}, Year = {1997}} @article{distrModJSS, Author = {M. Kohl and P. Ruckdeschel}, Date-Added = {2012-10-18 18:41:33 +0200}, Date-Modified = {2012-10-18 18:42:23 +0200}, Journal = {Journal of Statistical Software}, Number = {10}, Pages = {1-27}, Title = {{\proglang{R} Package \pkg{distrMod}: S4 Classes and Methods for Probability Models}}, Volume = {35}, Year = {2010}} @article{actuarJSS, Author = {C. Dutang and V. Goulet and M. Pigeon}, Date-Added = {2012-10-18 18:32:43 +0200}, Date-Modified = {2012-10-18 18:35:33 +0200}, Journal = {Journal of Statistical Software}, Number = {7}, Pages = {1-37}, Title = {{\pkg{actuar}: an \proglang{R} Package for Actuarial Science}}, Volume = {25}, Year = {2008}} @book{Cullen99, Author = {Cullen, A.C. and Frey, H.C.}, Date-Modified = {2013-05-15 16:09:40 +0200}, Edition = {1st}, Language = {english}, Publisher = {Plenum Publishing Co.}, Title = {Probabilistic Techniques in Exposure Assessment}, Year = 1999} @book{Vose10, Author = {Vose, D.}, Date-Modified = {2013-05-15 16:07:47 +0200}, Edition = {1st}, Language = {english}, Publisher = {John Wiley \& Sons}, Title = {Quantitative Risk Analysis. A Guide to Monte Carlo Simulation Modelling}, Year = {2010}} @book{Klugmanetal09, Author = {Klugman, S.A. and Panjer, H.H. and Willmot, G.E.}, Date-Modified = {2013-05-15 16:08:27 +0200}, Edition = {3rd}, Language = {english}, Publisher = {John Wiley \& Sons}, Title = {Loss Models: from Data to Decisions}, Year = {2009}} @book{Stephens86, Author = {D'Agostino, R.B. and Stephens, M.A.}, Date-Modified = {2013-05-15 16:10:10 +0200}, Edition = {1st}, Language = {english}, Publisher = {Dekker}, Title = {Goodness-of-Fit Techniques}, Year = {1986}} @book{MASS, Author = {Venables, W. N. and Ripley, B. D.}, Edition = {4th}, Language = {english}, Publisher = {Springer-Verlag}, Title = {Modern Applied Statistics with {S}}, Year = 2010} @book{Blom, Asin = {B002LBF3JO}, Author = {Blom, G.}, Date-Modified = {2013-05-15 16:10:43 +0200}, Edition = {1st}, Language = {english}, Publisher = {John Wiley \& Sons}, Title = {Statistical Estimates and Transformed Beta Variables}, Year = 1959} @article{Luceno06, Author = {Luceno, A.}, Date-Modified = {2013-05-15 16:39:08 +0200}, Journal = {{Computational Statistics and Data Analysis}}, Month = {{NOV 15}}, Number = {{2}}, Pages = {{904-917}}, Title = {{Fitting the Generalized Pareto Distribution to Data Using Maximum Goodness-of-fit Estimators}}, Volume = {{51}}, Year = {{2006}}} @manual{survival, Author = {Therneau, T.}, Date-Modified = {2013-05-15 16:40:53 +0200}, Note = {\proglang{R}~package version~2.36-9}, Title = {\pkg{survival}: Survival Analysis, Including Penalized Likelihood}, Url = {http://CRAN.R-project.org/package=survival}, Year = {2011}, Bdsk-Url-1 = {http://cran.r-project.org/web/packages/survival/}} @manual{fitdistrplus, Author = {Delignette-Muller, M.L. and Pouillot, R. and Denis, J.B. and Dutang, C.}, Date-Modified = {2014-07-15 16:44:56 +0200}, Note = {R package version 1.0-2}, Title = {\pkg{fitdistrplus}: Help to Fit of a Parametric Distribution to Non-Censored or Censored Data}, Url = {http://CRAN.R-project.org/package=fitdistrplus}, Year = {2014}, Bdsk-Url-1 = {http://cran.r-project.org/web/packages/fitdistrplus/}} @manual{mc2d, Author = {Pouillot, R. and Delignette-Muller, M.L. and Denis, J.B.}, Date-Modified = {2013-05-15 16:41:18 +0200}, Note = {R package version 0.1-12}, Title = {\pkg{mc2d}: Tools for Two-Dimensional Monte-Carlo Simulations}, Url = {http://CRAN.R-project.org/package=mc2d}, Year = {2011}, Bdsk-Url-1 = {http://cran.r-project.org/web/packages/mc2d/}} @unpublished{Ricci05, Author = {Ricci, V.}, Date-Modified = {2013-05-15 16:48:58 +0200}, Language = {english}, Note = {Contributed Documentation available on CRAN}, Title = {Fitting Distributions with \proglang{R}}, Url = {http://CRAN.R-project.org/doc/contrib/Ricci-distributions-en.pdf}, Year = {2005}, Bdsk-Url-1 = {http://cran.r-project.org/doc/contrib/Ricci-distributions-en.pdf}} @article{Pouillot10, Author = {Pouillot, R. and Delignette-Muller, M.L.}, Date-Modified = {2012-11-02 19:01:40 +0100}, Journal = {{International Journal of Food Microbiology}}, Month = {{SEP 1}}, Number = {{3}}, Pages = {{330-340}}, Title = {{Evaluating Variability and Uncertainty Separately in Microbial Quantitative Risk Assessment using two R Packages}}, Unique-Id = {{ISI:000281981700007}}, Volume = {{142}}, Year = {{2010}}, Bdsk-Url-1 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2010.07.011}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2010.07.011}} @article{Delignette08, Author = {Delignette-Muller, M. L. and Cornu, M. and AFSSA-STEC-Study-Group}, Date-Modified = {2012-11-02 19:01:25 +0100}, Journal = {{International Journal of Food Microbiology}}, Month = {{NOV 30}}, Number = {{1, SI}}, Pages = {{158-164}}, Title = {{Quantitative Risk Assessment for \emph{Escherichia coli} O157:H7 in Frozen Ground Beef Patties Consumed by Young Children in French Households}}, Unique-Id = {{ISI:000261280700022}}, Volume = {{128}}, Year = {{2008}}, Bdsk-Url-1 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2008.05.040}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2008.05.040}} @article{Busschaert10, Author = {Busschaert, P. and Geeraerd, A. H. and Uyttendaele, M. and Van Impe, J. F.}, Date-Modified = {2012-11-02 19:01:35 +0100}, Doi = {{10.1016/j.ijfoodmicro.2010.01.025}}, Issn = {{0168-1605}}, Journal = {{International Journal of Food Microbiology}}, Month = {{APR 15}}, Number = {{3}}, Pages = {{260-269}}, Title = {{Estimating Distributions out of Qualitative and (Semi)Quantitative Microbiological Contamination Data for Use in Risk Assessment}}, Unique-Id = {{ISI:000276819700010}}, Volume = {{138}}, Year = {{2010}}, Bdsk-Url-1 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2010.01.025}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2010.01.025}} @article{Hose04, Author = {Hose, G.C. and Van den Brink, P.J.}, Date-Modified = {2013-03-06 21:55:00 +0100}, Journal = {{Archives of Environmental Contamination and Toxicology}}, Month = {{OCT}}, Number = {{4}}, Pages = {{511-520}}, Title = {{Confirming the Species-Sensitivity Distribution Concept for Endosulfan Using Laboratory, Mesocosm, and Field Data}}, Unique-Id = {{ISI:000224753800011}}, Volume = {{47}}, Year = {{2004}}, Bdsk-Url-1 = {http://dx.doi.org/10.1007/s00244-003-3212-5}, Bdsk-Url-2 = {http://dx.doi.org/10.1007/s00244-003-3212-5}} @article{Fromont01, Author = {Fromont, E and Morvilliers, L and Artois, M and Pontier, D}, Date-Modified = {2012-11-02 19:00:22 +0100}, Journal = {{Parasitology}}, Month = {{AUG}}, Number = {{Part 2}}, Pages = {{143-151}}, Title = {{Parasite Richness and Abundance in Insular and Mainland Feral Cats: Insularity or Density?}}, Unique-Id = {{ISI:000170390500004}}, Volume = {{123}}, Year = {{2001}}, Bdsk-Url-1 = {http://dx.doi.org/10.1017/S0031182001008277}, Bdsk-Url-2 = {http://dx.doi.org/10.1017/S0031182001008277}} @article{Turnbull74, Author = {Turnbull, B.W.}, Date-Modified = {2013-03-06 21:55:28 +0100}, Journal = {{Journal of the American Statistical Association}}, Number = {{345}}, Pages = {{169-173}}, Title = {{Nonparametric Estimation of a Survivorship Function with Doubly Censored Data}}, Unique-Id = {{ISI:A1974S755300025}}, Volume = {{69}}, Year = {{1974}}, Bdsk-Url-1 = {http://dx.doi.org/10.2307/2285518}, Bdsk-Url-2 = {http://dx.doi.org/10.2307/2285518}} @article{Wang2007, title={On fast computation of the non-parametric maximum likelihood estimate of a mixing distribution}, author={Wang, Yong}, journal={Journal of the Royal Statistical Society: Series B (Statistical Methodology)}, volume={69}, number={2}, pages={185--198}, year={2007}, publisher={Wiley Online Library} } @article{Wang2008, title={Dimension-reduced nonparametric maximum likelihood computation for interval-censored data}, author={Wang, Yong}, journal={Computational Statistics \& Data Analysis}, volume={52}, number={5}, pages={2388--2402}, year={2008}, publisher={Elsevier} } @article{Wang2013, title={Efficient computation of nonparametric survival functions via a hierarchical mixture formulation}, author={Wang, Yong and Taylor, Stephen M}, journal={Statistics and Computing}, volume={23}, number={6}, pages={713--725}, year={2013}, publisher={Springer} } @article{Wang2018, title={Nonparametric maximum likelihood computation of a U-shaped hazard function}, author={Wang, Yong and Fani, Shabnam}, journal={Statistics and Computing}, volume={28}, number={1}, pages={187--200}, year={2018}, publisher={Springer} } @book{Posthuma2010, Author = {Posthuma, L. and Suter, G.W. and Traas, T.P.}, Publisher = {Taylor \& Francis}, Series = {Environmental and Ecological Risk Assessment Series}, Title = {Species Sensitivity Distributions in Ecotoxicology}, Year = {2010}} @book{Tse2009, Author = {Tse, Y.K.}, Date-Modified = {2013-05-15 16:08:20 +0200}, Edition = {1st}, Lccn = {2009520513}, Publisher = {Cambridge University Press}, Series = {International Series on Actuarial Science}, Title = {Nonlife Actuarial Models: Theory, Methods and Evaluation}, Year = {2009}} %%%%%%%%%%%%%%%%%%%%%%%%%% papers citing fitdistrplus %%%%%%%%%%%%%%%%%%%% @article{Wu2:2013, Author = {Xing Zheng Wu}, Date-Added = {2014-02-04 12:23:42 +0100}, Date-Modified = {2014-02-04 12:24:29 +0100}, Journal = {Soils and Foundations}, Number = {4}, Pages = {540 - 556}, Title = {Trivariate Analysis of Soil Ranking-Correlated Characteristics and its Application to Probabilistic Stability Assessments in Geotechnical Engineering Problems}, Volume = {53}, Year = {2013}, Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S003808061300070X}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.sandf.2013.06.006}} @mastersthesis{lebaut13, Author = {J. Le Baut}, Date-Added = {2014-02-04 12:15:16 +0100}, Date-Modified = {2014-02-04 12:19:59 +0100}, School = {Institut Universitaire Europ\'een de la mer, Universit\'e de Brest}, Title = {Evaluation d'un stock de poissons pour lequel les donn\'ees sont d\'eficientes : Application au stock de sardine (Sardina pilchardus) du golfe de Gascogne, de Manche et de mer Celtique}, Year = {2013}} @article{Zhang2013, Author = {Yu Zhang and Emad Habib and Robert J. Kuligowski and Dongsoo Kim}, Date-Added = {2014-02-04 12:12:17 +0100}, Date-Modified = {2014-02-04 12:12:35 +0100}, Journal = {Advances in Water Resources}, Pages = {133 - 145}, Title = {Joint Distribution of Multiplicative Errors in Radar and Satellite \{QPEs\} and its Use in Estimating the Conditional Exceedance Probability}, Volume = {59}, Year = {2013}, Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S030917081300105X}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.advwatres.2013.06.004}} @article{Rigaux2014, Author = {Cl{\'e}mence Rigaux and St{\'e}phane Andr{\'e} and Isabelle Albert and Fr{\'e}d{\'e}ric Carlin}, Date-Added = {2014-02-04 12:10:00 +0100}, Date-Modified = {2014-02-04 12:10:13 +0100}, Journal = {International Journal of Food Microbiology}, Pages = {119 - 128}, Title = {Quantitative Assessment of the Risk of Microbial Spoilage in Foods. Prediction of Non-Stability at 55$\,^{\circ}$C Caused by \emph{Geobacillus stearothermophilus} in Canned Green Beans}, Volume = {171}, Year = {2014}, Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S0168160513005357}, Bdsk-Url-2 = {http://dx.doi.org/10.1016/j.ijfoodmicro.2013.11.014}} @article{eiketal13, Author = {M. Eik and K. Luhmus and M. Tigasson and M. Listak and J. Puttonen and H. Herrmann}, Date-Added = {2014-02-04 12:06:14 +0100}, Date-Modified = {2014-02-04 12:07:44 +0100}, Journal = {Journal of Materials Science}, Number = {10}, Pages = {3745-3759}, Title = {{DC-Conductivity Testing Combined with Photometry for Measuring Fibre Orientations in SFRC}}, Volume = {48}, Year = {2013}} @mastersthesis{gustafssonetal13, Author = {A. Gustafsson and K. Fagerstroem}, Date-Added = {2014-02-04 12:00:47 +0100}, Date-Modified = {2014-02-04 12:02:27 +0100}, School = {Faculty of Engineering, Lund University}, Title = {Modelling Risk in Forest Insurance: Extreme Value and Frequency Analysis of Insurance Claims Due to Storm Damaged Forest}, Year = {2013}} @article{tikoleetal13, Author = {S. Tikole and V. Jaravine and V. Yu Orekhov and P. Guentert}, Date-Added = {2014-02-04 11:57:02 +0100}, Date-Modified = {2014-02-04 11:58:27 +0100}, Journal = {PloS one}, Title = {{Effects of NMR spectral resolution on protein structure calculation}}, Volume = {8}, Number = {7}, Pages = {e68567}, Year = {2013}} @unpublished{mukhopadhyay13, Author = {S. Mukhopadhyay}, Date-Added = {2014-02-04 11:54:02 +0100}, Date-Modified = {2014-02-04 11:55:14 +0100}, Note = {arXiv}, Title = {{CDfdr: A comparison density approach to local false discovery rate}}, Year = {2013}} @mastersthesis{feng13, Author = {Z. Feng}, Date-Added = {2014-02-04 11:52:24 +0100}, Date-Modified = {2014-02-04 11:53:07 +0100}, School = {Norwegian University of Science and Technology}, Title = {Markov process applied to degradation modelling: different modelling alternatives and their properties}, Year = {2013}} @phdthesis{duarte13, Author = {A.S. Ribeiro Duarte}, Date-Added = {2014-02-04 11:49:31 +0100}, Date-Modified = {2014-02-04 11:50:31 +0100}, School = {Technical University of Denmark and National Food Institute}, Title = {The interpretation of quantitative microbial data: meeting the demands of quantitative microbiological risk assessment}, Year = {2013}} @article{fiorellietal13, Author = {L.E. Fiorelli and M.D. Ezcurra and E.M. Hechenleitner and E. Arga\~{n}araz and R. Jeremias and A. Taborda and M.J. Trotteyn and M. Bel\'en von Baczko and J.B. Desojo}, Date-Added = {2014-02-04 11:45:15 +0100}, Date-Modified = {2014-02-04 11:47:47 +0100}, Journal = {Scientific Reports}, Title = {{The Oldest Known Communal Latrines Provide Evidence of Gregarism in Triassic Megaherbivores}}, Volume = {3}, Number = {3348}, Pages = {1-7}, Year = {2013}} @article{vaninsky13, Author = {A.Y. Vaninsky}, Date-Added = {2014-02-04 11:40:36 +0100}, Date-Modified = {2014-02-04 11:41:26 +0100}, Journal = {American Journal of Applied Mathematics and Statistics}, Number = {4}, Pages = {57-63}, Title = {{Stochastic DEA with a Perfect Object and Its Application to Analysis of Environmental Efficiency}}, Volume = {1}, Year = {2013}} @article{staggeetal13, Author = {Stagge, J. H. and Moglen, G. E.}, Date-Added = {2014-02-04 11:36:49 +0100}, Date-Modified = {2014-02-04 11:37:27 +0100}, Journal = {Water Resources Research}, Number = {10}, Pages = {6179-6193}, Title = {A Nonparametric Stochastic Method for Generating Daily Climate-Adjusted Streamflows}, Volume = {49}, Year = {2013}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/wrcr.20448}} @article{wu13, Author = {Xing Zheng Wu}, Date-Added = {2014-02-03 21:54:24 +0100}, Date-Modified = {2014-02-03 21:55:15 +0100}, Journal = {Computational Geosciences}, Number = {5}, Pages = {739-755}, Title = {Probabilistic Slope Stability Analysis by a Copula-Based Sampling Method}, Volume = {17}, Year = {2013}} @article{vianaetal13, Author = {Viana, D. S. and Santamar\'a, L. and Michot, T. C. and Figuerola, J.}, Date-Added = {2014-02-03 21:49:39 +0100}, Date-Modified = {2014-02-03 21:50:54 +0100}, Journal = {The American Naturalist}, Number = {5}, Pages = {649-662}, Title = {Allometric Scaling of Long-Distance Seed Dispersal by Migratory Birds}, Volume = {181}, Year = {2013}} @article{wayland13, Author = {M.T. Wayland}, Date-Added = {2014-02-03 21:46:13 +0100}, Date-Modified = {2014-02-03 21:47:06 +0100}, Journal = {Biodiversity Data Journal}, Title = {{Morphological Variation in \emph{Echinorhynchus truttae} Schrank, 1788 and the \emph{Echinorhynchus bothniensis} Zdzitowiecki \& Valtonen, 1987 species complex from freshwater fishes of northern Europe}}, Volume = {1}, Pages = {e975}, Year = {2013}} @article{westphalfitch13, Author = {Westphal-Fitch, G. and Fitch, W. T.}, Date-Added = {2014-02-03 21:42:15 +0100}, Date-Modified = {2014-02-03 21:43:23 +0100}, Journal = {PloS one}, Number = {9}, Title = {Spatial Analysis of ``Crazy Quilts'', a Class of Potentially Random Aesthetic Artefacts}, Volume = {8}, Pages = {e74055}, Year = {2013}} @article{larrasetal13, Author = {Floriane Larras and Bernard Montuelle and Agn\`es Bouchez}, Date-Added = {2014-02-03 21:34:58 +0100}, Date-Modified = {2014-02-03 21:36:20 +0100}, Journal = {Science of The Total Environment}, Pages = {469-477}, Title = {{Assessment of Toxicity Thresholds in Aquatic Environments: Does Benthic Growth of Diatoms Affect their Exposure and Sensitivity to Herbicides?}}, Volume = {463-464}, Year = {2013}} @article{Daelmanetal13, Author = {Jeff Daelman and Jeanne-Marie Membr\'e and Liesbeth Jacxsens and An Vermeulen and Frank Devlieghere and Mieke Uyttendaele}, Date-Added = {2014-02-03 21:23:53 +0100}, Date-Modified = {2014-02-03 21:29:36 +0100}, Journal = {International Journal of Food Microbiology}, Number = {3}, Pages = {433-449}, Title = {A Quantitative Microbiological Exposure Assessment Model for \emph{Bacillus cereus} in REPFEDs}, Volume = {166}, Year = {2013}} @article{voigtetal14, Author = {Christian C. Voigt and Linn S. Lehnert and Ana G. Popa-Lisseanu and Mateusz Ciechanowski and P\'eter Est\'ok and Florian Gloza-Rausch and Tam\'as Goerfoel and Matthias Goettsche and Carsten Harrje and Meike Hoetzel and Tobias Teige and Reiner Wohlgemuth and Stephanie Kramer-Schadt}, Date-Added = {2014-02-03 21:07:48 +0100}, Date-Modified = {2014-02-03 21:21:42 +0100}, Journal = {Biodiversity and Conservation}, Volume = {23}, Pages = {617-631}, Title = {{The Trans-Boundary Importance of Artificial Bat \emph{hibernacula} in Managed European Forests}}, Year = {2014}} @article{Guillier2013471, Author = {Laurent Guillier and Corinne Danan and H\'el\`ene Bergis and Marie-Laure Delignette-Muller and Sophie Granier and Sylvie Rudelle and Annie Beaufort and Anne Brisabois}, Date-Added = {2014-02-03 21:00:28 +0100}, Date-Modified = {2014-02-03 21:04:18 +0100}, Journal = {International Journal of Food Microbiology}, Number = {3}, Pages = {471 - 478}, Title = {{Use of Quantitative Microbial Risk Assessment when Investigating Foodborne Illness Outbreaks: the Example of a Monophasic \emph{Salmonella Typhimurium} 4,5,12:i:- Outbreak Implicating Beef Burgers}}, Volume = {166}, Year = {2013}} @article{satoetal13, Author = {Maria Ines Z. Sato and Ana Tereza Galvani and Jose Antonio Padula and Adelaide Cassia Nardocci and Marcelo de Souza Lauretto and Maria Tereza Pepe Razzolini and Elayse Maria Hachich}, Date-Added = {2014-02-03 19:20:58 +0100}, Date-Modified = {2014-02-03 19:22:42 +0100}, Journal = {Science of The Total Environment}, Pages = {389-396}, Title = {{Assessing the Infection Risk of \emph{Giardia} and \emph{Cryptosporidium} in Public Drinking Water Delivered by Surface Water Systems in Sao Paulo State, Brazil}}, Volume = {442}, Year = {2013}} @article{callauetal13, Author = {Callau Poduje, Ana Claudia and Belli, Aslan and Haberlandt, Uwe}, Date-Added = {2014-02-03 19:19:01 +0100}, Date-Modified = {2014-02-03 19:20:14 +0100}, Doi = {10.1080/02626667.2013.871014}, Journal = {Hydrological Sciences Journal}, Title = {Dam Risk Assessment Based on Univariate versus Bivariate Statistical Approaches - a Case Study for Argentina}, Year = {2013}} @article{meyeretal13, Author = {Meyer, W. K. and Zhang, S. and Hayakawa, S. and Imai, H. and Przeworski, M.}, Date-Added = {2014-02-03 19:15:45 +0100}, Date-Modified = {2014-02-03 19:17:29 +0100}, Journal = {American Journal of Physical Anthropology}, Number = {3}, Title = {The Convergent Evolution of Blue Iris Pigmentation in Primates Took Distinct Molecular Paths}, Volume = {151}, Pages = {398-407}, Year = {2013}} @article{prosseretal13, Author = {D.J. Prosser and L.L. Hungerford and R.M. Erwin and M.A. Ottinger and J.Y. Takekawa and E.C. Ellis}, Date-Added = {2014-02-03 19:11:30 +0100}, Date-Modified = {2014-02-03 19:12:43 +0100}, Journal = {Frontiers in Public Health}, Title = {Mapping Avian Influenza Transmission Risk at the Interface of Domestic Poultry and Wild Birds}, Volume = {1}, Number = {28}, Pages = {1-11}, Year = {2013}} @article{srinivasanetal2013, Author = {S. Srinivasan and T.P. Sorrell and J.P. Brooks and D.J. Edwards and R. Diehl McDougle}, Date-Added = {2014-02-03 19:08:28 +0100}, Date-Modified = {2014-02-03 19:09:55 +0100}, Journal = {Policing: An International Journal of Police Strategies \& Management}, Number = {4}, Pages = {702-718}, Title = {{Workforce Assessment Method for an Urban Police Department: Using Analytics to Estimate Patrol Staffing}}, Volume = {36}, Year = {2013}} @article{drakeetal2014, Author = {T. Drake and Z. Chalabi and R. Coker}, Date-Added = {2014-02-03 19:02:50 +0100}, Date-Modified = {2014-02-03 19:03:43 +0100}, Journal = {Health Policy and Planning}, Title = {{Buy Now, saved Later? The Critical Impact of Time-to-Pandemic Uncertainty on Pandemic Cost-Effectiveness Analyses}}, Doi = {10.1093/heapol/czt101}, Year = {2014}} @article{contrerasetal2013, Author = {V. De La Huerta Contreras and H. Vaquera Huerta and B.C. Arnold}, Date-Added = {2014-02-03 18:58:47 +0100}, Date-Modified = {2014-02-03 19:00:41 +0100}, Journal = {Journal of Statistical Computation and Simulation}, Doi = {10.1080/00949655.2013.825095}, Title = {A Test for Equality of Variance with Censored Samples}, Year = {2013}} @article{sosaetal2013, Author = {A. Samuel-Rosa and R. Simao Diniz Dalmolin and P. Miguel}, Date-Added = {2014-02-03 18:56:07 +0100}, Date-Modified = {2014-02-03 22:02:48 +0100}, Journal = {Revista Brasileira de Ciencia do Solo}, Pages = {422-430}, Title = {Building Predictive Models of Soil Particle-Size Distribution}, Volume = {37}, Year = {2013}} @article{simoetal13, Author = {J. Sim\'o and Francesc Casa{\~n}a and J. Sabat\'e}, Date-Added = {2014-02-03 18:46:51 +0100}, Date-Modified = {2014-02-03 18:49:34 +0100}, Journal = {Statistics and Operations Research Transactions}, Number = {1}, Title = {{Modelling ``cal\c{c}ots'' (\emph{Alium cepa L.}) Growth by Gompertz Function}}, Volume = {37}, Pages = {95-106}, Year = {2013}} @unpublished{Kingetal2013, Author = {G. Kon Kam King and P. Veber and S. Charles and M.-L. Delignette-Muller}, Date-Added = {2014-02-03 18:41:16 +0100}, Date-Modified = {2014-02-03 18:42:28 +0100}, Note = {preprint on arXiv}, Title = {{MOSAIC SSD: a New Web-Tool for the Species Sensitivity Distribution, Allowing to Include Censored Data by Maximum Likelihood}}, Year = {2013}} @article{nadarajahbakar2013, Author = {S. Nadarajah and S.A.A. Bakar}, Date-Added = {2014-02-03 18:36:31 +0100}, Date-Modified = {2014-02-03 18:37:29 +0100}, Journal = {R journal}, Number = {2}, Pages = {98-104}, Title = {{CompLognormal: An R Package for Composite Lognormal Distributions.}}, Volume = {5}, Year = {2013}} @article{mala2013publi, Author = {I. Mal\'a}, Date-Added = {2014-02-03 18:33:08 +0100}, Date-Modified = {2014-02-03 18:34:37 +0100}, Journal = {Research Journal of Economics, Business and ICT}, Number = {2}, Pages = {55-61}, Title = {The Use of Finite Mixtures of Lognormal and Gamma Distributions}, Volume = {8}, Year = {2013}} @inproceedings{mala2013, Author = {I. Mal\'a}, Booktitle = {The seventh International Days of Statistics and Economics}, Date-Added = {2014-02-03 18:29:50 +0100}, Date-Modified = {2014-02-03 18:31:12 +0100}, Title = {Finite mixtures of lognormal and gamma distributions}, Year = {2013}} @mastersthesis{rebuge12, Author = {A.J.d.S. Rebuge}, Date-Added = {2013-02-10 12:02:10 +0100}, Date-Modified = {2013-05-15 16:32:28 +0200}, School = {Universidade Tecnica de Lisboa}, Title = {Business Process Analysis in Healthcare Environments}, Year = {2012}} @mastersthesis{nordan12, Author = {R.P.V. Nordan}, Date-Added = {2013-02-10 11:55:59 +0100}, Date-Modified = {2013-05-15 16:32:52 +0200}, School = {Norwegian University of Science and Technology}, Title = {An Investigation of Potential Methods for Topology Preservation in Interactive Vector Tile Map Applications}, Year = {2012}} @article{mandletal13, Author = {J.N. Mandl and J.P. Monteiro and N. Vrisekoop and R.N. Germain}, Date-Added = {2013-02-10 11:48:03 +0100}, Date-Modified = {2013-05-15 16:31:29 +0200}, Journal = {Immunity}, Number = {{2}}, Pages = {{263-274}}, Title = {{T Cell-Positive Selection Uses Self-Ligand Binding Strength to Optimize Repertoire Recognition of Foreign Antigens}}, Volume = {{38}}, Year = {2013}} @phdthesis{bakos11, Author = {R.O. Bakos}, Date-Added = {2013-02-10 11:42:32 +0100}, Date-Modified = {2013-05-15 16:34:11 +0200}, School = {Hungarian Veterinary Archive}, Title = {Poszm\'eh Egy\"uttesek \"Osszehasonl\'it\'o Vizsg\'alata a Cser\'epfalusi f\'as Legel\'o k\"l\"onb\"oz\'o n\"ov\'enybor\'it\'as\'u ter\"uletein}, Year = {2011}} @mastersthesis{poduje12, Author = {A.C. Callau Poduje}, Date-Added = {2013-02-10 11:34:40 +0100}, Date-Modified = {2013-05-15 16:33:15 +0200}, School = {Leibniz Universitat Hannover}, Title = {{Bivariate Analysis and Synthesis of Flood Events for the Design of Hydraulic Structures -- a Case Study for Argentina}}, Year = {2012}} @mastersthesis{garcia12, Author = {P. Garcia}, Date-Added = {2013-02-10 11:29:03 +0100}, Date-Modified = {2013-05-15 16:33:24 +0200}, School = {Universit\'e de Strasbourg}, Title = {{Analyse Statistique des Pannes du R\'eseau HTA}}, Year = {2012}} @article{benavidesetal12, Author = {R. Benavides-Piccione and I. Fernaud-Espinosa and V. Robles and R. Yuste and J. DeFelipe}, Date-Added = {2013-02-10 11:23:11 +0100}, Date-Modified = {2013-05-15 16:23:55 +0200}, Number = {8}, Pages = {1798-1810}, Volume = {23}, Journal = {Cerebral Cortex}, Title = {Age-Based Comparison of Human Dendritic Spine Structure Using Complete Three-Dimensional Reconstructions}, Year = {2012}, Bdsk-Url-1 = {http://dx.doi.org/10.1093/cercor/bhs154}} @article{breitbach12, Author = {N. Breitbach and K. B\"ohning-Gaese and I. Laube and M. Schleuning}, Date-Added = {2013-02-10 11:18:03 +0100}, Date-Modified = {2013-05-15 16:24:21 +0200}, Journal = {Journal of Ecology}, Number = {6}, Pages = {1349-1358}, Title = {Short Seed-Dispersal Distances and Low Seedling Recruitment in Farmland Populations of Bird-Dispersed Cherry Trees}, Volume = {100}, Year = {2012}} @article{meheustetal12, Author = {D. M\'eheust and P. Le Cann and T. Reponen and J. Wakefield and S. Vesper}, Date-Added = {2013-02-10 11:10:54 +0100}, Date-Modified = {2013-05-15 16:24:39 +0200}, Journal = {International Journal of Hygiene and Environmental Health}, Number = {{3}}, Pages = {{333-340}}, Title = {{Possible Application of the Environmental Relative Moldiness Index in France: a Pilot Study in Brittany}}, Volume = {{216}}, Year = {2012}} @article{varoetal12, Author = {J.P. Gonz\'alez-Varo and J.V. L\'opez-Bao and J. Guiti\'an}, Date-Added = {2013-02-10 11:03:06 +0100}, Date-Modified = {2013-05-15 16:24:57 +0200}, Volume = {{82}}, Pages = {{562-571}}, Journal = {Journal of Animal Ecology}, Title = {Functional Diversity Among Seed Dispersal Kernels Generated by Carnivorous Mammals}, Year = {2012}, Bdsk-Url-1 = {http://dx.doi.org/10.1111/1365-2656.12024}} @article{telloetal12, Author = {A. Tello and B. Austin and T.C. Telfer}, Date-Added = {2013-02-10 10:57:51 +0100}, Date-Modified = {2013-05-15 16:25:16 +0200}, Journal = {Environmental Health Perspectives}, Number = {8}, Pages = {1100-1106}, Title = {Selective Pressure of Antibiotic Pollution on Bacteria of Importance to Public Health}, Volume = {120}, Year = {2012}} @article{orellanoetal12, Author = {P.W. Orellano and J.I. Reynoso and A. Grassi and A. Palmieri and O. Uez and O. Carlino}, Date-Added = {2013-02-10 10:51:38 +0100}, Date-Modified = {2013-05-15 16:25:38 +0200}, Journal = {Iranian Journal of Public Health}, Number = {12}, Pages = {26-29}, Title = {{Estimation of the Serial Interval for Pandemic Influenza (pH1N1) in the Most Southern Province of Argentina}}, Volume = {41}, Year = {2012}} @unpublished{pouillotetal11, Author = {R. Pouillot and M.L. Delignette-Muller and M. Cornu}, Date-Added = {2013-02-10 09:42:22 +0100}, Date-Modified = {2013-05-15 16:49:50 +0200}, Title = {{Case study: \emph{L. monocytogenes} in Cold-Smoked Salmon}}, Url = {http://CRAN.R-project.org/web/packages/mc2d/vignettes/mc2dLmEnglish.pdf}, Year = {2011}, Bdsk-Url-1 = {http://cran.r-project.org/web/packages/mc2d/vignettes/mc2dLmEnglish.pdf}} @article{luangkesornetal12, Author = {K.L. Luangkesorn and B.A. Norman and Y. Zhuang and M. Falbo and J. Sysko}, Date-Added = {2013-02-10 09:29:42 +0100}, Date-Modified = {2013-05-15 16:25:55 +0200}, Journal = {Interfaces}, Number = {4}, Pages = {406-409}, Title = {{Practice Summaries: Designing Disease Prevention and Screening Centers in Abu Dhabi}}, Volume = {42}, Year = {2012}} @article{tarnczi11, Author = {T. Tarnczi and V. Fenyves and Z. Bcs}, Date-Added = {2013-02-10 09:26:15 +0100}, Date-Modified = {2013-05-15 16:22:41 +0200}, Journal = {International Journal of Management Cases}, Number = {3}, Pages = {159-167}, Title = {The Business Uncertainty and Variability Management with Real Options Models Combined two Dimensional Simulation}, Volume = {13}, Year = {2011}} @article{suuronenetal12, Author = {J.P. Suuronen and A. Kallonen and M. Eik and J. Puttonen and Ritva Serimaa and Heiko Herrmann}, Date-Modified = {2013-05-15 16:26:28 +0200}, Journal = {Journal of Materials Science}, Number = {3}, Pages = {1358--1367}, Title = {Analysis of Short Fibres Orientation in Steel Fibre-Reinforced Concrete (SFRC) by X-ray Tomography}, Volume = {48}, Year = {2012}} @article{scholletal12, Author = {C.F. Scholl and C.C. Nice and J.A. Fordyce and Z. Gompert and M.L. Forister}, Date-Added = {2012-11-07 22:56:30 +0100}, Date-Modified = {2013-05-15 16:26:46 +0200}, Journal = {International Journal of Ecology}, Title = {Larval Performance in the Context of Ecological Diversification and Speciation in Lycaeides Butterflies}, Number = {ID 242154}, Pages = {1-13}, Volume = {2012}, Year = {2012}, Bdsk-Url-1 = {http://dx.doi.org/10.1155/2012/242154}} @article{saketal11, Author = {H. Sak and C. Haksoz}, Date-Added = {2012-11-07 22:53:37 +0100}, Date-Modified = {2013-05-15 16:22:57 +0200}, Journal = {Journal of Operational Risk}, Number = {3}, Pages = {15-38}, Title = {A Copula-based Simulation Model for Supply Portfolio Risk}, Volume = {6}, Year = {2011}} @mastersthesis{rosa12, Author = {A. S. Rosa}, Date-Added = {2012-11-07 22:44:37 +0100}, Date-Modified = {2013-05-15 16:33:40 +0200}, School = {Universidade Federal de Santa Maria}, Title = {Fun\c{c}\~{o}es de Predi\c{c}\~{a}o Espacial de Propriedades do Solo}, Year = {2012}} @article{poulliotetal12, Author = {R. Pouillot and K. Hoelzer and Y. Chen and S. Dennis}, Date-Added = {2012-11-07 22:41:36 +0100}, Date-Modified = {2013-05-15 16:27:28 +0200}, Journal = {Food Control}, Keywords = {cited in page 7 for MLE censored fit}, Number = {2}, Pages = {350-357}, Title = {{Estimating Probability Distributions of Bacterial Concentrations in Food Based on Data Generated Using the Most Probable Number (MPN) Method for Use in Risk Assessment}}, Volume = {29}, Year = {2012}} @article{marquetouxetal12, Author = {N. Marquetoux and M. Paul and S. Wongnarkpet and C. Poolkhet and W. Thanapongtham and F. Roger and C. Ducrot and K. Chalvet-Monfray}, Date-Added = {2012-11-07 22:37:48 +0100}, Date-Modified = {2013-05-15 16:27:56 +0200}, Journal = {Preventive Veterinary Medicine}, Number = {2}, Pages = {143-151}, Title = {{Estimating Spatial and Temporal Variations of the Reproduction Number for Highly Pathogenic Avian Influenza H5N1 Epidemic in Thailand}}, Volume = {106}, Year = {2012}} @article{lehaetal11, Author = {A. Leha and T. Beissbarth and K. Jung}, Date-Added = {2012-11-07 22:34:24 +0100}, Date-Modified = {2013-05-15 16:23:17 +0200}, Journal = {BMC Bioinformatics}, Number = {127}, Pages = {1-14}, Title = {{Sequential Interim Analyses of Survival Data in {DNA} Microarray Experiments}}, Volume = {12}, Year = {2011}} @article{kochetal12, Author = {F.H. Koch and D. Yemshanov and R.D. Magarey and W.D. Smith}, Date-Added = {2012-11-07 22:28:27 +0100}, Date-Modified = {2013-03-06 21:49:35 +0100}, Journal = {Journal of Economic Entomology}, Number = {2}, Pages = {438-450}, Title = {Dispersal of Invasive Forest Insects via Recreational Firewood: a Quantitative Analysis}, Volume = {105}, Year = {2012}} @article{hoelzeretal12, Author = {K. Hoelzer and R. Pouillot and D. Gallagher and M.B. Silverman and J. Kause and S. Dennis}, Date-Added = {2012-11-07 22:19:27 +0100}, Date-Modified = {2013-05-15 16:28:30 +0200}, Journal = {International Journal of Food Microbiology}, Number = {2}, Pages = {267-277}, Title = {{Estimation of \emph{Listeria Monocytogenes} Transfer Coefficients and Efficacy of Bacterial Removal Through Cleaning and Sanitation}}, Volume = {157}, Year = {2012}} @article{jongenburgeretal12, Author = {I. Jongenburger and M.W. Reij and E.P.J. Boer and M.H. Zwietering and L.G.M. Gorris}, Date-Added = {2012-11-07 22:16:14 +0100}, Date-Modified = {2013-05-15 16:28:56 +0200}, Journal = {International Journal of Food Microbiology}, Number = {1}, Pages = {35-44}, Title = {Modelling Homogeneous and Heterogeneous Microbial Contaminations in a Powdered Food Product}, Volume = {157}, Year = {2012}} @article{jaloustreetal11, Author = {S. Jaloustre and M. Cornu and E. Morelli and V. Noel and M.L. Delignette-Muller}, Date-Added = {2012-11-07 22:11:48 +0100}, Date-Modified = {2013-05-15 16:23:33 +0200}, Journal = {Food microbiology}, Number = {2}, Pages = {311-320}, Title = {{Bayesian Modeling of \emph{Clostridium perfringens} Growth in Beef-in-Sauce Products}}, Volume = {28}, Year = {2011}} @article{fusteinercostafreda12, Author = {C.H.Y. Fu and H. Steiner and S.G. Costafreda}, Date-Added = {2012-11-07 22:05:23 +0100}, Date-Modified = {2013-05-15 16:29:33 +0200}, Journal = {Neurobiology of Disease}, Pages = {75-83}, Title = {Predictive Neural Biomarkers of Clinical Response in Depression: A Meta-Analysis of Functional and Structural Neuroimaging Studies of Pharmacological and Psychological Therapies}, Volume = {52}, Year = {2012}} @article{eling12, Author = {M. Eling}, Date-Added = {2012-10-08 23:04:08 +0200}, Date-Modified = {2013-05-15 16:29:53 +0200}, Journal = {Insurance: Mathematics and Economics}, Number = {2}, Pages = {239-248}, Title = {{Fitting Insurance Claims to Skewed Distributions: Are the Skew-normal and the Skew-student Good Models?}}, Volume = {51}, Year = {2012}} @inproceedings{eikhermann12, Author = {M. Eik and H. Herrmann}, Booktitle = {the Estonian Academy of Sciences}, Date-Added = {2012-10-08 23:00:46 +0200}, Date-Modified = {2013-05-15 16:31:55 +0200}, Number = {2}, Pages = {128-136}, Title = {Raytraced Images for Testing the Reconstruction of Fibre Orientation Distributions}, Volume = {61}, Year = {2012}} @article{croucheretal12, Author = {N. J. Croucher and S. R. Harris and L. Barquist and J. Parkhill and S. D. Bentley}, Date-Added = {2012-10-08 22:56:37 +0200}, Date-Modified = {2013-03-06 21:51:01 +0100}, Journal = {PLoS Pathogens}, Number = {6}, Pages = {e1002745}, Title = {A High-Resolution View of Genome-Wide Pneumococcal Transformation}, Volume = {8}, Year = {2012}} @article{commeauetal12, Author = {N. Commeau and E. Parent and M.-L. Delignette-Muller and M. Cornu}, Date-Added = {2012-10-08 22:53:49 +0200}, Date-Modified = {2013-05-15 16:30:14 +0200}, Journal = {International Journal of Food Microbiology}, Pages = {146-152}, Title = {Fitting a Lognormal Distribution to Enumeration and Absence/Presence Data}, Volume = {155}, Year = {2012}} @article{busschaertetal10, Author = {P. Busschaert and A.H. Geeraerd and M. Uyttendaele and J.F. VanImpe}, Date-Added = {2012-10-08 22:48:29 +0200}, Date-Modified = {2013-05-15 16:22:08 +0200}, Journal = {International Journal of Food Microbiology}, Pages = {260-269}, Title = {Estimating Distributions out of Qualitative and (Semi)Quantitative Microbiological Contamination Data for Use in Risk Assessment}, Volume = {138}, Year = {2010}} @inproceedings{brooksetal11, Author = {J.P. Brooks and D.J. Edwards and T.P. Sorrell and S. Srinivasan and R.L. Diehl}, Booktitle = {the 2011 Winter Simulation Conference}, Date-Added = {2012-10-08 22:43:23 +0200}, Date-Modified = {2013-03-06 21:51:21 +0100}, Pages = {1770-1777}, Title = {Simulating Calls for Service for an Urban Police Department}, Year = {2011}} @article{bagariaetal12, Author = {A. Bagaria and V. Jaravine and Y.J. Huang and G.T. Montelione and P. G\"untert}, Date-Added = {2012-10-08 22:39:34 +0200}, Date-Modified = {2013-05-15 16:30:38 +0200}, Journal = {Protein Science}, Number = {2}, Pages = {229-238}, Title = {Protein Structure Validation by Generalized Linear Model Root-Mean-Square Deviation Prediction}, Volume = {21}, Year = {2012}} @article{anandetal12, Author = {P. Anand and K. Yeturu and N. Chandra}, Date-Added = {2012-10-08 22:27:41 +0200}, Date-Modified = {2013-05-15 16:30:52 +0200}, Journal = {Nucleic Acids Research}, Pages = {1-9}, Title = {PocketAnnotate: Towards Site-Based Function Annotation}, Volume = {40}, Year = {2012}} @mastersthesis{aktassjostrand11, Author = {\"O. Akta\c{s} and M. Sj\"ostrand}, Date-Added = {2012-10-08 22:22:14 +0200}, Date-Modified = {2013-05-15 16:32:16 +0200}, Rating = {5}, School = {School of Information Science, Computer and Electrical Engineering, Halmstad University}, Title = {Cornish-Fisher Expansion and Value-at-Risk Method in Application to Risk Management of Large Portfolios}, Year = {2011}} fitdistrplus/R/0000755000176200001440000000000014102244224013202 5ustar liggesusersfitdistrplus/R/util-checkparamlist.R0000644000176200001440000000535413767050553017321 0ustar liggesusers# checkparam function checks start.arg and fix.arg that parameters are named correctly # INPUTS # start.arg : a named list # fix.arg : NULL or a named list # argdistname : argument names of the distribution # hasnodefaultval : vector of logical indicating no default value of argument # OUTPUTS # a named list with components: ok (TRUE or FALSE), txt (NULL or the error message), # start.arg : a named list of starting values for optimization # or a function to compute them from data checkparamlist <- function(start.arg, fix.arg, argdistname, hasnodefaultval) { errtxt <- list(t3="'start' must specify names which are arguments to 'distr'.", t4="'fix.arg' must specify names which are arguments to 'distr'.", t5="A distribution parameter cannot be specified both in 'start' and 'fix.arg'.", t6="'start' should not have NA or NaN values.", t7="'fix.arg' should not have NA or NaN values.", t8="Some parameter names have no starting/fixed value: ", t9="Some parameter names have no starting/fixed value but have a default value: ") vstart <- unlist(start.arg) #check unexpected names m <- match(names(vstart), argdistname) if (any(is.na(m))) stop(errtxt$t3) #check NA/NaN values if(any(is.na(vstart)) || any(is.nan(vstart))) stop(errtxt$t6) if(!is.null(fix.arg)) { vfix <- unlist(fix.arg) #check unexpected names mfix <- match(names(vfix), argdistname) if (any(is.na(mfix))) stop(errtxt$t4) # check that some parameters are not both in fix.arg and start minter <- match(names(vstart), names(vfix)) if (any(!is.na(minter))) stop(errtxt$t5) #check NA/NaN values if(any(is.na(vfix)) || any(is.nan(vfix))) stop(errtxt$t7) allparname <- names(c(vstart, vfix)) }else allparname <- names(vstart) theoparam <- computegetparam(argdistname) #special case where both scale and rate are allowed, see ?dgamma if("scale" %in% theoparam && "rate" %in% theoparam) { errt8 <- any(!allparname %in% theoparam) || length(allparname) != length(theoparam)-1 #special case where both prob and mu are allowed, see ?dnbinom }else if(length(theoparam) == 3 && all(c("size", "prob", "mu") %in% theoparam)) { errt8 <- any(!allparname %in% theoparam) || length(allparname) != length(theoparam)-1 }else errt8 <- any(!theoparam %in% allparname) #only make a warning if unset arguments have a default value if(errt8) { unsetarg <- theoparam[!theoparam %in% allparname] if(any(hasnodefaultval[unsetarg])) stop(paste0(errtxt$t8, paste(unsetarg, collapse = ", "), ".")) else warning(paste0(errtxt$t9, paste(unsetarg, collapse = ", "), ".")) } list("start.arg"=start.arg, "fix.arg"=fix.arg) }fitdistrplus/R/cdfcompcens.R0000644000176200001440000003545613742313702015635 0ustar liggesusers############################################################################# # Copyright (c) 2011 Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot cumulative distribution functions for various fits ### of continuous distribution(s) (fitdist results) ### on a same dataset ### ### R functions ### cdfcompcens <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datacol, fillrect, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, lines01 = FALSE,Turnbull.confint = FALSE, NPMLE.method = "Wang", add = FALSE, plotstyle = "graphics", ...) { if(inherits(ft, "fitdistcens")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdistcens' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdistcens")))) stop("argument ft must be a list of 'fitdistcens' objects") } NPMLE.method <- match.arg(NPMLE.method, c("Wang", "Turnbull.intervals", "Turnbull.middlepoints", "Turnbull")) if (NPMLE.method == "Turnbull") { warning("Turnbull is now a deprecated option for NPMLE.method. You should use Turnbull.middlepoints of Turnbull.intervals. It was here fixed as Turnbull.middlepoints, equivalent to former Turnbull.") NPMLE.method <- "Turnbull.middlepoints" } if ((Turnbull.confint == TRUE) & ((NPMLE.method == "Wang") | (NPMLE.method == "Turnbull.intervals"))) { warning("When Turnbull.confint is TRUE NPMLE.method is forced to Turnbull.middlepoints." ) NPMLE.method <- "Turnbull.middlepoints" } # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) if ((plotstyle == "ggplot") & (NPMLE.method == "Turnbull.middlepoints")) { warning("When NPMLE.method is Turnbull.middlepoints, plotstyle is forced to graphics." ) plotstyle <- "graphics" } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("cdfcompcens is not yet available when using weights") nft <- length(ft) if (missing(datacol)) datacol <- "black" if (missing(fillrect)) fillrect <- "lightgrey" if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitlty)) fitlty <- 1:nft if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitlty <- rep(fitlty, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) if (missing(xlab)) xlab <- ifelse(xlogscale, "censored data in log scale", "censored data") if (missing(ylab)) ylab <- "CDF" if (missing(main)) main <- paste("Empirical and theoretical CDFs") censdata <- ft[[1]]$censdata logxy <- paste(ifelse(xlogscale, "x", ""), ifelse(ylogscale, "y", ""), sep="") verif.ftidata <- function(fti) { if (any(fti$censdata$left != censdata$left, na.rm=TRUE) | any(fti$censdata$right != censdata$right, na.rm=TRUE)) stop("All compared fits must have been obtained with the same dataset") } l <- lapply( ft, verif.ftidata) rm(l) # calculations for Wang method, for both graphics and ggplot displays if ((NPMLE.method == "Wang") | (NPMLE.method == "Turnbull.intervals")) { f <- npmle(censdata, method = NPMLE.method) bounds <- c(f$right, f$left) finitebounds <- bounds[is.finite(bounds)] upper <- max(finitebounds) lower <- min(finitebounds) width <- upper - lower if(missing(xlim)) { if (xlogscale == TRUE) { xmin <- lower * (upper / lower)^(-0.1) xmax <- upper * (upper / lower)^0.1 } else { xmin <- lower - width * 0.1 xmax <- upper + width * 0.1 } xlim <- c(xmin, xmax) } else { xmin <- xlim[1] xmax <- xlim[2] } if(missing(ylim)) { ylim <- c(0,1) } if ((xlogscale == TRUE) & xmin <= 0) stop("log transformation of data requires only positive values") if (xlogscale == TRUE) { xmininf <- lower * (upper / lower)^(-10) # 10 to be very large xmaxinf <- upper * (upper / lower)^10 } else { xmininf <- lower - width * 10 xmaxinf <- upper + width * 10 } k <- length(f$left) Fnpsurv <- cumsum(f$p) ## calculation of points for Q and P in graphs Fbefore <- c(0, Fnpsurv[-k]) df <- data.frame(left = f$left, right = f$right) # Definition of vertices of each rectangle Qi.left <- df$left # dim k Qi.left4plot <- Qi.left if (is.infinite(Qi.left4plot[1]) | is.nan(Qi.left4plot[1])) Qi.left4plot[1] <- xmininf Qi.right <- df$right Qi.right4plot <- Qi.right if (is.infinite(Qi.right4plot[k]) | is.nan(Qi.right4plot[k])) Qi.right4plot[k] <- xmaxinf # keep only 16 significants digits for R configured with noLD (--disable-long-double) Pi.low <- signif(Fbefore, 16) Pi.up <- signif(Fnpsurv, 16) # the line at right of the rectangles dright <- c(f$left[1], rep(f$right, rep(2,k)), f$right[k]) Fright <- rep(c(0,Fnpsurv), rep(2,k+1)) # the line at left of the rectangles dleft <- rep(c(f$left,f$right[k]), rep(2,k+1)) Fleft <- c(0,rep(Fnpsurv, rep(2,k)),1) } # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## if (NPMLE.method == "Turnbull.middlepoints") # Turnbull plot { if(missing(xlim)) { xmin <- min(c(censdata$left, censdata$right), na.rm=TRUE) xmax <- max(c(censdata$left, censdata$right), na.rm=TRUE) xlim <- c(xmin, xmax) } else { xmin <- xlim[1] xmax <- xlim[2] } if ((xlogscale == TRUE) & xmin <= 0) stop("log transformation of data requires only positive values") # plot of data (ecdf) using Turnbull algorithm survdata <- Surv(time = censdata$left, time2 = censdata$right, type="interval2") survfitted <- survfit(survdata ~ 1) #main plotting if(missing(ylim)) { if (Turnbull.confint) { if (!add) plot(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, xlim = xlim, ...) else lines(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, xlim = xlim, ...) }else { if (!add) plot(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, conf.int = FALSE, xlim = xlim, ...) else lines(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, conf.int = FALSE, xlim = xlim, ...) } } else { if (Turnbull.confint) { if (!add) plot(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, xlim = xlim, ylim=ylim, ...) else lines(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, xlim = xlim, ylim=ylim, ...) } else { if (!add) plot(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, conf.int = FALSE, xlim = xlim, ylim = ylim, ...) else lines(survfitted, fun="event", xlab=xlab, ylab=ylab, main=main, log=logxy, col=datacol, conf.int = FALSE, xlim = xlim, ylim = ylim, ...) } } } else # if NPMLE.method == "Wang" # Wang plot { # Plot of the ECDF if (!add) plot(1, 1, type = "n", xlab=xlab, ylab=ylab, main=main, log = logxy, xlim = xlim, ylim = ylim, ...) # the line at right of the rectangles lines(dright, Fright, col = datacol) # the line at left of the rectangles lines(dleft, Fleft, col = datacol) # Add of the filled rectangles # ca donne un rendu bizarre - plutot ajouter un argument fill.datacol # rgbdatacol <- col2rgb(datacol) # lightdatacol <- rgb(rgbdatacol[1], rgbdatacol[2], rgbdatacol[3], maxColorValue = 255, # alpha = 10) for(i in 1:k) { rect(xleft = Qi.left4plot, ybottom = Pi.low, xright = Qi.right4plot, ytop = Pi.up, border = datacol, col = fillrect) } } ################## plot of each fitted distribution plot.fti <- function(i, ...) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname pdistname <- paste("p", distname, sep="") if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) warning(" Be careful, variables are considered continuous in this function!") if (xlogscale == TRUE) { sfin <- 10^seq(log10(xmin), log10(xmax), by=(log10(xmax)-log10(xmin))/100) } else { sfin <- seq(xmin, xmax, by=(xmax-xmin)/100) } theopfin <- do.call(pdistname, c(list(sfin), as.list(para))) lines(sfin, theopfin, lty=fitlty[i], col=fitcol[i], lwd=fitlwd[i], ...) } s <- sapply(1:nft, plot.fti, ...) rm(s) if(lines01) abline(h=c(0, 1), lty="dashed", col="grey") if (addlegend) { legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, lty=fitlty, col=fitcol, lwd=fitlwd, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## if ((NPMLE.method == "Wang") | (NPMLE.method == "Turnbull.intervals")) { # recode the legend position according to available positions in ggplot2 if(xlegend %in% c("topleft", "bottomleft")) xlegend <- "left" if(xlegend %in% c("topright", "bottomright")) xlegend <- "right" if(xlegend == "center") xlegend <- "right" # the line at right of the rectangles dsegmright <- cbind(dright, Fright)[2:9,] dsegmright <- cbind(dsegmright[-8, ], dsegmright[-1,]) dsegmright <- as.data.frame(dsegmright) colnames(dsegmright) <- c("x1", "y1", "x2", "y2") # the line at left of the rectangles dsegmleft <- cbind(dleft, Fleft)[2:9,] dsegmleft <- cbind(dsegmleft[-8, ], dsegmleft[-1,]) dsegmleft <- as.data.frame(dsegmleft) colnames(dsegmleft) <- c("x1", "y1", "x2", "y2") drect <- data.frame(x1=Qi.left4plot, x2=Qi.right4plot, y1=Pi.low, y2=Pi.up) if (xlogscale == TRUE) { sfin <- rep(10^seq(log10(xmin), log10(xmax), by=(log10(xmax)-log10(xmin))/100), times = nft) } else { sfin <- rep(seq(xmin, xmax, by=(xmax-xmin)/100), times = nft) } theopfin <- vector(mode = "numeric", length = length(sfin)) ind <- vector(mode = "character", length = length(sfin)) len <- length(sfin) / nft for(i in 1:nft) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) warning(" Be careful, variables are considered continuous in this function!") pdistname <- paste("p", distname, sep="") theopfin[((i - 1) * len + 1):(i * len)] <- do.call(pdistname, c(list(sfin[((i - 1) * len + 1):(i * len)]), as.list(para))) ind[((i - 1) * len + 1):(i * len)] <- distname } dline <- data.frame(x = sfin, y = theopfin, ind = ind) dline$ind <- factor(dline$ind, levels = unique(dline$ind)) # reorder levels in the appearance order of the input ggcdfcompcens <- ggplot2::ggplot() + ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + ggplot2::ggtitle(main) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + {if(lines01) ggplot2::geom_hline(ggplot2::aes(yintercept=0), color="grey", linetype="dashed")} + {if(lines01) ggplot2::geom_hline(ggplot2::aes(yintercept=1), color="grey", linetype="dashed")} + ggplot2::geom_rect(data=drect, mapping=ggplot2::aes_(xmin=quote(x1), xmax=quote(x2), ymin=quote(y1), ymax=quote(y2)), colour = datacol, fill = fillrect, alpha=0.5) + ggplot2::geom_segment(data=dsegmright, mapping=ggplot2::aes_(x=quote(x1), y=quote(y1), xend=quote(x2), yend=quote(y2)), colour = datacol) + ggplot2::geom_segment(data=dsegmleft, mapping=ggplot2::aes_(x=quote(x1), y=quote(y1), xend=quote(x2), yend=quote(y2)), colour = datacol) + ggplot2::geom_line(data=dline, ggplot2::aes_(quote(x), quote(y), group = quote(ind), colour = quote(ind), linetype = quote(ind), size = quote(ind))) + ggplot2::theme_bw() + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend), plot.title = ggplot2::element_text(hjust = 0.5)) else ggplot2::theme(legend.position = "none", plot.title = ggplot2::element_text(hjust = 0.5))} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitlty, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} return(ggcdfcompcens) } } } fitdistrplus/R/mledist.R0000644000176200001440000004623513742313702015007 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### maximum likelihood estimation for censored or non-censored data ### ### R functions ### ### many ideas are taken from the fitdistr function of the MASS package and ### the mle function of the stat package. mledist <- function (data, distr, start=NULL, fix.arg=NULL, optim.method="default", lower=-Inf, upper=Inf, custom.optim=NULL, weights=NULL, silent=TRUE, gradient=NULL, checkstartfix=FALSE, ...) # data may correspond to a vector for non censored data or to # a dataframe of two columns named left and right for censored data { if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr ddistname <- paste("d", distname, sep="") argddistname <- names(formals(ddistname)) if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) if(is.null(custom.optim)) optim.method <- match.arg(optim.method, c("default", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent")) start.arg <- start #to avoid confusion with the start() function of stats pkg (check is done lines 87-100) if(is.vector(start.arg)) #backward compatibility start.arg <- as.list(start.arg) txt1 <- "data must be a numeric vector of length greater than 1 for non censored data" txt2 <- "or a dataframe with two columns named left and right and more than one line for censored data" if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of integers greater than 0") if(!is.allint.w(weights)) stop("weights should be a vector of (strictly) positive integers") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") warning("weights are not taken into account in the default initial values") } if (is.vector(data)) { cens <- FALSE if (!(is.numeric(data) & length(data)>1)) stop(paste(txt1, txt2)) } else { cens <- TRUE censdata <- data if (!(is.vector(censdata$left) & is.vector(censdata$right) & length(censdata[, 1])>1)) stop(paste(txt1, txt2)) pdistname<-paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined to apply maximum likelihood to censored data")) } if (cens) { #format data for calculation of starting values and fitting process dataformat <- cens2pseudo(censdata) data <- dataformat$pseudo rcens <- dataformat$rcens; lcens <- dataformat$lcens icens <- dataformat$icens; ncens <- dataformat$ncens irow <- cens2idxrow(censdata) irow.rcens <- irow$rcens; irow.lcens <- irow$lcens irow.icens <- irow$icens; irow.ncens <- irow$ncens } if(!checkstartfix) #pre-check has not been done by fitdist() or bootdist() { # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #set fix.arg.fun if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL }else #pre-check has been done by fitdist() or bootdist() { arg_startfix <- list(start.arg=start, fix.arg=fix.arg) fix.arg.fun <- NULL } #unlist starting values as needed in optim() vstart <- unlist(arg_startfix$start.arg) #sanity check if(is.null(vstart)) stop("Starting values could not be NULL with checkstartfix=TRUE") #erase user value #(cannot coerce to vector as there might be different modes: numeric, character...) fix.arg <- arg_startfix$fix.arg ############# closed-form formula for uniform distribution ########## if(distname == "unif") { if(length(fix.arg) >= 2) { stop("'fix.arg' sets all distribution parameters without any parameter to estimate.") }else if(length(fix.arg) == 1) { if(names(fix.arg) == "min") par <- c(max=max(data)) else if(names(fix.arg) == "max") par <- c(min=min(data)) else stop("'fix.arg' must specify names which are arguments to 'distr'.") }else par <- c(min=min(data), max=max(data)) myarg <- c(list(data), as.list(par), as.list(fix.arg)) loglikval <- sum(log(do.call(dunif, myarg))) res <- list(estimate = par[!names(par) %in% names(fix.arg)], convergence = 0, loglik = loglikval, meth = "closed formula", hessian = NA, optim.function= NA, fix.arg = fix.arg) return(res) } ############# MLE fit using optim or custom.optim ########## # definition of the function to minimize : - log likelihood # for non censored data if (!cens && is.null(weights)) { # the argument names are: # - par for parameters (like in optim function) # - fix.arg for optional fixed parameters # - obs for observations (previously dat but conflicts with genoud data.type.int argument) # - ddistnam for distribution name if ("log" %in% argddistname){ fnobj <- function(par, fix.arg, obs, ddistnam){ -sum(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg), log=TRUE) ) ) } } else{ fnobj <- function(par, fix.arg, obs, ddistnam) { -sum(log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } } } else if(cens && is.null(weights)) #censored data { argpdistname<-names(formals(pdistname)) if (("log" %in% argddistname) & ("log.p" %in% argpdistname)) fnobjcens <- function(par, fix.arg, rcens, lcens, icens, ncens, ddistnam, pdistnam) -sum(do.call(ddistnam, c(list(ncens), as.list(par), as.list(fix.arg), list(log=TRUE)))) - sum(do.call(pdistnam, c(list(lcens), as.list(par), as.list(fix.arg), list(log=TRUE)))) - sum(do.call(pdistnam, c(list(rcens), as.list(par), as.list(fix.arg), list(lower.tail=FALSE), list(log=TRUE)))) - sum(log(do.call(pdistnam, c(list(icens$right), as.list(par), as.list(fix.arg))) - # without log=TRUE here do.call(pdistnam, c(list(icens$left), as.list(par), as.list(fix.arg))) )) # without log=TRUE here else fnobjcens <- function(par, fix.arg, rcens, lcens, icens, ncens, ddistnam, pdistnam) -sum(log(do.call(ddistnam, c(list(ncens), as.list(par), as.list(fix.arg))))) - sum(log(do.call(pdistnam, c(list(lcens), as.list(par), as.list(fix.arg))))) - sum(log(1-do.call(pdistnam, c(list(rcens), as.list(par), as.list(fix.arg))))) - sum(log(do.call(pdistnam, c(list(icens$right), as.list(par), as.list(fix.arg))) - do.call(pdistnam, c(list(icens$left), as.list(par), as.list(fix.arg))) )) }else if(!cens && !is.null(weights)) { fnobj <- function(par, fix.arg, obs, ddistnam) { -sum(weights * log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } }else if(cens && !is.null(weights)) { fnobjcens <- function(par, fix.arg, rcens, lcens, icens, ncens, ddistnam, pdistnam) { p1 <- log(do.call(ddistnam, c(list(ncens), as.list(par), as.list(fix.arg)))) p2 <- log(do.call(pdistnam, c(list(lcens), as.list(par), as.list(fix.arg)))) p3 <- log(1-do.call(pdistnam, c(list(rcens), as.list(par), as.list(fix.arg)))) p4 <- log(do.call(pdistnam, c(list(icens$right), as.list(par), as.list(fix.arg))) - do.call(pdistnam, c(list(icens$left), as.list(par), as.list(fix.arg))) ) -sum(weights[irow.ncens] * p1) - sum(weights[irow.lcens] * p2) - sum(weights[irow.rcens] * p3) - sum(weights[irow.icens] * p4) } } #get warning value owarn <- getOption("warn") # Try to minimize the minus (log-)likelihood using the base R optim function if(is.null(custom.optim)) { hasbound <- any(is.finite(lower) | is.finite(upper)) # Choice of the optimization method if (optim.method == "default") { meth <- ifelse(length(vstart) > 1, "Nelder-Mead", "BFGS") }else meth <- optim.method if(meth == "BFGS" && hasbound && is.null(gradient)) { meth <- "L-BFGS-B" txt1 <- "The BFGS method cannot be used with bounds without provided the gradient." txt2 <- "The method is changed to L-BFGS-B." warning(paste(txt1, txt2)) } options(warn=ifelse(silent, -1, 0)) #select optim or constrOptim if(hasbound) #finite bounds are provided { if(!is.null(gradient)) { opt.fun <- "constrOptim" }else #gradient == NULL { if(meth == "Nelder-Mead") opt.fun <- "constrOptim" else if(meth %in% c("L-BFGS-B", "Brent")) opt.fun <- "optim" else { txt1 <- paste("The method", meth, "cannot be used by constrOptim() nor optim() without gradient and bounds.") txt2 <- "Only optimization methods L-BFGS-B, Brent and Nelder-Mead can be used in such case." stop(paste(txt1, txt2)) } } if(opt.fun == "constrOptim") { #recycle parameters npar <- length(vstart) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) # constraints are : Mat %*% theta >= Bnd, i.e. # +1 * theta[i] >= lower[i]; # -1 * theta[i] >= -upper[i] #select rows from the identity matrix haslow <- is.finite(lower) Mat <- diag(npar)[haslow, ] #select rows from the opposite of the identity matrix hasupp <- is.finite(upper) Mat <- rbind(Mat, -diag(npar)[hasupp, ]) colnames(Mat) <- names(vstart) rownames(Mat) <- paste0("constr", 1:NROW(Mat)) #select the bounds Bnd <- c(lower[is.finite(lower)], -upper[is.finite(upper)]) names(Bnd) <- paste0("constr", 1:length(Bnd)) initconstr <- Mat %*% vstart - Bnd if(any(initconstr < 0)) stop("Starting values must be in the feasible region.") if(!cens) { opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobj, ui=Mat, ci=Bnd, grad=gradient, fix.arg=fix.arg, obs=data, ddistnam=ddistname, hessian=!is.null(gradient), method=meth, ...), silent=TRUE) } else #cens == TRUE opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobjcens, ui=Mat, ci=Bnd, grad=gradient, ddistnam=ddistname, rcens=rcens, lcens=lcens, icens=icens, ncens=ncens, pdistnam=pdistname, fix.arg=fix.arg, hessian=!is.null(gradient), method=meth, ...), silent=TRUE) if(!inherits(opttryerror, "try-error")) if(length(opt$counts) == 1) #appears when the initial point is a solution opt$counts <- c(opt$counts, NA) }else #opt.fun == "optim" { if(!cens) opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, ddistnam=ddistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) else #cens == TRUE opttryerror <- try(opt <- optim(par=vstart, fn=fnobjcens, fix.arg=fix.arg, gr=gradient, rcens=rcens, lcens=lcens, icens=icens, ncens=ncens, ddistnam=ddistname, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } }else #hasbound == FALSE { opt.fun <- "optim" if(!cens) opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, ddistnam=ddistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) else #cens == TRUE opttryerror <- try(opt <- optim(par=vstart, fn=fnobjcens, fix.arg=fix.arg, gr=gradient, rcens=rcens, lcens=lcens, icens=icens, ncens=ncens, ddistnam=ddistname, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } options(warn=owarn) if (inherits(opttryerror, "try-error")) { warnings("The function optim encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA, length(vstart)), convergence = 100, loglik = NA, hessian = NA, optim.function=opt.fun, fix.arg = fix.arg, optim.method=meth, fix.arg.fun = fix.arg.fun, counts=c(NA, NA))) } if (opt$convergence>0) { warnings("The function optim failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) res <- list(estimate = opt$par, convergence = opt$convergence, value=opt$value, hessian = opt$hessian, optim.function=opt.fun, optim.method=meth, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights = weights, counts=opt$counts, optim.message=opt$message, loglik = -opt$value) } else # Try to minimize the minus (log-)likelihood using a user-supplied optim function { options(warn=ifelse(silent, -1, 0)) if (!cens) opttryerror <- try(opt <- custom.optim(fn=fnobj, fix.arg=fix.arg, obs=data, ddistnam=ddistname, par=vstart, ...), silent=TRUE) else opttryerror <-try(opt<-custom.optim(fn=fnobjcens, fix.arg=fix.arg, rcens=rcens, lcens=lcens, icens=icens, ncens=ncens, ddistnam=ddistname, pdistnam=pdistname, par=vstart, ...), silent=TRUE) options(warn=owarn) if (inherits(opttryerror, "try-error")) { warnings("The customized optimization function encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA, length(vstart)), convergence = 100, loglik = NA, hessian = NA, optim.function=custom.optim, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, counts=c(NA, NA))) } if (opt$convergence>0) { warnings("The customized optimization function failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) argdot <- list(...) method.cust <- argdot$method res <- list(estimate = opt$par, convergence = opt$convergence, value=opt$value, hessian = opt$hessian, optim.function = custom.optim, optim.method = method.cust, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights = weights, counts=opt$counts, optim.message=opt$message, loglik = -opt$value) } return(res) } ## old function with previous name for censored data mledistcens <- function(censdata, distr, start=NULL, optim.method="default", lower=-Inf, upper=Inf) { stop("The function \"mledistcens\" is no more used. Now the same function \"mledist\" must be used both for censored and non censored data.") } fitdistrplus/R/quantiles.R0000644000176200001440000002514313742313702015346 0ustar liggesusers############################################################################# # Copyright (c) 2012 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### calculation of theoretical quantiles from a parametric distribution ### fitted on censored or non-censored data ### ### R functions ### #quantile function for fitdist objects quantile.fitdist <- function(x, probs = seq(0.1, 0.9, by=0.1), ...) { if (!inherits(x, "fitdist")) stop("Use only with 'fitdist' objects") myquantiles.fitdist(f = x, probs = probs, cens = FALSE) } #quantile function for fitdistcens objects quantile.fitdistcens <- function(x, probs = seq(0.1, 0.9, by=0.1), ...) { if (!inherits(x, "fitdistcens")) stop("Use only with 'fitdistcens' objects") myquantiles.fitdist(f = x, probs = probs, cens = TRUE) } #internal quantile function for fitdist myquantiles.fitdist <- function(f, probs, cens) { qdistname<-paste("q", f$distname, sep="") if (!exists(qdistname, mode="function")) stop(paste("The ", qdistname, " function must be defined")) # computation and print of quantiles using estimations of parameters para=c(as.list(f$estimate), as.list(f$fix.arg)) quantiles <- do.call(qdistname, c(list(probs), as.list(para))) if (length(probs)>1) quantiles <- as.data.frame(t(quantiles)) else quantiles <- as.data.frame(quantiles) colnames(quantiles) <- paste("p=", probs, sep="") rownames(quantiles) <- "estimate" reslist <- list(quantiles = quantiles, probs = probs) if(!cens) class(reslist) <- "quantile.fitdist" else class(reslist) <- "quantile.fitdistcens" reslist } print.quantile.fitdist <- function(x, ...) { if (!inherits(x, "quantile.fitdist")) stop("Use only with 'quantile.fitdist' objects") typedata <- "(non-censored data)" cat("Estimated quantiles for each specified probability ", typedata,"\n", sep="") print(x$quantiles) invisible(x) } print.quantile.fitdistcens <- function(x, ...) { if (!inherits(x, "quantile.fitdistcens")) stop("Use only with 'quantile.fitdistcens' objects") typedata <- "(censored data)" cat("Estimated quantiles for each specified probability ", typedata,"\n", sep="") print(x$quantiles) invisible(x) } ############################################################################# ### calculation of theoretical quantiles from a parametric distribution ### fitted on censored or non-censored data ### and associated bootstrap confidence intervals ### ### R functions ### #quantile function for bootdist objects quantile.bootdist <- function(x, probs = seq(0.1, 0.9, by=0.1), CI.type = "two.sided", CI.level = 0.95, ...) { if (!inherits(x, "bootdist")) stop("Use only with 'bootdist' objects") myquantiles.bootdist(b = x, probs = probs, CI.type = CI.type, CI.level = CI.level, cens = FALSE) } #quantile function for bootdistcens objects quantile.bootdistcens <- function(x, probs = seq(0.1, 0.9, by=0.1), CI.type = "two.sided", CI.level = 0.95, ...) { if (!inherits(x, "bootdistcens")) stop("Use only with 'bootdistcens' objects") myquantiles.bootdist(b = x, probs = probs, CI.type = CI.type, CI.level = CI.level, cens = TRUE) } #internal quantile function for bootdist myquantiles.bootdist <- function(b, probs, CI.type, CI.level, cens) { CI.type <- match.arg(CI.type, c("two.sided", "less", "greater")) if(!is.logical(cens)) stop("wrong argument cens.") CI.level <- CI.level[1] # 1/ computation of quantiles using quantile.fitdist basequant <- quantile(b$fitpart, probs=probs) # 2/ computation of bootstraped quantiles and alpha-percent CI of quantiles qdistname <- paste("q", b$fitpart$distname, sep="") calcquant <- function(i) { parai <- c(as.list(b$estim[i, ]), as.list(b$fitpart$fix.arg)) do.call(qdistname, c(list(probs), as.list(parai))) } bootquant <- sapply(1:b$nbboot, calcquant) if (length(probs)>1) bootquant <- as.data.frame(t(bootquant)) else bootquant <- as.data.frame(bootquant) colnames(bootquant) <- paste("p=", probs, sep="") quantmedian <- rbind(apply(bootquant, MARGIN=2, median, na.rm=TRUE)) colnames(quantmedian) <- paste("p=", probs, sep="") rownames(quantmedian) <- "estimate" if (CI.type == "two.sided") { alpha <- (1-CI.level)/2 quantCI <- rbind( apply(bootquant, MARGIN=2, quantile, alpha, na.rm=TRUE), apply(bootquant, MARGIN=2, quantile, 1-alpha, na.rm=TRUE)) rownames(quantCI) <- format.perc(c(alpha, 1-alpha), 3) }else if (CI.type == "less") { quantCI <- t(apply(bootquant, MARGIN=2, quantile, CI.level, na.rm=TRUE)) rownames(quantCI) <- format.perc(CI.level, 3) }else { quantCI <- t(apply(bootquant, MARGIN=2, quantile, 1-CI.level, na.rm=TRUE)) rownames(quantCI) <- format.perc(1-CI.level, 3) } # message when lack of convergence nbconverg <- length(b$converg[b$converg == 0]) reslist <- list(quantiles = basequant$quantiles, probs=probs, bootquant = bootquant, quantCI = as.data.frame(quantCI), quantmedian = quantmedian, CI.type = CI.type, CI.level = CI.level, nbboot = b$nbboot, nbconverg = nbconverg) if(!cens) class(reslist) <- "quantile.bootdist" else class(reslist) <- "quantile.bootdistcens" reslist } print.quantile.bootdist <- function(x, ...) { if (!inherits(x, "quantile.bootdist")) stop("Use only with 'quantile.bootdist' objects") typedata <- "(non-censored data)" #base quantiles cat("(original) estimated quantiles for each specified probability ", typedata,"\n", sep="") print(x$quantiles) cat("Median of bootstrap estimates\n") print(x$quantmedian) #confidence intervals cat("\n") if (x$CI.type == "two.sided") { cat("two-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n", sep="") print(x$quantCI) }else if (x$CI.type == "less") { cat("right bound of one-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n") print(x$quantCI) }else { cat("left bound of one-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n") print(x$quantCI) } if (x$nbconverg < x$nbboot) { cat("\n") cat("The estimation method converged only for", x$nbconverg, "among", x$nbboot, "bootstrap iterations.\n") } invisible(x) } print.quantile.bootdistcens <- function(x, ...) { if (!inherits(x, "quantile.bootdistcens")) stop("Use only with 'quantile.bootdistcens' objects") typedata <- "(censored data)" #base quantiles cat("(original) estimated quantiles for each specified probability ", typedata,"\n", sep="") print(x$quantiles) cat("Median of bootstrap estimates\n") print(x$quantmedian) #confidence intervals cat("\n") if (x$CI.type == "two.sided") { cat("two-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n", sep="") print(x$quantCI) }else if (x$CI.type == "less") { cat("right bound of one-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n") print(x$quantCI) }else { cat("left bound of one-sided ", format.perc(x$CI.level, 3)," CI of each quantile\n") print(x$quantCI) } if (x$nbconverg < x$nbboot) { cat("\n") cat("The estimation method converged only for", x$nbconverg, "among", x$nbboot, "bootstrap iterations.\n") } invisible(x) } #from the stat package (not exported in fitdistrplus) format.perc <- function(probs, digits) ## Not yet exported, maybe useful in other contexts: ## quantile.default() sometimes uses a version of it paste(format(100 * probs, trim = TRUE, scientific = FALSE, digits = digits), "%") fitdistrplus/R/gofstat.R0000644000176200001440000003403413742313702015007 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### calculate goodness-of-fit statistics for ### fit of a parametric distribution on non-censored data ### ### R functions ### gofstat <- function (f, chisqbreaks, meancount, discrete, fitnames=NULL) { if(inherits(f, "fitdist")) { f <- list(f) }else if(length(f) == 1) { if(!inherits(f, "fitdist")) stop("argument f must a 'fitdist' object or a list of 'fitdist' objects.") }else if(!is.list(f)) { stop("argument f must be a list of 'fitdist' objects") }else { if(any(sapply(f, function(x) !inherits(x, "fitdist")))) stop("argument f must be a list of 'fitdist' objects") } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(f[[1]]$weights)) stop("gofstat is not yet available when using weights") odata <- f[[1]]$data sdata <- sort(odata) n <- f[[1]]$n distname <- f[[1]]$distname pdistname <- paste("p", distname, sep="") estimate <- f[[1]]$estimate fix.arg <- f[[1]]$fix.arg verif.ftidata <- function(fti) { if (any(fti$data != odata)) stop("All compared fits must have been obtained with the same dataset") invisible() } lapply(f, verif.ftidata) # initiate discrete if not given if(missing(discrete)) { discrete <- f[[1]]$discrete } if(!is.logical(discrete)) stop("wrong argument 'discrete'.") #define chisqbreaks if not defined if (missing(chisqbreaks)) { if (missing(meancount)) meancount <- round( n / ((4*n)^(2/5)) ) if (length(sdata)>ceiling(1.5*meancount)) { limit <- sdata[meancount] sdata <- sdata[sdata>limit] chisqbreaks <- limit }else { warnings("The sample is too small to automatically define chisqbreaks") chisq <- NULL chisqbreaks <- NULL chisqpvalue <- NULL chisqtable <- NULL chisqdf <- NULL } while (length(sdata)>ceiling(1.5*meancount)) { limit <- sdata[meancount] sdata <- sdata[sdata>limit] chisqbreaks <- c(chisqbreaks,limit) } sdata <- sort(odata) } nbfit <- length(f) if(is.null(fitnames)) fitnames <- paste(1:nbfit, sapply(f, function(x) x$method), sapply(f, function(x) x$distname), sep="-") Chi2 <- compute.gofstat.Chi2(sdata, n, distname, pdistname, estimate, fix.arg, chisqbreaks) if(length(f) > 1) { #renaming names(Chi2$chisq) <- names(Chi2$chisqpvalue) <- names(Chi2$chisqdf) <- fitnames[1] colnames(Chi2$chisqtable)[2] <- paste("theo", fitnames[1], sep=" ") #computation and storing for(i in 2:nbfit) { Chi2temp <- compute.gofstat.Chi2(sdata, n, f[[i]]$distname, paste("p", f[[i]]$distname, sep=""), f[[i]]$estimate, f[[i]]$fix.arg, chisqbreaks) names(Chi2temp$chisq) <- names(Chi2temp$chisqpvalue) <- names(Chi2temp$chisqdf) <- fitnames[i] Chi2$chisq <- c(Chi2$chisq, Chi2temp$chisq) Chi2$chisqpvalue <- c(Chi2$chisqpvalue, Chi2temp$chisqpvalue) Chi2$chisqdf <- c(Chi2$chisqdf, Chi2temp$chisqdf) Chi2$chisqtable <- cbind(Chi2$chisqtable, Chi2temp$chisqtable[,2]) colnames(Chi2$chisqtable)[NCOL(Chi2$chisqtable)] <- paste("theo", fitnames[i], sep=" ") } } if(discrete) { addres <- Chi2 }else { KSCvMAD <- compute.gofstat.KSCvMAD(sdata, n, distname, pdistname, estimate, fix.arg, f[[1]]$method) #renaming names(KSCvMAD$cvm) <- names(KSCvMAD$ad) <- names(KSCvMAD$ks) <- fitnames[1] if(!is.null(KSCvMAD$cvmtest)) names(KSCvMAD$cvmtest) <- names(KSCvMAD$adtest) <- names(KSCvMAD$kstest) <- fitnames[1] if(length(f) > 1) { #computation and storing for(i in 2:nbfit) { KSCvMADtemp <- compute.gofstat.KSCvMAD(sdata, n, f[[i]]$distname, paste("p", f[[i]]$distname, sep=""), f[[i]]$estimate, f[[i]]$fix.arg, f[[i]]$method) names(KSCvMADtemp$cvm) <- names(KSCvMADtemp$ad) <- names(KSCvMADtemp$ks) <- fitnames[i] if(!is.null(KSCvMADtemp$cvmtest)) names(KSCvMADtemp$cvmtest) <- names(KSCvMADtemp$adtest) <- names(KSCvMADtemp$kstest) <- fitnames[i] KSCvMAD$cvm <- c(KSCvMAD$cvm, KSCvMADtemp$cvm) KSCvMAD$cvmtest <- c(KSCvMAD$cvmtest, KSCvMADtemp$cvmtest) KSCvMAD$ad <- c(KSCvMAD$ad, KSCvMADtemp$ad) KSCvMAD$adtest <- c(KSCvMAD$adtest, KSCvMADtemp$adtest) KSCvMAD$ks <- c(KSCvMAD$ks, KSCvMADtemp$ks) KSCvMAD$kstest <- c(KSCvMAD$kstest, KSCvMADtemp$kstest) } } addres <- c(Chi2, KSCvMAD) } aics <- sapply(f, function(x) x$aic) names(aics) <- fitnames bics <- sapply(f, function(x) x$bic) names(bics) <- fitnames res <- c(addres, aic=list(aics), bic=list(bics), discrete=discrete, nbfit=nbfit) class(res) <- c("gofstat.fitdist", "fitdist") res } #---------------------------------------------------------------------- #KS, CvM, AD statistics : only for continuous distributions compute.gofstat.KSCvMAD <- function(sdata, n, distname, pdistname, estimate, fix.arg, method) { obspu <- seq(1,n)/n obspl <- seq(0,n-1)/n theop <- do.call(pdistname, c(list(sdata), as.list(estimate), fix.arg)) # Kolmogorov-Smirnov statistic ks <- max(pmax(abs(theop-obspu), abs(theop-obspl))) Dmod <- ks*(sqrt(n)+0.12+0.11/sqrt(n)) # Kolmogorov-Smirnov test if (n>=30) kstest <- ifelse(Dmod>1.358,"rejected","not rejected") else kstest <- "not computed" # Anderson-Darling statistic ad <- - n - mean( (2 * 1:n - 1) * (log(theop) + log(1 - rev(theop))) ) # ad <- -n-sum((2*(1:n)-1)*log(theop) + (2*n+1-2*(1:n))*log(1-theop))/n # Anderson-Darling test if (is.null(fix.arg) & method == "mle") { # the following test does not correspond to MLE estimate but to unbiased # estimate of the variance #if ((distname == "norm" | distname == "lnorm") & n>=5) { # a2mod <- ad*(1+0.75/n+2.25/n^2) # adtest <- ifelse(a2mod>0.752,"rejected","not rejected") #} #else if (distname == "exp" & n>=5) { a2mod <- ad*(1+0.6/n) adtest <- ifelse(a2mod>1.321, "rejected", "not rejected") }else if (distname == "gamma" & n>=5) { m <- as.list(estimate)$shape interp <- approxfun(c(1,2,3,4,5,6,8,10,12,15,20), c(0.786,0.768,0.762,0.759,0.758,0.757,0.755,0.754,0.754,0.754,0.753), yright=0.752) adtest <- ifelse(ad>interp(m), "rejected", "not rejected") }else if (distname == "weibull" & n>=5) { a2mod <- ad*(1+0.2/sqrt(n)) adtest <- ifelse(a2mod>0.757, "rejected", "not rejected") }else if (distname == "logis" & n>=5) { a2mod <- ad*(1+0.25/n) adtest <- ifelse(a2mod>0.66,"rejected","not rejected") }else adtest <- "not computed" } else # if (is.null(fix.arg)...) adtest <- "not computed" # Cramer-von Mises statistic cvm <- 1/(12*n) + sum( ( theop - (2 * 1:n - 1)/(2 * n) )^2 ) # Cramer-von Mises test if (is.null(fix.arg) & method == "mle") { # the following test does not correspond to MLE estimate but to unbiased # estimate of the variance # if ((distname == "norm" | distname == "lnorm") & n>=5) { # w2mod <- cvm*(1+0.5/n) # cvmtest <- ifelse(w2mod>0.126,"rejected","not rejected") # } # else if (distname == "exp" & n>=5) { w2mod <- cvm*(1+0.16/n) cvmtest <- ifelse(w2mod>0.222,"rejected","not rejected") }else if (distname == "gamma" & n>=5) { m <- as.list(estimate)$shape interp <- approxfun(c(1,2,3,4,5,6,8,10,12,15,20), c(0.136,0.131,0.129,0.128,0.128,0.128,0.127,0.127,0.127,0.127,0.126), yright=0.126) cvmtest <- ifelse(cvm>interp(m),"rejected","not rejected") }else if (distname == "weibull" & n>=5) { w2mod <- cvm*(1+0.2/sqrt(n)) cvmtest <- ifelse(w2mod>0.124,"rejected","not rejected") }else if (distname == "logis" & n>=5) { w2mod <- (n*cvm - 0.08)/(n - 1) cvmtest <- ifelse(w2mod>0.098,"rejected","not rejected") }else cvmtest <- "not computed" } else # if (is.null(fix.arg)) cvmtest <- "not computed" if (length(table(sdata)) != length(sdata)) warnings("Kolmogorov-Smirnov, Cramer-von Mises and Anderson-Darling statistics may not be correct with ties") list(cvm = cvm, cvmtest = cvmtest, ad = ad,adtest = adtest, ks = ks, kstest=kstest) } #---------------------------------------------------------------------- #chi-squared statistic : both for continuous and discrete distributions compute.gofstat.Chi2 <- function(sdata, n, distname, pdistname, estimate, fix.arg, chisqbreaks) { # chi-squared statistic and pvalues if (!is.null(chisqbreaks)) { if(!is.numeric(chisqbreaks)) stop("chisqbreaks must be a numeric vector defining the cell boundaries") nbreaks <- length(chisqbreaks) pbreaks <- do.call(pdistname, c(list(chisqbreaks), as.list(estimate), fix.arg)) Fobsbreaks <- ecdf(sdata)(chisqbreaks) Fobsunder <- c(0, Fobsbreaks[1:nbreaks-1]) punder <- c(0, pbreaks[1:nbreaks-1]) if (pbreaks[nbreaks]==1 & Fobsbreaks[nbreaks]==1) { p <- pbreaks-punder Fobs <- Fobsbreaks-Fobsunder }else { p <- c(pbreaks-punder, 1-pbreaks[nbreaks]) Fobs <- c(Fobsbreaks-Fobsunder, 1-Fobsbreaks[nbreaks]) } obscounts <- round(Fobs*n) theocounts <- p*n chisq <- sum(((obscounts-theocounts)^2)/theocounts) chisqdf <- length(obscounts)-1-length(estimate) # replacing of the line below which causes an error message for chisqdf <=0 # chisqpvalue <- ifelse(chisqdf>0, pchisq(chisq, df=chisqdf, lower.tail=FALSE), NULL) if (chisqdf>0) { chisqpvalue <- pchisq(chisq, df=chisqdf, lower.tail=FALSE) } else { chisqpvalue <- NULL } chisqtable <- as.table(cbind(obscounts, theocounts)) for (i in 1:length(obscounts)-1) rownames(chisqtable)[i] <- paste("<=", signif(chisqbreaks[i], digits=4)) rownames(chisqtable)[length(obscounts)] <- paste(">", signif(chisqbreaks[i], digits=4)) return( list(chisq = chisq, chisqbreaks=chisqbreaks, chisqpvalue = chisqpvalue, chisqdf = chisqdf, chisqtable = chisqtable) ) }else return(NULL) } print.gofstat.fitdist <- function(x, ...) { if (!inherits(x, "gofstat.fitdist")) stop("Use only with 'gofstat.fitdist' objects") if (x$discrete) #discrete distribution { if(!is.null(x$chisq)) { cat("Chi-squared statistic: ",x$chisq,"\n") cat("Degree of freedom of the Chi-squared distribution: ",x$chisqdf,"\n") if (any(x$chisqdf <= 0)) { cat(" The degree of freedom of the chi-squared distribution is less than 1 \n") cat(" The number of cells is insufficient to calculate the p-value. \n") }else { cat("Chi-squared p-value: ",x$chisqpvalue,"\n") if (any(x$chisqtable[,-1] < 5)) cat(" the p-value may be wrong with some theoretical counts < 5 \n") } cat("Chi-squared table:\n") print(x$chisqtable) cat("\nGoodness-of-fit criteria\n") mm <- rbind(AIC=x$aic, BIC=x$bic) rownames(mm) <- c("Akaike's Information Criterion", "Bayesian Information Criterion") print(mm) }else cat("The sample is too small to automatically define cells for Chi-squared test \n") }else # continuous distribution { cat("Goodness-of-fit statistics\n") mm <- rbind(KS=x$ks, CvM=x$cvm, AD=x$ad) rownames(mm) <- c("Kolmogorov-Smirnov statistic", "Cramer-von Mises statistic", "Anderson-Darling statistic") print(mm) cat("\nGoodness-of-fit criteria\n") mm <- rbind(AIC=x$aic, BIC=x$bic) rownames(mm) <- c("Akaike's Information Criterion", "Bayesian Information Criterion") print(mm) # } } invisible(x) }fitdistrplus/R/util-npsurv-NNLS.R0000644000176200001440000001111313742313702016411 0ustar liggesusers# ----------------------------------------------------------------------- # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Internal optimization functions for nonnegative least square method # # ----------------------------------------------------------------------- # ## ========================================================================== ## Nonnegative least squares (NNLS): ## ## Minimize ||ax - b|| ## subject to non-negativity for all components ## x >= 0 i.e. diag(ncol(x)) x - 0 >= 0 ## sum up to one ## sum(x) = 1, ie. - 1 >= 0, + 1 >= 0 ## ========================================================================== NNLS_constrSum <- function(a, b, control=list(), pkg="stats", sumtotal=1, ...) { pkg <- match.arg(pkg, c("stats")) controlnames <- c("trace", "fnscale", "parscale", "ndeps", "maxit", "abstol", "reltol", "alpha", "beta", "gamma", "REPORT", "warn.1d.NelderMead", "type", "lmm", "factr", "pgtol", "tmax", "temp") if(length(control) >= 1) control <- control[names(control) %in% controlnames] else control <- list(maxit=500) if (pkg == "stats") #control parameter for BFGS used below { control$maxit <- max(control$maxit, 1000) control$reltol <- 1e-6 } #sanity check if(!is.vector(b)) b = drop(b) if(!is.matrix(a)) stop("a not matrix") if(length(sumtotal) > 1) stop("sumtotal must be a positive scalar") if(!is.numeric(sumtotal)) stop("sumtotal must be a positive scalar") if(sumtotal <= 0) stop("sumtotal must be a positive scalar") m <- NROW(a) n <- NCOL(a) if (pkg == "stats") { if(control$trace >= 2) cat("nb of optimized variables", n, "\n") if(n > 2) { #residual least square sum with theta=x[1:(n-1)] ; x[n] = 1-sum(theta) RLS <- function(theta) { x <- c(theta, sumtotal-sum(theta)) y <- a %*% x - b sum(y^2) } gradRLS <- function(theta) { x <- c(theta, sumtotal-sum(theta)) diffa <- a[, 1:(NCOL(a)-1)] - a[, NCOL(a)] y <- a %*% x - b 2*crossprod(diffa, y) } # non negativity constraint one_n <- rep(1, n-1) ui <- diag(n-1) rownames(ui) <- c(paste0("theta", 1:(n-1))) ci <- rep(0, n-1) #initial guess x0 <- rep(1/(n-1), n-1) #call to constrOptim control$trace <- control$trace >=5 res <- constrOptim(theta=x0, f=RLS, grad=gradRLS, ui=ui, ci=ci, method="BFGS", control=control, ...) #warning : convergence is not reached if(res$convergence != 0) res$prob <- c(res$par, sumtotal-sum(res$par)) #sanity check res$prob <- pmax(res$prob, 0) res$prob <- res$prob/sum(res$prob)*sumtotal }else if(n == 2) { #residual least square sum with theta=x[1:(n-1)] ; x[n] = 1-sum(theta) RLS <- function(theta) { x <- c(theta, sumtotal-sum(theta)) y <- a %*% x - b sum(y^2) } gradRLS <- function(theta) { x <- c(theta, sumtotal-sum(theta)) diffa <- a[,1]-a[,2] 2*crossprod(diffa, a %*% x - b) } # non negativity constraint one_n <- rep(1, n-1) ui <- diag(n-1) rownames(ui) <- c(paste0("theta", 1:(n-1))) ci <- rep(0, n-1) #initial guess x0 <- rep(1/(n-1), n-1) #call to constrOptim res <- constrOptim(theta=x0, f=RLS, grad=gradRLS, ui=ui, ci=ci, method="BFGS", control=control, ...) #warning : convergence is not reached if(res$convergence != 0) res$prob <- c(res$par, sumtotal-sum(res$par)) #sanity check res$prob <- pmax(res$prob, 0) res$prob <- res$prob/sum(res$prob)*sumtotal }else if(n == 1) { xstar <- sumtotal res <- list(prob=xstar, value=(a*xstar-b)^2, counts=0, par=NA, convergence=1*(xstar < 0), message="no optimization, because fully constrained problem") }else stop("wrong argument a for NNLS_constrSum()") }else # if (pkg == "limSolve") # { # #TODO : pass control argument to limSolve::lsei # require(limSolve) # res <- limSolve::lsei(A=a, B=b, E=rep(1,n), F=1, G=diag(n), H=rep(0, n), ...) # if(res$IsError) # stop("error in limSolve::lsei when computing NNLS") # xstar <- res$X # }else stop("wrong package") res } fitdistrplus/R/util-getparam.R0000644000176200001440000000227313742313702016113 0ustar liggesusers# INPUTS # argdistname : argument names of the distribution from names(formals()) # OUTPUTS # parameter names (as a vector) of the distribution (excluding non parameter argument) computegetparam <- function(argdistname) { #remove first argument, that should be "x", "p", "q", or "n", see ?dgamma, pgamma, qgamma argdistname <- argdistname[-1] nonparaminR <- c("x", "p", "q", "n") #defensive programming #remove other arguments, see ?dgamma, pgamma, qgamma, dbeta nonparaminR <- c(nonparaminR, "log", "log.p", "lower.tail", "ncp") nonparaminActuar <- c("limit", "order", "t") nonparaminGamlssdist <- "fast" nonparamspecial <- c("...", "..1", "..2") #see ?dnig, dhyperb, dskewlap, dgig,... nonparaminGenHyperbolic <- c("param", "KOmega", "ibfTol", "nmax", "method", "intTol", "valueOnly", "nInterpol", "uniTol", "subdivisions", "logPars") #see ?dsn nonparamsn <- "dp" plist <- setdiff(argdistname, nonparaminR) plist <- setdiff(plist, nonparaminActuar) plist <- setdiff(plist, nonparaminGamlssdist) plist <- setdiff(plist, nonparamspecial) plist <- setdiff(plist, nonparaminGenHyperbolic) plist <- setdiff(plist, nonparamsn) plist } fitdistrplus/R/util-wtdstat.R0000644000176200001440000001517213742313702016007 0ustar liggesusers############################################################################# # Copyright (c) 2015 Frank E Harrell Jr # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# #some functions from Hmisc also under GPL #From wtd.stats.s (line 1) of the Hmisc package wtd.mean <- function(x, weights=NULL, normwt='ignored', na.rm=TRUE) { if(!length(weights)) return(mean(x, na.rm=na.rm)) if(na.rm) { s <- !is.na(x + weights) x <- x[s] weights <- weights[s] } sum(weights*x)/sum(weights) } #From wtd.stats.s (line 15) of the Hmisc package wtd.var <- function(x, weights=NULL, normwt=FALSE, na.rm=TRUE, method = c('unbiased', 'ML')) { method <- match.arg(method) if(!length(weights)) { if(na.rm) x <- x[!is.na(x)] return(var(x)) } if(na.rm) { s <- !is.na(x + weights) x <- x[s] weights <- weights[s] } if(normwt) weights <- weights * length(x) / sum(weights) if(method == 'ML') return(as.numeric(stats::cov.wt(cbind(x), weights, method = "ML")$cov)) sw <- sum(weights) xbar <- sum(weights * x) / sw sum(weights*((x - xbar)^2)) / (sw - (if(normwt) sum(weights ^ 2) / sw else 1)) } #From wtd.stats.s (line 43) of the Hmisc package wtd.quantile <- function(x, weights=NULL, probs=c(0, .25, .5, .75, 1), type='quantile', normwt=FALSE, na.rm=TRUE) { if(!length(weights)) return(quantile(x, probs=probs, na.rm=na.rm)) type <- match.arg(type) if(any(probs < 0 | probs > 1)) stop("Probabilities must be between 0 and 1 inclusive") nams <- paste(format(round(probs * 100, if(length(probs) > 1) 2 - log10(diff(range(probs))) else 2)), "%", sep = "") w <- wtd.table(x, weights, na.rm=na.rm, normwt=normwt, type='list') x <- w$x wts <- w$sum.of.weights n <- sum(wts) order <- 1 + (n - 1) * probs low <- pmax(floor(order), 1) high <- pmin(low + 1, n) order <- order %% 1 ## Find low and high order statistics ## These are minimum values of x such that the cum. freqs >= c(low,high) allq <- approx(cumsum(wts), x, xout=c(low,high), method='constant', f=1, rule=2)$y k <- length(probs) quantiles <- (1 - order)*allq[1:k] + order*allq[-(1:k)] names(quantiles) <- nams return(quantiles) } #From wtd.stats.s (line 119) of the Hmisc package wtd.table <- function(x, weights=NULL, type=c('list','table'), normwt=FALSE, na.rm=TRUE) { type <- match.arg(type) if(!length(weights)) weights <- rep(1, length(x)) #isdate <- testDateTime(x) ## 31aug02 + next 2 ax <- attributes(x) ax$names <- NULL if(is.character(x)) x <- as.factor(x) lev <- levels(x) x <- unclass(x) if(na.rm) { s <- !is.na(x + weights) x <- x[s, drop=FALSE] ## drop is for factor class weights <- weights[s] } n <- length(x) if(normwt) weights <- weights * length(x) / sum(weights) i <- order(x) # R does not preserve levels here x <- x[i]; weights <- weights[i] if(anyDuplicated(x)) { ## diff(x) == 0 faster but doesn't handle Inf weights <- tapply(weights, x, sum) if(length(lev)) { levused <- lev[sort(unique(x))] if((length(weights) > length(levused)) && any(is.na(weights))) weights <- weights[!is.na(weights)] if(length(weights) != length(levused)) stop('program logic error') names(weights) <- levused } if(!length(names(weights))) stop('program logic error') if(type=='table') return(weights) x <- all.is.numeric(names(weights), 'vector') #if(isdate) # attributes(x) <- c(attributes(x),ax) names(weights) <- NULL return(list(x=x, sum.of.weights=weights)) } xx <- x #if(isdate) # attributes(xx) <- c(attributes(xx),ax) if(type=='list') list(x=if(length(lev))lev[x] else xx, sum.of.weights=weights) else { names(weights) <- if(length(lev)) lev[x] else xx weights } } #From Misc.s (line 241) of the Hmisc package all.is.numeric <- function(x, what=c('test','vector'), extras=c('.','NA')) { what <- match.arg(what) x <- sub('[[:space:]]+$', '', x) x <- sub('^[[:space:]]+', '', x) xs <- x[!x %in% c('',extras)] #originally %nin% isnum <- suppressWarnings(!any(is.na(as.numeric(xs)))) if(what=='test') isnum else if(isnum) as.numeric(x) else x } fitdistrplus/R/vcov.R0000644000176200001440000000602713742313702014316 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Regis Pouillot, Jean-Baptiste Denis, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### var-covariance matrix ### ### R functions ### #already in R # #vcov <- function(object, ...) # UseMethod("vcov") # #vcov.default <- function(object, ...) # return(object) vcov.fitdist <- function(object, ...) { stopifnot(inherits(object, "fitdist")) if (object$method != "mle") warning("The variance-covariance matrix can only be calculated for fits using the mle method") return(object$vcov) } vcov.fitdistcens <- function(object, ...) { stopifnot(inherits(object, "fitdistcens")) return(object$vcov) } fitdistrplus/R/cdfcomp.R0000644000176200001440000002753614102171104014751 0ustar liggesusers############################################################################# # Copyright (c) 2011 Marie Laure Delignette-Muller, Christophe Dutang, Aurelie Siberchicot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot cumulative distribution functions for various fits ### of continuous distribution(s) (fitdist results) ### on a same dataset ### ### R functions ### cdfcomp <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datapch, datacol, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, horizontals = TRUE, verticals = FALSE, do.points = TRUE, use.ppoints = TRUE, a.ppoints = 0.5, name.points = NULL, lines01 = FALSE, discrete, add = FALSE, plotstyle = "graphics", fitnbpts = 101, ...) { if(inherits(ft, "fitdist")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdist' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdist")))) stop("argument ft must be a list of 'fitdist' objects") } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("cdfcomp is not yet available when using weights") # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # manage default parameters nft <- length(ft) if (missing(datapch)) datapch <- 16 if (missing(datacol)) datacol <- "black" if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitlty)) fitlty <- 1:nft if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitlty <- rep(fitlty, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) if (missing(xlab)) xlab <- ifelse(xlogscale, "data in log scale", "data") if (missing(ylab)) ylab <- "CDF" if (missing(main)) main <- paste("Empirical and theoretical CDFs") # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } # initiate discrete if not given if(missing(discrete)) { discrete <- any(sapply(ft, function(x) x$discrete)) } if(!is.logical(discrete)) stop("wrong argument 'discrete'.") # check data mydata <- ft[[1]]$data verif.ftidata <- function(fti) { if (any(fti$data != mydata)) stop("All compared fits must have been obtained with the same dataset") invisible() } lapply(ft, verif.ftidata) # check xlim if(missing(xlim)) { xmin <- min(mydata) xmax <- max(mydata) xlim <- c(xmin, xmax) } else { xmin <- xlim[1] xmax <- xlim[2] } # some variable definitions distname <- ft[[1]]$distname n <- length(mydata) sdata <- sort(mydata) largedata <- (n > 1e4) logxy <- paste(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y",""), sep="") if ((xlogscale == TRUE) & min(mydata) <= 0) stop("log transformation of data requires only positive values") # plot of data (ecdf) if(xlogscale && !discrete) sfin <- seq(log10(xmin), log10(xmax), by=(log10(xmax)-log10(xmin))/fitnbpts[1]) else # (!xlogscale && !discrete) and discrete sfin <- seq(xmin, xmax, length.out=fitnbpts[1]) # previous version with no vizualisation of ex-aequos # obsp <- ecdf(sdata) if (use.ppoints && !discrete) obsp <- ppoints(n, a = a.ppoints) else obsp <- (1:n) / n # computation of each fitted distribution comput.fti <- function(i) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname pdistname <- paste("p", distname, sep = "") if(xlogscale && !discrete) { do.call(pdistname, c(list(10^sfin), as.list(para))) }else { do.call(pdistname, c(list(sfin), as.list(para))) } } fittedprob <- sapply(1:nft, comput.fti) if(NCOL(fittedprob) != nft || NROW(fittedprob) != length(sfin)) stop("problem when computing fitted CDFs.") # check ylim if(missing(ylim)) ylim <- range(obsp, fittedprob) else ylim <- range(ylim) #in case of users enter a bad ylim # optional add of horizontal and vertical lines for step function xhleft <- sdata[-length(sdata)] xhright <- sdata[-1L] yh <- obsp[-length(sdata)] xv <- xhright yvdown <- yh yvup <- obsp[-1L] if(xlogscale) sfin <- 10^sfin if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## #main plot if(!add) #create a new graphic { if(!largedata && do.points) plot(sdata, obsp, main=main, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, log=logxy, pch=datapch, col=datacol, type="p", ...) else if(largedata) plot(sdata, obsp, main=main, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, log=logxy, col=datacol, type="s", ...) else if(!do.points) plot(sdata, obsp, main=main, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, log=logxy, col=datacol, type="n", ...) else stop("internal error in cdfcomp().") }else #add to the current graphic { #do not need parameters: main=main, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, log=logxy, if(!largedata && do.points) points(sdata, obsp, pch=datapch, col=datacol, type="p", ...) else if(largedata) points(sdata, obsp, col=datacol, type="s", ...) #else if(!do.points) nothing to plot } if(!largedata && do.points && !is.null(name.points)) text(sdata, obsp, labels = name.points, pos = 2) # optional add of horizontal and vertical lines for step function if (!largedata && horizontals) { segments(xhleft, yh, xhright, yh, col=datacol,...) segments(sdata[length(sdata)], 1, xmax, 1, col=datacol, lty = 2, ...) segments(xmin, 0, sdata[1], 0, col=datacol, lty = 2, ...) if (verticals) { segments(xv, yvdown, xv, yvup, col=datacol,...) segments(sdata[1], 0, sdata[1], obsp[1], col=datacol, ...) } } # plot fitted cdfs for(i in 1:nft) lines(sfin, fittedprob[,i], lty=fitlty[i], col=fitcol[i], lwd=fitlwd[i], type=ifelse(discrete, "s", "l"), ...) if(lines01) abline(h=c(0, 1), lty="dashed", col="grey") if(addlegend) legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, lty=fitlty, col=fitcol, lwd=fitlwd, ...) invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## # recode the legend position according to available positions in ggplot2 if(xlegend %in% c("topleft", "bottomleft")) xlegend <- "left" if(xlegend %in% c("topright", "bottomright")) xlegend <- "right" if(xlegend == "center") xlegend <- "right" # structure the fittedprob in a relevant data.frame fittedprob <- as.data.frame(fittedprob) colnames(fittedprob) <- unlist(lapply(ft, function(X) X["distname"])) fittedprob <- stack(fittedprob) fittedprob$sfin <- sfin # sfin is recycled in the standard fashion fittedprob$ind <- factor(fittedprob$ind, levels = unique(fittedprob$ind)) # reorder levels in the appearance order of the input step <- data.frame(values = obsp, ind = "step", sfin = sdata) horiz <- data.frame(x = xhleft, y = yh, xend = xhright, yend = yh, ind = "horiz") horiz0 <- data.frame(x = xmin, y = 0, xend = sdata[1], yend = 0, ind = "horiz0") horiz1 <- data.frame(x = sdata[length(sdata)], y = 1, xend = xmax, yend = 1, ind = "horiz1") verti <- data.frame(x = sdata[1], y = 0, xend = sdata[1], yend = obsp[1], ind = "verti") ggcdfcomp <- ggplot2::ggplot(data = fittedprob, ggplot2::aes_(quote(sfin), quote(values), group = quote(ind), colour = quote(ind))) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::ggtitle(main) + ggplot2::coord_cartesian(xlim = c(xlim[1], xlim[2]), ylim = c(ylim[1], ylim[2])) + {if(!largedata && do.points) ggplot2::geom_point(data = step, ggplot2::aes_(quote(sfin), quote(values)), show.legend = FALSE, colour = datacol, shape = datapch)} + {if(!largedata && do.points && !is.null(name.points)) ggplot2::geom_text(data = step, ggplot2::aes_(quote(sfin), quote(values), label = name.points), hjust = "right", nudge_x = -0.05, inherit.aes = FALSE, show.legend = FALSE)} + {if(largedata) ggplot2::geom_step(data = step, ggplot2::aes_(quote(sfin), quote(values)), show.legend = FALSE, colour = datacol, shape = datapch)} + {if(!largedata && horizontals && !verticals) ggplot2::geom_segment(data = horiz, ggplot2::aes_(x=quote(x), y=quote(y), xend=quote(xend), yend=quote(yend)), show.legend = FALSE, colour = datacol)} + {if(!largedata && horizontals && verticals) ggplot2::geom_step(data = step, ggplot2::aes_(quote(sfin), quote(values)), show.legend = FALSE, colour = datacol)} + {if(!largedata && horizontals) ggplot2::geom_segment(data = horiz1, ggplot2::aes_(x=quote(x), y=quote(y), xend=quote(xend), yend=quote(yend)), show.legend = FALSE, colour = datacol, linetype = 2)} + {if(!largedata && horizontals) ggplot2::geom_segment(data = horiz0, ggplot2::aes_(x=quote(x), y=quote(y), xend=quote(xend), yend=quote(yend)), show.legend = FALSE, colour = datacol, linetype = 2)} + {if(!largedata && horizontals && verticals) ggplot2::geom_segment(data = verti, ggplot2::aes_(x=quote(x), y=quote(y), xend=quote(xend), yend=quote(yend)), show.legend = FALSE, colour = datacol)} + {if(discrete) ggplot2::geom_step(data = fittedprob, ggplot2::aes_(linetype = quote(ind), colour = quote(ind)), size = 0.4)} + {if(!discrete) ggplot2::geom_line(data = fittedprob, ggplot2::aes_(linetype = quote(ind), colour = quote(ind), size = quote(ind)))} + ggplot2::theme_bw() + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend)) else ggplot2::theme(legend.position = "none")} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitlty, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + {if(lines01) ggplot2::geom_hline(ggplot2::aes(yintercept=0), color="grey", linetype="dashed")} + {if(lines01) ggplot2::geom_hline(ggplot2::aes(yintercept=1), color="grey", linetype="dashed")} + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} return(ggcdfcomp) } } fitdistrplus/R/ppcomp.R0000644000176200001440000002056413747741345014656 0ustar liggesusers############################################################################# # Copyright (c) 2012 Christophe Dutang, Aurelie Siberchicot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### P-P plot for various fits ### of continuous distribution(s) (fitdist results) ### on a same dataset ### ### R functions ### ppcomp <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fitpch, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, use.ppoints = TRUE, a.ppoints = 0.5, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, plotstyle = "graphics", ...) { if(inherits(ft, "fitdist")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdist' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdist")))) stop("argument ft must be a list of 'fitdist' objects") } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("ppcomp is not yet available when using weights") # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # check data mydata <- ft[[1]]$data verif.ftidata <- function(fti) { if (any(fti$data != mydata)) stop("All compared fits must have been obtained with the same dataset") invisible() } lapply(ft, verif.ftidata) n <- length(mydata) sdata <- sort(mydata) largedata <- (n > 1e4) if (xlogscale != ylogscale) { warning("As a P-P plot should use the same scale on x and y axes, both or none of the axes should be put in a logarithmic scale.") } logxy <- paste(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y",""), sep="") # manage default parameters nft <- length(ft) if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitpch)) fitpch <- ifelse(largedata, 1, 21) if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitpch <- rep(fitpch, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } if (missing(xlab)) xlab <- "Theoretical probabilities" if (missing(ylab)) ylab <- "Empirical probabilities" if (missing(main)) main <- "P-P plot" if (use.ppoints) obsp <- ppoints(n, a = a.ppoints) else obsp <- (1:n) / n # computation of each fitted distribution comput.fti <- function(i) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname pdistname <- paste("p", distname, sep="") do.call(pdistname, c(list(sdata), as.list(para))) } fittedprob <- sapply(1:nft, comput.fti) if(NCOL(fittedprob) != nft || NROW(fittedprob) != length(sdata)) stop("problem when computing fitted probabilities.") # check limits if (missing(xlim)) xlim <- range(fittedprob) if (missing(ylim)) ylim <- range(obsp) if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## #main plotting if(!largedata) resquant <- plot(fittedprob[,1], obsp, main=main, xlab=xlab, ylab=ylab, log=logxy, pch = fitpch[1], xlim=xlim, ylim=ylim, col=fitcol[1], type="p", ...) else resquant <- plot(fittedprob[,1], obsp, main=main, xlab=xlab, ylab=ylab, log=logxy, lty = fitpch[1], xlim=xlim, ylim=ylim, col=fitcol[1], type="l", lwd = fitlwd[1], ...) #plot other fitted probabilities if(nft > 1 && !ynoise && !largedata) for(i in 2:nft) points(fittedprob[,i], obsp, pch=fitpch[i], col=fitcol[i], ...) if(nft > 1 && ynoise && !largedata) for(i in 2:nft) { if (ylogscale) { noise2mult <- runif(n, 0.95, 1.05) points(fittedprob[,i], obsp*noise2mult, pch=fitpch[i], col=fitcol[i], ...) }else { noise2add <- runif(n, -0.02, 0.02) points(fittedprob[,i], obsp+noise2add, pch=fitpch[i], col=fitcol[i], ...) } } if(nft > 1 && largedata) for(i in 2:nft) lines(fittedprob[,i], obsp, col=fitcol[i], lty = fitpch[i], lwd = fitlwd[i], ...) if(line01) abline(0, 1, lty=line01lty, col=line01col) if(addlegend) { if(!largedata) legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, pch = fitpch, ...) else legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, lty = fitpch, lwd = fitlwd, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## # recode the legend position according to available positions in ggplot2 if(xlegend %in% c("topleft", "bottomleft")) xlegend <- "left" if(xlegend %in% c("topright", "bottomright")) xlegend <- "right" # structure the fittedprob in a relevant data.frame fittedprob <- as.data.frame(fittedprob) colnames(fittedprob) <- unlist(lapply(ft, function(X) X["distname"])) fittedprob <- stack(fittedprob) nfp <- nrow(fittedprob) fittedprob$obsp <- obsp # obsp is recycled in the standard fashion fittedprob$ind <- factor(fittedprob$ind, levels = unique(fittedprob$ind)) # reorder levels in the appearance order of the input if(nft > 1 && ynoise && !largedata) { if (ylogscale) { noise2mult <- runif(nfp, 0.95, 1.05) fittedprob$obsp <- fittedprob$obsp*noise2mult }else { noise2add <- runif(nfp, -0.02, 0.02) fittedprob$obsp <- fittedprob$obsp+noise2add } } ggppcomp <- ggplot2::ggplot(data = fittedprob, ggplot2::aes_(quote(values), quote(obsp), group = quote(ind), colour = quote(ind), shape = quote(ind), size = quote(ind))) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::ggtitle(main) + ggplot2::coord_cartesian(xlim = c(xlim[1], xlim[2]), ylim = c(ylim[1], ylim[2])) + {if(!largedata) ggplot2::geom_point() else ggplot2::geom_line(ggplot2::aes_(linetype = quote(ind), size = quote(ind)))} + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend), plot.title = ggplot2::element_text(hjust = 0.5)) else ggplot2::theme(legend.position = "none", plot.title = ggplot2::element_text(hjust = 0.5))} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_shape_manual(values = fitpch, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitpch, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(shape = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + {if(line01) ggplot2::geom_abline(intercept = 0, slope = 1)} + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} return(ggppcomp) } } fitdistrplus/R/fitbench.R0000644000176200001440000001327213742313702015123 0ustar liggesusers############################################################################# # Copyright (c) 2016 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### Benchmark of optimization algorithms to compute estimate ### ### R functions ### fitbench <- function(data, distr, method, grad=NULL, control=list(trace=0, REPORT=1, maxit=1000), lower=-Inf, upper=+Inf, ...) { if(method != "mle") stop("not supported") hasbound <- any(is.finite(lower) | is.finite(upper)) hasgrad <- !is.null(grad) reslist <- NULL # 1 - methods without gradient without constraint (always possible) for(meth in c("BFGS", "Nelder", "CG")) #CG with FR update { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, optim.method=meth, control=control, ...))[3] reslist <- c(reslist, list(res1fit)) } for(type in 2:3) #CG with PR or BS updates { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, optim.method="CG", control=c(control, type=type), ...))[3] reslist <- c(reslist, list(res1fit)) } fullname <- c("BFGS", "NM", paste0("CG", c("FR", "PR", "BS"))) # 2 - methods without gradient with constraints if(hasbound) { for(meth in c("L-BFGS-B", "Nelder")) { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, optim.method=meth, control=control, lower=lower, upper=upper, ...))[3] reslist <- c(reslist, list(res1fit)) } fullname <- c(fullname, "L-BFGS-B", "NM-B") } # 3 - methods with gradient without constraint if(hasgrad) { for(meth in c("BFGS", "CG")) #CG with FR update { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, gradient=grad, optim.method=meth, control=control, ...))[3] reslist <- c(reslist, list(res1fit)) } for(type in 2:3) #CG with PR or BS updates { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, gradient=grad, optim.method="CG", control=c(control, type=type), ...))[3] reslist <- c(reslist, list(res1fit)) } fullname <- c(fullname, paste0("G-",c("BFGS", paste0("CG", c("FR", "PR", "BS")))) ) } # 4 - methods with gradient with constraints if(hasbound && hasgrad) { for(meth in c("BFGS", "Nelder", "CG")) #CG with FR update { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, optim.method=meth, control=control, lower=lower, upper=upper, gradient=grad, ...))[3] reslist <- c(reslist, list(res1fit)) } for(type in 2:3) #CG with PR or BS updates { res1fit$time <- system.time(res1fit <- mledist(data, distr=distr, optim.method="CG", control=c(control, type=type), lower=lower, upper=upper, gradient=grad, ...))[3] reslist <- c(reslist, list(res1fit)) } fullname <- c(fullname, paste0("G-", c("BFGS", "NM", paste0("CG", c("FR", "PR", "BS"))), "-B") ) } names(reslist) <- fullname getval <- function(x) c(x$estimate, loglik=x$loglik, x$counts, x$time) #suspect behavior if(any(sapply(reslist, length) != 12)) { print(sapply(reslist, length)) } resmat <- sapply(reslist, getval) if(is.null(dim(resmat))) stop("wrong extract") allname <- c(paste("fitted", names(reslist[[1]]$estimate)), "fitted loglik", "func. eval. nb.", "grad. eval. nb.", "time (sec)") if(NROW(resmat) != length(allname)) stop("wrong extract") else rownames(resmat) <- allname resmat }fitdistrplus/R/util-isint.R0000644000176200001440000000534513742313702015444 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### test if integers ### ### R functions ### #test if the weight vector contains integer values is.int.w <- function(x) { x <- x - floor(x) abs(x) < .Machine$double.eps } #test if the weight vector contains only integer values is.allint.w <- function(x) all(is.int.w(x)) fitdistrplus/R/descdist.R0000644000176200001440000002473613742313702015152 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### Description of an empirical distribution ### ### R functions ### descdist <- function(data, discrete = FALSE, boot = NULL, method = "unbiased", graph = TRUE, obs.col = "darkblue", obs.pch = 16, boot.col = "orange") { #if(is.mcnode(data)) data <- as.vector(data) if (missing(data) || !is.vector(data,mode="numeric")) stop("data must be a numeric vector") if (length(data) < 4) stop("data must be a numeric vector containing at least four values") moment <- function(data,k){ m1 <- mean(data) return(sum((data-m1)^k)/length(data)) } if (method=="unbiased") { skewness <- function(data){ # unbiased estimation (Fisher 1930) sd <- sqrt(moment(data,2)) n <- length(data) gamma1 <- moment(data,3)/sd^3 unbiased.skewness <- sqrt(n*(n-1)) * gamma1 / (n-2) return(unbiased.skewness) } kurtosis <- function(data){ # unbiased estimation (Fisher 1930) n <- length(data) var<-moment(data,2) gamma2 <- moment(data,4)/var^2 unbiased.kurtosis <- (n-1)/ ((n-2)*(n-3)) * ((n+1)*gamma2 -3*(n-1) ) + 3 return(unbiased.kurtosis) } standdev <- function(data){ sd(data) } } else if (method=="sample") { skewness <- function(data) { sd <- sqrt(moment(data, 2)) return(moment(data, 3)/sd^3) } kurtosis <- function(data) { var <- moment(data, 2) return(moment(data, 4)/var^2) } standdev <- function(data){ sqrt(moment(data,2)) } } else stop("The only possible value for the argument method are 'unbiased' or 'sample'") res <- list(min=min(data),max=max(data),median=median(data), mean=mean(data),sd=standdev(data), skewness=skewness(data),kurtosis=kurtosis(data), method = method) skewdata<-res$skewness kurtdata<-res$kurtosis # Cullen and Frey graph if (graph) { # bootstrap sample for observed distribution # and computation of kurtmax from this sample if (!is.null(boot)) { if (!is.numeric(boot) || boot<10) { stop("boot must be NULL or a integer above 10") } n<-length(data) databoot<-matrix(sample(data,size=n*boot,replace=TRUE),nrow=n,ncol=boot) s2boot<-sapply(1:boot,function(iter) skewness(databoot[,iter])^2) kurtboot<-sapply(1:boot,function(iter) kurtosis(databoot[,iter])) kurtmax<-max(10,ceiling(max(kurtboot))) xmax<-max(4,ceiling(max(s2boot))) } else{ kurtmax<-max(10,ceiling(kurtdata)) xmax<-max(4,ceiling(skewdata^2)) } ymax<-kurtmax-1 plot(skewdata^2,kurtmax-kurtdata,pch=obs.pch,xlim=c(0,xmax),ylim=c(0,ymax), yaxt="n",xlab="square of skewness",ylab="kurtosis",main="Cullen and Frey graph") yax<-as.character(kurtmax-0:ymax) axis(side=2,at=0:ymax,labels=yax) if (!discrete) { # beta dist p<-exp(-100) lq<-seq(-100,100,0.1) q<-exp(lq) s2a<-(4*(q-p)^2*(p+q+1))/((p+q+2)^2*p*q) ya<-kurtmax-(3*(p+q+1)*(p*q*(p+q-6)+2*(p+q)^2)/(p*q*(p+q+2)*(p+q+3))) p<-exp(100) lq<-seq(-100,100,0.1) q<-exp(lq) s2b<-(4*(q-p)^2*(p+q+1))/((p+q+2)^2*p*q) yb<-kurtmax-(3*(p+q+1)*(p*q*(p+q-6)+2*(p+q)^2)/(p*q*(p+q+2)*(p+q+3))) s2<-c(s2a,s2b) y<-c(ya,yb) polygon(s2,y,col="lightgrey",border="lightgrey") # gamma dist lshape<-seq(-100,100,0.1) shape<-exp(lshape) s2<-4/shape y<-kurtmax-(3+6/shape) lines(s2,y,lty=2) # lnorm dist lshape<-seq(-100,100,0.1) shape<-exp(lshape) es2<-exp(shape^2) s2<-(es2+2)^2*(es2-1) y<-kurtmax-(es2^4+2*es2^3+3*es2^2-3) lines(s2,y,lty=3) legend(xmax*0.2,ymax*1.03,pch=obs.pch,legend="Observation",bty="n",cex=0.8,pt.cex=1.2,col=obs.col) if (!is.null(boot)) { legend(xmax*0.2,ymax*0.98,pch=1,legend="bootstrapped values", bty="n",cex=0.8,col=boot.col) } legend(xmax*0.55,ymax*1.03,legend="Theoretical distributions",bty="n",cex=0.8) legend(xmax*0.6,0.98*ymax,pch=8,legend="normal",bty="n",cex=0.8) legend(xmax*0.6,0.94*ymax,pch=2,legend="uniform",bty="n",cex=0.8) legend(xmax*0.6,0.90*ymax,pch=7,legend="exponential",bty="n",cex=0.8) legend(xmax*0.6,0.86*ymax,pch=3,legend="logistic",bty="n",cex=0.8) legend(xmax*0.6,0.82*ymax,fill="grey80",legend="beta",bty="n",cex=0.8) legend(xmax*0.6,0.78*ymax,lty=3,legend="lognormal",bty="n",cex=0.8) legend(xmax*0.6,0.74*ymax,lty=2,legend="gamma",bty="n",cex=0.8) legend(xmax*0.58,0.69*ymax,legend=c("(Weibull is close to gamma and lognormal)"), bty="n",cex=0.6) } else { # negbin dist p<-exp(-10) lr<-seq(-100,100,0.1) r<-exp(lr) s2a<-(2-p)^2/(r*(1-p)) ya<-kurtmax-(3+6/r+p^2/(r*(1-p))) p<-1-exp(-10) lr<-seq(100,-100,-0.1) r<-exp(lr) s2b<-(2-p)^2/(r*(1-p)) yb<-kurtmax-(3+6/r+p^2/(r*(1-p))) s2<-c(s2a,s2b) y<-c(ya,yb) polygon(s2,y,col="grey80",border="grey80") legend(xmax*0.2,ymax*1.03,pch=obs.pch,legend="Observation",bty="n",cex=0.8,pt.cex=1.2, col = obs.col) if (!is.null(boot)) { legend(xmax*0.2,ymax*0.98,pch=1,legend="bootstrapped values", bty="n",cex=0.8,col=boot.col) } legend(xmax*0.55,ymax*1.03,legend="Theoretical distributions",bty="n",cex=0.8) legend(xmax*0.6,0.98*ymax,pch=8,legend="normal",bty="n",cex=0.8) legend(xmax*0.6,0.94*ymax,fill="grey80",legend="negative binomial", bty="n",cex=0.8) legend(xmax*0.6,0.90*ymax,lty=2,legend="Poisson",bty="n",cex=0.8) # poisson dist llambda<-seq(-100,100,0.1) lambda<-exp(llambda) s2<-1/lambda y<-kurtmax-(3+1/lambda) lines(s2,y,lty=2) } # bootstrap sample for observed distribution if (!is.null(boot)) { points(s2boot,kurtmax-kurtboot,pch=1,col=boot.col,cex=0.5) } # observed distribution points(skewness(data)^2,kurtmax-kurtosis(data),pch=obs.pch,cex=2,col=obs.col) # norm dist points(0,kurtmax-3,pch=8,cex=1.5,lwd=2) if (!discrete) { # unif dist points(0,kurtmax-9/5,pch=2,cex=1.5,lwd=2) # exp dist points(2^2,kurtmax-9,pch=7,cex=1.5,lwd=2) # logistic dist points(0,kurtmax-4.2,pch=3,cex=1.5,lwd=2) } } # end of is (graph) return(structure(res, class = "descdist")) } print.descdist <- function(x, ...) { if (!inherits(x, "descdist")) stop("Use only with 'descdist' objects") cat("summary statistics\n") cat("------\n") cat("min: ",x$min," max: ",x$max,"\n") cat("median: ",x$median,"\n") cat("mean: ",x$mean,"\n") if (x$method=="sample") { cat("sample sd: ",x$sd,"\n") cat("sample skewness: ",x$skewness,"\n") cat("sample kurtosis: ",x$kurtosis,"\n") } else if (x$method=="unbiased") { cat("estimated sd: ",x$sd,"\n") cat("estimated skewness: ",x$skewness,"\n") cat("estimated kurtosis: ",x$kurtosis,"\n") } } fitdistrplus/R/mgedist.R0000644000176200001440000004246213742313702015000 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### maximum goodness-of-fit estimation for censored or non-censored data ### and continuous distributions ### (at this time only available for non censored data) ### ### R functions ### mgedist <- function (data, distr, gof = "CvM", start=NULL, fix.arg=NULL, optim.method="default", lower=-Inf, upper=Inf, custom.optim=NULL, silent=TRUE, gradient=NULL, checkstartfix=FALSE, ...) # data may correspond to a vector for non censored data or to # a dataframe of two columns named left and right for censored data { if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr if (is.element(distname,c("binom","nbinom","geom","hyper","pois"))) stop("Maximum goodness-of-fit estimation method is not intended to fit discrete distributions") pdistname <- paste("p",distname,sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) ddistname <- paste("d",distname,sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) argddistname <- names(formals(ddistname)) if(is.null(custom.optim)) optim.method <- match.arg(optim.method, c("default", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent")) gof <- match.arg(gof, c("CvM", "KS", "AD", "ADR", "ADL", "AD2R", "AD2L", "AD2")) start.arg <- start #to avoid confusion with the start() function of stats pkg (check is done lines 87-100) if(is.vector(start.arg)) #backward compatibility start.arg <- as.list(start.arg) my3dots <- list(...) if ("weights" %in% names(my3dots)) stop("Weights is not allowed for maximum GOF estimation") if (is.vector(data)) { cens <- FALSE if (!(is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1 for non censored data or a dataframe with two columns named left and right and more than one line for censored data") } else { cens <- TRUE censdata <- data if (!(is.vector(censdata$left) & is.vector(censdata$right) & length(censdata[,1])>1)) stop("data must be a numeric vector of length greater than 1 for non censored data or a dataframe with two columns named left and right and more than one line for censored data") pdistname<-paste("p",distname,sep="") if (!exists(pdistname,mode="function")) stop(paste("The ",pdistname," function must be defined to apply maximum likelihood to censored data")) } if (cens) { # Definition of datasets lcens (left censored)=vector, rcens (right censored)= vector, # icens (interval censored) = dataframe with left and right # and ncens (not censored) = vector lcens<-censdata[is.na(censdata$left),]$right if (any(is.na(lcens)) ) stop("An observation cannot be both right and left censored, coded with two NA values") rcens<-censdata[is.na(censdata$right),]$left ncens<-censdata[censdata$left==censdata$right & !is.na(censdata$left) & !is.na(censdata$right),]$left icens<-censdata[censdata$left!=censdata$right & !is.na(censdata$left) & !is.na(censdata$right),] # Definition of a data set for calculation of starting values data<-c(rcens,lcens,ncens,(icens$left+icens$right)/2) } if(!checkstartfix) #pre-check has not been done by fitdist() or bootdist() { # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #set fix.arg.fun if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL }else #pre-check has been done by fitdist() or bootdist() { arg_startfix <- list(start.arg=start, fix.arg=fix.arg) fix.arg.fun <- NULL } #unlist starting values as needed in optim() vstart <- unlist(arg_startfix$start.arg) #sanity check if(is.null(vstart)) stop("Starting values could not be NULL with checkstartfix=TRUE") #erase user value #(cannot coerce to vector as there might be different modes: numeric, character...) fix.arg <- arg_startfix$fix.arg ############# MGE fit using optim or custom.optim ########## # definition of the function to minimize depending on the argument gof # for non censored data if (!cens) { # the argument names are: # - par for parameters (like in optim function) # - fix.arg for optional fixed parameters # - obs for observations (previously dat but conflicts with genoud data.type.int argument) # - pdistnam for distribution name if (gof == "CvM") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) 1/(12*n) + sum( ( theop - (2 * 1:n - 1)/(2 * n) )^2 ) } else if (gof == "KS") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) obspu <- seq(1,n)/n obspl <- seq(0,n-1)/n theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) max(pmax(abs(theop-obspu),abs(theop-obspl))) } else if (gof == "AD") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) - n - mean( (2 * 1:n - 1) * (log(theop) + log(1 - rev(theop))) ) } else if (gof == "ADR") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) n/2 - 2 * sum(theop) - mean ( (2 * 1:n - 1) * log(1 - rev(theop)) ) } else if (gof == "ADL") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) -3*n/2 + 2 * sum(theop) - mean ( (2 * 1:n - 1) * log(theop) ) } else if (gof == "AD2R") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) 2 * sum(log(1 - theop)) + mean ( (2 * 1:n - 1) / (1 - rev(theop)) ) } else if (gof == "AD2L") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) 2 * sum(log(theop)) + mean ( (2 * 1:n - 1) / theop ) } else if (gof == "AD2") fnobj <- function(par, fix.arg, obs, pdistnam) { n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam,c(list(s),as.list(par),as.list(fix.arg))) 2 * sum(log(theop) + log(1 - theop) ) + mean ( ((2 * 1:n - 1) / theop) + ((2 * 1:n - 1) / (1 - rev(theop))) ) } } else # if (!cens) stop("Maximum goodness-of-fit estimation is not yet available for censored data.") # Function to calculate the loglikelihood to return loglik <- function(par, fix.arg, obs, ddistnam) { sum(log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } owarn <- getOption("warn") # Try to minimize the gof distance using the base R optim function if(is.null(custom.optim)) { hasbound <- any(is.finite(lower) | is.finite(upper)) # Choice of the optimization method if (optim.method == "default") { meth <- ifelse(length(vstart) > 1, "Nelder-Mead", "BFGS") }else meth <- optim.method if(meth == "BFGS" && hasbound && is.null(gradient)) { meth <- "L-BFGS-B" txt1 <- "The BFGS method cannot be used with bounds without provided the gradient." txt2 <- "The method is changed to L-BFGS-B." warning(paste(txt1, txt2)) } options(warn=ifelse(silent, -1, 0)) #select optim or constrOptim if(hasbound) #finite bounds are provided { if(!is.null(gradient)) { opt.fun <- "constrOptim" }else #gradient == NULL { if(meth == "Nelder-Mead") opt.fun <- "constrOptim" else if(meth %in% c("L-BFGS-B", "Brent")) opt.fun <- "optim" else { txt1 <- paste("The method", meth, "cannot be used by constrOptim() nor optim() without gradient and bounds.") txt2 <- "Only optimization methods L-BFGS-B, Brent and Nelder-Mead can be used in such case." stop(paste(txt1, txt2)) } } if(opt.fun == "constrOptim") { #recycle parameters npar <- length(vstart) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) # constraints are : Mat %*% theta >= Bnd, i.e. # +1 * theta[i] >= lower[i]; # -1 * theta[i] >= -upper[i] #select rows from the identity matrix haslow <- is.finite(lower) Mat <- diag(npar)[haslow, ] #select rows from the opposite of the identity matrix hasupp <- is.finite(upper) Mat <- rbind(Mat, -diag(npar)[hasupp, ]) colnames(Mat) <- names(vstart) rownames(Mat) <- paste0("constr", 1:NROW(Mat)) #select the bounds Bnd <- c(lower[is.finite(lower)], -upper[is.finite(upper)]) names(Bnd) <- paste0("constr", 1:length(Bnd)) initconstr <- Mat %*% vstart - Bnd if(any(initconstr < 0)) stop("Starting values must be in the feasible region.") opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobj, ui=Mat, ci=Bnd, grad=gradient, fix.arg=fix.arg, obs=data, pdistnam=pdistname, hessian=!is.null(gradient), method=meth, ...), silent=TRUE) if(!inherits(opttryerror, "try-error")) if(length(opt$counts) == 1) #appears when the initial point is a solution opt$counts <- c(opt$counts, NA) }else #opt.fun == "optim" { opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } }else #hasbound == FALSE { opt.fun <- "optim" opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The function optim encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, loglik = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The function optim failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=opt.fun, optim.method=meth, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights=NULL, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), gof=gof) } else # Try to minimize the gof distance using a user-supplied optim function { options(warn=ifelse(silent, -1, 0)) if (!cens) opttryerror <- try(opt <- custom.optim(fn=fnobj, fix.arg=fix.arg, obs=data, pdistnam=pdistname, par=vstart, ...), silent=TRUE) else stop("Maximum goodness-of-fit estimation is not yet available for censored data.") options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The customized optimization function encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The customized optimization function failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) argdot <- list(...) method.cust <- argdot$method res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=custom.optim, optim.method=method.cust, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights=NULL, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), gof=gof) } return(res) } fitdistrplus/R/util-npsurv-intercens.R0000644000176200001440000000736213742313702017644 0ustar liggesusers# ----------------------------------------------------------------------- # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Internal functions for handling interval censored data # # ----------------------------------------------------------------------- # # Original code from Yong Wang, 2020 # # ----------------------------------------------------------------------- # # Delta matrix = incidence matrix of maximal intersection intervals # Delta[i,j] = 1 indicates that ith observation is within jth interval # # see section 2.2, p3 of Wang & Taylor : Delta matrix is denoted S # An interval is either (Li, Ri] if Li < Ri, or [Li, Ri] if Li = Ri. Deltamatrix = function(LR) { #remove NAs id_noNA <- rowSums(is.na(LR)) == 0 LR <- LR[id_noNA,] L = LR[,1] R = LR[,2] ic = L != R # inverval-censored nc = sum(ic) # tol = max(R[R!=Inf]) * 1e-8 if(nc > 0) { L1 = L[ic] + max(R[R!=Inf]) * 1e-8 # open left endpoints LRc = cbind(c(L1, R[ic]), c(rep(0,nc), rep(1,nc)), rep(1:nc, 2)) LRc.o = LRc[order(LRc[,1]),] j = which(diff(LRc.o[,2]) == 1) left = L[ic][LRc.o[j,3]] right = R[ic][LRc.o[j+1,3]] } else left = right = numeric(0) if(nrow(LR) - nc > 0) { ut = unique(L[!ic]) jin = colSums(outer(ut, left, ">") & outer(ut, right, "<=")) > 0 left = c(ut, left[!jin]) # remove those that contain exact obs. right = c(ut, right[!jin]) o = order(left, right) left = left[o] right = right[o] } ## D = outer(L, left, "<=") & outer(R, right, ">=") D = outer(L, left, "<=") & outer(R, right, ">=") & (outer(L, right, "<") | outer(R, left, "==")) colnames(D) <- paste0("left=", round(left, 1), "-right=", round(right, 1)) rownames(D) <- paste0("obs", 1:length(L)) names(left) = names(right) = NULL list(left=left, right=right, Delta=D) } # interval distribution function, i.e., a distribution function defined on # a set of intervals. # left Left endpoints of the intervals # right Right endpoints of the intervals # p Probability masses allocated to the intervals idf = function(left, right, p) { if(length(left) != length(right)) stop("length(left) != length(right)") names(left) = names(right) = names(p) = NULL p = rep(p, length=length(left)) f = list(left=left, right=right, p=p/sum(p)) f } idf2data.frame <- function(object) { if(inherits(object, "idf")) data.frame(left=object$left, right=object$right, p=object$p) else as.data.frame(object) } icendata = function(x, w=1) { if(is.null(x)) return(NULL) if(is.icendata(x)) { if(all(w == 1)) return(x) w = rep(w, length = length(x$t) + nrow(x$o)) if(length(x$t) > 0) x$wt = x$wt * w[1:length(x$wt)] if(nrow(x$o) > 0) x$wo = x$wo * w[length(x$wt)+1:nrow(x$o)] return(x) } z = vector("list", 7) names(z) = c("t", "wt", "o", "wo", "i1", "upper", "u") if(is.vector(x)) x = cbind(x, x) if(!is.matrix(x)) x = as.matrix(x) if(ncol(x) == 3) {w = w * x[,3]; x = x[,1:2]} if(length(w) != nrow(x)) w = rep(w, len=nrow(x)) iw = w > 0 w = w[iw] x = x[iw,,drop=FALSE] o = order(x[,1], x[,2]) x = x[o,] w = w[o] id = c(TRUE, diff(x[,1]) > 0 | diff(x[,2]) > 0) id[is.na(id)] = FALSE # for Inf's w = aggregate(w, by=list(group=cumsum(id)), sum)[,2] x = x[id,] i = x[,1] == x[,2] z$t = x[i,1] names(z$t) = NULL z$wt = w[i] z$o = x[!i,1:2,drop=FALSE] dimnames(z$o) = list(NULL, c("L","R")) z$wo = w[!i] z$upper = max(x[,1]) z$i1 = z$t != z$upper z$u = sort(unique(c(0, pmin(c(x[,1], x[,2]), z$upper)))) class(z) = "icendata" z } is.icendata = function(x) "icendata" %in% class(x) fitdistrplus/R/plotdist.R0000644000176200001440000003023013742313702015174 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot functions for non-censored data ### ### R functions ### plotdist <- function(data, distr, para, histo = TRUE, breaks="default", demp = FALSE, discrete, ...) { def.par <- par(no.readonly = TRUE) if (missing(data) || !is.vector(data, mode="numeric")) stop("data must be a numeric vector") if ((missing(distr) & !missing(para)) || (missing(distr) & !missing(para))) stop("distr and para must defined") if (!histo & !demp) stop("one the arguments histo and demp must be put to TRUE") xlim <- c(min(data), max(data)) # for plot of discrete distributions s <- sort(data) n <- length(data) if (missing(distr)) { ## Plot of data only par(mfrow=c(1, 2)) if(missing(discrete)) discrete <- FALSE if (!discrete) { # plot for continuous data alone obsp <- ppoints(s) # PLOT 1 --- if (histo) { if(demp) { if (breaks=="default") h <- hist(data, freq=FALSE, xlab="Data", main="Empirical density", ...) else h <- hist(data, freq=FALSE, xlab="Data", main="Empirical density", breaks=breaks, ...) lines(density(data)$x, density(data)$y, lty=2, col="black") } else { if (breaks=="default") h <- hist(data, freq=FALSE, xlab="Data", main="Histogram", ...) else h <- hist(data, freq=FALSE, xlab="Data", main="Histogram", breaks=breaks, ...) } } else { h <- hist(data, freq=FALSE, xlab="Data", main="Histogram", plot = FALSE, ...) plot(density(data)$x, density(data)$y, lty=1, col="black", type = "l", xlab="Data", main=paste("Empirical density"), ylab = "Density",...) } # PLOT 2 --- plot(s, obsp, main=paste("Cumulative distribution"), xlab="Data", xlim=c(h$breaks[1], h$breaks[length(h$breaks)]), ylab="CDF", ...) } else { # plot for discrete data alone if (breaks!="default") warning("Breaks are not taken into account for discrete data") # plot of empirical distribution t <- table(data) xval <- as.numeric(names(t)) # xvalfin <- seq(min(xval), max(xval),by=1) ydobs <- as.vector(t)/n ydmax <- max(ydobs) plot(xval, ydobs, type="h", xlim=xlim, ylim=c(0, ydmax), main="Empirical distribution", xlab="Data", ylab="Density", ...) # plot of the cumulative probability distributions ycdfobs <- cumsum(ydobs) plot(xval, ycdfobs, type="p", xlim=xlim, ylim=c(0, 1), main="Empirical CDFs", xlab="Data", ylab="CDF", ...) } } #end of if (missing(distr)) else { # plot of data and distribution if (!is.character(distr)) distname <- substring(as.character(match.call()$distr), 2) else distname <- distr if (!is.list(para)) stop("'para' must be a named list") ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) pdistname <- paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) qdistname <- paste("q", distname, sep="") if (!exists(qdistname, mode="function")) stop(paste("The ", qdistname, " function must be defined")) densfun <- get(ddistname, mode="function") nm <- names(para) f <- formals(densfun) args <- names(f) m <- match(nm, args) if (any(is.na(m))) stop(paste("'para' specifies names which are not arguments to ", ddistname)) if(missing(discrete)) { if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) discrete <- TRUE else discrete <- FALSE } if (!discrete) { # plot of continuous data with theoretical distribution par(mfrow=c(2, 2)) obsp <- ppoints(s) # plot of empirical and theoretical density # computes densities in order to define limits for y-axis if (breaks=="default") h <- hist(data, plot=FALSE) else h <- hist(data, breaks=breaks, plot=FALSE, ...) xhist <- seq(min(h$breaks), max(h$breaks), length=1000) yhist <- do.call(ddistname, c(list(xhist), as.list(para))) if(length(yhist) != length(xhist)) stop("problem when computing densities.") ymax <- ifelse(is.finite(max(yhist)), max(max(h$density), max(yhist)), max(h$density)) # PLOT 1 - plot of empirical and theoretical density # empirical density if (histo) { hist(data, freq=FALSE, xlab="Data", ylim=c(0, ymax), breaks=h$breaks, main=paste("Empirical and theoretical dens."), ...) if(demp) { lines(density(data)$x, density(data)$y, lty=2, col="black") } } else plot(density(data)$x, density(data)$y, lty=2, col="black", type = "l", xlab="Data", main=paste("Empirical and theoretical dens."), ylab = "Density", xlim = c(min(h$breaks), max(h$breaks)), ...) if (demp) legend("topright",bty="n",lty=c(2,1),col=c("black","red"), legend=c("empirical","theoretical"), bg="white",cex=0.7) # Add of theoretical density lines(xhist, yhist,lty=1,col="red") # PLOT 2 - plot of the qqplot theoq <- do.call(qdistname, c(list(obsp), as.list(para))) if(length(theoq) != length(obsp)) stop("problem when computing quantities.") plot(theoq, s, main=" Q-Q plot", xlab="Theoretical quantiles", ylab="Empirical quantiles", ...) abline(0, 1) # PLOT 3 - plot of the cumulative probability distributions xmin <- h$breaks[1] xmax <- h$breaks[length(h$breaks)] if(length(s) != length(obsp)) stop("problem when computing probabilities.") plot(s, obsp, main=paste("Empirical and theoretical CDFs"), xlab="Data", ylab="CDF", xlim=c(xmin, xmax), ...) sfin <- seq(xmin, xmax, by=(xmax-xmin)/100) theopfin <- do.call(pdistname, c(list(sfin), as.list(para))) lines(sfin, theopfin, lty=1,col="red") # PLOT 4 - plot of the ppplot theop <- do.call(pdistname, c(list(s), as.list(para))) if(length(theop) != length(obsp)) stop("problem when computing probabilities.") plot(theop, obsp, main="P-P plot", xlab="Theoretical probabilities", ylab="Empirical probabilities", ...) abline(0, 1) } else { # plot of discrete data with theoretical distribution par(mfrow=c(1, 2)) if (breaks!="default") warning("Breaks are not taken into account for discrete distributions") # plot of empirical and theoretical distributions t <- table(data) xval <- as.numeric(names(t)) xvalfin <- seq(min(xval), max(xval),by=1) xlinesdec <- min((max(xval)-min(xval))/30, 0.4) yd <- do.call(ddistname, c(list(xvalfin), as.list(para))) if(length(yd) != length(xvalfin)) stop("problem when computing density points.") ydobs <- as.vector(t)/n ydmax <- max(yd, ydobs) plot(xvalfin+xlinesdec, yd, type='h', xlim=c(min(xval), max(xval)+xlinesdec), ylim=c(0, ydmax), lty=1, col="red", main="Emp. and theo. distr.", xlab="Data", ylab="Density", ...) points(xval, ydobs, type='h', lty=1, col="black",...) legend("topright", lty=c(1, 1), col=c("black","red"), legend=c("empirical", paste("theoretical")), bty="o", bg="white",cex=0.6,...) # plot of the cumulative probability distributions ycdf <- do.call(pdistname, c(list(xvalfin), as.list(para))) if(length(ycdf) != length(xvalfin)) stop("problem when computing probabilities.") plot(xvalfin, ycdf, type="s", xlim=c(min(xval), max(xval)+xlinesdec), ylim=c(0, 1), lty=1, col="red", main="Emp. and theo. CDFs", xlab="Data", ylab="CDF", ...) # plot(xvalfin+xlinesdec, ycdf, type="h", xlim=c(min(xval), max(xval)+xlinesdec), # ylim=c(0, 1), lty=3, col="red", # main="Emp. and theo. CDFs", xlab="Data", # ylab="CDF", ...) ycdfobs <- cumsum(ydobs) points(xval,ycdfobs, type="p", col="black",...) legend("bottomright", lty=c(1, 1), col=c("black","red"), legend=c("empirical", paste("theoretical")), bty="o", bg ="white",cex=0.6,...) } } par(def.par) invisible() } fitdistrplus/R/prefit.R0000644000176200001440000003071013742313702014626 0ustar liggesusers############################################################################# # Copyright (c) 2016 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### prefit for maximum likelihood estimation ### ### R functions ### #search good starting values prefit <- function(data, distr, method = c("mle", "mme", "qme", "mge"), feasible.par, memp=NULL, order=NULL, probs=NULL, qtype=7, gof=NULL, fix.arg=NULL, lower, upper, weights=NULL, silent=TRUE, ...) { if (!is.character(distr)) distname <- substring(as.character(match.call()$distr), 2) else distname <- distr method <- match.arg(method, c("mle", "mme", "qme", "mge")) if(method != "qme" && !is.null(probs)) stop("probs is not needed") if(method != "mme" && (!is.null(memp) || !is.null(order))) stop("memp, order are not needed") if(method != "mge" && !is.null(gof)) stop("gof is not needed") ddistname <- paste0("d", distname) if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) pdistname <- paste0("p", distname) if (!exists(pdistname, mode="function") && method == "mge") stop(paste("The ", pdistname, " function must be defined")) qdistname <- paste0("q",distname) if (!exists(qdistname, mode="function") && method == "qme") stop(paste("The ", qdistname, " function must be defined")) mdistname <- paste0("m",distname) if (!exists(mdistname, mode="function") && method == "mme") stop(paste("The ", mdistname, " function must be defined")) if(is.null(probs) && method == "qme") stop("probs must be provided") if(is.null(order) && method == "mme") stop("order must be provided") if(missing(feasible.par)) stop("feasible values must be provided") if(missing(lower) || missing(upper)) stop("bounds (yet infinite) must be provided") #recycle parameters if(is.list(feasible.par)) feasible.par <- unlist(feasible.par) npar <- length(feasible.par) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) if(all(is.infinite(lower)) && all(is.infinite(upper))) { bnd <- detectbound(distname, feasible.par, data, fix.arg=fix.arg) }else { bnd <- rbind(lower, upper) colnames(bnd) <- names(feasible.par) rownames(bnd) <- c("lowb", "uppb") } if(!silent) print(bnd) translist <- invlist <- NULL for(i in 1:NCOL(bnd)) { if(bnd["lowb", i] == -Inf && bnd["uppb", i] == Inf) { translist <- c(translist, list(function(x) x)) invlist <- c(invlist, list(function(x) x)) }else if(bnd["lowb", i] == 0 && bnd["uppb", i] == Inf) { translist <- c(translist, list(T0Inf)) invlist <- c(invlist, list(iT0Inf)) }else if(bnd["lowb", i] == 1 && bnd["uppb", i] == Inf) { translist <- c(translist, list(T1Inf)) invlist <- c(invlist, list(iT1Inf)) }else if(bnd["lowb", i] == 0 && bnd["uppb", i] == 1) { translist <- c(translist, list(T01)) invlist <- c(invlist, list(iT01)) }else if(bnd["lowb", i] == -1 && bnd["uppb", i] == 0) { translist <- c(translist, list(Tm10)) invlist <- c(invlist, list(iTm10)) }else { print(bnd) stop("unknown parameter domain") } } if(!silent) print(translist) if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of numerics greater than 0") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") if(method == "mge") stop("weights is not allowed for maximum GOF estimation") } #maximum likelihood if(method == "mle") { if(is.null(weights)) weights <- rep(1, NROW(data)) fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) -sum( weights * log(do.call(ddistnam, c(list(obs), lpar, as.list(fix.arg)) ) ) ) } } #quantile matching if(method == "qme" && is.null(weights)) { DIFF2Q <- function(par, fix.arg, prob, obs, qdistnam, qtype) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) qtheo <- do.call(qdistnam, c(list(prob), lpar, as.list(fix.arg)) ) qemp <- as.numeric(quantile(obs, probs=prob, type=qtype)) (qemp - qtheo)^2 } fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) sum( sapply(probs, function(p) DIFF2Q(par, fix.arg, p, obs, qdistnam, qtype)) ) } if(method == "qme" && !is.null(weights)) { DIFF2Q <- function(par, fix.arg, prob, obs, qdistnam, qtype) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) qtheo <- do.call(qdistnam, c(list(prob), lpar, as.list(fix.arg)) ) qemp <- as.numeric(wtd.quantile(x=obs, weights=weights, probs=prob)) (qemp - qtheo)^2 } fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) sum( sapply(probs, function(p) DIFF2Q(par, fix.arg, p, obs, qdistnam, qtype)) ) } #moment matching if(method == "mme" && is.null(weights)) { DIFF2 <- function(par, fix.arg, order, obs, mdistnam, memp, weights) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) momtheo <- do.call(mdistnam, c(list(order), lpar, as.list(fix.arg)) ) momemp <- as.numeric(memp(obs, order)) (momemp - momtheo)^2 } fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) sum( sapply(order, function(o) DIFF2(par, fix.arg, o, obs, mdistnam, memp)) ) } if(method == "mme" && !is.null(weights)) { DIFF2 <- function(par, fix.arg, order, obs, mdistnam, memp, weights) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) momtheo <- do.call(mdistnam, c(list(order), lpar, as.list(fix.arg)) ) momemp <- as.numeric(memp(obs, order, weights)) (momemp - momtheo)^2 } fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) sum( sapply(order, function(o) DIFF2(par, fix.arg, o, obs, mdistnam, memp, weights)) ) } #gof matching if(method == "mge") { fnobj <- function(par, fix.arg, obs, ddistnam, qdistnam, pdistnam, mdistnam, qtype, memp, gof) { if(!is.list(par)) par <- as.list(par) lpar <- lapply(1:length(par), function(i) translist[[i]](par[[i]])) n <- length(obs) s <- sort(obs) theop <- do.call(pdistnam, c(list(s), lpar, as.list(fix.arg)) ) obspu <- seq(1,n)/n obspl <- seq(0,n-1)/n if (gof == "CvM") 1/(12*n) + sum( ( theop - (2 * 1:n - 1)/(2 * n) )^2 ) else if (gof == "KS") max(pmax(abs(theop-obspu),abs(theop-obspl))) else if (gof == "AD") - n - mean( (2 * 1:n - 1) * (log(theop) + log(1 - rev(theop))) ) else if (gof == "ADR") n/2 - 2 * sum(theop) - mean ( (2 * 1:n - 1) * log(1 - rev(theop)) ) else if (gof == "ADL") -3*n/2 + 2 * sum(theop) - mean ( (2 * 1:n - 1) * log(theop) ) else if (gof == "AD2R") 2 * sum(log(1 - theop)) + mean ( (2 * 1:n - 1) / (1 - rev(theop)) ) else if (gof == "AD2L") 2 * sum(log(theop)) + mean ( (2 * 1:n - 1) / theop ) else if (gof == "AD2") 2*sum(log(theop) + log(1 - theop)) + mean(((2*1:n - 1) / theop) + ((2*1:n - 1) / (1 - rev(theop)))) } } ltrans.par <- sapply(1:length(feasible.par), function(i) invlist[[i]](feasible.par[[i]])) if(!silent) { cat("before transform\n") print(unlist(feasible.par)) cat("after transform\n") print(unlist(ltrans.par)) } if(method == "mle") test1 <- try(fnobj(par=ltrans.par, fix.arg = fix.arg, obs=data, ddistnam = ddistname), silent=silent) if(method == "qme") test1 <- try(fnobj(par=ltrans.par, fix.arg = fix.arg, obs=data, qdistnam=qdistname, qtype=qtype), silent=silent) if(method == "mme") test1 <- try(fnobj(par=ltrans.par, fix.arg = fix.arg, obs=data, mdistnam=mdistname, memp=memp), silent=silent) if(method == "mge") test1 <- try(fnobj(par=ltrans.par, fix.arg = fix.arg, obs=data, pdistnam=pdistname, gof=gof), silent=silent) if(class(test1) == "try-error" || silent == FALSE) print(test1) #get old warning value and set it owarn <- options(warn=ifelse(silent, -1, 0)) if(method == "mle") opttryerror <- try(opt <- optim(par=ltrans.par, fn=fnobj, fix.arg=fix.arg, obs=data, ddistnam=ddistname, hessian=FALSE, method="BFGS", ...), silent=silent) if(method == "qme") opttryerror <- try(opt <- optim(par=ltrans.par, fn=fnobj, fix.arg=fix.arg, obs=data, qdistnam=qdistname, qtype=qtype, hessian=FALSE, method="BFGS", ...), silent=silent) if(method == "mme") opttryerror <- try(opt <- optim(par=ltrans.par, fn=fnobj, fix.arg=fix.arg, obs=data, mdistnam=mdistname, memp=memp, hessian=FALSE, method="BFGS", ...), silent=silent) if(method == "mge") opttryerror <- try(opt <- optim(par=ltrans.par, fn=fnobj, fix.arg=fix.arg, obs=data, pdistnam=pdistname, gof=gof, hessian=FALSE, method="BFGS", ...), silent=silent) #get back to old warning value on.exit(options(owarn), add=TRUE) if(class(opttryerror) == "try-error") stop("unsuccessful pre-fitting process") if(!silent) print(opt) if(opt$convergence %in% 0:1) #either successful or reached the iteration limit (see ?optim) { prefitpar <- unlist(sapply(1:length(opt$par), function(i) translist[[i]](opt$par[i]))) }else { prefitpar <- rep(NA, length(opt$par)) } names(prefitpar) <- names(feasible.par) as.list(prefitpar) } fitdistrplus/R/util-startarg.R0000644000176200001440000001147213742313702016143 0ustar liggesusers# start.arg.default function returns initial values of parameters generally using moments or quantiles # INPUTS #x : data vector or matrix #distr : the distribution name # OUTPUTS # a named list or raises an error start.arg.default <- function(x, distr) { if (distr == "norm") { n <- length(x) sd0 <- sqrt((n - 1)/n) * sd(x) mx <- mean(x) start <- list(mean=mx, sd=sd0) }else if (distr == "lnorm") { if (any(x <= 0)) stop("values must be positive to fit a lognormal distribution") n <- length(x) lx <- log(x) sd0 <- sqrt((n - 1)/n) * sd(lx) ml <- mean(lx) start <- list(meanlog=ml, sdlog=sd0) }else if (distr == "pois") { start <- list(lambda=mean(x)) }else if (distr == "exp") { if (any(x < 0)) stop("values must be positive to fit an exponential distribution") start <- list(rate=1/mean(x)) }else if (distr == "gamma") { if (any(x < 0)) stop("values must be positive to fit an gamma distribution") n <- length(x) m <- mean(x) v <- (n - 1)/n*var(x) start <- list(shape=m^2/v, rate=m/v) }else if (distr == "nbinom") { n <- length(x) m <- mean(x) v <- (n - 1)/n*var(x) size <- ifelse(v > m, m^2/(v - m), 100) start <- list(size = size, mu = m) }else if (distr == "geom" ) { m <- mean(x) prob <- ifelse(m>0, 1/(1+m), 1) start <- list(prob=prob) }else if (distr == "beta") { if (any(x < 0) | any(x > 1)) stop("values must be in [0-1] to fit a beta distribution") n <- length(x) m <- mean(x) v <- (n - 1)/n*var(x) aux <- m*(1-m)/v - 1 start <- list(shape1=m*aux, shape2=(1-m)*aux) }else if (distr == "weibull") { if (any(x < 0)) stop("values must be positive to fit an Weibull distribution") m <- mean(log(x)) v <- var(log(x)) shape <- 1.2/sqrt(v) scale <- exp(m + 0.572/shape) start <- list(shape = shape, scale = scale) }else if (distr == "logis") { n <- length(x) m <- mean(x) v <- (n - 1)/n*var(x) start <- list(location=m, scale=sqrt(3*v)/pi) }else if (distr == "cauchy") { start <- list(location=median(x), scale=IQR(x)/2) }else if (distr == "unif"){ start <- list(min=0, max=1) }else if (distr == "invgamma") { if (any(x < 0)) stop("values must be positive to fit an inverse gamma distribution") #http://en.wikipedia.org/wiki/Inverse-gamma_distribution m1 <- mean(x) m2 <- mean(x^2) shape <- (2*m2-m1^2)/(m2-m1^2) scale <- m1*m2/(m2-m1^2) start <- list(shape=shape, scale=scale) }else if (distr == "llogis") { if (any(x < 0)) stop("values must be positive to fit a log-logistic distribution") p25 <- as.numeric(quantile(x, 0.25)) p75 <- as.numeric(quantile(x, 0.75)) shape <- 2*log(3)/(log(p75)-log(p25)) scale <- exp(log(p75)+log(p25))/2 start <- list(shape=shape, scale=scale) }else if (distr == "invweibull") { if (any(x < 0)) stop("values must be positive to fit an inverse Weibull distribution") g <- log(log(4))/(log(log(4/3))) p25 <- as.numeric(quantile(x, 0.25)) p75 <- as.numeric(quantile(x, 0.75)) shape <- exp((g*log(p75)-log(p25))/(g-1)) scale <-log(log(4))/(log(shape)-log(p25)) start <- list(shape=shape, scale=max(scale, 1e-9)) }else if (distr == "pareto1") { if (any(x < 0)) stop("values must be positive to fit a Pareto distribution") #http://www.math.umt.edu/gideon/pareto.pdf x1 <- min(x) m1 <- mean(x) n <- length(x) shape <- (n*m1-x1)/(n*(m1-x1)) min <- x1*(n*shape - 1)/(n*shape) start <- list(shape=shape, min=min) }else if (distr == "pareto") { if (any(x < 0)) stop("values must be positive to fit a Pareto distribution") m1 <- mean(x) m2 <- mean(x^2) scale <- (m1*m2)/(m2-2*m1^2) shape <- 2*(m2-m1^2)/(m2-2*m1^2) start <- list(shape=shape, scale=scale) }else if (distr == "lgamma") { if (any(x < 0)) stop("values must be positive to fit a log-gamma distribution") #p228 of Klugmann and Hogg (1984) m1 <- mean(log(x)) m2 <- mean(log(x)^2) alpha <- m1^2/(m2-m1^2) lambda <- m1/(m2-m1^2) start <- list(shapelog=alpha, ratelog=lambda) }else if (distr == "trgamma") { if (any(x < 0)) stop("values must be positive to fit an trans-gamma distribution") #same as gamma with shape2=tau=1 n <- length(x) m <- mean(x) v <- (n - 1)/n*var(x) start <- list(shape1=m^2/v, shape2=1, rate=m/v) }else if (distr == "invtrgamma") { if (any(x < 0)) stop("values must be positive to fit an inverse trans-gamma distribution") #same as gamma with shape2=tau=1 n <- length(1/x) m <- mean(1/x) v <- (n - 1)/n*var(1/x) start <- list(shape1=m^2/v, shape2=1, rate=m/v) }else stop(paste0("Unknown starting values for distribution ", distr, ".")) return(start) } fitdistrplus/R/ppcompcens.R0000644000176200001440000002065713742313702015515 0ustar liggesusers############################################################################# # Copyright (c) 2018 Marie Laure Delignette-Muller, Christophe Dutang, # Aurelie Siberchicot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### PP plot for various fits ### of continuous distribution(s) (fitdistcens results) ### on a same dataset ### ### R functions ### ppcompcens <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fillrect, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, NPMLE.method = "Wang", plotstyle = "graphics", ...) { if(inherits(ft, "fitdistcens")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdistcens' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdistcens")))) stop("argument ft must be a list of 'fitdistcens' objects") } NPMLE.method <- match.arg(NPMLE.method, c("Wang", "Turnbull.intervals", "Turnbull.middlepoints")) if (NPMLE.method == "Turnbull.middlepoints") { warning("The PPcomp plot for censored data is not available with NPMLE.method at Turnbull.middlepoints. Turnbull.intervals will be used instead of Turnbull.middlepoints.") NPMLE.method <- "Turnbull.intervals" } # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("qqcompcens is not yet available when using weights") censdata <- ft[[1]]$censdata # check data verif.ftidata <- function(fti) { if (any(fti$censdata$left != censdata$left, na.rm=TRUE) | any(fti$censdata$right != censdata$right, na.rm=TRUE)) stop("All compared fits must have been obtained with the same dataset") } l <- lapply( ft, verif.ftidata) rm(l) if (xlogscale != ylogscale) { xlogscale <- ylogscale <- TRUE warning("As a Q-Q plot should use the same scale on x and y axes, both axes were put in a logarithmic scale.") } logxy <- paste(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y",""), sep="") # manage default parameters nft <- length(ft) if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) if (missing(fillrect)) if ((nft == 1) | plotstyle == "ggplot") fillrect <- "lightgrey" else fillrect <- NA # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } if (missing(xlab)) xlab <- "Theoretical probabilities" if (missing(ylab)) ylab <- "Empirical probabilities" if (missing(main)) main <- "P-P plot" # computation from censdata f <- npmle(censdata, method = NPMLE.method) if(missing(xlim) & missing(ylim)) { if (xlogscale == TRUE) { stop("You must define the limits of axes using xlim or ylim in order to use a logarithmic scale for a P-P plot with censored data.") } else { xlim <- ylim <- c(0, 1) } } else # at least xlim or ylim are specified { if (missing(xlim) | missing(ylim)) { warning("By default the same limits are applied to x and y axes. You should specifiy both if you want different x and y limits") if (missing(xlim)) xlim <- ylim else ylim <- xlim } } k <- length(f$left) Fnpsurv <- cumsum(f$p) Fbefore <- c(0, Fnpsurv[-k]) df <- data.frame(left = f$left, right = f$right) # Definition of vertices of each rectangle Qi.left <- df$left # dim k Qi.right <- df$right nQi <- length(Qi.left) Pi.low <- Fbefore Pi.up <- Fnpsurv lrect <- vector(mode = "list", length = nft) for(i in 1:nft) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname pdistname <- paste("p", distname, sep="") if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) warning(" Be careful, variables are considered continuous in this function!") Pitheo.low <- do.call(pdistname, c(list(Qi.left), as.list(para))) Pitheo.up <- do.call(pdistname, c(list(Qi.right), as.list(para))) lrect[[i]] <- data.frame(Pitheo.low = Pitheo.low, Pitheo.up = Pitheo.up, Pi.low = Pi.low, Pi.up = Pi.up, ind = legendtext[i]) } if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## # main plot plot(1, 1, type = "n", main = main, xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, log = logxy) # plot of rectangles plot.fti <- function(i, ...) { Pitheo.low <- lrect[[i]]$Pitheo.low Pi.low <- lrect[[i]]$Pi.low Pitheo.up <- lrect[[i]]$Pitheo.up Pi.up <- lrect[[i]]$Pi.up if (ynoise & nft > 1) { if (xlogscale == TRUE) { noise2mult <- runif(nQi, 0.99, 1.01) rect(xleft = Pitheo.low, ybottom = Pi.low * noise2mult, xright = Pitheo.up, ytop = Pi.up * noise2mult, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } else { noise2add <- runif(nQi, -0.01, 0.01) rect(xleft = Pitheo.low, ybottom = Pi.low + noise2add, xright = Pitheo.up, ytop = Pi.up + noise2add, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } } else # ! ynoise { rect(xleft = Pitheo.low, ybottom = Pi.low, xright = Pitheo.up, ytop = Pi.up, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } } s <- sapply(1:nft, plot.fti, ...) rm(s) if(line01) abline(0, 1, lty = line01lty, col = line01col) if (addlegend) { legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, lty = 1, lwd = fitlwd, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## drect <- do.call("rbind", lrect) ind <- as.factor(drect$ind) fitcol <- rep(fitcol, table(ind)) fitlwd <- rep(fitlwd, table(ind)) fillrect <- if(length(fillrect) > 1) {rep(fillrect, table(ind))} else {fillrect} ggppcompcens <- ggplot2::ggplot(drect) + ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + ggplot2::ggtitle(main) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::geom_rect(data=drect, mapping=ggplot2::aes_(xmin=quote(Pitheo.low), xmax=quote(Pitheo.up), ymin=quote(Pi.low), ymax=quote(Pi.up)), colour = fitcol, fill = fillrect, alpha=0.5, size = fitlwd) + ggplot2::theme_bw() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) + {if(line01) ggplot2::geom_abline(ggplot2::aes(slope = 1, intercept = 0), color = line01col, linetype = line01lty)} + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} + ggplot2::facet_wrap(~ind) return(ggppcompcens) } } fitdistrplus/R/util-npmle.R0000644000176200001440000000230513742313702015422 0ustar liggesusers# ----------------------------------------------------------------------- # # Copyright (c) 2020 Marie Laure Delignette-Muller # # and Christophe Dutang # # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Function calling alternatives to npsurv() from the npsurv package # # ----------------------------------------------------------------------- # npmle <- function(censdata, method = "Wang") { method <- match.arg(method, c("Wang", "Turnbull.intervals")) if (method == "Wang") { db <- censdata db$left[is.na(db$left)] <- -Inf db$right[is.na(db$right)] <- Inf r <- npsurv.minimal(db, pkg="stats") if (r$convergence) { f <- as.data.frame(r$f) } else { warning("Due to lack of convergence of Wang algorithm, method Turnbull.intervals was used instead for NPMLE") f <- Turnbull.intervals(censdata) } } else if (method == "Turnbull.intervals") { f <- Turnbull.intervals(censdata) } return(f) } fitdistrplus/R/bootdist.R0000644000176200001440000002450713742313702015173 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### bootstrap in fitdistrplus ### ### R functions ### bootdist <- function (f, bootmethod="param", niter=1001, silent=TRUE, parallel = c("no", "snow", "multicore"), ncpus) { if (niter<10) stop("niter must be an integer above 10") bootmethod <- match.arg(bootmethod, c("param", "nonparam")) parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "multicore" & .Platform$OS.type == "windows") { parallel <- "snow" warning("As the multicore option is not supported on Windows it was replaced by snow") } if ((parallel == "snow" | parallel == "multicore") & missing(ncpus)) stop("You have to specify the number of available processors to parallelize the bootstrap") if (!inherits(f, "fitdist")) stop("Use only with 'fitdist' objects") if(!is.null(f$weights)) stop("Bootstrap is not yet available when using weights") #simulate bootstrap data if (bootmethod == "param") { # parametric bootstrap rdistname <- paste("r", f$distname, sep="") if (!exists(rdistname, mode="function")) stop(paste("The ", rdistname, " function must be defined")) rdata <- do.call(rdistname, c(list(niter*f$n), as.list(f$estimate), f$fix.arg)) dim(rdata) <- c(f$n, niter) } else { # non parametric bootstrap rdata <- sample(f$data, size=niter*f$n, replace=TRUE) dim(rdata) <- c(f$n, niter) } #compute bootstrap estimates foncestim <- switch(f$method, "mle"=mledist, "qme"=qmedist, "mme"=mmedist, "mge"=mgedist, "mse"=msedist) start <- as.list(f$estimate) #a named vector is no longer is accepted as starting values. if(is.function(f$fix.arg.fun)) fix.arg <- f$fix.arg.fun else fix.arg <- f$fix.arg if (is.null(f$dots) && !is.function(fix.arg)) { func <- function(iter) { res <- try(do.call(foncestim, list(data=rdata[, iter], distr=f$distname, start=start, fix.arg=fix.arg, checkstartfix=TRUE)), silent=silent) if(inherits(res, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(res$estimate, res$convergence)) } }else if (is.null(f$dots) && is.function(fix.arg)) { func <- function(iter) { fix.arg.iter <- fix.arg(rdata[, iter]) res <- try(do.call(foncestim, list(data=rdata[, iter], distr=f$distname, start=start, fix.arg=fix.arg.iter, checkstartfix=TRUE)), silent=silent) if(inherits(res, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(res$estimate, res$convergence)) } }else if(!is.null(f$dots) && !is.function(fix.arg)) { func <- function(iter) { res <- try(do.call(foncestim, c(list(data=rdata[, iter], distr=f$distname, start=start, fix.arg=fix.arg, checkstartfix=TRUE), f$dots)), silent=silent) if(inherits(res, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(res$estimate, res$convergence)) } }else if(!is.null(f$dots) && is.function(fix.arg)) { func <- function(iter) { fix.arg.iter <- fix.arg(rdata[, iter]) res <- try(do.call(foncestim, c(list(data=rdata[, iter], distr=f$distname, start=start, fix.arg=fix.arg.iter, checkstartfix=TRUE), f$dots)), silent=silent) if(inherits(res, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(res$estimate, res$convergence)) } }else stop("wrong implementation in bootdist") owarn <- getOption("warn") oerr <- getOption("show.error.messages") options(warn=ifelse(silent, -1, 0), show.error.messages=!silent) # parallel or sequential computation if (parallel != "no") { if (parallel == "snow") type <- "PSOCK" else if (parallel == "multicore") type <- "FORK" clus <- parallel::makeCluster(ncpus, type = type) resboot <- parallel::parSapply(clus, 1:niter, func) parallel::stopCluster(clus) } else { resboot <- sapply(1:niter, func) } options(warn=owarn, show.error.messages=oerr) rownames(resboot) <- c(names(start), "convergence") if (length(resboot[, 1])>2) { estim <- data.frame(t(resboot)[, -length(resboot[, 1])]) bootCI <- cbind(apply(resboot[-length(resboot[, 1]), ], 1, median, na.rm=TRUE), apply(resboot[-length(resboot[, 1]), ], 1, quantile, 0.025, na.rm=TRUE), apply(resboot[-length(resboot[, 1]), ], 1, quantile, 0.975, na.rm=TRUE)) colnames(bootCI) <- c("Median", "2.5%", "97.5%") } else { estim <- as.data.frame(t(resboot)[, -length(resboot[, 1])]) names(estim) <- names(f$estimate) bootCI <- c(median(resboot[-length(resboot[, 1]), ], na.rm=TRUE), quantile(resboot[-length(resboot[, 1]), ], 0.025, na.rm=TRUE), quantile(resboot[-length(resboot[, 1]), ], 0.975, na.rm=TRUE)) names(bootCI) <- c("Median", "2.5%", "97.5%") } # code of convergence of the optimization function for each iteration converg <- t(resboot)[, length(resboot[, 1])] res <- structure(list(estim=estim, converg=converg, method=bootmethod, nbboot=niter, CI=bootCI, fitpart=f), class="bootdist") res } print.bootdist <- function(x, ...){ if (!inherits(x, "bootdist")) stop("Use only with 'bootdist' objects") if (x$method=="param") cat("Parameter values obtained with parametric bootstrap \n") else cat("Parameter values obtained with nonparametric bootstrap \n") print(head(x$estim), ...) nconverg <- length(x$converg[x$converg==0]) if (nconverg < length(x$converg)) { cat("\n") cat("The estimation method converged only for", nconverg, "among", length(x$converg), "iterations \n") } } plot.bootdist <- function(x, main="Bootstrapped values of parameters", enhance=FALSE, trueval=NULL, rampcol=NULL, nbgrid = 100, nbcol = 100, ...){ if (!inherits(x, "bootdist")) stop("Use only with 'bootdist' objects") if (dim(x$estim)[2]==1) { stripchart(x$estim, method="jitter", main=main, xlab="Bootstrapped values of the parameter", ...) } else { if(!is.logical(enhance)) stop("wrong argument enhance for plot.bootdist.") if (!enhance) { if(is.null(trueval)) #no true value supplied pairs(data.matrix(x$estim), main=main, ...) else #some true value supplied pairs4boot(x$estim, main=main, trueval=trueval, enhance=FALSE, ...) } else { if(is.null(rampcol)) rampcol <- c("green", "yellow", "orange", "red") pairs4boot(x$estim, main=main, trueval=trueval, col4ramp = rampcol, nbgrid = nbgrid, nbcol = nbcol, ...) } } } summary.bootdist <- function(object, ...){ if (!inherits(object, "bootdist")) stop("Use only with 'bootdist' objects") class(object) <- c("summary.bootdist", class(object)) object } print.summary.bootdist <- function(x, ...){ if (!inherits(x, "summary.bootdist")) stop("Use only with 'summary.bootdist' objects") if (x$method=="param") cat("Parametric bootstrap medians and 95% percentile CI \n") else cat("Nonparametric bootstrap medians and 95% percentile CI \n") print(x$CI) nconverg <- length(x$converg[x$converg==0]) if (nconverg < length(x$converg)) { cat("\n") cat("The estimation method converged only for", nconverg, "among", length(x$converg), "iterations \n") } } fitdistrplus/R/fitdistcens.R0000644000176200001440000002277713742313702015672 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### fit parametric distributions for censored data ### ### R functions ### fitdistcens <- function (censdata, distr, start=NULL, fix.arg=NULL, keepdata = TRUE, keepdata.nb=100, ...) { if (missing(censdata) || !(is.vector(censdata$left) & is.vector(censdata$right) & length(censdata[, 1])>1)) stop("datacens must be a dataframe with two columns named left and right and more than one line") leftsupright <- censdata$left>censdata$right leftsupright <- leftsupright[!is.na(leftsupright)] if (any(leftsupright)) stop("each left value must be less or equal to the corresponding right value") if (!is.character(distr)) distname <- substring(as.character(match.call()$distr), 2) else distname <- distr ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) pdistname <- paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) if(!is.logical(keepdata) || !is.numeric(keepdata.nb) || keepdata.nb < 3) stop("wrong arguments 'keepdata' and 'keepdata.nb'.") #encapsulate three dots arguments my3dots <- list(...) if (length(my3dots) == 0) my3dots <- NULL #format data for calculation of starting values pseudodata <- cens2pseudo(censdata)$pseudo # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=pseudodata, distname=distname) #check inconsistent parameters argddistname <- names(formals(ddistname)) hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #store fix.arg.fun if supplied by the user if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL # check d, p, q, functions of distname dpq2test <- c("d", "p") resdpq <- testdpqfun(distname, dpq2test, start.arg=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, discrete=FALSE) if(any(!resdpq$ok)) { for(x in resdpq[!resdpq$ok, "txt"]) warning(x) } # MLE fit with mledist mle <- mledist(censdata, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) if (mle$convergence>0) stop("the function mle failed to estimate the parameters, with the error code ", mle$convergence) estimate <- mle$estimate if(!is.null(mle$hessian)){ #check for NA values and invertible Hessian if(all(!is.na(mle$hessian)) && qr(mle$hessian)$rank == NCOL(mle$hessian)){ varcovar <- solve(mle$hessian) sd <- sqrt(diag(varcovar)) correl <- cov2cor(varcovar) }else{ varcovar <- NA sd <- NA correl <- NA } }else{ varcovar <- NA sd <- NA correl <- NA } loglik <- mle$loglik n <- nrow(censdata) npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar fix.arg <- mle$fix.arg weights <- mle$weights #needed for bootstrap if (!is.null(fix.arg)) fix.arg <- as.list(fix.arg) if(keepdata) { reslist <- list(estimate = estimate, method="mle", sd = sd, cor = correl, vcov = varcovar, loglik = loglik, aic=aic, bic=bic, n=n, censdata=censdata, distname=distname, fix.arg=fix.arg, fix.arg.fun = fix.arg.fun, dots=my3dots, convergence=mle$convergence, discrete=FALSE, weights = weights) }else { n2keep <- min(keepdata.nb, n)-4 imin <- unique(apply(censdata, 2, which.min)) imax <- unique(apply(censdata, 2, which.max)) subdata <- censdata[sample((1:n)[-c(imin, imax)], size=n2keep, replace=FALSE), ] subdata <- rbind.data.frame(subdata, censdata[c(imin, imax), ]) reslist <- list(estimate = estimate, method="mle", sd = sd, cor = correl, vcov = varcovar, loglik = loglik, aic=aic, bic=bic, n=n, censdata=subdata, distname=distname, fix.arg=fix.arg, fix.arg.fun = fix.arg.fun, dots=my3dots, convergence=mle$convergence, discrete=FALSE, weights = weights) } return(structure(reslist, class = "fitdistcens")) } print.fitdistcens <- function(x, ...){ if (!inherits(x, "fitdistcens")) stop("Use only with 'fitdistcens' objects") cat("Fitting of the distribution '", x$distname, "' on censored data by maximum likelihood \n") cat("Parameters:\n") print(cbind.data.frame("estimate" = x$estimate), ...) if(!is.null(x$fix.arg)) { if(is.null(x$fix.arg.fun)) { cat("Fixed parameters:\n") }else { cat("Fixed parameters (computed by a user-supplied function):\n") } print(cbind.data.frame("value" = unlist(x$fix.arg)), ...) } } plot.fitdistcens <- function(x, ...){ if (!inherits(x, "fitdistcens")) stop("Use only with 'fitdistcens' objects") if(!is.null(x$weights)) stop("The plot of the fit is not yet available when using weights") plotdistcens(censdata=x$censdata, distr=x$distname, para=c(as.list(x$estimate), as.list(x$fix.arg)), ...) } summary.fitdistcens <- function(object, ...){ if (!inherits(object, "fitdistcens")) stop("Use only with 'fitdistcens' objects") object$ddistname <- paste("d", object$distname, sep="") object$pdistname <- paste("p", object$distname, sep="") class(object) <- c("summary.fitdistcens", class(object)) object } print.summary.fitdistcens <- function(x, ...){ if (!inherits(x, "summary.fitdistcens")) stop("Use only with 'fitdistcens' objects") ddistname <- x$ddistname pdistname <- x$pdistname cat("Fitting of the distribution '", x$distname, "' By maximum likelihood on censored data \n") cat("Parameters\n") print(cbind.data.frame("estimate" = x$estimate, "Std. Error" = x$sd), ...) if(!is.null(x$fix.arg)) { if(is.null(x$fix.arg.fun)) { cat("Fixed parameters:\n") }else { cat("Fixed parameters (computed by a user-supplied function):\n") } print(cbind.data.frame("value" = unlist(x$fix.arg)), ...) } cat("Loglikelihood: ", x$loglik, " ") cat("AIC: ", x$aic, " ") cat("BIC: ", x$bic, "\n") if (length(x$estimate) > 1) { cat("Correlation matrix:\n") print(x$cor) cat("\n") } invisible(x) } #see quantiles.R for quantile.fitdistcens #see logLik.R for loglik.fitdistcens #see vcov.R for vcov.fitdistcens #see coef.R for coef.fitdistcens fitdistrplus/R/util-testdensity.R0000644000176200001440000000773613742313702016703 0ustar liggesusers# testdpqfun function returns a vector of TRUE when the d,p,q functions exist # and behave like in R (e.g. d,p,qexp()), otherwise a list of messages. # INPUTS #distr : the distribution name #fun: a character vector with letters among d, p, q #start.arg: an initial value list #fix.arg: a fixed value list #discrete: a logical whether the distribution is discrete # OUTPUTS # a vector of logical TRUE or a vector of text messages testdpqfun <- function(distr, fun=c("d","p","q"), start.arg, fix.arg=NULL, discrete=FALSE) { stopifnot(all(is.character(fun))) fun <- fun[fun %in% c("d","p","q")] stopifnot(length(fun) > 0) if(is.vector(start.arg)) start.arg <- as.list(start.arg) if(is.function(fix.arg)) stop("fix.arg should be either a named list or NULL but not a function") op <- options() #get current options #print(getOption("warn")) options(warn=-1) res <- NULL if("d" %in% fun) res <- rbind(res, test1fun(paste0("d", distr), start.arg, fix.arg)) if("p" %in% fun) res <- rbind(res, test1fun(paste0("p", distr), start.arg, fix.arg)) if("q" %in% fun) res <- rbind(res, test1fun(paste0("q", distr), start.arg, fix.arg)) options(op) # reset (all) initial options res } test1fun <- function(fn, start.arg, fix.arg, dpqr) { res <- data.frame(ok=FALSE, txt="") stopifnot(is.list(start.arg)) if(!is.null(fix.arg)) stopifnot(is.list(fix.arg)) #does the function exist? if(!exists(fn, mode="function")) { res$txt <- paste("The", fn, "function must be defined") return(res) } #naming convention if(missing(dpqr)) dpqr <- substr(fn, 1, 1) firstarg_theo <- switch(dpqr, "d"="x", "p"="q", "q"="p", "r"="n") firstarg_found <- names(formals(fn))[1] if(firstarg_found != firstarg_theo) { t0 <- paste("The", fn, "function should have its first argument named:", firstarg_theo) res$txt <- paste(t0, "as in base R") return(res) } #zero-component vector res0 <- try(do.call(fn, c(list(numeric(0)), start.arg, fix.arg)), silent=TRUE) t0 <- paste("The", fn, "function should return a zero-length vector when input has length zero and not raise an error") t1 <- paste("The", fn, "function should return a zero-length vector when input has length zero") if(class(res0) == "try-error") { res$txt <- t0 return(res) } if(length(res0) != 0) { res$txt <- t1 return(res) } #inconsistent value x <- c(0, 1, Inf, NaN, -1) res1 <- try(do.call(fn, c(list(x), start.arg, fix.arg)), silent=TRUE) t2 <- paste("The", fn, "function should return a vector of with NaN values when input has inconsistent values and not raise an error") if(class(res1) == "try-error") { res$txt <- t2 return(res) } #missing value x <- c(0, 1, NA) res2 <- try(do.call(fn, c(list(x), start.arg, fix.arg)), silent=TRUE) t4 <- paste("The", fn, "function should return a vector of with NA values when input has missing values and not raise an error") t5 <- paste("The", fn, "function should return a vector of with NA values when input has missing values and not remove missing values") if(class(res2) == "try-error") { res$txt <- t4 return(res) } if(length(res2) != length(x)) { res$txt <- t5 return(res) } #inconsistent parameter x <- 0:1 start.arg <- lapply(start.arg, function(x) -x) res3 <- try(do.call(fn, c(list(x), start.arg, fix.arg)), silent=TRUE) t6 <- paste("The", fn, "function should return a vector of with NaN values when input has inconsistent parameters and not raise an error") if(class(res3) == "try-error") { res$txt <- t6 return(res) } #wrong parameter name x <- 0:1 names(start.arg) <- paste0(names(start.arg), "_") res4 <- try(do.call(fn, c(list(x), start.arg, fix.arg)), silent=TRUE) t8 <- paste("The", fn, "function should raise an error when names are incorrectly named") if(class(res4) != "try-error") { res$txt <- t8 return(res) } return(data.frame(ok=TRUE, txt="")) } fitdistrplus/R/bootdistcens.R0000644000176200001440000002267213742313702016045 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### bootstrap in fitdistrplus with censored data ### ### R functions ### bootdistcens <- function (f, niter=1001, silent=TRUE, parallel = c("no", "snow", "multicore"), ncpus) { if (niter<10) stop("niter must be an integer above 10") parallel <- match.arg(parallel, c("no", "snow", "multicore")) if (parallel == "multicore" & .Platform$OS.type == "windows") { parallel <- "snow" warning("As the multicore option is not supported on Windows it was replaced by snow") } if ((parallel == "snow" | parallel == "multicore") & missing(ncpus)) stop("You have to specify the number of available processors to parallelize the bootstrap") if (!inherits(f, "fitdistcens")) stop("Use only with 'fitdistcens' objects") if(!is.null(f$weights)) stop("Bootstrap is not yet available when using weights") # non parametric bootstrap n <- length(f$censdata[, 1]) numrow <- seq(1, n) rnumrow <- sample(numrow, size=niter*n, replace=TRUE) dim(rnumrow) <- c(n, niter) start <- as.list(f$estimate) #a named vector is no longer is accepted as starting values. if(is.function(f$fix.arg.fun)) fix.arg <- f$fix.arg.fun else fix.arg <- f$fix.arg if (is.null(f$dots) && !is.function(fix.arg)) { funcmle <- function(iter) { mle <- try(do.call(mledist, list(data=data.frame(left=f$censdata[rnumrow[, iter], ]$left, right=f$censdata[rnumrow[, iter], ]$right), distr=f$distname, start=start, fix.arg=fix.arg, checkstartfix=TRUE)), silent=silent) if(inherits(mle, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(mle$estimate, mle$convergence)) } }else if (is.null(f$dots) && is.function(fix.arg)) { funcmle <- function(iter) { bootdata <- data.frame(left=f$censdata[rnumrow[, iter], ]$left, right=f$censdata[rnumrow[, iter], ]$right) fix.arg.iter <- fix.arg(cens2pseudo(bootdata)$pseudo) mle <- try(do.call(mledist, list(data=bootdata, distr=f$distname, start=start, fix.arg=fix.arg.iter, checkstartfix=TRUE)), silent=silent) if(inherits(mle, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(mle$estimate, mle$convergence)) } }else if(!is.null(f$dots) && !is.function(fix.arg)) { funcmle <- function(iter) { mle <- try(do.call(mledist, c(list(data=data.frame(left=f$censdata[rnumrow[, iter], ]$left, right=f$censdata[rnumrow[, iter], ]$right), distr=f$distname, start=start), fix.arg=fix.arg, f$dots, checkstartfix=TRUE)), silent=silent) if(inherits(mle, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(mle$estimate, mle$convergence)) } }else if(!is.null(f$dots) && is.function(fix.arg)) { funcmle <- function(iter) { bootdata <- data.frame(left=f$censdata[rnumrow[, iter], ]$left, right=f$censdata[rnumrow[, iter], ]$right) fix.arg.iter <- fix.arg(cens2pseudo(bootdata)$pseudo) mle <- try(do.call(mledist, c(list(data=bootdata, distr=f$distname, start=start), fix.arg=fix.arg.iter, f$dots, checkstartfix=TRUE)), silent=silent) if(inherits(mle, "try-error")) return(c(rep(NA, length(start)), 100)) else return(c(mle$estimate, mle$convergence)) } }else stop("wrong implementation in bootdistcens") owarn <- getOption("warn") oerr <- getOption("show.error.messages") options(warn=ifelse(silent, -1, 0), show.error.messages=!silent) # parallel or sequential computation if (parallel != "no") { if (parallel == "snow") type <- "PSOCK" else if (parallel == "multicore") type <- "FORK" clus <- parallel::makeCluster(ncpus, type = type) resboot <- parallel::parSapply(clus, 1:niter, funcmle) parallel::stopCluster(clus) } else { resboot <- sapply(1:niter, funcmle) } options(warn=owarn, show.error.messages=oerr) rownames(resboot) <- c(names(start), "convergence") if (length(resboot[, 1])>2) { estim <- data.frame(t(resboot)[, -length(resboot[, 1])]) bootCI <- cbind(apply(resboot[-length(resboot[, 1]), ], 1, median, na.rm=TRUE), apply(resboot[-length(resboot[, 1]), ], 1, quantile, 0.025, na.rm=TRUE), apply(resboot[-length(resboot[, 1]), ], 1, quantile, 0.975, na.rm=TRUE)) colnames(bootCI) <- c("Median", "2.5%", "97.5%") } else { estim <- as.data.frame(t(resboot)[, -length(resboot[, 1])]) names(estim) <- names(f$estimate) bootCI <- c(median(resboot[-length(resboot[, 1]), ], na.rm=TRUE), quantile(resboot[-length(resboot[, 1]), ], 0.025, na.rm=TRUE), quantile(resboot[-length(resboot[, 1]), ], 0.975, na.rm=TRUE)) names(bootCI) <- c("Median", "2.5%", "97.5%") } res <- structure(list(estim=estim, converg=t(resboot)[, length(resboot[, 1])], method="nonparam", nbboot=niter, CI=bootCI, fitpart=f), class="bootdistcens") res } print.bootdistcens <- function(x, ...){ if (!inherits(x, "bootdistcens")) stop("Use only with 'bootdistcens' objects") cat("Parameter values obtained with nonparametric bootstrap \n") print(x$estim, ...) nconverg <- length(x$converg[x$converg==0]) if (nconverg < length(x$converg)) { cat("\n") cat("The estimation method converged only for", nconverg, "among", length(x$converg), "iterations \n") } } plot.bootdistcens <- function(x, ...){ if (!inherits(x, "bootdistcens")) stop("Use only with 'bootdistcens' objects") if (dim(x$estim)[2]==1) { stripchart(x$estim, method="jitter", xlab="Bootstrapped values of the parameter", ...) } else { if (dim(x$estim)[2]==2) plot(x$estim, main="Bootstrapped values of the two parameters", ...) else plot(x$estim, main="Bootstrapped values of parameters", ...) } } summary.bootdistcens <- function(object, ...){ if (!inherits(object, "bootdistcens")) stop("Use only with 'bootdistcens' objects") class(object) <- c("summary.bootdistcens", class(object)) object } print.summary.bootdistcens <- function(x, ...){ if (!inherits(x, "summary.bootdistcens")) stop("Use only with 'summary.bootdistcens' objects") cat("Nonparametric bootstrap medians and 95% percentile CI \n") print(x$CI) nconverg <- length(x$converg[x$converg==0]) if (nconverg < length(x$converg)) { cat("\n") cat("The estimation method converged only for", nconverg, "among", length(x$converg), "iterations \n") } } fitdistrplus/R/util-npsurv-main.R0000644000176200001440000001217613742313702016575 0ustar liggesusers# ----------------------------------------------------------------------- # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Main function : npsurv.minimal # # ----------------------------------------------------------------------- # # Original code from Yong Wang, 2020 # # ----------------------------------------------------------------------- # ## Arguments: ## data: Data ## w: Weights ## maxit: Maximum number of iterations to perform ## tol: Tolerance for the stopping condition (in log-likelihood value) ## verb: For internal use only: depth of recursion (up to 4) ## pkg: package used in NNLS_constrSum() ## probtol: Tolerance for keeping output probabilities (default value has ## been chosen so that the output is similar to original npsurv()) npsurv.minimal <- function(data, w=1, maxit=100, tol=1e-6, verb=0, pkg="stats", probtol=2e-4, ...) { #sanity checks pkg <- match.arg(pkg, c("stats")) if(length(maxit) > 1) stop("maxit should be a positive scalar") if(maxit <= 0) stop("maxit should be a positive scalar") if(length(tol) > 1) stop("maxit should be a positive scalar") if(tol <= 0) stop("maxit should be a positive scalar") if(length(verb) > 1) stop("maxit should be a non-negative scalar") if(verb < 0) stop("maxit should be a non-negative scalar") if(length(probtol) > 1) stop("maxit should be a positive probability") if(probtol <= 0 || probtol >= 1) stop("maxit should be a positive probability") if(sum(is.na(data))) stop("data should have no NA values") x2 = icendata(data, w) #see npsurv-intercens.R #sanity checks if(sum(apply(x2$o, 1, function(x) x[1] > x[2])) > 0) stop("some intervals have left bounds strictly greater than right bounds") # exact or right-censored only if(nrow(x2$o) == 0 || all(x2$o[,2] == Inf)) { if(verb > 0) cat("call to km()\n") r0 = km(x2) #see npsurv-km.R r = list(f=r0$f, upper=max(x2$t, x2$o[,1]), convergence=TRUE, ll=r0$ll, maxgrad=0, numiter=1, method="km") return(r) } #get left/right interval bounds x = rbind(cbind(x2$t, x2$t), x2$o) nx = nrow(x) w = c(x2$wt, x2$wo) wr = sqrt(w) n = sum(w) upper = x2$upper # compute incidence matrix of maximal intersection intervals # see section 2.2, p3 of Wang & Taylor : Delta matrix is denoted S dmat = Deltamatrix(x) #see npsurv-intercens.R left = dmat$left right = dmat$right D = dmat$Delta m = length(left) p = double(m) if(verb > 0) cat("nb row orig data=", nx, "\nnb of maximal intersection intervals=", m, "\n") i = rowSums(D) != 1 j = colSums(D[!i,,drop=FALSE]) > 0 j[c(1,m)] = TRUE # Initial p must ensure P > 0 repeat { jm = which.max(colSums(D[i,,drop=FALSE])) j[jm] = TRUE i[D[,jm]] = FALSE if( sum(i) == 0 ) break } p = colSums(w * D) * j p = p / sum(p) # interval censored and large dataset if(m >= 30) { ## Turn to HCNM if(verb > 0) cat("call to hcnm()\n") r = hcnm(w=w, D=D, p0=p, maxit=maxit, tol=tol, verb=verb) #see npsurv-hcnm.R j = r$pf > probtol f = idf(left=left[j], right=right[j], p=r$pf[j]) #normalize prob vector f$p <- f$p/sum(f$p) r = list(f=f, upper=upper, convergence=r$convergence, method="hcnm", ll=r$ll, maxgrad=r$maxgrad, numiter=r$numiter, m=m) return(r) } # interval censored and small dataset if(verb > 0) cat("body of npsurv.minimal()\n\n") P = drop(D %*% p) ll = sum( w * log(P) ) converge = FALSE for(i in 1:maxit) { p.old = p ll.old = ll S = D / P d = colSums(w * S) dmax = max(d) - n if(verb > 0) { cat("\n##### Iteration", i, "#####\n") cat("Log-likelihood: ", signif(ll, 6), "\n") } if(verb > 1) cat("Maximum gradient: ", signif(dmax, 6), "\n") if(verb > 2) {cat("Probability vector:\n"); print(p)} j[which(j)-1 + aggregate(d, by=list(group=cumsum(j)), which.max)[,2]] = TRUE #orignal call #pj = pnnls(wr * S[,j,drop=FALSE], wr * 2, sum=1)$x #new call resNNLS <- NNLS_constrSum(a=wr * S[,j,drop=FALSE], b=wr * 2, pkg=pkg, sumtotal=1, control=list(trace=verb), ...) #see npsurv-NNLS.R if(resNNLS$convergence != 0) break else pj <- resNNLS$prob p[j] = pj / sum(pj) # line search alpha = 1 pd = p - p.old lld = sum(d * pd) p.alpha = p repeat { P.alpha = drop(D %*% p.alpha) ll.alpha = sum(w * log(P.alpha)) if(ll.alpha >= ll + alpha * lld * .33) { p = p.alpha; P = P.alpha; ll = ll.alpha; break } if((alpha <- alpha * .5) < 1e-10) break p.alpha = p.old + alpha * pd } j = p > 0 if( ll <= ll.old + tol ) #convergence attained { converge=TRUE; break } } f <- idf(left[j], right[j], p[j]) #see npsurv-intercens.R res <- list(f=f, upper=upper, convergence=converge, method="cnm", ll=ll, maxgrad=max(crossprod(w/P, D))-n, numiter=i, m=m) res } fitdistrplus/R/qmedist.R0000644000176200001440000003416313742313702015011 0ustar liggesusers############################################################################# # Copyright (c) 2010 Christophe Dutang and Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### quantile matching estimation for censored or non-censored data ### ### R functions ### qmedist <- function (data, distr, probs, start=NULL, fix.arg=NULL, qtype=7, optim.method="default", lower=-Inf, upper=Inf, custom.optim=NULL, weights=NULL, silent=TRUE, gradient=NULL, checkstartfix=FALSE, ...) # data may correspond to a vector for non censored data or to # a dataframe of two columns named left and right for censored data { if (!is.character(distr)) # distname <- substring(as.character(match.call()$distr), 2) stop("distr must be a character string naming a distribution") else distname <- distr qdistname <- paste("q",distname,sep="") ddistname <- paste("d",distname,sep="") argddistname <- names(formals(ddistname)) if (!exists(qdistname, mode="function")) stop(paste("The ", qdistname, " function must be defined")) if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) if (missing(probs)) stop("missing probs argument for quantile matching estimation") if(is.null(custom.optim)) optim.method <- match.arg(optim.method, c("default", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent")) start.arg <- start #to avoid confusion with the start() function of stats pkg (check is done lines 87-100) if(is.vector(start.arg)) #backward compatibility start.arg <- as.list(start.arg) if(qtype < 1 || qtype > 9) stop("wrong type for the R quantile function") if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of integers greater than 0") if(!is.allint.w(weights)) stop("weights should be a vector of (strictly) positive integers") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") warning("weights are not taken into account in the default initial values") } if (is.vector(data)) { cens <- FALSE if (!(is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1 for non censored data or a dataframe with two columns named left and right and more than one line for censored data") } else { cens <- TRUE stop("Quantile matching estimation is not yet available for censored data.") } if(!checkstartfix) #pre-check has not been done by fitdist() or bootdist() { # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #set fix.arg.fun if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL }else #pre-check has been done by fitdist() or bootdist() { arg_startfix <- list(start.arg=start, fix.arg=fix.arg) fix.arg.fun <- NULL } #unlist starting values as needed in optim() vstart <- unlist(arg_startfix$start.arg) #sanity check if(is.null(vstart)) stop("Starting values could not be NULL with checkstartfix=TRUE") #erase user value #(cannot coerce to vector as there might be different modes: numeric, character...) fix.arg <- arg_startfix$fix.arg if(length(vstart) != length(probs)) stop("wrong dimension for the quantiles to match.") ############# QME fit using optim or custom.optim ########## # definition of the function to minimize : # for non censored data if (!cens && is.null(weights)) { # the argument names are: # - par for parameters (like in optim function) # - fix.arg for optional fixed parameters # - obs for observations (previously dat but conflicts with genoud data.type.int argument) # - qdistnam for distribution name DIFF2Q <- function(par, fix.arg, prob, obs, qdistnam, qtype) { qtheo <- do.call(qdistnam, c(as.list(prob), as.list(par), as.list(fix.arg)) ) qemp <- as.numeric(quantile(obs, probs=prob, type=qtype)) (qemp - qtheo)^2 } fnobj <- function(par, fix.arg, obs, qdistnam, qtype) sum( sapply(probs, function(p) DIFF2Q(par, fix.arg, p, obs, qdistnam, qtype)) ) }else if (!cens && !is.null(weights)) { DIFF2Q <- function(par, fix.arg, prob, obs, qdistnam, qtype) { qtheo <- do.call(qdistnam, c(as.list(prob), as.list(par), as.list(fix.arg)) ) qemp <- as.numeric(wtd.quantile(x=obs, weights=weights, probs=prob)) (qemp - qtheo)^2 } fnobj <- function(par, fix.arg, obs, qdistnam, qtype) sum( sapply(probs, function(p) DIFF2Q(par, fix.arg, p, obs, qdistnam, qtype)) ) } # Function to calculate the loglikelihood to return if(is.null(weights)) { loglik <- function(par, fix.arg, obs, ddistnam) sum(log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) }else { loglik <- function(par, fix.arg, obs, ddistnam) sum(weights * log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } owarn <- getOption("warn") # Try to minimize the stat distance using the base R optim function if(is.null(custom.optim)) { hasbound <- any(is.finite(lower) | is.finite(upper)) # Choice of the optimization method if (optim.method == "default") { meth <- ifelse(length(vstart) > 1, "Nelder-Mead", "BFGS") }else meth <- optim.method if(meth == "BFGS" && hasbound && is.null(gradient)) { meth <- "L-BFGS-B" txt1 <- "The BFGS method cannot be used with bounds without provided the gradient." txt2 <- "The method is changed to L-BFGS-B." warning(paste(txt1, txt2)) } options(warn=ifelse(silent, -1, 0)) #select optim or constrOptim if(hasbound) #finite bounds are provided { if(!is.null(gradient)) { opt.fun <- "constrOptim" }else #gradient == NULL { if(meth == "Nelder-Mead") opt.fun <- "constrOptim" else if(meth %in% c("L-BFGS-B", "Brent")) opt.fun <- "optim" else { txt1 <- paste("The method", meth, "cannot be used by constrOptim() nor optim() without gradient and bounds.") txt2 <- "Only optimization methods L-BFGS-B, Brent and Nelder-Mead can be used in such case." stop(paste(txt1, txt2)) } } if(opt.fun == "constrOptim") { #recycle parameters npar <- length(vstart) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) # constraints are : Mat %*% theta >= Bnd, i.e. # +1 * theta[i] >= lower[i]; # -1 * theta[i] >= -upper[i] #select rows from the identity matrix haslow <- is.finite(lower) Mat <- diag(npar)[haslow, ] #select rows from the opposite of the identity matrix hasupp <- is.finite(upper) Mat <- rbind(Mat, -diag(npar)[hasupp, ]) colnames(Mat) <- names(vstart) rownames(Mat) <- paste0("constr", 1:NROW(Mat)) #select the bounds Bnd <- c(lower[is.finite(lower)], -upper[is.finite(upper)]) names(Bnd) <- paste0("constr", 1:length(Bnd)) initconstr <- Mat %*% vstart - Bnd if(any(initconstr < 0)) stop("Starting values must be in the feasible region.") opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobj, ui=Mat, ci=Bnd, grad=gradient, fix.arg=fix.arg, obs=data, qdistnam=qdistname, qtype=qtype, hessian=!is.null(gradient), method=meth, ...), silent=TRUE) if(!inherits(opttryerror, "try-error")) if(length(opt$counts) == 1) #appears when the initial point is a solution opt$counts <- c(opt$counts, NA) }else #opt.fun == "optim" { opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, qdistnam=qdistname, qtype=qtype, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } }else #hasbound == FALSE { opt.fun <- "optim" opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, qdistnam=qdistname, qtype=qtype, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The function optim encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The function optim failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=opt.fun, optim.method=meth, fix.arg=fix.arg, fix.arg.fun=fix.arg.fun, weights = weights, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), probs=probs) } else # Try to minimize the stat distance using a user-supplied optim function { if (!cens) opttryerror <- try(opt <- custom.optim(fn=fnobj, fix.arg=fix.arg, obs=data, qdistnam=qdistname, qtype=qtype, par=vstart, ...), silent=TRUE) else stop("Quantile matching estimation is not yet available for censored data.") if (inherits(opttryerror,"try-error")) { warnings("The customized optimization function encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The customized optimization function failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) argdot <- list(...) method.cust <- argdot$method res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=custom.optim, optim.method=method.cust, fix.arg=fix.arg, fix.arg.fun=fix.arg.fun, weights = weights, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), probs=probs) } return(res) } fitdistrplus/R/qqcomp.R0000644000176200001440000002063713747741345014661 0ustar liggesusers############################################################################# # Copyright (c) 2012 Christophe Dutang, Aurelie Siberchicot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot density functions for various fits ### of continuous distribution(s) (fitdist results) ### on a same dataset ### ### R functions ### qqcomp <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fitpch, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, use.ppoints = TRUE, a.ppoints = 0.5, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, plotstyle = "graphics", ...) { if(inherits(ft, "fitdist")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdist' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdist")))) stop("argument ft must be a list of 'fitdist' objects") } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("qqcomp is not yet available when using weights") # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # check data mydata <- ft[[1]]$data verif.ftidata <- function(fti) { if (any(fti$data != mydata)) stop("All compared fits must have been obtained with the same dataset") invisible() } lapply(ft, verif.ftidata) n <- length(mydata) sdata <- sort(mydata) largedata <- (n > 1e4) if (xlogscale != ylogscale) { warning("As a Q-Q plot should use the same scale on x and y axes, both or none of the axes should be put in a logarithmic scale.") } logxy <- paste(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y",""), sep="") # manage default parameters nft <- length(ft) if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitpch)) fitpch <- ifelse(largedata, 1, 21) if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitpch <- rep(fitpch, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } if (missing(xlab)) xlab <- "Theoretical quantiles" if (missing(ylab)) ylab <- "Empirical quantiles" if (missing(main)) main <- "Q-Q plot" if (use.ppoints) obsp <- ppoints(n, a = a.ppoints) else obsp <- (1:n) / n # computation of each fitted distribution comput.fti <- function(i) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname qdistname <- paste("q", distname, sep="") do.call(qdistname, c(list(obsp), as.list(para))) } fittedquant <- sapply(1:nft, comput.fti) if(NCOL(fittedquant) != nft || NROW(fittedquant) != length(obsp)) stop("problem when computing fitted CDFs.") # check limits if(missing(xlim)) xlim <- range(fittedquant) if(missing(ylim)) ylim <- range(mydata) if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## # main plot if(!largedata) resquant <- plot(fittedquant[,1], sdata, main=main, xlab=xlab, ylab=ylab, log=logxy, pch = fitpch[1], xlim=xlim, ylim=ylim, col=fitcol[1], type="p", ...) else resquant <- plot(fittedquant[,1], sdata, main=main, xlab=xlab, ylab=ylab, log=logxy, lty = fitpch[1], xlim=xlim, ylim=ylim, col=fitcol[1], type="l", lwd = fitlwd[1], ...) #plot of other fitted quantiles if(nft > 1 && !ynoise && !largedata) for(i in 2:nft) points(fittedquant[,i], sdata, pch=fitpch[i], col=fitcol[i], ...) if(nft > 1 && ynoise && !largedata) for(i in 2:nft) if (ylogscale) { noise2mult <- runif(n, 0.95, 1.05) points(fittedquant[,i], sdata*noise2mult, pch=fitpch[i], col=fitcol[i], ...) }else { noise2add <- runif(n, -0.02, 0.02) points(fittedquant[,i], sdata+noise2add, pch=fitpch[i], col=fitcol[i], ...) } if(nft > 1 && largedata) for(i in 2:nft) lines(fittedquant[,i], sdata, col=fitcol[i], lty = fitpch[i], lwd = fitlwd[i], ...) if(line01) abline(0, 1, lty=line01lty, col=line01col) if (addlegend) { if(!largedata) legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, pch = fitpch, ...) else legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, lty = fitpch, lwd = fitlwd, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## # recode the legend position according to available positions in ggplot2 if(xlegend %in% c("topleft", "bottomleft")) xlegend <- "left" if(xlegend %in% c("topright", "bottomright")) xlegend <- "right" # structure the fittedquant in a relevant data.frame fittedquant <- as.data.frame(fittedquant) colnames(fittedquant) <- unlist(lapply(ft, function(X) X["distname"])) fittedquant <- stack(fittedquant) nfq <- nrow(fittedquant) fittedquant$sdata <- sdata # sdata is recycled in the standard fashion fittedquant$ind <- factor(fittedquant$ind, levels = unique(fittedquant$ind)) # reorder levels in the appearance order of the input if(nft > 1 && ynoise && !largedata) { if (ylogscale) { noise2mult <- runif(nfq, 0.95, 1.05) fittedquant$sdata <- fittedquant$sdata*noise2mult }else { noise2add <- runif(nfq, -0.02, 0.02) fittedquant$sdata <- fittedquant$sdata+noise2add } } ggqqcomp <- ggplot2::ggplot(data = fittedquant, ggplot2::aes_(quote(values), quote(sdata), group = quote(ind), colour = quote(ind), shape = quote(ind), size = quote(ind))) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::ggtitle(main) + ggplot2::coord_cartesian(xlim = c(xlim[1], xlim[2]), ylim = c(ylim[1], ylim[2])) + {if(!largedata) ggplot2::geom_point() else ggplot2::geom_line(ggplot2::aes_(linetype = quote(ind), size = quote(ind)))} + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend), plot.title = ggplot2::element_text(hjust = 0.5)) else ggplot2::theme(legend.position = "none", plot.title = ggplot2::element_text(hjust = 0.5))} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_shape_manual(values = fitpch, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitpch, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(shape = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + {if(line01) ggplot2::geom_abline(intercept = 0, slope = 1)} + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} return(ggqqcomp) } } fitdistrplus/R/detectbound.R0000644000176200001440000001120713742313702015635 0ustar liggesusers############################################################################# # Copyright (c) 2016 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### detect boundaries detectbound <- function(distname, vstart, obs, fix.arg=NULL, echo=FALSE) { ddistname <- paste("d", distname, sep="") argdist <- formalArgs(ddistname) argdist <- argdist[!argdist %in% c("x", "log")] stopifnot(all(names(vstart) %in% argdist)) if("scale" %in% argdist && "rate" %in% argdist) { if(length(grep("rate", as.character(formals(ddistname)$scale))) > 0) { argdist <- argdist[argdist != "rate"] #remove rate for parameter list if("rate" %in% names(vstart)) #update value if rate is supplied { vstart["rate"] <- 1/vstart["rate"] names(vstart)[names(vstart) == "rate"] <- "scale" } } } argdist <- argdist[!argdist %in% names(fix.arg)] if(length(argdist) == 0) return(NULL) if(echo) { print(argdist) print(vstart) } lowb <- rep(-Inf, length(argdist)) uppb <- -lowb names(lowb) <- names(uppb) <- argdist eps <- sqrt(.Machine$double.eps) owarn <- getOption("warn") oerr <- getOption("show.error.messages") options(warn=-1, show.error.messages=FALSE) for(a in argdist) { if(echo) cat(a, "\n") dx <- do.call(ddistname, c(list(obs), as.list(vstart), as.list(fix.arg))) if(any(is.nan(dx))) stop("wrong init param") vstarta <- vstart aval <- -1:1 for(i in 1:length(aval)) { vstarta[a] <- aval[i]-eps dx1 <- try(do.call(ddistname, c(list(obs), as.list(vstarta), as.list(fix.arg))), silent=TRUE) vstarta[a] <- aval[i]+eps dx2 <- try(do.call(ddistname, c(list(obs), as.list(vstarta), as.list(fix.arg))), silent=TRUE) if(echo) { cat(i, "\ttested value", vstarta, "\n") print(dx1) print(dx2) } if(class(dx1) == "try-error" && class(dx2) != "try-error") { lowb[a] <- aval[i] } if(any(is.nan(dx1)) && any(!is.nan(dx2))) { lowb[a] <- aval[i] } if(class(dx1) != "try-error" && class(dx2) == "try-error") { uppb[a] <- aval[i] } if(any(!is.nan(dx1)) && any(is.nan(dx2))) { uppb[a] <- aval[i] } } } options(warn=owarn, show.error.messages=oerr) rbind(lowb, uppb) } fitdistrplus/R/logLik.R0000644000176200001440000000615313742313702014562 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Regis Pouillot, Jean-Baptiste Denis, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### log likelihood ### ### R functions ### #logLik already defined in R # #logLik <- function(object, ...) # UseMethod("logLik") # #logLik.default <- function(object, ...) # return(object) logLik.fitdist <- function(object, ...) { stopifnot(inherits(object, "fitdist")) if(is.null(object$loglik)) stop("Internal error in loglik.fitdist") else return(object$loglik) } logLik.fitdistcens <- function(object, ...) { stopifnot(inherits(object, "fitdistcens")) if(is.null(object$loglik)) stop("Internal error in loglik.fitdistcens") else return(object$loglik) } fitdistrplus/R/plotdistcens.R0000644000176200001440000003526513742313702016062 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Regis Pouillot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot functions for censored data ### ### R functions ### plotdistcens <- function(censdata, distr, para, leftNA = -Inf, rightNA = Inf, NPMLE = TRUE, Turnbull.confint = FALSE, NPMLE.method = "Wang", ...) { if (missing(censdata) || !(is.vector(censdata$left) & is.vector(censdata$right) & length(censdata[,1])>1)) stop("datacens must be a dataframe with two columns named left and right and more than one line") if ((missing(distr) & !missing(para)) || (!missing(distr) & missing(para))) stop("distr and para must defined") my3dots <- list(...) if("main" %in% names(my3dots)) specifytitle <- FALSE else specifytitle <- TRUE if (missing(distr)) { onlyCDFplot <- TRUE titleCDF <- "Cumulative distribution" } else { if (!is.character(distr)) distname <- substring(as.character(match.call()$distr), 2) else distname <- distr if (!is.list(para)) stop("'para' must be a named list") ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) onlyCDFplot <- FALSE titleCDF <- "Empirical and theoretical CDFs" } # definition of xlim or lim for data and of xrange, xmininf and xmaxinf ibounds <- c(censdata$right, censdata$left) iboundsnotNA <- ibounds[!is.na(ibounds)] xmin <- min(iboundsnotNA) xmax <- max(iboundsnotNA) xrange <- xmax - xmin xmin <- xmin - 0.1 * xrange xmax <- xmax + 0.1 * xrange xmininf <- xmin - 100 * xrange xmaxinf <- xmax + 100 * xrange xlim <- c(xmin, xmax) #definition of ylim or lim for ECDF ylim <- c(0,1) # Supression of the deprecated argument Turnbull ############################################### # if (!missing(Turnbull)) # { # warning("The argument Turnbull is deprecated and should note be used any more. # Now use the argument NPMLE to tell if you want to compute a nonparametric # maximum likelihood estimation of the cumulative distribution, and the argument NPMLE.method # to define the method chosen for the computation (Turnbull or Wang).") # if (missing(NPMLE) & missing(NPMLE.method)) # { # if (Turnbull == TRUE) # { # NPMLE <- TRUE # NPMLE.method <- "Turnbull" # } else # { # NPMLE <- FALSE # } # } # } NPMLE.method <- match.arg(NPMLE.method, c("Wang", "Turnbull.intervals", "Turnbull.middlepoints", "Turnbull")) if (NPMLE.method == "Turnbull") { warning("Turnbull is now a deprecated option for NPMLE.method. You should use Turnbull.middlepoints of Turnbull.intervals. It was here fixed as Turnbull.middlepoints, equivalent to former Turnbull.") NPMLE.method <- "Turnbull.middlepoints" } if ((Turnbull.confint == TRUE) & ((NPMLE.method == "Wang") | (NPMLE.method == "Turnbull.intervals"))) { warning("When Turnbull.confint is TRUE NPMLE.method is forced to Turnbull.middlepoints." ) NPMLE.method <- "Turnbull.middlepoints" # so the second part of the message will be printed in the following if needed onlyCDFplot <- TRUE } if ((NPMLE.method == "Turnbull.middlepoints") & !missing(distr)) { warning("Q-Q plot and P-P plot are available only with the arguments NPMLE.method at Wang (default value) or Turnbull.intervals." ) onlyCDFplot <- TRUE } if ((NPMLE == FALSE) & !missing(distr)) { warning("When NPMLE is FALSE the nonparametric maximum likelihood estimation of the cumulative distribution function is not computed. Q-Q plot and P-P plot are available only with the arguments NPMLE.method at Wang (default value) or Turnbull.intervals." ) onlyCDFplot <- TRUE } if (!onlyCDFplot) { pdistname <- paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) qdistname <- paste("q", distname, sep="") if (!exists(qdistname, mode="function")) stop(paste("The ", qdistname, " function must be defined")) densfun <- get(ddistname, mode="function") nm <- names(para) f <- formals(densfun) args <- names(f) m <- match(nm, args) if (any(is.na(m))) stop(paste("'para' specifies names which are not arguments to ", ddistname)) def.par <- par(no.readonly = TRUE) par(mfrow = c(2, 2)) } # Plot of the empirical distribution as an ECDF if (NPMLE) { if (NPMLE.method == "Wang" | NPMLE.method =="Turnbull.intervals") { f <- npmle(censdata, method = NPMLE.method) # New xlim calculation from equivalence intervals bounds <- c(f$right, f$left) finitebounds <- bounds[is.finite(bounds)] upper <- max(finitebounds) lower <- min(finitebounds) width <- upper - lower xmin.Wang.cdf <- lower - width * 0.1 xmax.Wang.cdf <- upper + width * 0.1 xlim.Wang.cdf <- c(xmin.Wang.cdf, xmax.Wang.cdf) ylim.Wang.cdf <- c(0,1) k <- length(f$left) Fnpsurv <- cumsum(f$p) ## calul des points points pour Q et P dans les GOF stat et graph Fbefore <- c(0, Fnpsurv[-k]) df <- data.frame(left = f$left, right = f$right) # Definition of vertices of each rectangle Qi.left <- df$left # dim k Qi.left4plot <- Qi.left if (is.infinite(Qi.left4plot[1]) | is.nan(Qi.left4plot[1])) Qi.left4plot[1] <- xmininf Qi.right <- df$right Qi.right4plot <- Qi.right if (is.infinite(Qi.right4plot[k]) | is.nan(Qi.right4plot[k])) Qi.right4plot[k] <- xmaxinf # keep only 16 significants digits for R configured with noLD (--disable-long-double) Pi.low <- signif(Fbefore, 16) Pi.up <- signif(Fnpsurv, 16) # Plot of the ECDF if (specifytitle) { plot(1, 1, type = "n", xlim = xlim.Wang.cdf, ylim = ylim.Wang.cdf, xlab = "Censored data", ylab = "CDF", main = titleCDF, ...) } else { plot(1, 1, type = "n", xlim = xlim.Wang.cdf, ylim = ylim.Wang.cdf, xlab = "Censored data", ylab = "CDF", ...) } xmin <- par("usr")[1] xmax <- par("usr")[2] # the line at right of the rectangles dright <- c(f$left[1], rep(f$right, rep(2,k)), f$right[k]) Fright <- rep(c(0,Fnpsurv), rep(2,k+1)) lines(dright, Fright, ...) ### the line at left of the rectangles dleft <- rep(c(f$left,f$right[k]), rep(2,k+1)) Fleft <- c(0,rep(Fnpsurv, rep(2,k)),1) lines(dleft, Fleft, ...) # Add of the filled rectangles for(i in 1:k) { rect(xleft = Qi.left4plot, ybottom = Pi.low, xright = Qi.right4plot, ytop = Pi.up, border = "black", col = "lightgrey", ...) } } else # plot using package survival { survdata <- Surv(time = censdata$left, time2 = censdata$right, type="interval2") survfitted <- survfit(survdata ~ 1) if (Turnbull.confint) { if (specifytitle) { plot(survfitted,fun="event",xlab="Censored data", ylab="CDF",ylim = c(0,1), main = titleCDF, ...) } else { plot(survfitted,fun="event",xlab="Censored data", ylab="CDF", ylim = c(0,1), ...) } } else { if (specifytitle) { plot(survfitted,fun="event",xlab="Censored data", ylab="CDF", conf.int = FALSE, main = titleCDF, ylim = c(0,1), ...) } else { plot(survfitted,fun="event",xlab="Censored data", ylab="CDF", conf.int = FALSE, ylim = c(0,1), ...) } } xmin <- par("usr")[1] xmax <- par("usr")[2] } }else # if !NPMLE { if (is.finite(leftNA) & any(is.na(censdata$left))) censdata[is.na(censdata$left),]$left<-leftNA if (is.finite(rightNA) & any(is.na(censdata$right))) censdata[is.na(censdata$right),]$right<-rightNA lcens<-censdata[is.na(censdata$left),]$right if (any(is.na(lcens)) ) stop("An observation cannot be both right and left censored, coded with two NA values") rcens<-censdata[is.na(censdata$right),]$left noricens<-censdata[!is.na(censdata$left) & !is.na(censdata$right),] # definition of mid point for each observation (if not NA) # in order to have the order of plot of each observation # and order of left and right bounds for censored observations midnoricens<-(noricens$left+noricens$right)/2 ordmid<-order(midnoricens) ordlcens<-order(lcens) ordrcens<-order(rcens) nlcens<-length(lcens) nrcens<-length(rcens) nnoricens<-length(noricens$left) n<-length(censdata$left) if (specifytitle) { plot(c(0,0),c(0,0),type="n",xlim=xlim,ylim=ylim,xlab="Censored data", ylab="CDF",main=titleCDF, ...) } else { plot(c(0,0),c(0,0),type="n",xlim=xlim,ylim=ylim,xlab="Censored data", ylab="CDF", ...) } # functions to plot one interval or point for each observation for # observation ordered i out of n plotlcens <- function(i) { y <- i/n lines(c(xmininf, lcens[ordlcens[i]]), c(y, y), ...) } if (nlcens>=1) toto<-sapply(1:nlcens,plotlcens) plotnoricens<-function(i) { y<-(i+nlcens)/n if (noricens[ordmid[i],]$left!=noricens[ordmid[i],]$right) lines(c(noricens[ordmid[i],]$left,noricens[ordmid[i],]$right),c(y,y), ...) else points(noricens[ordmid[i],]$left,y,pch=4, ...) } if (nnoricens>=1) toto<-sapply(1:nnoricens,plotnoricens) plotrcens<-function(i) { y<-(i+nlcens+nnoricens)/n lines(c(rcens[ordrcens[i]],xmaxinf),c(y,y), ...) } if (nrcens>=1) toto <- sapply(1:nrcens,plotrcens) } # en of else if NPMLE if (!missing(distr)){ # plot of the theoretical cumulative function if (!is.character(distr)) distname<-substring(as.character(match.call()$distr),2) else distname<-distr if (!is.list(para)) stop("'para' must be a named list") ddistname <- paste0("d", distname) if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) pdistname <- paste0("p", distname) if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) densfun <- get(ddistname,mode="function") nm <- names(para) f <- formals(densfun) args <- names(f) m <- match(nm, args) if (any(is.na(m))) stop(paste("'para' specifies names which are not arguments to ",ddistname)) # plot of continuous data with theoretical distribution s <- seq(xmin, xmax, by=(xmax-xmin)/100) theop <- do.call(pdistname, c(list(s), as.list(para))) lines(s, theop, col="red") } if (!onlyCDFplot) { # definition of rectangles and limits Qitheo.left <- do.call(qdistname, c(list(Pi.low), as.list(para))) Qitheo.right <- do.call(qdistname, c(list(Pi.up), as.list(para))) xmin.Wang.qq <- min(xmin.Wang.cdf, Qitheo.right[-k]) xmax.Wang.qq <- max(xmin.Wang.cdf, Qitheo.left[-1]) xlim.Wang.qq <- c(xmin.Wang.qq, xmax.Wang.qq) Qitheo.left4plot <- Qitheo.left if (is.infinite(Qitheo.left4plot[1]) | is.nan(Qitheo.left4plot[1])) Qitheo.left4plot[1] <- xmininf Qitheo.right4plot <- Qitheo.right if (is.infinite(Qitheo.right4plot[k]) | is.nan(Qitheo.right4plot[k])) Qitheo.right4plot[k] <- xmaxinf ## Q-Q plot plot(1, 1, type = "n", main = "Q-Q plot", xlim = xlim.Wang.qq, ylim = xlim.Wang.qq, xlab = "Theoretical quantiles", ylab = "Empirical quantiles") rect(xleft = Qitheo.left4plot, ybottom = Qi.left4plot, xright = Qitheo.right4plot, ytop = Qi.right4plot, border = "black", col = "lightgrey") abline(0,1) ## P-P plot plot(1, 1, type = "n", main = "P-P plot", xlim = ylim, ylim = ylim, xlab = "Theoretical probabilities", ylab = "Empirical probabilities") # plot of rectangles Pitheo.low <- do.call(pdistname, c(list(Qi.left), as.list(para))) Pitheo.up <- do.call(pdistname, c(list(Qi.right), as.list(para))) rect(xleft = Pitheo.low, ybottom = Pi.low, xright = Pitheo.up, ytop = Pi.up, border = "black", col = "lightgrey") abline(0,1) par(def.par) } invisible() } fitdistrplus/R/util-transform.R0000644000176200001440000000611213742313702016322 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### Infinitely differentiable transformations of R into a bounded or half-bounded interval ### ### R functions ### #inverse are useless? #Transformation from (-Inf, +Inf) to (-1, 0) Tm10 <- function(x) -1/(1+exp(-x)) #Inverse iTm10 <- function(x) log(-x/(1+x)) #Transformation from (-Inf, +Inf) to (0, 1) T01 <- function(x) 1/(1+exp(-x)) #Inverse iT01 <- function(x) log(x/(1-x)) #Transformation from (-Inf, +Inf) to (0, +Inf) T0Inf <- function(x) exp(x) #Inverse iT0Inf <- function(x) log(x) #Transformation from (-Inf, +Inf) to (1, +Inf) T1Inf <- function(x) 1+exp(x) #Inverse iT1Inf <- function(x) log(x-1) fitdistrplus/R/bootdist-graph.R0000644000176200001440000000177013742313702016267 0ustar liggesusers pairs4boot <- function(x, trueval, col4ramp = c("green", "yellow", "orange", "red"), nbgrid = 100, nbcol = 100, enhance=TRUE, ...) { x <- data.matrix(rbind(x, trueval)) n <- NROW(x) if(is.null(trueval)) id1 <- 1:n else id1 <- 1:(n-1) panel.points <- function(x, y, ...) { points(x[id1], y[id1], xlim=range(x, na.rm=TRUE), ylim=range(y, na.rm=TRUE)) if(!is.null(trueval)) abline(v=x[n], h=y[n], col="red", lwd=2) } panel.density <- function(x, y, ...) { id2 <- id1[!is.na(x[id1])] #require(MASS) k <- kde2d(x[id2], y[id2], n=nbgrid) image(k, col=colorRampPalette(col4ramp)(nbcol), add=TRUE, xlim=range(x, na.rm=TRUE), ylim=range(y, na.rm=TRUE)) if(!is.null(trueval)) abline(v=x[n], h=y[n], col="black", lty="dashed") } if(enhance) pairs(x, upper.panel=panel.points, lower.panel=panel.density, ...) else pairs(x, upper.panel=panel.points, lower.panel=panel.points, ...) invisible() } fitdistrplus/R/util-manageparam.R0000644000176200001440000000544013742313702016563 0ustar liggesusers# checkparam function checks start.arg and fix.arg that parameters are named correctly # INPUTS # start.arg : starting values for optimization or the function to compute them from data or NULL # fix.arg : fixed values of paramaters or the function to compute them from data or NULL # obs : the full dataset # distname : name of the distribution # OUTPUTS # two named list with untested components manageparam <- function(start.arg, fix.arg, obs, distname) { #if clause with 3 different cases: #start.arg : NULL | named list | a function if(is.null(start.arg)) { trystart <- try(start.arg.default(obs, distname), silent = TRUE) if(class(trystart) == "try-error") { cat("Error in computing default starting values.\n") stop(trystart) } lstart <- trystart #lstart should be a named list but check it hasnoname <- is.null(names(lstart)) || !is.list(lstart) if(hasnoname) stop("Starting values must be a named list, error in default starting value.") }else if(is.list(start.arg)) { hasnoname <- is.null(names(start.arg)) if(hasnoname) stop("Starting values must be a named list (or a function returning a named list).") lstart <- start.arg }else if(is.function(start.arg)) { trystart <- try(start.arg(obs), silent = TRUE) if(class(trystart) == "try-error") { cat("Error in computing starting values with your function.\n") stop(trystart) } lstart <- trystart hasnoname <- is.null(names(lstart)) || !is.list(lstart) if(hasnoname) stop("Starting values must be a named list, your function does not return that.") }else stop("Wrong type of argument for start") #if clause with 3 different cases: #fix.arg : NULL | named list | a function if(is.null(fix.arg)) { lfix <- NULL }else if(is.list(fix.arg)) { hasnoname <- is.null(names(fix.arg)) if(hasnoname) stop("Fixed parameter values must be a named list (or a function returning a named list).") lfix <- fix.arg }else if(is.function(fix.arg)) { tryfix <- try(fix.arg(obs), silent = TRUE) if(class(tryfix) == "try-error") { cat("Error in computing fixed parameter values with your function.\n") stop(tryfix) } lfix <- tryfix hasnoname <- is.null(names(lfix)) || !is.list(lfix) if(hasnoname) stop("Fixed parameter values must be a named list, your function does not return that.") }else stop("Wrong type of argument for fix.arg") #eliminate arguments both in lstart and lfix (when start.arg was NULL) if(is.null(start.arg) && !is.null(lfix)) { lstart <- lstart[!names(lstart) %in% names(lfix)] if(length(lstart) == 0) stop("Don't need to use fitdist() if all parameters have fixed values") } list("start.arg"=lstart, "fix.arg"=lfix) } fitdistrplus/R/mmedist.R0000644000176200001440000004573113742313702015010 0ustar liggesusers############################################################################# # Copyright (c) 2010 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### Matching moment estimation for non-censored data ### ### R functions ### mmedist <- function (data, distr, order, memp, start=NULL, fix.arg=NULL, optim.method="default", lower=-Inf, upper=Inf, custom.optim=NULL, weights=NULL, silent=TRUE, gradient=NULL, checkstartfix=FALSE, ...) { if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr if (is.element(distname, c("norm", "lnorm", "pois", "exp", "gamma", "nbinom", "geom", "beta", "unif", "logis"))) meth <- "closed formula" else meth <- optim.method mdistname <- paste("m", distname, sep="") ddistname <- paste("d", distname, sep="") argddistname <- names(formals(ddistname)) if(is.null(custom.optim)) optim.method <- match.arg(optim.method, c("default", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent")) if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of integers greater than 0") if(!is.allint.w(weights)) stop("weights should be a vector of (strictly) positive integers") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") warning("weights are not taken into account in the default initial values") } if(meth != "closed formula") { if (!exists(mdistname, mode="function")) stop(paste0("The moment ", mdistname, " function must be defined.")) # mdistname contains the good name of the theoretical moment function } if (!(is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1") if(is.null(weights)) { loglik <- function(par, fix.arg, obs, ddistnam) sum(log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) }else { loglik <- function(par, fix.arg, obs, ddistnam) sum(weights * log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } if(meth == "closed formula") { n <- length(data) if(is.null(weights)) { m <- mean(data) v <- (n - 1)/n*var(data) }else #weighted version from util-wtdstat.R { m <- wtd.mean(data, weights=weights) v <- wtd.var(data, weights=weights) } if (!is.null(fix.arg)) stop("argument fix.arg cannot be used when a closed formula is used.") # Fitting by matching moments if (!(is.vector(data) & is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1") if (distname == "norm") { estimate <- c(mean=m, sd=sqrt(v)) order <- 1:2 } if (distname == "lnorm") { if (any(data <= 0)) stop("values must be positive to fit a lognormal distribution") sd2 <- log(1+v/m^2) estimate <- c(meanlog=log(m) - sd2/2, sdlog=sqrt(sd2)) order <- 1:2 } if (distname == "pois") { estimate <- c(lambda=m) order <- 1 } if (distname == "exp") { estimate <- c(rate=1/m) order <- 1 } if (distname == "gamma" ) { shape <- m^2/v rate <- m/v estimate<-c(shape=shape, rate=rate) order <- 1:2 } if (distname == "nbinom" ) { size <- if (v > m) m^2/(v - m) else NaN estimate<-c(size=size, mu=m) order <- 1:2 } if (distname == "geom" ) { prob<-if (m>0) 1/(1+m) else NaN estimate<-c(prob=prob) order <- 1 } if (distname == "beta" ) { if (any(data < 0) | any(data > 1)) stop("values must be in [0-1] to fit a beta distribution") aux<-m*(1-m)/v - 1 shape1 <- m*aux shape2 <- (1-m)*aux estimate<-c(shape1=shape1, shape2=shape2) order <- 1:2 } if (distname == "unif" ) { min1 <- m-sqrt(3*v) max1 <- m+sqrt(3*v) estimate<-c(min1,max1) order <- 1:2 } if (distname == "logis" ) { scale <- sqrt(3*v)/pi estimate<-c(location=m, scale=scale) order <- 1:2 } if (exists(ddistname)) loglikval <- loglik(estimate, fix.arg, data, ddistname) else loglikval <- NULL res <- list(estimate=estimate, convergence=0, value=NULL, hessian=NULL, optim.function=NULL, opt.meth=NULL, fix.arg=NULL, fix.arg.fun=NULL, weights=weights, counts=NULL, optim.message=NULL, loglik= loglikval, method=meth, order=order, memp=NULL) }else #an optimimisation has to be done, where fix.arg and start can be a function { if(is.vector(start)) #backward compatibility start <- as.list(start) if(!checkstartfix) #pre-check has not been done by fitdist() or bootdist() { cat("checkstartfix is carried out\n") # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #set fix.arg.fun if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL }else #pre-check has been done by fitdist() or bootdist() { arg_startfix <- list(start.arg=start, fix.arg=fix.arg) fix.arg.fun <- NULL } #unlist starting values as needed in optim() vstart <- unlist(arg_startfix$start.arg) #sanity check if(is.null(vstart)) stop("Starting values could not be NULL with checkstartfix=TRUE") #erase user value #(cannot coerce to vector as there might be different modes: numeric, character...) fix.arg <- arg_startfix$fix.arg if(length(vstart) != length(order)) stop("wrong dimension for the moment order to match") if(missing(memp)) stop("the empirical moment function must be defined") #backward compatibility when memp is the name of the function and not the function itself if(is.character(memp)) memp <- get0(memp, envir=pos.to.env(1)) #check the memp function if(!is.function(memp)) stop("the empirical moment must be defined as a function") if(is.null(weights)) { txt <- "the empirical moment function must be a two-argument function of 'x', 'order'" if(length(formals(memp)) != 2) stop(txt) if(any(names(formals(memp)) != c("x", "order"))) stop(txt) }else { txt <- "the empirical moment function must be a three-argument function of 'x', 'order', 'weights'" if(length(formals(memp)) != 3) stop(txt) if(any(names(formals(memp)) != c("x", "order", "weights"))) stop(txt) } ############# MME fit using optim or custom.optim ########## # definition of the function to minimize : least square (Cramer - von Mises type) if(is.null(weights)) { DIFF2 <- function(par, fix.arg, order, obs, mdistnam, memp, weights) { momtheo <- do.call(mdistnam, c(as.list(order), as.list(par), as.list(fix.arg)) ) momemp <- as.numeric(memp(obs, order)) (momemp - momtheo)^2 } fnobj <- function(par, fix.arg, obs, mdistnam, memp, weights) sum( sapply(order, function(o) DIFF2(par, fix.arg, o, obs, mdistnam, memp)) ) }else { DIFF2 <- function(par, fix.arg, order, obs, mdistnam, memp, weights) { momtheo <- do.call(mdistnam, c(as.list(order), as.list(par), as.list(fix.arg)) ) momemp <- as.numeric(memp(obs, order, weights)) (momemp - momtheo)^2 } fnobj <- function(par, fix.arg, obs, mdistnam, memp, weights) sum( sapply(order, function(o) DIFF2(par, fix.arg, o, obs, mdistnam, memp, weights)) ) } cens <- FALSE if(cens) stop("Moment matching estimation for censored data is not yet available.") owarn <- getOption("warn") # Try to minimize the stat distance using the base R optim function if(is.null(custom.optim)) { hasbound <- any(is.finite(lower) | is.finite(upper)) # Choice of the optimization method if (optim.method == "default") { opt.meth <- ifelse(length(vstart) > 1, "Nelder-Mead", "BFGS") }else opt.meth <- optim.method if(opt.meth == "BFGS" && hasbound && is.null(gradient)) { opt.meth <- "L-BFGS-B" txt1 <- "The BFGS method cannot be used with bounds without provided the gradient." txt2 <- "The method is changed to L-BFGS-B." warning(paste(txt1, txt2)) } options(warn=ifelse(silent, -1, 0)) #select optim or constrOptim if(hasbound) #finite bounds are provided { if(!is.null(gradient)) { opt.fun <- "constrOptim" }else #gradient == NULL { if(opt.meth == "Nelder-Mead") opt.fun <- "constrOptim" else if(opt.meth %in% c("L-BFGS-B", "Brent")) opt.fun <- "optim" else { txt1 <- paste("The method", opt.meth, "cannot be used by constrOptim() nor optim() without gradient and bounds.") txt2 <- "Only optimization methods L-BFGS-B, Brent and Nelder-Mead can be used in such case." stop(paste(txt1, txt2)) } } if(opt.fun == "constrOptim") { #recycle parameters npar <- length(vstart) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) # constraints are : Mat %*% theta >= Bnd, i.e. # +1 * theta[i] >= lower[i]; # -1 * theta[i] >= -upper[i] #select rows from the identity matrix haslow <- is.finite(lower) Mat <- diag(npar)[haslow, ] #select rows from the opposite of the identity matrix hasupp <- is.finite(upper) Mat <- rbind(Mat, -diag(npar)[hasupp, ]) colnames(Mat) <- names(vstart) rownames(Mat) <- paste0("constr", 1:NROW(Mat)) #select the bounds Bnd <- c(lower[is.finite(lower)], -upper[is.finite(upper)]) names(Bnd) <- paste0("constr", 1:length(Bnd)) initconstr <- Mat %*% vstart - Bnd if(any(initconstr < 0)) stop("Starting values must be in the feasible region.") opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobj, ui=Mat, ci=Bnd, grad=gradient, fix.arg=fix.arg, obs=data, mdistnam=mdistname, memp=memp, hessian=!is.null(gradient), method=opt.meth, weights=weights, ...), silent=TRUE) if(!inherits(opttryerror, "try-error")) if(length(opt$counts) == 1) #appears when the initial point is a solution opt$counts <- c(opt$counts, NA) }else #opt.fun == "optim" { opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, mdistnam=mdistname, memp=memp, hessian=TRUE, method=opt.meth, lower=lower, upper=upper, weights=weights, ...), silent=TRUE) } }else #hasbound == FALSE { opt.fun <- "optim" opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, mdistnam=mdistname, memp=memp, hessian=TRUE, method=opt.meth, lower=lower, upper=upper, ...), silent=TRUE) } options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The function optim encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The function optim failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=opt.fun, optim.method=opt.meth, fix.arg=fix.arg, fix.arg.fun=fix.arg.fun, weights=weights, counts=opt$counts, optim.message=opt$message, loglik=ifelse(exists(ddistname), loglik(opt$par, fix.arg, data, ddistname), NULL), method=meth, order=order, memp=memp) }else # Try to minimize the stat distance using a user-supplied optim function { opt.meth <- NULL if (!cens) { options(warn=ifelse(silent, -1, 0)) opttryerror <- try(opt <- custom.optim(fn=fnobj, fix.arg=fix.arg, obs=data, mdistnam=mdistname, memp=memp, par=vstart, weights=weights, ...), silent=TRUE) options(warn=owarn) }else stop("Moment matching estimation for censored data is not yet available.") if (inherits(opttryerror,"try-error")) { warnings("The customized optimization function encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The customized optimization function failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) argdot <- list(...) method.cust <- argdot$method res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=custom.optim, optim.method=method.cust, fix.arg=fix.arg, fix.arg.fun=fix.arg.fun, weights=weights, counts=opt$counts, optim.message=opt$message, loglik=ifelse(exists(ddistname), loglik(opt$par, fix.arg, data, ddistname), NULL), method=meth, order=order, memp=memp) } } return(res) } ## old function with previous name momdist<-function (data, distr) { stop("the name \"momdist\" for matching moments function is NO MORE used and is replaced by \"mmedist\".") } fitdistrplus/R/util-cens2pseudo.R0000644000176200001440000000460513742313702016546 0ustar liggesusers# compute pseudo data from a censored dataset # INPUTS # censdata : a two-column matrix with left, right and/or interval censored data # OUTPUTS # a vector of pseudo data (needed to compute starting values) # a vector of right censored data # a vector of left censored data # a vector of non censored data # a vector of interval censored data cens2pseudo <- function(censdata) { # Definition of datasets lcens (left censored)=vector, rcens (right censored)= vector, # icens (interval censored) = dataframe with left and right # ncens (not censored) = vector and # pseudo (data transformed in non censored pseudo data by taking the # mean of bounds for interval censored data and the left or right bound for the other # censored data) = vector irow.lcens <- is.na(censdata$left) # rows corresponding to lcens data lcens <- censdata[irow.lcens, ]$right irow.rcens <- is.na(censdata$right) # rows corresponding to rcens data rcens <- censdata[irow.rcens, ]$left if (any(is.na(lcens)) ) stop("An observation cannot be both right and left censored, coded with two NA values") irow.ncens <- censdata$left==censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to ncens data ncens<-censdata[irow.ncens, ]$left irow.icens <- censdata$left!=censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to icens data icens<-censdata[irow.icens, ] pseudo <- c(rcens, lcens, ncens, (icens$left+icens$right)/2) list(pseudo=pseudo, rcens=rcens, lcens=lcens, ncens=ncens, icens=icens) } # compute row indexes from a censored dataset cens2idxrow <- function(censdata) { # Definition of datasets lcens (left censored)=vector, rcens (right censored)= vector, # icens (interval censored) = dataframe with left and right # and ncens (not censored) = vector irow.lcens <- is.na(censdata$left) # rows corresponding to lcens data irow.rcens <- is.na(censdata$right) # rows corresponding to rcens data irow.ncens <- censdata$left==censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to ncens data irow.icens <- censdata$left!=censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to icens data list(lcens=irow.lcens, rcens=irow.rcens, ncens=irow.ncens, icens=irow.icens) }fitdistrplus/R/util-npsurv-km.R0000644000176200001440000000270313742313702016253 0ustar liggesusers# ----------------------------------------------------------------------- # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Internal kaplan meier function # # ----------------------------------------------------------------------- # # Original code from Yong Wang, 2020 # # ----------------------------------------------------------------------- # # Kaplan-Meier estimate of the survival function for right-censored data km = function(data, w=1) { x = icendata(data, w) if(any(x$o[,2] != Inf)) stop("Not all observations are exact or right-censored") if(nrow(x$o) == 0) { # no right-censored observations f = idf(x$t, x$t, x$wt) ll = sum(x$wt * log(f$p)) return(list(f=f, ll=ll)) } c = colSums(x$wo * outer(x$o[,1], x$t, "<")) n = sum(x$wt, x$wo) # number of observations r = n - c - c(0,cumsum(x$wt))[1:length(x$t)] # no. at risk S = cumprod(1 - x$wt/r) # survival prob. # tab = cbind(x$t, x$wt, c, r, S) p = rev(diff(rev(c(1,S,0)))) dc = x$wt + c if(max(x$t) > max(x$o[,1])) { f = idf(x$t, x$t, p[-length(p)]) ll = sum( x$wt * log(f$p) ) } else { f = idf(c(x$t,max(x$o[,1])), c(x$t,Inf), p) ll = sum(c(x$wt, n - sum(x$wt)) * log(f$p)) } list(f=f, ll=ll) } fitdistrplus/R/Surv2fitdistcens.R0000644000176200001440000001117714075737424016637 0ustar liggesusers############################################################################# # Copyright (c) 2021 Christophe Dutang and Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### data handling functions ### ### R functions ### Surv2fitdistcens <- function(time, time2, event, type=c('right', 'left', 'interval', 'interval2')) { type <- match.arg(type, c('right', 'left', 'interval', 'interval2')) stopifnot(is.numeric(time)) stopifnot(length(time) >= 1) if (type %in% c('right', 'left')) { if (!missing(time2)) warning("time2 is not used with type 'right' and 'left' ") } else { stopifnot(is.numeric(time2)) stopifnot(length(time) == length(time2)) if (type == 'interval2' & !missing(event)) warning("event is not used with type 'interval2' ") } if (type != 'interval2') { stopifnot(length(time) == length(event)) if(is.logical(event)) event <- 1*(event == TRUE) else if(all(event == 1 | event == 2) & type != 'interval') { event <- 1*(event == 2) }else if(all(event %in% 0:3) && sum(event >= 3) > 0) { stopifnot(type %in% 'interval') }else if(is.factor(event)) { stopifnot(length(levels(event)) == 2) event <- 1*(event == levels(event)[2]) } if(any(!event %in% 0:1) && type != "interval") stop("wrong 'event' argument") } #compute data.frame if(type == "right") { out <- cbind.data.frame(left=time, right=NA) out$right[event == 1] <- time[event == 1] }else if(type == "left") { out <- cbind.data.frame(left=NA, right=time) out$left[event == 1] <- time[event == 1] }else if(type == "interval") { out <- cbind.data.frame(left=rep(NA, length(time)), right=rep(NA, length(time2))) #0=right censored, out$left[event == 0] <- time[event == 0] #1=event at time, out$left[event == 1] <- time[event == 1] out$right[event == 1] <- time[event == 1] #2=left censored, out$right[event == 2] <- time[event == 2] #3=interval censored out$left[event == 3] <- time[event == 3] out$right[event == 3] <- time2[event == 3] } else # type "interval2 { out <- cbind.data.frame(left=time,right=time2) out$left[!is.finite(time)] <- NA out$right[!is.finite(time2)] <- NA } out } fitdistrplus/R/CIcdfplot.R0000644000176200001440000002535514102244224015206 0ustar liggesusers############################################################################# # Copyright (c) 2016 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot cumulative distribution functions with confidence interval band ### ### R functions ### CIcdfplot <- function(b, CI.output, CI.type = "two.sided", CI.level = 0.95, CI.col = "red", CI.lty = 2, CI.fill = NULL, CI.only = FALSE, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, datapch, datacol, fitlty, fitcol, fitlwd, horizontals = TRUE, verticals = FALSE, do.points = TRUE, use.ppoints = TRUE, a.ppoints = 0.5, name.points = NULL, lines01 = FALSE, plotstyle = "graphics", ...) { if(inherits(b, "bootdist")) { cens <- FALSE } else if(inherits(b, "bootdistcens")) { cens <- TRUE } else { stop("argument b must be a 'bootdist' or a `bootdistcens` object") } if(missing(CI.output)) stop("argument CI.output must be specified: either 'probability' or 'quantile'.") CI.output <- match.arg(CI.output, c("probability", "quantile")) CI.type <- match.arg(CI.type, c("two.sided", "less", "greater")) CI.level <- CI.level[1] #compute lower and upper value for the area if (!cens) { mydat <- b$fitpart$data n <- length(mydat) xmin <- min(mydat) xmax <- max(mydat) } else { censdata <- b$fitpart$censdata n <- nrow(censdata) xmin <- min(c(censdata$left, censdata$right), na.rm=TRUE) xmax <- max(c(censdata$left, censdata$right), na.rm=TRUE) } if (missing(xlim)) xlim <- c(xmin, xmax) lowx <- min(xlim[1], ifelse(xmin < 0, xmin*1.5, xmin*.5)) uppx <- max(xlim[2], ifelse(xmax < 0, xmax*.5, xmax*1.5)) if(missing(ylim)) ylim <- c(0, 1) if(!is.logical(CI.only)) stop("argument CI.only must be a logical") # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) #default values (same as cdfcomp()) if (missing(datapch)) datapch <- 16 if (missing(datacol)) datacol <- "black" if (missing(fitcol)) fitcol <- 2 if (missing(fitlty)) fitlty <- 1 if (missing(fitlwd)) fitlwd <- 1 if (missing(xlab)) { if (!cens) xlab <- ifelse(xlogscale, "data in log scale", "data") else xlab <- ifelse(xlogscale, "censored data in log scale", "censored data") } if (missing(ylab)) ylab <- "CDF" if (missing(main)) main <- ifelse(CI.only, "Theoretical CDF with CI", "Empirical and theoretical CDF with CI") #get name and cdf name distname <- b$fitpart$distname pdistname <- paste("p",distname,sep="") qdistname <- paste("q",distname,sep="") if (!exists(pdistname, mode="function") && CI.output == "probability") stop(paste("The ", pdistname, " function must be defined")) if (!exists(qdistname, mode="function") && CI.output == "quantile") stop(paste("The ", qdistname, " function must be defined")) #compute c.d.f. values on bootstraped parameters if(CI.output == "probability") { cdfval <- function(x) { calcp <- function(i) { parai <- c(as.list(b$estim[i, ]), as.list(b$fitpart$fix.arg)) do.call(pdistname, c(list(x), as.list(parai))) } res <- t(sapply(1:b$nbboot, calcp)) rownames(res) <- 1:b$nbboot colnames(res) <- paste0("x=", x) res } x <- seq(lowx, uppx, length=501) #compute quantiles on c.d.f. if (CI.type == "two.sided") { alpha <- (1-CI.level)/2 CIband <- t(apply(cdfval(x), MARGIN=2, quantile, probs=c(alpha, 1-alpha), na.rm=TRUE)) colnames(CIband) <- format.perc(c(alpha, 1-alpha), 3) }else if (CI.type == "less") { CIband <- as.matrix(apply(cdfval(x), MARGIN=2, quantile, probs=CI.level, na.rm=TRUE)) colnames(CIband) <- format.perc(CI.level, 3) }else { CIband <- as.matrix(apply(cdfval(x), MARGIN=2, quantile, probs=1-CI.level, na.rm=TRUE)) colnames(CIband) <- format.perc(1-CI.level, 3) } }else #CI.output == "quantile" { qval <- function(p) { calcp <- function(i) { parai <- c(as.list(b$estim[i, ]), as.list(b$fitpart$fix.arg)) do.call(qdistname, c(list(p), as.list(parai))) } res <- t(sapply(1:b$nbboot, calcp)) rownames(res) <- 1:b$nbboot colnames(res) <- paste0("p=", p) res } #compute lower and upper value for the area # p <- seq(sqrt(.Machine$double.eps), 1- sqrt(.Machine$double.eps), length=101) p <- seq(0.0001, 1- 0.0001, length=501) #compute quantiles on c.d.f. if (CI.type == "two.sided") { alpha <- (1-CI.level)/2 CIband <- t(apply(qval(p), MARGIN=2, quantile, probs=c(alpha, 1-alpha), na.rm=TRUE)) colnames(CIband) <- format.perc(c(alpha, 1-alpha), 3) }else if (CI.type == "less") { CIband <- as.matrix(apply(qval(p), MARGIN=2, quantile, probs=1-CI.level, na.rm=TRUE)) colnames(CIband) <- format.perc(CI.level, 3) }else { CIband <- as.matrix(apply(qval(p), MARGIN=2, quantile, probs=CI.level, na.rm=TRUE)) colnames(CIband) <- format.perc(1-CI.level, 3) } } #temp var to open a graphic (if needed) logxy <- paste0(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y","")) ##### plot #### if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## #open graphic window plot(0, 0, main=main, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, log=logxy, type="n") if (!is.null(CI.fill)) # first fill the band { if(CI.output == "probability") { if(CI.type == "two.sided") polygon(c(x, rev(x)), c(CIband[,2], rev(CIband[,1])), col=CI.fill, border=CI.fill, ...) else if(CI.type == "less") polygon(c(x, uppx, uppx), c(CIband, 1, 0), col=CI.fill, border=CI.fill, ...) else #if(CI.type == "greater") polygon(c(x, lowx, lowx), c(CIband, 1, 0), col=CI.fill, border=CI.fill, ...) }else #CI.output == "quantile" { if(CI.type == "two.sided") polygon(c(CIband[,2], rev(CIband[,1])), c(p, rev(p)), col=CI.fill, border=CI.fill, ...) else if(CI.type == "less") polygon(c(CIband, uppx, uppx), c(p, 1, 0), col=CI.fill, border=CI.fill, ...) else #if(CI.type == "greater") polygon(c(CIband, lowx, lowx), c(p, 1, 0), col=CI.fill, border=CI.fill, ...) } } # add lines for the bounds of the CI if(CI.output == "probability") { matlines(x, CIband, col=CI.col, lty=CI.lty, ...) }else #CI.output == "quantile" { matlines(CIband, p, col=CI.col, lty=CI.lty, ...) } if(!CI.only) # add the empirical and fitted distributions { if (!cens) { cdfcomp(b$fitpart, xlim=xlim, ylim=ylim, xlogscale = xlogscale, ylogscale = ylogscale, main=main, xlab=xlab, ylab=ylab, datapch=datapch, datacol=datacol, fitlty=fitlty, fitlwd=fitlwd, fitcol=fitcol, horizontals = horizontals, verticals = verticals, do.points = do.points, use.ppoints = use.ppoints, a.ppoints = a.ppoints, name.points = name.points, lines01 = lines01, addlegend = FALSE, add=TRUE) } else { cdfcompcens(b$fitpart, xlim=xlim, ylim=ylim, xlogscale = xlogscale, ylogscale = ylogscale, main=main, xlab=xlab, ylab=ylab, datacol=datacol, fitlty=fitlty, fitlwd=fitlwd, fillrect = NA, fitcol=fitcol, lines01 = lines01, Turnbull.confint = FALSE, addlegend = FALSE, add=TRUE) } } } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## if(CI.output == "probability") { if(CI.type == "less") CIband <- cbind(rep(0, NROW(CIband)), CIband) if(CI.type == "greater") CIband <- cbind(CIband, rep(1, NROW(CIband))) dd <- as.data.frame(cbind(x, x, CIband)) } if(CI.output == "quantile") { if(CI.type == "less") CIband <- cbind(rep(uppx, NROW(CIband)), CIband) if(CI.type == "greater") CIband <- cbind(rep(lowx, NROW(CIband)), CIband) dd <- as.data.frame(cbind(CIband, p, p)) } colnames(dd) <- c("x1", "x2", "y1", "y2") {if (!cens) { cdfcomp(b$fitpart, xlim=xlim, ylim=ylim, xlogscale = xlogscale, ylogscale = ylogscale, main=main, xlab=xlab, ylab=ylab, datapch=datapch, datacol=datacol, fitlty={if(!CI.only) fitlty else 0}, fitlwd=fitlwd, fitcol=fitcol, horizontals = {if(!CI.only) horizontals else FALSE}, verticals = {if(!CI.only) verticals else FALSE}, do.points = {if(!CI.only) do.points else FALSE}, use.ppoints = use.ppoints, a.ppoints = a.ppoints, name.points = name.points, lines01 = lines01, addlegend = FALSE, add=TRUE, plotstyle = "ggplot") } else { cdfcompcens(b$fitpart, xlim=xlim, ylim=ylim, xlogscale = xlogscale, ylogscale = ylogscale, main=main, xlab=xlab, ylab=ylab, datacol=datacol, fitlty=fitlty, fitlwd=fitlwd, fillrect = NA, fitcol=fitcol, lines01 = lines01, Turnbull.confint = FALSE, addlegend = FALSE, add=TRUE, plotstyle = "ggplot") }} + ggplot2::geom_line(data = dd, ggplot2::aes_(x=quote(x1), y=quote(y1)), inherit.aes = FALSE, color = CI.col, lty = 2, alpha = 0.5) + ggplot2::geom_line(data = dd, ggplot2::aes_(x=quote(x2), y=quote(y2)), inherit.aes = FALSE, color = CI.col, lty = 2, alpha = 0.5) + {if(!is.null(CI.fill) & CI.output == "probability") ggplot2::geom_ribbon(data = dd, ggplot2::aes_(x = quote(x1), ymin=quote(y1), ymax=quote(y2)), inherit.aes = FALSE, fill = CI.fill, alpha = 0.5)} + {if(!is.null(CI.fill) & CI.output == "quantile") ggplot2::geom_ribbon(data = dd, ggplot2::aes_(xmin = quote(x1), xmax = quote(x2), y = quote(y1)), inherit.aes = FALSE, fill = CI.fill, alpha = 0.5)} } }fitdistrplus/R/util-Turnbull-intervals.R0000644000176200001440000000470513742313702020131 0ustar liggesusers# ----------------------------------------------------------------------- # # Copyright (c) 2020 Marie Laure Delignette-Muller # # # # Extrapolation of bounds of the Turnbull intervals # # form the outputs of survfit (pakage survival) # # ----------------------------------------------------------------------- # Turnbull.intervals <- function(censdata, threshold.par = 0.001) { survdata <- Surv(time = censdata$left, time2 = censdata$right, type="interval2") survfitted <- survfit(survdata ~ 1) # calculation of mass s <- survfitted$surv ns <- length(s) savant <- c(1, s[-ns]) mass <- savant - s # calculation of bounds of Turnbull intervals (equivalence classes) middletime <- survfitted$time lem <- length(middletime) leftbounds <- numeric(length = lem) rightbounds <- numeric(length = lem) db <- censdata db$left[is.na(db$left)] <- -Inf db$right[is.na(db$right)] <- Inf bounds <- sort(unique(c(db$right, db$left))) leb <- length(bounds) finitebounds <- bounds[is.finite(bounds)] minbounds <- min(finitebounds) maxbounds <- max(finitebounds) uncensoredvalues <- censdata[censdata$left == censdata$right,]$left j <- 1 for (i in 1:lem) { while(bounds[j] < middletime[i]) j <- j + 1 if (isTRUE(all.equal(middletime[i], bounds[j]))) { leftbounds[i] <- bounds[j] rightbounds[i] <- bounds[j] } else { leftbounds[i] <- bounds[j - 1] rightbounds[i] <- bounds[j] } } # try to rewrite it with a min(which()) and apply # correction for first and last bounds if needed if (!is.finite(bounds[1]) & isTRUE(all.equal(leftbounds[1], rightbounds[1])) & isTRUE(all.equal(leftbounds[1], minbounds)) & !is.element(leftbounds[1], uncensoredvalues)) { leftbounds[1] <- -Inf } if (!is.finite(bounds[leb]) & isTRUE(all.equal(leftbounds[lem], rightbounds[lem])) & isTRUE(all.equal(leftbounds[lem], maxbounds))& !is.element(leftbounds[lem], uncensoredvalues)) { rightbounds[lem] <- Inf } mass[lem] <- 1 - sum(mass[1:(lem - 1)]) f <- data.frame(left = leftbounds, right = rightbounds, p = mass, middletime = middletime) # elimination of negligible masses threshold <- threshold.par / nrow(censdata) f <- f[f$p > threshold, ] nf <- nrow(f) f$p[nf] <- 1 - sum(f$p[1:nf - 1]) return(f) } fitdistrplus/R/msedist.R0000644000176200001440000004331713742313702015014 0ustar liggesusers############################################################################# # Copyright (c) 2019 Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### maximum goodness-of-fit estimation for censored or non-censored data ### and continuous distributions ### (at this time only available for non censored data) ### ### R functions ### msedist <- function (data, distr, phidiv="KL", power.phidiv=NULL, start=NULL, fix.arg=NULL, optim.method="default", lower=-Inf, upper=Inf, custom.optim=NULL, weights=NULL, silent=TRUE, gradient=NULL, checkstartfix=FALSE, ...) # data may correspond to a vector for non censored data or to # a dataframe of two columns named left and right for censored data { if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr pdistname <- paste("p",distname,sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) ddistname <- paste("d",distname,sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) argddistname <- names(formals(ddistname)) if(is.null(custom.optim)) optim.method <- match.arg(optim.method, c("default", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent")) phidiv <- match.arg(phidiv, c("KL", "J", "R", "H", "V")) if(phidiv == "KL") #Kullback-Leibler information stopifnot(is.null(power.phidiv)) if(phidiv == "J") #Jeffreys divergence stopifnot(is.null(power.phidiv)) if(phidiv == "R") #Renyi divergence { stopifnot(length(power.phidiv) == 1) stopifnot(power.phidiv > 0 && power.phidiv != 1) } if(phidiv %in% c("H", "V")) #Hellinger distance or Vajda information { stopifnot(length(power.phidiv) == 1) stopifnot(power.phidiv >= 1) } start.arg <- start #to avoid confusion with the start() function of stats pkg (check is done lines 87-100) if(is.vector(start.arg)) #backward compatibility start.arg <- as.list(start.arg) if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of integers greater than 0") if(!is.allint.w(weights)) stop("weights should be a vector of (strictly) positive integers") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") warning("weights are not taken into account in the default initial values") } if (is.vector(data)) { cens <- FALSE if (!(is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1 for non censored data or a dataframe with two columns named left and right and more than one line for censored data") } else { cens <- TRUE censdata <- data stop("not yet implemented") } if (cens) { stop("not yet implemented") } if(!checkstartfix) #pre-check has not been done by fitdist() or bootdist() { # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #set fix.arg.fun if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL }else #pre-check has been done by fitdist() or bootdist() { arg_startfix <- list(start.arg=start, fix.arg=fix.arg) fix.arg.fun <- NULL } #unlist starting values as needed in optim() vstart <- unlist(arg_startfix$start.arg) #sanity check if(is.null(vstart)) stop("Starting values could not be NULL with checkstartfix=TRUE") #erase user value #(cannot coerce to vector as there might be different modes: numeric, character...) fix.arg <- arg_startfix$fix.arg ############# MGE fit using optim or custom.optim ########## # definition of the function to minimize depending on the argument gof # for non censored data if (!cens) { if(is.null(weights)) weights <- rep(1, NROW(data)) if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") # objective function (to minimize) is the opposite of the weighted average of the log spacings # the argument names are: # - par for parameters (like in optim function) # - fix.arg for optional fixed parameters # - obs for observations (previously dat but conflicts with genoud data.type.int argument) # - pdistnam for distribution name #NB1: by keeping only positive value, we take into cdf that are step functions #NB2: weight has a duplicate first value to have same length as spacings diffFx if(phidiv == "KL") { fnobj <- function(par, fix.arg, obs, pdistnam) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Fxi <- do.call(pdistnam, c(list(sx[-1]), as.list(par), as.list(fix.arg))) Fxim1 <- do.call(pdistnam, c(list(sx[-n]), as.list(par), as.list(fix.arg))) diffFx <- Fxi - Fxim1 idxPositive <- diffFx > 0 if(sum(idxPositive, na.rm = TRUE) == 0) return(NaN) wx <- c(weights[1], weights) - mean(wx[idxPositive] * log(diffFx[idxPositive])) } }else if(phidiv == "J") { fnobj <- function(par, fix.arg, obs, pdistnam) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Fxi <- do.call(pdistnam, c(list(sx[-1]), as.list(par), as.list(fix.arg))) Fxim1 <- do.call(pdistnam, c(list(sx[-n]), as.list(par), as.list(fix.arg))) diffFx <- Fxi - Fxim1 idxPositive <- diffFx > 0 if(sum(idxPositive, na.rm = TRUE) == 0) return(NaN) wx <- c(weights[1], weights) - mean(wx[idxPositive] * log(diffFx[idxPositive]) * (1-diffFx[idxPositive])) } }else if(phidiv == "R") { fnobj <- function(par, fix.arg, obs, pdistnam) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Fxi <- do.call(pdistnam, c(list(sx[-1]), as.list(par), as.list(fix.arg))) Fxim1 <- do.call(pdistnam, c(list(sx[-n]), as.list(par), as.list(fix.arg))) diffFx <- Fxi - Fxim1 idxPositive <- diffFx > 0 if(sum(idxPositive, na.rm = TRUE) == 0) return(NaN) wx <- c(weights[1], weights) - mean(wx[idxPositive] * diffFx[idxPositive]^power.phidiv * sign(1-power.phidiv)) } }else if(phidiv == "H") { fnobj <- function(par, fix.arg, obs, pdistnam) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Fxi <- do.call(pdistnam, c(list(sx[-1]), as.list(par), as.list(fix.arg))) Fxim1 <- do.call(pdistnam, c(list(sx[-n]), as.list(par), as.list(fix.arg))) diffFx <- Fxi - Fxim1 idxPositive <- diffFx > 0 if(sum(idxPositive, na.rm = TRUE) == 0) return(NaN) wx <- c(weights[1], weights) mean(wx[idxPositive] * abs( 1-diffFx[idxPositive]^(1/power.phidiv) )^power.phidiv ) } }else if(phidiv == "V") { fnobj <- function(par, fix.arg, obs, pdistnam) { sx <- c(-Inf, sort(obs), Inf) n <- length(sx) Fxi <- do.call(pdistnam, c(list(sx[-1]), as.list(par), as.list(fix.arg))) Fxim1 <- do.call(pdistnam, c(list(sx[-n]), as.list(par), as.list(fix.arg))) diffFx <- Fxi - Fxim1 idxPositive <- diffFx > 0 if(sum(idxPositive, na.rm = TRUE) == 0) return(NaN) wx <- c(weights[1], weights) mean(wx[idxPositive] * abs( 1-diffFx[idxPositive] )^power.phidiv ) } }else stop("error: wrong phidiv") } else # if (!cens) stop("Maximum goodness-of-fit estimation is not yet available for censored data.") # Function to calculate the loglikelihood to return loglik <- function(par, fix.arg, obs, ddistnam) { sum(log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) } owarn <- getOption("warn") # Try to minimize the gof distance using the base R optim function if(is.null(custom.optim)) { hasbound <- any(is.finite(lower) | is.finite(upper)) # Choice of the optimization method if (optim.method == "default") { meth <- ifelse(length(vstart) > 1, "Nelder-Mead", "BFGS") }else meth <- optim.method if(meth == "BFGS" && hasbound && is.null(gradient)) { meth <- "L-BFGS-B" txt1 <- "The BFGS method cannot be used with bounds without provided the gradient." txt2 <- "The method is changed to L-BFGS-B." warning(paste(txt1, txt2)) } options(warn=ifelse(silent, -1, 0)) #select optim or constrOptim if(hasbound) #finite bounds are provided { if(!is.null(gradient)) { opt.fun <- "constrOptim" }else #gradient == NULL { if(meth == "Nelder-Mead") opt.fun <- "constrOptim" else if(meth %in% c("L-BFGS-B", "Brent")) opt.fun <- "optim" else { txt1 <- paste("The method", meth, "cannot be used by constrOptim() nor optim() without gradient and bounds.") txt2 <- "Only optimization methods L-BFGS-B, Brent and Nelder-Mead can be used in such case." stop(paste(txt1, txt2)) } } if(opt.fun == "constrOptim") { #recycle parameters npar <- length(vstart) #as in optim() line 34 lower <- as.double(rep_len(lower, npar)) #as in optim() line 64 upper <- as.double(rep_len(upper, npar)) # constraints are : Mat %*% theta >= Bnd, i.e. # +1 * theta[i] >= lower[i]; # -1 * theta[i] >= -upper[i] #select rows from the identity matrix haslow <- is.finite(lower) Mat <- diag(npar)[haslow, ] #select rows from the opposite of the identity matrix hasupp <- is.finite(upper) Mat <- rbind(Mat, -diag(npar)[hasupp, ]) colnames(Mat) <- names(vstart) rownames(Mat) <- paste0("constr", 1:NROW(Mat)) #select the bounds Bnd <- c(lower[is.finite(lower)], -upper[is.finite(upper)]) names(Bnd) <- paste0("constr", 1:length(Bnd)) initconstr <- Mat %*% vstart - Bnd if(any(initconstr < 0)) stop("Starting values must be in the feasible region.") opttryerror <- try(opt <- constrOptim(theta=vstart, f=fnobj, ui=Mat, ci=Bnd, grad=gradient, fix.arg=fix.arg, obs=data, pdistnam=pdistname, hessian=!is.null(gradient), method=meth, ...), silent=TRUE) if(!inherits(opttryerror, "try-error")) if(length(opt$counts) == 1) #appears when the initial point is a solution opt$counts <- c(opt$counts, NA) }else #opt.fun == "optim" { opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } }else #hasbound == FALSE { opt.fun <- "optim" opttryerror <- try(opt <- optim(par=vstart, fn=fnobj, fix.arg=fix.arg, obs=data, gr=gradient, pdistnam=pdistname, hessian=TRUE, method=meth, lower=lower, upper=upper, ...), silent=TRUE) } options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The function optim encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, loglik = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The function optim failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=opt.fun, optim.method=meth, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights=NULL, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), phidiv=phidiv, power.phidiv=power.phidiv) } else # Try to minimize the gof distance using a user-supplied optim function { options(warn=ifelse(silent, -1, 0)) if (!cens) opttryerror <- try(opt <- custom.optim(fn=fnobj, fix.arg=fix.arg, obs=data, pdistnam=pdistname, par=vstart, ...), silent=TRUE) else stop("Maximum goodness-of-fit estimation is not yet available for censored data.") options(warn=owarn) if (inherits(opttryerror,"try-error")) { warnings("The customized optimization function encountered an error and stopped.") if(getOption("show.error.messages")) print(attr(opttryerror, "condition")) return(list(estimate = rep(NA,length(vstart)), convergence = 100, value = NA, hessian = NA)) } if (opt$convergence>0) { warnings("The customized optimization function failed to converge, with the error code ", opt$convergence) } if(is.null(names(opt$par))) names(opt$par) <- names(vstart) argdot <- list(...) method.cust <- argdot$method res <- list(estimate = opt$par, convergence = opt$convergence, value = opt$value, hessian = opt$hessian, optim.function=custom.optim, optim.method=method.cust, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, weights=weights, counts=opt$counts, optim.message=opt$message, loglik=loglik(opt$par, fix.arg, data, ddistname), phidiv=phidiv, power.phidiv=power.phidiv) } return(res) } fitdistrplus/R/denscomp.R0000644000176200001440000003303713742313702015152 0ustar liggesusers############################################################################# # Copyright (c) 2012 Christophe Dutang, Aurelie Siberchicot, # Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### plot density functions for various fits ### of continuous distribution(s) (fitdist results) ### on a same dataset ### ### R functions ### denscomp <- function(ft, xlim, ylim, probability = TRUE, main, xlab, ylab, datacol, fitlty, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "topright", ylegend = NULL, demp = FALSE, dempcol = "black", plotstyle = "graphics", discrete, fitnbpts = 101, fittype="l", ...) { if(inherits(ft, "fitdist")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdist' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdist")))) stop("argument ft must be a list of 'fitdist' objects") } # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("denscomp is not yet available when using weights") # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # parameters used in 'hist' function ###### Where are they used - to remove ? !!!!!!!!!!!!!!!!!!!!!!!! argshistPlotFalse <- c("breaks", "nclass", "include.lowest", "right") argshistPlotTrue <- c(argshistPlotFalse, "density", "angle", "border", "axes", "labels") # manage default parameters nft <- length(ft) if (missing(datacol)) datacol <- NULL if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitlty)) fitlty <- 1:nft if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitlty <- rep(fitlty, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) fittype <- match.arg(fittype[1], c("p", "l", "o")) if (missing(xlab)) xlab <- "data" if (missing(ylab)) ylab <- ifelse(probability, "Density", "Frequency") if (missing(main)) main <- ifelse(probability, "Histogram and theoretical densities", "Histogram and theoretical frequencies") # check data mydata <- ft[[1]]$data verif.ftidata <- function(fti) { if (any(fti$data != mydata)) stop("All compared fits must have been obtained with the same dataset") invisible() } lapply(ft, verif.ftidata) # check xlim if(missing(xlim)) { xmin <- min(mydata) xmax <- max(mydata) xlim <- range(mydata) }else { xmin <- xlim[1] xmax <- xlim[2] } # initiate discrete if not given if(missing(discrete)) { discrete <- any(sapply(ft, function(x) x$discrete)) } if(!is.logical(discrete)) stop("wrong argument 'discrete'.") if(!is.logical(demp)) stop("wrong argument 'discrete'.") # some variable definitions n <- length(mydata) if(!discrete) sfin <- seq(xmin, xmax, length.out = fitnbpts[1]) else sfin <- unique(round(seq(xmin, xmax, length.out = fitnbpts[1]), digits = 0)) reshist <- hist(mydata, plot = FALSE, ...) if (!discrete) { if (probability) { scalefactor <- 1 } else { if (length(unique(diff(reshist$breaks))) > 1) # wrong histogram and not possible to compute a scale factor stop("You should not use probability = FALSE with non-equidistant breaks for the histogram !") else scalefactor <- n * diff(reshist$breaks)[1] } # previous writing that gave incorrect output in case of probability = 1 and non-equidistant breaks # scalefactor <- ifelse(probability, 1, n * diff(reshist$breaks)) } else { scalefactor <- ifelse(probability, 1, n) } # binwidth <- min(diff(reshist$breaks)) # computation of each fitted distribution comput.fti <- function(i) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname ddistname <- paste("d", distname, sep="") do.call(ddistname, c(list(sfin), as.list(para))) * scalefactor } fitteddens <- sapply(1:nft, comput.fti) if(NCOL(fitteddens) != nft || NROW(fitteddens) != length(sfin)) stop("problem when computing fitted densities.") # check ylim if (missing(ylim)) { if(!probability) if (discrete) { ylim <- c(0, max(as.numeric(table(mydata)))) } else { ylim <- c(0, max(reshist$counts)) } else # so if probability { if (discrete) { ylim <- c(0, max(as.numeric(table(mydata))/length(mydata))) } else { ylim <- c(0, max(reshist$density)) } } ylim <- range(ylim, fitteddens) }else ylim <- range(ylim) # in case of users enter a bad ylim # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } # forces demp to TRUE if discrete is TRUE if(discrete) demp <- TRUE #add empirical density/fmp to legend vectors if(demp) { legendtext <- c(legendtext, "emp.") fitlty <- c(fitlty, 1) fitlwd <- c(fitlwd, 1) fitcol <- c(fitcol, dempcol) } if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## if(!discrete) { #main plotting reshist <- hist(mydata, main = main, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, col = datacol, probability = probability, ...) #plot fitted densities (line) for(i in 1:nft) lines(sfin, fitteddens[,i], lty=fitlty[i], col=fitcol[i], lwd=fitlwd[i], ...) #plot empirical density if(demp) lines(density(mydata)$x, density(mydata)$y * scalefactor, col=dempcol) if (addlegend) legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, lty=fitlty, col=fitcol, lwd=fitlwd, ...) }else # so if discrete { #main plotting # plotting of an empty histogram reshist <- hist(mydata, main = main, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, border = "white", probability = probability, ...) eps <- diff(range(sfin))/200 if(fittype %in% c("l", "o")) { #plot fitted mass probability functions (line) for(i in 1:nft) lines(sfin+(i)*eps, fitteddens[,i], lty=fitlty[i], col=fitcol[i], lwd=fitlwd[i], type="h", ...) #plot empirical mass probability function if(demp) { empval <- sort(unique(mydata)) empprob <- as.numeric(table(mydata))/length(mydata) * scalefactor lines(empval, empprob, col=dempcol, type="h") } } if(fittype %in% c("p", "o")) { #plot fitted mass probability functions (point) for(i in 1:nft) points(sfin+(i)*eps, fitteddens[,i], col=fitcol[i], pch=1) #plot empirical density if(demp) { empval <- sort(unique(mydata)) empprob <- as.numeric(table(mydata))/length(mydata) * scalefactor points(empval, empprob, col=dempcol, pch=1) } } if (addlegend && fittype %in% c("l", "o")) legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, lty=fitlty, col=fitcol, lwd=fitlwd, ...) if (addlegend && fittype == "p") legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, pch=1, col=fitcol, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## # recode the legend position according to available positions in ggplot2 if(xlegend %in% c("topleft", "bottomleft")) xlegend <- "left" if(xlegend %in% c("topright", "bottomright")) xlegend <- "right" # the default colors of the bars is the same as panel.background.fill in theme_grey() if(is.null(datacol)) datacol <- "grey92" if (!discrete) { # structure the fitteddens in a relevant data.frame fitteddens <- as.data.frame(fitteddens) colnames(fitteddens) <- unlist(lapply(ft, function(X) X["distname"])) fitteddens <- stack(fitteddens) fitteddens$sfin <- sfin # sfin is recycled in the standard fashion fitteddens$ind <- factor(fitteddens$ind, levels = unique(fitteddens$ind)) # reorder levels in the appearance order of the input if(demp) # bind empirical data if demp is TRUE fitteddens <- rbind(fitteddens, data.frame(values = density(mydata)$y * scalefactor, ind = "demp", sfin = density(mydata)$x)) histdata <- data.frame(values = mydata, ind = "hist", sfin = mydata) # the added data must have the same column names as the main data to be compatible with ggplot ggdenscomp <- ggplot2::ggplot(fitteddens, ggplot2::aes_(quote(sfin), quote(values), group = quote(ind), colour = quote(ind))) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::ggtitle(main) + ggplot2::coord_cartesian(xlim = c(xlim[1], xlim[2]), ylim = c(ylim[1], ylim[2])) + {if(probability) ggplot2::geom_histogram(data = histdata, ggplot2::aes_(quote(values), quote(..density..)), breaks = reshist$breaks, boundary = 0, show.legend = FALSE, col = "black", alpha = 1, fill = datacol) else ggplot2::geom_histogram(data = histdata, ggplot2::aes_(quote(values), quote(..count..)), breaks = reshist$breaks, boundary = 0, show.legend = FALSE, col = "black", alpha = 1, fill = datacol)} + ggplot2::geom_line(data = fitteddens, ggplot2::aes_(linetype = quote(ind), colour = quote(ind), size = quote(ind))) + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend)) else ggplot2::theme(legend.position = "none")} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitlty, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) return(ggdenscomp) } else { eps <- diff(range(sfin))/200 # structure the fitteddens in a relevant data.frame fitteddens <- as.data.frame(fitteddens) colnames(fitteddens) <- unlist(lapply(ft, function(X) X["distname"])) fitteddens <- stack(fitteddens) fitteddens$ind <- factor(fitteddens$ind, levels = unique(fitteddens$ind)) # reorder levels in the appearance order of the input fitteddens$sfin <- sfin + sapply(fitteddens$ind, function(X) which(X == levels(fitteddens$ind))) *eps # sfin is recycled in the standard fashion if(demp) # bind empirical data if demp is TRUE fitteddens <- rbind(fitteddens, data.frame(values = as.numeric(table(mydata))/length(mydata) * scalefactor, ind = "demp", sfin = as.numeric(names(table(mydata))))) ggdenscomp <- ggplot2::ggplot(fitteddens, ggplot2::aes_(quote(sfin), quote(values), group = quote(ind), colour = quote(ind))) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::ggtitle(main) + ggplot2::coord_cartesian(xlim = c(xlim[1], xlim[2]), ylim = c(ylim[1], ylim[2])) + {if(fittype %in% c("l", "o")) ggplot2::geom_segment(data = fitteddens, ggplot2::aes_(x = quote(sfin), xend = quote(sfin), y = 0, yend = quote(values), linetype = quote(ind), size = quote(ind)))} + {if(fittype %in% c("p", "o")) ggplot2::geom_point(data = fitteddens, ggplot2::aes_(x = quote(sfin), y = quote(values), colour = quote(ind)), shape = 1)} + ggplot2::guides(colour = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(linetype = ggplot2::guide_legend(title = NULL)) + ggplot2::guides(size = ggplot2::guide_legend(title = NULL)) + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) + {if(addlegend) ggplot2::theme(legend.position = c(xlegend, ylegend)) else ggplot2::theme(legend.position = "none")} + ggplot2::scale_color_manual(values = fitcol, labels = legendtext) + ggplot2::scale_linetype_manual(values = fitlty, labels = legendtext) + ggplot2::scale_size_manual(values = fitlwd, labels = legendtext) return(ggdenscomp) } } } fitdistrplus/R/coef.R0000644000176200001440000000614513742313702014256 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Regis Pouillot, Jean-Baptiste Denis, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### extract model coefficients ### ### R functions ### #already in R # #coef <- function(object, ...) # UseMethod("coef") # #coef.default <- function(object, ...) # return(object) coef.fitdist <- function(object, ...) { stopifnot(inherits(object, "fitdist")) if(is.null(object$estimate)) stop("Internal error in coef.fitdist") else return(object$estimate) } coef.fitdistcens <- function(object, ...) { stopifnot(inherits(object, "fitdistcens")) if(is.null(object$estimate)) stop("Internal error in coef.fitdistcens") else return(object$estimate) } fitdistrplus/R/gradlogLik.R0000644000176200001440000000614313742313702015417 0ustar liggesusers############################################################################# # Copyright (c) 2016 Marie Laure Delignette-Muller, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### gradient of log-likelihood ### ### R functions (not exported) ### #Beta distribution grdbeta <- function(x, d1, d2) #individual contribution c(log(x)-digamma(d1)+digamma(d1+d2), log(1-x)-digamma(d2)+digamma(d1+d2)) grlnlbeta <- function(par, obs, ...) #total grad loglik -rowSums(sapply(obs, function(x) grdbeta(x, d1=par[1], d2=par[2]))) #Gamma distribution grdgamma <- function(x, shape, rate) #individual contribution c(log(x)-log(rate)-digamma(shape), x/rate^2-shape/rate) grlnlgamma <- function(par, obs, ...) #total grad loglik { n <- length(obs) res <- grdgamma(obs, shape=par[1], rate=par[2]) c(-sum(res[1:n]), -sum(res[1:n+n])) } fitdistrplus/R/fitdist.R0000644000176200001440000003346314067266732015026 0ustar liggesusers############################################################################# # Copyright (c) 2009 Marie Laure Delignette-Muller, Regis Pouillot, Jean-Baptiste Denis, Christophe Dutang # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### fit parametric distributions for non-censored data ### ### R functions ### fitdist <- function (data, distr, method = c("mle", "mme", "qme", "mge", "mse"), start=NULL, fix.arg=NULL, discrete, keepdata = TRUE, keepdata.nb=100, ...) { #check argument distr if (!is.character(distr)) distname <- substring(as.character(match.call()$distr), 2) else distname <- distr ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) #pdistname <- paste("p", distname, sep="") #if (!exists(pdistname, mode="function")) # stop(paste("The ", pdistname, " function must be defined")) #check argument discrete if(missing(discrete)) { if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) discrete <- TRUE else discrete <- FALSE } if(!is.logical(discrete)) stop("wrong argument 'discrete'.") if(!is.logical(keepdata) || !is.numeric(keepdata.nb) || keepdata.nb < 2) stop("wrong arguments 'keepdata' and 'keepdata.nb'") #check argument method if(any(method == "mom")) warning("the name \"mom\" for matching moments is NO MORE used and is replaced by \"mme\"") method <- match.arg(method, c("mle", "mme", "qme", "mge", "mse")) if(method %in% c("mle", "mme", "mge", "mse")) dpq2test <- c("d", "p") else dpq2test <- c("d", "p", "q") #check argument data if (!(is.vector(data) & is.numeric(data) & length(data)>1)) stop("data must be a numeric vector of length greater than 1") #encapsulate three dots arguments my3dots <- list(...) if (length(my3dots) == 0) my3dots <- NULL n <- length(data) # manage starting/fixed values: may raise errors or return two named list arg_startfix <- manageparam(start.arg=start, fix.arg=fix.arg, obs=data, distname=distname) #check inconsistent parameters argddistname <- names(formals(ddistname)) hasnodefaultval <- sapply(formals(ddistname), is.name) arg_startfix <- checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, argddistname, hasnodefaultval) #arg_startfix contains two names list (no longer NULL nor function) #store fix.arg.fun if supplied by the user if(is.function(fix.arg)) fix.arg.fun <- fix.arg else fix.arg.fun <- NULL # check d, p, q, functions of distname resdpq <- testdpqfun(distname, dpq2test, start.arg=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, discrete=discrete) if(any(!resdpq$ok)) { for(x in resdpq[!resdpq$ok, "txt"]) warning(x) } # Fit with mledist, qmedist, mgedist or mmedist if (method == "mme") { if (!is.element(distname, c("norm", "lnorm", "pois", "exp", "gamma", "nbinom", "geom", "beta", "unif", "logis"))) if (!"order" %in% names(my3dots)) stop("moment matching estimation needs an 'order' argument") mme <- mmedist(data, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) sd <- NULL correl <- varcovar <- NULL estimate <- mme$estimate loglik <- mme$loglik npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar convergence <- mme$convergence fix.arg <- mme$fix.arg weights <- mme$weights }else if (method == "mle") { mle <- mledist(data, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) if (mle$convergence>0) stop("the function mle failed to estimate the parameters, with the error code ", mle$convergence, "\n") estimate <- mle$estimate if(!is.null(mle$hessian)){ #check for NA values and invertible Hessian if(all(!is.na(mle$hessian)) && qr(mle$hessian)$rank == NCOL(mle$hessian)){ varcovar <- solve(mle$hessian) sd <- sqrt(diag(varcovar)) correl <- cov2cor(varcovar) }else{ varcovar <- NA sd <- NA correl <- NA } }else{ varcovar <- NA sd <- NA correl <- NA } loglik <- mle$loglik npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar convergence <- mle$convergence fix.arg <- mle$fix.arg weights <- mle$weights }else if (method == "qme") { if (!"probs" %in% names(my3dots)) stop("quantile matching estimation needs an 'probs' argument") qme <- qmedist(data, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) estimate <- qme$estimate sd <- NULL loglik <- qme$loglik npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar correl <- varcovar <- NULL convergence <- qme$convergence fix.arg <- qme$fix.arg weights <- qme$weights }else if (method == "mge") { if (!"gof" %in% names(my3dots)) warning("maximum GOF estimation has a default 'gof' argument set to 'CvM'") mge <- mgedist(data, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) estimate <- mge$estimate sd <- NULL loglik <- mge$loglik npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar correl <- varcovar <- NULL convergence <- mge$convergence fix.arg <- mge$fix.arg weights <- NULL }else if (method == "mse") { mse <- msedist(data, distname, start=arg_startfix$start.arg, fix.arg=arg_startfix$fix.arg, checkstartfix=TRUE, ...) estimate <- mse$estimate sd <- NULL loglik <- mse$loglik npar <- length(estimate) aic <- -2*loglik+2*npar bic <- -2*loglik+log(n)*npar correl <- varcovar <- NULL convergence <- mse$convergence fix.arg <- mse$fix.arg weights <- mse$weights }else { stop("match.arg() did not work correctly") } #needed for bootstrap if (!is.null(fix.arg)) fix.arg <- as.list(fix.arg) if(keepdata) { reslist <- list(estimate = estimate, method = method, sd = sd, cor = correl, vcov = varcovar, loglik = loglik, aic=aic, bic=bic, n = n, data=data, distname = distname, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, dots = my3dots, convergence = convergence, discrete = discrete, weights = weights) }else #just keep a sample set of all observations { n2keep <- min(keepdata.nb, n)-2 imin <- which.min(data) imax <- which.max(data) subdata <- data[sample((1:n)[-c(imin, imax)], size=n2keep, replace=FALSE)] subdata <- c(subdata, data[c(imin, imax)]) reslist <- list(estimate = estimate, method = method, sd = sd, cor = correl, vcov = varcovar, loglik = loglik, aic=aic, bic=bic, n = n, data=subdata, distname = distname, fix.arg = fix.arg, fix.arg.fun = fix.arg.fun, dots = my3dots, convergence = convergence, discrete = discrete, weights = weights) } return(structure(reslist, class = "fitdist")) } print.fitdist <- function(x, ...) { if (!inherits(x, "fitdist")) stop("Use only with 'fitdist' objects") if (x$method=="mme") cat("Fitting of the distribution '", x$distname, "' by matching moments \n") else if (x$method=="mle") cat("Fitting of the distribution '", x$distname, "' by maximum likelihood \n") else if (x$method=="qme") cat("Fitting of the distribution '", x$distname, "' by matching quantiles \n") else if (x$method=="mge") cat("Fitting of the distribution '", x$distname, "' by maximum goodness-of-fit \n") cat("Parameters:\n") if (x$method=="mle") print(cbind.data.frame("estimate" = x$estimate, "Std. Error" = x$sd), ...) else print(cbind.data.frame("estimate" = x$estimate), ...) if(!is.null(x$fix.arg)) { if(is.null(x$fix.arg.fun)) { cat("Fixed parameters:\n") }else { cat("Fixed parameters (computed by a user-supplied function):\n") } print(cbind.data.frame("value" = unlist(x$fix.arg)), ...) } } plot.fitdist <- function(x, breaks="default", ...) { if (!inherits(x, "fitdist")) stop("Use only with 'fitdist' objects") if(!is.null(x$weights)) stop("The plot of the fit is not yet available when using weights") if(!is.null(x$data)) plotdist(data=x$data, distr=x$distname, para=c(as.list(x$estimate), as.list(x$fix.arg)), breaks=breaks, discrete = x$discrete, ...) if(!is.null(x$weights)) stop("The plot of the fit is not yet available when using weights") } summary.fitdist <- function(object, ...) { if (!inherits(object, "fitdist")) stop("Use only with 'fitdist' objects") object$ddistname <- paste("d", object$distname, sep="") object$pdistname <- paste("p", object$distname, sep="") object$qdistname <- paste("q", object$distname, sep="") class(object) <- c("summary.fitdist", class(object)) object } print.summary.fitdist <- function(x, ...) { if (!inherits(x, "summary.fitdist")) stop("Use only with 'summary.fitdist' objects") ddistname <- x$ddistname pdistname <- x$pdistname if (x$method=="mme") cat("Fitting of the distribution '", x$distname, "' by matching moments \n") else if (x$method=="mle") cat("Fitting of the distribution '", x$distname, "' by maximum likelihood \n") else if (x$method=="qme") cat("Fitting of the distribution '", x$distname, "' by matching quantiles \n") else if (x$method=="mge") cat("Fitting of the distribution '", x$distname, "' by maximum goodness-of-fit \n") cat("Parameters : \n") if (x$method == "mle") print(cbind.data.frame("estimate" = x$estimate, "Std. Error" = x$sd), ...) else print(cbind.data.frame("estimate" = x$estimate), ...) if(!is.null(x$fix.arg)) { if(is.null(x$fix.arg.fun)) { cat("Fixed parameters:\n") }else { cat("Fixed parameters (computed by a user-supplied function):\n") } print(cbind.data.frame("value" = unlist(x$fix.arg)), ...) } cat("Loglikelihood: ", x$loglik, " ") cat("AIC: ", x$aic, " ") cat("BIC: ", x$bic, "\n") if (x$method=="mle") { if (length(x$estimate) > 1) { cat("Correlation matrix:\n") print(x$cor) cat("\n") } } invisible(x) } #see quantiles.R for quantile.fitdist #see logLik.R for loglik.fitdist #see vcov.R for vcov.fitdist #see coef.R for coef.fitdist fitdistrplus/R/util-npsurv-hcnm.R0000644000176200001440000002036513742313702016575 0ustar liggesusers# ----------------------------------------------------------------------- # # Nonparametric maximum likelihood estimation from interval-censored data # # ----------------------------------------------------------------------- # # Internal optimi functions for Hierarchical constrained Newton Method # # ----------------------------------------------------------------------- # # Original code from Yong Wang, 2020 # # ----------------------------------------------------------------------- # ## ========================================================================== ## Hierarchical CNM: a variant of the Constrained Newton Method for finding ## the NPMLE survival function of a data set containing interval censoring. ## This is a new method to build on those in the Icens and MLEcens ## packages. It uses the idea of block subsets of the S matrix to move ## probability mass among blocks of candidate support intervals. ## ## Usage (parameters and return value) is similar to the methods in package ## Icens, although note the transposed clique matrix. ## ## Arguments: ## data: Data ## w: Weights ## D: Clique matrix, n*m (note, transposed c.f. Icens::EMICM, ## MLEcens::reduc). The clique matrix may contain conditional ## probabilities rather than just membership flags, for use in HCNM ## recursively calling itself. ## p0: Vector (length m) of initial estimates for the probabilities of ## the support intervals. ## maxit: Maximum number of iterations to perform ## tol: Tolerance for the stopping condition (in log-likelihood value) ## blockpar: ## NA or NULL means choose a value based on the data (using n and r) ## ==0 means same as cnm (don't do blocks) ## <1 means nblocks is this power of sj, e.g. 0.5 for sqrt ## >1 means exactly this block size (e.g. 40) ## recurs.maxit: For internal use only: maximum number of iterations in ## recursive calls ## depth: For internal use only: depth of recursion ## verb: For internal use only: depth of recursion ## pkg: package used in NNLS_constrSum() ## Author: Stephen S. Taylor and Yong Wang ## Reference: Wang, Y. and Taylor, S. M. (2013). Efficient computation of ## nonparametric survival functions via a hierarchical mixture ## formulation. Statistics and Computing, 23, 713-725. ## ========================================================================== hcnm = function(data, w=1, D=NULL, p0=NULL, maxit=100, tol=1e-6, blockpar=NULL, recurs.maxit=2, depth=1, verb=0, pkg="stats", ...) { if(missing(D)) { x2 = icendata(data, w) #see npsurv-intercens.R if(nrow(x2$o) == 0 || all(x2$o[,2] == Inf)) { # exact or right-censored only r0 = km(x2) r = list(f=r0$f, convergence=TRUE, ll=r0$ll, maxgrad=0, numiter=1) class(r) = "npsurv" return(r) } x = rbind(cbind(x2$t, x2$t), x2$o) nx = nrow(x) w = c(x2$wt, x2$wo) dmat = Deltamatrix(x) #see npsurv-intercens.R left = dmat$left right = dmat$right intervals = cbind(left, right) D = dmat$Delta } else { if (missing(p0)) stop("Must provide 'p0' with D.") if (!missing(data)) warning("D and data both provided. LR ignored!") nx = nrow(D) w = rep(w, length=nx) intervals = NULL } n = sum(w) wr = sqrt(w) converge = FALSE m = ncol(D) m1 = 1:m nblocks = 1 maxdepth = depth i = rowSums(D) == 1 r = mean(i) # Proportion of exact observations if(is.null(p0)) { ## Derive an initial p vector. j = colSums(D[i,,drop=FALSE]) > 0 while(any(c(FALSE,(i <- rowSums(D[,j,drop=FALSE])==0)))) { j[which.max(colSums(D[i,,drop=FALSE]))] = TRUE } p = colSums(w * D) * j } else { if(length(p <- p0) != m) stop("Argument 'p0' is the wrong length.") } p = p / sum(p) P = drop(D %*% p) ll = sum(w * log(P)) evenstep = FALSE for(iter in 1:maxit) { p.old = p ll.old = ll S = D / P g = colSums(w * S) dmax = max(g) - n if(verb > 0) { cat("\n##### Iteration", iter, "#####\n") cat("Log-likelihood: ", signif(ll, 6), "\n") } if(verb > 1) cat("Maximum gradient: ", signif(dmax, 6), "\n") if(verb > 2) { cat("Probability vector of length ", length(p), " :\n") if(length(p) > 12) cat(head(as.numeric(p)), "\t ...\t", tail(as.numeric(p)), "\n") else cat(as.numeric(p), "\n") } j = p > 0 if(depth==1) { s = unique(c(1,m1[j],m)) if (length(s) > 1) for (l in 2:length(s)) { j[s[l-1] + which.max(g[s[l-1]:s[l]]) - 1] = TRUE } } sj = sum(j) ## BW: matrix of block weights: sj rows, nblocks columns if(is.null(blockpar) || is.na(blockpar)) ## Default blockpar based on log(sj), Equation (14) p6 of Wang & Taylor iter.blockpar = ifelse(sj < 30, 0, 1 - log(max(20,10*log(sj/100)))/log(sj)) else iter.blockpar = blockpar if(iter.blockpar==0 | sj < 30) { nblocks = 1 BW = matrix(1, nrow=sj, ncol=1) } else { nblocks = max(1, if(iter.blockpar>1) round(sj/iter.blockpar) else floor(min(sj/2, sj^iter.blockpar))) i = seq(0, nblocks, length=sj+1)[-1] if(evenstep) { nblocks = nblocks + 1 BW = outer(round(i)+1, 1:nblocks, "==") } else BW = outer(ceiling(i), 1:nblocks, "==") storage.mode(BW) = "numeric" } for(block in 1:nblocks) { jj = logical(m) jj[j] = BW[,block] > 0 sjj = sum(jj) if (sjj > 1 && (delta <- sum(p.old[jj])) > 0) { Sj = S[,jj] #original call #res = pnnls(wr * Sj, wr * drop(Sj %*% p.old[jj]) + wr, sum=delta) #new call resNNLS <- NNLS_constrSum(a=wr * Sj, b=wr * drop(Sj %*% p.old[jj]) + wr, pkg=pkg, sumtotal=delta, control=list(trace=verb, maxit=5000), ...) #see npsurv-NNLS.R if(resNNLS$convergence != 0) warning("Problem NNLS_constrSum(a,b)") xj <- resNNLS$prob if(verb > 3) {cat("Block:", block, "\t delta", delta, "\t Optimized vector by NNLS:\n"); print(xj)} p[jj] = p[jj] + BW[jj[j],block] * (xj * (delta / sum(xj)) - p.old[jj]) } } ## Maximise likelihood along the line between p and p.old p.gap = p - p.old # vector from old to new estimate ## extrapolated rise in ll, based on gradient at old estimate ll.rise.gap = sum(g * p.gap) alpha = 1 p.alpha = p ll.rise.alpha = ll.rise.gap repeat { P = drop(D %*% p.alpha) ll = sum(w * log(P)) if(ll >= ll.old && ll + ll.rise.alpha <= ll.old) { p = p.alpha # flat land reached converge = TRUE break } if(ll > ll.old && ll >= ll.old + ll.rise.alpha * .33) { p = p.alpha # Normal situation: new ll is higher break } if((alpha <- alpha * 0.5) < 1e-10) { p = p.old P = drop(D %*% p) ll = ll.old converge = TRUE break } p.alpha = p.old + alpha * p.gap ll.rise.alpha = alpha * ll.rise.gap } if(converge) break if (nblocks > 1) { ## Now jiggle p around among the blocks Q = sweep(BW,1,p[j],"*") # Matrix of weighted probabilities: [sj,nblocks] q = colSums(Q) # its column sums (total in each block) ## Now Q is n*nblocks Matrix of probabilities for mixture components Q = sweep(D[,j] %*% Q, 2, q, "/") if (any(q == 0)) { warning("A block has zero probability!") } else { if(verb >= 4) cat("recursion\n") ## Recursively call HCNM to allocate probability among the blocks res = hcnm(w=w, D=Q, p0=q, blockpar=iter.blockpar, maxit=recurs.maxit, recurs.maxit=recurs.maxit, depth=depth+1, pkg=pkg, ...) maxdepth = max(maxdepth, res$maxdepth) if (res$ll > ll) { p[j] = p[j] * (BW %*% (res$pf / q)) P = drop(D %*% p) ll = sum(w * log(P)) # should match res$lval } } } if(iter > 2) if( ll <= ll.old + tol ) {converge=TRUE; break} evenstep = !evenstep } list(pf=p, intervals=intervals, convergence=converge, method="hcnm", ll=ll, maxgrad=max(crossprod(w/P, D))-n, numiter=iter) } fitdistrplus/R/logLik-surface.R0000644000176200001440000003700013742313702016203 0ustar liggesusers############################################################################# # Copyright (c) 2015 Christophe Dutang and Marie Laure Delignette-Muller # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### (log)-likelihood surface/line ### ### R functions ### llplot <- function(mlefit, loglik = TRUE, expansion = 1, lseq = 50, back.col = TRUE, nlev = 10, pal.col = terrain.colors(100), fit.show = FALSE, fit.pch = 4, ...) { if (!inherits(mlefit, c("fitdist", "fitdistcens"))) stop("Use only with 'fitdist' or 'fitdistcens' objects") if(inherits(mlefit, "fitdist")) { if(mlefit$method !="mle") stop("This plot is only available for distribution fits using maximum likelihood") data <- mlefit$data } else # censored data { data <- mlefit$censdata } distr <- mlefit$distname np <- length(mlefit$estimate) if (np == 1) { estim.value <- mlefit$estimate estim.sd <- mlefit$sd plot.arg <- names(mlefit$estimate) fix.arg <- mlefit$fix.arg llcurve(data, distr, plot.arg = plot.arg, min.arg = estim.value - estim.sd * 2 *expansion, max.arg = estim.value + estim.sd * 2 *expansion, lseq = lseq, fix.arg = fix.arg, loglik = loglik, weights = mlefit$weights, ...) if (fit.show) points(estim.value, ifelse(loglik, mlefit$loglik, exp(mlefit$loglik)), pch = fit.pch) } else # so if np > 1 if (np == 2) { estim.value <- mlefit$estimate estim.sd <- mlefit$sd plot.arg <- names(mlefit$estimate) fix.arg <- mlefit$fix.arg llsurface(data, distr, plot.arg = plot.arg, min.arg = estim.value - estim.sd * 2 *expansion, max.arg = estim.value + estim.sd * 2 *expansion, lseq = lseq, fix.arg = fix.arg, loglik = loglik, back.col = back.col, nlev = nlev, pal.col = pal.col, weights = mlefit$weights, ...) if (fit.show) points(estim.value[1], estim.value[2], pch = fit.pch) } else # so if np > 2 { def.par <- par(no.readonly = TRUE) ncombi <- choose(np, 2) lay <- lower.tri(matrix(0, (np - 1), (np - 1)), TRUE) lay[which(lay, TRUE)] <- 1:ncombi layout(lay) par(mar = c(5, 4, 0.2, 0.2)) for (i in 1:(np - 1)) for (j in (i+1):np) { plot.arg <- names(mlefit$estimate)[c(i, j)] estim.value <- mlefit$estimate[c(i, j)] estim.sd <- mlefit$sd[c(i, j)] fix.arg <- c(mlefit$fix.arg, as.list(mlefit$estimate[-c(i,j)])) llsurface(data, distr, plot.arg = plot.arg, min.arg = estim.value - estim.sd * 2 *expansion, max.arg = estim.value + estim.sd * 2 *expansion, lseq = lseq, fix.arg = fix.arg, loglik = loglik, back.col = back.col, nlev = nlev, pal.col = pal.col, weights = mlefit$weights, ...) if (fit.show) points(estim.value[1], estim.value[2], pch = fit.pch) } par(def.par) } invisible() } llsurface <- function(data, distr, plot.arg, min.arg, max.arg, lseq = 50, fix.arg = NULL, loglik = TRUE, back.col = TRUE, nlev = 10, pal.col = terrain.colors(100), weights = NULL, ...) { stopifnot(is.vector(plot.arg) || length(plot.arg) == 2) stopifnot(is.list(fix.arg) || is.null(fix.arg)) if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of numerics greater than 0") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") } else { weights <- rep(1, NROW(data)) } if (is.vector(data)) { cens <- FALSE } else { cens <- TRUE # Definition of datasets lcens (left censored)=vector, rcens (right censored)= vector, # icens (interval censored) = dataframe with left and right # and ncens (not censored) = vector censdata <- data irow.lcens <- is.na(censdata$left) # rows corresponding to lcens data lcens <- censdata[irow.lcens, ]$right if (any(is.na(lcens)) ) stop("An observation cannot be both right and left censored, coded with two NA values") irow.rcens <- is.na(censdata$right) # rows corresponding to rcens data rcens <- censdata[irow.rcens, ]$left irow.ncens <- censdata$left==censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to ncens data ncens<-censdata[irow.ncens, ]$left irow.icens <- censdata$left!=censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to icens data icens<-censdata[irow.icens, ] } #get distrib name if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) if (cens) { pdistname <- paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) } #sanity check for argument names argdistname <- names(formals(ddistname)) m <- match(plot.arg, argdistname) if (any(is.na(m))) #check unexpected names stop("'plot.arg' must specify names which are arguments to 'distr'.") m <- match(names(fix.arg), argdistname) if (any(is.na(m))) #check unexpected names stop("'fix.arg' must specify names which are arguments to 'distr'.") #function to plot if (!cens) { if(loglik) { f2plot <- function(x, y) { par <- list(x,y) names(par) <- plot.arg loglikelihood(par, fix.arg = fix.arg, obs = data, ddistnam = ddistname, weights = weights) } }else { f2plot <- function(x, y) { par <- list(x,y) names(par) <- plot.arg likelihood(par, fix.arg = fix.arg, obs= data, ddistnam = ddistname, weights = weights) } } } else # for censored data { if(loglik) { f2plot <- function(x, y) { par <- list(x,y) names(par) <- plot.arg loglikelihoodcens(par, fix.arg = fix.arg, rcens = rcens, lcens = lcens, icens = icens, ncens = ncens, ddistnam = ddistname, pdistnam = pdistname, weights = weights, irow.ncens = irow.ncens, irow.lcens = irow.lcens, irow.rcens = irow.rcens, irow.icens = irow.icens) } }else { f2plot <- function(x, y) { par <- list(x,y) names(par) <- plot.arg likelihoodcens(par, fix.arg = fix.arg, rcens = rcens, lcens = lcens, icens = icens, ncens = ncens, ddistnam = ddistname, pdistnam = pdistname, weights = weights, irow.ncens = irow.ncens, irow.lcens = irow.lcens, irow.rcens = irow.rcens, irow.icens = irow.icens) } } } #create x, y and z matrix. p1 <- seq(min.arg[1], max.arg[1], length=lseq) p2 <- seq(min.arg[2], max.arg[2], length=lseq) z <- outer(p1, p2, Vectorize(f2plot, c("x","y"))) # vectorize is necessary to vectorize the function f2plot if (back.col) { image(p1, p2, z, col = pal.col, xlab = plot.arg[1], ylab = plot.arg[2], ...) if (nlev > 0) contour(p1, p2, z, nlevels = nlev, add = TRUE, ...) } else { contour(p1, p2, z, nlevels = nlev, xlab = plot.arg[1], ylab = plot.arg[2], ...) } invisible() } llcurve <- function(data, distr, plot.arg, min.arg, max.arg, lseq = 50, fix.arg = NULL, loglik = TRUE, weights = NULL, ...) { stopifnot(is.vector(plot.arg) || length(plot.arg) == 1) stopifnot(is.list(fix.arg) || is.null(fix.arg)) if(!is.null(weights)) { if(any(weights < 0)) stop("weights should be a vector of numerics greater than 0") if(length(weights) != NROW(data)) stop("weights should be a vector with a length equal to the observation number") } else { weights <- rep(1, NROW(data)) } if (is.vector(data)) { cens <- FALSE } else { cens <- TRUE # Definition of datasets lcens (left censored)=vector, rcens (right censored)= vector, # icens (interval censored) = dataframe with left and right # and ncens (not censored) = vector censdata <- data irow.lcens <- is.na(censdata$left) # rows corresponding to lcens data lcens <- censdata[irow.lcens, ]$right if (any(is.na(lcens)) ) stop("An observation cannot be both right and left censored, coded with two NA values") irow.rcens <- is.na(censdata$right) # rows corresponding to rcens data rcens <- censdata[irow.rcens, ]$left irow.ncens <- censdata$left==censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to ncens data ncens<-censdata[irow.ncens, ]$left irow.icens <- censdata$left!=censdata$right & !is.na(censdata$left) & !is.na(censdata$right) # rows corresponding to icens data icens<-censdata[irow.icens, ] } if (!is.character(distr)) stop("distr must be a character string naming a distribution") else distname <- distr ddistname <- paste("d", distname, sep="") if (!exists(ddistname, mode="function")) stop(paste("The ", ddistname, " function must be defined")) if (cens) { pdistname <- paste("p", distname, sep="") if (!exists(pdistname, mode="function")) stop(paste("The ", pdistname, " function must be defined")) } #sanity check for argument names argdistname <- names(formals(ddistname)) m <- match(plot.arg, argdistname) if (any(is.na(m))) #check unexpected names stop("'plot.arg' must specify names which are arguments to 'distr'.") m <- match(names(fix.arg), argdistname) if (any(is.na(m))) #check unexpected names stop("'fix.arg' must specify names which are arguments to 'distr'.") if (!cens) { #function to plot if(loglik) { f2plot <- function(x) { par <- list(x) names(par) <- plot.arg loglikelihood(par, fix.arg=fix.arg, obs = data, ddistnam = ddistname, weights = weights) } }else { f2plot <- function(x) { par <- list(x) names(par) <- plot.arg likelihood(par, fix.arg=fix.arg, obs = data, ddistnam = ddistname, weights = weights) } } } else # for censored data { if(loglik) { f2plot <- function(x) { par <- list(x) names(par) <- plot.arg loglikelihoodcens(par, fix.arg = fix.arg, rcens = rcens, lcens = lcens, icens = icens, ncens = ncens, ddistnam = ddistname, pdistnam = pdistname, weights = weights, irow.ncens = irow.ncens, irow.lcens = irow.lcens, irow.rcens = irow.rcens, irow.icens = irow.icens) } }else { f2plot <- function(x) { par <- list(x) names(par) <- plot.arg likelihoodcens(par, fix.arg = fix.arg, rcens = rcens, lcens = lcens, icens = icens, ncens = ncens, ddistnam = ddistname, pdistnam = pdistname, weights = weights, irow.ncens = irow.ncens, irow.lcens = irow.lcens, irow.rcens = irow.rcens, irow.icens = irow.icens) } } } #create x, y matrix. p1 <- seq(min.arg[1], max.arg[1], length = lseq) y <- sapply(p1, function(x) f2plot(x)) plot(p1, y, type="l", xlab = plot.arg, ylab = ifelse(loglik, "loglikelihood", "likelihood"), ...) invisible() } #local definition of loglikelihood loglikelihood <- function(par, fix.arg, obs, ddistnam, weights) sum(weights * log(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) ) ) ) #local definition of likelihood likelihood <- function(par, fix.arg, obs, ddistnam, weights) prod(do.call(ddistnam, c(list(obs), as.list(par), as.list(fix.arg)) )^weights ) #local definition of loglikelihood for censored data loglikelihoodcens <- function(par, fix.arg, rcens, lcens, icens, ncens, ddistnam, pdistnam, weights, irow.ncens, irow.lcens, irow.rcens, irow.icens) { p1 <- log(do.call(ddistnam, c(list(ncens), as.list(par), as.list(fix.arg)))) p2 <- log(do.call(pdistnam, c(list(lcens), as.list(par), as.list(fix.arg)))) p3 <- log(1-do.call(pdistnam, c(list(rcens), as.list(par), as.list(fix.arg)))) p4 <- log(do.call(pdistnam, c(list(icens$right), as.list(par), as.list(fix.arg))) - do.call(pdistnam, c(list(icens$left), as.list(par), as.list(fix.arg))) ) sum(weights[irow.ncens] * p1) + sum(weights[irow.lcens] * p2) + sum(weights[irow.rcens] * p3) + sum(weights[irow.icens] * p4) } #local definition of likelihood for censored data likelihoodcens <- function(par, fix.arg, rcens, lcens, icens, ncens, ddistnam, pdistnam, weights, irow.ncens, irow.lcens, irow.rcens, irow.icens) { p1 <- do.call(ddistnam, c(list(ncens), as.list(par), as.list(fix.arg))) p2 <- do.call(pdistnam, c(list(lcens), as.list(par), as.list(fix.arg))) p3 <- 1-do.call(pdistnam, c(list(rcens), as.list(par), as.list(fix.arg))) p4 <- do.call(pdistnam, c(list(icens$right), as.list(par), as.list(fix.arg))) - do.call(pdistnam, c(list(icens$left), as.list(par), as.list(fix.arg))) prod(p1^weights[irow.ncens]) * prod(p2^weights[irow.lcens]) * prod(p3^weights[irow.rcens]) * prod(p4^weights[irow.icens]) } fitdistrplus/R/qqcompcens.R0000644000176200001440000002520213742313702015506 0ustar liggesusers############################################################################# # Copyright (c) 2018 Marie Laure Delignette-Muller, Christophe Dutang, # Aurelie Siberchicot # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA # ############################################################################# ### QQ plot for various fits ### of continuous distribution(s) (fitdistcens results) ### on a same dataset ### ### R functions ### qqcompcens <- function(ft, xlim, ylim, xlogscale = FALSE, ylogscale = FALSE, main, xlab, ylab, fillrect, fitcol, fitlwd, addlegend = TRUE, legendtext, xlegend = "bottomright", ylegend = NULL, line01 = TRUE, line01col = "black", line01lty = 1, ynoise = TRUE, NPMLE.method = "Wang", plotstyle = "graphics", ...) { if(inherits(ft, "fitdistcens")) { ft <- list(ft) }else if(!is.list(ft)) { stop("argument ft must be a list of 'fitdistcens' objects") }else { if(any(sapply(ft, function(x) !inherits(x, "fitdistcens")))) stop("argument ft must be a list of 'fitdistcens' objects") } NPMLE.method <- match.arg(NPMLE.method, c("Wang", "Turnbull.intervals", "Turnbull.middlepoints")) if (NPMLE.method == "Turnbull.middlepoints") { warning("The QQcomp plot for censored data is not available with NPMLE.method at Turnbull.middlepoints. Turnbull.intervals will be used instead of Turnbull.middlepoints.") NPMLE.method <- "Turnbull.intervals" } # check the 'plotstyle' argument plotstyle <- match.arg(plotstyle[1], choices = c("graphics", "ggplot"), several.ok = FALSE) # In the future developments, it will be necessary to check that all the fits share the same weights if(!is.null(ft[[1]]$weights)) stop("qqcompcens is not yet available when using weights") censdata <- ft[[1]]$censdata # check data verif.ftidata <- function(fti) { if (any(fti$censdata$left != censdata$left, na.rm=TRUE) | any(fti$censdata$right != censdata$right, na.rm=TRUE)) stop("All compared fits must have been obtained with the same dataset") } l <- lapply( ft, verif.ftidata) rm(l) if (xlogscale != ylogscale) { xlogscale <- ylogscale <- TRUE warning("As a Q-Q plot should use the same scale on x and y axes, both axes were put in a logarithmic scale.") } logxy <- paste(ifelse(xlogscale,"x",""), ifelse(ylogscale,"y",""), sep="") # manage default parameters nft <- length(ft) if (missing(fitcol)) fitcol <- 2:(nft+1) if (missing(fitlwd)) fitlwd <- 1 fitcol <- rep(fitcol, length.out=nft) fitlwd <- rep(fitlwd, length.out=nft) if (missing(fillrect)) if ((nft == 1) | plotstyle == "ggplot") fillrect <- "lightgrey" else fillrect <- NA # check legend parameters if added if(missing(legendtext)) { legendtext <- sapply(ft, function(x) x$distname) if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, sapply(ft, function(x) toupper(x$method)), sep="-") if(length(legendtext) != length(unique(legendtext))) legendtext <- paste(legendtext, 1:nft, sep="-") } if (missing(xlab)) xlab <- "Theoretical quantiles" if (missing(ylab)) ylab <- "Empirical quantiles" if (missing(main)) main <- "Q-Q plot" # computation from censdata f <- npmle(censdata, method = NPMLE.method) bounds <- c(f$right, f$left) finitebounds <- bounds[is.finite(bounds)] if(missing(xlim) & missing(ylim)) { user.defined.lim <- FALSE upper <- max(finitebounds) lower <- min(finitebounds) width <- upper - lower if (xlogscale == TRUE) { xmin <- lower * (upper / lower)^(-0.1) xmax <- upper * (upper / lower)^0.1 xmininf <- lower * (upper / lower)^(-100) # 100 to be very large xmaxinf <- upper * (upper / lower)^100 } else { xmin <- lower - width * 0.1 xmax <- upper + width * 0.1 xmininf <- lower - width * 100 xmaxinf <- upper + width * 100 } xlim <- c(xmin, xmax) ylim <- c(xmin, xmax) } else # at least xlim or ylim are specified { user.defined.lim <- TRUE if (missing(xlim) | missing(ylim)) { warning("By default the same limits are applied to x and y axes. You should specify both if you want different x and y limits") if (missing(xlim)) xlim <- ylim else ylim <- xlim } lower <- min(c(xlim, ylim)) upper <- max(c(xlim, ylim)) width <- upper - lower if (xlogscale == TRUE) { xmininf <- lower * (upper / lower)^(-100) # 100 to be very large xmaxinf <- upper * (upper / lower)^100 } else { xmininf <- lower - width * 100 xmaxinf <- upper + width * 100 } } k <- length(f$left) Fnpsurv <- cumsum(f$p) Fbefore <- c(0, Fnpsurv[-k]) df <- data.frame(left = f$left, right = f$right) # Definition of vertices of each rectangle Qi.left <- df$left # dim k Qi.left4plot <- Qi.left # when R is configured with noLD (--disable-long-double), qnorm and other 'q' functions # produce NaN values instead of Inf values for 0 and first argument. if (is.infinite(Qi.left4plot[1]) | is.nan(Qi.left4plot[1])) Qi.left4plot[1] <- xmininf Qi.right <- df$right Qi.right4plot <- Qi.right if (is.infinite(Qi.right4plot[k]) | is.nan(Qi.right4plot[k])) Qi.right4plot[k] <- xmaxinf # keep only 16 significants digits for R configured with noLD (--disable-long-double) Pi.low <- signif(Fbefore, 16) Pi.up <- signif(Fnpsurv, 16) nPi <- length(Pi.low) lrect <- vector(mode = "list", length = nft) theo.xmin <- xlim[1] theo.xmax <- xlim[2] for(i in 1:nft) { fti <- ft[[i]] para <- c(as.list(fti$estimate), as.list(fti$fix.arg)) distname <- fti$distname qdistname <- paste("q", distname, sep="") if (is.element(distname, c("binom", "nbinom", "geom", "hyper", "pois"))) warning(" Be careful, variables are considered continuous in this function!") Qitheo.left <- do.call(qdistname, c(list(Pi.low), as.list(para))) Qitheo.right <- do.call(qdistname, c(list(Pi.up), as.list(para))) theo.xmin <- min(theo.xmin, Qitheo.right[-k]) Qitheo.left4plot <- Qitheo.left theo.xmax <- max(theo.xmax, Qitheo.left[-1]) if (is.infinite(Qitheo.left4plot[1]) | is.nan(Qitheo.left4plot[1])) Qitheo.left4plot[1] <- xmininf Qitheo.right4plot <- Qitheo.right if (is.infinite(Qitheo.right4plot[k]) | is.nan(Qitheo.right4plot[k])) Qitheo.right4plot[k] <- xmaxinf lrect[[i]] <- data.frame(Qitheo.left4plot = Qitheo.left4plot, Qi.left4plot = Qi.left4plot, Qitheo.right4plot = Qitheo.right4plot, Qi.right4plot = Qi.right4plot, ind = legendtext[i]) } # insert here a check of limits in order to enlarge xlim and ylim if needed # in order to be sure to visualize each interval, for all the fitted distributions if (!user.defined.lim) { xlim <- c(theo.xmin, theo.xmax) ylim <- c(theo.xmin, theo.xmax) } if(plotstyle == "graphics") { ######## plot if plotstyle=='graphics' ######## # main plot plot(1, 1, type = "n", main = main, xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, log = logxy) # plot of rectangles plot.fti <- function(i, ...) { Qitheo.left4plot <- lrect[[i]]$Qitheo.left4plot Qi.left4plot <- lrect[[i]]$Qi.left4plot Qitheo.right4plot <- lrect[[i]]$Qitheo.right4plot Qi.right4plot <- lrect[[i]]$Qi.right4plot if (ynoise & nft > 1) { if (xlogscale == TRUE) { noise2mult <- runif(nPi, 0.99, 1.01) rect(xleft = Qitheo.left4plot, ybottom = Qi.left4plot * noise2mult, xright = Qitheo.right4plot, ytop = Qi.right4plot * noise2mult, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } else { noise2add <- runif(nPi, -width*0.01, width*0.01) rect(xleft = Qitheo.left4plot, ybottom = Qi.left4plot + noise2add, xright = Qitheo.right4plot, ytop = Qi.right4plot + noise2add, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } } else # ! ynoise { rect(xleft = Qitheo.left4plot, ybottom = Qi.left4plot, xright = Qitheo.right4plot, ytop = Qi.right4plot, border = fitcol[i], col = fillrect[i], lwd = fitlwd[i]) } } s <- sapply(1:nft, plot.fti, ...) rm(s) if(line01) abline(0, 1, lty = line01lty, col = line01col) if (addlegend) { legend(x=xlegend, y=ylegend, bty="n", legend=legendtext, col=fitcol, lty=1, lwd=fitlwd, ...) } invisible() } else if (!requireNamespace("ggplot2", quietly = TRUE)) { stop("ggplot2 needed for this function to work with plotstyle = 'ggplot'. Please install it", call. = FALSE) } else { ######## plot if plotstyle=='ggplot' ######## drect <- do.call("rbind", lrect) ind <- as.factor(drect$ind) fitcol <- rep(fitcol, table(ind)) fitlwd <- rep(fitlwd, table(ind)) fillrect <- if(length(fillrect) > 1) {rep(fillrect, table(ind))} else {fillrect} ggqqcompcens <- ggplot2::ggplot(drect) + ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) + ggplot2::ggtitle(main) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + ggplot2::geom_rect(data=drect, mapping=ggplot2::aes_(xmin=quote(Qitheo.left4plot), xmax=quote(Qitheo.right4plot), ymin=quote(Qi.left4plot), ymax=quote(Qi.right4plot)), colour = fitcol, fill = fillrect, size = fitlwd, alpha=0.5) + ggplot2::theme_bw() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) + {if(line01) ggplot2::geom_abline(ggplot2::aes(slope = 1, intercept = 0), color = line01col, linetype = line01lty)} + {if(xlogscale) ggplot2::scale_x_continuous(trans='log10')} + {if(ylogscale) ggplot2::scale_y_continuous(trans='log10')} + ggplot2::facet_wrap(~ind) return(ggqqcompcens) } } fitdistrplus/R/util-checkparam.R0000644000176200001440000001126213742313702016407 0ustar liggesusers# checkparam function checks start.arg and fix.arg that parameters are named correctly # INPUTS # start.arg : starting values for optimization or the function to compute them from data # fix.arg : fixed values of paramaters or the function to compute them from data # argdistname : parameter names of the distribution # errtxt : error text messages # data10 : the first ten values of data # distname : name of the distribution # OUTPUTS # a named list with components: ok (TRUE or FALSE), txt (NULL or the error message), # start.arg : a named list of starting values for optimization # or a function to compute them from data checkparam <- function(start.arg, fix.arg, argdistname, errtxt=NULL, data10, distname) { if(is.null(errtxt)) errtxt <- list(t0="Fixed values must be either a named list or a function returning a named list.", t1="Starting values must be either a named list or a function returning a named list.", t2="Starting and fixed values must be either a named list or a function returning a named list.", t3="'start' must specify names which are arguments to 'distr'.", t4="'fix.arg' must specify names which are arguments to 'distr'.", t5="A distribution parameter cannot be specified both in 'start' and 'fix.arg'.") #t6 = "Unknown starting values..." #before any treatment start.arg.was.null <- is.null(start.arg) #if clause with 4 different cases: #start.arg \ fix.arg | NULL | non NULL # NULL | 1 | 2 # non NULL | 3 | 4 if(is.null(start.arg) && is.null(fix.arg)) #1 { #default case from fitdist, mledist,... start.arg <- start.arg.default(data10, distr=distname) }else if(is.null(start.arg) && !is.null(fix.arg)) #2 { #fix.arg should be a function or a named list if(!is.list(fix.arg) && !is.function(fix.arg)) return(list(ok=FALSE, txt=errtxt$t0)) #get param names if(is.function(fix.arg)) namarg <- names(fix.arg(data10)) else namarg <- names(fix.arg) start.arg <- start.arg.default(data10, distr=distname) #could return "Unknown starting values..." start.arg <- start.arg[!names(start.arg) %in% namarg] }else if(!is.null(start.arg) && is.null(fix.arg)) #3 { #start should be a function or a named list if(!is.list(start.arg) && !is.function(start.arg)) return(list(ok=FALSE, txt=errtxt$t1)) }else if(!is.null(start.arg) && !is.null(fix.arg)) #4 { #fix.arg and start should be a function or a named list if( (!is.list(fix.arg) && !is.function(fix.arg)) || (!is.list(start.arg) && !is.function(start.arg)) ) return(list(ok=FALSE, txt=errtxt$t2)) }else stop("wrong implementation") #check start #start.arg : function() | list() #start.arg cannot be null because set to a named list (by start.arg.default) when NULL if(is.function(start.arg)) #a function { start2 <- start.arg(data10) if(!is.list(start2) && is.null(names(start2))) #check a named list return(list(ok=FALSE, txt=errtxt$t3)) vstart <- unlist(start2) }else #a list vstart <- unlist(start.arg) m <- match(names(vstart), argdistname) if (any(is.na(m))) #check unexpected names return(list(ok=FALSE, txt=errtxt$t3)) #check fix.arg #fix.arg : function() | list() | NULL if(is.function(fix.arg)) #a function { fix.arg2 <- fix.arg(data10) if(!is.list(fix.arg2) && is.null(names(fix.arg2))) #check a named list return(list(ok=FALSE, txt=errtxt$t4)) vfix.arg <- unlist(fix.arg2) }else if(is.list(fix.arg)) #a list vfix.arg <- unlist(fix.arg) else vfix.arg <- NULL mfix <- match(names(vfix.arg), argdistname) if (any(is.na(mfix))) #check unexpected names return(list(ok=FALSE, txt=errtxt$t4)) # check that some parameters are not both in fix.arg and start minter <- match(names(vstart), names(vfix.arg)) if (any(!is.na(minter))) return(list(ok=FALSE, txt=errtxt$t5)) #prepare the starg.arg for outputs, i.e. when start.arg=NULL, # returns start.arg.default if not fixed param # returns a subset of start.arg.default if fixed param if(start.arg.was.null && is.null(fix.arg)) start.arg <- function(x) start.arg.default(x, distr=distname) #could return "Unknown starting values..." else if(start.arg.was.null && !is.null(fix.arg)) { if(is.function(fix.arg)) namarg <- names(fix.arg(data10)) else namarg <- names(fix.arg) start.arg <- function(x){ start.arg <- start.arg.default(x, distr=distname) #could return "Unknown starting values..." start.arg[!names(start.arg) %in% namarg] } } #otherwise start.arg is a named list or a function return(list(ok=TRUE, txt=NULL, start.arg=start.arg)) }fitdistrplus/MD50000644000176200001440000002017314124575145013331 0ustar liggesusersdaae0afd0dc3098d534c2f9e66560291 *DESCRIPTION de394941018816ccc72c06e4fc32517d *NAMESPACE 782edbd3e7dcd895d0d9afa4435ffc95 *R/CIcdfplot.R 92007c3f790b5991302bfc8949aa3c59 *R/Surv2fitdistcens.R e51b1ec6ecfd544336918fa128d4d2cc *R/bootdist-graph.R 3c26daea244f61f71595ed71909bcb20 *R/bootdist.R 9c12eac5e8b4ca4a70c5f77f8cabdcde *R/bootdistcens.R 529c6a524d5d6caeb594477b5f99a833 *R/cdfcomp.R d4e229d0dfdc7425343c6c1f64950dfc *R/cdfcompcens.R a1885db7833d7335b8583357c8ac61e7 *R/coef.R 95eb22fed13e87cfb37dd9080e5d0908 *R/denscomp.R 6abb0e4f6a9c0c0fdddaa7c7323144ce *R/descdist.R 606f819da049c3e777856acbef74f23d *R/detectbound.R d76db67eade3aa3a6e8684b57ed232d7 *R/fitbench.R e10db1ae53bceee0faa185cdd4d0a37b *R/fitdist.R 8b7fe0d5f65c319686b848497d007f28 *R/fitdistcens.R 67e22cea82c9678989153a98e55c616c *R/gofstat.R 82d3e8c7e8cbef28e7e5e34aded990b4 *R/gradlogLik.R e16afa96315460129b7be6a16ca509f3 *R/logLik-surface.R 63e5f7d6b4fd5e3146c8f54521a376b8 *R/logLik.R 7270db811a7166f9d38a73b7a61c5ebb *R/mgedist.R 2d00884418577c9bd0ca81b2f6c9e2ff *R/mledist.R 540d01970ffaf0c79d64db02aac71419 *R/mmedist.R 9e92082612440e2ac599a7bc99aeaeed *R/msedist.R bd2851f3db6111d020917249af8206f0 *R/plotdist.R 56f269286f3ad932f6e595096039be69 *R/plotdistcens.R 2d611928867a1b6fd63209c28560633c *R/ppcomp.R 78f22dab7165c64b948941045615b6c9 *R/ppcompcens.R 7179e19315286e4da78ceef4f6025060 *R/prefit.R 397855dbef0187642af6e86c1234cb17 *R/qmedist.R b84a413520a05d9c2ea6fabcc922bbf3 *R/qqcomp.R 85102230bfe77b081d7944336c075cda *R/qqcompcens.R 7de8e4fb47be9a8ae4c44985162e8d9c *R/quantiles.R c3cefdb7c45178a6480c8a6a1c5bae4f *R/util-Turnbull-intervals.R 3a2ef8f74dd2eddc677e94f43db8748c *R/util-cens2pseudo.R afe3b5bc936d28b19187894c4d6466f0 *R/util-checkparam.R 632a9fdc83759dd7094409f7de17fa01 *R/util-checkparamlist.R 0776b6e417ce2d77b759c6d97ca19bd8 *R/util-getparam.R 0cfd3cdaf4bcd0ed07e58c7ae669927f *R/util-isint.R a9e1c0221bf88a227aff1bdd9de7a2f8 *R/util-manageparam.R 6c230edd6d839101c052c39f6695bd8e *R/util-npmle.R 3703ec7cbdabb68bd71760a81a6a6346 *R/util-npsurv-NNLS.R 04e5164ab6d088884353e48c356e0cf1 *R/util-npsurv-hcnm.R f357efd17a037b9474a45b6ef43c76f1 *R/util-npsurv-intercens.R 49fb006e703dce03b8004ddf43103e10 *R/util-npsurv-km.R 77ba4257d3824370acc350c1d31eec98 *R/util-npsurv-main.R db4d7cb7667ca55c88efa5d88e629ea9 *R/util-startarg.R bf7ab2921dc86db9e7ad9bcadb57a0c6 *R/util-testdensity.R efcc748256f6f7912a7815e952e2c5c2 *R/util-transform.R 6604bda627766a6387c4ed31c28044f4 *R/util-wtdstat.R 3e809f399b41fa5574e15d86c7544ae5 *R/vcov.R 1997fa39bbb4afc9f525852128f6bd3f *README.md 950dc0bb4ece04664d8d7730b713b160 *build/vignette.rds 8aeb7eb0fb1218a9eac135e7e0200639 *data/danishmulti.rda 54ef81c0377c3e6ac8479ffd85499bba *data/danishuni.rda 1c644a363be0660d5db8f587cfe8938a *data/dataFAQlog1.rda c7efd1d1b67d6a4348f65dff31fe4d8c *data/dataFAQscale1.rda 66166ff91b40cc18fc95b03ee5f45ba6 *data/dataFAQscale2.rda b97c01a6db75501fc8c0581a28f51bb0 *data/endosulfan.rda c5561b18f5f5ade0e9ab40055094a26a *data/fluazinam.rda d171a7a2267a0ffaf960f64b657d609f *data/fremale.rda 174c5238de9d810f191b011b4ae8dc8f *data/groundbeef.rda 044cf443a7bf2d86bd8352665ed3f068 *data/salinity.rda 594ad11436b821c73706f8dc5c4d95d3 *data/smokedfish.rda e0d960a9181b15cad54f95de005532e6 *data/toxocara.rda cd7d45f2293f51f1214fc30f37d5bf0d *inst/CITATION fdc14d093901cd6cdee8f75ecfa36223 *inst/NEWS fe365e709cd41d48da184e03e6f5bdae *inst/doc/FAQ.R 1be3b5ccdc2b1ae5bceb17d6849b4580 *inst/doc/FAQ.Rmd 6d1db10b7c8caa60a30c22b2ee59b88a *inst/doc/FAQ.html 8b98adb0e94fd0ffa72c01e692df3d22 *inst/doc/Optimalgo.R 118176501da0ad32c449ebebe9743714 *inst/doc/Optimalgo.Rmd 60bc3b5427000e5b20201adda7d23b3e *inst/doc/Optimalgo.html 649af02e0b0be84bfee899d3a5a65279 *inst/doc/paper2JSS.R 066c953eb6202ac59c82e308fb9fc480 *inst/doc/paper2JSS.Rnw aef49efba904b9e641ff6a7fb96f7cbe *inst/doc/paper2JSS.pdf d6937d37574599cad75ac8c2cf972a26 *man/CIcdfplot.Rd d131a1f5849858cba1248d93c0a9e192 *man/Surv2fitdistcens.Rd e9613893126040461e0ce26364563306 *man/bootdist.Rd e450c9bb067b72f35287b33690c93d68 *man/bootdistcens.Rd 638b4ab2997f4943fc2d94a3a37e308b *man/danish.Rd 57ef4b67287c6ce677dda6cdd371f1f2 *man/dataFAQ.Rd c2754ae68b764948f34a274f594ae4d7 *man/descdist.Rd 1d2e341daf16c87213966ace5f0104b5 *man/detectbound.Rd 1a805ed619fc6c79b3c67c4fc9c686bb *man/endosulfan.Rd 97b4c7b2df0ea7f2c705e8f456592e07 *man/fitdist.Rd 2dc27afc3ce41fa4a390df7bd4591fe7 *man/fitdistcens.Rd 465d92b2587df9b785f1f9cbd17ddbb5 *man/fitdistrplus.Rd 9faa268955dfd31721d62bef465ce096 *man/fluazinam.Rd ae37a8ccde1b53b0531783ec726f85ed *man/fremale.Rd 63eeea9aa01a89d47e38a12328cc0a82 *man/gofstat.Rd b3be3448df16749b3dcd7e3fa2fd4faa *man/graphcomp.Rd 3558e56db90d451b223d10c690b4cc36 *man/graphcompcens.Rd ed1d0fae7fa5edf3164fff232db294f0 *man/groundbeef.Rd ee8b7658672b56b4f33cfbc613d227b7 *man/logLik-plot.Rd 5933a05cfe4ed6b5580b917c4bdbb1af *man/logLik-surface.Rd 9e60fe43ebd4895130e732099cea196a *man/mgedist.Rd 22516025a168b3269d802147ca7f51bb *man/mledist.Rd d9367e16b97b282f81af6192c5f28404 *man/mmedist.Rd e89cec88490f89d00b752d74d6561f6c *man/msedist.Rd bb3a2eb9448224cde71bb1e2dee71c8f *man/plotdist.Rd b223e3d2b697d1dd51cab2e943fb6573 *man/plotdistcens.Rd 783ac1a62b6a8b26b02ade7cd3b178c9 *man/prefit.Rd 3281935f61136d7fb8947b490e8be972 *man/qmedist.Rd 16e47b41f3112aebd1298e67cbbc464a *man/quantile.Rd b68d3a42f243e2848e4259d4a200bd72 *man/salinity.Rd 98c2c4e867b961158683b4de514d8d4a *man/smokedfish.Rd 0415cac1636b88677b1c29b65b021803 *man/toxocara.Rd 2fbd5d1728a1ee060424b64c840dd887 *tests/t-CIcdfplot.R 387be0138a2022ca190d7efffefa15b5 *tests/t-Surv2fitdistcens.R 8a943a8da4d2532e47eb0c1c67903030 *tests/t-bootdist.R 6de295af895d219b115b66e2a5c1fc6c *tests/t-bootdistcens.R 11ecf2496d760cfb6ace050d6147e2b1 *tests/t-cdfcomp.R 40d1b5678c3cb09fd3bbdb39c2f9526d *tests/t-cdfcompcens.R 590bd6107a2777b36551f4f5863125bb *tests/t-cvg-algo.R 59333d1bdd1052f4a32db0a07cec54ab *tests/t-denscomp.R 091922cbb3188dc916f60c0729b1d001 *tests/t-descdist.R aa631957ac1f0be4a3143974ce0fb8b4 *tests/t-detectbound.R 7eecd17b69d87ae28e306330dd76d792 *tests/t-fitbench.R 4b14d31978044e50018eb9c58d7939ac *tests/t-fitdist-customoptim.R d7b9522acf713804e6676f533263a95b *tests/t-fitdist.R dddfaf8ea8626c1e58942b1b4f71686b *tests/t-fitdistcens.R 10204028cb11cb6b8430d885b77430b5 *tests/t-gen-max-spacing-estim.R 5b7e2f4e1b970622d8ee100c76c99554 *tests/t-getparam.R 8d2caabb07d60ae9fdea976f77ba625d *tests/t-gofstat.R a513487b9264a36f1b18f285763339c3 *tests/t-init-actuar.R 3c8a93146ee8d4b39acbd54035123d31 *tests/t-llplot.R 986f32254a74010c6ebd151598744a0f *tests/t-lnL-surf.R bf445663f525ef8c9ab1baeb9b5677c5 *tests/t-logLik-vcov-coef.R 86c01974a09c93f1697d0c1036cf35cd *tests/t-manageparam.R b84179b08b018be21b2b72ff9b6b615b *tests/t-mgedist.R 6717be50d96c5f4f3a42658109d13a30 *tests/t-mledist-cens.R 067eaab04d070fd6d0e71491be913c1a *tests/t-mledist-nocens.R 1f3d2ce43f1c338a3b54d5ef694c12ba *tests/t-mledist-paramsupport.R 95bb918dac6b5a3ffe2c92cf21da5b28 *tests/t-mmedist.R b88f49725eb084a55b10cb455c85da00 *tests/t-msedist.R 82e3b99e3ec105e1bac5792f64c5c583 *tests/t-parallel.R 41859be68197676a2d1f2cdb75c49962 *tests/t-plotdist.R 61dcbc90c4785098b68c6213085d4b9a *tests/t-plotdistcens.R be4ec8bc492de8bc6f704452030deeda *tests/t-ppcomp.R 0ba0d48a32291b4d359f6477a32eda10 *tests/t-ppcompcens.R e680266064f0edee51b3ea4bc1981763 *tests/t-prefit.R 01392f301e431a4a04c19982a2c6b25e *tests/t-qme-discrete.R 9989c73af7776c125edcb2a95bd9f2e9 *tests/t-qmedist.R 62c41606c29ba212b4fa0aa9be7a3f96 *tests/t-qqcomp.R 6ee7dfba17f45f6889018e909525f7fd *tests/t-qqcompcens.R 0091d2e1b68e2b57b1b8d4ec26f46461 *tests/t-quantiledist.R 94332098f8609f629854eaf842b38451 *tests/t-startfixarg-overall.R 7d1e7a2ada0542a3cad30c88f2420b90 *tests/t-startingvalues.R 328281fc3ab364017b962bac58722fe7 *tests/t-util-npmle.R f34b74d1539817075945a72888fd0fac *tests/t-util-npsurv-mainfunction.R 4a6da9856d5656fe52ea7e9a43d2eb2e *tests/t-util-testdensity.R a6e91ae2d5083bf94697ab0468fe7423 *tests/t-weird-ppcomp-cens.R cb0be7f5e63736f49f2cc6a4aa575566 *tests/t-weird-qqcomp-cens.R 1be3b5ccdc2b1ae5bceb17d6849b4580 *vignettes/FAQ.Rmd 118176501da0ad32c449ebebe9743714 *vignettes/Optimalgo.Rmd 79c969a393c5922c5b6f9007516feb78 *vignettes/jssfitdistrplus.bib 066c953eb6202ac59c82e308fb9fc480 *vignettes/paper2JSS.Rnw fitdistrplus/inst/0000755000176200001440000000000014124570223013763 5ustar liggesusersfitdistrplus/inst/doc/0000755000176200001440000000000014124570223014530 5ustar liggesusersfitdistrplus/inst/doc/FAQ.Rmd0000644000176200001440000017007314124541154015614 0ustar liggesusers--- title: Frequently Asked Questions author: Marie Laure Delignette Muller, Christophe Dutang date: '`r Sys.Date()`' output: html_vignette: toc: yes number_sections: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Frequently Asked Questions} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r setup, echo=FALSE, message=FALSE, warning=FALSE} require(fitdistrplus) set.seed(1234) options(digits = 3) ``` # Questions regarding distributions ## How do I know the root name of a distribution? The root name of a probability distribution is the `name` which is used the `d`, `p`, `q`, `r` functions. For base R distributions, the root names are given in R-intro : https://cran.r-project.org/doc/manuals/R-intro.html#Probability-distributions. For example, you must use `"pois"` for the Poisson distribution and **not** `"poisson"`. ## How do I find "non standard" distributions? For non-standard distributions, you can either find a package implementing them or define by yourself. A comprehensive list of non-standard distributions is given in the Distributions task view https://CRAN.R-project.org/view=Distributions. Here are some two examples of user-defined distributions. A third example (shifted exponential) is given in FAQ 3.5.4. * The Gumbel distribution ```{r, eval=FALSE} dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) qgumbel <- function(p, a, b) a-b*log(-log(p)) data(groundbeef) fitgumbel <- fitdist(groundbeef$serving, "gumbel", start=list(a=10, b=10)) ``` * The zero-modified geometric distribution ```{r, eval=FALSE} dzmgeom <- function(x, p1, p2) p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) pzmgeom <- function(q, p1, p2) p1 * (q >= 0) + (1-p1)*pgeom(q-1, p2) rzmgeom <- function(n, p1, p2) { u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 u[u != 0] <- rgeom(sum(u != 0), p2)+1 u } x2 <- rzmgeom(1000, 1/2, 1/10) fitdist(x2, "zmgeom", start=list(p1=1/2, p2=1/2)) ``` ## How do I set (or find) initial values for non standard distributions? As documented, we provide initial values for the following distributions: `"norm"`, `"lnorm"`, `"exp"`, `"pois"`, `"cauchy"`, `"gamma`", `"logis"`, `"nbinom"`, `"geom"`, `"beta"`, `"weibull"` from the `stats` package; `"invgamma"`, `"llogis"`, `"invweibull"`, `"pareto1"`, `"pareto"`, `"lgamma"`, `"trgamma"`, `"invtrgamma"` from the `actuar` package. Look first at statistics and probability books such as * different volumes of N. L. Johnson, S. Kotz and N. Balakrishnan books, e.g. **Continuous Univariate Distributions, Vol. 1**, * **Thesaurus of univariate discrete probability distributions** by G. Wimmer and G. Altmann. * **Statistical Distributions** by M. Evans, N. Hastings, B. Peacock. * **Distributional Analysis with L-moment Statistics using the R Environment for Statistical Computing** by W. Asquith. If not available, find initial values by equalling theoretical and empirical quartiles. The graphical function `plotdist()` and `plotdistcens()` can also be used to assess the suitability of starting values : by an iterative manual process you can move parameter values so as to obtain a distribution that roughly fits the data and take these parameter values as starting values for the real fit. You may also consider the `prefit()` function to find initial values especially in case where parameters are constrained. ## Is it possible to fit a distribution with at least 3 parameters? Yes, an example with the Burr distribution is detailed in the JSS paper. We reproduce it very quickly here. ```{r, message=FALSE} data("endosulfan") library("actuar") fendo.B <- fitdist(endosulfan$ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) summary(fendo.B) ``` ## Why there are differences between MLE and MME for the lognormal distribution? We recall that the lognormal distribution function is given by $$ F_X(x) = \Phi\left(\frac{\log(x)-\mu}{\sigma} \right), $$ where $\Phi$ denotes the distribution function of the standard normal distribution. We know that $E(X) = \exp\left( \mu+\frac{1}{2} \sigma^2 \right)$ and $Var(X) = \exp\left( 2\mu+\sigma^2\right) (e^{\sigma^2} -1)$. The MME is obtained by inverting the previous formulas, whereas the MLE has the following explicit solution $$ \hat\mu_{MLE} = \frac{1}{n}\sum_{i=1}^n \log(x_i),~~ \hat\sigma^2_{MLE} = \frac{1}{n}\sum_{i=1}^n (\log(x_i) - \hat\mu_{MLE})^2. $$ Let us fit a sample by MLE and MME. The fit looks particularly good in both cases. ```{r, fig.height=3, fig.width=6} x3 <- rlnorm(1000) f1 <- fitdist(x3, "lnorm", method="mle") f2 <- fitdist(x3, "lnorm", method="mme") par(mfrow=1:2) cdfcomp(list(f1, f2), do.points=FALSE, xlogscale = TRUE, main = "CDF plot") denscomp(list(f1, f2), demp=TRUE, main = "Density plot") ``` Let us compare the theoretical moments (mean and variance) given the fitted values ($\hat\mu,\hat\sigma$), that is $$ E(X) = \exp\left( \hat\mu+\frac{1}{2} \hat\sigma^2 \right), Var(X) = \exp\left( 2\hat\mu+\hat\sigma^2\right) (e^{\hat\sigma^2} -1). $$ ```{r} c("E(X) by MME"=as.numeric(exp(f2$estimate["meanlog"]+f2$estimate["sdlog"]^2/2)), "E(X) by MLE"=as.numeric(exp(f1$estimate["meanlog"]+f1$estimate["sdlog"]^2/2)), "empirical"=mean(x3)) c("Var(X) by MME"=as.numeric(exp(2*f2$estimate["meanlog"]+f2$estimate["sdlog"]^2)*(exp(f2$estimate["sdlog"]^2)-1)), "Var(X) by MLE"=as.numeric(exp(2*f1$estimate["meanlog"]+f1$estimate["sdlog"]^2)*(exp(f1$estimate["sdlog"]^2)-1)), "empirical"=var(x3)) ``` From a MLE point of view, a lognormal sample $x_1,\dots,x_n$ is equivalent to handle a normal sample $\log(x_1),\dots,\log(x_n)$. However, it is well know by the Jensen inequality that $E(X) = E(\exp(\log(X))) \geq \exp(E(\log(X)))$ implying the MME estimates provides better moment estimates than with MLE. ## Can I fit a distribution with positive support when data contains negative values? The answer is no: you cannot fit a distribution with positive support (say gamma distribution) when data contains negative values. ```{r} set.seed(1234) x <- rnorm(100, mean = 1, sd = 0.5) (try(fitdist(x, "exp"))) ``` It is irrelevant to do such fit. If you really need to use that distribution, you have two options: either to remove negative values (not recommended) or to shift the data. ```{r} fitdist(x[x >= 0], "exp") fitdist(x - min(x), "exp") ``` ## Can I fit a finite-support distribution when data is outside that support? The answer is no: you cannot fit a distribution with finite-support (say beta distribution) when data is outside $[0,1]$. ```{r} set.seed(1234) x <- rnorm(100, mean = 0.5, sd = 0.25) (try(fitdist(x, "beta"))) ``` It is irrelevant to do such a fit. If you really need to use that distribution, you have two ways to tackle this issue: either to remove impossible values (not recommended) or to shift/scale the data. ```{r} fitdist(x[x > 0 & x < 1], "beta") fitdist((x - min(x)*1.01) / (max(x) * 1.01 - min(x) * 1.01), "beta") ``` ## Can I fit truncated distributions? The answer is yes: but the fitting procedure must be carried out carefully. Let $X$ be the original untruncated random variable. The truncated variable is the conditionnal random variable $Y = X ~\vert~ l< X = low) * (x <= upp) } ptexp <- function(q, rate, low, upp) { PU <- pexp(upp, rate=rate) PL <- pexp(low, rate=rate) (pexp(q, rate)-PL) / (PU-PL) * (q >= low) * (q <= upp) + 1 * (q > upp) } n <- 200 x <- rexp(n); x <- x[x > .5 & x < 3] f1 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x))) f2 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=.5, upp=3)) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, xlim=c(0, 3.5)) ``` ## Can I fit truncated inflated distributions? The answer is yes: but the fitting procedure must be carried out carefully. Let $X$ be the original untruncated random variable. The truncated variable is $Y = \max(\min(X, u), l)$ with $ly>l} + 1_{y>u}$. There is no density (w.r.t. the Lebesgues measure) since there are two probability masses $P(Y=l)= P(X\leq l)>0$ and $P(Y=u)=P(X>u)>0$. However, the density function with respect to the measure $m(x)= \delta_l(x)+\delta_u(x)+\lambda(x)$ is $$ f_Y(y) = \left\{\begin{array}{ll} F_X(l) & \text{if } y=l \\ f_X(y) & \text{if } l\min_i y_i$ or $u<\max_i y_i$ and increasing with respect to $l$ in $]-\infty, \min_i y_i]$ and decreasing with respect to $u$ in $[\max_i y_i,+\infty[$. So the maximum of $L$ is reached at $l=\min_i y_i$ and $u=\max_i y_i$. The MLE of $\theta$ is then obtained by maximizing the log-likelihood $\log(L(l, \theta, u))$ with $u=\max_i Y_i$ and $l=\min_i Y_i$. Let us illustrate truncated distribution with the truncated exponential distribution. The log-likelihood is particularly bad-shaped. ```{r, message=FALSE, fig.height=4, fig.width=8} dtiexp <- function(x, rate, low, upp) { PU <- pexp(upp, rate=rate, lower.tail = FALSE) PL <- pexp(low, rate=rate) dexp(x, rate) * (x >= low) * (x <= upp) + PL * (x == low) + PU * (x == upp) } ptiexp <- function(q, rate, low, upp) pexp(q, rate) * (q >= low) * (q <= upp) + 1 * (q > upp) n <- 100; x <- pmax(pmin(rexp(n), 3), .5) # the loglikelihood has a discontinous point at the solution par(mar=c(4,4,2,1), mfrow=1:2) llcurve(x, "tiexp", plot.arg="low", fix.arg = list(rate=2, upp=5), min.arg=0, max.arg=.5, lseq=200) llcurve(x, "tiexp", plot.arg="upp", fix.arg = list(rate=2, low=0), min.arg=3, max.arg=4, lseq=200) ``` The first method directly maximizes the log-likelihood $L(l, \theta, u)$; the second method maximizes the log-likelihood $L(\theta)$ assuming that $u=\hat u$ and $l=\hat l$ are known. Inside $[0.5,3]$, the CDF are correctly estimated in both methods but the first method does not succeed to estimate the true value of the bounds $l,u$. ```{r, fig.height=4, fig.width=6} (f1 <- fitdist(x, "tiexp", method="mle", start=list(rate=3, low=0, upp=20))) (f2 <- fitdist(x, "tiexp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x)))) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, addlegend=FALSE, xlim=c(0, 3.5)) curve(ptiexp(x, 1, .5, 3), add=TRUE, col="blue", lty=3) legend("bottomright", lty=1:3, col=c("red", "green", "blue", "black"), leg=c("full MLE", "MLE fixed arg", "true CDF", "emp. CDF")) ``` ## Can I fit a uniform distribution? The uniform distribution $\mathcal U(a,b)$ has only support parameters since the density does not have a scale or a shape parameter $f_U(u) = \frac{1}{b-a}1_{[a,b]}(u)$. For this distribution, we should not maximize the log-likelihood but only the likelihood. Let $(x_i)_i$ be i.i.d. observations from $\mathcal U(a,b)$ distribution. The likelihood is $$ L(a,b) = \prod_{i=1}^n \frac{1}{b-a} 1_{[a,b]}(x_i) = 1_{a\leq x_i \leq b, i=1,\dots,n} \frac{1}{b-a}^n = 1_{a\leq \min_i x_i} 1_{\max_i x_i \leq b} \frac{1}{b-a}^n $$ Hence $a\mapsto L(a,b)$ for any fixed $b\in]\max_i x_i, +\infty[$ is increasing on $]-\infty, \min_i x_i]$, similarly $b\mapsto L(a,b)$ is decreasing for any fixed $a$. This leads to $\min_i x_i$ and $\max_i x_i$ to be the MLE of the uniform distribution. We should notice that the likelihood function $L$ is defined on $\mathbb R^2$ yet it cancels outside $S=]-\infty, \min_i x_i]\times]\max_i x_i, +\infty[$. Hence, the log-likelihood is undefined outside $S$, which is an issue when maximizing the log-likelihood. For these reasons, `fitdist(data, dist="unif", method="mle")` uses the explicit form of the MLE for this distribution. Here is an example below ```{r, fig.height=4, fig.width=6} trueval <- c("min"=3, "max"=5) x <- runif(n=500, trueval[1], trueval[2]) f1 <- fitdist(x, "unif") delta <- .01 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(min(x)-2*delta, max(x)-delta), max.arg=c(min(x)+delta, max(x)+2*delta), main="likelihood surface for uniform", loglik=FALSE) abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) delta <- .2 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(3-2*delta, 5-delta), max.arg=c(3+delta, 5+2*delta), main="log-likelihood surface for uniform") abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) ``` Maximizing the log-likelihood is harder and can be done by defining a new density function. Appropriate starting values and parameters bound must be supplied. Using the closed-form expression (as in `fitdist()`) or maximizing the log-likelihood (with `unif2`) lead to very similar results. ```{r} dunif2 <- function(x, min, max) dunif(x, min, max) punif2 <- function(q, min, max) punif(q, min, max) f2 <- fitdist(x, "unif2", start=list(min=0, max=10), lower=c(-Inf, max(x)), upper=c(min(x), Inf)) print(c(logLik(f1), logLik(f2)), digits=7) print(cbind(coef(f1), coef(f2)), digits=7) ``` ## Can I fit a beta distribution with the same shape parameter? Yes, you can wrap the density function of the beta distribution so that there is a only one shape parameter. Here is an example of a concave density. ```{r} x <- rbeta(1000, 3, 3) dbeta2 <- function(x, shape, ...) dbeta(x, shape, shape, ...) pbeta2 <- function(q, shape, ...) pbeta(q, shape, shape, ...) fitdist(x, "beta2", start=list(shape=1/2)) ``` Another example with a U-shaped density. ```{r} x <- rbeta(1000, .3, .3) fitdist(x, "beta2", start=list(shape=1/2), optim.method="L-BFGS-B", lower=1e-2) ``` ## How to estimate support parameter? the case of the four-parameter beta Let us consider the four-parameter beta distribution, also known as the PERT distribution, defined by the following density for $x\in [a,c]$ $f_X(x) = (x-a)^{\alpha-1} (c-x)^{\beta-1}/C_N$ with $C_N$ a normalizing constant and $\alpha=1+d(b-a)/(c-a)$, $\beta=1+d(c-b)/(c-a)$. $a,c$ are support parameters, $b\in]a,c[$ is the mode and $d$ the shape parameter. As for uniform distribution, one can show that the MLE of $a$ and $c$ are respectively the sample minimum and maximum. The code below illustrates the strategy using partial closed formula with `fix.arg` and the full numerical search of MLE. NB: on small sample size, the latter has generally better goodness-of-fit statistics; a small positive number is added or subtracted when fixing the support parameters $a$ and $c$ to sample minimum and maximum. ```{r, message=FALSE, fig.height=4, fig.width=6} require(mc2d) x2 <- rpert(n=2e2, min=0, mode=1, max=2, shape=3/4) eps <- sqrt(.Machine$double.eps) f1 <- fitdist(x2, "pert", start=list(min=-1, mode=0, max=10, shape=1), lower=c(-Inf, -Inf, -Inf, 0), upper=c(Inf, Inf, Inf, Inf)) f2 <- fitdist(x2, "pert", start=list(mode=1, shape=1), fix.arg=list(min=min(x2)-eps, max=max(x2)+eps), lower=c(min(x2), 0), upper=c(max(x2), Inf)) gofstat(list(f1,f2)) cdfcomp(list(f1,f2)) print(cbind(coef(f1), c(f2$fix.arg["min"], coef(f2)["mode"], f2$fix.arg["max"], coef(f2)["shape"])), digits=7) ``` # Questions regarding goodness-of-fit tests and statistics ## Where can we find the results of goodness-of-fit tests ? Results of goodness-of-fit tests are not printed but are given in the object returned by `gofstat()` and you can have access to them as described in the example below. Nevertheless, p-values are not given for every test. For Anderson-Darling (ad), Cramer von Mises (cvm) and Kolomogorov (ks), only the decision (rejection of H0 or not) is given, when available (see FAQ 2.3 for more details). ```{r, fig.height=3, fig.width=6} set.seed(1234) x <- rgamma(n = 100, shape = 2, scale = 1) # fit of the good distribution fgamma <- fitdist(x, "gamma") # fit of a bad distribution fexp <- fitdist(x, "exp") g <- gofstat(list(fgamma, fexp), fitnames = c("gamma", "exp")) denscomp(list(fgamma, fexp), legendtext = c("gamma", "exp")) # results of the tests ## chi square test (with corresponding table with theoretical and observed counts) g$chisqpvalue g$chisqtable ## Anderson-Darling test g$adtest ## Cramer von Mises test g$cvmtest ## Kolmogorov-Smirnov test g$kstest ``` ## Is it reasonable to use goodness-of-fit tests to validate the fit of a distribution ? In the first versions of fitdistrplus, when they were available, the results of the GOF tests (AD, KS, CvM) were automatically printed. We decided to suppress this automatic printing when we realized that some users had some difficulties to interpret the results of those tests and sometimes misused them. Goodness-of-fit tests often appear as objective tools to decide wether a fitted distribution well describes a data set. **But they are not !** It would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it (see FAQ 2.2.1). And it would not be reasonable at all any more to validate a distribution because goodness-of-fit tests do not reject it (see FAQ 2.2.2). A fitted distribution should be evaluated using graphical methods (goodness-of-fit graphs automatically provided in our package by plotting the result of the fit (output of `fitdist()` or `fitdistcens()` and the complementary graphs that help to compare different fits - see `?graphcomp`). We really think it is the most appropriate way to evaluate the adequacy of a fit and we are not the only ones to recommend it. You can find the same type of recommendations in reference books : * **Probabilistic techniques in exposure assessment - a handbook dealing with variability and uncertainty in models and inputs** by A.C. Cullen and H.C. Frey. * **Application of uncertainty analysis to ecological risks of pesticides** by W.J. Warren-Hicks and A. Hart. * **Statistical inference** by G. Casella and R.L. Berger * **Loss models: from data to decision** by S.A. Klugman and H.H. Panjer and G.E. Willmot Moreover, the selection of a distribution should also be driven by knowledge of underlying processes when available. For example when a variable cannot be negative, one would be very cautious while fitting a normal distribution, that potentially gives negative values, even if the observed data of this variable seem well fitted by a normal distribution. ### Should I reject a distribution because a goodness-of-fit test rejects it ? No it would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it, especially in the case of big samples. In the real life, as soon as you have a sufficient amount of data, you will reject the fitted distribution. We know that a model cannot perfectly describe real data, and generally the true question is to find the better distribution among a pool of simple parametric distributions to describe the data, so to compare different models (see FAQ 2.4 and 2.5 for corresponding questions). To illustre this point let us comment the example presented below. We drew two samples from the same Poisson distribution with a mean parameter equal to 100. In many applications, for this value of its parameter, the Poisson distribution would be considered to be well approximated by a normal distribution. Testing the fit (here using a Kolmogorov-Smirnov test ) of the normal distribution on a sample of 100 observations would not reject the normal fit, while testing it on a sample of 10000 observations would reject it, while both samples come from the same distribution. ```{r, fig.height=3, fig.width=6} set.seed(1234) x1 <- rpois(n = 100, lambda = 100) f1 <- fitdist(x1, "norm") g1 <- gofstat(f1) g1$kstest x2 <- rpois(n = 10000, lambda = 100) f2 <- fitdist(x2, "norm") g2 <- gofstat(f2) g2$kstest par(mfrow=1:2) denscomp(f1, demp = TRUE, addlegend = FALSE, main = "small sample") denscomp(f2, demp = TRUE, addlegend = FALSE, main = "big sample") ``` ### Should I accept a distribution because goodness-of-fit tests do not reject it ? No, it would not be reasonable at all to validate a distribution because goodness-of-fit tests do not reject it. Like all the other hypothesis tests, goodness-of-fit tests lack of statistical power when the sample size is not so high. And the different goodness-of-fit tests are not equally sensitive to different types of deviation between empirical and fitted distributions. For example the Kolmogorov-Smirnov test is sensitive when distributions differ in a global fashion near the centre of the distribution. The Anderson-Darling test will be more sensitive when distributions differ in their tails, and the Cramer von Mises will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions. The sensitivity of a chi square test will depend on the definition of classes, and even if we propose a default definition of classes when the user does not provide classes, this choice is not obvious and could impact the results of the test. This test is more appropriate when data are discrete, even if they are modelled by a continuous distribution, as in the following example. Two samples of respective sizes 500 and 50 are drawn from a Poisson distribution of mean parameter equal to 1 (not a sufficiently high value to consider that the Poisson distribution could be approximated by a normal one). Using a Kolmogorov-Smirnov test, for the small sample the normal fit is rejected only for the bigger sample. It is not rejected with the smaller sample even if the fit could be rejected after a simple visual confrontation of the distributions. In that particular case, the chi square test with classes defined by default would have rejected te normal fit for both samples. ```{r, fig.height=3, fig.width=6} set.seed(1234) x3 <- rpois(n = 500, lambda = 1) f3 <- fitdist(x3, "norm") g3 <- gofstat(f3) g3$kstest x4 <- rpois(n = 50, lambda = 1) f4 <- fitdist(x4, "norm") g4 <- gofstat(f4) g4$kstest par(mfrow=1:2) denscomp(f3, addlegend = FALSE, main = "big sample") denscomp(f4, addlegend = FALSE, main = "small sample") ``` ```{r} g3$chisqtable g3$chisqpvalue g4$chisqtable g4$chisqpvalue ``` ## Why all goodness-of-fit tests are not available for every distribution ? The Chi-squared test is available for any distribution but one must be conscious that its result depends on the definition of cells in which observed data are grouped, and a correct definition is not possible with a too small sample. Concerning the Kolmogorov-Smirnov test, it is proposed for any continuous distribution, but with a critical value corresponding to the comparison of the empirical distribution to a fully specified distribution. As the distribution is not fully known for a fitted distribution, the result of this test is subject to caution, but there is no general asymptotic theory for the Kolmogorov-Smirnov statistics in case of a fitted distribution. Nevertheless, one can use Monte Carlo methods to conduct Kolmgorov-Smirnov goodness-of-fit tests in cases when the sample is used to estimate model parameters. Such a method is implemented in the R package `KScorrect` for a variety of continuous distributions. Such an asymptotic theory was proposed for quadratic statistics for some distributions (Anderson-Darling, Cramer von Mises). The reference book we used on this subject (**Tests based on edf statistics** by Stephens MA in **Goodness-of-fit techniques** by D'Agostino RB and Stephens MA) proposes critical values of those statistics for a some classical distributions (exponential, gamma, Weibull, logistic, Cauchy, normal and lognormal). But the asymptotic theory about these statistics also depends on the way the parameters are estimated. And as they were not estimated by maximum likelihood for Cauchy, normal and lognormal distributions in the results reported by Stephens, we only propose the results of the Anderson-Darling and Cramer von Mises using those results for exponential, gamma, Weibull, logistic distributions. The user can refer to the cited books and use the proposed formula to estimate the parameters of Cauchy, normal and lognormal distributions and apply the tests using critical values given in the book. R packages `goftest` and `ADGofTest` could also be explored by users who would like to apply Anderson-Darling and Cramer von Mises tests on other distributions. But at this time we are not sure that the case where parameters are unknown (estimated by maximum likelihood) is tackled in those two packages. Concerning the development of our package, rather than develoing further more goodness-of-fit tests we made the choice to develop graphical tools to help to appreciate the quality of a fit and to compare the fits of different distributions on a same data set (see FAQ 2.2 for argumentation). ## How can we use goodness-of-fit statistics to compare the fit of different distributions on a same data set ? Goodness-of-fit statistics based on the empirical distribution function (Kolmogorov-Smirnov, Anderson-Darling and Cramer von Mises) may be used to measure a distance between the fitted distribution and the empirical distribution. So if one wants to compare the fit of various distributions on the same data set, the smaller are those statistics the better. The Kolmogorov-Smirnov statistics will be sensitive when distributions differ in a global fashion near the centre of the distribution while the Anderson-Darling statistics will be more sensitive when distributions differ in their tails, and the Cramer von Mises statistics will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions. But as mentioned in the main vignette of our package, the use of the Anderson-Darling to compare the fit of different distributions is subject to caution due to the the weighting of the quadratic distance between fitted and empirical distribution functions that depends on the parametric distribution. Moreover, statistics based on the empirical distribution function do not penalize distributions with a greater number of parameters and as those are generally more flexible, this could induce over-fitting. Goodness-fo-fit statistics based on information criteria (AIC, BIC) correspond to deviance penalized by the complexity of the model (the number of parameters of the distribution), and so the smaller the better. As more generic statistics, they are not adapted to focus on a part of the fitted distribution, but they take into account the complexity of the distribution and thus could help to prevent overfitting. ## Can we use a test to compare the fit of two distributions on a same data set ? In our package we did not implement such a test but for **two nested distributions** (when one is a special case of the other one, e.g. exponential and gamma distributions) a likelihood ratio test can be easily implemented using the loglikelihood provided by `fitdist` or `fitdistcens`. Denoting $L$ the maximum likelihood obtained with the complete distribution and $L_0$ the one obtained with the simplified distribution, when the sample size increases, $- 2 ln(\frac{L_0}{L}) = 2 ln(L) - 2 ln(L_0)$ tends to a Chi squared distribution degrees of freedom equal to the difference on the numbers of parameters characterizing the **two nested distributions**. You will find below an example of such a test. ```{r} set.seed(1234) g <- rgamma(100, shape = 2, rate = 1) (f <- fitdist(g, "gamma")) (f0 <- fitdist(g, "exp")) L <- logLik(f) k <- length(f$estimate) # number of parameters of the complete distribution L0 <- logLik(f0) k0 <- length(f0$estimate) # number of parameters of the simplified distribution (stat <- 2*L - 2*L0) (critical_value <- qchisq(0.95, df = k - k0)) (rejected <- stat > critical_value) ``` Such a test can also be used for fits on censored data. ## Can we get goodness-of-fit statistics for a fit on censored data ? Function `gofstat` is not yet proposed in our package for fits on censored data but to develop one is among one of our objectives in the future. Published works on goodness-of-fit statistics based on the empirical distribution function for censored data generally focused on data containing only one type of censoring (e.g. right censored data in survival data). Build such statistics in the general case, with data containing in the same time (right, left and interval censoring), remains tricky. Nevertheless, it is possible for any type of censored data, to use information criteria (AIC and BIC given in the summary of an object of class `fitdistcens`) to compare the fits of various distributions to a same data set. # Questions regarding optimization procedures ## How to choose optimization method? If you want to perform optimization without bounds, `optim()` is used. You can try the derivative-free method Nelder-Mead and the Hessian-free method BFGS. If you want to perform optimization with bounds, only two methods are available without providing the gradient of the objective function: Nelder-Mead via `constrOptim()` and bounded BFGS via `optim()`. In both cases, see the help of `mledist()` and the vignette on optimization algorithms. ## The optimization algorithm stops with error code 100. What shall I do? First, add traces by adding `control=list(trace=1, REPORT=1)`. Second, try to set bounds for parameters. Third, find better starting values (see FAQ 1.3). ## Why distribution with a `log` argument may converge better? Say, we study the shifted lognormal distribution defined by the following density $$ f(x) = \frac{1}{x \sigma \sqrt{2 \pi}} \exp\left(- \frac{(\ln (x+\delta)- \mu)^2}{2\sigma^2}\right) $$ for $x>-\delta$ where $\mu$ is a location parameter, $\sigma$ a scale parameter and $\delta$ a boundary parameter. Let us fit this distribution on the dataset `y` by MLE. We define two functions for the densities with and without a `log` argument. ```{r} dshiftlnorm <- function(x, mean, sigma, shift, log = FALSE) dlnorm(x+shift, mean, sigma, log=log) pshiftlnorm <- function(q, mean, sigma, shift, log.p = FALSE) plnorm(q+shift, mean, sigma, log.p=log.p) qshiftlnorm <- function(p, mean, sigma, shift, log.p = FALSE) qlnorm(p, mean, sigma, log.p=log.p)-shift dshiftlnorm_no <- function(x, mean, sigma, shift) dshiftlnorm(x, mean, sigma, shift) pshiftlnorm_no <- function(q, mean, sigma, shift) pshiftlnorm(q, mean, sigma, shift) ``` We now optimize the minus log-likelihood. ```{r} data(dataFAQlog1) y <- dataFAQlog1 D <- 1-min(y) f0 <- fitdist(y+D, "lnorm") start <- list(mean=as.numeric(f0$estimate["meanlog"]), sigma=as.numeric(f0$estimate["sdlog"]), shift=D) # works with BFGS, but not Nelder-Mead f <- fitdist(y, "shiftlnorm", start=start, optim.method="BFGS") summary(f) ``` If we don't use the `log` argument, the algorithms stalls. ```{r, error=FALSE} f2 <- try(fitdist(y, "shiftlnorm_no", start=start, optim.method="BFGS")) print(attr(f2, "condition")) ``` Indeed the algorithm stops because at the following value, the log-likelihood is infinite. ```{r} sum(log(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) log(prod(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) sum(dshiftlnorm(y, 0.16383978, 0.01679231, 1.17586600, TRUE )) ``` There is something wrong in the computation. Only the R-base implementation using `log` argument seems reliable. This happens the C-base implementation of `dlnorm` takes care of the log value. In the file `../src/nmath/dlnorm.c` in the R sources, we find the C code for `dlnorm` ```{r, eval=FALSE, echo=TRUE} double dlnorm(double x, double meanlog, double sdlog, int give_log) { double y; #ifdef IEEE_754 if (ISNAN(x) || ISNAN(meanlog) || ISNAN(sdlog)) return x + meanlog + sdlog; #endif if(sdlog <= 0) { if(sdlog < 0) ML_ERR_return_NAN; // sdlog == 0 : return (log(x) == meanlog) ? ML_POSINF : R_D__0; } if(x <= 0) return R_D__0; y = (log(x) - meanlog) / sdlog; return (give_log ? -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) : M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)); /* M_1_SQRT_2PI = 1 / sqrt(2 * pi) */ } ``` In the last four lines with the logical condtion `give_log?`, we see how the `log` argument is handled: * when log=TRUE, we use $-(\log(\sqrt{2\pi}) + y^2/2+\log(x\sigma))$ ```{r, eval=FALSE, echo=TRUE} -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) ``` * when log=FALSE, we use $\sqrt{2\pi} *\exp( y^2/2)/(x\sigma))$ (and then the logarithm outside `dlnorm`) ```{r, eval=FALSE, echo=TRUE} M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)) ``` Note that the constant $\log(\sqrt{2\pi})$ is pre-computed in the C macro `M_LN_SQRT_2PI`. In order to sort out this problem, we use the `constrOptim` wrapping `optim` to take into account linear constraints. This allows also to use other optimization methods than L-BFGS-B (low-memory BFGS bounded) used in optim. ```{r} f2 <- fitdist(y, "shiftlnorm", start=start, lower=c(-Inf, 0, -min(y)), optim.method="Nelder-Mead") summary(f2) print(cbind(BFGS=f$estimate, NelderMead=f2$estimate)) ``` Another possible would be to perform all computations with higher precision arithmetics as implemented in the package `Rmpfr` using the MPFR library. ## What to do when there is a scaling issue? Let us consider a dataset which has particular small values. ```{r} data(dataFAQscale1) head(dataFAQscale1) summary(dataFAQscale1) ``` The only way to sort out is to multiply the dataset by a large value. ```{r} for(i in 6:0) cat(10^i, try(mledist(dataFAQscale1*10^i, "cauchy")$estimate), "\n") ``` Let us consider a dataset which has particular large values. ```{r} data(dataFAQscale2) head(dataFAQscale2) summary(dataFAQscale2) ``` The only way to sort out is to multiply the dataset by a small value. ```{r} for(i in 0:5) cat(10^(-2*i), try(mledist(dataFAQscale2*10^(-2*i), "cauchy")$estimate), "\n") ``` ## How do I set bounds on parameters when optimizing? ### Setting bounds for scale parameters Consider the normal distribution $\mathcal{N}(\mu, \sigma^2)$ defined by the density $$ f(x) = \frac{1}{\sqrt{2\pi\sigma^2}}\exp\left(-\frac{(x-\mu)^2}{2\sigma^2}\right), x\in\mathbb{R}, $$ where $\mu$ is a location parameter such that $\mu\in\mathbb{R}$, $\sigma^2$ is a scale parameter such that $\sigma^2>0$. Therefore when optimizing the log-likelihood or the squared differences or the GoF statistics. Setting a lower bound for the scale parameter is easy with `fitdist`: just use the `lower` argument. ```{r scalenormal, echo=TRUE, warning=FALSE} set.seed(1234) x <- rnorm(1000, 1, 2) fitdist(x, "norm", lower=c(-Inf, 0)) ``` ### Setting bounds for shape parameters Consider the Burr distribution $\mathcal B(\mu, \sigma^2)$ defined by the density $$ f(x) = \frac{a b (x/s)^b}{x [1 + (x/s)^b]^{a + 1}}, x\in\mathbb{R}, $$ where $a,b$ are shape parameters such that $a,b>0$, $s$ is a scale parameter such that $s>0$. ```{r shapeburr, echo=TRUE, warning=FALSE} x <- rburr(1000, 1, 2, 3) fitdist(x, "burr", lower=c(0, 0, 0), start=list(shape1 = 1, shape2 = 1, rate = 1)) ``` ### Setting bounds for probability parameters Consider the geometric distribution $\mathcal G(p)$ defined by the mass probability function $$ f(x) = p(1-p)^x, x\in\mathbb{N}, $$ where $p$ is a probability parameter such that $p\in[0,1]$. ```{r probgeom, echo=TRUE, warning=FALSE} x <- rgeom(1000, 1/4) fitdist(x, "geom", lower=0, upper=1) ``` ### Setting bounds for boundary parameters Consider the shifted exponential distribution $\mathcal E(\mu,\lambda)$ defined by the mass probability function $$ f(x) = \lambda \exp(-\lambda(x-\mu)), x>\mu, $$ where $\lambda$ is a scale parameter such that $\lambda>0$, $\mu$ is a boundary (or shift) parameter such that $\mu\in\mathbb{R}$. When optimizing the log-likelihood, the boundary constraint is $$ \forall i=1,\dots,n, x_i>\mu \Rightarrow \min_{i=1,\dots,n} x_i > \mu \Leftrightarrow \mu > -\min_{i=1,\dots,n} x_i. $$ Note that when optimizing the squared differences or the GoF statistics, this constraint may not be necessary. Let us do it in R. ```{r shiftexp, echo=TRUE, warning=FALSE} dsexp <- function(x, rate, shift) dexp(x-shift, rate=rate) psexp <- function(x, rate, shift) pexp(x-shift, rate=rate) rsexp <- function(n, rate, shift) rexp(n, rate=rate)+shift x <- rsexp(1000, 1/4, 1) fitdist(x, "sexp", start=list(rate=1, shift=0), lower= c(0, -min(x))) ``` ### Setting linear inequality bounds For some distributions, bounds between parameters are not independent. For instance, the normal inverse Gaussian distribution ($\mu, \delta, \alpha, \beta$ parametrization) has the following parameter constraints, which can be reformulated as a linear inequality: $$ \left\{ \begin{array}{l}\alpha > 0\\ \delta >0\\ \alpha > |\beta|\end{array} \right. \Leftrightarrow \underbrace{ \left( \begin{matrix} 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 1 & -1 \\ 0 & 0 & 1 & 1 \\ \end{matrix} \right) }_{ui} \left( \begin{matrix} \mu\\ \delta\\ \alpha \\ \beta \\ \end{matrix} \right) \geq \underbrace{ \left( \begin{matrix} 0\\ 0\\ 0 \\ 0 \\ \end{matrix} \right)}_{ci}. $$ These constraints can be carried out via `constrOptim()` and the arguments `ci` and `ui`. Here is an example ```{r, message=FALSE} library(GeneralizedHyperbolic) myoptim <- function(fn, par, ui, ci, ...) { res <- constrOptim(f=fn, theta=par, method="Nelder-Mead", ui=ui, ci=ci, ...) c(res, convergence=res$convergence, value=res$objective, par=res$minimum, hessian=res$hessian) } x <- rnig(1000, 3, 1/2, 1/2, 1/4) ui <- rbind(c(0,1,0,0), c(0,0,1,0), c(0,0,1,-1), c(0,0,1,1)) ci <- c(0,0,0,0) fitdist(x, "nig", custom.optim=myoptim, ui=ui, ci=ci, start=list(mu = 0, delta = 1, alpha = 1, beta = 0)) ``` ## How works quantile matching estimation for discrete distributions? Let us consider the geometric distribution with values in $\{0,1,2,3,\dots\}$. The probability mass function, the cumulative distribution function and the quantile function are $$ P(X=x)= p (1-p)^{\lfloor x\rfloor}, F_X(x) = 1- (1-p)^{\lfloor x\rfloor}, F_X^{-1}(q) = \left\lfloor\frac{\log(1-q)}{\log(1-p)}\right\rfloor. $$ Due to the integer part (floor function), both the distribution function and the quantile function are step functions. ```{r, fig.height=3, fig.width=6} pgeom(0:3, prob=1/2) qgeom(c(0.3, 0.6, 0.9), prob=1/2) par(mar=c(4,4,2,1), mfrow=1:2) curve(pgeom(x, prob=1/2), 0, 10, n=301, main="c.d.f.") curve(qgeom(x, prob=1/2), 0, 1, n=301, main="q.f.") ``` Now we study the QME for the geometric distribution. Since we have only one parameter, we choose one probabiliy, $p=1/2$. The theoretical median is the following integer $$ F_X^{-1}(1/2) = \left\lfloor\frac{\log(1/2)}{\log(1-p)}\right\rfloor. $$ Note that the theoretical median for a discrete distribution is an integer. Empirically, the median may not be an integer. Indeed for an even length dataset, the empirical median is $$ q_{n,1/2} = \frac{x_{n/2}^\star + x_{n/2+1}^\star}{2}, $$ where $x_{1}^\star<\dots ## Is it possible to add the names of the observations in a goodness-of-fit plot, e.g. the names of the species in the plot of the Species Sensitivity Distribution (SSD) classically used in ecotoxicology ? An argument named `name.points` can be used in functions `cdfcomp` or `CIcdfcomp` to pass a label vector for observed points so as to add the names of the points on the left of each point. This option is available only for ECDF goodness-of-fit plots and only for non censored data. This option can be used as below, for example, to name the species in the classical plot of the Species Sensitivity Distributions (SSD) in ecotoxicology. ```{r, fig.height= 6, fig.width= 6, warning = FALSE} data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa f <- fitdist(ATV, "lnorm") cdfcomp(f, xlogscale = TRUE, main = "Species Sensitivty Distribution", xlim = c(1, 100000), name.points = taxaATV, addlegend = FALSE, plotstyle = "ggplot") ``` # Questions regarding (left, right and/or interval) censored data ## How to code censored data in `fitdistrplus` ? Censored data must be rpresented in the package by a dataframe of two columns respectively named left and right, describing each observed value as an interval. The left column contains either `NA` for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either `NA` for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. This type of representation corresponds to the coding names `"interval2"` in function `Surv` of the package `survival`. There is no other way to represent censored data in `fitdistrplus` but the function Surv2fitdistcens() can be used to help you to format data for use in fitdistcens() from one of the format used in the survival package (see the help page of Surv2fitdistcens()). You have a toy example below. ```{r} dtoy <- data.frame(left = c(NA, 2, 4, 6, 9.7, 10), right = c(1, 3, 7, 8, 9.7, NA)) dtoy ``` ## How do I prepare the input of `fitdistcens()` with `Surv2fitdistcens()`? Let us consider a classical right-censored dataset for human life: twenty values randomly chosen from the `canlifins` dataset of `CASdatasets` package. We refer to the help of `Surv2fitdistcens()` for other censoring types. ```{r} exitage <- c(81.1,78.9,72.6,67.9,60.1,78.3,83.4,66.9,74.8,80.5,75.6,67.1, 75.3,82.8,70.1,85.4,74,70,71.6,76.5) death <- c(0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0) ``` When performing survival analysis, it is very common to use `Surv()` function from package `survival` to handle different types of censoring. In order to ease the use of `fitdistcens()`, a dedicated function `Surv2fitdistcens()` has been implemented with arguments similar to the ones of `Surv()`. ```{r} svdata <- Surv2fitdistcens(exitage, event=death) ``` Let us now fit two simple distributions. ```{r, fig.height= 4, fig.width= 6} flnormc <- fitdistcens(svdata, "lnorm") fweic <- fitdistcens(svdata, "weibull") cdfcompcens(list(fweic, flnormc), xlim=range(exitage), xlegend = "topleft") ``` ## How to represent an empirical distribution from censored data ? The representation of an empirical distribution from censored data is not a trivial problem. One can simply represent each observation as an interval at an y-value defined by the rank of the observation as done below using function `plotdistcens`. This representation can be interesting to visualize the raw data, but it remains difficult to correctly order the observations in any case (see the example below on the right using data `smokedfish`). ```{r, fig.height= 4, fig.width= 8} par(mfrow = c(1,2), mar = c(3, 4, 3, 0.5)) plotdistcens(dtoy, NPMLE = FALSE) data(smokedfish) dsmo <- log10(smokedfish) plotdistcens(dsmo, NPMLE = FALSE) ``` Many authors worked on the development of algorithms for **non parametric maximum likelihood estimation (NPMLE)** of the **empirical cumulative distribution function (ECDF)** from interval censored data (including left and right censored data that can be considered as interval censored data with one bound at infinity). In old versions of `fitdistrplus` we used the Turnbull algorithm using calls to functions of the package `survival`. Even if this Turnbull algorithm is still available in the package, the default plot now uses the function `npsurv` of the package `npsurv`. This package provides more performant algorithms developped by Yong Wang (see references cited in the help page of `plotdistcens`). Due to lack of maintenance of this package we were forced to rewrite their main functions in our package, using another optimization function. The same ECDF plot was also implemented in our using the Turnbull algorithm of survival (see below). ```{r, fig.height= 6, fig.width= 6} par(mfrow = c(2, 2), mar = c(3, 4, 3, 0.5)) # Turnbull algorithm with representation of middle points of equivalence classes plotdistcens(dsmo, NPMLE.method = "Turnbull.middlepoints", xlim = c(-1.8, 2.4)) # Turnbull algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Turnbull.intervals") # Wang algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Wang") ``` As you can see in the above example, the new implementation of NPMLE provides a different type of plot for the ECDF, representing by filled rectangles the zones of non-uniqueness of the NPMLE ECDF. Indeed an NPMLE algorithm generally proceeds in two steps. 1. The first step aims at identifying **equivalence classes** (also named in the litterture **Turnbull intervals** or **maximal intersection intervals** or **innermost intervals** or **maximal cliques** of the data). Equivalences classess are points/intervals under which the NPMLE ECDF may change. Equivalence classes have been shown to correspond to regions between a left bound of an interval (named L in the following plot on a the previous toy example) immediately followed by a right bound of an interval (named R in the following plot). An equivalence class may be of null length (for example at each non censored value). 2. The second step aims at assigning a **probability mass** to each equivalence class, which may be zero on some classes. The NPMLE is unique only up to these equivalence classes and this **non uniqueness** of the NPMLE ECDF is represented by **filled rectangles**. Various NPMLE algorithms are implemented in the packages **Icens**, **interval** and **npsurv**. They are more or less performant and all of them do not enable the handling of other data than survival data, especially with left censored observations. ```{r, echo = FALSE, fig.height= 4, fig.width= 8} d <- data.frame(left = c(NA, 2, 4, 6, 9.5, 10), right = c(1, 3, 7, 8, 9.5, NA)) addbounds <- function(d) { xbounds <- c(d$left, d$right) xboundsnotNA <- xbounds[!is.na(xbounds)] abline(v = xboundsnotNA, col = "grey") } addLR <- function(d) { Lbounds <- d$left[!is.na(d$left)] Rbounds <- d$right[!is.na(d$right)] range <- range(c(Lbounds,Rbounds)) eps <- (range[2] - range[1]) * 0.01 text(x = Lbounds-eps, y = 0.05, labels = "L", col = "red", cex = 0.75) text(x = Rbounds+eps, y = 0.05, labels = "R", col = "red", cex = 0.75) } addeq <- function(deq) { left <- deq$left left[is.na(left)] <- -100 right <- deq$right right[is.na(right)] <- 100 rect(left, -2, right, 2, density = 10) } par(mfrow = c(2,1), mar = c(2, 4, 3, 0.5)) # First step plotdistcens(d, NPMLE = FALSE, lwd = 2, col = "blue", main = "Step 1 : identification of equivalence classes") addbounds(d) addLR(d) deq <- data.frame(left = c(NA, 2, 6, 9.5, 10), right = c(1, 3, 7,9.5, NA)) addeq(deq) # Second step plotdistcens(d, lwd = 2, main = "Step 2 : estimation of mass probabilities") ``` ## How to assess the goodness-of-fit of a distribution fitted on censored data ? The only available method in `fitdistrplus` to fit distributions on censored data is the maximum likelihood estimation (MLE). Once a distribution is fitted using `fitdistcens`, AIC and BIC values can be found in the `summary` of the object of class `fitdistcens` returned by the function. Those values can be used to compare the fit of various distributions on a same dataset. Function `gofstat` is not yet proposed in our package for fits on censored data but we plan to develop it in the future with the calculation of other goodness-of-fit statistics for censored data. ```{r} fnorm <- fitdistcens(dsmo,"norm") flogis <- fitdistcens(dsmo,"logis") # comparison of AIC values summary(fnorm)$aic summary(flogis)$aic ``` Considering goodness-of-fit plots, the generic `plot` function of an object of class `fitdistcens`provides three plots, one in CDF using the NPMLE ECDF plot (by default using the Wang prepresentation, see previous part for details), a Q-Q plot and a P-P plot simply derived from the Wang plot of the ECDF, with filled rectangles indicating non uniqueness of the NPMLE ECDF. ```{r, fig.height= 6, fig.width= 6} par(mar = c(2, 4, 3, 0.5)) plot(fnorm) ``` Functions `cdfcompcens()`, `qqcompens()` and `ppcompcens()` can be used to individualize and personnalize CDF, Q-Q and P-P goodness-of-fit plots and/or to compare the fit of various distributions on a same dataset. ```{r, fig.height= 4, fig.width= 4} cdfcompcens(list(fnorm, flogis), fitlty = 1) qqcompcens(list(fnorm, flogis)) ppcompcens(list(fnorm, flogis)) ``` Considering Q-Q plots and P-P plots, it may be easier to compare various fits by splitting the plots as below which is done automatically using the `plotstyle` `ggplot` in `qqcompens()` and `ppcompcens()` but can also be done manually with the `plotstyle` `graphics`. ```{r, fig.height= 4, fig.width= 8} qqcompcens(list(fnorm, flogis), lwd = 2, plotstyle = "ggplot", fitcol = c("red", "green"), fillrect = c("pink", "lightgreen"), legendtext = c("normal distribution", "logistic distribution")) ``` fitdistrplus/inst/doc/FAQ.html0000644000176200001440000341640414124570201016035 0ustar liggesusers Frequently Asked Questions

Frequently Asked Questions

Marie Laure Delignette Muller, Christophe Dutang

2021-09-28

1 Questions regarding distributions

1.1 How do I know the root name of a distribution?

The root name of a probability distribution is the name which is used the d, p, q, r functions. For base R distributions, the root names are given in R-intro : https://cran.r-project.org/doc/manuals/R-intro.html#Probability-distributions. For example, you must use "pois" for the Poisson distribution and not "poisson".

1.2 How do I find “non standard” distributions?

For non-standard distributions, you can either find a package implementing them or define by yourself. A comprehensive list of non-standard distributions is given in the Distributions task view https://CRAN.R-project.org/view=Distributions. Here are some two examples of user-defined distributions. A third example (shifted exponential) is given in FAQ 3.5.4.

1.3 How do I set (or find) initial values for non standard distributions?

As documented, we provide initial values for the following distributions: "norm", "lnorm", "exp", "pois", "cauchy", "gamma", "logis", "nbinom", "geom", "beta", "weibull" from the stats package; "invgamma", "llogis", "invweibull", "pareto1", "pareto", "lgamma", "trgamma", "invtrgamma" from the actuar package.

Look first at statistics and probability books such as

If not available, find initial values by equalling theoretical and empirical quartiles. The graphical function plotdist() and plotdistcens() can also be used to assess the suitability of starting values : by an iterative manual process you can move parameter values so as to obtain a distribution that roughly fits the data and take these parameter values as starting values for the real fit. You may also consider the prefit() function to find initial values especially in case where parameters are constrained.

1.4 Is it possible to fit a distribution with at least 3 parameters?

Yes, an example with the Burr distribution is detailed in the JSS paper. We reproduce it very quickly here.

## Fitting of the distribution ' burr ' by maximum likelihood 
## Parameters : 
##        estimate Std. Error
## shape1    0.206     0.0561
## shape2    1.540     0.3188
## rate      1.497     0.4683
## Loglikelihood:  -520   AIC:  1046   BIC:  1054 
## Correlation matrix:
##        shape1 shape2   rate
## shape1  1.000 -0.900 -0.727
## shape2 -0.900  1.000  0.588
## rate   -0.727  0.588  1.000

1.5 Why there are differences between MLE and MME for the lognormal distribution?

We recall that the lognormal distribution function is given by \[ F_X(x) = \Phi\left(\frac{\log(x)-\mu}{\sigma} \right), \] where \(\Phi\) denotes the distribution function of the standard normal distribution. We know that \(E(X) = \exp\left( \mu+\frac{1}{2} \sigma^2 \right)\) and \(Var(X) = \exp\left( 2\mu+\sigma^2\right) (e^{\sigma^2} -1)\). The MME is obtained by inverting the previous formulas, whereas the MLE has the following explicit solution \[ \hat\mu_{MLE} = \frac{1}{n}\sum_{i=1}^n \log(x_i),~~ \hat\sigma^2_{MLE} = \frac{1}{n}\sum_{i=1}^n (\log(x_i) - \hat\mu_{MLE})^2. \] Let us fit a sample by MLE and MME. The fit looks particularly good in both cases.

Let us compare the theoretical moments (mean and variance) given the fitted values (\(\hat\mu,\hat\sigma\)), that is \[ E(X) = \exp\left( \hat\mu+\frac{1}{2} \hat\sigma^2 \right), Var(X) = \exp\left( 2\hat\mu+\hat\sigma^2\right) (e^{\hat\sigma^2} -1). \]

## E(X) by MME E(X) by MLE   empirical 
##        1.61        1.60        1.61
## Var(X) by MME Var(X) by MLE     empirical 
##          4.30          4.36          4.30

From a MLE point of view, a lognormal sample \(x_1,\dots,x_n\) is equivalent to handle a normal sample \(\log(x_1),\dots,\log(x_n)\). However, it is well know by the Jensen inequality that \(E(X) = E(\exp(\log(X))) \geq \exp(E(\log(X)))\) implying the MME estimates provides better moment estimates than with MLE.

1.6 Can I fit a distribution with positive support when data contains negative values?

The answer is no: you cannot fit a distribution with positive support (say gamma distribution) when data contains negative values.

## Error in computing default starting values.
## Error in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,  : 
##   Error in start.arg.default(obs, distname) : 
##   values must be positive to fit an exponential  distribution
## [1] "Error in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,  : \n  Error in start.arg.default(obs, distname) : \n  values must be positive to fit an exponential  distribution\n\n"
## attr(,"class")
## [1] "try-error"
## attr(,"condition")
## <simpleError in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,     distname = distname): Error in start.arg.default(obs, distname) : 
##   values must be positive to fit an exponential  distribution
## >

It is irrelevant to do such fit. If you really need to use that distribution, you have two options: either to remove negative values (not recommended) or to shift the data.

## Fitting of the distribution ' exp ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## rate     1.06      0.107
## Fitting of the distribution ' exp ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## rate    0.914     0.0914

1.7 Can I fit a finite-support distribution when data is outside that support?

The answer is no: you cannot fit a distribution with finite-support (say beta distribution) when data is outside \([0,1]\).

## Error in computing default starting values.
## Error in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,  : 
##   Error in start.arg.default(obs, distname) : 
##   values must be in [0-1] to fit a beta distribution
## [1] "Error in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,  : \n  Error in start.arg.default(obs, distname) : \n  values must be in [0-1] to fit a beta distribution\n\n"
## attr(,"class")
## [1] "try-error"
## attr(,"condition")
## <simpleError in manageparam(start.arg = start, fix.arg = fix.arg, obs = data,     distname = distname): Error in start.arg.default(obs, distname) : 
##   values must be in [0-1] to fit a beta distribution
## >

It is irrelevant to do such a fit. If you really need to use that distribution, you have two ways to tackle this issue: either to remove impossible values (not recommended) or to shift/scale the data.

## Fitting of the distribution ' beta ' by maximum likelihood 
## Parameters:
##        estimate Std. Error
## shape1     2.08      0.288
## shape2     2.50      0.352
## Fitting of the distribution ' beta ' by maximum likelihood 
## Parameters:
##        estimate Std. Error
## shape1     1.77      0.236
## shape2     2.17      0.296

1.8 Can I fit truncated distributions?

The answer is yes: but the fitting procedure must be carried out carefully. Let \(X\) be the original untruncated random variable. The truncated variable is the conditionnal random variable \(Y = X ~\vert~ l< X <u\) with \(l<u\) the lower and upper bounds. The cdf of \(Y\) is \(F_Y(y)=\frac{F_X(x) - F_X(l)}{F_X(u)-F_X(l)}\). There is a density (w.r.t. the Lebesgues measure) given by \[ f_Y(y) = \left\{\begin{array}{ll} \frac{f_X(x)}{F_X(u)-F_X(l)} & \text{if } l < x < u \\ 0 & \text{otherwise }\\ \end{array}\right. \]

## Goodness-of-fit statistics
##                              1-mle-texp 2-mle-texp
## Kolmogorov-Smirnov statistic     0.0952      0.084
## Cramer-von Mises statistic       0.1343      0.104
## Anderson-Darling statistic          Inf      1.045
## 
## Goodness-of-fit criteria
##                                1-mle-texp 2-mle-texp
## Akaike's Information Criterion        127        132
## Bayesian Information Criterion        130        135

1.9 Can I fit truncated inflated distributions?

The answer is yes: but the fitting procedure must be carried out carefully. Let \(X\) be the original untruncated random variable. The truncated variable is \(Y = \max(\min(X, u), l)\) with \(l<u\) the lower and upper bounds. The cdf of \(Y\) is \(F_Y(y)=F_X(y)1_{u>y>l} + 1_{y>u}\). There is no density (w.r.t. the Lebesgues measure) since there are two probability masses \(P(Y=l)= P(X\leq l)>0\) and \(P(Y=u)=P(X>u)>0\). However, the density function with respect to the measure \(m(x)= \delta_l(x)+\delta_u(x)+\lambda(x)\) is \[ f_Y(y) = \left\{\begin{array}{ll} F_X(l) & \text{if } y=l \\ f_X(y) & \text{if } l<y<u \\ 1-F_X(u) & \text{if } y=u \\ \end{array}\right. \] Let \(\theta\) be the parameter of the untruncated distribution. Since the likelihood can be factorized, the maximization can be done separately \[ L(l, \theta, u) = 1_{\forall i, l\leq y_i\leq u} \prod_{i=1, y_i=l}^n F_X(l, \theta) \times \prod_{i=1,l<y_i<u}^n f_X(y_i, \theta) \times \prod_{i=1,y_i=u}^n (1-F_X(u, \theta)), \] Furthermore, using \(\forall i, l\leq y_i\leq u\Leftrightarrow l\leq \min_i y_i\leq \max_i y_i\leq u\), the likelihood is zero for \(l>\min_i y_i\) or \(u<\max_i y_i\) and increasing with respect to \(l\) in \(]-\infty, \min_i y_i]\) and decreasing with respect to \(u\) in \([\max_i y_i,+\infty[\). So the maximum of \(L\) is reached at \(l=\min_i y_i\) and \(u=\max_i y_i\). The MLE of \(\theta\) is then obtained by maximizing the log-likelihood \(\log(L(l, \theta, u))\) with \(u=\max_i Y_i\) and \(l=\min_i Y_i\).

Let us illustrate truncated distribution with the truncated exponential distribution. The log-likelihood is particularly bad-shaped.

The first method directly maximizes the log-likelihood \(L(l, \theta, u)\); the second method maximizes the log-likelihood \(L(\theta)\) assuming that \(u=\hat u\) and \(l=\hat l\) are known. Inside \([0.5,3]\), the CDF are correctly estimated in both methods but the first method does not succeed to estimate the true value of the bounds \(l,u\).

## Fitting of the distribution ' tiexp ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## rate    0.949         NA
## low    -0.502         NA
## upp    23.072         NA
## Fitting of the distribution ' tiexp ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## rate    0.947     0.0982
## Fixed parameters:
##     value
## low   0.5
## upp   3.0
## Goodness-of-fit statistics
##                              1-mle-tiexp 2-mle-tiexp
## Kolmogorov-Smirnov statistic       0.378       0.377
## Cramer-von Mises statistic         1.890       1.882
## Anderson-Darling statistic        10.222      10.193
## 
## Goodness-of-fit criteria
##                                1-mle-tiexp 2-mle-tiexp
## Akaike's Information Criterion         216         162
## Bayesian Information Criterion         224         165

1.10 Can I fit a uniform distribution?

The uniform distribution \(\mathcal U(a,b)\) has only support parameters since the density does not have a scale or a shape parameter \(f_U(u) = \frac{1}{b-a}1_{[a,b]}(u)\). For this distribution, we should not maximize the log-likelihood but only the likelihood. Let \((x_i)_i\) be i.i.d. observations from \(\mathcal U(a,b)\) distribution. The likelihood is \[ L(a,b) = \prod_{i=1}^n \frac{1}{b-a} 1_{[a,b]}(x_i) = 1_{a\leq x_i \leq b, i=1,\dots,n} \frac{1}{b-a}^n = 1_{a\leq \min_i x_i} 1_{\max_i x_i \leq b} \frac{1}{b-a}^n \] Hence \(a\mapsto L(a,b)\) for any fixed \(b\in]\max_i x_i, +\infty[\) is increasing on \(]-\infty, \min_i x_i]\), similarly \(b\mapsto L(a,b)\) is decreasing for any fixed \(a\). This leads to \(\min_i x_i\) and \(\max_i x_i\) to be the MLE of the uniform distribution.

We should notice that the likelihood function \(L\) is defined on \(\mathbb R^2\) yet it cancels outside \(S=]-\infty, \min_i x_i]\times]\max_i x_i, +\infty[\). Hence, the log-likelihood is undefined outside \(S\), which is an issue when maximizing the log-likelihood.

For these reasons, fitdist(data, dist="unif", method="mle") uses the explicit form of the MLE for this distribution. Here is an example below

Maximizing the log-likelihood is harder and can be done by defining a new density function. Appropriate starting values and parameters bound must be supplied. Using the closed-form expression (as in fitdist()) or maximizing the log-likelihood (with unif2) lead to very similar results.

## [1] -346.0539 -346.0540
##         [,1]     [,2]
## min 3.000684 3.000683
## max 4.998606 4.998606

1.11 Can I fit a beta distribution with the same shape parameter?

Yes, you can wrap the density function of the beta distribution so that there is a only one shape parameter. Here is an example of a concave density.

## Fitting of the distribution ' beta2 ' by maximum likelihood 
## Parameters:
##       estimate Std. Error
## shape     3.24      0.135

Another example with a U-shaped density.

## Fitting of the distribution ' beta2 ' by maximum likelihood 
## Parameters:
##       estimate Std. Error
## shape    0.295    0.00986

1.12 How to estimate support parameter? the case of the four-parameter beta

Let us consider the four-parameter beta distribution, also known as the PERT distribution, defined by the following density for \(x\in [a,c]\) \(f_X(x) = (x-a)^{\alpha-1} (c-x)^{\beta-1}/C_N\) with \(C_N\) a normalizing constant and \(\alpha=1+d(b-a)/(c-a)\), \(\beta=1+d(c-b)/(c-a)\). \(a,c\) are support parameters, \(b\in]a,c[\) is the mode and \(d\) the shape parameter.

As for uniform distribution, one can show that the MLE of \(a\) and \(c\) are respectively the sample minimum and maximum. The code below illustrates the strategy using partial closed formula with fix.arg and the full numerical search of MLE. NB: on small sample size, the latter has generally better goodness-of-fit statistics; a small positive number is added or subtracted when fixing the support parameters \(a\) and \(c\) to sample minimum and maximum.

## Warning in checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, : Some
## parameter names have no starting/fixed value but have a default value: mean.
## Warning in checkparamlist(arg_startfix$start.arg, arg_startfix$fix.arg, : Some
## parameter names have no starting/fixed value but have a default value: mean.
## Goodness-of-fit statistics
##                              1-mle-pert 2-mle-pert
## Kolmogorov-Smirnov statistic     0.0452     0.0584
## Cramer-von Mises statistic       0.0823     0.1834
## Anderson-Darling statistic       0.5325     1.2776
## 
## Goodness-of-fit criteria
##                                1-mle-pert 2-mle-pert
## Akaike's Information Criterion        268        265
## Bayesian Information Criterion        281        272

##       [,1]       [,2]       
## min   0.03106317 0.03395487 
## mode  1.120283   1.956149   
## max   1.9595     1.956234   
## shape 0.3056077  0.008646087

2 Questions regarding goodness-of-fit tests and statistics

2.1 Where can we find the results of goodness-of-fit tests ?

Results of goodness-of-fit tests are not printed but are given in the object returned by gofstat() and you can have access to them as described in the example below. Nevertheless, p-values are not given for every test. For Anderson-Darling (ad), Cramer von Mises (cvm) and Kolomogorov (ks), only the decision (rejection of H0 or not) is given, when available (see FAQ 2.3 for more details).

##    gamma      exp 
## 1.89e-01 7.73e-05
##           obscounts theo gamma theo exp
## <= 0.5483         9      10.06    23.66
## <= 0.8122         9       8.82     9.30
## <= 0.9592         9       5.27     4.68
## <= 1.368          9      14.63    11.37
## <= 1.523          9       5.24     3.74
## <= 1.701          9       5.73     3.97
## <= 1.94           9       7.09     4.82
## <= 2.381          9      11.08     7.50
## <= 2.842          9       9.00     6.29
## <= 3.801          9      11.93     9.28
## > 3.801          10      11.16    15.40
##          gamma            exp 
## "not rejected"     "rejected"
##          gamma            exp 
## "not rejected"     "rejected"
##          gamma            exp 
## "not rejected"     "rejected"

2.2 Is it reasonable to use goodness-of-fit tests to validate the fit of a distribution ?

In the first versions of fitdistrplus, when they were available, the results of the GOF tests (AD, KS, CvM) were automatically printed. We decided to suppress this automatic printing when we realized that some users had some difficulties to interpret the results of those tests and sometimes misused them.

Goodness-of-fit tests often appear as objective tools to decide wether a fitted distribution well describes a data set. But they are not ! It would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it (see FAQ 2.2.1). And it would not be reasonable at all any more to validate a distribution because goodness-of-fit tests do not reject it (see FAQ 2.2.2).

A fitted distribution should be evaluated using graphical methods (goodness-of-fit graphs automatically provided in our package by plotting the result of the fit (output of fitdist() or fitdistcens() and the complementary graphs that help to compare different fits - see ?graphcomp). We really think it is the most appropriate way to evaluate the adequacy of a fit and we are not the only ones to recommend it. You can find the same type of recommendations in reference books :

Moreover, the selection of a distribution should also be driven by knowledge of underlying processes when available. For example when a variable cannot be negative, one would be very cautious while fitting a normal distribution, that potentially gives negative values, even if the observed data of this variable seem well fitted by a normal distribution.

2.2.1 Should I reject a distribution because a goodness-of-fit test rejects it ?

No it would not be reasonable at all to reject a distribution just because a goodness-of-fit test rejects it, especially in the case of big samples. In the real life, as soon as you have a sufficient amount of data, you will reject the fitted distribution. We know that a model cannot perfectly describe real data, and generally the true question is to find the better distribution among a pool of simple parametric distributions to describe the data, so to compare different models (see FAQ 2.4 and 2.5 for corresponding questions).

To illustre this point let us comment the example presented below. We drew two samples from the same Poisson distribution with a mean parameter equal to 100. In many applications, for this value of its parameter, the Poisson distribution would be considered to be well approximated by a normal distribution. Testing the fit (here using a Kolmogorov-Smirnov test ) of the normal distribution on a sample of 100 observations would not reject the normal fit, while testing it on a sample of 10000 observations would reject it, while both samples come from the same distribution.

##     1-mle-norm 
## "not rejected"
## 1-mle-norm 
## "rejected"

2.2.2 Should I accept a distribution because goodness-of-fit tests do not reject it ?

No, it would not be reasonable at all to validate a distribution because goodness-of-fit tests do not reject it. Like all the other hypothesis tests, goodness-of-fit tests lack of statistical power when the sample size is not so high. And the different goodness-of-fit tests are not equally sensitive to different types of deviation between empirical and fitted distributions. For example the Kolmogorov-Smirnov test is sensitive when distributions differ in a global fashion near the centre of the distribution. The Anderson-Darling test will be more sensitive when distributions differ in their tails, and the Cramer von Mises will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions.

The sensitivity of a chi square test will depend on the definition of classes, and even if we propose a default definition of classes when the user does not provide classes, this choice is not obvious and could impact the results of the test. This test is more appropriate when data are discrete, even if they are modelled by a continuous distribution, as in the following example. Two samples of respective sizes 500 and 50 are drawn from a Poisson distribution of mean parameter equal to 1 (not a sufficiently high value to consider that the Poisson distribution could be approximated by a normal one). Using a Kolmogorov-Smirnov test, for the small sample the normal fit is rejected only for the bigger sample. It is not rejected with the smaller sample even if the fit could be rejected after a simple visual confrontation of the distributions. In that particular case, the chi square test with classes defined by default would have rejected te normal fit for both samples.

## 1-mle-norm 
## "rejected"
##     1-mle-norm 
## "not rejected"

##      obscounts theocounts
## <= 0     180.0       80.3
## <= 1     187.0      163.5
## <= 2      87.0      168.1
## <= 3      32.0       73.4
## > 3       14.0       14.7
## [1] 7.11e-42
##      obscounts theocounts
## <= 0     14.00       5.46
## <= 1     15.00      14.23
## <= 2     15.00      18.09
## > 2       6.00      12.22
## [1] 3.57e-05

2.3 Why all goodness-of-fit tests are not available for every distribution ?

The Chi-squared test is available for any distribution but one must be conscious that its result depends on the definition of cells in which observed data are grouped, and a correct definition is not possible with a too small sample.

Concerning the Kolmogorov-Smirnov test, it is proposed for any continuous distribution, but with a critical value corresponding to the comparison of the empirical distribution to a fully specified distribution. As the distribution is not fully known for a fitted distribution, the result of this test is subject to caution, but there is no general asymptotic theory for the Kolmogorov-Smirnov statistics in case of a fitted distribution. Nevertheless, one can use Monte Carlo methods to conduct Kolmgorov-Smirnov goodness-of-fit tests in cases when the sample is used to estimate model parameters. Such a method is implemented in the R package KScorrect for a variety of continuous distributions.

Such an asymptotic theory was proposed for quadratic statistics for some distributions (Anderson-Darling, Cramer von Mises). The reference book we used on this subject (Tests based on edf statistics by Stephens MA in Goodness-of-fit techniques by D’Agostino RB and Stephens MA) proposes critical values of those statistics for a some classical distributions (exponential, gamma, Weibull, logistic, Cauchy, normal and lognormal). But the asymptotic theory about these statistics also depends on the way the parameters are estimated. And as they were not estimated by maximum likelihood for Cauchy, normal and lognormal distributions in the results reported by Stephens, we only propose the results of the Anderson-Darling and Cramer von Mises using those results for exponential, gamma, Weibull, logistic distributions.

The user can refer to the cited books and use the proposed formula to estimate the parameters of Cauchy, normal and lognormal distributions and apply the tests using critical values given in the book. R packages goftest and ADGofTest could also be explored by users who would like to apply Anderson-Darling and Cramer von Mises tests on other distributions. But at this time we are not sure that the case where parameters are unknown (estimated by maximum likelihood) is tackled in those two packages.

Concerning the development of our package, rather than develoing further more goodness-of-fit tests we made the choice to develop graphical tools to help to appreciate the quality of a fit and to compare the fits of different distributions on a same data set (see FAQ 2.2 for argumentation).

2.4 How can we use goodness-of-fit statistics to compare the fit of different distributions on a same data set ?

Goodness-of-fit statistics based on the empirical distribution function (Kolmogorov-Smirnov, Anderson-Darling and Cramer von Mises) may be used to measure a distance between the fitted distribution and the empirical distribution. So if one wants to compare the fit of various distributions on the same data set, the smaller are those statistics the better. The Kolmogorov-Smirnov statistics will be sensitive when distributions differ in a global fashion near the centre of the distribution while the Anderson-Darling statistics will be more sensitive when distributions differ in their tails, and the Cramer von Mises statistics will be more sensitive when there are small but repetitive differences between empirical and theoretical distribution functions.

But as mentioned in the main vignette of our package, the use of the Anderson-Darling to compare the fit of different distributions is subject to caution due to the the weighting of the quadratic distance between fitted and empirical distribution functions that depends on the parametric distribution. Moreover, statistics based on the empirical distribution function do not penalize distributions with a greater number of parameters and as those are generally more flexible, this could induce over-fitting.

Goodness-fo-fit statistics based on information criteria (AIC, BIC) correspond to deviance penalized by the complexity of the model (the number of parameters of the distribution), and so the smaller the better. As more generic statistics, they are not adapted to focus on a part of the fitted distribution, but they take into account the complexity of the distribution and thus could help to prevent overfitting.

2.5 Can we use a test to compare the fit of two distributions on a same data set ?

In our package we did not implement such a test but for two nested distributions (when one is a special case of the other one, e.g. exponential and gamma distributions) a likelihood ratio test can be easily implemented using the loglikelihood provided by fitdist or fitdistcens. Denoting \(L\) the maximum likelihood obtained with the complete distribution and \(L_0\) the one obtained with the simplified distribution, when the sample size increases, \(- 2 ln(\frac{L_0}{L}) = 2 ln(L) - 2 ln(L_0)\) tends to a Chi squared distribution degrees of freedom equal to the difference on the numbers of parameters characterizing the two nested distributions. You will find below an example of such a test.

## Fitting of the distribution ' gamma ' by maximum likelihood 
## Parameters:
##       estimate Std. Error
## shape    2.025      0.266
## rate     0.997      0.149
## Fitting of the distribution ' exp ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## rate    0.492     0.0492
## [1] 23.9
## [1] 3.84
## [1] TRUE

Such a test can also be used for fits on censored data.

2.6 Can we get goodness-of-fit statistics for a fit on censored data ?

Function gofstat is not yet proposed in our package for fits on censored data but to develop one is among one of our objectives in the future. Published works on goodness-of-fit statistics based on the empirical distribution function for censored data generally focused on data containing only one type of censoring (e.g. right censored data in survival data). Build such statistics in the general case, with data containing in the same time (right, left and interval censoring), remains tricky.

Nevertheless, it is possible for any type of censored data, to use information criteria (AIC and BIC given in the summary of an object of class fitdistcens) to compare the fits of various distributions to a same data set.

3 Questions regarding optimization procedures

3.1 How to choose optimization method?

If you want to perform optimization without bounds, optim() is used. You can try the derivative-free method Nelder-Mead and the Hessian-free method BFGS. If you want to perform optimization with bounds, only two methods are available without providing the gradient of the objective function: Nelder-Mead via constrOptim() and bounded BFGS via optim(). In both cases, see the help of mledist() and the vignette on optimization algorithms.

3.2 The optimization algorithm stops with error code 100. What shall I do?

First, add traces by adding control=list(trace=1, REPORT=1). Second, try to set bounds for parameters. Third, find better starting values (see FAQ 1.3).

3.3 Why distribution with a log argument may converge better?

Say, we study the shifted lognormal distribution defined by the following density \[ f(x) = \frac{1}{x \sigma \sqrt{2 \pi}} \exp\left(- \frac{(\ln (x+\delta)- \mu)^2}{2\sigma^2}\right) \] for \(x>-\delta\) where \(\mu\) is a location parameter, \(\sigma\) a scale parameter and \(\delta\) a boundary parameter. Let us fit this distribution on the dataset y by MLE. We define two functions for the densities with and without a log argument.

We now optimize the minus log-likelihood.

## Fitting of the distribution ' shiftlnorm ' by maximum likelihood 
## Parameters : 
##       estimate Std. Error
## mean    -1.386    0.02401
## sigma    0.071    0.00192
## shift    0.248    0.00598
## Loglikelihood:  8299   AIC:  -16591   BIC:  -16573 
## Correlation matrix:
##         mean  sigma  shift
## mean   1.000 -0.885  0.999
## sigma -0.885  1.000 -0.886
## shift  0.999 -0.886  1.000

If we don’t use the log argument, the algorithms stalls.

## <simpleError in optim(par = vstart, fn = fnobj, fix.arg = fix.arg, obs = data,     gr = gradient, ddistnam = ddistname, hessian = TRUE, method = meth,     lower = lower, upper = upper, ...): différences finies ayant des valeurs infinies [2]>
## Error in fitdist(y, "shiftlnorm_no", start = start, optim.method = "BFGS") : 
##   the function mle failed to estimate the parameters, 
##                 with the error code 100
## <simpleError in fitdist(y, "shiftlnorm_no", start = start, optim.method = "BFGS"): the function mle failed to estimate the parameters, 
##                 with the error code 100
## >

Indeed the algorithm stops because at the following value, the log-likelihood is infinite.

## [1] -Inf
## [1] -Inf
## [1] 7761

There is something wrong in the computation.

Only the R-base implementation using log argument seems reliable. This happens the C-base implementation of dlnorm takes care of the log value. In the file ../src/nmath/dlnorm.c in the R sources, we find the C code for dlnorm

In the last four lines with the logical condtion give_log?, we see how the log argument is handled:

Note that the constant \(\log(\sqrt{2\pi})\) is pre-computed in the C macro M_LN_SQRT_2PI.

In order to sort out this problem, we use the constrOptim wrapping optim to take into account linear constraints. This allows also to use other optimization methods than L-BFGS-B (low-memory BFGS bounded) used in optim.

## Fitting of the distribution ' shiftlnorm ' by maximum likelihood 
## Parameters : 
##       estimate Std. Error
## mean   -1.3873         NA
## sigma   0.0711         NA
## shift   0.2481         NA
## Loglikelihood:  8299   AIC:  -16591   BIC:  -16573 
## Correlation matrix:
## [1] NA
##         BFGS NelderMead
## mean  -1.386    -1.3873
## sigma  0.071     0.0711
## shift  0.248     0.2481

Another possible would be to perform all computations with higher precision arithmetics as implemented in the package Rmpfr using the MPFR library.

3.4 What to do when there is a scaling issue?

Let us consider a dataset which has particular small values.

## [1] -0.007077 -0.000947 -0.001898 -0.000475 -0.001902 -0.000476
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -0.00708 -0.00143 -0.00047 -0.00031  0.00096  0.00428

The only way to sort out is to multiply the dataset by a large value.

## 1e+06 -290 1194 
## 1e+05 -29 119 
## 10000 -2.9 11.9 
## 1000 -0.29 1.19 
## 100 -0.029 0.119 
## 10 -0.0029 0.0119 
## <simpleError in optim(par = vstart, fn = fnobj, fix.arg = fix.arg, obs = data,     gr = gradient, ddistnam = ddistname, hessian = TRUE, method = meth,     lower = lower, upper = upper, ...): différences finies ayant des valeurs infinies [2]>
## 1 NA NA

Let us consider a dataset which has particular large values.

## [1] 1.40e+09 1.41e+09 1.43e+09 1.44e+09 1.49e+09 1.57e+09
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 1.40e+09 1.58e+09 2.24e+09 2.55e+09 3.39e+09 4.49e+09

The only way to sort out is to multiply the dataset by a small value.

## 1 2.03e+09 6.59e+08 
## 0.01 20283641 6594932 
## 1e-04 202836 65949 
## 1e-06 2028 659 
## 1e-08 20.3 6.59 
## 1e-10 0.203 0.0659

3.5 How do I set bounds on parameters when optimizing?

3.5.1 Setting bounds for scale parameters

Consider the normal distribution \(\mathcal{N}(\mu, \sigma^2)\) defined by the density \[ f(x) = \frac{1}{\sqrt{2\pi\sigma^2}}\exp\left(-\frac{(x-\mu)^2}{2\sigma^2}\right), x\in\mathbb{R}, \] where \(\mu\) is a location parameter such that \(\mu\in\mathbb{R}\), \(\sigma^2\) is a scale parameter such that \(\sigma^2>0\). Therefore when optimizing the log-likelihood or the squared differences or the GoF statistics. Setting a lower bound for the scale parameter is easy with fitdist: just use the lower argument.

## Fitting of the distribution ' norm ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## mean    0.947         NA
## sd      1.994         NA

3.5.2 Setting bounds for shape parameters

Consider the Burr distribution \(\mathcal B(\mu, \sigma^2)\) defined by the density \[ f(x) = \frac{a b (x/s)^b}{x [1 + (x/s)^b]^{a + 1}}, x\in\mathbb{R}, \] where \(a,b\) are shape parameters such that \(a,b>0\), \(s\) is a scale parameter such that \(s>0\).

## Fitting of the distribution ' burr ' by maximum likelihood 
## Parameters:
##        estimate Std. Error
## shape1    0.969         NA
## shape2    2.051         NA
## rate      3.180         NA

3.5.3 Setting bounds for probability parameters

Consider the geometric distribution \(\mathcal G(p)\) defined by the mass probability function \[ f(x) = p(1-p)^x, x\in\mathbb{N}, \] where \(p\) is a probability parameter such that \(p\in[0,1]\).

## Fitting of the distribution ' geom ' by maximum likelihood 
## Parameters:
##      estimate Std. Error
## prob    0.242    0.00666

3.5.4 Setting bounds for boundary parameters

Consider the shifted exponential distribution \(\mathcal E(\mu,\lambda)\) defined by the mass probability function \[ f(x) = \lambda \exp(-\lambda(x-\mu)), x>\mu, \] where \(\lambda\) is a scale parameter such that \(\lambda>0\), \(\mu\) is a boundary (or shift) parameter such that \(\mu\in\mathbb{R}\). When optimizing the log-likelihood, the boundary constraint is \[ \forall i=1,\dots,n, x_i>\mu \Rightarrow \min_{i=1,\dots,n} x_i > \mu \Leftrightarrow \mu > -\min_{i=1,\dots,n} x_i. \] Note that when optimizing the squared differences or the GoF statistics, this constraint may not be necessary. Let us do it in R.

## Fitting of the distribution ' sexp ' by maximum likelihood 
## Parameters:
##       estimate Std. Error
## rate     0.248         NA
## shift    1.005         NA

3.5.5 Setting linear inequality bounds

For some distributions, bounds between parameters are not independent. For instance, the normal inverse Gaussian distribution (\(\mu, \delta, \alpha, \beta\) parametrization) has the following parameter constraints, which can be reformulated as a linear inequality: \[ \left\{ \begin{array}{l}\alpha > 0\\ \delta >0\\ \alpha > |\beta|\end{array} \right. \Leftrightarrow \underbrace{ \left( \begin{matrix} 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 1 & -1 \\ 0 & 0 & 1 & 1 \\ \end{matrix} \right) }_{ui} \left( \begin{matrix} \mu\\ \delta\\ \alpha \\ \beta \\ \end{matrix} \right) \geq \underbrace{ \left( \begin{matrix} 0\\ 0\\ 0 \\ 0 \\ \end{matrix} \right)}_{ci}. \] These constraints can be carried out via constrOptim() and the arguments ci and ui. Here is an example

## Warning in fitdist(x, "nig", custom.optim = myoptim, ui = ui, ci = ci, start =
## list(mu = 0, : The dnig function should return a vector of with NaN values when
## input has inconsistent parameters and not raise an error
## Warning in fitdist(x, "nig", custom.optim = myoptim, ui = ui, ci = ci, start =
## list(mu = 0, : The pnig function should return a vector of with NaN values when
## input has inconsistent values and not raise an error
## Fitting of the distribution ' nig ' by maximum likelihood 
## Parameters:
##       estimate Std. Error
## mu       2.985         NA
## delta    0.457         NA
## alpha    0.466         NA
## beta     0.237         NA

3.6 How works quantile matching estimation for discrete distributions?

Let us consider the geometric distribution with values in \(\{0,1,2,3,\dots\}\). The probability mass function, the cumulative distribution function and the quantile function are \[ P(X=x)= p (1-p)^{\lfloor x\rfloor}, F_X(x) = 1- (1-p)^{\lfloor x\rfloor}, F_X^{-1}(q) = \left\lfloor\frac{\log(1-q)}{\log(1-p)}\right\rfloor. \] Due to the integer part (floor function), both the distribution function and the quantile function are step functions.

## [1] 0.500 0.750 0.875 0.938
## [1] 0 1 3

Now we study the QME for the geometric distribution. Since we have only one parameter, we choose one probabiliy, \(p=1/2\). The theoretical median is the following integer \[ F_X^{-1}(1/2) = \left\lfloor\frac{\log(1/2)}{\log(1-p)}\right\rfloor. \] Note that the theoretical median for a discrete distribution is an integer. Empirically, the median may not be an integer. Indeed for an even length dataset, the empirical median is \[ q_{n,1/2} = \frac{x_{n/2}^\star + x_{n/2+1}^\star}{2}, \] where \(x_{1}^\star<\dots<x_{n}^\star\) is the sorted sample, which is not an integer value if \(x_{n/2}^\star + x_{n/2+1}^\star\) is not an even number. However for an odd length dataset, the empirical median is an integer \(q_{n,1/2}=x_{(n+1)/2}^\star\).

## [1] 0.5
## [1] 0

Therefore, a first issue arises: if the median is not an integer, it is impossible to match exactly the empirical median with the theoretical quantile.

Furthermore, the second issue is the non-uniqueness of the solution. Admitting matching \(q_{n,1/2}\) is an integer, QME aims to find some \(p\) such that \[ \left\lfloor\frac{\log(1/2)}{\log(1-p)}\right\rfloor = q_{n,1/2} \Leftrightarrow q_{n,1/2} \leq \frac{\log(1/2)}{\log(1-p)} < q_{n,1/2} +1. \] Let us plot the squared differences \((F_X^{-1}(1/2) - q_{n,1/2})^2\).

## [1] 0

Any value between [1/3, 5/9] minimizes the squared differences. Therefore, fitdist() may be sensitive to the chosen initial value with deterministic optimization algorithm.

## initial  value 1.000000 
## iter   2 value 0.000000
## iter   2 value 0.000000
## iter   2 value 0.000000
## final  value 0.000000 
## converged
## Fitting of the distribution ' geom ' by matching quantiles 
## Parameters:
##      estimate
## prob     0.34
## initial  value 144.000000 
## iter   1 value 144.000000
## final  value 144.000000 
## converged
## Fitting of the distribution ' geom ' by matching quantiles 
## Parameters:
##      estimate
## prob     0.05

The solution is to use a stochastic algorithm such as simulated annealing (SANN).

## Fitting of the distribution ' geom ' by matching quantiles 
## Parameters:
##      estimate
## prob    0.497
## Fitting of the distribution ' geom ' by matching quantiles 
## Parameters:
##      estimate
## prob    0.401

Let us consider the Poisson distribution defined by the following mass probability and the cumulative distribution functions \[ P(X=k)=\frac{\lambda^k}{k!}\exp(-\lambda),~ F_X(x) = \exp(-\lambda)\sum_{k=0}^{\lfloor x \rfloor}\frac{\lambda^k}{k!},~ x\geq 0. \] The quantile function \(F_X^{-1}(p)=\inf(x, F_X(x)\geq p)\) simplifies to \[ F_X^{-1}(p) = i \text{ such that } \sum_{k=0}^{i-1} P(X=k) \leq p < \sum_{k=0}^{i} P(X=k). \] Again, the quantile function is a step function \[ F_X^{-1}(p) = \left\{ \begin{array}{ll} 0 & \text{if } p < P(X=0) \\ 1 & \text{if } P(X=0) \leq p < P(X=0)+P(X=1) \\ 2 & \text{if } P(X=0)+P(X=1) \leq p < P(X=0)+P(X=1)+P(X=2) \\ \dots \\ i & \text{if } \sum_{k=0}^{i-1} P(X=k) \leq p < \sum_{k=0}^{i} P(X=k) \\ \dots \\ \end{array} \right. \]

Again, the squared differences is a step function \((F_X^{-1}(1/2) - q_{n,1/2})^2\).

Therefore, using fitdist() may be sensitive to the chosen initial value.

## Fitting of the distribution ' pois ' by matching quantiles 
## Parameters:
##        estimate
## lambda        2
## Fitting of the distribution ' pois ' by matching quantiles 
## Parameters:
##        estimate
## lambda     6.73

4 Questions regarding uncertainty

4.1 Can we compute marginal confidence intervals on parameter estimates from their reported standard error ?

In statistics, deriving marginal confidence intervals on MLE parameter estimates using the approximation of their standard errors (calculated from the hessian) is a quite common procedure. It is based on the wald approximation which stands that when the sample size \(n\) is sufficiently high, the marginal \(95\%\) confidence on the ith component \(\theta_i\) of a model parameter \(\theta\) estimated by maximum likelihood (estimate denoted \(\hat \theta\)) can be approximated by : \(\hat \theta_i \pm 1.96 \times SE(\hat \theta_i )\) with \(SE(\hat \theta_i )\) the ith term of the diagonal of the covariance matrix of the estimates (\(V_{ii}\)). \(V\) is generally approximated by the inverse of the Fisher information matrix (\(I(\hat \theta)\)). The Fisher information matrix corresponds to the opposite of the hessian matrix evaluated on the MLE estimate. Let us recall that the hessian matrix is defined by \(H_{ij}(y, \theta) = \frac{\partial^2 L(y, \theta)}{\partial \theta_i \partial \theta_j}\) with \(L(y, \theta)\) the loglikelihod function for data \(y\) and parameter \(\theta\).

Before using this approximation, one must keep in mind that its validity does not only depend on the sample size. It also strongly depends on the data, of the distribution, and also on the parameterization of the distribution. For this reason we recommend potential users of the Wald approximation to compare the results to the ones obtained using the bootstrap procedure (see below) before using this approximation. A look at the loglikelihood contours is also interesting as the Wald approximation assumes elliptical contours. In a more general context, we recommend the use of bootstrap to compute confidence intervals on parameters or on any function of those parameters.

Below you will find two examples, one for which Wald confidence intervals seem correct and one for which they give wrong results, with parameter values even outside their possible range (negative rate bound for the gamma distribution).

##      Median 2.5% 97.5%
## mean   9.41 8.78 10.02
## sd     1.73 1.33  2.15
##      estimate 2.5% 97.5%
## mean     9.41 8.77 10.04
## sd       1.78 1.33  2.22

##        Median   2.5%   97.5%
## shape  0.0923 0.0636   0.145
## rate  30.0782 9.6306 146.660
##       estimate    2.5%  97.5%
## shape   0.0882  0.0553  0.121
## rate   24.2965 -6.3504 54.944

4.2 How can we compute confidence intervals on quantiles from the fit of a distribution ?

The quantile() function can be used to calculate any quantile from a fitted distribution when it is called with an object of class fitdist or fitdistcens as the first argument. When called with an object of class bootdist or bootdistcens as the first argument, quantiles are returned accompanied with a confidence interval calculated using the bootstraped sample of parameters. Moreover, you can use the CIcdfplot() function to plot the fitted distribution as a CDF curve surrounded by a band corresponding to pointwise intervals on the quantiles. See an example below on censored data corresponding to 72-hour acute salinity tolerance (LC50values) of rivermarine invertebrates.

## (original) estimated quantiles for each specified probability (censored data)
##          p=0.05
## estimate   1.12
## Median of bootstrap estimates
##          p=0.05
## estimate   1.12
## 
## two-sided 95 % CI of each quantile
##        p=0.05
## 2.5 %    1.05
## 97.5 %   1.20

4.3 How can we compute confidence intervals on any function of the parameters of the fitted distribution ?

The bootstrap sample of parameter estimates can be used to calculate a bootstrap sample of any variable defined as a function of the parameters of the fitted distribution. From such a bootstrap sample you can easily compute a conidence interval using percentiles. Below is an example that uses the bootstrap sample of parameters from the previous example (FAQ 4.2) to calculate a 95 percent confidence interval on the Potentially Affected Portion (PAF) of species at a given exposure to salinity (fixed to 1.2 in log10 in this example).

##   2.5%  97.5% 
## 0.0487 0.1470

For more complex calculations especially to tranfer uncertainty within a quantitative risk assessment, we recommend the use of the package mc2d which aims at making such calculations easy and which gives extensive examples of use of such bootstrap samples of parameters estimated using functions of the package fitdistrplus.

5 How to personalize plots

5.1 Can I personalize the default plot given for an object of class fitdist or fitdistcens?

The default plot given by using the plot() function on an object of class fitdist or fitdistcens is hard to personalize. Indeed this plot was designed only to give a quick overview of the fit, not to be used as a graph in a manuscript or a formal presentation. To personalize some of (or all) the goodness-of-fit plots, you should rather use specific graphical functions, denscomp, cdfcomp, ppcomp, qqcomp or cdfcompcens (see how in the following paragraphs).

5.2 How to personalize goodness-of-fit plots ?

The default plot of an object of class fitdist can be easily reproduced and personalized using denscomp, cdfcomp, ppcomp and qqcomp.

In a similar way, the default plot of an object of class fitdistcens can be easily personalized using cdfcompcens.

5.3 Is it possible to obtain ggplot2 plots ?

An argument plotstyle was added to functions denscomp, cdfcomp, ppcomp, qqcompand cdfcompcens, ppcompcens, qqcompcens to enable the generation of plots using the ggplot2 package. This argument by default fixed at graphics must simply be fixed at ggplot for this purpose, as in the following example. In that latter case the graphical functions return a graphic object that can be further personalized using ggplot2 functions.

5.4 Is it possible to add the names of the observations in a goodness-of-fit plot, e.g. the names of the species in the plot of the Species Sensitivity Distribution (SSD) classically used in ecotoxicology ?

An argument named name.points can be used in functions cdfcomp or CIcdfcomp to pass a label vector for observed points so as to add the names of the points on the left of each point. This option is available only for ECDF goodness-of-fit plots and only for non censored data. This option can be used as below, for example, to name the species in the classical plot of the Species Sensitivity Distributions (SSD) in ecotoxicology.

6 Questions regarding (left, right and/or interval) censored data

6.1 How to code censored data in fitdistrplus ?

Censored data must be rpresented in the package by a dataframe of two columns respectively named left and right, describing each observed value as an interval. The left column contains either NA for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The right column contains either NA for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. This type of representation corresponds to the coding names "interval2" in function Surv of the package survival. There is no other way to represent censored data in fitdistrplus but the function Surv2fitdistcens() can be used to help you to format data for use in fitdistcens() from one of the format used in the survival package (see the help page of Surv2fitdistcens()). You have a toy example below.

##   left right
## 1   NA   1.0
## 2  2.0   3.0
## 3  4.0   7.0
## 4  6.0   8.0
## 5  9.7   9.7
## 6 10.0    NA

6.2 How do I prepare the input of fitdistcens() with Surv2fitdistcens()?

Let us consider a classical right-censored dataset for human life: twenty values randomly chosen from the canlifins dataset of CASdatasets package. We refer to the help of Surv2fitdistcens() for other censoring types.

When performing survival analysis, it is very common to use Surv() function from package survival to handle different types of censoring. In order to ease the use of fitdistcens(), a dedicated function Surv2fitdistcens() has been implemented with arguments similar to the ones of Surv().

Let us now fit two simple distributions.

6.3 How to represent an empirical distribution from censored data ?

The representation of an empirical distribution from censored data is not a trivial problem. One can simply represent each observation as an interval at an y-value defined by the rank of the observation as done below using function plotdistcens. This representation can be interesting to visualize the raw data, but it remains difficult to correctly order the observations in any case (see the example below on the right using data smokedfish).

Many authors worked on the development of algorithms for non parametric maximum likelihood estimation (NPMLE) of the empirical cumulative distribution function (ECDF) from interval censored data (including left and right censored data that can be considered as interval censored data with one bound at infinity). In old versions of fitdistrplus we used the Turnbull algorithm using calls to functions of the package survival. Even if this Turnbull algorithm is still available in the package, the default plot now uses the function npsurv of the package npsurv. This package provides more performant algorithms developped by Yong Wang (see references cited in the help page of plotdistcens). Due to lack of maintenance of this package we were forced to rewrite their main functions in our package, using another optimization function. The same ECDF plot was also implemented in our using the Turnbull algorithm of survival (see below).

As you can see in the above example, the new implementation of NPMLE provides a different type of plot for the ECDF, representing by filled rectangles the zones of non-uniqueness of the NPMLE ECDF. Indeed an NPMLE algorithm generally proceeds in two steps.

  1. The first step aims at identifying equivalence classes (also named in the litterture Turnbull intervals or maximal intersection intervals or innermost intervals or maximal cliques of the data). Equivalences classess are points/intervals under which the NPMLE ECDF may change. Equivalence classes have been shown to correspond to regions between a left bound of an interval (named L in the following plot on a the previous toy example) immediately followed by a right bound of an interval (named R in the following plot). An equivalence class may be of null length (for example at each non censored value).

  2. The second step aims at assigning a probability mass to each equivalence class, which may be zero on some classes. The NPMLE is unique only up to these equivalence classes and this non uniqueness of the NPMLE ECDF is represented by filled rectangles.

Various NPMLE algorithms are implemented in the packages Icens, interval and npsurv. They are more or less performant and all of them do not enable the handling of other data than survival data, especially with left censored observations.

6.4 How to assess the goodness-of-fit of a distribution fitted on censored data ?

The only available method in fitdistrplus to fit distributions on censored data is the maximum likelihood estimation (MLE). Once a distribution is fitted using fitdistcens, AIC and BIC values can be found in the summary of the object of class fitdistcens returned by the function. Those values can be used to compare the fit of various distributions on a same dataset. Function gofstat is not yet proposed in our package for fits on censored data but we plan to develop it in the future with the calculation of other goodness-of-fit statistics for censored data.

## [1] 178
## [1] 177

Considering goodness-of-fit plots, the generic plot function of an object of class fitdistcensprovides three plots, one in CDF using the NPMLE ECDF plot (by default using the Wang prepresentation, see previous part for details), a Q-Q plot and a P-P plot simply derived from the Wang plot of the ECDF, with filled rectangles indicating non uniqueness of the NPMLE ECDF.

Functions cdfcompcens(), qqcompens() and ppcompcens() can be used to individualize and personnalize CDF, Q-Q and P-P goodness-of-fit plots and/or to compare the fit of various distributions on a same dataset.

Considering Q-Q plots and P-P plots, it may be easier to compare various fits by splitting the plots as below which is done automatically using the plotstyle ggplot in qqcompens() and ppcompcens() but can also be done manually with the plotstyle graphics.

fitdistrplus/inst/doc/paper2JSS.R0000644000176200001440000003403114124570223016425 0ustar liggesusers### R code from vignette source 'paper2JSS.Rnw' ################################################### ### code chunk number 1: par4vignette ################################################### options(digits = 4, prompt="R> ", SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) set.seed(1234) ################################################### ### code chunk number 2: datgroundbeef ################################################### library("fitdistrplus") data("groundbeef") str(groundbeef) ################################################### ### code chunk number 3: figgroundbeef.echo (eval = FALSE) ################################################### ## plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) ################################################### ### code chunk number 4: figgroundbeefplot ################################################### getOption("SweaveHooks")[["fig"]]() plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) ################################################### ### code chunk number 5: descgroundbeef.echo (eval = FALSE) ################################################### ## descdist(groundbeef$serving, boot = 1000) ################################################### ### code chunk number 6: descgroundbeefplot ################################################### getOption("SweaveHooks")[["fig"]]() descdist(groundbeef$serving, boot = 1000) ################################################### ### code chunk number 7: fitgroundbeef.weibull ################################################### fw <- fitdist(groundbeef$serving, "weibull") summary(fw) ################################################### ### code chunk number 8: fitgroundbeef.echo ################################################### fg <- fitdist(groundbeef$serving, "gamma") fln <- fitdist(groundbeef$serving, "lnorm") par(mfrow = c(2, 2)) plot.legend <- c("Weibull", "lognormal", "gamma") denscomp(list(fw, fln, fg), legendtext = plot.legend) qqcomp(list(fw, fln, fg), legendtext = plot.legend) cdfcomp(list(fw, fln, fg), legendtext = plot.legend) ppcomp(list(fw, fln, fg), legendtext = plot.legend) ################################################### ### code chunk number 9: fitgroundbeef ################################################### getOption("SweaveHooks")[["fig"]]() par(mfrow=c(2, 2)) denscomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) qqcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) cdfcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) ppcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) ################################################### ### code chunk number 10: fitendo.echo ################################################### data("endosulfan") ATV <-endosulfan$ATV fendo.ln <- fitdist(ATV, "lnorm") library("actuar") fendo.ll <- fitdist(ATV, "llogis", start = list(shape = 1, scale = 500)) fendo.P <- fitdist(ATV, "pareto", start = list(shape = 1, scale = 500)) fendo.B <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE, legendtext = c("lognormal", "loglogistic", "Pareto", "Burr")) ################################################### ### code chunk number 11: fitendo ################################################### getOption("SweaveHooks")[["fig"]]() cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE,legendtext = c("lognormal","loglogistic","Pareto","Burr")) ################################################### ### code chunk number 12: quantilefitdist ################################################### quantile(fendo.B, probs = 0.05) quantile(ATV, probs = 0.05) ################################################### ### code chunk number 13: fendo.gof.print ################################################### gofstat(list(fendo.ln, fendo.ll, fendo.P, fendo.B), fitnames = c("lnorm", "llogis", "Pareto", "Burr")) ################################################### ### code chunk number 14: fitBurr.boot.echo ################################################### bendo.B <- bootdist(fendo.B, niter = 1001) ################################################### ### code chunk number 15: fitBurr.boot.results ################################################### summary(bendo.B) plot(bendo.B) ################################################### ### code chunk number 16: fitBurrbootplot ################################################### getOption("SweaveHooks")[["fig"]]() plot(bendo.B) ################################################### ### code chunk number 17: fitATV.lnorm.quantile ################################################### quantile(bendo.B, probs = 0.05) ################################################### ### code chunk number 18: fitATV.lnorm.quantileb ################################################### quantile(bendo.B, probs = 0.05) ################################################### ### code chunk number 19: mge.gofcomp.echo ################################################### fendo.ln.ADL <- fitdist(ATV, "lnorm", method = "mge", gof = "ADL") fendo.ln.AD2L <- fitdist(ATV, "lnorm", method = "mge", gof = "AD2L") cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", xlegend = "bottomright", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order")) ################################################### ### code chunk number 20: mgegofcompplot ################################################### getOption("SweaveHooks")[["fig"]]() cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order"), xlegend = "bottomright") ################################################### ### code chunk number 21: quantilefitdist ################################################### (HC5.estimates <- c( empirical = as.numeric(quantile(ATV, probs = 0.05)), Burr = as.numeric(quantile(fendo.B, probs = 0.05)$quantiles), lognormal_MLE = as.numeric(quantile(fendo.ln, probs = 0.05)$quantiles), lognormal_AD2 = as.numeric(quantile(fendo.ln.ADL, probs = 0.05)$quantiles), lognormal_AD2L = as.numeric(quantile(fendo.ln.AD2L, probs = 0.05)$quantiles))) ################################################### ### code chunk number 22: danish.mme ################################################### data("danishuni") str(danishuni) fdanish.ln.MLE <- fitdist(danishuni$Loss, "lnorm") fdanish.ln.MME <- fitdist(danishuni$Loss, "lnorm", method = "mme", order = 1:2) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend = c("lognormal MLE", "lognormal MME"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) ################################################### ### code chunk number 23: danishmmeplot ################################################### getOption("SweaveHooks")[["fig"]]() library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start=list(shape=10, scale=10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method="mme", order=1:2, memp="memp", start=list(shape=10, scale=10), lower=c(2+1e-6,2+1e-6), upper=c(Inf,Inf)) par(mfrow=c(1, 2)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend=c("lognormal MLE", "lognormal MME"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend=c("Pareto MLE", "Pareto MME"), main="Fitting a Pareto distribution", xlogscale=TRUE, datapch=20) ################################################### ### code chunk number 24: danish.mme.pareto ################################################### library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start = list(shape = 10, scale = 10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method = "mme", order = 1:2, memp = "memp", start = list(shape = 10, scale = 10), lower = c(2+1e-6, 2+1e-6), upper = c(Inf, Inf)) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend = c("Pareto MLE", "Pareto MME"), main = "Fitting a Pareto distribution", xlogscale = TRUE, datapch = ".") gofstat(list(fdanish.ln.MLE, fdanish.P.MLE, fdanish.ln.MME, fdanish.P.MME), fitnames = c("lnorm.mle", "Pareto.mle", "lnorm.mme", "Pareto.mme")) ################################################### ### code chunk number 25: danish.qme.echo ################################################### fdanish.ln.QME1 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(1/3, 2/3)) fdanish.ln.QME2 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(8/10, 9/10)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend = c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) ################################################### ### code chunk number 26: danishqmeplot ################################################### getOption("SweaveHooks")[["fig"]]() cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend=c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) ################################################### ### code chunk number 27: optimmethod.gamma ################################################### data("groundbeef") fNM <- fitdist(groundbeef$serving, "gamma", optim.method = "Nelder-Mead") fBFGS <- fitdist(groundbeef$serving, "gamma", optim.method = "BFGS") fSANN <- fitdist(groundbeef$serving, "gamma", optim.method = "SANN") fCG <- try(fitdist(groundbeef$serving, "gamma", optim.method = "CG", control = list(maxit = 10000))) if(class(fCG) == "try-error") fCG <- list(estimate = NA) ################################################### ### code chunk number 28: optimmethod.customgenoud ################################################### mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values = par, ...) standardres <- c(res, convergence = 0) return(standardres) } ################################################### ### code chunk number 29: optimmethod.customgenoud.fitdist ################################################### fgenoud <- mledist(groundbeef$serving, "gamma", custom.optim = mygenoud, nvars = 2, max.generations = 10, Domains = cbind(c(0,0), c(10,10)), boundary.enforcement = 1, hessian = TRUE, print.level = 0, P9 = 10) cbind(NM = fNM$estimate, BFGS = fBFGS$estimate, SANN = fSANN$estimate, CG = fCG$estimate, fgenoud = fgenoud$estimate) ################################################### ### code chunk number 30: datsalinity ################################################### data("salinity") str(salinity) ################################################### ### code chunk number 31: plotsalinity2.echo ################################################### plotdistcens(salinity, NPMLE = FALSE) ################################################### ### code chunk number 32: plotsalinity ################################################### getOption("SweaveHooks")[["fig"]]() plotdistcens(salinity, NPMLE = FALSE) ################################################### ### code chunk number 33: fitsalinity.echo ################################################### fsal.ln <- fitdistcens(salinity, "lnorm") fsal.ll <- fitdistcens(salinity, "llogis", start = list(shape = 5, scale = 40)) summary(fsal.ln) summary(fsal.ll) ################################################### ### code chunk number 34: fitsalinity.cdfcomp.echo (eval = FALSE) ################################################### ## par(mfrow=c(2, 2)) ## cdfcompcens(list(fsal.ln, fsal.ll), ## legendtext = c("lognormal", "loglogistic ")) ## qqcompcens(fsal.ln, legendtext = "lognormal") ## ppcompcens(fsal.ln, legendtext = "lognormal") ## qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), ## main = "Q-Q plot with 2 dist.") ################################################### ### code chunk number 35: fitsalinitycdfcompplot ################################################### getOption("SweaveHooks")[["fig"]]() par(mfrow=c(2, 2)) cdfcompcens(list(fsal.ln, fsal.ll), legendtext=c("lognormal", "loglogistic ")) qqcompcens(fsal.ln, legendtext = "lognormal") ppcompcens(fsal.ln, legendtext = "lognormal") qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), main = "Q-Q plot with 2 dist.") ################################################### ### code chunk number 36: dattoxocara ################################################### data("toxocara") str(toxocara) ################################################### ### code chunk number 37: fittoxocara.poisnbinom ################################################### (ftoxo.P <- fitdist(toxocara$number, "pois")) (ftoxo.nb <- fitdist(toxocara$number, "nbinom")) ################################################### ### code chunk number 38: fittoxocara.poisnbinom.echo ################################################### par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) ################################################### ### code chunk number 39: fittoxocarapoisnbinomplot ################################################### getOption("SweaveHooks")[["fig"]]() par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) ################################################### ### code chunk number 40: fittoxocara.poisnbinom.gof ################################################### gofstat(list(ftoxo.P, ftoxo.nb), fitnames = c("Poisson", "negative binomial")) fitdistrplus/inst/doc/Optimalgo.Rmd0000644000176200001440000004315113762162350017140 0ustar liggesusers--- title: Which optimization algorithm to choose? author: Marie Laure Delignette Muller, Christophe Dutang date: '`r Sys.Date()`' output: html_vignette: toc: true number_sections: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Which optimization algorithm to choose?} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r setup, echo=FALSE, message=FALSE, warning=FALSE} require(fitdistrplus) require(knitr) #for kable() function set.seed(12345) options(digits = 3) ``` # Quick overview of main optimization methods We present very quickly the main optimization methods. Please refer to **Numerical Optimization (Nocedal \& Wright, 2006)** or **Numerical Optimization: theoretical and practical aspects (Bonnans, Gilbert, Lemarechal \& Sagastizabal, 2006)** for a good introduction. We consider the following problem $\min_x f(x)$ for $x\in\mathbb{R}^n$. ## Derivative-free optimization methods The Nelder-Mead method is one of the most well known derivative-free methods that use only values of $f$ to search for the minimum. It consists in building a simplex of $n+1$ points and moving/shrinking this simplex into the good direction. 1. set initial points $x_1, \dots, x_{n+1}$. 2. order points such that $f(x_1)\leq f(x_2)\leq\dots\leq f(x_{n+1})$. 3. compute $x_o$ as the centroid of $x_1, \dots, x_{n}$. 4. Reflection: + compute the reflected point $x_r = x_o + \alpha(x_o-x_{n+1})$. + **if** $f(x_1)\leq f(x_r)1$, once initiated by $d_1 = -g(x_1)$. $\beta_k$ are updated according a scheme: * $\beta_k = \frac{ g_k^T g_k}{g_{k-1}^T g_{k-1} }$: Fletcher-Reeves update, * $\beta_k = \frac{ g_k^T (g_k-g_{k-1} )}{g_{k-1}^T g_{k-1}}$: Polak-Ribiere update. There exists also three-term formula for computing direction $d_k = -g(x_k) + \beta_k d_{k-1}+\gamma_{k} d_t$ for $tt+1$ otherwise $\gamma_k=0$ if $k=t$. See Yuan (2006) for other well-known schemes such as Hestenses-Stiefel, Dixon or Conjugate-Descent. The three updates (Fletcher-Reeves, Polak-Ribiere, Beale-Sorenson) of the (non-linear) conjugate gradient are available in `optim`. ### Computing the stepsize $t_k$ Let $\phi_k(t) = f(x_k + t d_k)$ for a given direction/iterate $(d_k, x_k)$. We need to find conditions to find a satisfactory stepsize $t_k$. In literature, we consider the descent condition: $\phi_k'(0) < 0$ and the Armijo condition: $\phi_k(t) \leq \phi_k(0) + t c_1 \phi_k'(0)$ ensures a decrease of $f$. Nocedal \& Wright (2006) presents a backtracking (or geometric) approach satisfying the Armijo condition and minimal condition, i.e. Goldstein and Price condition. * set $t_{k,0}$ e.g. 1, $0 < \alpha < 1$, * **Repeat** until Armijo satisfied, + $t_{k,i+1} = \alpha \times t_{k,i}$. * **end Repeat** This backtracking linesearch is available in `optim`. ## Benchmark To simplify the benchmark of optimization methods, we create a `fitbench` function that computes the desired estimation method for all optimization methods. This function is currently not exported in the package. ```{r, echo=TRUE, eval=FALSE} fitbench <- function(data, distr, method, grad=NULL, control=list(trace=0, REPORT=1, maxit=1000), lower=-Inf, upper=+Inf, ...) ``` ```{r, echo=FALSE} fitbench <- fitdistrplus:::fitbench ``` # Numerical illustration with the beta distribution ## Log-likelihood function and its gradient for beta distribution ### Theoretical value The density of the beta distribution is given by $$ f(x; \delta_1,\delta_2) = \frac{x^{\delta_1-1}(1-x)^{\delta_2-1}}{\beta(\delta_1,\delta_2)}, $$ where $\beta$ denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. We recall that $\beta(a,b)=\Gamma(a)\Gamma(b)/\Gamma(a+b)$. There the log-likelihood for a set of observations $(x_1,\dots,x_n)$ is $$ \log L(\delta_1,\delta_2) = (\delta_1-1)\sum_{i=1}^n\log(x_i)+ (\delta_2-1)\sum_{i=1}^n\log(1-x_i)+ n \log(\beta(\delta_1,\delta_2)) $$ The gradient with respect to $a$ and $b$ is $$ \nabla \log L(\delta_1,\delta_2) = \left(\begin{matrix} \sum\limits_{i=1}^n\ln(x_i) - n\psi(\delta_1)+n\psi( \delta_1+\delta_2) \\ \sum\limits_{i=1}^n\ln(1-x_i)- n\psi(\delta_2)+n\psi( \delta_1+\delta_2) \end{matrix}\right), $$ where $\psi(x)=\Gamma'(x)/\Gamma(x)$ is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. ### `R` implementation As in the `fitdistrplus` package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in `grlnL`. Both the log-likelihood and its gradient are not exported. ```{r} lnL <- function(par, fix.arg, obs, ddistnam) fitdistrplus:::loglikelihood(par, fix.arg, obs, ddistnam) grlnlbeta <- fitdistrplus:::grlnlbeta ``` ## Random generation of a sample ```{r, fig.height=4, fig.width=4} #(1) beta distribution n <- 200 x <- rbeta(n, 3, 3/4) grlnlbeta(c(3, 4), x) #test hist(x, prob=TRUE) lines(density(x), col="red") curve(dbeta(x, 3, 3/4), col="green", add=TRUE) legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ``` ## Fit Beta distribution Define control parameters. ```{r} ctr <- list(trace=0, REPORT=1, maxit=1000) ``` Call `mledist` with the default optimization function (`optim` implemented in `stats` package) with and without the gradient for the different optimization methods. ```{r} unconstropt <- fitbench(x, "beta", "mle", grad=grlnlbeta, lower=0) ``` In the case of constrained optimization, `mledist` permits the direct use of `constrOptim` function (still implemented in `stats` package) that allow linear inequality constraints by using a logarithmic barrier. Use a exp/log transformation of the shape parameters $\delta_1$ and $\delta_2$ to ensure that the shape parameters are strictly positive. ```{r} dbeta2 <- function(x, shape1, shape2, log) dbeta(x, exp(shape1), exp(shape2), log=log) #take the log of the starting values startarg <- lapply(fitdistrplus:::start.arg.default(x, "beta"), log) #redefine the gradient for the new parametrization grbetaexp <- function(par, obs, ...) grlnlbeta(exp(par), obs) * exp(par) expopt <- fitbench(x, distr="beta2", method="mle", grad=grbetaexp, start=startarg) #get back to original parametrization expopt[c("fitted shape1", "fitted shape2"), ] <- exp(expopt[c("fitted shape1", "fitted shape2"), ]) ``` Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one). ## Results of the numerical investigation Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (`-B` stands for bounded version), (2) the original parametrization with the (true) gradient (`-B` stands for bounded version and `-G` for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (`-G` stands for gradient). ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt))], digits=3) ``` Using `llsurface`, we plot the log-likehood surface around the true value (green) and the fitted parameters (red). ```{r, fig.width=4, fig.height=4} llsurface(min.arg=c(0.1, 0.1), max.arg=c(7, 3), plot.arg=c("shape1", "shape2"), nlev=25, plot.np=50, data=x, distr="beta", back.col = FALSE) points(unconstropt[1,"BFGS"], unconstropt[2,"BFGS"], pch="+", col="red") points(3, 3/4, pch="x", col="green") ``` We can simulate bootstrap replicates using the `bootdist` function. ```{r, fig.width=4, fig.height=4} b1 <- bootdist(fitdist(x, "beta", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=3, h=3/4, col="red", lwd=1.5) ``` # Numerical illustration with the negative binomial distribution ## Log-likelihood function and its gradient for negative binomial distribution ### Theoretical value The p.m.f. of the Negative binomial distribution is given by $$ f(x; m,p) = \frac{\Gamma(x+m)}{\Gamma(m)x!} p^m (1-p)^x, $$ where $\Gamma$ denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. There exists an alternative representation where $\mu=m (1-p)/p$ or equivalently $p=m/(m+\mu)$. Thus, the log-likelihood for a set of observations $(x_1,\dots,x_n)$ is $$ \log L(m,p) = \sum_{i=1}^{n} \log\Gamma(x_i+m) -n\log\Gamma(m) -\sum_{i=1}^{n} \log(x_i!) + mn\log(p) +\sum_{i=1}^{n} {x_i}\log(1-p) $$ The gradient with respect to $m$ and $p$ is $$ \nabla \log L(m,p) = \left(\begin{matrix} \sum_{i=1}^{n} \psi(x_i+m) -n \psi(m) + n\log(p) \\ mn/p -\sum_{i=1}^{n} {x_i}/(1-p) \end{matrix}\right), $$ where $\psi(x)=\Gamma'(x)/\Gamma(x)$ is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. ### `R` implementation As in the `fitdistrplus` package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in `grlnL`. ```{r} grlnlNB <- function(x, obs, ...) { m <- x[1] p <- x[2] n <- length(obs) c(sum(psigamma(obs+m)) - n*psigamma(m) + n*log(p), m*n/p - sum(obs)/(1-p)) } ``` ## Random generation of a sample ```{r, fig.height=4, fig.width=4} #(1) beta distribution n <- 200 trueval <- c("size"=10, "prob"=3/4, "mu"=10/3) x <- rnbinom(n, trueval["size"], trueval["prob"]) hist(x, prob=TRUE, ylim=c(0, .3)) lines(density(x), col="red") points(min(x):max(x), dnbinom(min(x):max(x), trueval["size"], trueval["prob"]), col="green") legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ``` ## Fit a negative binomial distribution Define control parameters and make the benchmark. ```{r} ctr <- list(trace=0, REPORT=1, maxit=1000) unconstropt <- fitbench(x, "nbinom", "mle", grad=grlnlNB, lower=0) unconstropt <- rbind(unconstropt, "fitted prob"=unconstropt["fitted mu",] / (1+unconstropt["fitted mu",])) ``` In the case of constrained optimization, `mledist` permits the direct use of `constrOptim` function (still implemented in `stats` package) that allow linear inequality constraints by using a logarithmic barrier. Use a exp/log transformation of the shape parameters $\delta_1$ and $\delta_2$ to ensure that the shape parameters are strictly positive. ```{r} dnbinom2 <- function(x, size, prob, log) dnbinom(x, exp(size), 1/(1+exp(-prob)), log=log) #transform starting values startarg <- fitdistrplus:::start.arg.default(x, "nbinom") startarg$mu <- startarg$size / (startarg$size+startarg$mu) startarg <- list(size=log(startarg[[1]]), prob=log(startarg[[2]]/(1-startarg[[2]]))) #redefine the gradient for the new parametrization Trans <- function(x) c(exp(x[1]), plogis(x[2])) grNBexp <- function(par, obs, ...) grlnlNB(Trans(par), obs) * c(exp(par[1]), plogis(x[2])*(1-plogis(x[2]))) expopt <- fitbench(x, distr="nbinom2", method="mle", grad=grNBexp, start=startarg) #get back to original parametrization expopt[c("fitted size", "fitted prob"), ] <- apply(expopt[c("fitted size", "fitted prob"), ], 2, Trans) ``` Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one). ## Results of the numerical investigation Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (`-B` stands for bounded version), (2) the original parametrization with the (true) gradient (`-B` stands for bounded version and `-G` for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (`-G` stands for gradient). ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ``` ```{r, results='asis', echo=FALSE} kable(expopt[, grep("G-", colnames(expopt))], digits=3) ``` Using `llsurface`, we plot the log-likehood surface around the true value (green) and the fitted parameters (red). ```{r, fig.width=4, fig.height=4} llsurface(min.arg=c(5, 0.3), max.arg=c(15, 1), plot.arg=c("size", "prob"), nlev=25, plot.np=50, data=x, distr="nbinom", back.col = FALSE) points(unconstropt["fitted size","BFGS"], unconstropt["fitted prob","BFGS"], pch="+", col="red") points(trueval["size"], trueval["prob"], pch="x", col="green") ``` We can simulate bootstrap replicates using the `bootdist` function. ```{r, fig.width=4, fig.height=4} b1 <- bootdist(fitdist(x, "nbinom", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=trueval["size"], h=trueval["mu"], col="red", lwd=1.5) ``` # Conclusion Based on the two previous examples, we observe that all methods converge to the same point. This is rassuring. However, the number of function evaluations (and the gradient evaluations) is very different from a method to another. Furthermore, specifying the true gradient of the log-likelihood does not help at all the fitting procedure and generally slows down the convergence. Generally, the best method is the standard BFGS method or the BFGS method with the exponential transformation of the parameters. Since the exponential function is differentiable, the asymptotic properties are still preserved (by the Delta method) but for finite-sample this may produce a small bias. fitdistrplus/inst/doc/paper2JSS.pdf0000644000176200001440000506610114124570223017005 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Length 910 >> stream concordance:paper2JSS.tex:paper2JSS.Rnw:1 212 1 1 6 1 2 1 0 2 1 7 0 1 2 16 1 1 2 4 0 1 2 5 1 2 2 60 1 1 2 4 0 1 2 5 1 1 2 12 0 1 2 47 1 1 2 1 0 1 1 15 0 1 2 35 1 1 2 1 0 7 1 3 0 1 2 5 1 1 6 1 2 53 1 1 2 1 0 5 1 1 2 1 0 1 3 5 0 1 2 6 1 1 3 1 2 19 1 1 2 8 0 1 1 7 0 1 2 22 1 1 3 17 0 1 2 75 1 1 2 4 0 1 3 10 0 1 1 3 0 1 2 3 1 2 2 25 1 1 2 4 0 2 2 14 0 1 2 79 1 1 2 1 0 1 1 1 5 7 0 1 2 5 1 1 6 1 2 12 1 1 9 15 0 1 2 55 1 1 2 1 0 1 1 7 0 1 1 1 2 1 0 1 4 6 0 1 2 4 1 1 16 1 2 25 1 1 2 1 0 1 2 1 0 1 1 1 3 2 0 1 4 3 0 1 3 17 0 1 2 49 1 1 3 2 0 1 2 1 0 1 4 6 0 1 2 16 1 1 4 1 2 34 1 1 2 1 0 3 1 1 2 1 0 1 2 4 0 1 2 13 1 1 8 10 0 1 2 11 1 1 4 3 0 1 5 12 0 1 2 44 1 1 2 1 0 1 1 8 0 1 2 34 1 1 2 4 0 1 2 6 1 2 2 43 1 1 2 1 0 1 2 1 0 1 1 14 0 1 1 15 0 1 2 19 1 1 2 1 0 1 2 1 0 2 1 1 2 4 0 1 2 5 1 1 8 1 2 25 1 1 2 1 0 1 1 7 0 1 2 8 1 1 2 9 0 1 1 10 0 1 2 6 1 1 2 1 0 1 2 1 0 1 2 4 0 1 2 4 1 1 6 1 2 20 1 1 3 25 0 1 2 65 1 endstream endobj 4 0 obj << /Length 5360 /Filter /FlateDecode >> stream xڥyHG$ef>@'U]]wU+mfO+xߗTIf ;S&mfU$ݯg0~|:ϰ2H*W)OS").y ^2O{|6w 6Av@po'LE,,ɲrn2}K+|:#;ΖM@B8#H 5at\QK\ aK Cs,K꼒 $6uы 15OHHgY_::ܱi(hGe5oT |u&.3) ҙ}=>' Q:nb"Jj'ӕ2oWXGz2J7*.Xto.skBܠNL'^Uv ƘD:dJ{0Ni3i3<5 ltabC5ֻS0yw~PaYC-)1]V*)<*c:;+oW 䉝jP`"SŹdIf+})C;ȌGXYgBX7BOFꀕBИk;V/4xe7c1wYRm"D'=1Ԥ\y+a(0qZ"JѮ{9lUP>JOWȡgGAOk p셱K3L N>S }1{2v Αy'%QtEņ> 7L$g O֞"wc[TK@z^gJ\ vW,q\:>ႆXx9i {'k2M4TE= `1)\0nQ4l4GPӦb|;p̛z$/vTTNʨV,|/c;~  FEP2|~.&cBU>F*`LluO*Hyk vwPciDܱPoB~ZA-L$!4u!ΙHɔ8z~P@GFlSjKf OWIf 'l#,:X9a1!@37:p=p2ƹ'i^3.SyG%Fhrl@naC81 uYznmfRa-g$p91Whl>ḿㅀ|^ ґ'3n?"nZ<˚ PU|G~$ +:i"ԵR-Qj++ ŴR$߰`(YVlw~ nVV^^ȽAlJdy {m+wa.bߎ&cߡGaS5#Ndfď$ʓjʓ.cE>d,b^G; \MFnBAKD٩^u^9m kkE#h8f ; Z98yD<>8&ȝ(Ɩ JLZ kWČ sвL m:&b|i"#9K1;p9Z]|>'ߖs@ж6oiR.J4K}WC&bP$y^|˼>w6rQYk~u;h{P'+ފ&r 5)q}rX(h 4OLv%1Cllf^3%(8wIإ0]Z"4Բ _ʀ:z'yܱaowMRuS˪g$lbntF[&w\AnJw{zwnD40@~Ni {~'FHQL’e+5$#6…` 2n;M6N1W:^g˳eU | ÙCY n>'6ÖE:O=.x퉧\UO,^Lz:Ԣ@X*Z2#7 9찹E,MYJxJQMRs4Iֿ˻$蹝(`Sԑt\%*ۥQs7%u^_{J`z] u2;~s|ljaaX| ;p"| 2<~ĸ<'ӠQ: /d-_<.]:8c_ĘM\dr*MGIO mW6)#c^&N3P|DYSuôtIjRMYBqNuQ6}і+.&✏?E#+YH+67=H6Ybxgݤ\+_dPZ^a|džn`_@%mP0}T*VESI'w459I&Vn8/.iz!fՊ'B+L%r]hdkvZker' =+V. zwFY4e.]H%^sVcq@4zr4JPbZȎzkM d1>n[τqI46\K̃_>+&P3NW"PsY# "xx-B(Y=y);n`_ b3iA$4"H<2i%{E-諌7xIeg]eq$\͑*,KDGC [QeI#RQ#Ѝ/زy%@Sa՝ӠEW(N9j\\{9m+y̥v8JS\Pl^,ج%>8 sm]TXT Sň9x9(j"! *?(pMfLi+~ p}⸡qLEE);L8@ԕDG& "ҏ) ӫ'zҀJ؍Iȣ15D;.S c|;lZK9Y94Mq34Wb8KtG+-OUip0R#'o6A1j$MtVsH;_I=j6Z ; ulq4a;gJْ;ٽ8RW7eT"I }坿MDv/n醖 KGgTgpgqFn$1,`.2 ; Y1r,NZa-^F-0MEՁM5W_GzҠ7oiih2¤%7"5s,vhn%uK7;>@ _|!;`:ɛ&Vq8&U03D+(*?Vd% a6W\4ZBrlsR\I ,ލm7\T {MZOvVs\m zki}ll#/knp4WE[, L wrLcS92yK^M7 0-Q# S[QG]Xը@y sY{]9zx3+MZ6N3ZIj_^r_ j<0H}.1AV {QSS%+Fn$U( ].#YCG;XhKgb?o_QOHa5nK "Ǖx%ފT"!$}762g> stream xڵ;k+@ut4͢-ƻ(\i^"$7cai~\v!Rӟz|y |ӑ5 ;fGO*oz8foޕe".s%KxCRKRU^O-MVU:alZU&+- 6"Ȓꯡ)0 EeD)uPbDܖ)GJߋ q+$u{91i?"ޝ(K 𬁗 x7+!>!gEw6HC8fu^|+liKQ@ixM;M|C&V=_>:&)Rul(Ty4CJ Pɰԑa~?CYeXY-H%o `KJ;?2FF= %!YE dn~wT(*щ<σNX ,Ob2$<]-΋߁?tI)XpPw/9H#'B{R}YHTƺ> oQâ^Tr7Ux(Y?⮛R?M }B yٔ4HգZGE CUeqk~ॆF_<57̳Mm#o[E vBr}h}p)(l%U3(3|{-fO A`&;>|a)-aI~>RGq=Buߥd}C"C&9 Y~KͿ'Ji>bԵobK~}ǡ1hIO e9ߜH@=FU»PP[Y2 ܓT@Zq~&;R!I_48niYÖÅA@Q%N1fn ЦBUv;*|μQ;@V1#=HہQܤ 4ѿA֋hI{C5⏂NԬ3)1:<뱵q=?ե׬8\xL5ݬ?]BhBB+,Ɏ/sI/)EVvy jS+S o)7 5!@oSBR0! g,ؖt ypz1(ZcWD 8@:;#qq@jreo%d>FeE|L0|3ّq9 V;fG2<-*jQV 񭒢,[Y4I>Yrޞ`ApRBFޥ%[NPvdKp4M>eZHa!{ uc+u_9O( ig`a-(&j~) a0rSA4k!>ֻ6r˄-qˬJ meGQbn) {RP5WcQ$jx'[v L!$jš{zi4;O`s4ĦgcquD Ge)кW\&r 7h,fAv[{¿;-Ɠګ#/xW4I'.;,VhRV&nZCrj3ICƮ*J|U!"pBdj`++j"-w]'gPP&`Yma"ue~Aq5[({zAN%M<!km!Ji*o.8hErST ?ijRH`fmR`Ix@[d#0H8ss/p>$v=R#Q9A.(Y[3Vbɒՠi1I4Hؽ NL\:@lL^de9X঎G88O:YŸaqҶ'%oB~$٣C-ݿݭvMl7jR+U*\ݥĵ ?U5wUwr>򌩞OIք2lik$ވЋ9(<ˍ+͒ Z7Kr;j!<͸@3T4N>|Ѓ҆^9B>0UȴtkW<%bP;}SOme)F UGϗf%BXEk~"v{|8G Gڝq%j&|)3Om> r S[Wz=* }&ǥwqhڄ15.`[=sR};bqE.jztwv7r|uS5rԈ?m4|ͣ.˜ix W:~aOZ,\٤fSpzg%,5HMHַflfɜ4) *TBg$[<ŠVIo”y)r#y5"wpAXy'˶?'5O0o^B,} `#ڠn06ì0^z$`͌MJT⎄bX,cJՔk&,B޷*n|U_'|˛U6j@Ws'Gjb`U;Cɤ)نJ4΁A_%u?f|d|S>Vn=T^HsHCA:T,_L 97`ԈUal] x0fȁt'W&s&:Foe@j3݂=BŶHM3f(}[a{W|kye%+t%2a޾@CB;Lv lί-eF{(HmCɁx%>7QO Ř&`8_o)AsvujX b҄5Db_Q@2Wcʽ)jVjw \573o6p&l<6lOPA2S̬7 3eèk-Mz't 5mڅ[ endstream endobj 21 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-figgroundbeefplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 33 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 34 0 R/F3 35 0 R>> /ExtGState << >>/ColorSpace << /sRGB 36 0 R >>>> /Length 16601 /Filter /FlateDecode >> stream x}Mmm3v dd.;2.-rc$--::Wz/xS߽/?~P;>We^*t*Wio~˯?}ow?ߟ_~}*|)c:1vwcdoj[|~т@/>_n____I(JZd._TTחG}6z!?c_3F H7#F6;cg( GHgrMu1}gE{ <#M~;}L7cec m~#.1<ϥ|i|!< _(ߡ+c_}~TDv1!j( x*Hمu9~zYHuSnG)`U֨#Xsӎ ܞ>]Gsk {\瀋={QZMd]fWz~{Ԭo8%' tq${ێD$15@--*TODrLMvlb@DqSMֹ[=c &7hEV]ꋨrV%'+=Y$ZH,I^&`Siڨ7U njGEgz/YJ5Q/H3FM;m [6Qh.5x7_1T'^_~Q-2/;))MڑdܢɒP;N6>}ךoSωMn v&w_;=&7AG!J<t~>A-(I+&4o;j'h~|e>S@>}Cy";\An2PZJd-4")V&'.x yEV~MTdnrϴT\\kC(|IZGhOx,M rOɴ~ueQ-g!ϱM aO.@ӞA<6l3P_z m]vH5^gQBoyJ4ev`!N6e zЃ;B<4Yr 5D'!ސbg8!Nls<7=_'EeM|nУœ͆}^U/гx^G =~c = /;PM牜A3WHd;U[f;32ɐ4a|ՙovΣ_G@jcNW@S8*Oo3xM, N󙖦0?xmCh>aS o4 ы3h4? 4kCD4aL7#}!SP.yccӃާ֛ihh> д>د|X=Kxm*!,Hi}=ߦi>2}Ӵ>e >_x> #EhZвl+e{Ӵ{~Z{i؄V`$EdkqfiEO SDždhZnٿ^Ѫ,4-'DszOnѠ~QNBo Ig/FZmAڞ[gӋi-iy[=piXY&4iڳ=д [ sYxraQx?<zyxTgDh^?Mk^临6'D341_X^eyI'aƳ'Z^B#M<>_H1x4q ox'- 1;4Rcx6=4Wcw ʒ=BOSO>g}{DSf%@W&?OO8֥;灾ƻ`}I$=*(|n]Ўܶ<ؓe?OeѮBry2&W06Qj.o-6$rd@36=#;yi,K,{yE6)'"yɜe;/KĖV j=YeK2d1C䞼둹==bG==Z !OYgM3h ᔬ%cOoNqrMA3'I{zf!{zDVS=fͮ oVhƞ&zӛ]{z񔱧GSH?oM}kҞE>fw6h%>B {zXv\lFaD;e͈=){/c/.9n:&9W{zc_Sv9ӣ 3lѠ!;rBX7;`?o,znLnޔłͼMv|ux+OW;y䓉IvZ!ܜ( [`oK=%h{xܛ& :Hr@LI~brtQ(ػΈu\\[(0oQPrOI&CmG#®CQe#޳--;#i9ƆBǂHޮݺWgϲhVYG@^JXz ;uK Z$y`n*`e9AZJ,آN9^ u\sH ssb5Qhwc{Talx.ʠ`gHAم<dy[nʫ`WNM9 Lɢ' v(fڐ;`?N#avƺRI\+،Ga9 IS"qlFwFܬ2 ؇RTDKV>TlMYڃdZBN^MI 6ϟ Cq¥kɸ`MnZl.sJ4Y%Lo|&Y7mN7y3. \|FHg›/\}|o&g>3?S,P W,Xj  /\5 op͕K5OK'h3.9R`̀\Q \9G[|ާVySVg›/\X,r`̟R 75ϯyo>gj~׌τ7_XK|u-Xݴ 75_Tk|ޛS b)#/L8\٪wz zGq" 8## ̗%阏> k%-=gT|p@҃p-}0ʄ7_\aJ5FNmZOf4. hksU+0}+ֈK:[Ho MT#I(Ԁx$+73\J@(%4r,CT@ |QSJ@plY>k47"X~s dJ SH5@% ee0njgp@ݖApk BRIxPf`£7:7(A 0r`* a,weo:kyk03T^\rAjeAe7.| VFgP0OTV)֭@%aCI)@WtFXs~1_lAG"'\3L,]V,T{W9W ~ \>LV(֍OKq@TÚ͔. oծNBNT..>th`(87c,+ƧE|Pd m9ni[br?7ޭ6}+`YoXV"">(5`oXjbhy S}tZ<勭"krX 2,L,·›˶[Œ8U,L,‡*krX ך S{#_X؝aɜ* 5d9G,⃂+QE>5qT"|^d YNōvt X}ۭX:ڽgYh 1RN=TgZDV)֍OK |Pd>1A V%,Ze-}:p$5NO>Jn|ZZ*˧L7S@.} _lR[,3d폩|,;` 2L,r"?iD,1f돩|4H|RYlU [6}]v_XiMӰ XW[!{i}<|t+qh??//,|.`᪞㪖T كL>W]ޡ} ? >2C_mA-nԣT" ˢ >%q^X X[E 27 *`~}owĒ7,kŒ%,=n,7;eX ؊|w.QtJ<'0?kۆO#zdZ|F=ө (,l8V,L,૭=ȴsōtω;y}o+3K,[v?VdO\èZ(NS֛{/,\ X:g٪aa1B {F}FqOYĝ2|}aM2R7H:S r>|(NSFu}aᣁ 7he#VdO\dq8*.'|^v_XV›SB@y,W[!{=q C>8|(G7Ee y,t0a躢/A5ōG 1'N>}aJƥ>%1 bAōJ2'n2͐[xN6@Y6KJ{-B%H d.G7(|}+vmN7,-|o1T//SBq w=(EP 4Vݠi-|K}a)oX*gي, K XD֐X*x,幱_v_XawLJn'Gይ"kȴtF|PedOIDKoX֊Xx7#|Ud .YSvҾ쾰p-(`sϦEhM;S_lY%<]>(\2ݧ}}?}aZP_4}Ao Gb(iA>w}?}aZP8}?PVQ7]NGv_Xl<.Zdg7a(i WZs ˢIg K,[d;šX/XDFI5|_vG,I*ϊb9(i`q#ݠ x iհT;סX/֋Vk.nP  `-ư4;ݡX/Ҋ}A~ZsNN/,ƀf:g_#jVQZ>hq#;ɪ5'`R$`К>~7옇#|Udmf|ZHNwj͉;iݾ쾰7,uJ7e,"ktc᱔7,%`lµBn ߲3+jVQq >hq#9ݧtN/,\ Xd(Eb(͸Qz*O'q~µ qgXYQ,‡*k4F}FrSy:q',lŒ9V,y( Qq >hq#ѩ<q-(`+ _NjXP,,"k4F}FrSy:q',%`KsEb} XN WR\~쾰E,KE.X2t윇b*6J3a.z}a, YХn<ይ"k4|aŕ0w_./,|SMґ ]vC~Iemf\èZHNwj͉;}?}aiT? Xp7Ky="҈}A]Zsγnv_X€e" } 윇ڳ.(W8ժ5'<`/ Xp裣 cQ*6J#-nh1pݠ/,|GB5HKs%]$Q>h1p5E;kܾ쾰,, Y`Ks%]$Q>h1p5E?߾Xp=`K XҍE|b2ްe&G5(KE.XYQ,RkA˭\bj/,\ X*pҐ fgVK;b*kF}br#Wy ׂ,\td肥ۙ(QnWy ׂ,\ d߰3+jH*kF}br]bʷ/,\ Xp79PH*kF}br]bJ/,\ X&pѷ9PH*kF}br]bznv_X,e>(Eb X\ #g\~쾰| y XERY0ۂt0ot1r5nLuQhq 3p9PKH*kfL'ӭX #, 7b'佯-Yp: HWuke֍狵MVTk|pG7(|}+v9w2`)3 ]sC_Yҩ:OzݠNgV#Y8ciK;<VQjS *`Y Ky4 g,=`oXz"6J7A}5 g}7ΙGb(Y);MUoGv_X YD.sfE*6JVy>X*Oҷ{/,\ H2to3+b (Y)tʓЙ|}aZP25 '}X<勭"kȬ}b<<a2(C*;k~}oae7,+`YCvc7,%`Yoe]·>Ѫ?㋭"kjX ׃ U {K_YS/EYvkr2X';IϬĿSYd-AȒut ,ܷ.tW[f*%#wM8P/4>TƧ>Ya4-pWK݂.%ywrZ>_6{I8A￉PVyAȒut Ov’Wki3,sㆥ9"|^d Y`zaʓa`Yo%m¿:cXWW KsEb=A b'"|9.K~+Ev9̖p̷ 竌?aBX _dj-|KdZ te[Cy=[E֐dO*bVko]"4Z:e٦oRmM=a_lYCVJ?WaR;klwZ [><ይ"kJXEtX ZT~ H(_lYCVR">(X Kja~}obi{`e.pM>dVB9`YVkE|\[boq?7,cك">(Xz߰8ݟrZ<9Ⱜ3"{Iɍ`zaʓa|.K_MIﶵL ;-8w ePjƧY-Iz~}+;ݟrZ׹ azfŰC #`9>Xxx U ŮNg\Yb}3,MyVdG,, m'[6c\v_Xk-l90{W[!{,׃LUoGv_Xk-=`ekCy=૭=`ʓAA*Oַ K`3Mβ<VdD,FsVk\av}azLβUb ك,爥a>YhNwj;?_//,S jG??PVd9E,7 *`~}oe}ڒR< bdX-nT"[ aɜe+< YZōzt X}}aIzdβK,[=aXW!{WQݚbjŝ:|}aoXW K X@ ZX屨{/,Eﶵ,[4dق ك,5ōt[ŝ:|}az4d٢#˖Y1{W[!{QQnXkȲEB--=aB Kq >hq:ݧtN-oLZǂn?PʓF=hq8ݏUkN)ZKC-:2S9]$=ȞWQd՚wJ}oaȲEX@ ZXä?O\lYÔ,[vfE~GLd'a-nU, лme"} Y̊ڳdO\èZ(NYg XEكkAŭ\NoXZKB-X2l휇b~Id'a-n>r';%’>XkKA-XP,"A5 `qѩhqcioXZf[W%dق%1=F}FvSy:q'7v_XmkXle lgVK;b"{Fi5ōGtNoXڣwZKF-X lR̊b)~Id(QTNwZKA-X*lR휇b~Id(QTNϛ{/,Y,[4dق9.ȞQq >hq#9ݧtNZoZZ9PKH"{Fi5̶cz+)ao{,Fa5̶5Le]$=4|pl՚w./,M,[MT2.ȞQq C>8}HNwj͉;ߟZD-?*`Y~Id(͸Qj՚wR{}oe}ֲeC_9PVȞQ>hq#5Ej͉;2>Xm֕ɟ$$gf|ZHnMѭZsN*o7, Y`K~ÒȞQZXLä?(̸֕şY#&gf\èZHn}t*O' Kһm ,՟YT#&gf\èZHn}t*O' Kֻm",͟Y4#&gf\èZHN<7v_Xmk- Y ]$=4F}tӉ;z}o`)|=IZ:gٕ,n+A(Ƶ+UYNI[* }*O7j[4hzr/۷e[p?ڪR_[ϗP-Az>'[bz/,],βe<ይ3`9cz>'[f}n>XkYep-X/Vk:OKjbYee}ڲ,[$βKsEUemZ|,XUk ` K,[dβKsEEdmZs` ˰jb~}owIJk-lR8V,y( Qj7T" K`pX*gي9"|^dmZsō?’߰TβK XҍE|2{/,EﶵYekά=[EFI+OZxSy:qwZK,[ βagVይ"k ZVGv_Xmk-l79YQ{/V.Sy:1t K׻merg߲3+jVQq >h1p9ݧtbZ,[͇lǢ|Udmz\èZ \G8CWݾLV[&aIe+d<a(QTN ]u²>XÒYbvC_T:,\r1r5~8auaf,[;X/XDF5 Y'hXU]v_Xk-lR9V,y("k|a^n}4ZsbT//,Yak KsEb(W{YЕ^{/,EYbe+n<VQ>h1p9ݏUkN ]}obI6}KK,6tYv( d| {[dV&NVѾW7,Y|2*ްU6, KXG͈e"}|̊#|gtБ,ӤOIX лme!ˆ>mX<勭= ׃ ˩<)/v_Xm-:βK,[$;X[EV.,\2,X|}aYzaIȲK,[d;X/X {FI+O SyR,_X֣ZKF-X gي9"|3JZy|b<<:{/,ITTβKsEb=d(iA螧tb,odZj8V,y(ይ5`Vq>,ЉZ91tR>XkiȲK,[t;X/BVkXЙ K`βE,[vCaYˏVkfӝZsb| K`#}lo9Gb+dӝZsbXotZle<ይ=j|Z Nwj͉c[ >N}29|݂:laS&+԰j!KOznibz/, ,[%aI |Paiz wVZIS='ʓ9޶/2XeJt,Y7LPr>|Td݊h]ՖY6%sSաGR3#E*ԩ iBZ!K ->}2YobዢwV[ gً PY6?(w~d:'mB[(|V`}R9V,l휇b*L+OTYSyҾWjjK Xg߰sj)AToHx,{,`s&gߴsjV5dZq>ll|>XmeY윇#|Ud Vk#[{@XF~쾰 V[&g٢(Eb2\>(X*HT(/,ՖYbIe+d<V5dZ|b`?A,Gv_X+-ISX2gي%9"|تL5Z G7%=v$βK,[;X/XD֐iA}?}aIoX2gي, K XD֐X-z, X 쾰dV[ gيqXYQ,E֐iA~N^ov_Xm-l9V,ά(ይ"kJ\èZ N< Kmqg߰3+jV5d%a-vTN `ݶ9V}lo9Gb0}*O't~>XmeY윇#|Ud YkA>Cs~2>Xmh1Ѱj͉߾쾰$V[2gيpXP,E֐WܚbZnv_X-Y`KsEb7[S,֜ K`" , Y`ivC_lYC{_}Fs֜ K}Ґ7,=`YCvcᱤ7,)`ln[mE@. ;_lYCF}FsOĝov_Xm-YХigVԞwT֐帆QќSy:qawjD.2toٙg]$5d9a-n4TNin`鉿:Lݶֲ(xׅ?0MV(Xkɔew\ YJ,+Tʲ-w?y]eZ.M춮ݠҷ./,EJYaie< j+dT#>TC1ݏVko] v_Xk-l)˶0{W[!{U6QNZo#e7a~y?u~˿yKzz/}K'/F= }|!;04yrSB {̾7×*{Wat\ͫ&|}7|qm?BYNϏVc6ؑΧJ%z )3贈tD4>BOY>}nz?A]/BO ?(t=J,.2s!?@xyOZ юdn3]cp*?_^?_BDRteO/O_{]7~~o~׆o~S.7lM+J5{j|R?~' endstream endobj 38 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 42 0 obj << /Length 3786 /Filter /FlateDecode >> stream xڭZmo_! 'Br7A 4mHPMc|%ZN>wvVr8Lgg!zVqQ߯.>f)Uj¨׫>RЍVDKYL3a hwr7*JTfVȿ9e^32EmLʦ+BWPe ]3OR5 K5ZULjOYY0-_⛫.QL`w }fϿL~7+ HwFumg?^%_j\Qkzem>7(Yh1άBh}U3՗B50DYl'GQE lg|Su\Wn,b_*L ]*J ƨ;5"-tј=neLqguGrsb'$\\MUNcd3[z K $ /֪y,"M f /tGm'jv{?Ƞ9U+F69X򐞣|I:`iFVMQi# ITx D- IwtЧ}(4Uf* ce,>h%KX$4+T;N5e)7;_f~?A<~)9$Xv` mFOMn7To_S9,3dRQuQaQc6tR#)T6EPt})`R5fb[bG7RAiYeU@y.#dUԀ6|`92AeS#O}#+ت&pȪSI<:M.}'+10`nsPvGMNTzy<<6~2:X'}{Y^С 72^oϬ+r)5ﲕi-'.Ӕ_ OJLx e1hplp!n݋Rcs/AhK L amcNi (<|DhC0]j="[Yu񕣅-.1"aH`-Ǐ9nA0=ߵNQ!hz7܇JБxցj{5NԨf>}#aqߠ;I? kʰ7-nECX ָӝ`iX"G K#xt<%D>`Ұ<ߣc&zy7Pdkh*^{v4 G5%IKCo|//h|3big"ՑcmSkN"x!l`c>2,?EM3B꠬Q{Z΢' /ih]ÁlU2j ]^㪲I % |#ƅE4="IH;n}R0` Zii f1(I#PO<4l$[ QMoF6HX8ufkP#:X%=|XdV7A$F3dF#&R/Y4_*\nes>4&FCgX{-SQa1i PHX3k#3/ T<M0b^-=*~b'i:"JBq#k#J-T>S"Z=V$@7)^9CрEӐA8XviaJ(M;:Duh4*1g+} *fY N{gܓOޑ󵔚RY"_w̆p !F$q^LLG#^_NxPZ)aW)ʼnl$PHIoœ#ؤ8AҔ9+Ǵ/SjlųKgPH}d8u g|1D&*,Dk탒CDNLAܫtG%8tpPsB3^ċCCAK 3ISc%h]v!P 뱫W62Ӫf A  ;d]30Yf`8iWF&2 <X3L&҅pC0]fwu(<^\Fd9e'間E8}U@29r%`+txۈ='~OiNsexPzcoct,20Xr f"nIN}Zf;P:$t&^lTUhIc s `0n4asV,؄"9RbP [ oG'LJU<|)^Ҋi,E!8p&V2BpǤP"8[22sENM%]xpi4pc3* _DW( %Y$n-_p6g"Y8 M|\G<[c7VVO2&BmO*/'Qd KDF^bӔoߚW\Hf3vks~LOԫ\mh=K#BXb|+Fc!v!D3TME9nzسS2͛`(_` <=m|=\R2vV04& H9weXX~ԉR#iDr8<6$!z@F.=x+1]$.5>.r\9 QgC[ɾ}.ml`vM]C_c[4/k /13F+Er/P"h P /C 5SB&$e% }0B_lMBkqwkE>O6$s/CKv3mdS U5Py7|aX=b|B硁i($ӷ'u6 w!BʧS=P@MS)9NYTrʧ:"깲W ҩg*b/%*%GtG=L endstream endobj 39 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-descgroundbeefplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 43 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 44 0 R/F3 45 0 R>> /ExtGState << >>/ColorSpace << /sRGB 46 0 R >>>> /Length 60075 /Filter /FlateDecode >> stream x˲mqֿ_@ѥBr#l D!"-=+@ `8Vbd55?#/}Kco}V͢ï?oW?ҷHϛҾ-?VڷQ_o9~,_Rۺt_slieo7z_=??~!!?_۬u=v/ljps/5}kixosܺ/{_}o>u j[/Y/KϋG16d.[%[tٚƫϐ]&F=[ /~TGZ^.aayĿޟ1OBK &p~ z3Gxk}˄-lO5 ;c/۷_?YmzG?={-^|6ܥ*ј^ԥސfO?v-37?p}~ǣV;3w}^ygZXlv=#;lC~.H)9>0ܞBp945yʙ}=<:xo-?0l=_̙͐#? U(|;˃\ja}Xo<suOvuc~?Y?bwe=3u}Z)yOf_t5sq?7dAsi;z]sڳЪ˞} 8=>zLU?_,cm֬;O3՜Wb{^ZyE'kSkiի;͞?Lwi!)yf3G%Ƿ~\\_=31Y0;33>Ц_69۠?lvh.>Ձa4|$\ln7Y_g*8<8`[a-u?ބ:?3l.gz U>plv˦M٨fFe[vhЁ0^Y`sLjҪq'exR6f|N nBȮL{uqV\m38rM9E݉0QHg!@9(la,X ÿN9KB3~ s9?s9ï3? 9 rz7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7  \R}7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|7|? ݫgzi&izϛھ)ZƱ˱ݜ:{:6S;rm-{񩟞vv̫FءRd@5 OH{5u֓`ipu4PE̼Ώ*9GYskPk](If9 aAK܏E>΅?El+?b[[u[}ԍn;Y.=޸r!ng>?~)'UO|FI~mGn߲ySU{[j1:Wy_tY"Ӎ6J}~X{狺6.#}ϏW|_G8b7ǿW?fW~˿!3Gto}ϛ2,p~5$k{f3%2kRqY .vWqbW~?u|ӟ?~1@[o~W?}ol7 ~sv[n ^>~a/Laiub&</׹/+-\s9?P)?|9rr?枯Yklo7?8oHVuzZ`~}]S0 HyWM5wo&>|3&t&?ϤIǤ<_e"4Vg܏uXvO|O_ns!Ofiե:+~V0_'feOowg>o~݇ן~~^onGWgJy9Ym>GY[puT^g6q݆|EyyYٗ!Ftokͅ>ghz^4%2k}VrnCѶwKMg2y.g_3G,ːwtY"Ӎv˥cm733W|ޔvsixeD]5w+-Y"ӭ6m(]wZbcO({ro{*1QyXxr뙝Fdztw>]t믍2ey\d.v|ϕ)Sq_g19Xdlw&Y"ӭ6Jd6'&vQ%%@)x4!K\Sls@D[my.7@+|En=cتg`7ž3. g }+#wY"ӭ6< f! |Enzn3n?E|8K<8c=X[١'0 S;)$|^yJ> |feEIvǞK!5_vAnMLgr~Rb]2=z5Ob~粎J^'rr݆|EnݗtK4h/3oJ>33y0c\mg+~=Sn5)!.K!5&-5x:>3Fʚv3>m:+u?cFp!QS8u_S<_vAn911"3\~/zq&ԁ '0E&~h{5&r0Y5Pϔmj;]8qWrj|IZ |k8@UO>=zޛϛϻsՔWg 9) eB-iEu݆ᰱɧ]$W+yCcce;ei?uB;c~ ~uo?R[/Sr)P~v62+-s}^zG<I;<]ԑi֯0/l ,݆+ZAFɚmqmÏtKଐDW{A9M9໥&{;RlՓy/]mrğ|ޞc_rYXK i'%lE8Θy)^qy-|=6.j"IDrŗP$ؑQ.YK( .m6[ὸ'eٷAZjងz>.Bc(+dפWt݆ӒٝnͶ~YqUmV C3f%}n6J9څv݆챱ɧ]stM7}35uÓfJC(E3M>m^ }UӕSڙw@G߳*SHdSVW pY;6rŷ_nzݻŵWN/^34\X)(՘(;dy8kvQ;g p/J=NփFr Yr-eLz;wHɦc6UM>mwLöe8#!^i,wb$MS2p);-X_i q\uS~"9](SY&ك&wrn=cf77Aζ tKVCV]Vԩϝct\a |NsPt*grE0Ǧ)՘ݶ8ǽy̟3q^g%;+E߮#wnV~m7~^<cEΤx">JfN#:ݡvhLpiM8_Z Y&S2o@ ;L~E~:mUD1GiξU8Y8vmO ye(vԛsE`/%֦ .m}wF[Ry$G=gjn {&>m%b\MBw0n)~ۥ~K>тR&}`m'% tiI Mm3י><$%wAyO HBu3cpBV(A˞g.t}%cvQnnP%3m}sy \Bכ0.8Y?4rZ Zl |KD(|¹Nó3gqߎ]hٷ(vlOvts˸do㷜ؒr<g8P4so=wYGo1J[u&vQ;I'#`KfAGeuַNNuY)ͼDmHK|E`#H9W')AgRLc+B((JRls%YKqp|EnE_ŋr9Ҽ` O(w۫߾[.H(v& Nɧ]펍`*eA76`桬P7h3d6 BL65d_ozUٗVC|xrtp,QEQ ik.jlieoxfRYHy ُ8,9&x!K)lZ|"2 cOK!b7|)';\'l6aC4}ۺUcQZ e;@Ub,㦘6NSHoy Mv[͕Bpkqlieo#" g0JFH[t&r`ofd`H6/+@7&{ݗ%{ / /g,<Π"^_xa}3>D hᵜK w`틕MxcgŞXBZ$R%2Z7]6o6]M>mܜr>En5,IP|U(H84lÁu8p.vLJd-iBPc玖 =/~XoNYu(ff9R7NFJ >m{"QAF$BApC%b9:t Gƺt_[me/FkѵkMG7,f+1{ho.KoVPμ*Y{]wYȾrhDϛ3+WQctvU]xJPr YHwJM[j-g׽/ )ö8QM;jWZ@Э6ʲe/u}%gli)eo#4YO{d,W_ ׇ+I٪Lj2#$Yڥ.g(94А3 Zps:t)hl(KT=(IbC]w?,=/v_"'JYɊK/}S(sl,/j-e)N|N]6;y*&vQ @ѐߋGqi8"-Br ƂD%B H~lF#u1.vk3TM O_IlUL]JPF%2O!kӮcO({˯\| ''҅;(qYG57\6U&EY}1:6y%gx24tF+J@:"%*%˧Pҥ;kcO({si@B<):آSZםecg/}1:>%Zt\)1>˛pb);ΟvYDNI5dJѮVoKSbww?lf>j)jvI WNY'$[콑'|EXޯX' l8wbK`]E%Ku 8Nr|EX,b{%qTQsOP&~4SF QxGىp/.v_z Sr.)΂4ZFλ@@ruOY<9Wc/ bw<%(挳@ ^!]DJ}V;/)|u_*U(~Ђo ٞ we"q#(#Y wݑwKsb'M[jЋ`Q;2ςyF6  x|[rVטy܋ZzBLg/Q]XMX+5!,:(FYQK;l> |Enފ$,_4N:"x#_a0\!)_vjk:KB^"tvY< 8(+Xܫz욯lb# i)(qKkyV=JsEd(C5;JohlJÌnͼY>b8 ,Nw ]e'J+.v_!ͬj gDUnVƚaЂ?p.X[=X٠l{t/.vVGDȊXMɺt^uZ7;eۏ+@a]n kxj|4/v2(e!8Z8ڛvmߒ\֑QH1QLw= &vQ)<9D$Lȵj =\"sz"~iz4&Iaz dv=鸐afGoE ~D5I.k`]|㫱ɧ]׽OC8ue2UH_4(GY _eu}:-[jݑx/>l|>hHB/[[~,!eGىuUEtL%T΅) ub%hA,JHwP.v/X}/_cتcx'Gw.JQHVmrȴv}}~56yg#6̐(xmgU\TtqZV^Dɣ;HY8첽t6/ʞ[QRTZVXA E=;sIt/AQ7[%j% ;C)Ճ46ݱٝh. NQ⠳16k?=db. 6ߒ"u_w͍=ۃi(Z4\GJ&fh0+]Zw?)<;o>z$9wb9O**%znT\Z=ѓ+[5X̟nZ%l$G`ZFh'H@rĮ15mc9_R|LՓxײ2 H Pg'k(GZ#Ňc"Ň֘܋ I;) q}`PȝV#p0S6PJYIR46 /viC~NF3ૐY-e-R=tcO({;J`yNǒ"+hz;,tkMJ.[tiԿ&|ūMd'c5y=\BHnenUsa_ $,jI\ (:vyɕ7U6~SRQEDtGĬ&vQ;qӝ&P5D^ B:ǵ.']躃 /W 'H7&vQ;\g3wQ3OM^&F$m'Ys!;{F-Mݗ[tVEAY$ɦا,n :򣚪ÔBv)t}>}l7\h_Olޢ2w)j qW; Y-",vKwTUX%{ۭwBgyQ;)t 5@,p%N2|BVF)lmtg6klieoy +mEټbF̊]T$ѽ{E} QjhR֪Vɧ],S76j#渘ZHAQ4%j(JE!ezT&vQ[{Ce?łرʣp"T+|DD9n0.M[jݑDZv^߀ӌ[u~ _;3-D-2zVMF^&-M~cqӓHm`WMoK' mF ^}T 6 ]\\/dUr?/B=Ro+5j-w>rES"yg5tJcKk wی]JI3خ܄.'\pPDZvm-G;rzzSa6ggEWtK֑RlAuG. ЩmUa7uoYr-#Us<nmw̸j iwS3lqsE.9t@`O 6 15mҽ! ۟9&%(5*X-b1dR8RTmoMNg\o jA1Y!_N~M#[.Z&םߒ&vQ;BHYXN2bagF*9'e8,t)=JNH->-W.eZ!T0_"F]^uKiW|K뢚FuAYeu.!-&Ve+_ul\%[ :}mYFQ68u^\MX5}dpJ!.wKu[JCt"BS%bPŎ\p5h zAwlqW*"(|19ޔ̊'ߔ̶ix"'iO,AXfrk?=n%d',6|E(!+HF}ٹ>b"k|C\֑@ Ǵ- 0ů&?pv!CE51~tn(=I:d`:ıBrIG5)|%W T1|1Z #Zؓf7|1ؒuiaٷ'躣ԻNZؗKâ-,brgSg,rKV S\ZX3v6V2QXu|viLk#Y8AᚒUۥGM[FŗNq[\,J։$a?ct5<|NIWwnQc-B=bqRfaZ)p!߲S,QNeV<β觭뒽W}kO(p㠁g l .SdpAbPO((,Y4{ѭݧEid_s#&z r 4'܍ܭޅ-@rESKGטݶr*83ϋ`GdW0+EnG$tEY`>BI6 ՘ݶzhOHXpf~pZ<#[H rOH.[`j-d*J@̐:`P\O @Grwn["p(;_6W5Dk|E?)h%b"F0ݑiO͛b'qr򱁴am)+";=s٢ Q]"cO({2 "ȧG,Ss<_Ί9l,{R2(SpLɧ]Uz+02/} -56AK<%ycj^A awO']  9(-0^3\{ ra n[ Gדy:PB /IgFtW.)),Pׇc%Lh-W KV(%fGs8dNˑ! n`GDTA7turZ->-mwT_z~ C,츆9\& qAV0K.Y >&EhLpi n[#g;0L?i ՜CxE[ԅ[Me*E(!Q"BcO({}40=ˤk(vNNj > SˈH$]Q/9K7/PnKsbw>۫h˥=DM&TV@<%Kx?Xm.hDSX =Twຍym0CC`H2t.܁@OLw 8] 9w58\ZVg{^;9MoV8Ⱥg-{#.i) j#%guyw\Z(2B ó b!#9ml T&e%ksɧ],įLEA@V]rHNuIg$gǸP ;yE9M[zd_yYw}ޔ\C`5! PM/4CAfAh|tRP=- p  M^~ Tr?xVU ϣV8A5>~ =X`XrBl D %∂n&HӲ(̭,R;R46>9m]`=mQB.RO( b$͓yi89!w۪\S柄G hU!uHv%نCnȱ]};IMzn7&BrxC5opcQ,E-;EK:->mζ6OD]{pո$,Un\pKC Q2\ͣ.DcO({tײ"XZج=F^NXp6m.'0 BWמ\jLpݼ_mU"aU#e ̩i[hlۻ*K%e*R*M]Zr_cliR~ℵ GT‚h;P'9dbJtn#%㡧,;56Xex * BOL>CTKcƸ*!`DV1kA+wpl꾕]V݊sx?o|7ۘ&mOPc+cD 'l5. 'klҒeANS,Xғ.DBh;[UE@Vk!Qz|E0~RXڊ_V./U^-$HG5LĤR]M~7/vGьF3\ɉ?1E~fy{VqBr*JJcCZ%yGn%$w$&amPA63U%ȝdP{)~,}1:N4CJ6&#aVmKO܂o%(s#2 H7wZrvI;Qۑ|]*YD|ccT^Ǵ^%&eç~_#mWcO({ۭW=)k%%],P+w4ׅ])N64 ٔ]ku!-k>mwufZ1s#[.w\Q,4%%ߦ$.'c |9m<`Qܘ < /jr<&8F[E9\gNzZlטF5&bkNi*i% ;wrxh!B>/䰦XqvUXۭm>CnNH(NWBE׍TN`,Z0JwM>mw{:)HUC]{Ol,ϗW.(KT:)Z-@CyS({}%yˇHJsCԪ<y: :B.E eKwr_|t}~zzs$Y^keѠ,Q( eJH/vQ['PJ#s Mvݷ-O*TYϔe I%{ a.)'I Ҥ զ[g?:Ҧ[<,ۡS.cO({E:'f[!aǛ+)%);lBi=N§ɧ]vM[$4)QVNT䚯Frk!jQ+?Ti:Kh{XaCV YrL2m\+?$rđpl|t[l8[,gPz$wRRW[n56YGWqfۙyQdc_Ֆnڥr`cHlkbʧjZ qYzEp0Yrq9;Vo`1uryednv,nib svE.K0Av∱^#Fcr;/<"SB+g:ɫ#| tlu1ury5NoXqăn'( 9ۄ|W%eo#6Ct;)յݱ6KVVd[`kz>"R;߂%+ԢSR u~; N?!U'v3 ;M/JnYDz(,0Jwi.vk=rjmE WKl*yxxh9l(H٦&^),o|tg/-wKM[eL;tQUq(SbCn9M=(GͪI8^%jS+gnݶFx [(*(F+,e2)[Rב #܁yR)GUش] X:ySڋO'WŞȺn+U7BѬ-('RV uG6M[jԣfr*BA CC|[vJNh`r^Md|%[lo~LWsi n[j"txzDΩÔ,/(7Wي\)@n(ouxTqnCj-޵cKk w1''D?t63 i5zRVAIeSf[|Aҭ7c..u$A%NH3oɋdC =N;BM K:G̨X88cgTPsD-:H91_U߇ܷHiwD6|u8?'u5P N)=d ZlWy-M[JdtXM]Ed]/r5q-BB&(J n"}ymi_*6֙( Vv (C~&_F`6\u:(VϢV%_Krled_o.KKwjl\O;*Q0ES҆(8[. %])Kt!`^lQk*E F`N]9y \emK"fpЅ4ˎ^%ޠX2ZJ]cFȾNMճ-W^yzB-JpkƋE.m]NЄ_'Yh]xn }f5BVDRUYMw~iľOKa'3K|ɇtbM"D6ް )KE]_rNg.vGu:ڵ8AJc3rtWA4Y _eq(@v|ZJn=cUgz_H9E_!.<:Cdt}iÔ- +egJ>-mEbV)VSޏRgz4eޏ(Rwd]M>mw>oΕ--^1{v$B:e*ݑ窱ɧ]펭dEla$'i;c+_YI΁HP-{3vOΟV7̄Ï /7;[cq0hmwdՔj بj%n[_Q&&{@V`Ehr+.#,(ҮrsiMfvi@:) f-g+] )Kv{lEYI86 /v{)IP)nNPPU.3Bk`5z;J,^rv)~15m$36>} )@h+K({} JN^__cnYr_5靰5⚝lFKor jw9+%^KcKk wm:FT]CT@s6U@s9<0Ƌg0]t,gHwTWʜק˒ь~a3K0U) hdSult,FO [ZΙëlIh`+\Ph,>z#J֑DDٮi!@u.v[oTy[̺D_`dSS,-JWوvAF3l@cDz% d19ՒQ<#*^!˷'Ɂıɟp=MzQo-8o3nh%Kt5[ldGK4[.v<RQx%+n=[RDFT Q4nQ}c_mݱ-dK}[XQ$b[vkY~Տv%M-76 wjRlmP%{5ԚM7H g[pݒG#&fP"6,5Q@UaÁ]ji =Nٸ Oq9G&Goy$.6چˢt؂ςt[ץ[iKR&S&$ѭ4Ub?q:R(I=)K8n .v_+fs.ew|7@/E >jlHUB( ([ kt.Ⱦi?'=LI }6t%;bYS9T(\K4}T1LŤd_ёR&'zȫT\]6o$Cwh[|4/vG9eIw4B|%(T\6!]/;)I\ݑ$}2Q7g i"v!z JD7![0;=C+\qdj_-+JD*MP@z?Q~F 鸞dЍB}/vG )?sDbFpWE-l<7!!HϘ(3$ilid_`H wHw0dC @0ը`H; !+`Ȍ5] P4?\[s\ܢaA9Y6AmGq3㼍ϑy X}?{DSiM>mwd{ojQ IH_ }Y.Yz'H;;ԉֿCjۼ-MQJ {)fa[KD6ӌ #(G069&][\7Un`UK;KPP|\&C΁[0?ahZhLpw?\lU*f*޴7t0$(.wn緌#5 )a]Y [|#Y2hDٶ8~6-ZNxVP]tYXrE$鎶J|Eni'e q!ʴ:J$'{u+Qi 턲Dk\b'o.mW w |Ey72QV̼Y0gUmqW6ǁ"ůAI#d;|2ݣ&R6nKbw7-,JAޥj مb!IY!zBk& cA|E) /vpS}.3JK*@TCv`F#Vt|4/v{v)ުQ Spn 7qkIeKreKZmb(wqVVjszrGdT›nE]!!D^TjH]VhlRgw +mwvr_ p% j)G®dpx-T?C @|EHd,MSxDs^k5dZ s_pzQQFi!%P m+m ,f|@/ tu"Da\;#BB'g}/nrYƕ(ɧ]*79`X6.$ѨdDG :I/>ql6u"PzQ6pA[co@BHW!+T pUIX/9ڻql"SȾ9,ط=!%`e"z6jpsk埒n=oq1ur5Jt`+^*N@KX[h-V)vz줘r'̹ ؟rLpiMcǼzkJi oҮ6])ut]c)ϥi\&)Er6&-'Qi8leǝzPك&To=m-Q)v]jFcՌxC~VRvݮuOGyu]KDqJ%%d_fNFF$}]? 6|bX lZ3do45F5y#P 竭W11^SRIW֮'f@t3K֑ J0KwR;|EVA\B! R۫Y;pS`yS̛*9=:"adr g=}I{c5KNZ(mwoMŰ'm&wg/DS( L5klieo}-Uf^#Ez=,⌀3oݖA9`#K-ڴԘݶF)f&(2P;<3RO_]Шoۂr^(qűwKMzMhQI& @U ~#fLDW)xVQd[ NZ8=mi_G,>0=нJU%n_"*-3x ~XX#w¶n Za^$#"X`Mہ; (H i$iIJuzo,Q|"go꧄&LŠA)*$]F+O5!53rRND#bʎ0^bWzGYAJRrٌ7u0-MۛQE8d%$J @$!e*$B]$&vQ۟;%ë.;SIVP,fE53#2iG[RDd·qH+ى겷ў3FGBu*t+؛s:)x *A[˒;klݶayA-) Me )7ctKEl*{GEneg,,Ju`Xȷ %~ Q(F+QVc|4&PM9c:R(>ǧXėӯM 3B7&wKSb\$Hȱg'*=Ld&Z +,D{&M>j:/ Y1# n_mSCkRVx¡(8;G5Ay+d_}yeu}9)Lon?eA%IAv&a({iuy,MpONLhCDX"AnT.fr9˼HݶF6tXuT6bnvh3V#-oZfe0_QJO[Qj/ |6C `} K8 :3>Z%Q2 (k9;{̯&vQ[喿XfDW}OɫnD8".Hբ d=-]ɧ]WBpt k^S~qdsY`pt'فoϡ Ldݑ𓛠x^̠<}l_P֑f dm庛56zv[^.jXQpXWξԚ&IA9(1RwI[|docU"*>Yф^ؗlwi-pY uc+gtpis`J!9EH);@ 9EYe肒wVjF+g-\[29HYsDPM!Y2#u 3%XzM>mw:G9ߧ ;q_!c_[wmrVvQ[_ɅpCD)(x*E={B#BbzEc"M以G+g9Ş 48Akz' q:JX5p> ge$.ȾT(LbgAe$f#NDND^"3Wt_9do_xi<9MJ/ pN>k%$rڃՍZ\7/W[њ"XUk۵ ^(m$Gд%J\u]*!];/II^H*h4Mv'kw?Mطt%a{`% f0ةZ%n{N'T Qmu8XyU:)IVje QX>>o3EN=au.LCESc,ݜ ڧ4nݼ~t++ݦ1~-lYkSXa7N+zi2ۮ1Ap#ɯW-۾RyWi%Lcޕ=mh,dމBVM6/%HR "-!kSǸʞr Nk%hmH ~WfIZ xzCNƫqdO3Wl \PZyZjo#( )HbUy=a7 q%**Y6QP31lyrKŸQi!O 0ƹdf/2wD yEcֽ;K}ЇXJj5 {SkCRb/a<(W14/C' (/h/n6$vvX@Qk8joԄ`Yp5`)>t/I:'ÝRMkxdqڐtNkI췟I=&>* .md%[FB{Q B gZʅ{Jo˾oACBH,s;VhcgG :5RAKIZ` *븶ZiwO[[f&W>[E:ឯ59` CIlZqvҪN|=a7e_#mوWgq<ɴ7Dڴ}f`GX'lk0EhV/\hވwƈ7Cyº'rj-(=(i_fQjCLt4/4[BS>+aw>T[1>k/Ži_ULo+M)^VCad-ztYa>XB]Qr j!Cz :5 Ps48{p>9Y?(-[Rڞf c<^J?6u)dTݸ4xe(=-H[$ 3+ sڛvU5_M z ^d gKkv {C2Jbxr GpLʌKbx޴̴̬p\/Ҳ|8BYKlPN97C^Y4ORtF?4"{銨]aBnKŁ.ۋ4uBEJ*+zZVaya j§H6Hzq&,̽y4a*r5?ChOkH(>}IUK {`'" '.V~ЪS +.|);X 4컀B`>Qi(t N=_.+Z55Q{Jo˾;0iPup^9T7"д 4`%Elh^L}7~5jeww 7=]$8 EQ(L~- -I+!.' SjX&Z;*:_/1mPXJĔRJL7w@,;|.4S $n @:XJ9ة±\{B{wM; Naji&ڕ ?b) 4 l֎~#C+>&i@|6]-}inSh4)ǞE=E6 v R T81LMISÎ೰ E_ LcQڐ-n ~h6ۃ\8FIiW+;>ĆP4H `i\ȽYeXp(0خ9tM-l=.¼ NpP8SkbƏtd<2nKD'jX 1k<ޚ ]6M}0< .¹\võ)ʲZqp< LicܓVwsjZUy T'#2D|U#QTc|Ř_C>f2ǸfxM+.Ű^n{?gYX0н<_j WַH88=k,^Q?A@0[]I-t|mNIw6pqoog(`k(KlTZρNS!0"Q@ ʼnLqknajդn{ǪUX pW,k ,݂R}VxQ=~X|\8 6}'쫢ɨLNȃcjSwbKm&#X\-o,KzCn`6W=~$R!i0OU~Gw8sٗj eTl/$]: z(,ۥ@+q6XD/㞰ಯhGsA2-Ʋw9GleJkւXJ?y#b5hmH a R|Ӽb/H5L83pUZD{Jo˾F Uݣ װڏ$HVXIXc;a_~? |)ojӁ.OI6m#X'΅mSXRwKkuಯa-55R*J#AVK% GaC'CWg=a7e_c0HCe[>4|`ϬVjJ3ϰ XJA'}wk__{x7~rŮrE пOIRXyPj468HFZ(榭M^r&s$\D]HIoXHX[o .@]+{NO~Go\|Mn3DF5I2ٍ˱F- _G =o^z$E5a{=TA|%JU+p2$v-y8b`䞰{e죅h/pmSo"MUԝ鸮iMX8ڔ0 XJMr9Z{9I^N o,zI z}mvnt,=zX1c;zR ~/ƭr؛wE)#`A~4J:qJmZ{G%]~wTOz/w*x`vF.SvJa;JjfAuɅI.ݍBjwV\*h4j޻,4R*K>U0 }i%a~|D!ނȗ`$_^\uD-sҊgj&j􉝠6+z tŝ-Y8 'kWe \W."F!|HioZ~VE5ԿtIOWhm1R]-GXJ MŧGkǧK{6.:r5Gfщ]Ci/t+#MOֿǶiU_i74'ȭoZIc-"ݘ?Yci 3!QdM 벾a:`%wh8Lapv-xco:~w|ə S!PtbfP~̓aTi9 wGᶝ#z಻!0޻A⭬Izc^0~}m;; Xyh0o}@1:gzc lA4hKĠAh}ڐ𯱷Τyۏ-yWB-+Mt$}K6ȮXI= \Sk`/޴l9/e'k.4y 6W|))pw؍cȱb4D K7?'""wq=G)^JqfӁaZ{xY~w7jJW6$TIa{Iq8X@~C޴/b߼,y Z0-\9ʸ ׋ ^VG ' *4UmU\ui=M!o k7ufhZCj /I {T_w؁V]p߄~;EXxϖ.Lkfc^T+_ EthnoE=n!q.؛E jQӺ}܆SRLg Z/rqUf-p*ӸhOXݽ} SV61'Z%.Uӆ*ZԬ؊X!׮KUCGfO| G|)0dZe0vX'*osAsܩ!.5+*oųJo: ZZ*puSE|Rwfٜiu pC`,iE8 S:)1P8 Ԫ]:i yc/_L2bP'ّ}rxhl.IJ%>I.qMjȀ=q<-;=%6I{4k %%W׆RK}IDaܵvGM;"6vvj䢽/2%yb!POX#c]~1Ahaj&Yf%-lEñj.V4q m[vg︻_MQ}﬊$Wث }m];.!viLιT /EYl7n{cIRR VoW/h^{wsׄ~>_& fy$w}MXJ>v5r,Kev*KіK) g Lߗv|4R1Avĸzc^`vEl;rS(=1'VxBʎR,k/?_{x=Fo~,$sT9t:=CPEBu,&f{^5Eh [sc}%_of1?7;bR cAE(-xRp㖹7 /4ǭOdNkN.aG.y5Ú._ۙ}oo}ɓ\s#mA9Ǫu&MHiGhIX|pSC,'p4 k4^Y_8{! 502 3 ii`{$RkIXTinM{ZΏL^8xƍ "-SSbT$W1=oRɹ#Dkdܸ7i?~G^ #{XӅ mIR^n|``%Elh,dv*޴ejډI@[ciHaDA{uײ5[XJ1"4+kNewO;>zKnOTK"6Yjnaڑ޴/`gc\,xX=%\[1AXJ1;N0 ;^zbOL_~W_(^\}شMF+ @qо \Ja*Y[VhOX|1j hÍj3즹^gڻ8-9eJM+}bOZ qW$-$X+':ڋqLfsW'кD#ɉ */_k\Q`d ئ[cK>MT K+U!0c}ܰ=ಯ++hNxUˡ.kI/_sb%zoZYho +>c6kK,pe1#@ҥ5~@K:Jà6û6$޲/bYYqn`_CWLB vR4%AG ֮޴/%w;`;zj^f& _g5awIXJM0k7O=hoӺ/QXQKqec<ٴ+th[682If!AUii/ư%~9Ll 64%2vHgJtc.G%9-5 5i_ 6i@Lk+h?cdM#ٱ(>EJ{oa)LДآv޴4H< W ~=nHKeCzi9U*iwOY^lCsڎ",#͆BQ24*llp]#E?8`{Jo˾ЉBcS;j`+&ѾUGK^/@ e׎zM;"6t GX5N/ٌ ]Λ.)H kas_{xǂ~ڧWt<wM'ֆ􏞬v԰` t4V6#826I]`` cb));ȐjȠj3_~uUDzG$ÀF=N=fuzѣѣQy=zOۙ N:Spƕ49aƐ"qڦw(4 ZI8Z"P8hɽҿ}Mg+'md >Gl}Ji\^jL~gij4H]4hHsh@dLȝ-i3-\{D =mڰL(TQwmI_RRĺTR!Zyǂ~[f9Q \=V_W󬘿@s¸Z蜨=a7e_c0M js]35Uvt,:C؅@A|B=}g\(ÞOՔ33|m/9bX)½iwOK[1DNϷLzU3#{XJ𘙦XCM;"6a`.>zT֘ݒ<[Na -}L6$`0l%l;F}’S< nQS,5\4j6=iK:S?R}쥹*OJTJǸXJ'΄Xc)ƽi_f h6ad`ZvTH0i).-Orċ5-Cbǭ˂3Q(>wߛ&kx|{ o˾Fk 1@gSMqNq:f}*Ĺ n*]f Iqb {U<7^q6Kۋ/Cj`HSrrEnmo]wgx(0 9}˶bJC5a7ވRs]*6%;<%6b݂2NI-aomuF`ӂwvS8d-lFd@略AbV:\v7$\4R^7a]c %j1iM;"6n+{kr4gl8eGfw>D_խpCI%̕{oWfDpwNP _$ ;(a4s55&!.2fvT]ius.@ ҿOfCe%ouyta*$gm/Zu(=au5% Ďq3 ҫegº\4 [QʵKM{aV??~+`20;vgi@oV=>,ı$5/ B.5%-4etZ{gM{ZƏgy.KXIF'H[τc)u罔(ko_A{N~)"W}*'Ǫl6_Z! ZQ_O  ūS-ah%WH}`CHR:"̵+CI12]Hj^MΜ#1ZKkǓP{o1~Ojӑ5]{3$O ;;'V ]cG{W~%\:kTCR8+Iv&6ݭ֧W}%of_~o~5}y$)[9fXtw;HRƐf_>ͧg9>LYFLKm!*Rk廔lÜ͎QR^JWJ*lRRݝH{>ߩeSɥf#{#gƿ0%3oحHXI3(ЍBKkro_~rV]BqD"LkBc$Uyȓ鸮E/c r*ވ6h4yc('$m)!_}Hta)amRb#gv ŵ!ፈe~Ur'/}ꈅ=V"/+XTRNݭ(Tv)0Xycթun]':E3[g;2p5׬\OAM),%'Mi]b@$ݛRڛv԰oؾ:Q}+pMnWG6F+ysA}TXH8bDNJ=u.[<YiHf-ºЌXgF ).e_fb# ҠYC5ck{jW`M K)XۥdvӖ.M;"6ʫ*_԰b# 621$8ZU|I%ri)xp#Oǽ_5aPӂ{%b]{6Izr4.9OºԂ=CunEMk'a_f=r1R T\ gS<Ĺ_)lpUc41ܗ4?)"xp#>>%Ww3a)×ZZ{N~3|k'5ڴHJhg.ΣcZYvEl_/~ʥWlYeC1VYczpmκ(4 Tqn/gv pW/kxT/{0oX4KB(f*RĹ%L"%\?8p[Ҍc~)n`EiD).I)|ݎ:u /_S)L$~ydF/#T=p.( GE4ƍC͊U'rJ~P(;McmJcGPl ;4GammZ{x ]~wm5J*i,{ 閤QXkc.ECj͖v*h/P+μce0G ze(luIa­,ҪKf +.*n T0六ҀlY,l>ׅIn'VR3QJU=U{N~Nj4X5L/*k }bpD0ME$ݒ\;jnʝo*Xʦs敹 i* h+N΃bv2Q H7w*ą~v=0` X\ꡫcIa)0|mJ 2'l;~ѵO4WXq;Nߒv`o0W`-kG,O{N~gYbkg,4L+sķEs㐅uDNMVZ;x-7k2ڪM!k/0gXENnV+#4k3}mJ]awO;x>H-U烬V'~@8 ]eq͈3aMEǕ"ܫנh*ߥsACg,4'ׄۚbߡ7=ۚ{O~G=FĚRBg2tH\B\74wK65l&\{{O{;+N^)6hԡ ͫy&mܲЫכgA BRٿMcmH.a~M 13F zN+R'>C] 5f&,1j:>'ĢTksooEbœ$ԔTX+/'оAQAaʼnMj8{}tڔ7eb4†D!!Ő=a$ZH |`ꐤ,n_~r8()e,/Un[}թh] Kz 24e.]H3Q1VVl 3d4a /c޴͏JU|B]C" x݊)kQ) V +.!^%ji݂bS"I P=kV+W'?&=-6Ж6VP+_:@ɤ@¦IWbtVzSYiUݚ.ތJT8AyMa② ͨҀ\X؊׮ьʽa_M}7mEfzZP j1O:}ꘪD@.y*jT<.'謱wb.sssF&!e}~~zn_!%/!Gl`]c~gl`xw;iED&S#ͽea)q,CX M7IGO {jw5ѨE+9qU$)GXJӏ%󵇷hoZ~ֱLw{軏馲8[`Cw_|w[kw_{N~'K|*|5M? }3Ay$E Q!Pxvkܛv:[ {s+uH$Eb@$Vth8K)_ɭ=sM<54s@ڨFkH\Eb]RK â]kGK{Wuaք~sl\M05.m[AUck}4N,cӱ kC¿޲uC6&ƻ 4 S{D=1 1b)4q1Aei_fc0EE51wyքcD%W~{"%=)F]d;]!{N~ i\?YCzc~]K7o!^ ;4aް/`LIt}?|R6{mStKSװ[ұR5~Vs7ǽi_f#@jx(N(6YٰzҎk Hkxp= Ne͞cκ EQ@0H~aPc_!^ c;w\ h{|A. 3kۏjbmxˎa)͠fo_ hwhi6*6nT5m/ J)+D :5NNM;"6c5|^\viHaoFhIlHHc]׎3/W k_~12ϱDGYOAW C-옓!," i^ulE׆v%l;ȧ8T^iY'h/i}ijKXJ+`]Sn`q/ڛv#rRU8ypz.#T\ NNΛ5셪UWp=럋|'R lb`{׭,%IWK^Ҏba] 5['=r+5kjKIk slL*ް_\ghnT\S ; g'AGN +.3=1.<àVbDt$QFJXJۇ Hw׾hoڇkߊT #7,~8 ^U*׌mBෂG{}zKá ,ب!IDuMψ Ki0jRۋ3po y5Jyq$)E1IXJ;TN,CM{Wu4'״)U]a>/'!!IXJS)'RZy]{wX:3;JC: t~r^$` sWS baj@*)ڐѓ;YUUKyCI^%)cRXIkɥ/Vk?ho_~G}E}CA< 5Ht ii!9k&hR#776-g&$8}`%__vF(Z(Y=a7e_S<^AA A U^Ssi a)yk](q+J 7S e 3 F]ֶI4y^zxt)RáYžxж}'p]aؘgT'GM S݊ ⶸ4oiAQzL{Jo˾Yˈ :%qnQU"U^@6]ꔤ(a_M3jI˾o_.4}nE,붣&ԝfPiR3vAɽi_j'ԵtƊ;Qc܁\a; v'N8nZ9 LljPKGhNw W;6,] I @ORSOnql[!)@g'ᗰ4C{P4VAgtIE }2v)=xVQ@u˝HmV.IֵÎ)Ry~[C%zNʹ;҂]}j,W0&I>&syXWvϯ*>8bՓ*B;tT<km_q-IA~LhF1IڶwI hIav RV k̵޲ ݴXXS *([u4{G)ZL*8#Sv[ܛ*/fSY6R~AG$} {ǜIb]ݯ+35 N ܻ(560Ok.X6FXbHv=uɿ]CDc>vvqoڛ;/E0IVW?^l%>5R69i&,vioHfsql'S6zQ$ygi{1vǢhDkGQ}q8oᗮG J%}ݰG%4l[8'v7+n~"J7ᅱ\Ӝ ኿Ya` q,Y)AL8v4*8Kjե} 8h|5l6G|$O"r< Iaañ \9nj3 ϲQ37(K^|`ۨאRZޠw;LZ;H7azrⵄػI~|Y֨+cz K>45cmHz=Z;i?~':pF+jX*f!0V5˂d v{WERڙ4,c׎yM;"6 #E{xhwHŐ^b) i=EavwߛvEl[a|ɶ?Ycs㮠6;f3mpnMi[%,nkZ;ΛڛvEl[ S3peA4$)zJ؏z MP H֎H~NNOK:7ZkD V|_Z :|m0 kA}Rڛ`#KwY`=KwYdX-w>hj6y @qR^B$5b:dZ;7Ed}Mdc4qgv$0lo8 UKrU|= Ja5SpW ȋs$x`(Y!V:A pWa W˱ժc6$XjvzJl[#JAһGEet:i;RR'jf{PĵO:qo9wbө,\CezgT 5OoxOںp먎=sad-ONfbCHS0*N;b|J QY򮊣v;5!֞^i_KɱVIb\Le[TL;lF$NK9L17m]UZt>-JAHA%DŽ{%(4VTHܮ["vĖd.]O4kj64+BL.IwP)Lr3w<ș`C*v*6 RnEkJݢ_).ց 0Vg"pOZ,V#J* M{յrpgfc VXJ)B,bn-ް/`NE"q;.?FvwQwJدry;I+7PvJkϨʌ=eNkre1Cp(SrٯYmp.7 guZu=a7e_[~Y՟x!Z}/t{a ¢v_kC[vSbQeFɚ~GV{|T fa)4 Zbq6޴ӯim~.hqZ A{CgB*p.4X=Ű↕9rUXY0kԝuթ4VӇz@L]]?D#Oi8vxßMI95 uX@RY.Ҧ}KU Aij*6$8w\R0v\Pg@XL /~^jVsfɼIk䗫vFXi+UA4]_Mz%I_VŽ*ea)5OzJթ7$}w ;"6AF^XV8U y$?SCAh{. ۖV8D\v7sŻqr鑤̓ Sc vwB^M;"6͇/8? 6։S!/ V'ᨲC 2(xҪ[ep_de)"(GF N*I_6+a%E+[hh(_i`޴|Դ3 nѣ(R(7KkJ߰o4ERY*i-T6#@{bJfG(PJ)eiHA'hgJ-Sq=R3~{56Ҡغ.j1)b-&،*8 -Uibu\x,ᨁ˾$AԔ(eБ[la?^'C jEGV5h.Kw'Ƣ_QFEt$}W A IQ`u>16ci\;3so٧06QQbqbMXz s51`cZb4#,{<HM;"6ͯH}*v U[ubh h#΅5Oә[C^ܓ֮N|OW3wK3-pqKIO+KZ>a)ESdh^G7a^p@D-RW{B%m@x z'Z1C8V* ?8U[ `OZ qר]*hk5rt@jׯ$C'wB:Hw&챋>K޲Sbߑ5?fTYKJ+A'ޭhAXIQe-Ͳ׿QeiHwd7nMQ׼*JNﬕT3TXZT #컩_2ӣ~Nb`UK9.Fv3A>}c)EhG{:vY8Dk/޴/bu`"W0`-|aV@o HݗVwᲯqIt"?$$М"ʉ XI'Z>\S)Q=o?'Ku@M+kNeo\h~UȜ I{|ܓVz\5Jf7'nUF-6$O ci7 g7wP9Hbm{F_WjuI,tyמވ=6eSv3% ?U\FqP.?M^nE=qD sW8hժ41ܗ$P.*%n3V_}$DQӑ;$賴tSH[J %S/ۦᎮWKLLK҉Lfsc]jqixi=[{>u :_NBAy::8]upv_CLZ 4n';:.ysXLکQ{N~GW4.\yZVA6tj 뒂ԔYCWk)_~%l;>u<¡vx7$7Oا(u_%ÁE.qm޲7ѷw}o758%,˔eG%k+l) OCMYNw(I`r)NPK gA/.L&ɂMG\J a@Jz&)<ت4 1ت~w$bű!5IMg94֠$y`UߨŻK;a6֛;a Y8a/%FP/+A,)lp]ҪҞ,#p>|ᚃi LGBl;%EyX 6$ /aߑH0f~ZDhĨ#E]>*Yb{g'l; + uɂI,HG[/: ~d p#IG!$)a?s{ A@oW,s"N ZߧW.FE`ߐJ~}#*%c(~wtwF^dҀ6a95bHlۻ([b4kb^֎yڛvEl[1+N@K̓JVUCƮ.9w|ǽK|ES>{._wkU!5tŵ/&Y{+$Z {U=ݰ]mDY6RamH|@lO! rTG`*~䁘Y_5Cb]R4Ʊ5 _v˱o?V)OE5_s+|m{4{Q6xU឴{u~(V+^GZuRP .~"΅⍐)ZP6tծXuy8lR>IRE| | -6xa`7$E, j&k4q_~[HϱBacGXFGT 햓t," ;eNM![vzJl?V |Nasl;.-C?+u#\3JӔnE\.I+!.$}VfJZRkIk K)6\P:dvJ\Hh;OQ}0Tv0<#DXDvsoF$_~G*o_`j6l5^ X875rT(q!s%($1kTX3!Cp4A * ܃W1C&8v(ת$/b 5Ui% 錆Q㘒p~*J K)nGbѻ&iwO wf{_PUS3^NKp(ˑhadc)3G,d=G`~3N9cw Cu-n5İ.(gg|vpjoڻNC~ K3A.(;K(#$F,jX -#ܛvEl;Cfyge漩.q X'i$AJkvEl;L@AЗt6>;G[fKiF`5f>b=-đBSCs]]EMX"L [l zE{N~+sQiDyE !2I;#,%,j 0k/.ް˯lIkvt"LT\f/nhfFʎqR!e5M"Ylk~{SYRX ?Hj\rq0>qWug;:ē=au.,`Ja][u1{eV GaU f&ܰ)Wמ쫈R+dgͥ\`!XJWֵ+ɖF~["knjI!c[dDf3:IԭS<$$GBk>vTsN~+xeW/7V]i:۲Ƚ;MÀӮb=ZƎ=AʎE T\+g/WE2M8Bh6%p{lsJo˾z> ).6,DΉJY-)'D®>å)Gu6d +.*j6hxdmVjomͪeo_S.Ўs[v԰H`թ1'D;S%Ig^> )Lc[S'5=9-GWwH"Ծӆ ՅĒv&]{Rޅ"ĶޅsӾu;`u~l!e ){%VȊPPRKqR"֞y;57Qrx(MippvQ:VÊj\vP<ը˹9'k2B`w=byT  H b]A,q*Źؔ'[,n巧M0ܥ1SعZ,U##I!sBls"SǞ7Ɔbn_~y[KA>?h".G' i_(&R zהjOƮknRu}穹87yp)>L,K=a}ncmnӯ-ƶϲ]J¤y ˚cOz H6BjهuIߢ4ƌ.~8{{-;"6 EE}XA=2cJoHuIsԔ c4ܲ/aGg炵9/޸Wݘۛfm:{ujJlo*ʹeGI-u/lW#ԼvEXyQ$i{o?٭lSؐE .mH-zsn/~AԩvSTXk 24ZWm񲠵!x#No79'Qu}e-#Z:8`*Bk u 6k8оXI|U $r8=>틐!F];mdVR> Mفek֑#>KawOwP/ !4l0ST$P!>b8 .-;6lmTVpz(yϳ.P̺ KyDX#švߑP #ϩD@6[oj/ʃ*4QL|Aso`m±V~/Miil%"^U'B3D#l*`!*ljX¹, gnhTVz\ӴޒؖIavXXpa_ n]/ܓb'iTӜಯtSiJ(@a Ɏ>WR`f HB@B=¹a_~XA48jG;0wд!I$VRqд"l"Ǧ])awO[w輸>5{Y>}>MAK/MMG. ݜHsN~Ga34T"IBGH{Vd;sRӷ˚vEl;"Wq[K0`-:nf @/8Zp[7n^[]ͱkp[snWuV46 pmY^~IaM٭%h 6X|/!ig>$q4 kI;jn-~8wLHGg=$]k`%mh ,r#5vNjnz=DXBjPk8Ta $;Њ\5ЯOsJo˾j۾ɒQZZm?M#a_=,i@$,j4M榽D_~C # '%Q**ZxAC {S?C {k$>6%?\S2vgĩ.}KcF {}En;-Ieu/`?*6ޤ e7zuaiԦȂ愕}M6|xcW9{I 0ExKc]w~E= -"6,oWo,7o[WPAhs."µ.֨M{ +1܇)]4rj.7"b)]VhԄwjpQcCbܰ~6\VL#P@znG{8ÌI"Rtf7|9vtܴ/bQc 3WfFVbRO8l9WyjNX pר!6ܝ.I &$ZvCff|$j؄XͮF8䊺k>&#\ɽ>}^U;CCƐvƝذ^^>D=!\Ӷ~'Nh7(3-3ރRG%pְ+ձBoi:Xٞ M{U^)i.6<ίo%H!Kj!kj; UDo61PWayzL*R;[Tr*<2"wѭZDI+P帩Kv^)½>}u./BűGϲNY(Ⱦ4Z ŹXn۹XusWD\KQuI+W$ qݨi9jwZ WZUZ[mRM9`3:(p M;"6~s^l \U􆎞W}/ДX5vڥ_}/fOKwT5TQǸHu]WE.m-|쾞<>6/zvf7TE}nPcxJѤ~ͭNIXJK7( bGʱknpnr\{kWr$aF,^I a.# 3c8u'IqqE9`ǿJp M7ȍ/4vkv_~RE)%Υ_y^݈}D%GQ,C:Ms {x~G~jUcb0AJ6j|ĺdԀF%1՝O見? iQO ad+ ]5&}m%rAs-pnڷw|>+?BTA"A)Nu6Ջؾ,sX.^i_f=XNb). ̋Fa,cK`$R4aEq.E0TN䜃5pWܭbtN вv! ?I;߸*Kie5&lǭAi_f|ӧ Ay:u4% mt,4ԍS'禝~w*A^QPDOGTEG%}iqa?DKiq 4[x46=-S]5 Eu/4Լ!iulCnQqt ;nOU2P4ܪw[Hpa_$Jf VXJ' RVcGcHw{ҀG VxiaRH6Laq57249j\hjAv.ZTM4K/HM"?a!a/kiձ cC_cnVIcPSǧzl6RDA͒gܴ/b,U@jCZ[V%qn5_VRtT{S;ϱƞQs-A>'MQfM7šɚ*nu MVz\5^;ŋ]MŎM<&I/7M;"^scK717cX&UKݎԵ{/Kao2KP~W`s%i鲹a_~`nJRM Pw`V4_T w}liI ېMʱhLՖxjP['.IQnmK)JhAS]F޺a_f9Ƹ |'Xt`א58-{å&Jl8a2+cCպN;ϡF_8wK_ڬg\[ ˚UH6UiNX pW TkNÙ0摤oVHg¸MRb¸`dNGTv=3a!Fvٓr0[UŰwm݊zs+sAhTqS'f>\5' {\w&_-Lz6۫njC ڟRȼPEcTiNXU^x`Nӻ_Zic%=R6\OiK=%YIc+،ޙb,gl!)ɰ_HL!,[, щ@sN~kKbm -Z'jê8 $l;( Kc]_G47췧0#x Y}tKhIv4C BQѨdiNXݽ:>}}?G?/ɩ45Ii^'`O Ɔٚn_~ˮhZH_ͻ&;nǟ}!z}4ֱ$>!ޏbd?YL:ogJ$?AOGu6 !'K'Ze_E endstream endobj 48 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 51 0 obj << /Length 4716 /Filter /FlateDecode >> stream x\YG~h ˕G]zfŮWb<%667&-y*++223/#T^ʫnM]_)UtUnn.-UaY^}k5sU \7=^##_o[邨kwwKlĈ#KO,*wЦf=@= CeѨx̄qX\!!TU]tijXZUi[my)LɳBٞډaɳ?-ģ?%7'"CcE-H1*sӣVveH#jF a\xi( wLLkAND)լW7^/Y#qDKyydYr]iD{eFTYM>b7~GVn9vnt12Kis7nˍI85 ;jȚX=}t2Zdou@6{eΞЦ0 xiկn&ݴ3@BJVċc)J]qQ=k16XUf  r<C媨; WخJNP\E~;K;f_ Rh0HJj5]n|Ҫ 'kɶ }d6C26G]7ivh$;800Y=v>5~K? (S:D8v ~>hKI%+sxKj\G^QwxKz".yKdնDvB\ HFlXw,vcd_>!e!K~ r?"u.b,8[$:ʪ 샵)7'úӟ.Yp1){e;HP%(Ἢ@j02Px%Kt''"/' N^^kˍnB5HBEf׫( _/C|<1YIw,y^x 3Pr&&`m+Q"\!.0s;"ۥ&; i`o;#<<{+ :IŪlx,1) es5:lg9.9xn{ ^da[p`d1(ub˂@&uGx4^\g= Y*>; s܁pn0g\ $]"!Hqjf$a}̢_sz!. 7(ZјU3v)֚xFxa{`+c[~`f[t^S!7X''.:11(If@\8TCFGl|nBnnw2Β7Gt,l/ ;4]~7I+On?KkM)+lV1؇%SO #Jxwq$z4g>ԯsD9Y6tTOKl8ly<->%@D&O8f81M̮܈-n=w*FqL<*RnECrq2-@ x7JC}S_9IKe O=bWɞ +8e^{K]5w \uX8~ *Lrl i$'ԩLHJHVf15OUozj+,=q+C`i&Vͧu{&/c Q湚 #iCԍo\P pr}Iz= B2d[n5j/LQUt Grt} r6aG~Q+ (4Ψ61O||v2DE^5V|8r\&Gtv.]tN9<26ݰrjh) 4(ed!v0@=&<]t z^ u61[[ܢTpgޡJ8LOso}논>P2 x)6译'!T LKT |U3-q)t,-j򪛕Q;OzQ\\U01#DhN$f]Bvu9~Y1a1iP"UNP8rnm`QdSGh˄όza$l|ҴnB:al{ϴGnN$i$I>xp>(ER-))wHga,K|u d< BJ~do >ZvN9cEt!U@me"U ڒdVm!>9ē?S`~~䃶+p⑩B34 W2kSwh}:twރMG-4keguB][ m^$lљ\#<7Ƀ K̎/>Ɓ}ly+vE!VMaOb~&q>(&[o\R/%3hLgoHFSm.*mkK[GO8G~|[dD 60~cƁo=>| ۼ^h'4&-Ѿ,ID_VK)HA}l`"<]4>`7k9?,Uٺ gH:GEI t'p0`#`Bk "֪SmHBUx^)|vßqqMkb14C]ʦG3|L|BYhQ茏0Pv̊\dk,?ğ5˧ˊKׅ)x#9#DΏzTt_ЋֻUZNӪlBR1ct$&C@is*͂( @ :]nBc w,]WTƤItO,]E10Iz+2':[wT\0,BGA/4q$NWj^o4:Nogޓ5rZWIȉXtQl.Nt k0 endstream endobj 57 0 obj << /Length 2867 /Filter /FlateDecode >> stream xɎ_K5`qHVq L$86EI[LRn_- U^}):\l◛P~_sNj"(8]m6xQ`"[/6Zvfa  =I?42xy6yNmyC4>ȩ[/4&?QP:?w((O0n%?*GaĮsn"hQ faLDQ7n<,!-6,޴7.Iq%*Qt{UfKF,v BL"G}ZC$5LotYvrt{_9 wPT@֚1 B"@T#Ɇ/':pDLQ*b2!#A r[%Xhbv$m0x\s6]$=`Na>+o[ŗoeRn]tA gQ&@.܉<o_ 4R$ڌ)3R6+Fb]4 0;F!!!1BhkGqd٠vZyI ԚUKg?v$X̥ =YpGCT 61ʑ mHKÞBC2yc=8yϐfc ()' '@e8MF1 W"Gg0e؈J{6ǝ=(_Ԯ;$ ޟfr/?QH4{`3 Q;iF!G y{$yueS?Ne!yc&1^!DK3k67tFƴ_&&9 ]k9/JA:_ WO vK1MK g($T6Qsy@co K ˁo'z‚L!XHQ6כI0&5LܳѨPq}Ǥ<qGdW cte -HYAt#ޡ%8Sښǧ^x4rŹkJ ZztxݘZ2ٮDn.zڨ?*|^;8\r elR{_E)Ւ~*lK~wJN!Ϫ4qnPt9r4E9¡qF[ qO9 OS؄\ͨYy4N XO$A_z#5䩴HXcMї]h  Zٸ.J fA/ *2O=bqqNYm)_;ȎzpNrP?["\3 kuI}[k@BX^?,y5J5_Њ lmdTeJ|n/>bALȻv{ .@XTv`.I ߯<e พIYyKUnBx k!qJ͈׌[ve5V-ȷzwܓeEژ)]3_%4SwX+E-%0E''-+rI 2KݗjMFZ%plkbBIv?oq9 pg5)\Gŷ+cc`z(NTˑ-TmH[fzޓf 0S\9-\xAv`8fP_:4n$+ߵ,LW |HdV=(.$ 윐z\/!am[axKIhDh&1bql4Q1^X࢒ZE<%n"w芋 NpU ,{ˮ}+,0+$ 9 LZ0 u$B$Vy,ʤIR^ލC T'_ KܫxmPrIC;i_ezRf* 1xV3wnep7Bj9t,*c2^B뚣R<+-{7IF7{n2=>Jz qVJXŋ.&Bqv5!M~N?P5DyCf4-0^3t>qT{N#螪e(}Lh9ubs_n fz(,p]1ZR˧q$΂,Ko%u"en^'G4.uVvJreAİ A-CϴQE::OSI4jZj=>`\qA$,^fspu7~_R61  49_&[ endstream endobj 54 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-fitgroundbeef.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 59 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 60 0 R/F3 61 0 R>> /ExtGState << >>/ColorSpace << /sRGB 62 0 R >>>> /Length 92071 /Filter /FlateDecode >> stream xK-USayC-MG@܊`@0 ]&ZR݃K:R_J!evz^y߽~>[~_?˟_e~*w+Qr*)}?|~}_׿ׯ폿㯿go/Uޯwhw)t3 .$7/~rޥ?zKz7_e]y}3V_9_%"^cMO|2BdxUOr$fW<)xSo 6)W)}ͳ_.i ~Xݸ|\EE#ugo1ELgkkYP_GEg w?J{t>4?FB;?z:;h$ tɂҸrĬRo^ s}µ3 n12WY?)m{Ώ*6#Mn0hD.nKjoK$N,CΑjyۍ&=KFo_w]z[G۶FżjJ[,c-*Q-kYw5ű-ޑpO۶vQHlME[6͏k<5zύuזKIJ;ݣUQݣGOms{"Ư{&-_p_Kozgs|ϸkI9~mm]W%9 4H.t݂[ܾufIN$]*ֽ6TFT-ϏoɋE;o~~߬o#7G;¤86_ޏGPo/W94lU<_t)X[ok)d]fEyŋN,P)a.޲XK)*Һ'ʻJ75dm^7KzAoe7PygK-T;r:RwҶ*QRRMZ[ZZ$(n z+ˢT5KN戀(ܲEJ7cOma}c.`׫^6,cJ`)TSH"%m,+ND9EKĝ*pZ}ۋnk+Hp[gY%^$f`ڗse^2t̄,t徑soz;' HQP*tH"%U]qG2[Y^E)1XF>YVCՑeeudY Ya/|m',k, R9kdVi XDᶪ+,|m,a/:H2ɲ:,k,k 2҂=U`Ae.UB%y/wKv2]=_*ٝ.^?k+-%>e͒蝩y![Y>%cdY9XB9z#YzL%E-,'~TIF=%k+-%ѶNMyEQ^,R"Ж,YYFAQeJEOX,rm-,K,` ch#me>Xz`遥?Xޚ ,R",Lz &,-#K'KҲ*}\[E/iz;K'KR ()u]BR`c񑰾K-R3ddckXdُ|S`c XѶXBVs%2N0y, K/'K/3cɵ͞FEe<i3I6kUV2C$eE/nvYNYeVmJ`I#>k%`aI_w`YfA[Y&K*97Y{yˡ&lT)JԷ'M&^]p?^Aog;xcɤPoq^$"Y#UV&e z;^E*1&O/, 4%i$e&dqŞLT_t,B2^[XdXjE`)tYH ,Tb,+!Kе veTd YBYɂWsA)ik,k,!˨z q\ddΙK ,-K , Xz"6p=Ka Ad}XRyy}eUHB%BJ͒Ů,;r-阇TNͮjny#%si[9],k}chʲe]ȲZ( ,69KBR`c!It ]Xօ,:Y+,I%BiGޑ$c!)P,7ȵ^~Ԏ,{Yu,g!)P,:YR;dٙCdcYֈ,wSdG'˨2 !>†Zio1ԉ,;KrN*1 "}\|z;^E*1<ǭStsNѐXDX\ogidiYZEq̱ƍ_#ж">=w;, Kdu,zm_dYDqBNgXfe>E$Hk Ky 22`/7ȵ]!RR`/a/# 22`/a/-K R?=֐ud1QH璽u,!K{/5`] ƗrbKX005WGohn%didi YsLű s vZOZ$c90c0VB>OZVd9ϝ#KȲwy5W풳G%YD)`dB6ޑ'\'\ȲO7vtd)Y8Y@jH;еe.dd/EJ5WVBR`cdSs ',,"Ki2̌,3,3#LR,a/:,,, "HH[c,a/De'%wdY8Y@}e,d{H!W𹹝,u"K]RRԉ,/K??wA|A%J%dd,#,#!˸%d!_,O3V+刕߭uUeedYYXy8+'r>b ra,D.3e XDX2D;`!VOb%7rP?R>Yg1XJ?YJGw` YH/cqes6d˩҅,, ,m,m \Y泯^?xR,,c" s Umk,,%#KIR~,-亭 '˂9ozk[EJe-ddiYZȱ#᷶"(2B\p}#/[9KN' Aq,eUdY`44Ԍ, K-'K-R'K߁e5dYY铷}E% 9JN^WddYzA}^|vz;K''kcdYfCNِeVdd)YϹ/gځMdiY_*gRhZۊ,R"H[cdiYDvƗŸuFX0O.Y0On!On<<aYdϞ%d>Xj`Y+ڞ,dYg,tf\`_$d]'y,=vPogd!oeNd} ?h[cdB=~I=K,=#Yp!!g%r!KNr!K;̂,E},RbX]T ,Wm%,vL/OX5K\#Fak-Fk R,5,Y2`YW\/R?adacr>]Þg{//}W\/8a}e(2c`)`)Xfq|;)T`XZ`iXZ`KD/KOX%Xeddu륗R,9?ad!oeXzK ,5\ogXzȃ2~XD)}>оKyt,`9S!c l,%K ,Ϣ}Xu܃s7K ,-K ,-䃥AVczu,9R,#r ?K߁%X',`i# ??`armqkl?l?<,+z Gj߁X_RZl__gl?Ol=lgl=l۟{l}ba-~??mlo~{~ ߃폇`+z ?폇`-~[z/z,Z"`av3L/cy~SK %O>I2kV_/}D/^ 5-)d6S5l3ԋ^Vt}XgXZ`iXZ`PkK,9P^XF`O ,r)PRɒK,``5,+_XX',K,3lk{L,IW"%5`遥 |xMXJ`)cIPP}}<>x̚/wݤJԷPIĥ-o},tmWmY@B%RKzKBz,K,{"K&’,R",XK,`eKUkd٭R,%P[a ,3 2,R"Β,5,-#^[XD/aA%?Xr`Ɂ>Xz`eXr`Ɂ%B6DG{|~s+wm?C,mE%z j+wg z;Kg[ƒ+xGO$OT,mEzmeI&IYzzիIVmC~%Œ|JO?#lJ=SKV*eK,drGdWd'd,RK ,K ,`kkuY6 K~K}2xK}KehX2sea:TOngIY_m[ۊD}+ !71黸kqE?Xz`e,|&yIV$`\e>Xz`遥2,3L`)l%Xʃ ,E 2|m ;:K~K{RK>Xr`A%?Xr`Ɂ>Xz`eXr`Ɂ%B6,Kɼ8;43וÁ%ezڲ}+ L dC3qʡK,=̃Y;KJ"%3cXz`韰 ,XݻR^;˖" DW;2|}1-ݺ5krК֙vYKڷ4Ce-%׋'K,{YeXƃeXe_Yr`ɟK ,5^; , I,5R?aiJ,n2J[KTn, Iz;|7TW~.RKyR,2|W"%vXvYν,, KȒWdkk=mQogXvf,2,2,;?aٗ,#K ,̚ ,,"*^rB,=X2ɂ>u#lS}u, KȒɒ+dCwdAz:7zj"KN' vԆ,#˚ȂU눕=A_;K'Kq,#K=b%_r={eR/d Yz=Y@9eΓeNdYz=YjBz!K}%'dYf/ۚ}Z2y7E,%uN'dy+̰7r!KIRRQ2C=:n>|xGX#O3c.\#ߺYkdi,y+kd>4޾^K'˨2v,"KK'KȒC^~3ԉ,5(G|:?W)_rvT/g?6yy ySNWBY\e XDYv`<>ɓ+Ȳ 8Y,5!KM'KMRȂ{}Ͽ,Rk :Yg7{!,, \Y>,e,e OvN' lyYf;YfCwd kOXc$A<Ǹkg *Ki,,B{XfF ( mO\'K&2C=3Zl=bXsXC,!VG,!Vf7ȵ!/93VG\+c"˱t3Gki,Ǟ\c?c%~_dixXܺ,k,k! O Y^ſXbR`u&oY[Krs_ eudue [ XWV\W O,z9˞qiTx3h,ֵOddY`_Fƍ\.s]W-1ba̱u! z>{maN:U,5^Ú%[elsYzFlYyk~̎,[,%88)|ཕX摏{JR>Lc) 'K/Ȃc˜+' r[@Ex^R`VuJ0_uN1-<$ed)diYBNMd)q,v?RRB~O\Z?Q){ Y|b+,%q9bZb,=[ZsgVh[KTωȂ~.Z,,,EkRCXyU]* s|Z;Yk;YZ崗{i{AozyRRT#Xx,3 x҃!vdyK9s݌,>3| 2p_,Tp?,0-0>L ô>L{0-ô>L ôOއsrϑiKɲ#Ev޳due t-KܷPOiv=f3ISTM-,;Y@%>Z(;`,{mEJamzx [gvӣH?z;~Y>P,,/Ei+H#me]'KBz,=B%Ʋ@A;Н4  ] ^z+K"%S&_Rɂ 8K'KȂ]v#s1Yˉ,Tb,A9x̱ sl= s XBz,{)P=*gY#,+~mUr-}qе2[YEJ~6gmRuԅ,VtEmz;K^'K^R.didY@1N1etdid),a/t,m K2S`|D"H meMdiYxv̆,3k, K)RR };X:G|Xb;5d)d YzFO'd)3ȵ=!+K-'K-R3JȲɲ Y8Yj}XÏٟedd1~ĸҞYEJ%X(}OF"%.|,u!K ,KF XPog)XJ`iXf`XF`iXJ`)K,=̃%g+W"Hd\w`遥 *'*32NdͭkMRRD,+ğU^g.X,R9UC:OJWK>Ym!OF5diY+K # XDX veiYZCftz۳^.HRWJDN>a*C̒i z YD,w:X@>B%"WX$*.)YZ>YXX6/Y}c XD_sɸEra!vNِevוN9XJARB%R@עXfGِe%=X s,9Vvt,} K'K;Yrc)̱9XXZE1"K sV{V$`; XuZ`iYH/cqeΓeNdɂ~j  1>*̅,s"˜' }XH,1.#22¸ Y1. z;K['K[/dV?[V$`чFwYN\[[jȲmuԌ, K-'K-R*weudY YÏ;)|n'X2/d2/d Y_N] 2e\2#Zo[[EJDYz܅,:Y"%w5diYZ?YZG~GF3d-I/ԔYb?ĒIXۊty%<^0|m*mQogX& ʓeRV XDᶪ+Yf`e>X1.%  ʛt3")h^OV$[Y$ ږվIRBזz+IVH,T-6cN_7ڥnж*QZRKmzoG^^/zI[[Y:Zr$_dtKͼX$eio]w"qB%6}vZ&}d>2{h*mQogٹc.7TrV$V?^j[ok)E׶IgLGjmβB%BRӣ&wYjG]B%BmEW;е$cqeЪY_ Yc\VBB%Bm"N+ ,w9XXPku`>$,"e]2zo,#|̆,{E,$*1ِ"6{v9N9$C)ELNyIYD)i+,w`k2ɲ[(EJD+!ۃeXeXzdk=`Aee.d0~#{\V_}z//i+,w` YByA"_-ɂJWKEmTɲɲBX0R76=Ҵ XDXVs+Ħuα}ho/Zb{8~]"ɥH"%5#͞ %s,Rb`Ue{/d/d!It`=:1Fẕo, ˨ȲFd0$U=$`ѧì˨2 r'kIEfO''{6 s%f̱N+ dɰ X$ ,rm7lQYF:YFBe2iLk[EJDik,,##H2؇08Y0\!O^c-6w I["~i[XD)zyq]~N21sl}؜Y23Y0,㋶53ȵm`kde ,RsԔ5.dvH"%"mEvkR[Xud-9>y'o< J~m׶qV:;HY_1twi+H#mEWX6nX[Y aUqvRV$`Gڊzm/Vzc3 g5g>6]̉{*Ľ m+3k۸A>63?Tlzs/뢼]ڪD}_KIYa?Y1zKۢB_):XdYtЉ/"p#mUWYZz) ,e]Ȳ褝RX_UV$`eᶢ ,rmgEdYtfT?Jw_a[Hm,Ygkֶ,qRŸI}hYT^4A.ȤXW'K|zH7Kp6+7IJNe/йBQXouQңΎ,uy}Dۊd,VUےַص~Azً7쇁JD,:YTZ_E%gfѶ̢}Kabtf?c`S^K+0lί*BW/ǐc@r)LOy5X/f /4 _!~@P9@g·oObmw^_̒ȏi7YWbYuѻ? U___yw}qqQYuѹ~ww &t̝g~x߿?+/$w_W?x߳xӠǰ34=Y?% C#o$󗈉仗#C>Ҏ%JY@Jږ%ZJ&}(mӠKH,_^4C6ƒLxT'SkÞH@$}Qi|%kֳ^V~7S7|EmeIGXh H~LK詍S0b?lזzѫI*1܁%|Fz+ŒjD'}¤mEWgu%ԋ^V>XYK>^uwde\V2KYZ/zI[Ygy1 Z뻿m=,vq_vKӎ~!Kf^%e!"EqKD9.6O_|HԷt5mn:J׋^v1)1}hΡAx[KV|ins9v{"BȜ=^Y;KKVnrv{^Pog)6Xt$sh9̳5vDž$cZ"d71֋^v!cec 2ީwNmSWo.Q|Ѳ[i},zS2賉BK7ɕ=ݝ@dX}+J6ϴFer,_|U/BH˖PIf'PRfMXJF,(r[7Kʲ3 !t\[KVpTVg*e9o-Ehߗ]/nv35czkf ]K%e.KsKiRֵ$vо/{a]WR2[Y&(> В#TIYFL.-q67\[EqA)}eQSUR5q!V*_.Ѷ%7Iի^6,Cƪː9ltRIqzMڪm-%zew]*)Vz%%seћhRRBv|UNt$~##ؘ.m/ko dΒ{cRRtVs(.00/B+8\ڷLѧ{[>P&rEV$a\d/ƅ֕0.vVh[`\fd|FJ$)K8Iz;؊B%6.}矂qGV(h[`\D扴:yl8.sJC):WG#K r,-#K^E-W B1'PT Yu,z[xxUH\Ӣ=%mQogyORy$x*&8Z$eOe?ֶ"VbVي}dzKڢBO_d{`a^̚wZki[_r&m g4w^hVMzU\ogR6e2A&d%|֐EJ*m gwOEW;{[[YؾXX5od\&{K%fAHsK)n-],kKUuz;Kn'KnȲmYڃeXƃeK;Ywz;Ϋ# KNRɂgXX0~H߁%'d!v2c)D1>U& =G?&זzѫ*,:2?0?i[`\Dq9.mิqX 2UZ^mk൞wHD-Ѭ'˵jz;縬uZlqKM8.5RK?&}qYeeq,X`}K&y,m"K9l'ΒɒXZ>YFC9Hetd YZ>YB<%'K'K8.2spjeՓeA>6l]71k| ,%]WR"K9o}k7Pogra,3!]#KȒ}+K^Ȓ*}e&dqe|V: %OyOqe3UlXs %[޾J縠Oxc#c'B# i}f)YI/3^^"0Ӿ̐{b>6>Ǧ5ꓧc^5LW:Ou9 >yY>6\/[/΢K^я%[WU¸}øȵ-LR׼躒f+/LV+֕ {h[{٪h/֕JVG*˹a]p]YeudY7T ,s]m/]ȂɺrZ<9E~V3m?/J}έ%cR""mmuαqz;<.;?wq듗^Ͷb}۟mfػ|\4ޱRKuRmZBz"0.R ǜ9LYZ_i[¸3Ky2 ekȓij7ca㸌2X縌2&Kka\`M\qK=rBMqYe5u0Rb*HԉRK,O,*Y_ k=` XDMg/zm׺cOix|ezZsЦm+1)9&mz+)mMSBeRb,*^aǟ {%//1wZ'_/\Wmݹ:²}E/Zbk{;= WNJۊ~LJӒ7KX:\/+Hg|2^nDȷڑ>e)2 ^ږ,a䳸R=)^u, r˂.Xj*Pogy9 oXֵѓjm+1)99++_edYzArjLmȒɒ;dw` YDYV܇cY YNZ4Aog9X~?V~?6?6̏-oksc%l~lz;ˈZbuì+;uU?]ۗo'X`r|O.ϱ؂9̏虺D96̏%c0:`}9[a+?VÏzcjc%+}Xs^RNďM*g^?]oe|lo 훤!E9Ekx.o>*$CWvhvvMcY#Щ'C\\ogU$ҏR3Y3 UVV$`ǼvȎ,*XdWUX'2Eܐ%wd ,#K`YDYdZ"+>ԠGT~(D$L D]=PKEV2RE$mJôG%͟^)J2!k/%y*SXJ,M<'){[Y7tڣqiq\$ʸ8.k%αOfueEe?0 swq 8uDVKx٥m36;zmJ\og]}`%~$*v)yȊHI#q, ,E֑8-:m^f'H`/Yj1V6}.2EEN2E^Լygv زyҽm6m^>2[Y>,"%w>y~ڙEɗ3goe2σR^[;oe3ZR!.?/|R;Kʲh=٪mE3Zk[~%N\ԋ^v2,T?_}ލy[ۊX$12b~2^}W#f\og_vޅp0O:- Y2Ԭ^4+JλВd4; ]ƅqqeevdYBcm,{BR`cX@ّeٞL㾔B[l^%e9﷣Jκђeg鵥^t,9#Km'Af Y:YKRɒ3mQogٞ%-mje<ӰgJ[8ȝU.6,^j:]ogi|u}&%SwVZ?^4h-Oӑ* {&%mF]qw@ec~OrA]*)ZZo]I*%&QKH۾4&\EKW,ϱ c;RN7 YR/$Oْ*%UKiۗeC%׋^W|Z4]&߽jIfon/U2ϴSiR^;-mfrץ,{3})'݆˨EJʲWWRDڪ,k ok[;ZU$h9Y\/KȲt}jdkrg!XHJe(v7I/joeUy|ar<VRIK7ʤJ㋔)\ڶhYI%׋^U3Y\o}sM<ïYMTk-tH#m9\Y۠L^dh޾cUTIYZz} i؋l7؋\ >Pog!ON %~V~y*5_^=Ci+,#(r[E%[QW!g@Y/adܫLJB?,oHk=-'HܷPXUYuF˭-vq YH Gٱ=aNQp\ ؛qq;5s\&I{.&%~l__> ,فV˞IɭuY.1Y8ǥ 6q\zWV$ъF %[Ջ^>.h/%sk> ]Cm+R`hwsI*~αq,RKmV$c\s[8V?XhIYKNXzƥqWֳ^v"eXw)_*5W@HԷ}o͒Y/mz;Kj, Xb#k6۟np .9m4Tux=mQogQr}fQ`Ɂ%`’}G1l(β,6e+ۯ~w lۯZ/VdS%YYC5k}?]{$̓^F+^v`),dّe`E֬,e!K ,O8ߚ%F_Ej=ݦmE%\}x6򶨷9Ȝ!篏?rrrz,_?,HW.YI:q\qy. _qlz;K'KȒ ~ YFBNe\Rɒ ,㋔X^ǏJ;V_hH_DnxnrVoz;Ko'KoȢk-JVdzLҶ" 2"+7aPogdY&}> 4,!Ki'KmUW;̉,sGܷ)T{h/$:nJԯr[텯>z;KLRc%|d<uoe Yt5o\W򵵾aq8ǤS-c96 ?|sKt[I. _z;ˈJ-1b0)2m]sE\cg]$;,#,k, b7?O,I[KȂcwdY YD5OY<1)5HFY9K_}р}kg>c+k-#b|b?be XY?8瘔zJH~:V$c\yԧh2ֱk{avuR /-iލE5Y>Y$/KW$¢|m%dq_b9&%IgU96L?®mE9%:O.XQԼ,>Ru[W|l8.u8.Dž yvwo,\q8.s 9GEJ.Jd\f?ǥrlse{[}Bvf{㷮[6|\DOװ1k{c:Yr T ,f_?oc-A>z;K9rn{l!%~0v3xVlw}h^[o|mrYc\zp\f[ %zA%dy>.1.=tɨ҃`/봗vfZ*zkMk2`/{6ԏ ?J&}<kUy>#3e~.A>z;KŴD>|\fqpMx`FaN@z;K/s݊3nv:&}Fc~{{Y[e3jKY:瘼==XWT2 gM:%c\s̟]wcƉҰ^cog| |ג<|H0ǸD9$}[ '˺R ř6Kqc!V)@+mdY\og"oQ HȲjd6n>w6TNH[7d8rz;'ȲB,d YjCN ~${.B,]e=؂go,\7l3яezS mEcV ~L~Nu^pl30vS?cY1,ǤCϓ[`ʒ}2H0ǸD9)aȓ>3htcaƒJw%~؛ ʢ9"]?T h|_2[};y o,<9.{޺N*q7.m}\<(K >[=桷K,#Ər)eKtq[gYOX/OXw=V`XY`VҶ|GQJ`[eþ+z9)<\,#2,#_Iz; 1/%ˎ+וjk=ɥmYdq!z>\[Eӡ?z;ΉְoydAG7e1wHþђGSۦGR;k7;򶨷5+-Y~^kOeಟi7VZb?Cm+ԋ^] v[װdQGBS%5]mE]؏]r߳$ՕvYd;,;wGR mE ,"K)XBz,g^K/jQIYzzFۊD}+ t=ʨˬwsM()-oz;K;EJΪȋ J0 m+؋>VA{kKe,a/1NJ1a9sl96usl969V+aO昌#LO'kq\q!XH B%6.}}a\2),+`\XZG" IZ[`\Dq+\Օv3V+[!b r=b rX)}Cl!V+'OF?&%@?̫)˨^ϿmE?&%2OmSi G恾!wto,PogQ?=E GֲM;/\X%]VRocKq,κβ, b$vb孏f}FR+h6Y ,2)Q?ˬ8.⋖!ֶٱII%U/nv{d;q-i"gEQIc wegyN]JD Αh b#P*Ag:bxZ_gc8Hi;iK9qjzC҉Kmnr9w@2s2e]6FO:e7g^l__/tm\T]1.1.:~=hA_w[H`!yC"r] 7HmTÊrZ="%B"]-nfKI&\/,Eb_lӁ sχI]T5Q",}WhK6^ü?_Pv76&ql4UkWI1eG1$q޷y_Cccj[V@ 7 [>4-kueUO*-f}$"mnE>.KmnEhs`՚,ѵ-fk` lq=.v56&I@fGtZB \=]fq^):PӉƋU[͝D.wvt12[Haڪ`[%ɻ: F:pUHM.E{jCn"B m!3 F:p$d*1jNjhUFE] mp[HAc,6oC;ZmM.c8qL\e鰥˙v@<5.Ⴒ\7/.M#a\Έ\̹*:=B=,BWkqU^ɥk }k-<_m,0}B߇Ү޷w(c_s2y:cfhlk m y6\7dhϱnOE.2Qbm)9jN`kװYNl\/.˸(rb`u\I \<4C#eJxήE"Mh1(<]H-%PSyn}` ,f 7{`.FM \t t{hۈ1j:7 5-F,Zλ3tB m 1آ!ooc,0~ƶ6F ډ =cd*؊;ڢ ռ}\>7?1hO9㵪[lB m [;7ۈ\>5NX˗ u O>i#۟,aurk 5z2.kLL[H 4x5 [pAށ 6nriJ=Qψ#,C sqEG8Ʋ\eq*֙gy97>=qKI}ut):}g"WO_BRtyGKX-i򦋶벼UҿֲhqgLO FЪf]D%E.C[B[TE?Uҿֲ\M*c5S6U\W0i IֿFfd+^\=yrg\Diwo DwqYE"5(m!ILm-mDtz޽E[HN)Sa[#[%9<`q~?㇚CO}8+ZMD.kx~#Kl.ź,o~oLnуqQtz:P":hҷHT?5SÖX5\l#nrұ_AzR "/K?=롻u.d.ޟm\Xg\I~{Mp/ͥe-2LBL5q~->1h[U+ކlmLM#i )1htl렗FdQx:p6v.f@cqu3_<誟RrP3_lLR b;jz5,D.5M^MRXiydZ-5>s(oE.I}Vm4|ȸTl/"5(yD.x:p}IB"}ؒ&MYȦEIDtYM"*l)US#Vʼ?WIR c˟#hE:zם>8TVs,=/,Vָl&eqZ^O9u2㑋aKj&5FO!V3YGcm\ď/{y:C+TbCAzel6)1~lq~~\%I/[cj 4=~^o˜/sy21~lqelJ_6hego)ouJrWSjKI&DCH^Zĥ sY'1hǩ6_d^ 6 ۏ-kl128nr92mRaG^%_M/KE'#E-.UPSt_ٷR8[b$F;.MK[/5]$~J"dH="cȥq;O^>1uA$ %];B;G席~tydϮaĥ sÍ&/rH~:?Sn~A.,O*M.M[lnUB"وZ:q$!_WWp/v)WJ2w~Yl!M;C [xyw;òsCjPzI~1HM_DJ~95El/sgfs\#I_yʸܛ".1}O?auָrY_2FE_&qai<7D m =DZ=C.kc\&|G TGb9v]sQv5qn/vF:p6v.Y n[7%X*&#ӖOH:p6v.Qacj&GX~qrd=`xq4| M碄ǝw1 n0Ue3G/u\ڎ\ùs1=0h\WqK5CVATOol892E1tm\|5KCV[˻c&eOY8m! @ӹz/,qTݖF\2.zmSDtN/Ұ]2t._mS y7Y² vܱj}ۘhnȭLiLq4h'EۘmmLpYs"{S_lU#]v<~5e^2;~AH}4Q^F9AXH0Jc(bv]nq;|~/pe՗˙YY/"3#U_.$0Ú⸝rfCsbL^2>d#m! n[,[o>R۞mT,Bӛ=+ۃ\tˑ⳰/~%e/Dǐw ʶgi q,v.djoO& `Lkh )hat\OV\Fm i+=ח6їH_u[HA'ʶqnq;Med\y|rYv.3_s+ĥK-˜]WOR9DL3~q-r=r2{lK{B ~K9AX#WZ֛C %m!8MK8ފQzOxs%ߎ;h|?B˽ЬȇKVJ֛O[H55k\Vz3>FIEm5CrMC?Z1i.Лޔl)uwA\tm\t͸p6pP\- R궒N^kE[.Oe#jzاAOp-GP\-lfKj/\]F:p$EŸ4o'Uq6;./.6&㲫!F}z\Zh2~q=E$2ۛs7 - _\l2,kGqY=1;\ UEƠ6O[kcwjc6B_˩CpqJ[{6.A"~_B߇F?EHP̭y:pmM.EƠA(JMe{eXXEBژh*_ pw}J,Usin\.%;En7Qc~jMGx:p$p3Q],1h{r{iژh {CCH.⸝/#y"S3q\yp@[reensmc{6Cқc+Hmx4rl+TEٸ5ARۄ\S͠'2Zgr)qq-r ..sϳra/s?J9c A1H!A8b8wc(ql۸t=KƇ8g~9JHY J(۞q\q;Y^.D.yGRe @ \=^.y9K2o.MO ?Q/"#_.uG.u9䝸/rqّ9K/>#~nyN\Ή\Ύ\~{˱g"^^.G.sD.s\Ah[ .҉ e˥ȥeˮnn/ݢ_v~'eoa^q;rLSa1&됂eTB 1ʈZ3B/qr43\ke6݅cV.c9Ja  l=U_V~qe/DP&:藶_~Ҷ?+a El/$r9Qc%=w]Md68e K"xq;:_.uF.uF.{p\V\Vp=ĥȥȥq BiL?_N%̯)湴-jsS >۹L׍ˬLat[ }Ha thq2˶qv. _8'l 08J/aKN۹_}0[Tq 3~aFtkCN%a˯1L+5tM(q-r=r2{2[ҟ_,qW/,56j5֭ *;~K§ͳ˲m\`n2sV`x?7h )?N[/|Cqۈ۹L/5V76[Ŝ8Zn3[HAv2l=Vw1\m0ƶ*OY"McwB6nkGh3G1M.r[V 4> }_Ong2Zh_F~ȁ_P >'ΥKMs#^. NcU_bBމKK1\zyrac>/}_؆睸ߵ+z_d!m! vZZw/fq!_c0dh#Jc"qӗRРnylyWMRUvel6gaٯ_=<+!%n9 -; 79_9HIc_ɰkw kX\c~ ;mϟRv.ϻ$jl%]Ҵ6k|~KZ.-}IJ+g;|TΥۜ1a%\b/gmm-kq6J5\ϿR)<}Y[` )}h0Zֆ>ʶœtB.\c3(߳> gyGD7g-Y ogM.Gz/M{~aTw_;G#ev0NKy^sEPe藹_64=a{agVK/~=e=^{,_ڎ~i+q;1^2Fڶ6xӱ3_A,ֆذlN긝 0~Ǹ 6=>(q6I/v#G$ yoV?˼cٕWuۈ۹傸EځqV]J\ډ\睸&/rq2zl\W>\YEV˘ Vp[j2jIz`|+hUJGD.{-0rg^n ̻y,ۈ۹r=r82ˁ ֓{D>"#sO| 66C+c; O׋Ֆ1jNyWe XOFq_vzߺrbwn~u{RB/D`=~q6.xt\~PUhD.l !zWm\~aw9/'}M.dFҿ/G2=./(Ւb;xL 'nS常n;|C5r-W,m=rqe ;Fa}-oMJD} w Gܼm5`m"+@?B 6.Ku-KWpEm]o-%ɛ\0כK, so#_D wVGW{#^aK:{귃gwϰ/\gBۄ\tmV05V[w0/J%rO^aK~5.w\q; jtFJԻP%rU`#[Rv5E&Ƽ?e#6v.\z\z\c̉)8S";q=r-r7Y_.F.E.{f.E!ReB.heϗlˬˬlw\ϏS"<C^Gۏ^:%QK'㸝 LyawGO$R~XSQ ӫ~Wm)MA3ŶwQ5tRۄ\~Jdh]士;*6WPRZLL.wdݹ:P&" 跶oV-޵mTC0ݫ@ͧ#OsQtT½ m'xri<>>+QtS":3қRԀڔlF=,v.7_6.RMO?\Z]+QzMY`KWSa~yg"H>s1~ @ zuV6ܕMo4| .zӶ1BA)ΨN\v]&Qv @K<]O?\Z>Z<2SL} 4| M׋`tDSYhP̲]m\~Ƹw6D}_!"Rh.6>mFd҉. _~d\V}el"R"rF˥ȥq;9_.sz̥I*B \Aq92W2۹ 蒫/j~GX*YonI7ϻ6[%Q{Lq FAW ţ㌻bP\=KJ7 eڸuuKn궨TTJU\<]W/$orakfG>lHͶ︝KךxP{]>֢dt>u7\qUmyd銋sZi^Xj/VKEw LOHnafLEmVѼUqktEۈ۹3|GMy/HzSJR(}3۵%]=GM.b4vІ̲cLZ-TvC iޱa܊tEۈ۹Rȥ&.{{:w"R2w=yg.5q_⸝Kr/6Wlc{-Ʈ^ۘ͞tEۈ۹eE!٘{'h )E5[ue~/D/8)QS]y)(Yooh }JаnƩVf+.v._\zK_Wֹ_\Ή\qۈ\6 ډgafjc3fhcwlcZ?KKsiĥ%.e_\Z_\FEq[_ޛ/ӥe?S\F2f\Ją}Ֆ1W1YfzM}?v.~9|M>Q~qKO\/yGhs_7o8Ma!&{scr)10-8Yh 1+5{~:>KO\ߩ7;>KK|[$_.=q۹_\f2K.H7Yuk\/.D.~ Ÿ4cg-ӷK텃f{.Dc0֫hqK8S0ih )T~>Èz5q\,v. Mr"?J!&m^ms=R+01 g+Tb4ZKW#_L?Õ?kcns^*\Mqy|ذ11z޷uzN2Fx3e~Y4e3]q|q;_ԉ~˚/+[ }hNԖ}[}_q9nrz|ؓ^"=ɥ^͖dhWՖ1W1YqqE6Kc;086>%oc8+H|vʯ86m9 ڪZLѐ>m 0.l4b¸4v.8yqJg1/qL)ɰeؿ+g'0N:O\vKsOK"V"V^.D.-ONlE.E.\C_|%=mqg c9J{s̖}_qmCqXq;YYf$,\ŸX׌\VLglٷSgJQ"Q_xrvKX%/15^6\\f1.+<_$vj{ۢkxTc 2A!l9o<,c\`sR\56:!N}|sa߇j}yǾeqA[F]/ظ;e\*7jA E5lcjcѲYZCK0c_Ew2]m.>MK//^"^#_ #}"}^.D.{G.Rȥ\Xwøn#glcmZKk88Y5lcjq0dq1s9E'{[JˌOa\xMyp;q=_Ʀ_K!&O|f˘mfc=ΎmM.^ܧƇɧq1.ziǪeي}"n"mŠ9^${O낺=d=xJJ54FmuB1f:6v.w/Yv.=x69vLQbM]!ǎXy_e璨" yļaH.l&&+lWwm!ku*}%h iٹ$jL4Ba͇ӗ SqDttT |||9=Rۄ\;\B딚l6_$yh>YS[7$ח$M.}4zG\NvgOf |yCx?-9ň۹l"Ƹ쀵Et!l!p;ɥjD[[e~޽PϢ-\_/;%rq)R/Р 2m\I~W[߮nCx}ܷ_q+ e0N⸝٩SCΉ}g~v B߇}_t[\o\L&`qKq:1hN-vt9ehBg;6)sY;1h{:ކmjcreUl!6 T`qKe2.~x_.sE.sG.s\8&Ǻ'W!otEۈ\]/a9 }wP"=]^S-/v4^VɞFm#n,3.iҘzݩ\t4$y_CS#!-=l#nr{8d\m?,Ʃ;)~є]. R8\E۪Pv>˱Tkʙ^^ֺ%d5,]/ӣ-$[m6ﳼU"<Haqr 4]BPd-jyȻxAمIp6v.Mfa)w *FjzZ*(5[OUSvϻz2F:pUF=M.r߭谦DM':][D.Z)fKٚ5aJzi.J&>2˚)ۂ l J\d62R \*V杸HEpM..ʤ "_\\] &hR/h ʶ4B_`*:>A}i{ߔȅѠ ;-f}j^2[ϻsek:qU^븝e%.+q9f;f )p}YwսGrcJDI^(e{lX1Yle\8zy۱?17m 4S[3s2^e5[H 4[`Eށ F:pYpeƨA;džpZnc.ZX0[HAwZnc(E&@y_ )qn^l)_Ѻ\w 6ӈ\ 5OgO<*o`K/T^{>avy c\#c~f|?TMo .2ܶ٨ .T~np;Gif"Sng;'B \*V\Xq-#}pgdj338%-||2[H'COV~iZ*nLW\Eĩn[(\%-OX=0[HnM#oXOl+.Fc>52澴sjkqxԖX5Efmĭ\n߽E 5C./!o'i7V%[}.߾dݾɲɥh'\ .7[ӷ*iyfKf IֿF>dru]yF:p6"E}O2rE}s$}1]9 MG7}K: d4y yE;:wR _c&) N}Kx"Msߩ_ʟ1槿,Il">E<c|fO}9e| M%ߚtS)7j~̾4UmxɭC 'bC|ӈXkm|/ [[X9bkQ%;qy 5MQʈwwĻ92 ߃xՌLG|Psc:P 4ד%ĕ@; 4Ej= #goG4,=Ke\dg.JޣtMSTjC_͈qk;3CAC~q4_4l'by&'}DQ9#3O=q~OTɉdYMG~K~Z) Xց,D.rk J8\A"b,y܎8< _Bl2 .xxGPߩ(%l%#(Kӈ/!޼ \#Vךvgggz= ߃x:r]_b;N [XXtԌx G#^3#^=RvM/XӬ^wo3 o qolX~"x}4G|#F5ħ:>Cro],7 ^o~J+YglkKN ~WPߝ͍ oOw+q7U.*Wם%ăӆ,+HEvhgE6DR0>Al뽥:xՑXVA GOP)*!dk;ZZ^w]l. *( '~&{`'_B/¦:׹4M1MrzJߺ >}弴%h@콆^0| 6rN Ġ,Al" i.G΢k #MQ c%WuX1?!^-Ke`B#w)# \b^w—tU ˝'@\5MPkc ^\b u|d e<WbMSjCħds9\\^W;iqsˈ]!bwvE6TDz߀&@iRm,G|#f%3CAS ;W@iRmx:>rKEğ^dђ=Gz5KA x GFF#^=|8Cu|8G/! !M%X={(Oqħdħ8SNu,+Heo-A~ĚFݬZgEz] _B,$8b(y2yCɠV/x쩩E6&| =( KlB AkR/_FW3D˙u%|529G|mx:wfq#ձV&| =( $N7 bMSTjC=q;Ν-SXnF e P5MQ ##wɈwqĻ&|eħ94GR;8CLuԾZ}Q8V2 nˊwBȂD5.< x+|f/k_պ Zܼ@ 3 ݺcc"̵_1+Fϒf*?_-_-NZaU!\pufl&Ԓ;˂65t\J/?|) ߲څe :@ b\kܙ1B8E>fƚ2ssW\N+=b/ijk_5×iVKBT3#みGg_VvڗCFpȵ/ Q2 _.~O/A."OXexVr&E^DtB rk*s wX_u=}nv;]@Z#n#c?I.!%X0Vުsa/7>< }\3k_됕aA;3CSpEaX/7s;{3׾(O|_G{c_+´^n|8׾(O|_s˷蘕%bA{6CSP+O|ks˱5dQPnT;sO< pk_^>-[_%_5_jJtE%[XxVsķ#pگ^q B_VKiŀ{b8>}|p.Tvr/6~ [ ȵ/zj"|Qxķq^ٽ= zV=q}Q8b2׿ree9qoW/Zėf= zVJSqpk_^>eεr/g ߎ~[ H_eG,_V!W#r+r2EAGvc9=by+d/>}zve\_V!Wx_ m˵rJl`Ava0U;rFpw ;E𓱾O}]CV- j\n]_-_=c3+[sW;N ;\~2 ߎQrJޱ ;G + v0|=D,_v6ϣbp |\k+WX(B503",cAg">Z!bzGR2 *tYYmc6E.>׎wpk  G SS狮 >Z!qϵ߱[ƚyC*tYYIAv04wapǎwpk`)+|g/k_4am!` O_-_5_jZƪ4DyUoNTGB®MLN#Y*,N?U;FJڇûGgչ]t ײ,j޿g ,)5;hlSP&uC(( AA#U41$z{p m 9N]t r_Nx _4rV #9hn-0#rdBj\3Ms^-w.\\e#~Ȃx]]ɨ',]vf sA4WlJȻrMF:p$u7' /%s=Oe-2+Y"#_.G.E//-lchp4tim#k [cV唗)K߅tm|'󦔸nOm+N\dZ#?F|p?\I \\\y~ﲵHC~l^5" 0Xa^:/=#;qv.) N.gG.D.\Ή\Ύ\,RF˴}R2ypcL]%VtJ[㗭3|%eyZFD_;sv4FJ.U%pcRy0.D.\r_˃y^.E.E.\N\N㗣3|=e{A}>.v4rո Wb` ҁƬeOgK 1|})_\]$9j\4qA:ֽt^.kF.kD.k\ֈ\|p?\\lWwee b`wL; bh"^;$k]d~Cg(+lK_-~i@ 17ܿ/X'E~Sg(+l/U"E.{/rYp8xk[%i^zto1T_FDf>~:)[:Gyv8ç1_-~/W-~_Df`mSwg>mK2g2G2e%_ \֊\֎\~>mKз[KA4v/XD~Gg(<9qO[y[rFr%J˯ kEȅ [gA{(-w*z\V\V\V{>mK_d3^5̍G xku<.v2Np):=ƥ>mE re"?Nr/.8k\ .g}\ٸ8ç{ig.M/~Zw~Q)ra:֘r9'r9'y<q/kRt.gK3|ں`ߟ2}eО3y"J/ ^fV%ik^_y-<wEMSJT.K3|ں%CX#q9-r9 r'pi%%\.g5.)S/;CP)qA{<.v 9pY%rY%r}Qe%J#/'CX#"0pr@^`\z*5.H֖=u"a<zNpq_/ \=I#yj_!#=F-/rOE˜ؚ]]?vyp?\:1ko}Q{(A:ֽ^.G..?~r9#r }Qe=~i:xR?vyp?\xi։Vgu/=~:! ЇG :ߎ}Q /u"A .U&jt^TW]rvR˲B2H͐~Y)`#L[$+A~^ FxHE/b%銕/\Jle\/ ($,NѵNr2'j[reee̞z/r%rK䲿/\䄴q)*KopCԦѵNri2'f@[cf=#"MkeO.A ҁ|<5zbU.kD."r.kD.QsS3>o4'gѵNgY&kOv.E.F.\N\N{p`ig:g_t_v.wӹ/rYe}غ4{ /~ch}mF:fy~x5f\\Hng( o܁;UJ* YZVbHɑ砻WMɀFڍ ` s+s+xb'\\ FyxD\\VK/xkχ`TV#:t~[e֓_aKיAp'.)<׉x4ʳ#z*왙nˮˮˮn U2=3<323<=2 ޵/Cg]'v;;\'WU VUf-ee̠z%܉˹sEWq).EwL *d.k{.ky.ke.kO\}7kkJx\=㔫;U?{,Ikp^t$Q"qTұCV"_¥Ipa=1̠{q, 3"zEo杸K}Ppg[rf沪"U m)*˪ wRp㲻粇G沇粻 ~{V+N\lo5Rx\: ʶ -{im{QS.[0)_R}Pz`8OpZ˜˜˜+N\loqYs!I .ʸxV{l/W&܉F~Fyx&$#Hyjy.gz.gf.gON~ȏN<[ <V5.;Ekϧ`YVT.{.g.{.ּ4_:[{b{]0'Vj\{Q+22S=SR5=H ym]iU,9m%^^ Uv[rZ$9m^^ ڹvN[SzLY"-䳼,->@%Ҳ[X_h<6<$OxE9ϮxE9>ri > E9BkQޞC62Gr+sЛ[7wj yͥ'EOỒѧbj2ҧ܄)﮽Xr{n}JHN38ҧr} zڧPmCBu[c)E8)O9OyԮHr_j}ʭEOi&\q\қҧ>b>e >nOڧIܧyЧO<>eI>gѧW]~o-)s>e)OY?S֧>>SYS'O_)]4)CTSn>U#}JY\ѧ>r>О:ק<ҧO)F֧GRē>j)MO7SCiOCLS*)w/SWJ'XSx)uI,}J]l>:)uqSn[\»O[>n飤O>nAܧ)]ON >es#}х)+NyTʣ$S>Cѧ$yO\B})bK>q+} ?jЇN/2|"Чp~)_S|L逤O[SHSY)E4SC;es}J6)*>Ns)!"uRiҥMwҧ`>b)(}f_k>J`} y֧po)cO6}JwHh"Tt)<;%)M;/ߧL>eA>eҧ;A!)w;EB!D;NNp}JSѧtoSG)7)c)\SCh1%c)[>c)[OO9,g}fB#aSTsp~z}-,=xjxDDЃ@bmç2e4l |>Y{n/ kh]ѻKj+`GԳ@b7' + ꨡZ 2|q輽[3 hiv$L=n t;Jex 7m>U)C_ _Úi4\zN|_WovqIqv/_@\kW:;i gh؁Ky===_kFN+V|41!L⁏F #yOd5XN 2;1},x"|$P#4eb.HwuwqwIwqwX&1WǵxHcn==NdUKNkn z?5k(SF&<$; S -a l\f+S58׆Ph 75o>'Q#rP#bjVA;&.BݼkN(S< <TkV_;?g?h@'v\;sBe4lF W!&չߙ(lZ`d;ӧG._:p>f'>s%MR h )3UUU"";GsŌO|2s_w^/Ktt,~Qg-;Rӧ _@5?oZ'= ׻) \\ \K`lnߍ;: ]?E˻_N^]$vn\^D/eB9@a m$u {@7>k1)T_A៝M@aӿ 4x~ӭ򷠳EQtݵ؉Pp^*2$[\'2e4$o$߇j/ tk̻iqUe1ѱ?Î#RPh@'v&>8eш7AdEQр!Z(vRVO:?#Q >i ǧO"yPр!Z(vӯz eZ.aQi Ah-:qH_;%anɹFek'L2sX~LO$lmt)(ܙ*Q%J;-Ahv\Z2Eh$*{?+'-U%H`seL/Hć9].g">}Z|:"'&|19>C-Z|<|@؁;S8$?psX3SSSSS+4t/]#b ߥi+M `/Z/vӧ|uCf'>} |Z`/ZF,vꊝ௞F;rJrw OPkp]8X#hNWSdwhة+?t͟X>}|hk/"ӜdE-;?=_??O?5o]q| pgrv?p'H5>}AVZ& 2@>)YuC={ ǧ?iNW`p7`$w@pHdFCZ Z#>:X͞~EmF!adE1H(h*?-;uItpHpόX3>!+:3 2@iO뢇6q|5_9]Z+ӟY :^Bz岃f At _w~b g/&܉6͏nf\#z* S/Qu|_DoX ! ND(XV˳\`[h㲪BrA@qY^.&0K治粇G沇粻L~46XkC[N HSf4? ,TxD/XVIKk痡 ֆ>գ'[I~sW(< VU.d.s{.sy.se.sO;qee?~2x.x/cMmEkC[[K\ E*3V*Z2=<2'veGYip,   "|S˻~&^=1[M\qq}3K ^/֞;l]q wR4)E^lK+s9s9s95s9s9-4f zU.pr~9,Y{#ћ'vT0.\V\V\V\;]xcDH5xl=ĥiXR:Mk#?,>xD/XV읹艓ppY/&jy, <bk^J~<|8] `4ĥkqss3ss{'4{Z{Rue;x$܉ .(W˳0b^ ^Znnn U3;n\\\\NJ~<隑vI \x۾of)p`[R౧y'܉ 9w|R"jt>Bp,{Cq,9iz0n5垼ȋER:t~tdkY8Rh=lF$3Elpp%r BE¥xY 8R6=e:,])ܑKΧx.\㹬फ़rh .֡e:זp'.HpKӾ\D/֘앹<.!A 3\:ҵo zu^ZK Tzh wR5ĸ̙ὄ)KX!A٬w pW8!A ֢ :gEnΝ~4)ƞ5GcHPzBW%Mp޳gQ]7*dH=[H sEmͻh f=pm-\6]DOR:־k;_{aSk "h [1KNE/6N\(6;p4`fgz`e[cHprǞCS+kpp+s9rrJrrNcO6ZBMשP'IQ&~A o<%>H ~Za[4\S=ai yw]B٢\bqp9+r-ȏnC)l;.wi\:q:q!r![;qYCb\\nk\7w㲃${w T([打p'.[cHrh>]s_X\8EҎ\R2Y1$"zEbH,D [QP|rHpp`e[eυ$kO2'N\C]=I R5eNUW$FG-K]#5e߱'lZ׼Y_s R# DSM+V. \D/\Vi9S9.Wdqp/ g+W.bk^ڙt~!:rr#~'.[^a{;<ڜzڜ"i$Mbt6f [;qd*ΒpHp"zڂ z\v M(pHp"zڃSrs K $܉ f'.z.츬^Hmi]Ne^בp'.1$BWAi~ZD߬xD/XVss'ss9OEbH4eѴGZF+ V5/ȥݨ,I1$Z^C{222w22RO~<6>׆ MYw4Q|GUlK'srs#sdqpY=s9s9s9;s9s9sY/Ǟڞ痎u*{b;qvh~  V5/%L{jX_֩\ZG_fPlvB@ߤl73*g.x.\s%2OrrrZrr_==/T?{τ;qleҞLR|R"z [e֒_6= ,/ T -G_J1$B'*f Ufϓ鹬ṬṬppeo,%.x.{{.sD.N-6FJ kC{7yK~w4\(>[h$r[e֢_cOmH!qm=.'Ѵrl墑EUl =** X5N\*bH<=3=ݼfKᱧ’yb%܉KC ;(>[Hp#z*ʬ&T{j_X \D蟚pp9/ Dl-o(^^r9O222g2gJN\\\\\VH~i<69TS6Մ;qY˙˙˙+"1$B{25f VU.{F.ǞڞO痆u*=1kLĐ8.{.of)qYsY{ieSj",.7O;qY!є}(>[Hp#z*ʬTTOxiY K/玦ߢl4xb\v䱧e #zb'܉F 2e=z]7FD!Q<b̞艝pp+s9rrJrrcOmϻW^={tĐhtorTGUlYK~i<"'r_&ϮK~gץ<W<bk^ZꞋ[b)qYsY=N\(6;qss3ss{i&t{Z{lޱm~as^=bH7 e..d\z'T{Z{n~a)pw%䅸&!7ZR2} lK'ssqT,%.{..y'.)Ő ^J1$SsCRR} l=e7:C)>[sGu;p"\XlEK3dCFbH1${1${{o\\ Kp1$țZ')~AʢJ˶ D*N{`+Fk ]ì֡wu*zbۀ[4:l]otxvʻ0H IcOZBCשPz\Ή\xw(>< VU.7.wi\:q:q!r![;qw$t㲷w沷粃fˢ'LZT"zEKPlrhOr), 3Vؚ_6=e:,]+g&\Nˡ=ʥR .Ufpp[rz沊e=zţRq1$v_ͧKpC.b\Γܱq1"1$eFO;qCb\\\\\^/ƞ6 K l=ĥi R:ͮ#?,xD/XV's9s9s93s93xb%\vˠuGZE*Riit~)Ne,&܉ f'.y.{.g.{.y/FcOkKu*kC X wBف [5Œg#z:dTԄN~=}3K*yp~iNe+N\Ɛy<7^%Đ»@/W&܉lOG~,.bC<< bHˎX 53~gKy"9.W.x.+\{N!`OxiCޓ_` eee:2/Ǟ痩1$ֆ艝p'.GcH8墫/\,\DOXV=3srs5sdq˾Nx=&!wv QyS[$ol{Ewס8o =mی\xP|rHpppa[cHpcwǞi \S =[=ąbޓ .\,\D/k,yj{.ky.ke.kO˜˝O7.\Γs9K3>rh \S %܉Kݵ{2S .]fp`e[cJRh []B٬w Đ 4A}/7+:/e5eUeeUe;qiCb\\\\\^B KaIHĐXڢ'vt!AʠtGZE+:/%4{ZxcDD Oiqp9/ӑgky <lk\N\ӵs;s'N\Ɛx.x.d.x. ^J~4694]65;qw ?,xD/X֘՚㹜]鹬鹬॑2is痡T?'.')~A O7AD z,)ƞb{i7K̜=pm1$FwP .Efp}kk\CEcOp] 2u \Xlp wO') s=~skcQ}زy%eSTؾёyDD/Hw!4#)m ˀі=OVGcH$=z7KxNll=np zTOtz-'GWC?wBHpI7}1"7K`>l=np\+Ɛ 8,Q|nDbt6Sa "Slo{~4o𜤎^=pmPlvhv\(>[X$8^1C$qcOrס ֩kppY-s9s9s9+s9s9sY/ƞ}h y?NYoOPlv{2gky <=H non~a)pa/#N\:ޓ&(oj <lk̞sYsY'sYsO1$T}q!r9K'ri4-AUשP6}$܉LOG~^o V5f!1vm$bH -^.y!e|:l-"GmN沆BrA qY^.ļ0{沗粷w沷粗L~46;t!6OиN\Ɛ (>[˳Hp`e[IcOk痡Tֆ>ãq$СȯR|6ʫ .xlk\N\V\㹬'sYJPlvⲫ粛[沛kRˢe:mxm&܉ f{.d g+3V5f5eSe:?%ಣ_*V. ..K"˜˜ wR]븬ąe/cOmu*kCѷp'.EcHB(f z5f!1.gz.gx.gd.gx.g&\CFB"Em bHS尤=bH?^*.ļ0e5eueeue5rm61$ֆ艕p'.McHi>Q|g#zʶƬ̅ƞOИಓ_ͮ#?,xD/XָcOmχKu* X wBىܞ<<ݸ`o\H\d=:]+zZ \xO&b"zڂd1/,y.+%ܗ{O7_7y|髼߿| {_Jx$XM֋8 > }o\ճn3=2݌Ϣ7!H,:MW׿˿Uk^x|c-״;3hCo9tզu gXO:ɬ=v.[HH ?>XtA/j|eCc$\_V7W{_?U~5՟b=GT%w};D5i{7+}QpmteUG?wYMLŲbB_qGv1=,>F67o7o__o<ȓs=W۷pONz0\ tT/(4zdU{IhIرH!r%J)ZF#v+Bnv@gެ{ zWs;e`bǂV"t%W;_Wʄш |=NC8oطwʂ>-d +T(%W8W*Z'v+%>b0'|;]z`1;Q)0a'Bg"6#GoF2Ehc<7:ݤuD -a;5gW9|e+heb'I nȹL2X׽4.m+}OZ=h6>|BelƧYj)GӂV\q"u0 ,EmVW_?X '{EXD=*Nhv Օzg{mtGAMo9UNkhս7x;S=zroDD ( i?zgd;&7kY]n=. B$&Gt =1zAKws r$L&vtrGe4bFçdE; P^en\thhGrխK(SFV/7PaBW;vWqXvuؑB8$нMbh )Z'vkhSPV"-j# vtreшw,"A[Iue!Z(v,t,"0Rx6Arz)ZF#vk?uV%#.H ⸌~~~ks(.zRE5Ir7u}}Qkq ~MJO%>GVɟl7ӀsXCժ"֏WwWw;8W8u;ȯnugוD<9_o(K7U9qƝ\-6VS5 p@Xȕ) -ӇX#7g)ͅXc>Y6S9|-;Oz¿ nYGdM~N5bvݎv,K%w`6 + Vt\|nNS'[ӡMj6nb'G ]as-6h2Y+h4-̒0BsVFRR*`rY܁5z%f ZELm5׍f0fEu. -^;t ='OV $-֕ EVt&3 :+0DNߺͪ(GvZaOTԙۅhGuc|Oߩ3}:ӿZ}D?%=ӯ=:ӯ=KѰFIՇv*+?ND{}c *h́ zp7*Mȉc#WFe4b 6ME% t,pkS*ږʃnWyN!E- îj)w0l ; :6h`eb'hm _Fa'v*5؅oT?؂U}x>>)-1bfeOwoVLU?k% *V;*VXy[X?*ϓ+Os4_y\y9H^J ?=|CEiP-sv~u_\\?K槿oO?Uw?Sy ssSDἎRQ~w '\y0I-T\GV\U&ꛭZ|tPu\]OϞIlvZE3~[hɫ^) [4@׈oYΗ) -;W :lmCA]sjrHT|P~iz%" ]S(Q~)ChZU9t3JB:!@C  aǻ)T]!"7F]qj)\AZy]c}2D8R.8LVǣf[H]#~9wt'j٢m.rÁ[4Uz`e[j79IwUlku+N\NӔu׀4?j Ca=y cw`(y7]l+kp'. 89V,?jzڊB;гmtetr~~/=H/% ~y>#~:ju8cg:9Tc6k;ÿ=FumMxM4qVe~plTǮekP맷G_NQq>Kwwu ucOcH_J+4RzG5/<<<}}ulvxT.(Si 끕m  cYrחYĥϯ{f}~NL%z*rĶ]p擖-z}{ yk,K7xD' {҂~w_f\\\\\l|_XDy3~:k7k#m;m7$2)ρ %8@ҊʶVN\8J޵ř赾'x_jK}ÿ/}}1-%17g)1U,G+-ױ6}uZovu̿lkKm{wzmnv5*NZ_)p9nV yv~xI a4}r;.8tޕWZnlؚ_ݟ Pݟclq>_~3O,pl_OAooIkH9-么X֘T-Z:6uڝz^n\N5hR_\0 Bz4Ѹ>m-j{:hRlĥM4.\)S.z5fee.{.y.e.y.'ܩߢR>R_JOgq) }ghؒvca0G}:aе6mTj~k ~~xj\zk~}_CKG}Zi \>,͏g<۽ <V5f-F_.: K}y㹔㹔푟*/d%;۸orһPǻ?Gxǻ?»?fBEpX\Fm:sY98zUJ?ޗ4wg<:.n]!OsotnE7wRz_܅ܟx_,K}qsb7ϥTϥ̥j{B~[,lw?ڎqK{z.VW^ӯb{|4 WE X o**\X-$[M7hovhw^ߐnp94ER:8c ]ݰɍa$7u4ꁫ)a$X~Q^p}3vI -y..[`n?T qϮX"z}x.sg.=pLzp1 .S )p`[vW: )1>gP"wW5Bz}_Vhdqy<tTHK?˓pp);sss5ssR{u$~/TH˃ Uh?_HpsQrs![k zBc~e?~<]ĥ߷5pA){pLJ`[q}i%/%[,le^hR.5p˰ޠe. \N?Wnǖ_&hi;JnVW9\j\j\j\j\$y.GwIJ_mMwm ぞVۦvlU~[x1ckˬwaRy&//v߃[ ˛7U*VǢ396c۶9ڌnۢ3ll=n(r)- ?)|qu~Nz` iAM.jQ6끋mO.\g\{ø޸p)<\$ܑ _!ȏGy,y.3Vdi߄xu"!x y'.XG6.w͸6udҧrm ֑ \\l\޸p'.tKM«Q«Qw( zw8ޗNaiE(OK/审r<r[ )t-6PHU_{^l!MC 1Ev,0f=pm-\$y RhCk;>NtwSUCJ[lUXu֔NSъ nꌲE/6N\'Cc\HR.Ǹܻ,tcwor-n"_;([w5VRC\)oZ/p "zZˤ8Wp .g\nY ~r9R^{_b<eBbt =_c[HSqEʠ;`N'W-z%hM ?:];z!XָFCro%4.B zܑ˻VAR ј7t]xD/X҃ћr#OG>/bqp H)B1UEc 끞m n6.OBr 3T>+ӗ rmFIo)t'i٢\bq BgOI 6 ݸ/}1V5){#[۷n#[Se@з88TWeni9=g\Rtk>F4]IY%pt݁&es=4H޵']ĝe~e.=ŝ\f\Tnm\˰o@, .eeܰBjطo`y.]v!مtw-gqe볘qp]vhc .."7K.N\9ˣ[>ܰ8)X>?>փp"^-gr C-O\ΐ/9KdVvwV 9 wtrEGqV߱|ǭȅd.zݫzFd+5ON~!]Ƨ+v*>~ ⥆s9⸼U8⸾e{UJ}nD٠_?cƗ#c~lCEϸ>r>f/e~l2GKrrK/ wbǼj΢hc>fc"gk7X9GC Xr*Li. չW.+ĸ\4쓗 vy>$.'¢?vY3˹hs]Ev eT˨.]FK]~3b9G(28 Df9s8\TnfZvZhe}exR/ڥxx!^M?rj ]DR&ڥ ‰sRb5.W[ìY{Bq*pJc'Z/7~ %N\蔭*2.Se"rABjʽ }>'8⥣W.N\]9Է'7 ->qnrĥ>6q^ =Z\z\E.ثu?Q>B-~|bobbT0c5oǚ&Uטݝ歜Jvp'.G^|?)r*:zv JR'ݚpb~ B@?V?X XxU.XjC}6߯/"7KJ2?v9.7~r]Nإ`K vi KXel2v26r d."kR`K\Z>\ZKO#w#j]cc }Lu%U>>vcc;E;0ӲGv >փu15fv >v1EǮsk|ѩqT مffo]D`;>BZiixF~z} \>Y)[eo^T1<1kفs˽pn7-9lM0 +-ܒSE0ԲG+6ts*p`]C>kMggVN."wK;qud.]v)R62;#eU*hU]VA&ܟx7˂ؗxY=Kjhc_[Ʀ =mգc7b_8]neV]U{蓹\@.ƹ "97c3N%Yꚏ9spϩc0W]6r4b z9Y ʟvaޚJ%JIu}Cݼίrz춰S ^p_N>6S̷d0,mD94O|C4<-GK/.s]D̙2'eK/.e]};f~q'.WψМwͫة<8\TXUW_R4|B2xk.c첃].;$.7.ɧpJB`zRݑ ].rze|*p+\(\|Lt%Ee#wEwC6_1%e.#{Wo5.+S`5݆8\Tnm o/d# \D.X6\vKh.meӏeZ|q٩[/;FR]ĝb)U}:/ |cGG5:q>v?XB|L/k$.#مjyEq*pBuXK֪Ojr]Zv?v\-hN! Rc2].3ea:!؁qS`ǘz?vs?NuN~ .N\?|}ȎMx4 oT׭+66;3m`Û%-C.վeRsx+uɇSC;"IQ} e^ ,g;ӫ).V]-\Y7shxFu]ua\0.28[s~ݸʠ-rBe|e.e.+p.ͰsKp 6G蚒sySfEה˓;)i&cSR5%[S=S ֔$oD.NHywpJeخC#r*Ps lvx;[oGO\Eu͹\ ,u[? m0n7{s{71]Kp#YtpK \K \jr>\V5:syO@o;z:{3_B_e0E䆾;K \¥ri .DG\.…w*aŸ}&܉Kwc߽v**{?]M q<)eU$7jQw{v2j˨hQyMrerٶƣ\DpڥlKٟ>y>9x.8\ 铃We.3c4.'cӏDWS3cw`?v;c~Lk`?eV)^sGoRܱދV)^kL1j=-re]ix.+pY.+Xb^dO$ήzloj=VInkK?vYc1ޓrKv2:el.c$xY!^vhexx!^Z⥇x#^}ǧ9.}]٪xXXY{>?<>s*pGJ?\s9xva<3.!z5}v|>_0'_}؈~,Dza~SOW_p)_[.5{7JZKkNx"gSJQْS&\%lUhi\ K'H>=kyp$7i\D.)wݕf9qʅ#NL[SR."vݡ68noHu0+JEnO vvn] مf5?n.os?n.'ܟx^]NjFX_/:Kxc%=^/eڷ՚;Дa/.ǟH ~ۯ~|_G/:B%Xz-mvYŋcJ=Wp3T.˹\K#Br);CN kgBށ^uglWsK.=sk}מȇz\ejxeWZ4[U5ċ~9VشͣԷ$ų(\gon⥄x)x)!^M>>>}yXG>>>k >~;q.Ir*wHyr/Uxg<*g;\Ϧ'K*p١O>O.Nw_ Fk\pPfe#3U ۙ_J­\ZrFr*GV=%E*TWS xj-2沋n3. #wK\]ˣۛk+jjۉET,՝t*=~1[䂋unB[_KN}itnѠZ/RRtITWSBhNNi^lN1[䊋unB($wQ 0هnotJ:̢[xw)[䊋unR;} yXFG/LN/LWRůvեplW]ĭ\ ]5gn>\u2S+f;[5nCZv}CZ"ȥ~ r2?yo8D6lN! RE.yaR9"Kh.Mk6."v']c{O;esJl{6R."7ҲG'qHˠg;2O\Ћ1; ߬k\r"rCft+=^hxJBr5f6VZ]4rXMrE܉z˦GGZ}ǞJjj*ڴEKtw`59s<*kt{ojݦu L1ʣ9E#V: ̛\z>3>%V;3KhN%.hkW}|}A}LG=`cB(f\|rqO?\FB}ygxeM2jRrԝԍ\IfD{=iygR3 =zL>,nU>EncEo .E..܋vI\TnvA.e.+pY.+pفri5~lK28˰je`XJϷCC!1Zv_ƾͰ,A?>_.]V~Ap'.7ϓ[yrk8On-ϓUn9ΓyryrCd-;Eχ7*/fwABf ^.ڥO\( .=ۥ. JvRC}.Bn˺.%Nr6ULۡ\D~'>p!+?uރ6w`ߛp}s?F>֏a'U{?V:/!z؄xxQ]ĝOz3]Im۫9V#Twz=mJ]tӫ9|&8\TXUWR׹5'{vU."6&].ouE˽A snY.eۅfEʅz-,4ѷދ.TmIߥ)>1~K+jOWzmesu\p\8s9fл_-iQRT;|񍪫nh~fjj"\pG.30-rKK}NwV<,W+).4nIt9\T.HY7Nvw\)N{KUUrºn]Uuvoϯr9t^r9vr t{KRzam]0 C{!R~.}W I=EYIb%uA7| ZUN2l]/Q+8'O,?ݳIحh0}wsP?utJ`Uą2WOO'ݗk%>,t'I͠BE^Z*'>թRFzU)?Y2Ԍ&^bн?PL?s ]ljf7@KFKEpK RAS1|(Y?t5 VԻ*7)T=N]4ьHoѰ&rTаbo>8wSE ;4,O9(|;ATаb30W5toWCܣ)Z34Yt}{j>KXcB[g_+~k'=mlYs>k|ZRYj׈X?9⚙9EIZwQ[Z2D0q#֏AzjӡzҼ,6'4f_koh pog(|2@J;E/ьʘډC½ZcPL?*=Z8Ql(z(R'uШ`ݩ-n]7(|2bS.!5׮"UF zfL~d zW nRz[zGʺhoA[ЯԊc54X>l2J3c^9wOϢzT_$(htɻUzNR?Ep,4X3|q|9*74:4$UO࿙sJo3N*`vs)gRܧ0DYOh#f詥vNZcFCmE7)Ԋ(E-hMk,z5ZBCn9ޠ{5~5~[Džk}]'"Ǻa.A~h9`? |u$,z1 |.KFn7>ל3.;M/}ziJ UǶZhCGJ:UDF+jEYHu IqŸu%YEfT֕:EhDFK/ T:&%0DEϸDVEsKz)RE Y91CukuC\{գ=4Zm:EIfߗWaZVNjW=}y 䊷>\IYv_A33Ow(|Aዔ'^ͨZW8ڥZH$Fϒ(*Uj*'=w_;—7| ?z=o)EuzԔ7)5>5!*.E9|^`H)fy.}f19/Rm̶#kֿZVh[S_t[N?y~Bpp[_G>}4`|G/R(z36ӠQ5ٱVk/{j2 U~_>m؟_C QvuQ4TGҨ{ GݛG ХmV'b6lDO:c=-8,>Ԏs{#z5§7F 0]k<9R:EjX#1i$EBGJM&gp/ZN7íf]Ez< %PrhܩР1]I0}>h>hctb! 8Nw:k!RE3Ju:բbߠKsT]箈URdh9owtWԚNTUNjd=+޼iR*e@plo}Hsfɜk5p+)#`U.+V)aR=h\;5^kJYtd'^(*it ~IM+NyN2=pAg =ڠXm r(JGM@v9*?җvG?:?:GHʎ~fG<яpCȉF[8,qFc tFcWuFC\t% fl BDô%.Gsu Z烯`!syy{v.\@.?\݀-˸]E˼hy!p.5إVR+r-N\{Sl5)CK*p`]I-{-9FFoѰF17eiS<%Пg^n甔 O[~Z*XaNp?rQ`]ޑX쑋ȭ1z \"R߻GRL7"rƪF.4A5.b6.KO5."w_ '^!x7Ke;U.>3ݚ} GE܉˰9a۬m]TnBݓ] :b+إ9s+Et'^jrj\|xD.XE׬To.picw~NląOR} V+,^Rme/4/p`~݄;ryXT6^i*3ʇXsJ[В]ȸмǸ KГY%.eW0,q[]n gf:.k\l`vyc.k]l`vY&];XY+k1 gB/&G+ "c?>s8>V?>zO?>>}]>?>"O˩6c+ >>>!Fy{Dq0f9n.gԎ!e'vvT˚h='/iܖCs&N.".+n\z}DZq'.KOOϢR}okoJj 1U{aon7mUL-?=ؖ4tZZ_Dnox0'//xaD7XNN͓} Uט}_8gj' zxbֲ|rqlT EWR5xݬJhEU&ܟx)=rhY_#rC>{ow+U}RI7j;?ciţrƪuüukvEk5؀>l|lc8]R-߹`wBsan)e'[V|l=siԋ\\E.$+ڥWK.]0s9\N\M"ȥuU9|l}c+S&|W}D wr;̹bB.*+g,ƩeⳘ"eҾv6>OkVJm|̿qOP."]9e#zՕԴ3 vEv-r}`eaKȥb ɍK݈Y?K"tw|c:syyC(T9aq0OX엛cW.N\}.{w ^%f7ĢZ}耞kGz\+o!pR33{2v|l,IqESxX#o.C$bKgr"rƪƬn}>Ҹ܅\N??W7 R)X)D=Xi9O4Zn3rtwK^1G!5Dlj\&}OFX&!1|o9i`x>bs~iqƺ >&>ƺ5XuT*ewX=Ge8k[lM/o=| }fzcRi>Fr1E܉ HBծ\Q."+)Hr65GK)o^͡;Ċ=.ǧ0]I9.e:Z"nB]E͡_ Bѧ![n59mR0]I ۣ9|fYZv3+j"\˥w^rۃp?~;|.<2m}\RJn{t6+n{E.Dq'.td{xVG䆞t%;7q.}s!΅ƥ;q9 'p4evB.*+c;;INLZYQ.އ([.KՈ,MC+ݫ>Ei{xð"ӕ[Aft:mY"\v#Igiy8\TXUW_1o9|r\EUPE.a qp,Ev]+LNPmV\D.XE|c뢏>NuM?vn|F|l܄cԏckvI;.]~+˓]WӲQsVC)oRJoDt|3Q2u!.Gʅ$܉ѵ :rYAe B/]]h{C} ?\\zA.0#q\v9rl.'܉˲[^ Q*ċȭIא-0B %0ׄ;ry/ b /6V4}/fv9cU]IR}anMr):ZL3.g¥>"rCb|\z?\zO$pP2$ָL̸\xne3Ƌ_fO?\R!'ƾnSbߌ].Fܟx[oұ\~r8kQ]C~]X;!w^uދ]JEv)-ۅfRѣv2Eot́L>3KEv.m##op2OS`<[3 v`?v.}&܉ɓ{YB>} } ձO^ r,rNKe` vY.c:.5إ~R]0U{1v,hY.f̊vvKh.gp'.S=wB}<";jӣA?1N.=c#cӿ¼\?)Jy+9l|T]2x\+Wϕ"w.\e.z\k-=)rzCz dN,6>'N\;}[݂>v."_]k}hĵ>%FKډ\vU"K{/.MO1Y~x;ݿaIt]Һ%_c vuu.nV^|v)aN-Ev)'N\~/cެi}WI4<"v ehy/c"Zў|=}!>&r1ѕTvǟ+~Xs>Zv]-)UwkxD.XKxb]f }µN-qo}6`dXS]92^ D\0%eVH>_l\:q_b.qۣo|xϕp'.U]nee7䲽OC}}ﴁL?ws=ykj}~sp]bsK{S>Yted.}8cj.[1VK w:̻v: :Gu]yƗ_V_`UF=ŵw1UϮ`5<"'6<ح{>#.u.å.ԝ.åWݞpG.7#CxrQ9cU]I \am| ywaڸbm`ymb}mo} BI\: y޷oX}獽;ɹۼa}2cӏsm\ӏMc">c#c3/ ca?/*&;>[n'6~6~6?k;nrrN _>_0U׭Tr?CO c_}iroX}5f{~lBl~s1x{$Op? -9S%[b?#-E!Eˢ=eٞH"rA/꾒n|M99\DqZK>r.=pi!U2}>yd."o w|Q~3,\(|sZz> ح{:ʦT _ |l>y)oNoJ`ty`?ש| vn|q*p'3۟_NgS3ȽOgӾ|vK?h~.fv!\nE.V}U[˭ pyǞ :y~ќEPJ=>ӦӕԴ}3oP]7lWn RϠ9ľ𾩾ޒJQ咢:AG}9oJtSu\p퐒gX΢g-*dwrʺz z UNOZv5Q[KtwmnvyC˛;]tnvyrKh[:׷wBЭeRژtwr~g9=ppEt5U-50:rimB\[P."\iف ٽʥ[BB:r} u5Zrh^\[_Hq5+~\rag]gYRE{p ="/ɮ+*jdrt :Oux`Wtɭ*#pe.;p.;pYE,E.7p9p9MMOseӊr6b(+Դbm>z!BzHM\Nr>\NGk=bO\D.FHM?؎8\jy<|xXXap}}C5oʭOΓˮh]]v v)h]ZGvi=ۥulcLȖmH?Nwߨ')rʺvӹΉ6m>crk9ĥccaܿaܿqqfg\vRq>.L+fE?0ҏp'.Gϴv9]F,1.}m\a\Dn ]ĝWtwir:Bԓ傏us*]PX+6]`3va9cU]Mnv|L/%.cM\{ARr)+s) O>qSͫ0%exu~[xiċ{F^z?qSЫNMO?ܗk+;{}X_kϷxkL>6;ӕԱ@|%/ZT"<|!V: \'Et%e7XN+nX1.W'Wѵǝ7#彽U.MrvEƅt%o-x%VՏc$ܑ˻ݶF㽀c$>D󱆖]8\A}lc{c4r:rѹs9\tnvzNEmniA!}%.}` v9.}e.e.'N\hoNyy.{&qD]g6Ɨ_./p3T8l\_vǔA>H>>Y%.Wji\g\X>COqMc׌_M?\F[acabe]2F*ri\ZMi4gH/zS{/xXXWLcm߻ #܉sao㳍<-㱏X~Ε>ӏean9r|疢X[4p-/&E7N\~{+ B."Wc_4g3W7?q*܉ϕ/;B}R!lg7\rp'.\Iλw? va`]NceӻN}%FKp'.v?C쟐ڟ]!k8*79%pY+s9܂\n\nA."d~7cp*p'#~9|Ǣ׼.IikJ/7TnoJ*\*>pL*{xDX˴3O]>u[vS!%eV(3p|޺ڥ 3jj;)."gkV]!Εo.oEOvژtro!g1͑),uy:%[bg1iܯ;n3.Ed_s]88EJѵfr t%;M%עXZvRܑ ȅ{nR+CR"rú ) ʅOaP.˾IT.,W\p'4;wTs:yr5erXBt%'CN=rK n(?7h؟",ĬS;??5;T3 y@LK:u׻5LXz>A2&=o"Lr,4X-yp~Ha/A%G @%`'-HFٟgRjUS>Pg4XT^~T[$Iș?\= TJUI#z]JGd_Oox??WNN \?~?A_~?_㯿?RuW彯7Dȟ} S؟_?E endstream endobj 64 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 68 0 obj << /Length 2564 /Filter /FlateDecode >> stream xZYo~ , !3n$>%1!){_٤#K0IQ]UuuUD:?\D|s:HuܬXHFf0j_=_\͖ w?n𧗏Þݕ]jM9~sKGvNixB^bO4k$d4->pnZE'΋02R$9>(: U+X0R)/w;5NC#l?[y]-ө ¨+Ra$U̍0&%v!I Z}P Jj&9DUE,@SP{!kI #$m ß3[@0R 8If߉*D [" ?F*F"TKnG۩ˎhsv= <㌎y@"39ٟXd S%ZVa`à+%1bT"x/ $#†dlhUMITrLoǔ{A -QGĆÎEej؈,F++opʹWGAW[2 flm" 1 "a;FC 0.;|h{m l( Qv e6?CxXw7uc/Tr¿e {Bڹ#V䘭e>ަf?wAN:M}J. lowZpȍRk><:v\͠(XhSe `D;=dKc/s9&>a%2GEcy+^oO-.U~Tr Phh{9"ǰ0Iu1VY4NYL'Xl^P^s@l_{3/a! 5;c\g/*uoSdd`-d>!pw"6< |mLLH0㕦8_*ɆߟU1w">!+yq症:' ,dw%`$zִo`b7˹$>Ua]4OOt{@()"#&7Z;IS&{9pٔ~.5/aJ^ , ~J^C%Rx6֮h#e M=SddkfA;w|1tQI蝌r#)OGZL2c08][PaēΙj H;QH|}_ph)ih 3qMgR<ιQi$Ji>d;U{>ZаB&ivgZ|&^,? &ynƒ{ݐrCW Ͱ+!b[o*k)K{v8\@9^Jj_Bgʦ9V0mfx,#iR('v6Ea#p7 w O!e䌯 &CJOQ8C9:Èn!2 ( H`g0 [J% B[ b2 r~icS& U1 (s$V;"n{>cJ.ۦ!K>ۆCGS t峺jӧ,6SG23eKH4G;U3(+:N40b<؎DlR z{']wx6Vq3E{)}[![hR "˹Vἆwws`Gt FU)Mn),]ƌ#Ym_zބ֮TuBWyf!龪y$-gun|IzP ş(:B'+Ptqg 0j67Zԯ endstream endobj 65 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-fitendo.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 71 0 R /BBox [0 0 288 288] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 72 0 R/F3 73 0 R>> /ExtGState << >>/ColorSpace << /sRGB 74 0 R >>>> /Length 9556 /Filter /FlateDecode >> stream x}[-+F=KW;3 $0AgdO%aZ6+ `뜪*Vq\dr#<ǟkzH~?~O>|y?W?|k.zOg |!S}j*>pz֭gD*!{}BsX9]d#e iE,#QC_ d(I?tqps3-~.4rOm+nt>Rdtz3;`V&tztXiApb=^4w"p)Gla27e~Uxp߉}H H*-+-Nl!o\+ܟ> >f#45y75^jWH)Ի*eRJpqUpZkU ZCJG"A'݇4*v_Of)wbwR:=nuwbjw~;Sizt`4ͫq{#_aCX[z$Z42.oԫr?SLH,%uGoGDF7Hx>tzBkp5wbwR=nuw0#'NC_6gscTWh6TsBKR% PHk(v෢*~+v=ŋAow4T%9uT4KDȩYI$+#4^df;4ş Ň(1ܮMSõY7>fPnώBw6eډ=H힟3n[K/2ݳٞ-ؖDlS[PU,kr#0uϖmPl!/]2VCcNѬbq%^K%58ݳݗ({CpGe8-,"uGA9=nD#Y͎",קgrqG C#'uWT3p,:Lvjtjvl+qPN?QveK7'l;9i_^v\/8]tY%8䗥pBLPnyͶSۼluwKf: 97[<wse0&]Rn_lna;] P􋺻ߊ%W68;,ڲ6#fg%2qA`_}A]n|o~+Oe2,boxF%j]Ɩ%u*!Nm-][AEKX$6FNFlr<ު(7;JlEsZT ]A7}VǦX.˴Z2r*F97_/s&Q!X|fpF v2mPʖ~e6ۏXuG,XũG,WrۏX+ӇmX$s[j.㲗w㊷%Xي(Ezfˆ\~Abw/|n׬>zXVQnyɋM`+98[<&N)/r݇o4bgTyCr ]Qne)t9nc\i۸ޛo2lg5 9u9\N{.-eɌ%4.НޥeF=Ft~3j8F|=\aٮkvi$cE￈eg,9;jErJ݈E Wq6#R5b~Qw[\{5ɵ9;"ԄYP(ygL\K kq؟k *ȲkN7Ј{MFm 5ɇuqR!˦s钂m|MNw$lR_%}X<1n$_)}=wO H^7KUɠ,۠TOJ [`ǩsd[Κ=ë%+-8X $uImПPwzw.۠c%bI2@R}FXj JF+q{EhbᨘoƲZqLbIEk6O_jjlQyMZ_Aw\+Fon=bq6-!9&uy4cokQn%sc7umPͭluwKF-|R8uWh3%U"+N~>[3r*rEˍ;R GX+ZVa5z9M%G㫎M )cU6􋺻ߊƮ$'~ [U?!X|ERTY = ]?JM9b%G?wN/0ke;f,N;0KW.txd;,sM9_g,ݳRwհ<@._b3VCݢ֒G,BX.&F櫏%gN@)|.ϥ+YP_v5ʦ~Qw{ZĹ=_Tsy'TӶE9c"'3Qlt~+{PCs8zH)_K,zHq.PjzhԖ~Ab=Ϭ[y6KqTpcvsr?i{p|W8.̻ʦ\~AVw9@iЛXzY'tKm+8H Jr5_meZ('dr.LlP^}m;".(`牺ܴ *~+~~nʹ-im,8R,6H~ R>RmF]_G -9=b6kRBX qwe,0 ]RgBə(K݊]QKߊYVܸ8 Iշݗ.˫+tE' VziTcu~+zMX?wNFި[I%XـLܶb1F6(_ USPcUmzDY"qVS]Ce>o2w,̑kYwvcQӣByOψHT܅8XRwtYA7}O~+?孂s~qOQv#ߢPހM/ ]Q9$Swq/۠`eKNb1̙wֹ*NYBrɑ.):W 퓶S_ or7I]/}ݘ߬}kxއ0ǁYq H7YMy$x4b8$_f,wFș5mev_PKkԵy JdeKNOX|j2q,NXn^MPP,7.^ԩۢ\.۠TOKp_݈8+X @{ ٷb=包߈ůs-ߍ [nq Q(H:6.۠5ʖ~Iw[Txt;8ٗ97_)(yW%K*i/-RN_eFْ/~3T])#q$y>ҵ(_ԝel7vWʮXpZ8ۘ80ki7R)Ϟz.9ua`^mP%%/𛱘u N \Qq_.Xs']Rq_28ON9l9ʖ~Qw[d+c!z˾3_ya Q(ϗ!G^VpzŶl (rEoR|ފ';_;Ry~~iZr0CT'9Ke !ʦ~Qw[Lc+:}GnMl^yg\m{*+p/Y6􋺻ߌ &8C2,e2(0v𦴐sJd)sWTٔ/>V,81ܪrtXכl.Q.{NXYSꊪ]'p-uKbt~3Z[Gp.l^okݫv̓{̰y59~8cq-F71(<#gR!)%Inr9CrcrKp6|__zi p$Z~_WǯV~=(_?-y4W| ԇmZRk)&n`H&Kq+%$7y;!nW{n59hTryoݢ./` ?@%}["sէUh#Ӄ p}kN_BtL7|w|o?;O?-&f_/?t/L[6.Hg<4c'o%HIW){]9x3g4 /Ѭ7T/^l.ՓSM:8x5e#r_#ަpڿf+ 7q_#^'p_e# r_/xwN rp#}?N{Ǔ~|ޯI^6߾߾N?hbSzO J+Ź٣t%nŭ ź5tV~鋱nO{M"ŵ&[5N{YwUJ>q!߾w4Bo =J[(qp~wz[[:[^'`ovZ_uFy8ˋ<쩩A)3z88n:/s]b4ba8u.ǯ8qn- ̃S@: Vgx):c4uvx%.͘rYui|S]YTY'B:YtziBX]'Fwa ߚGm]{/v0GB{i#fڹÞ߾:SuqŮөZIƱC4 ;,kibq|\{ָq'`v_a9@mdzpe]q|Yih6 bmriiS՞Wז|\5G?q~ ~ؙ26{E']qZGG(\CuĴoHO ̶b/c'ˏH<0$o0nd ?c[ͤ:a~ 917WC(/yG-n'ǀ?\nvICet\@-";l<<_N}ԥVv7\w?C*~/4lhbѸ*ړovt7){U'C>g  قӹ?XF! .>Ó6 |. >u>l1 &/TUs |f^;qp |B z1 l>Sg77o$~}O>P_s > E|^a.>,Jl >OvKfFS ."|G|^3g:yXNN>vV >8OdC~>drdl#>gL>?p^y՟Cp p}|<~>'> >zOO8-> |7i9&' []SoX#\F|ډy:UJ>ƨO t\>_c X[sw|cqkA>o6|:FAg^+qsq"[i |mstl>ISS8 |*>JA30ԓ|jf<|x|.,:|gs >$'l|*cMsq0]Oc<ƕ```_+V>C+Z>'f{﹭|ؾ+ٵA]+I]O`V>'_;dX|2dL||>+9R7-6)l]t>>ؤ]SrT>l | 2#x{gvV>,:h C%!)`h֍72=6 Ն0d[ӂ!Ci2 jY0t' ^a %teu`aDC q@ CC\#ô`Hkܼ$8l haZ0Ԕp# hCL@k ML; &Cú`0h_0`H !`06RO08g e`0,ҚL0ق!aby P Gq C О 5HL *O´a!C ~c tr*:Y? ς!܂X% ZX%%40T' a `kC-?a?@nrC>a(' qM0T' 1!0T' 9o0]0k ւ!V NC^1tv&#Ɠ=<ڿ쁆23d쁦+幜7 W+/ÿ}Ï<~5=_~W;NBilﻟ7?D* ?>_?ߟ'eί?qԏ Z endstream endobj 76 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 79 0 obj << /Length 5391 /Filter /FlateDecode >> stream x<]۸*DX Eګ9*GhYqfmu7 @AyKaF$ݍYֳr㓒_]=)JVjvuflK;oW|=}5]_Z%6vY?tۯ?aj{?&xcWD#`e) k-#( /;|; k9Evoyf 1M6"R΄_i[)4p- B1ơd+Kk: =L5Tn-WADtZ Oȿ<[H)/lVU5*Jąn`OM]ԥEݘ CЂÖ#` bMQʃ,3H5f쓃*FvyIϰh9o[Xgl؂&M>C yPN̤MN ÂsUe9490%zIL9 x'nspn 45y メ P@?V?Gʭ_[x0x;p>@2tHtmxF3L 8ۣMe$;\4u X7?;jcM-=̰)*cg7li\0S2B#w @ˌdT-8ZeGDMChkL@X ,̦_=@ YkҰ8Cm0+bUbO_l|G+SCtP7>[E z{otFE]׳$O9t Dcr yjvbl:g&@CU5#mBG\`(T*]kO:U&dׂZ)VI~)(؃@lsTRF/DaoSEC`:C vZGRp'8mx$g~l!M=17ŷg9b4¨gsiMO gפO<큧W&^Ot{>Ѳ/rBcd**!SFiYǔ.MG{k`️W~![,+S?y܄ uI?Ϳqso0k1qqڻqFxD<$>,I1:X1"Ƞ 2O.kח{<9*KEEhM5c$#DfMY@WeNG"In%(~b Ŧ&u}l:8&ƢP28տA=7DL3nDķ ͹gzQś`)ZM؊gBag8Ы[8t~'3 t!El{׿4d <q7eUX=,Q40Vm m#ds7^Q|l~;R_~ç (!C^^8\4upRG86'Go4|.6-·鉐%^~΄t}l_J޳:q<*cnÖɝUEY׏5:f U! ?gN]ڏ'`"4߹6Z0t({iPYcoy**xȑVI?# U`(kUO #׿Șo [߀j@ qC*{EY*MwzeQIߊ8e$/^|dVXB#zOFBh(Ո@Ȥ8FNTT2_Tnu5ЪzT6$o %,V,lj$0B9~o*鸨\T?EqQS(EfO0.Hl8RS5dx,_ Xr+p>_Ѷ>lVjE2_fEJ[SF +spQ:J^ܢxD593( s :5ɰ"r&/u@Ϭ=eYpAz >k3\k@[0c- /&L5CEx4;F#Α%V 5Eٜ=2"\hhD56%jґ9~uQjjS_ҙ=}Oܙ7G;?c]‘TQ0BmKBԃPxzy]=.TWΖ2B~Rr<,[ϣ&.Fh3.^E(cSyg"9̙-.ӧ0If˵~lCGei,#aB!鏟B͕uIQOkPBg!vۖX~HL=k7,;.lH]˩: ^طu8+y.-XvAD~oCTe;7:Lޣ[Ǎ E|@ϥq춪%Wk:idf'{"KQyF7Fpz| <[\L3pS60B4{ϐC(1MNJlK;eWOLQqH=a`ȃԹDP)5EuT،o6bFujUD0CJ|ulD?iDQV!ş!p`*;$eqQR?ѩD*՞,$6!Mi!NmQD52 N]`oӣ= <~](u^. eGGILmՂK 1?&d9wVeX4,|y?ΙTwnﱝbDNl8@bT8V0 z,]OI@IIa&NPRڸ ZQ5o|t٩wvk\>EvksLo]?:E]3;\ǖQ.zTݩJ* J඿_w xʒ8zQ ToZ]b5GRN,ҕ'Z}}ĈH2U:"lGHj@3 3o#SWz4w:B25sX.o@Or/p5~4:_˂Te*k/+޵^~32}SFQngJ?]7x\@30b+yk 6y3,=}u m~88qmq`(uɄ&W ڢ| eY CZ{=ve!r 7eJ:+DON7mTR>zv ,ޚ7zjPnF!Tyol?Dtx8$0UY ˧M|Oq endstream endobj 85 0 obj << /Length 2999 /Filter /FlateDecode >> stream xڽ]o~ D<^z>4}IVNQ:w>%; PYųY: !sПLpD|<50Ğ~+Z,Ӫ2D4&9N,jL>(IiMl@LU?zvȍ5ϱI  E2"́Wi j_o*"g1{j"w/X@BZ Ddf^I U8AxO-!{^)H`u)bF3[ՔBt'ܵօ0Uh *8FJ2=*Vؽo21 QaAh;t!Oz(dr֯L HQo{oC鵴o=ʎl 0&E|h<{0 q`8٬SפS̘B}7ڳ ="Y =kFU}'sB ;J|7'0+~0qđǘf:8Vy(ˢVAih/G؝v`)翄Ք CϯuqUU( K͍_${YzT_-3 <BX:v.Q"+^8> /ExtGState << >>/ColorSpace << /sRGB 89 0 R >>>> /Length 337483 /Filter /FlateDecode >> stream x.˲_O1`:-@#@ne0SUnph3/+/#F_W_W]SUF=ƯS~_?;ǧu__~_߿+s>[W.:Ragܟˆ`?<?{_6׿ˊVܗ{]/RK-}/yyWz|!xKοr?W?o<Ϙ.fy>?GR4QoTW:?Qm\~㟩ZIFjg ՜P?}'~{y<~gb%ywgxƢ٢WQQ㟲nz5|f4Ț8ֶX=>?ϫa£vAzo[aebR{0_ *~=A=<󰯳pS8|lTQOB3 Zk!Ĩ|&zi ޶r|51=!lzfDv\fQQ/=38*Kk՟iSGҧ 5I_VR<_(Ĩʣz,5Lm/L3e>]5<>87zhSώG!Fʆ{m34jOLm]bWCl VGx>$7K]ggpIUzbT҄)_dxbT>zo[aC.W5~;iԥc_ۺdžyw~%ݷݜIg!XIlS y>!n~-ֻެG!F夋/NoQCR1{i ޶rC 9ؐ#zn=9wIB/Р,>N5{a`y+PϿY艹ZXkw†j^耩|$q^Z[x3KkoGAl?q^9`yw$wþܻu4WQuFXJk֨!35{{XbaRC9܎[}WmnX= 1jS6Y^z|5i3KkbrWC߮r~CJ:#H|z 1*gDY5jOl ޶rS=Z'َC̊lB, pK(dԐ2.ZjԤ^Z\8Sυ ;9gg݊@\tolңr_M+=W|sѨC=zo[a~e5R ܡaCx66βK<3#ջUzblg^xs5j`@<zo[pv̧\pvcicUΚ,HOBʅ3cy|^&3y{z}w pNK3z%1{[,ԣP!za5{JsH~k$MsS6 QB d^> Fy)m-8uo{=q%>-8X଻˸½gm3[\zoK'܂uoVP2aF!׹\ ]?>']zg^=NC z&zi ޶/na .$t&Fs{z[n$[Λ&wCڼ5{m+m&?Aa9c_=-٭鳔7`C=5)Ѡ޳<5Gd/̓V.tsy5ku M:T[o5)H/@F N=Gm+'ͪϫ#lJ[gg5<[ғP}aC9ZpKޥ__[}o%V;̆83jYZ{ 1*򌿧v땳 ixͽU׶ڿrϫar\r3hS'!F?}O덳jpr;&>o WC>t|N#3x8.Mː [ߝziT yzTjhpiԪTD/Vo[Yno[hl[ˉ%pv^z%jgɖ^<4!z&zi ޶ɓyq޳- zr 16h/h5?mn5#|IB F^1gƲCU ֈS.!5Kk&ÿVe4}ˈq. 1p\rX#)szWQp3ķܓq.j$ף &>ChEEtRfI'G!FUT\֋KF-r=5{ʷ7 aDo8R~U~zGB\@ EҫgFh*^Z4wX8OV^o.OUzWClg{ըY'=&>rDd2 lX>=T~suĵzS>jo 2QC5{3ш`v:sFxսK+t&lhǡ)z>Z5{jm$ v`%Wtn (,cMF3RRF@P5{j; .@==2#$а{;Уx%ti$w^Z<5K.jgkd'>2N)[?]8= x)za ޶B;$|,+}<^fF Z AZ.$9{f@Z$g[gRU3< r>BPa&BFUg2^nT|&{i޶3WC;wgY %5tԓPuUC{Шl>zo[i~$ODHWx+%.fMAzF/;ѢQ!л{i޶ƀB1$\AFls~n P]tќO1<ˀ8y&J\C^]3OBn[lh5ѧI8WsƳYm-Msk^ 4jmk @mAc, ȸ-> 뾷]6ZW9~lAg o~fqVO?aեgz}!= Co5Mz)5jӉSD/V{.%}9oxh"KRp/\2>= +ɾBpI?Pcw l.~r{@qޞ%(kbTez5.]Ȃ{@m=Cj GرpIFpY=!|xIH]G6iT\pt/Vq Sg׀?ܺX?dު,vM@ =~"dIbkBc~%&qnݽ[nt5sҲ^?V>]i}mSIύe| B3%w v(d]EzY4*?O^G[]۱Bhjt/'Q -Nڮ ?U sz3X(:=!÷Q=a|fbu(inj G #>9$E Y^KfғQCcAZ3AքVxLgT qK;,'tU͕MýC9qGBUT ^sg=zo[pvxRC%I g$LmxRC\ N5j^ZF$E pAȁGYcYE703HYBzlQt|`ajPvϫa緛U_-W | E,ޡdzbKrR5AYVzo[f@G 6$X)a EKId0|QcSŽ\j;/S:d83_;} [ dލKQ թa ,kTLvӓozƛ%xyxy_dpQ!X]>E9r韆UiȆH!|%SG{Kzέix6Pn.+)u٭sYf9Xzf!j0|$s})=6)=0BJ\ozNШU=2Okx2)Bnhr.{^)Gr kBcm nGNqާc{ 3nG۠fXxXDo_[ y~N\cWтx8c 9=2xbԨ^cL6mw9}m5@6ts!hi +6%pnݽ״& $KzqҨ]8u=zo[PQ%;'֜|Jv ե]^tTsgB^a;ڟU 5Pj>mN FN@*.LfjHbã&]|h5ѯ8UV!g-M.>{&oe}~ GF:O kBc]E7P@>ǚguovIZYL]J#Zt==]}}<\g:Ophm@o4Rϗlkꌟ=j?TDjMM^{mgUU&,*m= É#lx@9P<=ru/VͤY:Ÿw ~4|#$-%|EvE]IIoleJƞE?nG%͔sdSNNj?8~$j-? sz}v9Ϲ"y?]RMW,S^4LVSZE9RA) GI{wWnDD:T^d˽Nykof`tyO8U xf !5ĩbC0⏐H?j_[}#jt(n3l{kpCcflN.$xd6zQsh?sb0 iML3Nhv,ɽu*zר՜܆tjk՛@'p~j na\nyFg͓^?V""SkOCD7c rЧݽ FI0E #;s GAόYz[o `BM$r2$#+ͽM8yߜ08Qܽm ޶:$YDy5Y)Wl!Ѯit5WkZ ܶkmk9kJ=ܻDvbÒ^ y5@Dwnzo[,,`&n X4=4WHF:#рu޶Frp)g2kRȧ:jDQy~#.ԸxQSȻbNmu M)/0fzS6ԝI͎HEǟBxqA="PuKN5)= g8;I $Ik>fėE 2?/b’M@HUY➠Q}3FVHm}h t_J\@1|G!襥9/j{@m1Y )LVQdm\[p'sztEݽ +܄5HO`5%pb|MiKc (q@D%K9 Г`DzzQ@Mzf4Țz9V sX% B}Q!RUHi]p:SB[HRF!_[eegY̌99J+[֫qR"96)Oꐼ:]{֯,n}Y$eT0R*t_q?VPzFL}yҷO<޶tw"6i *1"Mxi=ar$1R/tm g\<ea%m!$ Ǡ@X[?^;zd_b 3hRyCi!7m}5l>A[MWUԀҋԓ0-&ԨHԧ ~6|yb,⅏e)f=clF->[mbDkODۊo ?TlFTT ]ifYY$JiUOkWa[mk= .%Oà#JkA`ߺ~,&xX Y RY^ٙr4j2jڶ&>:N2=E:j\V=i7Y]U4ǭB{d\[MjMti Dg@@%-`z:KmB6>tޟ[_[ R(n‘Ph7jJ7)G\a0MmΓ*cQRFAڶ5{jp 0 #\鎀@PD~?9,V?yzHjhԋD3Kk oui~^ fqQJ[W Er="βnjifݶ&>OO&#ftizzNWmz&z3ћz(*0\тkĈ]WY2`ݼ2hMBV˓+7r֠0V%Tg!"]kW1-qt +t#^yiԤ3^ZJr6D9j"81Lr6 mi=,9{vzo[i`o%UP!&_ϝ,4uzqרuCfnzo[a&Zm0 TcfVZEʗ66"NfJ k%chN ;n(IEpi0T/(ק|\1zaO$Pfvmm!~xHGBqox2 !zQ4*IO nFd]fLZEhʗ;f ķlbՎfcE z%@-(Tzc'-JSQ-bx5bVCί|m庿@̴Y6 \4&Wm_q.lnG4cC¿Ntqn߮`ylOSw}*NK=VS:)ɱjT:qn{EMk\!^~a ^Z4f.H'Zp|VnT2"D!Bo=+V S!a3c΃:r Z]HJ iY)Lg@m%7g$' )e@9EO$LK` ,RЋG5מ^ZS@~&q^NexZaRpEz|jh1 ZX2ۇ>D6@9Yyw\fmrHB1cm"${Lj5Rxy5r![Ko>s˛TI '5JwnSBJikBcyrenR*"K=9*?8^Z>@W~^ ++ҳӒߛ 4EY`yxtF/ SL)&m5ЇaW'o t0Ft~SC8W%PVgW@maVhtfǪ5T2.w_a~ެ#l ޶KVb]_kan0r0O$LhW0'<(G.9,umϓob."[#c/82}ƺBX ^ de**٣(1"Qbx9'`9W[z*CH;N#Y5U'/2Ѱd,AhlgDz i<`7JziTz&ziMbUk̈́uϫ!`ꎄ|^/nWw8yuWpKB{^H}r@mEL] A$$F/IY}ыFՁp3"KcQ̯m5=epk*5O@g7s i+ܳ4~b P9>}櫟?Ms_ 겎a,y~= ptnEVo\zZQآLPsS>ޝTµ ӍO=~{AW"$!q]j5my 49/`Ɍ t0+Tu<*ٹпq$y`T>l3;4az)K5%#o C XL]I0Yj(L6 Tuzzf4ȚsB|pFW ,ەzlMlkGrzJ=#}YfWJhEA#[uA_Gyڽw.C޲-\Dɖ#[(R 0\;<\\Abj"&QirZ5{ s=~1oux7P8 ezAQpzf4Țj!>O1`ϓHE)I^PjDB2RiҺcqT3 kJmĒ֗pVnl#mgnSfN7 +A ֋`F\cW9߱ܽ+*%j aRّ<_Eq*$d~RٚjsX89NFCbam[YEվY _A{ml1Vgyey:N*W0^ B(#|Mi3Nԧ`Voc6ƆLĔV;3v.񮽅tx(kwFsNDTz/eMŬ!<7 r{Rʙ^5*NbO4Nm밥G]G1Yz@"Mk:,(G4!#঄l+@ez4@R@Do_[or#ɍ"R- BŲRCRUN .*洳ˡ ̡J,2_e*XZ8Ȥ_y AUSp"H]JkɁ!珼m$ $wB3|rcգrk}-~m@I5wMIav,pj8!= Uˉ A<gY5 (gwV9էyՔy[%IBw!aW~tٷ$l}l嶕߯iߔuuWL,:_ na/\޾2܎NrA@']eGܙHSFʆ f Gd/̓V}2xe}D6 UK| csW!jHOXz"+bVaP?4"Ԋ)0#t6LWhVCeY.脊t\U}>["7a-񓇪 EA%e݂u;h8vcFVUefG`6=ƣoW5r nzҨ]C=f}mґuR^PH|Ƥdݴg%IIRYj9Ϋu{ܼ84-X &&5Za9dQ N<=n6t-4 = Ej53}Q3AքKG-i:j[(uzPF+&Pj nGk V?nәNlؠ`jl8=J2M,AP쌐+][H&'6UUfZD0ܠ~mt} scS}AH4%Qdۊ]bz~\g_[/"gېkRw \=]|"/1TE0Kwuzo[M90 /sd"qj24NJc;Njk?sXڬRI(bE؀ 4H7oʿ0-9(J)I0I)Ce 32?15"-H/=ΤңQK Zfp֡Q!7{y~me~6b8G+.Je>,F/VlQ0?⻥8.3Kk@;6zO,{Yq2jpΔ Ewr݂L*vR%=׵o 3[GxaKM2I[pF5:0 B/Lakp }5IDƊ*xý A U.u*6RB UVm ޶j&M}}"f] ӷS pw2ӟ%ݻ [xn1džy7]t6>W&I,n_, xËLs5*7 *ߥ3<!=У`,i4j29;m ޶C'0JMhF<%ӭ@NTz GTBݑF&=j,:HAEkM$]ܻCN穳2;/ p/pԣ$5pnYMBzԳmPNr9R#nAiw(9"Rd(WT s&Q3;ŘVXeXǙv+Llգ:Tgv16V3H1'ij59Aq|3w?7QH®a=A&EƔ5j7NUOmH?&XNYiZ"Pfmz&zjpJSxYWUT-ݻC)(ɐu&mu2:taB$F X;e/TwɎ)Q cq@moaP2} `٘D+Mޭ!IxTW3;']zP"OHTR xgb&?UB{%B&GYWY>i|muH{$ (`ᴎ{ HuϪ5\2[/.@#=.5Vˏu WVؾq>4iqrˮ^_ )5TCL 3!&BJf/- ~?{Fc GG ͏DcOU&*|j~ѴhjIkPjQQ̞v3[ԿDJ,I$RL3J11Ȁ+\7l7(xOWȢ}.;`Q!p)yؚ"VSx]ϫ! łY+\O|KoD).[AlfGۛ%Er)MR4 SI/Dmz ਗϬDg. IK7{ӛi?Oo<]z&zi ޶ftQC|7-\c/ԣoA;Z:5{z턴T_۹y GdАh.;g4t9rHPnxPڭW4j5MJYzo[}mHw¥z9(5Tg266y' sS:FK+2n^4j1A a*0*]z D+lq]!dx]QQQ+"= OJ5kM_}~3<5V G(=B&%H-Yz[/X%E;Vb3H=~n>'lkt\u^ApF\z0*/fW7,By&{i޶OcuE%<ۂ@knX~E'~fDs תG}S>uܹGˀLBK^@` To{R \C5j_[ƿ\Ԕwn(k ]jhdB'izTM٠>ICim©sXIPjI`QL$ 'BNA?cD֌=tՌd!HtSՇԡ!33ٝrjQ*b#G֋p(4g+Q}7;WC@䖋eɜđ {>A4|K tY.e0זuM5̬E1]Z=d.Kk(a {&ϢqtRlYB2딥TYf!JK4gd'uQ=@DꌷZQùIŤ䦃MI5Zj((LLTcr1*YI\nHr,x)U% r߉&BZ"<#ґ]klHY˘'/& F)Vٱ Q ̕1r cT^x5z&z>Ҿ;x9>霞IC;gLWISse5`3VUU4fs(G MZ5wI3ި75QI6h~FDc;g_vAc?1i}H%pvVfYWQG3Hz{;*bʸ٭hG%řŸG=w'~xޮt:%\E)e'^Jfٳ{Ʌ2XM<)C4,Qyˉ7[I=3aD4mg=Cɯ}z< ŸǮ@hKtD)u{k>Jfד*"b Zٛ{+$BavTcUu8Zm^}lۯ>3^u_=Yw귿סQ5`#z|Wˣtٚ*sff-^3j)|k!&=_^wPE51(j5z3Y;㱝| 5LpzΪPsv^'Ӧd!w)TV}ծZznÉ]K#*A~EOfqF3}ۢ~g]'Rф :wfyz O;R. OyYD>=Qs]zo[w”UP \n"BwaʡS7 S2ȋ<”DaJ3}mۧ[g̣#*t8v`R80~^+]ByˋUDZ j#Vks2-ԶڶxJۖqڶY癄* 5&m[yz]ڶų^_[}` jvx:bw9$2,qZF}BbúiDz/AٽzMו; aRrA./{>{"^*fm ޶;ToT^w{;v pZڊF?Wqn-U_M- nZz줌1?CX]fc1T'Q 3xzR@D@ zIB6 (\9hK/\Ph53f^fVՊkW8Zvwi\0 zq ֨>h-*2K.UnmhfA64>!*~( ͵[>򼮐[z׉5}m2ZLyގ֣d]խ_o7A4}KMK^D4j 4T9^GMN3}j,HtId|iŵq|#~P*M{2v^@s~fx9*mMDJ[{BKjh5eiQT).C5*LL4Ț*]E}A<$rC4jȌҨUɽmjk*oVx?\akغݻtRWh/z $?/?SJVܰ]qc17 :sDO澉Z8%q"%ZU _l+4Us<+8^ 9^@N4j6Yԍo[,8z9A##Ep,W 0UtY˱ǻ_[/T aPq݅s 88{ZG gzo[oZ/sHz խ.95З@aL\ 9XK>=jW~k^|(O}~mQqCws|:R]%Δ% %\DSC-K=jZ[5{ /i[yR>HK&Kf"^'2JɅ d΂d!mM}l5мnř^ ]_rP*wv+8͆!Qo8do/._[,XeE^,zW*y}S_貨xSie{ԤˢަL޴8=q:J M 8}Cvw00NrAݼSjB$?Wź.Wum0KWum? Wp0T#dzC@9Iۣz3[ rm"g"ijԼZvTâk{vE%m=S4^ ((QϱCmIț LM{oM3+t<ہn=TĘ u^b][M} ҅DcgVhY|hCf~^ J e(a%ءjbE{rRoʙM?f5{۪Kӕn<ՕU`h{պK -tP V?`b Z`+\vhŔEwzC-0W^TiTs-93*^XYN.|;'d顂_Kf[/3|PV@myH/ڏpIKpQH+4V *B$@͸fk ֻѹռ-XWKQUy%9-*ݾ勱!y=jjȵ5+Rci_{C s,c0[u X-Rp, IoiV\_֖Λ[vv曀N|Y<@Uޅ̄TLM.g&rVY0 znYQ}Qz]ݮ_WT4vԓؐ#s%mڕ^1 Jtn%Z[LB{fP+=N5Ț*qG¤L⮅ioQ߃>>`x5S/,xͽMs?ͯTai[H85phB!,oHH\0\Pw*GMk{n%ѽ0\ df $;)N$T*.t_L;W8jt,ik*ЮNd#oj!@FTX/7kuèBO)e.*mőJĥgFMLkIp&d hl toWPrNWʤ⒭>ɪB.h@m+7U*Qe!㳷VYSp`ȱS[PR[n^Q1=SXֿb6f$=ds%0*V{T-M3ԧN=|"Ն:){A(Nl\D B/vq$o{ƥzuz~6S)=S?=Gn"P_a({U ^DkԦ3:3V~ .j]ʷ=^ b_zq%֨!˵ ym5yVCB#bO/~ ށ[Onz֨ɷ|&z(jG5SkM$ bHdSVNZ Dz95siko&X"kc'SkMYuE99\j|HJ)ΤYz[o*SSٰը 7ɱPYIQ0^E#EFuެD+_[}}r=SҖd`Vs|1HSѤ#BlMR ܺ2Fgs:6kq[%Ag*ep2z[1_$r5,6)Lg(G yD9mr$ \r/ӨGXm5DV"H:\D/V?=l@LPF΀AInjAWcX&l@,vـXP l@sXmS.bx5^@m7TQH7OUIA8\G/ʶ[Upկm+\`]`{V-TEP"d 'tr[`ͯ^> 'gnz -\v./RyWW"Ky%<&Se?N*$BO"e+} 7a;ryFll ZdM}l oT1gIMr*kz1&Ֆ+p)_[%z K̺:f5~ݛ We~ Um\Vq -4N5 mM2Q"gB'N: nJĤ0,J)o_[ k"J}b>$W"m=3dM}lG%Ϗ&b |p,!̃qM+4VC$KO$T^p%[SB mOlk l礵%`<3z^5jvP,zo[/$!^&ي~+=v#lIl10C3%y~]s߅sf}@cJޤdf0̈́'a5{ʹ1"j=g#vߎtP7<ңIUC~+Z3KkՌ< Otq9f,^ z7`_E941a=13pZ {*5{jPO4>+J-vP*PH.V rj3[JkO .prkI0˗Naۯ%ЦFe`'_[K*]9 z]w*$$_n$(5 Anq/aᅷFАъjIH+mpa.\sr Jj,֒@/x,[t sP.Tf:|Ql㖯u 3vRV65^쪁[\BS|Q5+ѯWuKh)Oh\:ڦq49p鲓zviNKz$Hsf!Ej M! l halw^N8۔(ł;k H,WԒHZ+߀ 42Iߑd~rLi^ ~in$klzjg*] ,%-am"9V)],etXrRr4_.V˥1l ^[qfOJ~42Gj4g+lHZ/YZ5UKz[5ȳcp "6rF*>H![P>I[`|}_[Yț&y,i2"O^4g,ӣ{vSpT^hU[@g[čG[I8&t+lz^>B- z\uOY=.yT݅G0][U?ˌ$6w E@#9U D{ZՁUd1ϻWWM Sv$ a_/ٛЀ6MW(٢c\_[urc_n3jU*`)Y#BBS9uaEFeu5K@Yw/*& P5}$ ƛKSU;]5/8kkRTg>xG&^It? k&'"}UEd~«7쯭@g r+J|{a%'5q͔a=SƻuaH[3pDȎA}jNZޏZqXbidl _[ǕcX{M2uפ 'NY EB(E+Rl ^[u ; Xgrn_O˕BvzҪMm]3dMch FPi9e!v *a5YgYP -L.lկI=m9$j7yUobAS$ MB-y;cǵ586vX{c[~>-bkrk?lëwt5E,A:\kbv.gkڃJZF;_Pi`OBlќ\Ugtj@4"EVoyayft5 lܺѪϫ↞ v9٫mC@3vcO$쑫F ԀsOa هq{L,z@.gDbeQRs6%QyG>9[ n⮁ @`oIҗjL[Viw Y314F[V/"R؎q@ɪUv]KvIߛTdPsA,@32ShFG VuYX_[Ӫ^;;5½+8pIpMPzQU]PkbքVVxŠ n׏.<,>Ij>)$Bļ@6z=3܌!!CD]p#AYוkJbfNр|gVoE Qdp,؆ku]yqFBvOzǒ9}jR-*kk^2L{El}T%[:_R1iȶM'C]޴5{mW<7O%>n"%­nK.ɘb>J51k֞^rG@v#zN\Єn$.+3%(==o_S:+J OGE }Ҿi VRqv=0'Q71=G &%@TaZՌd&f{N[ =*v/U ˙BBPͥ סa5{mI4t8 +]: d^%k [G D[zN,4Mbȋ5IϱTHIe{L7NjRTM*I2_-iRUI~T.7\_[nf&:,ʕhCvλ>mn mv8ҫi&GݳC';AY3ȄlGc~e= C6 B!N6CBPZxU{mCZ3@!FV$(&pL6u+51DXVJ/94vJbm lttOn;^׼$ճ[Y*5brGI#!% Ne&B#*uiUrX.٥p_sV9wMU;'_NisT*.~UțrLYv뽶k=/t첁m=0Sj~Yх#`UpԮa[G "4X YSL__2hDv$a7}xU<Ꚙz|muA' y-@ ]l$s4 ̺lƕ˫NlBekBcO,)(&fb Np+=;*.zdҪNA隘m*r(kp(dA \ھ W T9ֽj.eP|*d:z@s+ЉGa%6[GY.Q蚘y|mu(NXQ9NJx,NeOf\[ [ DTz#7 LWkD#R ¿6=Ink |~~ coJ=[n~hv=_[vv܆;4#4);fz]EϊWow٪,_[MdE$4fO:{.;DQݧ G >a4i˪F^}t5Fk { ]"#=<{=RXz-Lߺ^u=51;Ak>#:m i)AGͰ|ICCGB{<ãkbU `!*EĀC &!AYh"VSoE7Wl_[:"0YG=ixK#$'*Ÿ/vS,s,̚2YSHx'_$JGuYSk2S#,q#lDjaןƠNcޫ=߸B7X2U:b%)҃0BX^M3YѪ[:'7l:6u9/N \OU5 4bUutTq@muƗr'y$Ӈjg۶t:9zqs1ڕfkH#'g DU!Q3ȟ@rkKaڽj3lWow_.&A!lx|{W|fғJ[%Hn_#b@LlgjQ~,`&)uYhU\蚃H9ښa*dS$-| [Ia7y3\So1ck=n%pı᏿CκͳLDڕ$Ⓣ*Oi״5 Cvor¹E'%38 8Y(.<n@RiUtMҚji51k+ k)0:/^I:QR0X"^rxUs9뚘/ka݅pWWxSkoX:HC"n(תY_Ew뽶=6 m=b>_ܠ8&5#Um֟u\7yEvc K-xGY$"AT%5Bs 5bɰҽj N lK5Ax}Qߦ8ȐA!8Ȑװd. 8A]=p:֤tu975Ǖ[JWձ^dso9$tG&5!vh="ì2 |c֫0H :l:qZtn%WI][)ڈr$1, lk NRҋOV7[T._[ܖkr[Fr䛜U'O3jE@t#*܌aB`@ Țت]- Z-wꚘob;d> LSw!kOSZڜ])O'?'D(>Bs>zgJ ϣoXLS1ьMF轶z;=fϔ`#)d4 } >cyUGtMDzOfu_1,c'&X(C-BBX=PT5(OyZy+k^mQ4 <$JIoQWbXO,+0;c,;$=ZTN7.fF38̤La;Łڦ^uښrU3pP6^ l:ˇ NM֭6Juk5qt!sR3ejXQ/#*ɏR b=$Ej7 tk7;b*LW"ūEHy+uMҚ>Ή<@=XmU'1l\;SF/WLEX:M6k)D\f& whiهYJyXTGNwK^) B~m|v6:7hHv7ЁDqg7Skbv8cϯ͋| ] $!  Sq Q ͥG`s..΍轶jg^WqNRϺbOa;/v]22=HV?V<@Li=aVl Gx_H%K|} %Z5{mu dɬ@Vuc+n|@i~ faH&0]IP.zfrSnrMC=t\r ]CPzGGDҳL7^]xCͳ6&hd9IY>lY_[}nѶܮNa8ShלcPEQZp8 6wQ51;圎2RFȘ1ױ$(14<{Si@g/$M;١ S__[}Yږ>R~(\۳Wtmw<.9^?홠i\Pb7[̞Li'g[FYw9p.7&t7ںw[ L[`lo N"in')[)tٕY܄2dBF1H[@DA-\%*\Dm:^hP ]u>aa9 @8, rdgK Wo믔z5bg:*kd{6,栙E'li A@t^@IuAiF\FjZeh3iwj*pd0{^R0V FQhxMi#ɰE$R 2F .tzvv=ӫ;Ɂ|Xjnz WQ  0pn+[ƎJ Xɔ@)fK |:4gtAbwSdy" ׇEqƦ^h\c$_:C~/n zE!/YWm_7F'ǴQ6,'Ԩ`PEP/ P1)$짛4_AV2%S2U5 kBcs\]v ESZv51Kkjy9@D[`XXQ@J!N EevQ8EbEzNglW(_[YoMf=br>NI!/xTZ72d֋1-=:lM}l88v$_,64zvF0Y{$tcr{X/bZ>v fx 8=?ߙ>9Pⳮ%=* 912q< ` %:pV-B?x>?8&T3 M3,k*FU!59 k@ @ 3%hIx!Ao]R0Rl^۴jU!٥q-_[h+LE|A:IV#q06J|8xcDg swCl7𢏼Ee`ZK\WH@ҩ7U!<6<#1 ȶ𒞄懧"8sբG}kk&C/'R;;CS]Â5=** ǫ.r{=_[0kN(>ַKg ӝmK/b~Z[] ̥y"vIJ#2ұl =F!LrsBwo4v:4Kn5{m嫛D^0o%kW3AiQԊA*UGߟ(sS`iܓ,M ŏkslށpG^@XIc+qPuU!잝ջ'In|2b?niݓ۬[.Q#:֋Vu6F,k=,CN˳ӷ|mu!Dh\P@d-e2$&' !gX\Ae>߬X^~tb:So59j-VhqQ(ĨȠ ၷ vw~m㳿|&ɤ\sJÎ|7WO /I/'>_>|& dgX<[g/}s-)g >w^j3'3*sr b̧˙ΈC)y95yaڜ(ffUW0{f4!!>}Չ m{LW6ьY0/*Y{)m,شQ(y Wmv@{F>R# *~h%pDRzC3{G2WUȼG-aғMx́ F[U w]~5{mMq zp\s){hEH-6Ko٥U_[2gqp؁IbrG2pS ^toJݡPZ,*g~m5JlK*d4:f~ L}~ꐀE?V{{TT]Z=t.偣.z8AYZ3N>w=xwNǺGO=( g,i;9GA510Z+_[v#ѧ8 @V=7/Mݥ ü)?SW66$Vw}Unr ,W)=ױ5 ~<4A\gK[_[ԔQWsySEI̸g7H6Ip1W1yt3I1ER%vZ$0GFD_5F QbO-EFRYU".jjmKkkL`f SԹSهg<˕9fzADwp: {ښR5S_F=񰮣 ;j֖…9Uut[oN`Zu(T>քV'y6T?//rޅ߷\wq-/+`StUtQ~ 5]ѿ 1#y6bsp>yCWYBw8 :5{mFu9: >"wr:9kod7çX`,SqVou ފo1A5ǒO$(O [ ,*dy&g]ٮ۳U!յuh n>ċ@bI=R$]k$׵9Om Na)CY ue$wej)t]}WS@b Y "^ښtbiyH>))}yT3ךѬDY>&YO/ etjS=TMs#H4 Wа뎠zo G. Q<>rjF5Ձh^:(GCPtS]) 5mӤSO=tGARj v:e B(bu^k[r7aɼ#p]^u5HB~ښ@ iTO6}z)( ^սeYz[Ϋ̖=XAK;٦ޒ;Hc4K#IYXVOHB5{\z~o歸Ė~$c=_.XK5 cv+z,n'!Pְ3:t+1ns?Ga DU CV3OE9qKJI@r6bk h *ԤZP_}_[ O =pw:`_ T6N'lZY6uu@J(M;Σ9^n>Ms= &s.2Z&g7͟|x4mΛg^$B䄼@ը ҋRQըMDzۘ[j3Bh:%Q!]waɛ9вqYjwawN<ћEG~e~l[{oCa]RHSVG@[>yY fQ;oٚig\&gM/O׌4ԯ'Sg&>CK-ՁΟ0cj؏T n ["מfgյ5͍*)mo3ɫzwdzeX2@TSQhUd4 Ț473<+Ht 9Ut| wn'W^.RTmz>T\uI+؉. ƪ-ANanoы!յkky:"!V%(~={ŚRp' 3VWeɌ?Ixb֑gr$p=IxlGZI!S-$>1Ű5Iՙ_V\z_(gL%1S'scUБMh"ě:iJn˖L‹ϰ; O.C^],: ;av8Xt%AC=[c؝/o3 ( ޴GիBzWXc6U_~-< >|mJqw1k@pHЅgxT+D򊭁kSauTdyK:bh֫Qbp^w]럏`JmiYl&@h ?^\Rcȣ(M?dd&+Ѫո#h}=&>f)?,d+LrktSvi=|{mD׎SMa*es4 @Tck\~m7l Ps¿~S2ѧl("YxNm_^iժPYZV auVyEP'8=9>MU.|6şg֬LXej@Fd!A#"{v(w"Ȍd@=Z\Il$hկRtL޲Hel{J`|_Wq:v-&\N@t轶& n"k0p 53BB 7ٌr4dl%:Yvo|;4$l! 3x GuEגGj =:ʁ[׫.;K6轶&; Cx<ʼn-kSJ{wS(&UY7B&gZ8xI5+awJA_u)L{a鵟]jHC3*8UzeUZ~YNy n,[>x˳G;c>\5?&gJ.lF)hZ}}}XocJէX/Zէov|m6qX$7_BiT t}Rڎr-4GPd-[O2b U¸gCkkbAѵmW邚yXav%@^ ^"]& Q-!7T#2v#AzOnZ_51ՄI0dC@/YKPNJ[ʞ'o}@/.{v6YotV>`O: ]?W ?p X!aov<>G9 [p:`^]Slί8 2Qg L{Y'$Q<3~4ݹq轶!,sc=Ri(Nr >;<:Q5 kBckbomh0(ݛeHafJ+Z^dhpi_-W= fH`6L/<]R .;Lzt¦=\ze=?S^$ᶿϮ;^lq  bhƳfQY3z_[}Xy|X&'Geʍf٣zSr8}\Z51Kkښ,'N2S*)NKS.\lIꅨɕBp}QcŔk_x.=⥚4dձ6-_.Azfw7̇l ^[}b{*ҷdc俧Mn!0Դ={>]Sz5cҋZ*kb֍Zj<" qE+=$(|zN0N% DuqkrQ'Ũ5Uq%dTήKH8Yggj4D⁋AHm []ֳ /v^ֽ2Yu[ 3'MT;iju'o䇞a=k}eVuCG]3kjqi)h#F=c*T 3@H/p0Z(ԩkbvjXk+}_5E4VT/)v(HE6 {r,+4êC٢n_[3Ќ$]h ^rGgz֝K q (Άg!V}:"⚜m"Bkkb\)]U쿻CےYĀaC\ٔZ[- JdҚjYD%z,!}$afby^wѭdqzo/w轶:?* T?3A=6O? Rh4 Q&Šq.dtBX2'GⰨHõŊΛ1Wn}u>4"f<9'GC'<r D(7#?/,ܖG?tbZJGƈ-9?{mHܚv(?v`CLu ?n-LY7?)t8L:;q<[=ߣQ$ }zpl:Դb?)Jsu!i f"̯xWўlwg,l$aGaG(^gB.V*51Kkcwa3,䷱ fy4)urs+.Fk JkBcKyhcSXG/5z,G$\ƶj4ׄi@UiU&f|o~u='?}k$)uR> 98 oIɶ< uksw;G;WOf Ao Q<''J@Z]7twT[)¦Ybͯ +k#lY`.@X$յ(tTv΅vEqjkbj[k ޴6,FU51T5 Ʃ( W#Icz]AyrKAPؚٚ_ݦ HHu},=kM"2u )zAUIDkk]=0M>$G%C-kО0b˔^#8N$bFښm8518ii/Db[EJ=VCtRP 4=1]26 +Ƞ! [\^mbKfMG}hwAz[z~ui@|V}5Ӭżq&~4zCB;d nax% DQ`*EmHP,y-mRR.˴|NJlM}l5;59%V&| U5oM 4 ׫6^[N[?)Sa鎃>ӗ;љ܄L1Qx = #"“ֹDt!Ӵsۚj|ݪ㵿cV X8,-.<)8B(T^#&fN6; 5YGIǍ3J|b߿-$Un1<[V}6P6@ܧ#Awyv RXN/,A F$][3T%mM64O / `!Ջ\Y֏CeHVb|l{L+RS ;rTd|zkբg_T&!iVC\#pY!8 C}R8m]tx_8.T51M&dCU+8 : ^<7k&הU"9WB`š5<轶ؚF5 `*[${r#u'3ECkbv`if=s=>sz2k= L=SUidv6Ӯs ɗǧDS[z @w\dǥ ӈQ)y׏Y *1"5txMғ0][iJ-W:E蚘]zY2q-#KT;0Txn}nfm ^[]E$誌">cTGTª6U%%qZF6ŶǴ^mRZݽ״5rE#nc;űgY7J^4ӪKP\]6ԯv٘dZNҝ>2J>[R {Odlc4}ֽӳE>0qgG58O5{s 9f7У`X f1q5 Aٮs_[_KS1GP<6ȏَu(}@+] /z \V㸯ZujkBc+w7r\0-GfIa>bEV!1f%G6} ojN'8O\&!JO!-F^DpƬ+?|(+VGᩁ3lQ<նmzvL! 9h1k:" ~q1xJH߄HEjƒoxŁX*o0 c5’Np\{BH~;@Ot UnYZVzILU t\CGGVfjg M;YGuX/j370 N5aC>˜w;1 Ƀl>s',湣31A\֋vZ)kƀ 6{a 5r^  ZQNuw|=BLW4!f! ` fe5!F|3\y$Y2@3;"AJa(dc^Dj3`6z>1Kdvر?^{qډKzs,Sݫ1뚘._[3hO4h 'l.|=McvpM5c4{轶fğG?{O-hWxoq6kxբ&>&(aP6>>9(\lJI h bҋ* Z5c@քV9]Jؔ̈L8[{نe5LVKo5WXՀ YE,bfe]L)χMdYWls85l_jgIքVۘ٫F^Dda4tm<1ZS0I=Bܳr6( akBckN֓{'^R"ZQ0kRO\<`{EH+U EY6zoɽ=Æ`qn١HaMPgǫ.yMxv4 c45sňu,Ќ~~ι#ɠDaK3=P)uD^֋SVusml ^[40SM´y /]0,IX,U5[^䵪f X(aްRPmf25+zժ|蚘m>振ybzn<ZyQG( tdnl$EqފiĀ IFr*xKk|x*aнl6~fj &+^{{L@<1΁c+A/L <|[٥)V/rՕ|C=Cn:ko@ 0pkTNlMo.*nL"ƠU~V׌Yz[M[R"rHFkV"N4H$>] oj 0{ͫvmf'[$k)x 8O]MǕ (gqe/Id3a@_kMq7KkJ@en![!ߞ[^3d= XƼ3Ub52p6$o\[Kt`x4.9:ę F3]،8BOB{ANE`VS&uV>I%"@xX] !lYGdK/aZ551KkښZ&LGj ZSc ,xDZiBxf)׺`w_d ?mM"dOt{;\=&BfԏZpkD ng)WWCkk|n5ù EU8#= *It9jfGja6˿g `, > (١nIR4S,kHs@gW卆LgP )x@ +tva?cVِQmQoR7*;^|WM(a+V >m ^[,1n >|84?<ϾG?YgW+]0ٞg5|[ϳ +zEYO=3W1J*:.h] ;Qɵ!5P3R Wq!dItYG軺 ŕ\aUXv-jRVH_0 >s2W=;= 3{7YY|ÆO5zg|5߰5,$qhd)h9;t n )fYAF:lM檪c"qLġ"+*5j!Q8* %4>Sդ:Sl ^[By9˳ Z \lj1猯E[ M WzѫRKvNoW݊ |]ۼ}հ wNkXugKR뚘:'>gvYBe:#R`,YPS5kX8.ʨ2#\3~kМɅuύS3nՖ;@.Q̚FݙE˫v"L3E,[Vnv͎MxMnAqj$i@tE)Lp3R_<#轶|&lVXL05)BRbzZ+nIQc `FD[jun^&>rzeϹhiqVn}ODR)3@:*hpB^SD{}mP*S ~j#6!'U')K[>:ߓ"A'),_'zBpdQڶM[pvgr,'E~UKz3h>] L6MjǴ5{mG]yf)q#ƅ0{A>h¢UTƬL[ӄO*3d+9Gasd9֮])9sTȜ#kؚ}e QF3|l>Hnؤ' 4'g H>$ȓZ]4<o{bE5ZMYɩG!QLXy,j{Q&ga ^[&̌,q /U/bIqZ@yT)xȳYGGݞ4l_[MWDP|J{mpɇ^<]_RfjZZQDk+Q%Fl@#ڈW~Q٨ْ &/Hjժ]z.HۀVqń o=,& XEDP*KUl ^[}*8aV hsOMGԟi[ 5 >*:Mykr@5}Gdy@D3@dJq ^>vV}ԙ(u.pna>C=j˽ynt.mkYtVW nT`15= n<$J$aQzQoV\?4& _[`bB~[#Dy%]y_Ka& zAͣUAǼ&f+Ծ*:&xQt9e92E]KГ^u^7yZJF,{0j2Vˈ5~;oh B VuE"zk#Y &0{½x\W%50bJjIV# 1}80I{L|mH,ғPt3| !Z٥`Ҧ2*_c3g3f.= k ~U&fi ^[nS/* Λr`7Av/x!Zqswx@6g*K 0_ րK[r'+U͈kbvkYkk{{8[^8T@!,nDr.nHӄ݁5VM4%١龾:Bv@RݦvzEm$pPj rԛ^Yw k+'JFUAkO#JƬpY U4̭U-*hk{{ES^2GeoW7\sǂ >4M?WW)HRZܒ轶'`&>=tw'c6>7}~pل~ FlM0afشL3;se#+:i?gݽI]zIbvI[hĖ%ۥGUw:kG%@ʈ.DV$ݳM-Bk5)RQ$*E|]nו ?C9@&CBXoT:˳UY/HM @ʨo K5ݮǫ/51:|mu؁6}b 4KaySR,ǝKB/ۘ$bzӪIucݾ&:Ac|-a A7ѱK،.P03R(4umP~NZR5t.LC'@WS\l SpChu5 BA>[ۊ2+Xm*{ASl!1AnmuY/ 4P!/[Bҩ"#Z)X^'j%DbU515K.m2fiFf18gY&5Փ^,&f1ZkykE0[ޛK@Äv9C--4KVW졎:i7* z8Gi YGQ#+ʌZcpe+ZA2Y8@v> z†xd#e\RUpf!K9Q 1v% !FeZ&>˕SrrpQLb.%err{.+]-vYW¯f!+__誎?ׅI8] IEvԣ8 ]<p+Ez4quUU,gSڕ%E%(~(Ky@)>s[GTï^O>HT)|Jhq?;eJl[ j~Hn&>3w9$_"\WAQoQu |[Ega.ajˁ8%@ta.7~Jw ntaO֬~MtOݾ ga|U,sBX޻.vNtAgj+mx7JPg|FYaR4.,}:բ1+~sfovBGhSN9^u U5zVIMnլ__NaC5Caq+ŠpaqEךflH:,{ZbMЅg=EP.<vCyeP鿖CބW؟}?RQ+Inm ' [1.OEF,܊7jﯯ>W(O:.Le2.J"m*rҬ=1Z뼿2a\"f 9 oKkΈU$K&g=(/ ZvDJEvq=1Ocd7we C:^JsZ#+zS;=ٽ:ÓuR S =U8Rv).8kr JRѾ:b*ò@^++(PИET3Hȏ` 4t!ZU~6d$'mtOf-ZtOݾ: m^'EODi G ^vo֖nӧ4Ŭt!ed0Z {bބW,=&xca ݷu,P3&i[$~pl3n9ۧp~yz毯ߢ&|WNqhgQE\u\5@'l^*L*L4d_ \cV|SU B57᏿ƯlF 7͚={ff ?ӋbӋ:zk8EZy: SWN YU6(*2WZ=iS~q폵DӪX2DQ>B.1a]jyv_%2O[/`ƓLazQFQ# O+8jVb% #VvnFg=p*H+bvU=vUvo/WլPQoaw4*؟|0=v[Q#γD:JrUYC%糖;C`A^R]jG[FdޭG@vTztzfMq&1>eo}bQDKŽ)!{pf?nyguQzW,SPb't#b9yrQ1S.$Yp_f__aosbBU$֜p|R{BeY{$>[iݾ: Bqr/!r0֯Xrx!SFVPޱ7{W8Ec4p{iUr"6epy {]|/4aɎ'4{ɐv|g-cхHy֡lwJ7__zЮ g=9 ohw ).ĉccu}b.uzg29TfKݳ2T}jxlr 3򂣂5P#kRGюvPRCogOD-\lAkBGx)>RT<1R/̣"vZy[jNP@gpԢO@kIO)өh>l%9Ҕ|;acY?=9 ohw@%,mi3Jj bxWF=1jҗ=.^6;IdЃMGQOF*| :Lu?ZX_7s?_?? R@=菿7/ү#??~?n7?rb*(5zGcןhZEw,vFgjhAFQhgE7k3Cu?7+^ F׿?/i皾H?mٶ-8"o!y'Ɔ&⑾B~v|gXex[Wqg4 "?;esR|sO͢>ŢƄm nW@vz%pV|b^\T$UusIeFjJc˽PT z`P;;qx܋c68p {e=;haE$Q &8 QDw|Eyl.\Oޅ=z{?آ8Smk{A  TcBs'>9lCh j%f̝ςͱ3tQ,&^ cG6(v7/E%x8 VY&=i [6xL epekCwط5ֲ:9 pN愍x %k,rܯW&(9_5(`ul[ѢGl>T Z/a+*X뒜]SE5JwU'F_9+Nf1sb\V%pY-%yY|Ҡ eTQO (XAf eM>$B?Z|_A[|cFV7S:eK1&ќOJ>'<" *9ڔi/Wx/{1C_L\e]M_fآ`zh1PY)m\mR&R53yRD|YC 6 dIi"e~X&vYTʀ/ s"{rq{xhˣq]()(?)'Gn_t9hޝq/Ec3m_*k ٕeHΗԈT|? P ],%@ q/eXP.NCD mcR'l.d%UA2̓fE =9CvPBPIY-ܦ {b9:Qi 4wmг⟱Fc9(gsXC^s#c mMuQ9i,iI|w|Вc%Q.3Mcaڪt/XRV',A:bz\ uͲɱ;|G6γvYVPwt*nc|KcHaEF c2b 4g+_֔Xڼ1j3|墊&J9_R'$̚Ǟ>G\7XR>RJ9kl^hϝ>c,?6Hb?Ľ8V_?.ΝyG!2eJ3lxg|~vk 8g|x c6' }rQl NlrǑ[vkK̴Pg^/{t!z-F JDʒvT FzZ {rK]܆?GǶ^UHtPN|.:B K8' ޱ6M?;P6g# Xڄx0mhI|uK/} St3ۥ/F#Z%;*f҅Ovq'͚7=1ߛlq6:m'wSV̿R#62OCdׄ{a >trڿ 0XZ=b 1< hŷ6SR]f"z к)*Dה o RVOoKͲsj3 fhc֮֘.b0[{Ԛe3{6/9Xqux+9aM6'/};gd8s[kUc{bCMre=v+=3'^]Imz〘eLXaC9 zz g< +t6(]oU50`.>oGFvTPejPUyvO@Щ:)C55tLM^NcO&ׄb0p,?z}-Gv;2ZIYiNAP.. C$][5`sҍqר7fksp4V"z~B^sz̆n|%` =>2i=kL_Eaۡ{ eH7Kݜ]T#$Bh%0&٘pX{u[3̿E^ W3-"7-"WWA9JFaNw.E.J^C{dsw J{e( S6wu;VH/Ľ s6KI`fMg@k!x|Y51K_ aP(seIc ibru e&\FӘf})m!f91UB- u~)ḑ`6u;o%z|[:GcLhؕ2;kl0-/wނ-R1˿JK _Tei,b(ħDa'η {Aas |G=VVtFbŚIޯR >lfT`>|S|W7l\=\(ߔ لV=,AN G\IB\jDZy" 3`h'J\@:93Z=1jRz5 rk" \xb`MC-=r!5mԬϮLX>P,r{>?}ڔx›٧Wn~e x279k >ϯ!rx2 8v?xXI^X]d͗9H}Fsx%~z[|fz<#)ՅH,>Ta nrLvBr ؛h*q-GWDvT^Z]PڽY?=9Jo`wj7 |[PU߯`UC6KM=6hS(Bl.X )c,H=;˝'3~+@!zT&sۍJK)pKnqu>dF(#PH&Pǁ 6 t۪ uEX>|㿘=N)e/Kc;6}|웨=L&CI>L zAm x45V&٥У76#z31Xbw\pm*I\(&!Z<qrALRf3f]F9 f&=9J`wO8o:ZXuzVdN8 @W -ۤO8!`s]5S/fS8ɍ)E/{(hGe& ^-;+>Ag1LN3+ûczTDc@ׁ.R9HPr7zM nSX5"+S6yG&ʃRp*x(qEES*CaW;]Y W(S5NՅnbͱAYȦ1w|6 -kwr><%gqV!87̒ (6,揨w`Hvߔ^nyyxw&Q?dU$:P4P/<ٗq/256?ǕJ"j =&& L&5g8%m '3N鋻Pt(jX@?B RLΈK"1E^B5;ZMcöjG lFмbaX܋cR>9n.~~MHftOB+*rq{VU|&X9_r{VR{EHJ);*kkюU(k{46-CQm R3'-{\D6$I]ȴPVe oGDK;*8b09j2dܐc mn7]1"L?}u,"=Ѷe#Yɍ {hG尥,^[T?5|1p. Dx=:DGV$R9Lj; u>guCQxCWP{Q KXv;^6e~a|3Y6cT,1"e=!Eh fE"'|b1$N2BK^ נN{cYw$*$W/>\Ec[] / p8;'- K<CYX~:W}V.«N+))Be [V}[IY[#at;w1h |!Bi"b@}On=ʴq{1>0]ٕ E{ݓ鰻|uOb<1!C#p=zf*>@<(UD򨴡x>Iն“qb *7L9z0[~z̏oWF?\AVO@JQ 3D4 = VDwFH>%t P^JP)(|%ql.B7mCIkg]Xj-6v >S._$vLgR,8Nt%/D*HvЬ=7׳m؞BQݹ3utj;(>BʷYh=B{D}`t/(eksV%W R1Q̴^@_0^kS*u}(g\Eiڲ\:})lr>|r|{>*\;m۴5}aQBxF64  f{j 7n (@ ˉ2Yii,d8zN[p c>$w.8M4WOc&r1t`Kl_鲹s{ P{BUTce j3;(ÀBUm /È-VE,92ci>"ǻ-YѹnjpK5҆iWuཪ&?orlP*(6H;q )V!:XOqLeI(u Th'Hg)_+6/@vzM̿L(w^;>IsG ?." m '̆>H-p>/10EJvfiv>IO:ΒO0F}lϏ\S.);+\7Bү M)Mc r7DtߐM%$R,09#sBUv K?e|j`tկ-IGcm.bDqYʨcؠy^&D}&vG)٬-n46xX6D&Ĵ :mF(hiJ7B.,0*DbS>{j-EWN(+%f,ER6Ψg"E ͗^z @Oz|.wgk P/Icl0b|]2XY5$W#O 7vS;g,d <)xyLZc>~vvΛ6 lI['%mhsmQCDk[D6 zlmQ[02(!9i3| A/v?4l.n Zn Zr&"M @E^s5rWœ:-h_3`!lnwV u%ڈ6CKtT$ʼF"}&՜/QXSw'wS7xI _<4E6MGF:6@yP5/ʦQm來T XX)k5pLwgYBSC Tt+dw',< NG"J[m&|\0`sWgXP?P{GdQ`m&&m('n# j1dFr`sKE2(pG 8̘ ~ui?]O 67s zQ+mn\+P,y^L=,( I2ˣ17 ഋ*EIv` ILbWөtWLb=7_EgVvS/"e/G >F@a:*Tr TvdN7b4j,m*\E=(62烬_`j >){yti2%ЙGtTrUz Zu|G2H?nl錭AÖ q2uR{Y'm(7%CdrrS0Kr77 -6j`iM<͜/bء7ϟlu ze şېZZVQ$4_2Eeh5kf?s keʊ_lEYq@!cVPUTNag]9t9t/ya;]ǿU# o.DWvWAe Q;)m踐v0iV(?=qAi7"#j^c+7''J9&R3 ]g~qyHS8}|}ut_b'y<\E@E,zna4NI%tq$PN?8]"JNw$/b,һd]LH#ӱ8?s||f FP9]W6;6tGgm }]y/uRlJcCY7S)HɃ2W4:l(zS|ݠwtukrj^CS6N ˧,؏nUW%)?cJVW~iqA-76Y[Y܀6$FՖeuFW;H2)Zw]rW)kC_/ PqrTڌ(t6vuAFcˇs%GālqjQj;46SnMJFެl%i >4r@߄v]!y5\?W>L6Q:30hC7ZUűyk"q&DB9\ݶ0q\un2!{l.CC#R@f6"*lpzޏD*;4VT8? A=Ǔdv)kۊTiC&QvLaxP?g{Hb2D`7@o24 HܲBFZ^xeʇFZgAQBw y{v<=ϪJV$lz Zia[kOoA-'( %hohaM+upvPuE>]loPx k'dva^fN-&g)O6؛'szgXOjMU9@u2уw2,v>%^ϡs|z  ;1EVKE7l Y*Bf f~L}֗|$o)q 0bjNsU_i48meeOI$&ʢw֦LݎgtN>wūw|>1*e)S l( !;W PK> I?I# F ,TAc|%zoӦY@ d*#zs;uh xYE {NR5fA6@k X@$Jh;H >HX !\^\tR/G -:3w Z}A<}5ʇbGik: OM-+:>Kqa" /LYh͡Ma9)ؕe3D:س:}7dM}J3u7œGpnmz*" O9Vr ˢk`q/9lHqF gķK1%CL @y mPeM0ah3Cw9DIXDʎR/Se3 ^h/'`0'լso@A$M-b?'Pݢl\#f>f\ 8 S!>bn#+zpˋT?<,'mX͙]`ly檃:|߼}&Roҳ&7t20G9Fۻ*Ma9Tg QįiŮJ 0g= a"v*b:gƲVGcқ:VvԌL!!/OR6Jo(y:+S#>7|@ :=$9_}I6KYzl.Tg9zd|XKT[{,[N } lޯkڧ.˿w7|S*+Ęz Ѩ>O\ |PҽHv+ݶ*1w$t , ]oAyIWˆrޣ6{5t|s)pV)p ,9ɱx9ro+kl{@vA&8{x:esgf c-+,ӞŽK)^Ǘ6|1ҒO eo*T Ph8vI3)Mq+]W,nUUn70!Ch:@:Zb,Q2m(;AP $|AUs3_ntc'pRcumd`W&ʰ nPӕҙUk} ^̴t[TnR0 ˙6*:K6! zI4. 39 ,ퟷ)1o/r<,ijD^2"#hbDrKi]EJCVBR胴䤏Ed$ 3Ξd;]SX_櫦\A mnN8>thoS Xt(y^CJɜTq8"@4d"1{@Πr?vAvb%l놆| 8hkIWJ㜐cӀNфo΄܅9zT D [ww/"4]JuZQK 16 ;?Wc,s΃ȥBQ46 ޖO- 3 jPBm R]>/5[/5TD?*JdX7dF'+{r 8#g?V.9zc9xGX_hR`24Ak:CoTxxP/QNtёG-*bȶ%cΧy,3AETCnY @o!Ţu!EH9◪ |}3]yS-^Z3ǣf: I U.03CB`}"u!d &jXSMlK&r&+w -L&%ՁIzeIɌOqqmk$J˸'D$HV1ce9;54孡r>|]Vds Mk.c[U3+:.^#$IZԆ!Ix!H`^gVHC3fyF_vPԭ b/;)y{r5]eݜyyKG?K>ȲJ) d^w̔*;c'=k1h4'db02'?z_.2=űɓFn v dv 6ϱt84j]Hઔ)HqџD:$Ō_:;rtvTkBOGXȥo͒¸!3Eafn__y r'sBsu<îC9L0^&ȋ25_r`kpCϬQ]zЅ 9ut@`2k9J`sKWSN 袏 -妺QJB vǛn&?{ fAnKHqɔIdl/HaРb>3?{<N=x; 0 :uдѴE8aTHK*|gNTȰzgA;7e) Y8㎤Aym0/[wЅ<eѹɎ(cd}F4Y.^S:"i&UQ:ic%2߉lDo\iODar|hR#(+Q4&RG9 8 Y(z1)kةZr-BȈ |϶3J=Al?9Sv u,6!*ZDJIʆF 2'X;: c}G$v7r{pg*<u dƣ5fjV(<Qz392ɯD º_^JL#9Zʎ ]|D4k;{bO8 u䵨p(3= @+.HAM8see?g[_9z'piA`8 rܡ1q`׽eً5y|^y/s~y+UoB2.bܙ3BhJZ D.YYݓv^@hFzоTh ' =Bo#1u4@RIyH7Kp^P0dMq¤y~Kc5}<@1+(fŒP+X*ƢYG#rG;)SI01Qz >[XJxixv_i>ׅ#R2CYtz.A( BVݽ=kR[(ɂ='=Go,*@QsR],Ƣv6݁bK\N lłLH7PXTjNퟣ Kw>Z8V(,}:ʒa3Yeu0 dNy#z֋$ZLW%dzqc`S+tlP6P h/kSca#.;[Pm YI ,Nݲ ﶶЌ`@q=nȱ)DuvWsfԊ88j|˖L.bb&m'lg'kXB8E獐mYy#W oTig䃮U5JqQ_OE˙]ɧFOx.N|gsNd#4hKQ².֣g5ߩdqjvG/(uxIBZv|ɝPi)KrHfuesܽ?G|/V"5ЅK)LoJ-G9e/p]pi{ބWnGFV=Q "DٽN}}P&I#)E?.D7 S&S1v\s]K gs+5RF N.e^{4;W tt܏x̿Lߵ7ӆr7:dj9i3 xfq^WV-A߁8⣿92=k k+lɳ}<Y sG8j H?=^qCfgpcMTq+ӣE(SM0]oSf›\}7`hG&H*3'e~j do6lI!Bl.\4=\:CƕyNCc䆐9&uΗVȇLEG$(.UPTp.9&Qq.tB`8P Q'G n_=}c2e f:qY.\ADh_/]6ӇL^w=dcgGUmSfME m6U] l?l" c~s S]aѓnr )Ec> :FSN)OidH\Lcwd~[ez=dW ohH{u'\D5`N#I uJP_Zԣ6ҭ t?4M5r57eE ,eRTsmlFܬ)D^CaqΚ㟱Z^s]ȁdg oց/0xEO6!s+ 6@@|\L b(|WOϙYO}0!B@5* f׋eST~{̝I+ķxzI턇8M &YN>[+Ayzw$ v# p)7[cdy:6ҘMM62Hja5Y'gI[`׶DerrAJaHt&M0aNF'V՘Tžiy}PTAbF+.$]VXh+ J2UgSyOmɘ[VES s+<=ZJ<+ L/Zs|E֐ )LґPR| OY -RPBbjM-X^saXD#Ȕ1(Ơ?N@9TeJMqUmYU0uq/5|n'hn'`$A߉0\6Uz~Eek|n2ajoN;F1 IYNDF|Ȧ]j ` HXʠlimVR| 8b~θqC#0t!o}c1EkRXz3Tv% 1k;SJΖYQGs>D qXx)[.QHWxc|7?gzgΨbT=ZG1.E&?ǪwCAQh

qFVlGŜIiMjZEMkX__6?lE>Y4vRklt#hɲQk?@9º>t?ar q"a}2L@.&9 f,w͗{%.˿C9;Ry +`*eE6C"46YRVk >d@ڿl1ظX m QYhED64[5Lv e6E2G0')P(84Tɠ2ЌI:!8Ax/6<Ð.ǓJrnadǧc4A֊4/|\+txxįxnݶ]}U6p{QZ>*:ρ1.͎-lx?-&eO+N+0.d1??*'F<>o5j{`y/%b)OrOE_ʿjy 6jVHn(nK(3?W&~sZ:=ׅp4{L)܉vs]ĸ#e&(7Xf䭌^G(_e+ŷ-R'~m |YBep0=?57n7  (iU6]E{~V7dr$F.l.NpPU W37Qs DăBXm k'JW̵5C#Ѣ;Iy4'[uB^'hV0o ԇ o*::9Va!@r, (I ;dErN7\{q,9gw.:Q & #2Z?+LVKA 6[cs` ,Ympͦv B 5b N>E 8 zDb͗ ƽ6m'ڂ- hR&*kV{2CXbNzC GЪ$'xNġd.hݖMH=yiB7{#t˴ڤ]#׏'-nv m:)g>$ͼWG,/\f%PXbKoE,(9{ ͎[e' &7 8V_a2JbzB#@9{JDa@'I~'V,y_*4)?ǿp,fybFu P) 3YA%U,G<Y6 ʎ1K3Yq%NF]gBٝ6N6AflM>G%p6rzFlXܤ eZWf|qFC&1glJ%lªʡ4n8Пmu`kaQq).D]EF(AǬ>=GW^tuW",{&̓ʔlM>$UP~@5u,Ѯ8,6,Ypȴ<\x"58{|}QAkwHM'^46Pδ{wbrCx+NQ +֥L-.BY0 ^1Lc 2)il<Fo~ץ~\0xX'3f0Ry78VM1c)bmZG1g3ymh޲WK;w [>T?;9"(P A#7-OpMa`nq8[FSptއ׃UG A\ ͔Oԛc-<ٲyA?*uASi;G;HUT57q@"0T -U%d廦l.Np$װBkqF/"w:mΛFX @D| l.zZ~Ⱥ/r2j Q]),kTXa-v/y PGOasI/oZ@|uA$u eRVeN|Ps&-&+uF{G(|nʱU~zTŁkZN*76~=9df*Zړ>OTxs.YΑc 8sb=l*Evj]X]_3ǬPOM*̍/ Ew?ł%5IVeG&9]1:* ¾>ɎKMv4\A i(ϱEe,/$0(ͻ:Y~vE g="P@8186"9+!hy s\7NM1?R~Md4ԃ6W:YUD.QS {**S<@'wd^4ՄO$~;1*ĉt ˬg&}]eGIpUvC79Ssngks  e5Ɗ,_z&FkYyT(7l5v퟿y Yh C %mN,/QA\gg:`M8?[|O6h2eFAxb^m22ei;@8,+ O\ȌOM6;9uՄO鲉P 3(5l.RWB+bZ*kPEoBԣ63Tz"dB䊅ber#IC6hZX[ = GcA4s<$s.kcY`9AV:9Xԏ:2m)vlPO9QbZVvP!rƅ(]|\4tO]%M7ЅTVqP-IJ|3ZYSPE)F186 ]Q?,Qɫ/ SU =FŅWz(yOқ׭Yc c2##[e@+n.lB|zz SiWVOBKʧ;1@y^um A,Mc{d\{:Xeܔ*[T;~MG>Ipo,c[e+%0.$G(K\Sأ83c+F50;;F|`gtEohSڀ|域;驘(UX evf*S5\. tg;(F4#Rdm0kg%+ALhu,5K 6[26埿y:{B#fpAVQBZ%@C7ҐM0hp~Í=4gY0PaaW΂5 ωcrY=lѵXH HSdʲBhsB*]kFbih >:D$0m:q  xwd^ؖ ,Y69߫8>;jt+t!B'`,zWeDjx:Ax8dSM2cj >4uǧ"e>G25Gkё77eFXߐD21.ý86X0?X1CCZ<@." 7kpe*5L]Dlٚ]üW!s/o\s[#w:6Pg>`BLy璻z-rv?ʦ -dR%@ws+ݎ_E'n;JsάJ[2K,rIoXSTw;`2MуWF&dw&eewfYlQF?BmNNl!ln|2A:beh7cvw@W%Mo$r\G[b߬cJ]j$h̘$1 <3pNk].w+#Tk1hT3bӞlf4L݋JWi-[Ũ*8vnyƻFЍr0|X'|Ώ =kK7e)-PbWxoł]SU=: P Ho.S?M~͔(O:ŗuE$ l$W)– ;I(—͘{>pmb!~O)[2>x} 6;.$Nb4+I{iɹ+A_ē\VgBa_Զ[wtἫwyՐ+;nⰬq1<~jnR> ٵU.¿+S=F[M%3{{̧-wˏOmFIKqt "N (*.5/HN+:wϰkmUPqgh~}8v] Ɩꤛ.9(++%zBo/9k"qgh4MD+6)ʗn3ɬ {R?4R)qͽ -?Wa.L0}nf$7'+(; X |AgM:ߓQy׷S*ϩN{=>s*Mv`ғ}C|Oɍq䪝A!HxvCb͡n',Ҍwtot 2HqЋ|u94{zHHplw6n1MR>u%,3R `uKcD?T, fH HÙ=v@Ҕ 2B_>~0K^ fōmLs|\~ÓVllJнBLJ)o~0H# `mK oEz,߮Bs<_u62鬶Ǻv%eģw@"|ڹ+M\MŤ9 19F_'߆~ _8ozņ_+dQj;P |!ZWmp+f(]i9Q @.%E?"_Ce6Y`6:NDT=70ϨeEGWy۠WIc6UzgM,rW?=|1nȪ1%scћ;&:o8Ƚ4&d/+U+t+#b>{ӟ@/ucr5G!E 8]1dvx,ڏ/ox[oHɎ =IEz1:zl/=O2 CwF iN[9+wсy'tQFem>({m4Q,/6ZW{h('Ͻl#N6 7/qb}?]"6|׿کpf23+nsEt!H*+B.YF( ]9/+u P/խov'"lGdn`ǻ8wAl|E##RwF ^V 2Oe9< j֯k {5b0g_q2q ̖QiPn2Hg Δq{.ɱ\v2OqB OU5l]D ̍9pnx p/%,Gy{YRߎ4\ٻ1m&mRs2whC|eՁwǏ*RϢpQvr6lc&U_Va hJ[W~H+~!L,W־=`m)jp("p$-,S ׿zqP B*& ٤buHN1oY=&& u d3_Vt!We1P+O';T*Wn'DƦS9fV)Co Iֳ I"۝D}WY|\بBAӽƺ\?O 7'*Y<ԧbɴ {l d/j;5}BUlv0 1H}_l* %cXA?!X9ޔ |W S0gSvc+rx5|\h GHCS f4@ 7FrɒwM0dJ|{Jйpj&8"iY:XfMƯTƅqLy/n/C_$J!d=)ER-'zM0d^i۩2q|!N bWb.3k [Ɠh;)ӽپ06 jY{2ڡ  HЩ;RF_H*y4ʖmP/J6śJ95?}o M=+6Uj-IH"pm#>YqUjlb>4ӿL^6Q1MQ1$ ~aQtbILy͈1M4z0Ձ|_ME@ǿ&Ld}R':Va ¥$cW9k@#Z/U^{a/SSU tjJEmj4o M6۱kP蹶盉H|IljK]+6_R$cK78rf5Kq'6K2NlF$j u|_FAW L*=%NAc ;<t! RẂ|,t FvK]+Qx`7dZxlSR-k>Rfa>ɼJXb\Z=W" ڕ!Ɲo'haC~g4h'9ŀB;9B>~;^0A.2-H?Q&B bkȟ\O.?S[q[5jDzБmOB_4luD;*Bq۳~ d^jK3՞"ʹNm$/7G|b|p)7ڏvVt"٫͜ʒlfX $PS4!P(5Mz*6_] XAᖊ_^`^``p[֘1C"8XP`+[GT`!>ib\W֒mB658Dh7ٓ&OT\mٻ|62ZF*?}wT=vVe+;poGbk~ցE'kխZ5JLjsE,@  kՍ(s?7)e ;׿Uv镕>عQH?7&(viǿǿ<5 U=`IcvU7eLte\J"oRX,`I>`)ӬC1#NACC) ^ԣrEjgpɨk9M%¥Y NW*V૥5p7R_z\_fL #Pf`Yv(hyFhV,q!ѺĬR'(kf1R1־/<*F-K܈ +Y)y$Յv#%v>*rϋR#8*  *8 Hs rI ‡LTGo\hSRq/Z=æZH":Yj"ޙN,zTgnILL=li(]]LPpQD8?)X6=TDg#SDk4And51`*+fDJs<_ ݫܨt_r~qCh4v4X@"PX[b#y&k@æO321<]8{F~@ |mSE gm#'h~me20bd: 4BTUF4zgCoפ\u|#ᢒ#fuRlBF?eX*у ;jrq;؀(<88LlSJAcXqi(iE¾?>UV^'5raMߓQy*̞0Y1ubXZGf9UƦa<ƲB5/( Q@ّYND_ yῧx06x l H:Ewp_$b"Dottq)*tv8WUS'hQ8S"jR :aetQ甕=NJO Fu!5p'6rl$DӌrX@ #PE[ r#}lgBWBp2Wmd ϴalbRچV 32yNm- Nu";c=ZǿiNGpO'=0I]]%c_ U5s=b0ucLwu|:=gC5>Rṛ1^\1+&8U +`%䏀Fzda˸S`܂gt_Xz7)J8](C] pmer/|h ؝UgEُ$eC0ҵfgGz,֏5/KM%"w6S<*gvMUurRSW@_c:*{9 ,^}ӌ_;O?ZjM2OP2R$~:2'ss/6\x;$tâkE '.hlSi?Uߗ}_hm?^ egeYI\P)2ʎb-Xa>+G㱳JR B<#̬I1{j4Vaƙ>R8d;2aǣ roVM)u2@aA"\y*3K2 Z;5ތ:1agVdΫR|3`0/ +LEM'W=6؆H\5/Z銍e:;">c0~Ju/D\v1\)||hF ]}P.٘V.1ϖrɒ;yqJ+Vy>ZXǿ\XD_FtXX&);:LKoM9#_)^Z;k0*[/S+tYsL`FK3VAtY.z*9|q) $xu '{$bƻGn IydAOEae.׳P.Yg'=FX/Y9~:Fp:K[)iLn<ǧtSNӾS鐴ۆ VCCONUTk^X/Q%G)#IW^]خxӐ"dQS1i|>Jf]AVepdG9>4YJuz\wiL{gNr晝 ֘O2 ky ? i!u%tZԩA[C,6MHrkA֑DI_[G7O*>Ԇꊞ::2m3eDxG/{ׄ\R?[@[=G0\HL=iPީ ,2&,;N6:6MMTBBOd.4Տ! !|!jmׁY1( &*р0Lׄa{ABe!NT.ۈz(82! 良]0w!d~樶\B/`wUט6x{smhё"aZqglC6^]Ci ogOngz,B^WF)S :%aOd}԰:<{ztLsO^+t~ #eq{R)CbTm̷s{1ǿy4= =&%m߆rTAK{72v 1\3Jl4&7dq%O_ԎU!;X jVS~Q@W|Q{V7uB@)}ޗQ[gA:30o/%NN-hNJyBkN(̚^'TpD_E6دc#y8 =HıiԥKDwۇ`'ۚ|҃_;]~}[ kl$0}(٘&vT_v=}RѶ=GJS4rmY*TM樓t/un/ѫ4cghMbҳX^g/̀dfm x׿aDZ{ϨLSnXaCid4h/lx)"Yr(kfa!FD^flZ_Y*N_nD(Y\]H]j TJ=O22d/_C5DdQͣVUhH;#(::.H_&k>丘O2/*fkK5B9UfKoQ:ixz;|AIgM5ߓBZ+.'@6K(.UI\m$?KtɪF|R$hNb~ˮ1ZNK1E^l:VtRHy}ELzݺW6_^O5/} F&:W*eY/SQi[^)l}qOlRQa?-U6g'mOomǿk͍-+FlXnE6'7}Wg%xtP6^>׏P5 : Qݎs,@@&r w/Sس-/AmCi AHtC? \LC`t9{#y=0T5 lkTIILA{MaxҿW/W/%+IJӉN3~oo'cSǿO9޼dǨ7jw !Cugչ /2 #$O]݄#7^oroe8OONEvܞ/QnC7|ﱚ 7IL}E#FvHhzүRNcD%%E ؤ?V4HMIWG,E&< '+wuEoXfʙWb/Oʐl'V}e-dDb'(mLVcL|('[Qp{/Bqmv~k7P?LG z`ā^Sl/{}'hw/ƽ[s'WoqO2(!nuԧ-R af\x^[kEζFt1MhZ^grV|߶;0{dNcy޷ ;c56l>YZ+xjRANؓU( X_+嗥TԍXjf^v5f4/X[hY ٧v;Y&RZJ'4ϷU}X^Y -<4N*$nz{;l3pj/SU]{|cZ+`ߋzFXF*W]4B)'tfS<^uJGMEͿrf t7PnzŮ܈Y}R; asː!=E%}a~4G0-+%U=e4GT-]R L!{V㘎v_s|'-{ +I;>""r6M1iGfzՐǏPK~~8Otxp =څK~8tx*,;R$Ne'@.?62^.WL] - [lzpR }?2 \&*̸MUR_.'O`+ V5,UQ@`ո|kqlI浮cz~k(X ')8wBll6Ϛ[:ߓQy5o!ZQ0##VMю?Bei }csI;#w5L(U++\+dJ6AQ ӳ[U ILUBb!N݉Xp5մ&ϳ BmB|k`(]' ME1Tkqnd"jDڇ]V[dIlTWjHԯ ZQ}NJPK]@N#7Gz Vd]{L> {hп)ֆGW9Z Yrجk>}'z9O]lVg}.%'Ck7EK|`?/*4kᄃFFv__3,B.F(RG!KQ( 0`"sǿp`]zڱGXXb#9m20u 7\|{+{ШQZئ*bj6 "BEOcR`:Y\Ƕ˔O; E}FD橨c?qp݉8Dr鋒d,)ɸRro',%o|1˝b/%4 %Lh9f|Fl]`龍$S6IrrA^հA#ڿ7vV=t*Xv+cz̀^Hjd'%>]v'PLDwˮ RR.~An.'c&[eW_J1/ܯࠖ4#rplJ%YPf}QA)Xk5G!ě{IǧC${eOlN.8B\ wqEZ3Q rK[eCB7]'؟?mOmeԸpQm3ܽ= 1sH{*TD3QIRXYѓwRNt:v1,'*Eh ;>_JS mb_1K 9GX6|3.P)A62]旙TO.>jxP)\ m1iILb]rQ R1J/,Px/HͥCs"KqHa)/5_O63 L4dg{L>Kh.nI7SsE}^y̩r,77]]4]D_PQPm?1U`MZt\* 6}gZ 9~eGڠ~-c;ݦv - Vd/k(h*@@, D%N2*ਗ7鿧q: S`iy9]+v O˸߈\܋ d$B@b.4dǢZdt\Jdk]8ɧzo ;y~=}L)2s*v>I'GU⟐:j=$]iS&ayi7/L?Q9)*%QkES@ot0&f!Ees\P+ E{P_+Ρ dQKZe# \Q6I&@C/@v;gd7r~YS\?W r?#b, VƾeZAڙ˧-!Nq{zgeSӢ:[4zا+%>ܳ́7"E[^w5 ?X3vy| 52?e:(Ge F9jeK7'u|̓VKm:){m#W/[*kƝ psgs8#S-&k!me!$Rl#9iC[fۺĮ{iL>_|p2ڜbH>"[_o.lQ(̗ܫһ^p>C<#Ɍ_~PVGA%䝡| uoN9!l妴 g AI ePwȷhl2B dRڭ 3GtY}ndV=R4#R= (`ބBV~ud[ ԲkVxz#,0Dw…tP4ʙpmkoAY:)Ki}J'IZy_*2Ow#h? D7DJҽ&HI_~q =Nw]e|njol$qKtϔKft/l>ec 8С,$H";咽\'}Ot Y1&U>85ۑ%C^C\&TcS _dmWI5k mY۴.ūC8{`,OޡYH:Pf UM2ئ[~v_soqWNz1 }5#A{I iy&6]ՕA_z֤d]pF;x8+lNFq.4 /.˝Ǝh~FDf1; o>׿"6N쬛YK:Jc=w!UJzwSKA6;Oc@n*!ΔlO%6= }p2"\'1v %D淛])d:wVoNU./:l>2fw7/ vfE%1}!lWYߓQyW^Ce\ߣYz"RmIJ&mh̅t^B%63Bs~)Fjv<ǿ?|4>#'t3}v!1HHMdQ/3KcA62+(}OSar=f0Оr"_QQ0=_"wM0h=K'r$K\k9š8Ps4𱳒P\(q촙mYIk}RQA'+"R 4?JfΫton^!yEq*SlC>(U;z9 >FИ%tt?Ոpӥy},Ne;/4APf\P'R]ߛvR)?fj0qA) rV*}Pք^]ߗ'HkΔ=T8蜬ފ׿׵6rYݐyXwXb#Klw̝Pe;lʱA;T5Z WRt*-9Tչ_z qb{dp/M@/M5oMZ5huQn ͯ0ʶCy\P9+Y_K/T\QrkĠ HHJV7d|xl)?ti}#Q,ic4_Lam{[U}׆RV Lxb(.xh8LM^^PSBL|"tT&wt{Æb̷GH_[F/s7IT\N.߉nI> JqʥzjRmbJƈ2'FYqنڡuolT` «Y}gvt 吏c,}>̽PUs%W` zm{@4m__v~p@w /`x4HH5巄K,0_.Kc!leKm"^0dMLj#N-`[`Qud6*Iӿ4ۘ7+ҤJKc :~㈲Yf2C'^p3Y |#ԴVm#9_/Y-{t/ mt&@ZU%TՂbK#U֓}P2 &8m~A;D|D6L>a])X.e4mX KߑNbuɨk.W\PD}gߢi\X*;y61PaL&D/Sp`8_4[QI7p`n*rM^/WEz:)| |ڦlРW>_MզߒB"C=S=#۱AN Mzhga>O¶ǿh %4"?FY>[yESN=f E3i26ŞBgtdyK# WC6j̶mF&qUEǿw~GYAk"]Y<=)\4zBE&䘻=_ k+t|<YY :^[$N|6v#tmC7R]* E@-aK  :kUbxhsEeϝ2z6*+5S߬pMm9ejD߈7aG dR**$h.|V=eU"2 ,ŗ [{e5dG"]+FXdѯp5d:>l|ӿ/4Q}*rówb٤GvR>0nobV)h9+_K@ԯ:-qjW֕F}lc٭ɍ"a,B=_nh!lwfb |آ<\GS|=7ѐqϏiV%6r$vvndT@VCB .={=& IbulU{f|ujQKOX5> ط|f6{ B!|kpkUkZa my\?k065PG׷?eZPw~quQٖQj<)k'F q>|(O^V`YVB@P&g46,BGiNJbWB좛߳&|ɨ{E4p]SS@:3 N˚% 6{Kxsy.?C=YPA)Z/bu[day,RA[t3_IPv* ,/s)S"-L]L>Ml|/o{iL>_m |xi"@!ZH5F-,ڰx N]7h *oPU)?6-fE[4I;*=1&I~m\E5S&Mvk$16_ǻ/H\_^Hh\MUTͦͩf/8Fͷ{1&day 'Pq 2H+C|Iel) m35Xf(̃vlzO\5 N"Et>v/x.Wb>h_ɇE^n*ga B[G1md(g_Կ~{k&/STtfn7T],j?T3rqx7lU(AQ=ǎE7X%Oo(AifrO7G6ݚ$;6=VHǿFqt7L4)u PHՊ jĎZ{Hpc r~o2[!2*Q輊x6+UX.ZKpedx?oj |!e} MA_ZJsvaYk|}OF+Q~}q7zNk&k<4cцw~NۡL2;%.ݞ5侧FFv__3!:͒kᬉ g".U0arXKwZ=WS{ѵ'Qē3{G 4rX:bT 5SOɌi+ _zpΧ<(g#Ž۠kK4658%[;cFv =ب^j{KcA68AK{~ lf*,>B5G[%3+o/TdȮ&C>>R}r%nx#`Fq/\%!$iɉ}c!̘tV;>`/KԊJorH*1>"UK@2$}/N)GtzP 8!j50Dwj$Y0bKzJ 2oȽ*B_om5\hЭSz._Ȅ@JFƅBϮ^If?mւZxSxb Ŀw.Ӊ ct dG6Ku;6`䏺W5Yǿo#Gp. rkv&D bOЫ r'6{OAnRQ*{bՌ9-N ,Jx7lC٬ ,>4t|P0/L$ {Ap<͕v({_*vbe(t@;Ru|M~y-Q d_ѭ¬\-LXVe!xBeEG"j5[Z܍j}P{onϗ@yܫ-D{*4 }jCg5CLbU+ND}}} o'Tf &`fjP&LuY ƫlY8B2Fi_;~l>≠/~xeъ Kh]LCI(O_NMjg2kM4O &~| ~.>qF{ȹMhQm[/5=( _~J{Ņ _k-prjG i+R*O 67k>/gѺO<::cuv̳"蒢Ci"P+>:txNO;t|hQ ТUӱ#+\?w5A{\a܌"4fD7Gj!]& a'Fcda;-] SfϷR:3LxA5 ؞lFfz@m,yM˙/l>Ɨzǁ̗6 6{})lfh>|B4~$mO{F}TMZhR-w?S&~TsOGf*# 7vSS];z[TjдG6A%q[Ysg\7a{DԍM &g3_çL4rIDF\Ԍ./^O6%.dտ]R,OEJ!ARړD|mlBSs@:2 ,ZEn!yUt&-jh&6cY4>rg,1m5a?c_&OSw#.G ?w3if.X4սjcG=^|Q Ǯ\=1C|fc>U;m {M֡]>!{OJ> -Xi'p_[+ BI9V|*1S_ԇp݄Fq\Ѕ{Ct%d`$2t\pݤrɫn閁ʭW8Z)_. I~c--q 9'=OHs s<6:ہ淔P|3|ˌuֿ_5v:*aFu못1&jɡ^y?^Ns|QhS}[agơv(Q_w=*ۊxSfNEE~4C2!{X6x"eTB(YE^C0{[~a6ėBtG!8dTH( jV z4rCI_(k6gQ(8kKkTzaYUCߕXW K\#34 nR BZW"vm5]i3UYZb֒(Pgq>oX!E7J%u0梂r/oJWuR?c5RXӵ*I!½I.h^#"zCJyc&cI.эf5==h,urjfPs7bnsob8Wnnd;=v('2 *Vf)EY׿Q3W藀jʱ{>kwg!(_F)'X$ zǪjq,"T=H OA_x,`eb(Md{!leȮTG>69S >iəC/P(̿\59J\OHEW.|K9|aP{*]Cu _b4Ssc:SQ)a$kcЃ, 6..(7}{1u7]/okt}(* jYuQzt2K+6Wު 37<(o>6#=A522q1kB3H"$GjUF?=w vq/UV[ﱒ!\~3ڍJ^m5 c]Q$ѽOa/kKU&lᡄJ= {dz9?B7X:Qn+aN^Z'kD܎W(Ȝ#P:RN:#HcQ^`KҹC|{55/#kjЬ:\d<Ua\\L,}]Hfc$ dbY=x:Wn`*[3\A^dXg3?ߊNINFq1ΔGmvZX1AB|{ ~|^o}Y{l:|aP^v(i鍇ɨkݕ^R`LHVb#$.{'s&6r!{>+P_UiSbnSzƤ|#,ƍ&6\dYRn, ȅvD;p#y0vס})zcHYy6pkzk@UW7)O}55O3 k s{!leoynv?FI%b*N(kYI )a|UP:者| X[~:*GܑyFǫ|2;o*`Jwd˦6FH ؉L X92o)Xᒉ! ۴NHڶM2Lz;k\{zgm ҿ^AEU1BvԾE5|cm'1t6_$)P2BCU ]U߳#-fE J{u+⣙ǿ\[@јPe+\"'!xҐ + ,bl:<+=9Z٨VIoQ `kqS6$ZCTx~C c ݚXw 'I* n6q=})h {eKiY >UE{ ʽϾe=ܬr-҉N *m$OM۝:lSyDv2&eu o,Vof^mMf5鹞~`E_PIgL$d8LCy҃܆ض9T,U8Ljkq_jx}ǿ| 6۟Mˬ~venAo2["scdDq^wƊY9SP|XMd)<%tP}Ĉ7Joc",+߱AN.tsu|;ٹt/6˪(Y6խ ǗUcs-k>63[̖S7Ifzl_uc&Z'}$TQ  aܔ{=I.1 K̠敺0 0J;㩠tNlӯ5R"2 C9…X#vUJ'x#-]ɚjHZ(ݎ=|X{B[ݘmVıM, {5ǿLlwC'4{L`DJI޳[T/VH C^.']%e{M"fǿWXm7gdI4\L;L/ 䖙7 r!d2ĵ׿,.B..*3] r9uE)'tZf/k|/Ed@E:6d<S a}<˽~,+qcgc/ z?ˏ-R>| V&wca= ڢ7~zXmW4-ϔ3h^o{A[݋Ǫ?Ɉby]*}UqR3 UHsb2WTrqCX}܎<"l n\ruƒ9ؼ!pzn߷Dz[S[6s1[68xԽ\eOp~vzcyCS#6mglW^:@_@ƋFثm +r;ajƜAǿG_-Qr"/Ξ/6=-x Z>jبVI{L>_`R!FMT=C;6}-er]7 rݯXy#pl?ePYmi.*-qjRNle7M_X0y彃/։ƳfQ\qǫ pu2eZ Y!zT6A 9΅kRlGX\(7:&9ܦbF`VdGm:zTʏ`2k)أVN)e|:jMg4'=JH+z\Y ,`S'y^ǢN6ȏ=Eco.`aBa(}/:RI5M]NTfQ2,7{^ؔ<RFZBnǿ1OE28ʨKyՠGb4˼R6!k>lLsO2KvkD/|b8Wƚ O<8 ldsXkȾ1_to11qOqcokA; }ixڠ♸+n=g{il:Ǐ/) N3B(5ql" 1'ӻɗz3+FbbC 6"/Q6+K d(쬔ӅeؕG/~|}jD҅Rj'Ƣ\pGMe&ZFb'fM3.؛5L==*]Cn5'go`Z1*.&Gk>Ids 8CIa}oi"+#+E",Rއ|A~k! s4,iN,3C(貚ALOի D4,z7lVֽBLJNZ$:}8"<ɚZ*k?X ;|1oTGGX{*!)f+6(H}Bj)FVNF)/CWm>.ǺDf+V^ 8(d"|*_a#Y3hY"?cHB@_ º*kJ8 kaEX%n6Mgs/5º>zɪK_KbZ7y,9YɪK_t\OΚ=߳v?>!U"ϥb )H4Yh8yml(n.jνO/+וT5(gW,7Z f{,Mq&C/Nl>V "̠׿O7DrUe8653WSfv7t  {*WJb 8Pp)tman0Rolu3᝴1^=jXVctVdzlp)Wy#n }AU~l>PA10\P{P%>˨R&II7_;m{2*ozuo'{`:axw'z\)*a"뗟&}qU/*l.A.2)Hi[2Vf}I)βb9DjnF\$JeG[mr e5`Rl)).ԃ\ՍJ葵Q2ޅN& Qx!G,Y=V{r1N N8[q{o`r{ep^]Zbc0 Y_EnONg2Iq+{mhYik`*Aoó?} vKר-v T9ZV%V2~.]o@UT7qYdBs$s~:.fku7suq!LBzN%]~^( HҨQv K嵌+1# 2 &,dQy -H"ggj wUf:4C)])k7H6VFjM=ޫ dP&1v܎]lԨrEq{Ϭz7-g5vVa٣a +Y`1矴>O=mF_(6l2Emyx;o9 |L-U) 6oڊ@ T)5ot)p";֭*MhE e.guttuPA6Ԧ <9Er$Jpre D92f.E{ʬI+4M$(~J7reQ*h+Z QMl"~2f\O$zI?V3yl*1]?wxuP>e _ u=u]|dyH2OG|3&ʨFn/Znd,G4G%siBG-rxx/&uS Vf_YijP%e;.?Pǫ: v_bZBfăIiu愫^hoò*o "YT2^:]FV { B/rԴ`U]5CIڒUHKPze*ND{W]奟 У:P%p'^@+Y8l!$`h|Ϥ9&(i{a';3+]WܐJ%2q>wh^FSB#Qe:kpwʋ݄͝ J &HVqd~MIܭk.޼ىI,& "i[ܬ(&CQ$9nr'~>L93;X1ǟ!VE.EФ VO<"7'ҹ)9"tu/}QI}Xxksl/[b,,.3ÁM,Q&eLʕ5mfG9TmKz79yI%IA.H>VMH_ RڱfIWVTg׿psăIQ_=/\^`C|ue^IR_ƏSY'6,R'ut֏\+'(dž\CuI.)L@ ]ݡ {8kٓrtkT_7/u\3dN.UFs ۗ =v8Wt f9իkVm)?Υ6˺ڼ|,`@kyx4_uF,.l-(thv wcӖx0[SЭT[ , 5@bI+95 Ɂ@6:Zb֮8ݓ䖾޺F1uO:Te"-tkYW<$_Mh5T^ը=nL`&$ҍ7s"MΉZpH U*H xOXGW,ҚK|$q' ^y&e”fyF햧bJ$"^S!iT.r6Qm Ğu$sY}=E26|QmhJTK?6m mgi ӾA\3/eumf!n׿Żk;iٽۂ/"mUt7$S 2@ڂԚB^OĒ\4%\a1V{('h Z-i8 x"J$w7߫R&ǧ?ɾ㫧AOےfKm"열zaq'9MJu=6˺kljdIo%+G.>K cI[L2J<{MLg8ơ8r MCO\v$G'Ooҝ9AHfkkPطtDyv"- E%h@: B@xMsUG3҅U8 " $O/&?A7¢Sx 4 P_W}Ǥ [ew(S\SvăN߱aIj5.zq,~pRwܷx=t=O4|M[;tLMODZ$!uNdA5g3oZn)d5㪅%Tv i·kqQ)(%-z) ڼq2ʹ5)% J9叅2Y?S{ER62TP)e&?ȷmU2B{@mPatd~;aPK4VGJA+>zPv} Hg$) :zKL? ;^l-b֔jb^L?i״:% $4 1̀ۦz^*^>o|ԤtP ·kmtdm4L \ie6UMد4!Ux7t5&ؼpp ؟=ӲHӰbhkb}.;{v|Sq/D}x ,Kgշ¿d$œÿukH#3(WH/KTuskam΂|6swhmI^dm1 Zk`.hw~9; ЋM7[1o# _Է^۸F=QmD0Zsgj3{'kZ885ᄇH`3U_nmsCõNaKΓRm/^gRОS'F ǎc7,n7ek~HZbH8PA>pRe]P%k4YɄ<D0ՈH}QG?0:Nd~HoVi :EH4 ^g9,Afu@Iun.<'5p췅ckJ`\@l>@d߈z8'ІrIWЋ[rG2Ix*:?A_}A7z*]{O~x%vz@@O^E WK`FU)WAE"hp\4޳rtoG- fgU49<qĂޜO &iK(`f~V)|kWc*;p$hý7;\ k'm>}L|[[K:@&JEA#F d%Hxd~mcm`0~Xu}, p%TKD#W0R 8kt=\5'-s4M_& @_9a_o/S[]2qXxisLQM'6y9^MuS52鼞2܇4N,E2Iȿ=zVf#a~qË@_a/s\OMaA׃zJq&QxС s' zkA}k&x&!n4C^-5_KqKN[ۑ6ER,- 3m;! (vx:[a-Ams]ؽ9ɮkU~dpIHKyv <_>/o_(!K#\b7H}':y`jfG.2(_y5e*қökd؛t;4ߐ2:LϿ\{ (,^^sD9ඐ(֮_oͤBV-︁{)ߊd~w@#1;V~ϵ8Fr$5!Qwp{#2U1,/qoyc;Y8Ӷ&OoQKM v-i@ڼF&lճ ^A OŰ R#\pj)>6ڛn6!e K)C^A.ҡs/]螚̇BOaK>Qg/tDF!͌@c['lW3JLRk]\?n,Y"iT ̫ۋ'^hc2ujw2v"|C9^x2I?HI/ "<װi䣷xj-/rK>`]M:F\?FʙF.ʱ-Q_x[o)įWwmKVɺnv;[($WpuՁݮuFV3EuDC!TX 0X{%D1v:,~^RlmuMp^"J"ӯ6c>\􊒿;d~ݦ  <{֜sۙHf0Hz.0Yrn+}uI'$"hOX)Zf~Yu>YOq4.qkyxO(/r:~6mi*}7w9?_?の+?*? Sto?O}Lg<׎z/Z.":YPn//D_>]&M?7c/f8'_Wyڭu`ż_Ї07#@l芹Aqo)e,R{5'.#jѵԀ_v|NIVͭoF 2n/{/ ;>KۿI#аCYs2E>"8$Kz^g՗lũsgyM4Ko~S;Z'XelEk(ϊ&|~O ,XZ–S/fX~f 'X.PI s E2}d>'sɧ^zGP}R9~J _Y0FBEܠ==&_B>Kyv02qЋ^Em},w~.kd#V=Oه*GsEMN>5l[G9jmS>7˒rVs7EK/ȾہzF,'*l 5|͒%UkoUiFro#jZQC,Ur\|~mrv eI_0лU&Y 7\6x~g Q|U2 Ks{ߛ|E٬~k{SrXy]VzPOe:H1 .YQM>b\ֲ|nQ{O(ߥl{\ǞR[MJo7fuJF6V.~sΪ{OV[I-@v1Lg avQng۲Ⲥ>b.kt>W^}gzw@"1x aepŕ&|sc,)'rYM>l;ֱ엛1e3m3I9-!YQ;v XQs;|ٗz$}g#Vp9[K,L*LﲤG-ktoe]YXhl#IlKOM]Q dEy-F9m35w,[|EٗޱU*MшxmwÙ|bM1Z+׮!Kx GΕ]paGsuzI6 K}d䉡|[(=K3Ɋro ;Hֲ}n]{O(g:FgFPe+{!xVD/YQކG evf~oe:#[jFC=/Qv68ˊ΢>bLsEM{O [KJdsj*'s~i{ݱǼw-KYR^#V_g`{O(giOiC! f/kYv]T#'uܠ׸ԋYx_*ֶ}X;־5V{lJ1R%b)[ޗ[$N J }) ,)_El^<#5vفs{ͣ|ٗY~9 PO˓EIQo Ñ%?NaF2ג&y_yk>_}_^~y[Iy/Z\?-ET#垕g Us)~$jnRnSSf sm sL…p(afmuqYREih-EنRT8r٬7?˵m/km۶9MQeI-e5*%;vmKݛ|E٬waa}-g].+#gJA sO(= A4B5do=aZPX^,G*vr_]s| K/Ⱦ3[`$غ([ ~N8Sv h]~E7 /X#+U`3#JXY_PT|X?-VXS/fY&NGC#Io7(}YO(w%Œ4tbiYHsН fJfxB,`vM9/v/|}3S?="Yu*.Tesr>*Oc?K:bI +OݿZyS[ヘEYEoMJ9}Rk}~K veB<߆ŷd-2?!K+G,h|ٗ[kHY9' y굉{˂k9QZ. J{so)eN`ΰOyDKI;.,+ d6PŹ$S;rH9$ ;yuq j|cݴ*.KjʑXe|{ig%zQ6|U7nx%lS1^9b9^iWYo}|s&-@ ᱦ,@V;;LJf^yp7`\OŸn1e'jX6ZKx7ݛ|ٗޱ,< qalWYs~~|ٗ{>}}}Y0}l;yx/ezTRzZ 5e &]b+YS佾LU7Ƚݫ(_knrnJd# ޝw.wNP$&ʭ eI##<+eܠ0OB.N@3|} _)S݃mQTϻ3, YkF7 /3Q-\أ26=]TķĒu|L{. /SN/"_迆0bO%N ~c%";#O$eH=";&zM>1 xy| .z"G=]띈ʓ1ɒZs:,c;,xoeޱW>aݟ>yjOzv }?RWX7%UƑn^Ȟܠ~QC/fq4ՌhhOb$k.S?pf,(R)SG_14x| ֥,9WWx`[|E٬w0yC‘<:F~y3Fx=Oms&lO7ԋYxQ*/%8P߽T*EF[-{:zX|l;ՌQڲa6#J++dEx8̊ߘ{F(=['/_~goe)Жء[|%);SjoPuhnRw~Q=_zG|M`x>ui:Y<1oQߖ"YR-,T婗s{:7ԋY]:V{e qRVj:WQweD8#u5#5-Kndm9ߴL 6g ™yk;3˞y ʟz;_zwg+_FEn3b2DaeoGNs[_z-2C8#1gx3{s[˂7{9 <6PuR6뭼깣i[.,o3;v;eI۬Qnp5ԋY-7rקC[WHQV> tH&sɧ^zB}v_aȚ]Ӭ֘':ܙ*O)̺{_zef錌D,+]7"/]/r>cM3֎Xi!l]"{O(N>%Ljݐ9S.{*,_VojWCcߎw_#ǽק&>|jJ٬wʷd{ִ(j+-*Us'+Mt| wQ]Tu7|:-TEnǐ%«ʑ8es{ʗP[fSM"=w~v(0O$O$KF-?eqXDnDw /S.Wg7rv0}rz;vx8bRޗ/M!;bP,*"M]{RD:'eIEEFgpܠg/tdx\+e_J4N:_Ԋ*Ss5C{w6a»yq*#hP~*"Rv*޴(!;qֈ! {NT '0m.%*7#U5d+9|{/ ;~AD]Q14Wx#ߥ7G5RQ(ZS(}rfzUdw+a-b~'p:gWg?񭇢dEx8b<]vs_(+d_zl<c62M;Y<])_n>35NWeEb^BA;Jнɧ^}שB,;DmfdEs+MՏ {O:2e{Q_9?y|8q.]=8Q+*YD =H&zAw) ڟLӒdc\y: ں }J#KYt4} `zhOPn'rZ(Kj‘+aUShM|OdF# e1WRzϩ8IFb(툯pޛ|E٬w/ ݌t 7lVMuQz',SN=P3UW~~УcwubݬC+5eEp*a]<{EOrٗDgw;dT!C͟ ՃU,T9eρfzE}C/fç͒?ybM5U2U;ɿfݪ0%+uHWmZ4Kܗ{/ۡwP-WHs 6~*@*؎eEȞBehnP(^}}Z-}X5m݋S.|e:㲢Zs\(b([:N%<#C{3s O Y*oݔ%##+1K˓l|ՄzcxcCjOM3AA|ITBpΒmʶo^=փO(N5ﬓw;[uqowy+ YR5^֜64-KsRٳ݆qE9Pu,GRCv sG_ҽwMz3fvƍ|tZt 1io>@#ݭŇM}FIl[|OԔY7Qٱp'"gmc*YbH (NxO-Xڠh7` Ee9Źe%lvlCs2ݢu]~f\rO'6[Q׺|}į~}[[|E٬w÷#^9`gZֶ܈6?[GbDCbʃ8^K eۖ~V"_jwԉ̎=4> S/C\CZ'ԫyΉ=oG|Nxur_ ~ULԡ32'bjuro ~Qm_z8@-QV-m֎1Cv茑<^<(({y ٬WRߥ9 h h7tUBzdՅQs޻wa[W#AKߴRt/վDR[!}鉬}kK﷟~-ȝ0#]SNQ;4U% YQ3g7đG YF9w|K޻ r} g"O+[if% v&*U.a—ϻzy){&l&z>q8PL ?QQAGv'Scn#&zQ6띰Xg` s(<>zeŏDYpdkufOQDۜ/wGW\n2'eQn,o_e]; V,^{/!œY],VKtbmv=!8HKPܤoΗ}pY@3 6(32p8rȆuz zjn cS,+2vswiK s}h\k[yGW|=j"gD@wHUgs-YQB/f-Oq$XKƦ|g=/u[Qjx#dMG%ԫ ,NM*C!r#jrOG艤'&yj^q}ay8G:rr(;?avZzCs 12{|,k)#N"'>)[кm%es9҄NIQs7S&l;տZ''TWV<̲/JU٪x{W>!0CX楄l;XjnpQ&n:~ܾ&ãlo7O5zu휡wyYSuB_?g'5]VԉfQA,vNe]Iw٪(ӽW) _t &xMT߅#({w J^ %jy&zdZk,~D. -2oWUt,A:"{:X ELOUD?(v1Q~hl~+92ѿ~ ,vI|,eP YR#8҅5>U%VʊsNȲQ+:Pk{+=KGZWzl6):_z1*Ljޜ^9e}0BDv#MQڍQpfCD|ٗa[ndS.:@4ef}He7i=d+09wͻ^U]C]+\nXJ0߅pA-Zx+c|ٗ)^ɸlX7{)aMuavYZnid Έ[o73?CS" ]NL7=GTBL[.+f͆/'.ӽɧ^}靰:ZYf/"tQeD%>t8lG0]>;K-gI‡N@m9(nij^%-駡mU6ٖzmz2*^t=S՗(}w|C:kIGȒQރp}x>W|{V;\'dҲo!u|w7WG9}inJXBv=(K/ ,+a0F?V-VZF!bQW72>˾ɦ/KYYJw~gq>3%N8W El)U'/}a^;4XmC7aw9CT T([s=M~ KtDH5oQl?b?KsYQ};91{}toeiMmXb!P`Y PrZkUͳ{zmıMo䇱{M0:Nxȝxe܁Y57T9-[F(>?nF|~״/SY###SMsGy;Z7jNjGfk Ws{O: oI~K 2wiG+S=UjfdLudrߣQ~B(^^zb']٧[9[cf+kR ےtgpn:hlg++Y(~ܟS~#O`R^rQ>Xv!^`fLQ3Tu3^_cSWS$(NpX3\po ~!EY!Zy1>YAY ϑrǻ|E٬w{O9X7!<;! }%j3 mW+:z-٭w]`n hZ@fڢ!15#Rqƈ럐 ^}SS# N<\eمFe+QTΑ"-sglaޱ sOT}e1/j"nMߴ8ٹ}ly#+#4:Tf2^~#n^Kӣ ;> >'z /\ruߑյw\'j|3'sVdYV Q}+y^Tb|" ;uv @f8>˝^[Ct'UzG?G EGN-ತ*YIQ*SDւOpABӋw(#ʄݟo<j7-4RSe0sܠ|^EwGymmt~JY!Ο2?? EVX47)_WZQ|G6sWVT7pO*A3ZzD߁gAYR3#otS41wLS޻{gY8_t=q޿e⼯ncqW1~]4`GZ|qd[nީosZ_`lҐ0q_WZٙ=!%0˜UZ{O(s0\+z7jBX (],+8.V5Igˬ:qd=ȬZK]]Jߥ_ Dv?+M~Ro. s'1%al!&JK_B/K]0S4Պ6`ըߥ 糶khkӖ(. k/o X2'XA=Q3 <@YtH[u5haxuM>l;b- uƚr  +iFT:!\tJ(Y$9wtҽ^S+EKcO6T~1rMyJ]ܾ0Oil ~y]}yg1N8$;!(M5e$їN ]#UeDHb\).FQŘxƗq[Db. \#Wb}+G~[#Y,50Cg3B&Nk䳕kچ(4zf^#"7ԋYo.KvpΘh=YWV?kdEm4T4'nQ;Ν)KR{l;O 砱C&HoqUymnoeUY|E٬wc,Bh<3EQUsvDh"fњ חEv[F7QW@2o w:3JȈK_N/S^{g1\X2EI;)Ƞg:QBYM[մ47)wY vzŎsbF *;̰>l;ՊI`DLa>iWIw<5> 1å1ajnR,d}gU-zb59B8Uycot7G%Oj/Q_ >l;}RmPoJO#=^[C>}`_#Mʵ\X[YcǠ ǎPwl;atge*9HE ]%M>K&{Oڱ/OS26Sfk>T[* wP̄{vN<z'^DRo?{ vckC >;ʊjA$/ CE:_zU z p98"V y;FoZAWˠgfzgAY]ZԽY[|E٬>%}#a> yN|s,sPv͹G\S/fmI %oQnܶ,wȖ;m!ۄ-J=CHbY삨Hփ.ׂ?PTC\lĹK]wqܩYNO٨2\s:7NuR_PQԊyLTY1&/Y.*#-BFEw9p,@Ԉ]6}@Խɧ^z'0W4qKrvux_AOzQwTgsO_(}J;EmWun({ݭ7(K8<'>#ך#~}cdm>$Kj ȗ,{s&zQ6&I8$F *Dt";K.␴ d 3ehnRrYð_8ŵtz>neIW5, tSjyod]jcid }P*؋:鹣nތJ׊*Ȋ+sنhS/ȾNZ߫,,).' #⑒%Ȃ/S} lt{O(N8ȻȞf,Kn;߱wWŒXf%Y{& ~>Kd89` B9߅|rI·y"Kz+ 瞅ɶduԾ1o|OzqB|(eA-YLpϐz>Y۟{KT'연ǘK\fO_QM7qkf밶1u+=ҫ> v+:r6θ=r#rgZds:B%NW|+_zǻOϼV{7I,TD!r՞}d"*3NȞwSg~yOm<gzDs euOiHm|״/S8Dc'S뽤|_geIFF$0o^ =V@pH﬘S hev%ow?,:2%[TݤDuY^Eߡw3#[:26 Ȼ虢=T>EOJʎY-Ε}ٽO$SdImGROl^(j >NPw5J̴`M",RMvNI-5ܤ;POjC䇁5j1a(C-[F8!TeOSP-ryg Poz+)q֒,Ss*x[9P6'd 犖o0ފ4;2EHȠ r5fv3d"SV+{>BxSn"z"P:O3]wNAan핛OhܠlDF!Ng1`~W=7 'kHRˊJ(+NQ~^}ةDVleVԿ{fR$+zfFA<7ԫ8č?n?:}D:xjިuQ4Nd k)o|ő5_/ bKe^Io3ec]b"<=n= 0zQ6Vo='L{K >(Kj#,,*K5wM>lؽVnpmU.uxV}0PՋˊarOę>+/|5z$-IdA-ߨ+YwȒJ+iOrY|%٬w oF8@5QOS*%d)OXԼ~k!(W͡wdE).6rFjjSu|u칪bb_'u|}^z^S\ bg:dUTAbXWO ٢rb8_za2  =rXCdrgy7eWݐZ{䐴J)42!eHgw}p숽RA/cXTMg7BV /gs]pKtYKd()S{z=` } j򽱯!5{5WPeҚ\ZST#E8𤋮S"|;&гr|ױuq~`7M˂x,ʑtJ]s^o wˆp${gѮ(?#WdIAnG6=1"0"e_z.Ix}Q3Kb%c]O{KZJ(?^κIicf~.i/w)[+)ƷqKD~8+dE2ع ] Ny# /f !26k5ud`+dIհ8RY: J+WIߓ䑡EK+Q9N>?esl[7ԫzdve MPPESs߄зUs&8sP$OGwQ2mSN@Iyq nd0voQ㛖lztzIܠ~'|Eٗ VqOı2C&>Dw^=9B? e[.Q~8^UH.OԈwĸSU_PS6uS+n\d|r(;T%a jr(YFYQ-g@o%xoe  n;m1SE"oV[3ջc'j)lx;*{߲S/fX R=}G/ E%۽ͦo|=ƙiV5 #W3d[u:p&?x#|g|,VQ;poVu{ j2l @1}Į _=v B /hfE٬wB|~FM";1Ed.5m #C6JEyN >l[w / 9xU) nQM@YQO;; m`ƽŇ^z36=Q3BRV嘆'3=Q;J,w=N=("Ysko#K+SC>m~CfttiI76Ei#W]w!a#VjJd N~eE\ZЭXԞX3۶_9)PQp~Q}?VbX7ҫ9e*1`^;ߡcRWX5tcq{q S8:O^4ge@ߘ;LĶXkW=d7DlgSӡw|#X}S7ɵoh_goԉNGHe,r%; =_dMI_zG:(ך#y°Q4_luvȊ 4A,D8(~+;cὧz0Yg̬Ղ Ϊs*?c;F2;v^f+/Mz,<BΉ҉7dI%D1ɢp!Z6cQt;ŒpWXgrX.%߲|̳k1wZ4|U7 -o+jvP.+*ayU |u/aB?  ^3[hUQY״RNK ]8.[[Es{~vֹҜiM}y8ra;bNz*k۰Q!YPON 97_<>R6;:#&Y2]rGwę3?eE͈nrdZ-0c]٪`\.;-Q!ߒg-Qa<\rܚ];݈s(vƼyoyo/*<HT!9Qr#'#UX/.+jG GbT=1[^z}{q,e!JvFm沤R40"YBܹW-Pm_z):aD0ZqU!aD0z%je%?\kѯxrcߐN sNu2Ǹِ;ڇ(ٖ9?jF͵ Q`{%e{'ɧ^S͡wNGLfNoIU"rzʊExG] !0T ]*kZ)*pSY"sY7k*7g^^U5 Q/\ނZ9rѪY٢+C{УחCKٗdI:n%`}7OrO i .ki<!ٔg0g,wvLnvPK";d'> TZnTI&>+IVm"S%v֢i~'t^&"Xnf$3x,e@VmVacm#agb= NlUx1TպlHJ 8/"WT .mߟ;r(}zۗ߾#w{%MDꔤy!X]qLmrpܐ`4/,ø 0 ;Mms[Jۧ7,|oS}ky=սm k}PŪTr-Pޭsxk7~xFz>M21 xǘ%K1fx#BKR1F$߲9A{WUw;ava.3dUtR6s[qΠmW8N޸Yzۗiǚ8Й$f.Iޭ6*UsǾ%ۧwinJLQ=N}dvܒ즞薞{]"0onm%e/9'W)E~ϖu*7 y1>%?}S1n4ntY!n4OKa8q\.XWNk[U?ي"n]ϫϮBŶ˃,t ,7Fa2Zk P[MݏDb5krI;kk6녔ϲ5l%\=DG'm>?-=okϿjY|Y9]RD# +mWDݶ 9n^Nը5}uNJK=V=VoI*ENNJөL/{ɬ5F71"[dGt 'iEY#S\#17eV'7Ktr~_Nӱ VL.>MRdSKwE7?l%ni ul\IF+ۗ  Pw6Wa=H'j8#mZsS\[?۳ Z j5 w~MIqfUHh9X^r_S_}"T~w+wb=yDfq%ZGmWMn"6>B/`;* \%Qg9WR) ͌;$.VV>w)zyPۿ1֔5Ǭ+"7vC ݰ4}ªkݶ] g-mؾhat|ˌe>m='.]:FEz%ۗ g;rE5o=В_W/$2ODp<~3?1Q=wVBˇynާ$/^HuynsэYǟ uSO\biW5IMQmE'>%4uch`v= /̮'hB ^Iۡ)fr_x`ݘ ~w<E>͙hĚjX;fqX䤿{ϞZεm;`Ldlz\%4 }Ϝ~ wRo> I9/=")]Tޔ߿9vqVl_~>n!/1%4Dڰ-r=v(5%vm}opߩl~1D}/Ļ^\=~>T1$fٗt[ؾN[E57{Q&ۆ4%VR0VuGΌxKHwV}r{vg˿yR4avu&8_Җ҈ەFӃ%Ti4=zE+9K:|BƳ))wږιNdi۩\)Eq6?~|%N;EDS$/욚D}ضT9܄hymJ|e Ʈ'7;OV,ܬH-#0f7&c<+0|vtz鳠x!o{osI2Ӗq#s0Ov]_: QlKRի=_sd#[`~4ų_;ʮ֚|qvW D .bMޡŎ78rI+YNV;0Vr%Ef[?6Ӗt<#CO J\R~ Uol}"/5nӷ$}W :VRso5Gv*tNt__m^d7%,OX7+#SRİD;B]s x""oܑ%?Qf&ء_SY-#_\a")'k]#;+36X+ۙ6~_r1؆`1eIJ+.X$}E56ax掂u\,EM+K!IRkgAb5Iz=Tۃd'do zjgTI.Dׅum{dѶ˯_WwܿiFɬ Zr'(j\ҙ5Gi@b!єKӣ\NȚ_QIEtm'З8t9M=Z>}3p8rr=؟շ X-l%pd+r&ؓc~6npS< OhlS"跤O$Yv0>p?a~lI?{^ˑhE~[W&\`G̺df/Iƃmc۩H:6QWDZ_K!pHQ{3r);CDl%g6~'~ ݒzE#qqߓ\:a.vIYGfDN]g y;z$}wZ_QzmzRrm3҅9. kD=;h+ a2)I?]_V}I̽WxWd,)YYOOi6È#54 d+HugOwRJY:-V/gSOhNgK{ْ -+"ߖqJ`?NKvb #+}-)ΖzT `4auN "w7:ڲ8:x:zG#)b %+:w#2mZcuXE!'~f^[9\v38"؃G);l_~;cuh}<_1 [$=dKet yl[ĴS$/XOhNDX77UvqM!s [I͑{TUR Huyn\/fӾOdl-YXDVC [B4+Iżo+Ys=??k|H#cۄ)_d`/f}Gfd%5p+%JsƵCbWsGdgf۪n.B_}N][co_'&)/%I [IضE ^'5Iq1fϖ=G8Hnqjc)@->,DFxY++SPSkr!q`dqO"cKJqQ Nuytl躝U@˰Ѱ݁Խʷ>kz~kzO5$qOUlSGod$$d|6C̄=i+%$WB[JJ*J‘zխـN$ErXhLRcjW Ii0."9CJܐw.==m;Րg'gd㬰ttKo}#t@|+&k}xZoq"ϑőtdo[w5֓S,әZrjsCgջOtG<-%cujbT+ON1?~Z|ƚ J<)HDKRGY@[I'g*qmW/IQp_~^ Ώdm<hJw[tI*ο4p"]݆eޔڔ=oƞd?|0~R֍Xi} 봥 P#k>1X w)s9%ؓ6zxg3̸ֳ^hݶ ]J{oϦ~-uoq_2Kb=_F6nW='n/f^ɺ/d0|?əB")ޗc}Ch ,WsԔs lJSؾPuw,onuT(|}cQWv$q4 Մgp~G5Hq-CQUaGԺlhWS,'d+c>O]F5Wؾgg-O+~CwʕQ j%5kM.b?# c74IOb}G m)\}a5s!{#\aw}ռUUWATaGdrk[J5sرRvbD&fJooӯ*4xz/>\@j6PL,R䯆C2}|6[]u|N>>q|JUi+;&\w2GD+S,PbQdER-4*w_p_UO鍃Vޭ^SRX'lVegb١gn@p8UyP5n"WJr_KYӶohU]\GDrmgy6ނW <8ѭ%I5BNJ2FړQmCN |6 /?/=:KkVB"I;0|ض+ڽ&_Fқlǽ4:h~DOWr On2`IJ=3iO2Bq/_]*y_Jw%ޗs;2[axR~_7>K+uہ # 6J_??Џ -h"lܑsgSOhNX2*X&!-W%EG|j!΅ᮌhˈ!.)E("|N0M D {ȳ: Aٽ4:~e_泩_~ce+Q;.DP~WuJ?ԛKsNqRh.Mn+VkG%^ɑ+mr[(\]SDC?蹴ԌѶ,uێ{ҍE? h3bWdLF_1$5p0.NhS5́+iԔnF[-n!,5azz5f<`#5OS3"WC2eR#cmu{l)mߎ)7t:4A7/d+2Ir~_#0O/f?gV}8nG C}H/}ibS:@>[J3k1Nb4fJZaKi#m8pj>45m+}}n#`sZOO:Pܒ=[o@ɞlm X! ֝<??̄O)s S$Xk~qD䪈 /DT=,IڑQRA"#X_Kly;["S;Um2;;W^U=ia y͝lᗪX^Zob+X|)!<2dB(7s=د}}!Q7ywWOUJNm8oqt^{ ~cD s(w|]'D)7vBh=Jj1#gYK;B+c5ia5WτdIp!6l)%Ml\|1I@xC|ٲ"rO}벫 f3qնKx2GJondFXBOKQ*9qP(FL")>,MvNԇvSS5l/fpGF1%r(KRG‘,EK:HWv~>~2B84'?D!dVR!Dd[KrZU%q QY̛rvW d{ vGbܗTW2Ym˵~uT _sN=y|GoXjJch2WK E+/8n瑉L2 I5Gܐ2[Lii;Іػk~})5}kJ޷~-趝bh} q} ]Skv](ad6ͭoqG+!q9qu>F<ٵ앭 CWTo$]IJlMܠ8) J˯"~-^9Ƒ-k2W´&z#I% ݘ\1&#dX;o`6]opSgܲ!yZl)ͨP&={=z5ԓgmɶ/I n]7oĹk8'Fx\okye 싊mn-%k6޸M=m;''"FD}jQ YLղ>:WRqH{V قZsx_lbcNQl\w@hsMp5,5me`}$;M]f?9}PcHF n7(~B>D#q7\/1w aO>qϢ$|cg<뎹Kdz%wnHG%m0@'{_IQ Yd=ö2줞z];~{t/5I7'+[K uYB,zl'Ў8S=Gؾ#z7ԅt$NoIJM[0ο<8:^~vNY>3%ǔ1nUlK۬$Y8+j|e͍ZmߩWwTlD8%WėVj1+kWR"hޯwkw"~GO37%? 9"HT]}FȜ֧X)DqG3?AD:!$3~J{ &K[i2G a߭_} _yʍwW&b}G_!m)X#MFW>s_GWSve?Ee^٪c"d68aj[J#& C߹^GRNJk O~'1$1S ;Y!ϵ5I+AޞRlKPQN+s', >[jr>~' Ub% UӅJ^-r}lI*znT^ C0TX#s7v8`!DZCl%rdmϽ1m`qˁBtkKaܙaxgeٖ#>-+8p7M=mkDc{MX){XE'nsMәkۡ\vtyo@M)n}Q锏)/ƈcdb|aS|Dѽm۔HQͺ!'>47ȋ/پN١f.g$o PXz,H^;> |;h=Ⳕ/ھRp~_}ic`M0|NިǤI-s2G*ɴ-:Ks_~{kV,ƸcOX\ SJ =s[T#$zhn=m;xH/NHO˵A{sfY@RK9z5:<(q΍ ה"/6':+cŝb)mq_[> 7xC87l_~1=xrkI ~2mK;>"%g[z೫N6&?X{Tېa,d~N]XTͶKOꅛe搤11WOkd<`vl#VRUKݯZ?~Yc!ӯ*X$?ՠY0T oݧY_K3p4҄*!I;JqU)pj`"[^9j_E;Q7:wd+=v}K;~$Ytɇ^9ٮEg|Ng~ә[⯝7Xp_Z9o} )ܷ54wqWcI}usҳ_]Abw.' /IꙡZꑤW9\ȕֱ޳zUghw_$cd獣OInv뻼!qlG<榔#RSc ݮ_xJaTUl{U6}eלmBv6M=3:[j4@g>ݐԺT}@iN7ΥTmsFsC_/fS9Aɋ[z Fnc,^Y%l%%`S&nZk/ؾgaM0V'qd"196vU~nY kmM=Zlߟ [niވ-Rz--yݒ4[L3s'Δ"vT]O,?AyJi(.V ѴTpDa^sC],l u 6-{г3ꓸ1+Bz5bnH#f==m[K>F8FȐ_y}&_'.GNURäH"ҡgS_qG\r~5PNIXPIq̚ʸm}&)r#k~7C뎍kk46$=ooVRsmՈ iÖQ4R iK#Ig[_~'l("X9gVJIO3?sqcYǶ 9ETE4o{Ww0o$f/Y>#' G50u˜)k`ܙk}Sjvq{8B,,C۔ub].J ۶ MIqg/f 4BNu! q$Eζh%ɻFp{sOD1bw‡8R52g;뻑!vuMn!v_GV}mɢ08_뇰b}0X&)"^*RXmGؑ9whaw BLhb oȞ0xVm'`<$|g}{XyX ~z⚸4ɚM\wj@ ~Od+䚫-\-֘\s/S. g+бF^2)GEGJJx׭whnClWR܁A>> y#lE9 GvN|v>m X<+ emܹجlz,W$hfM~47lX_E];-%cdgBo@b}W$;n#vQmw]8E_MooXWԝh a#I #[(ύ;v?֞-X?5wz~2m^Y񧤈vrIU,9'RsnRE>~',h 7>#[@kNVG=l)-rdNPb+Il]~'dJ'dX}i"gk}V{ٖ$Zmۃ_J[z{?u8w0<4Mc}ps$U#7G]}nKsS(g>9QlƵHNyz$"Q;BX^m[t hSRaX$? 1c 84bT_"ڭ@[#_DsUNԓ=˨]{mn2o&xDTLG.5)Ǯ(ԛ;ƚB s5I +tͨΦ?s/c5]U5i;_*9/eYwƬ\/6G& ‰j7VSg]l}bIg!r4bvF}X(n ZLn1lLUp%IqmWO⼒O^zEO-7].Y<BAto^U*+lz`#=Smvu .y*jupf"Ow S5m)%lusw ;wk[܊)fܛ.A,o =oHTΑbpSWj:Cީ9W b VI WS̺%I2S1G\/F~%巹"H'WTR]J2 ;]u$!;ě!Go£i7;0VO0Ud<MPQ㖪*i]8t# M㒼1bDO]l%eFUbG]8?m^~ض=+J M]);I=~SնMS5C/zyϖo[.Y<<"fl77fӕ1472{|QT]s )CءjvR*FJWߘ֚ϖU`2H3zHz##2 Zzu0vŢS5wsW`L}!&)czEw:NJ y_q`ڪ1,z@[&j]H¶]?x糥_EVʎ]KS_ґ7,뇘ԗ4wD:/ #n}=!nȾr)b}v~m){бl[ujER>b{}Z\[xE|z-)"^<Ś[^!ۧehnJ_[5;gI|9H.wt\7&ۃuq)E.i^~mճo-Y2|$C16ΖXGRDK|#I #Ҷӈ2g]_ߵߩ=7>h ne[cԭx$)œ9RuSҊȢ5WǢyxZVȺ+YP˰i eڶGe/ؾoJzeqi[JHK;6#^Fⶥ_Ulk2߸k-L|yT$mC-sؖ {Ȩn~Ūg}gF>"X||f+fLeε-gTC' MIqmwU k!;Vzg~u]a .nORug^**U榤5ӫ/ؾN0UtJuxVX7<wb~ܐtzEԫwYM\SV1U!ٗY 'zu8ܱNOzvU<~o fv/zGt<QӨ /ě-$̭~aݘ"Z]>wFgw"b14vVMҡ&fJZr$= "}د_N<t k?]"8^9Bl)a8;1/I,XOOb;0w+beW㈜*L5WX[tymն+V&) ;wcoyXi }&Jj]x}3$W/؆WؾN5$jmD6$ENY߅^Cʈb9ޚ}inJ.ӣ$^{_u&M/8'jJ/+|c';n̂պaʷ{%߈^HO$R𞶔FQCىoe6B/n;qh7K$7^|'IH=MRu G38MofM3ֽ|%Uĭ ޡ{k4r4`Yo:u=+Ml3~=Hfk[V}QiK s%E~~WΖ%̭OpB#[%ٹ>Y'jOxcH7chgOURǮSբ=I䩕}|Hst~1p ^d$7:B9m)^ ڮV#7oJzq>N"^V٦:;WE ^~ ~FZ,i0&)~c3TD'2X徶mmpsSi/f߽<^3f2 $ƋT+$bS˯"7A^g/ӅK/yl = ikITIinH'gSOh]o}6$ͳZ,gaK8blKwNm, ), oB0%E[ҖR3G*h[.޻"mo]Zvm}bIRB2憤eB~m/}4_[4s1-~b[H;qщ!;~98FOEyAoJx$/GZy (#Ylhm>[zEw:l]iQtmK[%ř~?[l)a8aJ'Y{ognGcY.2GEU)Mx=Ib!%3{ 1~}I 7q%yc5bWjK:öS(JRŬ/v;(^^ o*q))E{JJ"&kPyoq@~KB-up uU{3#ZyJ'kЕ˶~ l')EV-8w[Qm;\\i w$ĨMRdѩCLw7 O9Fo!^aSEt+=8,ec n;;Y,ޒZOuJ䪹Sqjd\O&RȖ=9Rxq|ꮧ:Ȟ|K@>0ʣ-'7־p<=lύ !IFuܑA,$Vco5VaVoI;x|UVϧT[R_[k}`#1ءc.IealfqDT V;콒,b 9a;a!N5n3̐Ч=WsSJm .!-mP%ũxd~1`@dp\MI˚/eʋ{Vp%\Wg;Y ۳Oadc}<?xJ7RjasY?ě0ROװ q]zv ~mPj5D!k&k2ȭC'f|!ȎI1xMM_}> *RobD. B>qy#l%u+pL'U\S8vw!aOE$GIt*LL⃕%IhHgg]ܔLB/~{Cx:#Wk^~ch\R9 ٶ!憤ؽSf$3$Qq3# W&VҮ9wT3׈l!]/<նhaRNqjI9YNR7#J,Ngvܐ Ӭw|;pp]L΃ 7jǽ ;m[JF]HGj=97b[_~|%|G&V+!ͬf}2$u#DO1xHՕs|vIUoߑ<Ή7|B!f=ΞX<%Vņmpo[mW񖈀o/7uqۍ^d>TQm|lKi+FJTy"OOK0ٝ066bc%,^rS[I9ѷ4o=s#Pmߩ'!鸋73~Q,o! 3]NF]Uw4aveD'Lhy Q?q v4wDwe YیY3odK=ʁlb+wꪐܓX&X-D82 bnH_JFONk2Қ(Zݞkk~(^4ryrlۄΞn9SQg̼<9n}Cm`ԮbbvhSR+;k*JoSl7L1byzz׮]+I#wM}1w:@ /S|)mL"M2%$|oN!> GB&DY$E|^~?KǪucձrEG+{]ʱĹD:SOgD(p.ӞEqHbq.]'?-jzQoBM=lZL+tChzzJ'd'qKcbB3J~#mkoߒvk= 42rpߙC<'MyީWvJxvrقEswt=dwؾN>>{82t%i`vlK,iж7Ĺ ]׶oއ05ާ&G3OXv̴S5mNkJgYzEw)';mtU$_ejrOdQjFўh[ZJQ O"`F/Ӌ#'"rCϜD^*m#b˫2D+l_~%gG&l N,K>KGl%"K0ϰm̘R-[ +s~vluc`%Io֯K]R#[fq"%)nݨݏor6{I1bAʙawMG^ّun3sIҽr#K.y 00Rߗ<83ԒTr2sI"1.vf:M؈dg!ژ D\zf_,Xt]hd#6G"T|CsSҭpo,X1v=72*7548#4+8F:Tpe~%~&5Ј))nQT|N&UsBbftNIzȹGVx{!1J\\!*e:G[J;9GxH*z=p] RT@w#%W;֚Mwf! HS욳jF۞ gصgؾN*df8bC:Q}@)2].ҒaEDFY%lGazȉ' f/ ߪNYU JWsG]L%l]L%9n;.>Lf2'"Y/;*ND<۶S'v$ZB/`۟4x4" /UR^ Uhn}r֤ĩ(!J^=*do ]ݵuqOmȮ5C'JJx!lKYq[wQ?~9 ~"opcB) mu >v co}YέEs@6ǘq_3.!I{@m_jVDh@聕x k ~>q:̞w6b b7h8wdјyJ[uyOuyg,{뻑H+b&{ZQ뒴 &PR6 m}47$Y)mߎsgh*Vʑ*6gfr+~Ε=] 5>a{kz7pUkz7`7siFKD^9c+sC!ZOho۶W۶"r%Ź|[UW䓏\I1Rm%bK#F."tg#b͝2m;qf܎rӯ,,cD#-gfTLR1DuתhSBZҀ&;\-м8lU {U۶f()< 8;D9c7Zebg.NzN؇u߭)EZO?l_lb֔Gα ej_*Dޡ%*Mll_~{[qۅzP[G纨8z?[Ig"~ہzIZǞgSOh s <0+)}0ݶC@'U!.tRgQ6s9ʂ s=ri9adJµ}Rt|VDH▩)ęo8D$ݒ"2xiեHo[ѫak*V5v8^,G :a+)Usm5]."z`>$yl[6v`ĺB/`(P}q7?n1H2 F[I-wHP|OEz6 /_qQoɑ%F I]Rįk԰4}zHt}㳩_~'n b%%*K\]%ōZjWskg܇k؞+ƈ]%ũ[O2;_>Q ؈O.m~k)/aTn㳛ǘQ~cO^3xϓ U=@T#ԘGdbnHkΖzۗߩς#+;GU0x'ޢ4Esy٥ޥ q8[Sg~++# ~AesIXBJI:Bpd.u y_Yq/&?O:oڈ3;aPRJzuN4dLz|K}N 8u2 B$#7i#+o"mԣWs55zPa;]!Ꮙ̀(8Nt%IM [14KW&?֖W~:%r-PpMR)JN<+I+ CX uEpMRz5nxn}/DE,)֚"b5I%x"bD]+cQNbͶ݁ߕ;P@&8Zr/_SZIrʼnF:"Dz#R^zU1oN/QO>[+XYURē o#I߄u2ꡇ_}jn7Lj 7f=ݷOk"e+_Su;apV)82sxcDyϟ\!`,~2&\)WN YWBp,E`MIwܞn!,/+j}VݞnhN9>8)# <~Hf2T߮f:^?ZH'fD硿DWځPTIXK]#I +:GQvRӟ 2-%N#ʰ=Qգ{Ztӯ"v>h~U G&0<g #V?+JAȓۆ-n/ؾN}I\ G$Qoƈ A -%tY/Sx~_XWTWJy[ѽ}枭!,747VN1XDr`U4.)b}-.>-|1r.K3n]R`KTkuo/osؾ;e /;L+{gH峩_];Z}al tƖ 뻐Mg{ON!W`7VRD~~<@HwL #^߈_t5a(bЌ!هKx5%Gp#q?vGOuw̰mO-@ d!)nI}$y?~^] ovaȻWR s:n͝" ʱYC/wRé8vAC4 \Uz\RH? 3zrWNe Q1R. #l^I١Wjjdia[.:LjSgKOhvlझ0qQ9rj"]?`--%|52T3ϳ0ϰm;Վ"0"bD,CR˛֨8Ms[oˆ(C#( #H!Ĉh˶tn;8!r U%ELZ`aKT‘lBsCX~mE2w,8ς8> ⨪։,h, ;J,z@;q4![Մ:S}bƅodLS~WuJynmߩ=7J[o60$#BqiT<"QKl)?s̳Nu],rĒ# G @ЪWs)#D)J1hև|N0XDe|STZk;NCǐul,m߾#.j9B, h?pQg}Vq9rxWio?bO-m;Ս'LH1VB„CRO5DRjrTaB!I"QLOɪk߾M_!1NPlJ#;D[Iuzc6apm3 ~}at/{'=wt*) I2F:6Nw{ync/f}+]-*dw1W`wc7AE GX>5\S.d] Nd%f9?J\ֆ(Ra+)}rt}7ۿH=zw{; Q\f:o bQ*m*zo/ؾg`64F]ځC38 yvjR2FLg݌gKOhg͏R 9u+8&h/ y9GDKv #j䁺 [<5cz6ԏW}_?cU?6_c݃9yۄaWk&Jd[([=IݶsWg쪪<`;-wcB8'cFGzvVRBE2'@ć(7->?~'d]%^~1\|Ȧ%)Va=ih+{HUFh4kM~ϖN@1oOODB{`ԀuMl%Di{07$"o~6~ctAF E̙,> Ϣ p.gA> >u}b8+1v`U-cTT> DƇ=0_cS^ z3 fqPV]I7! d[ogmB16 O-rG6N5U" Qgi Fn>-Vnqϴ>jr fݿT:Ln$ ,d!hKDӳ_~N^G'{~H,}XBÖRm-x4ylm^Isq7]cF.I2 :#`+ygHUWiN|vQ8a;- z5%ɻխ器55.Vޒuv\S{ <;l_~Ÿ  `uIq_jgem%͌*4I`qerGW !N N/i.{M"Q[ ~v?cead$"_RO~b<; ʛVұ }(!0ozlfPUCvQil~lȖf+hϳ]ԭIԫv r]0|nPnSSȾNފ0r#*i ahnY7eOd-/#B O ˶*}b7}_=Aanc0. *[Oy;(ՌO ""fĩf(Ă'dqcgwM}-E;0X !J}Z^ 5,]>c9_zMC: (:Wu[Af,JӋX"ҫ%\}X3a(ckjJy)C-i>AX/"Jڭ%ᚨ \[sC/vn<^"=|X)>MQ5gO35}ͪ OjLQC/f㬬qV!SٛeE.+*4*#枾h+)kw4L#-|"TP'S^ScI MYizogu߸z'=uJڃL nU]D~έ536C[~(o9UmIZ؅D7x]wX^~Y372؉}j+c;/ydܯPџJ0:_z1NjbFVo wo;c -r"gV e$‘g |U-9N]J\l'UgMQOН+UF Ub/`{MQS"-ѝGnV{nU㭙S.zf#Q3~X0-SV]7_a !N/(zK3(I -]l哜6aN V|0Wן=7 L"Mѽ}P9[m ݜ(}u:_zy;xE,i ^Әy;w;`USn"TQ=1w= Zq* Ȗ#Wxj;S qlD1*˞u ;Zw#> /-ݰ*r&!+jUXU&ji CuV^9,w1j6LY['"QLN*~7ɢFCsG &zQ6띰5)75cn ǘN!Kjd:m*J9{~w}pmU !liP=q ρs"/o/o6 {lfxe,)*70vY7djE^c&yWST/S<[ ygL1i_NȒ_X BߋW,-dީ^#z?;Eb'PwoCtZJWRKuC}S/Ⱦ~,PrB]yɂeE$;R_RIAy3Z.Î=*[ٗ)oxnٲqC_~_vRd!;eD>GYO>c^3|{q#5̉E{3P֩t6P>"iŸE[/F#U#S}NnMJz$jő7]VjQRF(;t<Qu(~v+#{@T b J>Q"b4} fvo1I=3:: H`yV]1w6 /Nfbp0'+o˳Vq=fD+7&MYI܄tV|ٗ)<|̿a?+o`*.Kjˑ.Z'nѷk/wU1W-vf^#HﲿK/apzC8;pzvWv_zaI7lamz/ԤܧO//eIܝ#9byE}Twa76mQzk >Z݆A:k2{gdJTz'8w~Y!c;Nm P7}P̚v/oJWՑwʵFɍDv Od=Q!߱ jP[yLkp->5l;'/j҉E_',0fR'\V{wxi0z*}B*kqỉd%y7tcraٮz &YkT8xur;bOa.6q XNtf|.JDp6~a<dHv͹Gp/SI92J7fsoco=%˅l_ܠ&S/fS4[`` [~x%Ft ~ă-<ضw^uY˽?_65U#vĻlws8_6 /SfF`ib:fjkR5WHG.CW_ƨy+ԫ{==x>vS>v(-}K5ͭinR)qo_zrX:o!]g673И=]Dyn D!ʒqqɷA;b"F-ԫ U'N6 v7<["OEW(eE1]crZx]v`F svVDy}tGswI!%ս9_z-NM"Dd7:A˦/QҎ>7^zcU9bTaRUE|z򔾾/[wFp{i޽/}//;MdyJܛK- F􀰑 |O;ПƎWlBηN:.Kd ix#)X׀[{C/f^I |υ5c΄9"[<=_x(K*qdȗ0uby\|E٬]l%[6m}g,itcE/yoNfly7_A~=N}` wF4Ƚt% 6"J1Ӝ/`C_*#6A{qnFnnu޼Q%;Pz˞iW2 *;􎳒D+|-vf`C>-J{ {L5"#]B8'[MV:_z+DNV~A\Qi7< r3.X[|izW؊ڳ ~HWCF Ϩ:>MT KG3D仦~lK>%ٲYu=KvJX[=W̭"_{c |&j.6VỠT付g'eEHQ5Dm>7(?YoW'#N%rjdYڒG*ٖ·5Q5.eTvi٭=FE D<ʾ{ƍ#o"/Q:4d4mgnЈ?aH|ҫ?{l= lE-p }|H W8.;s¿OK↑UR_/Ur_UYzbN}7 zB%v|F/+QucA٪X_n/0Bw1B!P 1춐my;ʨ]ꚛ߿d_z|K#Wpa@('o u#[Q4ȟs;זmz+x߄٥.8qa7#J\}"`ҡ-qV > BSm ضDh,sв\VT/E3*7jlmd_zu:RN 3waW cR%K s{vW}EAWd䊝w ٬W: *j ˿̤=[g<%0ϡD~ ]LN5JVrXcvNi^c;dI5[yZ-Ҏ(?)oH+*!rQT v4WCw`ʊ~i$-6ҋ} wAs]lcQշ5ǐ_F덈w+RʽVC6@]â_L_<{ь8udE-9a[R)VQ^]7 E'G/cuS]GD@fº)ת:wyzUU)_5#8|őY3RTDi=֌͌")YN#iq^~Ƚ8|őCtV.=bLG=D=MYw` sY /DR^gr4= 񷴉LGK'C~ԟQ_ >j$KrGLm.뮤A_cme_5%|^ML>fz dr{+GWJQ+*bnP]^z'b._G.2+U3k{PW}d]md #qz-|pzKeoXȆ9rX >_E6j?/>a j=ŧǻ͟/NwZ… #W5#?0hP^(ůOOKsIuoȆsDigzC;s[v:mKG^8C_^_4r@1#mQ~v;3sd!q˼W뙷%dIM@G v`r9PZ|E٬w_1W$6oAiI^o(J{f"n%WU_aD%}Db=6;##b&z\жGz1qgN\ FM ~S< ^'}N!FK/_WQ@Wz|VjlQ~66~G?.Xe_z #=7OhkHmC[D)K*55ZZ|E٬w_2Ws;ċn#/71E)YQÎKu@bu|czUacnυC$m[#].EVeU(H@IHբGmp]qrfT(f]v_4e/SHCl*YRb(} k/ ]3RKx-S{#YBYQ%q]a,;zCseD~yD!^@cQ?ڲ}PDeIx}6Κoe^YU_F.ڬb̛^)&5G>$ڡڐ=^:(Ww嘴wWe/w?VQ_h<^eE|xuنEtkO(boЇPѼ(-8_'WW ,fDF$Z:6N{2w.\ }w7a5Q'3_`{2k3dȹ[0Y#[];mr1)_ǘ϶ˊTB5Vs7GޑL}1/Ϩ$x E&OQvzLkhf;Ռpmw[NVT‘#\Fވ::=# yNUѲwe񽰚R=4j@ǍJZO3Xq9VLD[kUQ9֗{}D7FL !ʿpUv'//SPZ;YW~B]r^~:![]O xw.vFEg%~gQzһ#c d6djnRF.K/ȾN>"˅Oi2+BK>v3QGQisɧ^~ S>?<'"]U>wwlד>;=BcDU~Ht_Tqڗ 9wW) KER?PUsBT/(.kokK GQd%ݒ2[ۄ՛v3%Y&e.Gq[_z'>M>Xbˉ]#7DՀ,)ʒZEő^ܗ(WU wT71U Sa>s'{l/᝕WժZ[)FkxwsޱY]#;*#jzZX|O:R˽'D? +3lAwL|u<$َӫ/l>oUS~z[גmz}Vx82-zu9D$;!>HYR#<a9e:3C?y:~WֿN= X~\כleua^7Q#nn鈛Uժ3jbF[>>{sh]P%?Wn| ^3˒j^.Eg]]<7MkO(N~~zvW<{MzWkޫUo]Ȉ>89s?Ʉ ŵ:/#^{%>`> Qz T$'}9Lj}Qmez ٵ`d3rw S {̬!=\ke_z";G/΋1i(c,'yH~ݏy7܏ȵw;uH ӽqZZtrBYR^eeTΆyw|Nw+ V:+KG뙲/ 9_| K)߅YP%+)UX͈'-"z'~V*)eo^(. Ϳ/ßYu䍧Xēzfg/DieE"4"<g/_~H~KRo˶ Q9E[~K.BFzQ6KA+9¾Vjvjל|+qYRWT#dw6w+ʵɧ^z߅yF CSL9ED6۳S#b^{&Kױ6 ^4@Y<}>1Db3ow:_$o OY'>(?_n *clGlGsȻSL;j&po&L`%mßN$>EmՓǿ^i1RJZ…=ª|=QȆ~w܀yMA) aXVW"]Nh7Q>ucwa6nD=EmLv5xueWRbw֢RB/ȾN8K=4-(Ü7X1v? |N)ZTLj$ݴ ѫ8ɟюRkxp)9Ȅ,h)Bfc<[D?/SЍ7lő?Gw]q#َ)FCqdP#[ ȡ ΢Q4b0 Q1Zapdg%ns9U=!YĎ>3R~Cn (.ʿ&tÚe #~԰K1w[ګ,VNq1gG{;i+:q($ڜw#*uqI#ʣv++Ael (e4fu|_zYiu70҈q}@~bm3*GYR;G8Ay_zqgb&O>DO*s~ ؓm} kZʗީ&DWtOI `UTߢ?3Q#:TYډb=6[1վN6 fN6LBv/c=&f6 [E ӃO0=n_~nߨfDG *YR=l~eYϹFk*|/SC ê*D(˾YM%];5QXf55-^QO_wjk/zW~2G VL^"+oEy]e_z'Gdĝ#U{QUjѵ6 /ӹZxJ5soю{G۲8$+_Α68k`Q'*>KTT?yjEsrdF.o-{-ԋYTgc%/m&Ƹ=WW_@WB zG\+ڒ,JX9#ᠪK ~rڞ z?Kλ%{Ո]^?fJ Q}W_zq,3zD`@Ղ*F7Gs;>w2W>ΩQ;b 1^{Ke{ҳ([44t6dip [f/ӹϬؓZ%=^̢_+sӘ.+DlVGϋ`*~㱦ϏcAw!N ߢ׌|GJXD{UhO-ʽ7Uucޓ5O,)uZ;Ϟ>%5#o#eo׍:üwµF}KQ,=ĵvBm*>q!PB٣4"eTqvɧ^C8wʵk\kܾJlf2\|dIvq?!Ԝ^"G7. Ywcu)1_bR,Q +Tm{# y[8۬^KuO(:_NZM\ӦER_ѡgޭ k]۲N6k /ejY/uP7(ݯz]-e;p"&>{e/+C |?wFxoȻӃO"~zzxla%k_ܤdz/MBo(V9[e'k@7E$wQG:SݶBֻ]_x9B6~VLvuY8ȣ_SYK}Ѳ6:fȲڒsxGe/ͳu Z~?Y,FgW1߿GS~}?Q- xǃ?Amڭ;~O>3?X{ގ2Oz DoO烅"\AcüXz?II^ohǖty'w>@̨@2ـY{laMrPn5PS9A6=?97]\+PcC 5(Y۫ެ8tɍ9~4N]?'7s yy;LJ8NOԬ y9ť6[0k ǁ)UщA;Z)G"5X@kJr{f \ `rYtؗ7?鬷gw^J:7bdo@@=jOB}Y;R1p}?Eњy=V)@9X絼+5EhCkr}c4q@8c͍Y L\R5dPgIMX\j3f->^(b}?>c67JČd 3r]`Ϭ=g$?kzf"uMA4Ф^~F& wtZWr jV(R#dO C [\jSr]S~燬́. s>s{:aYuf7{/?k mz)[_3,+f߬2Jj%"sa;"~F1ZGFkⴗ!10 FwKwʂIJDJĀ[&ҵJo]\jǤk8޺-53ވ:k/j051k*šBk,y b bUU"V-- 79@G@ϔϬ ).ԣ\5g=)[MAc_+EB/w<@\ lZs礖5k8vcrVgπ!$nz6=L9\y>[n`` `=^n͹8 g;>rœ ϚEj6UaG}w kp`':S1}$bzXp]Y$d=k m(tMj_ $izG'9.t-zt<='NvVugXӃ6˺р]GF<Ź9|%bƉ1Ƙۘk m;xi4UYu="DݶUPD|]|U3\\hCk<)iyٗHztO8 HicqhpV)$.\UעKixr9&A#/b"frMr 䲮xn0Ѵ m UmQ{FBI΅6S \W9X(U&4 . 2 kr8 %Uex(( {]swGyS/f}5-h}9|lЇp*)GSBfenu+كo@6yWO0sI)}>/]ے{f'A.?##n \Stl'IzB7+{iv[}\*cM}?wo{+s#=*z'͒;A(Te6A M8L]|`m_.ݼ$| ܱPkFxܺfpzk2'K} [;{&I;wYS\h\WDc{({"Oo?y' RŽIr gpCZÚB%]9qKlQB^wSg\#↔#+f W9e>,٢kJfշXN`qprSfqJnme~f]Q:5ɥz˺&l\m|\37mO$")9^p%1NO6)& ۙjXCv k!吐5Ts/9ӻqGcT Rfw7jqk n3h͑Be϶OxQ)ឹ,j4P;y|v!Nݰԫ#j;' ͻ)G"}@ÏH%+jܹ5+k%~GqHS {yY]TͰ6Re=m ʽ;ԫxΎ=B+>in$(WIG}۹} ꣮¯ٮ>'c[TwcOo?v=1(qRK*09 wì'fX\k\ۣ{;WH{:qq9s8FcXZ5Ʌ6Mw}5٢OhFu-w,ً̇s-5Ur VzpӶD Es]uMR8t"`ঃ&B¿iRn *GgV\.pif̄f ׹Uoɝ3qm΅6Eٓk6+[NЁss,16G1k(֬[qk:pm=zs1ݏIL95v\Qg9i\a\e]a3DL}EuD.+~մdI($3,O yIx};w<@Orx%_mUBk\ 9O.sl16q-xb+wùDI9#X5<]ԱHx$Kmk5vu_v5har6_'[۷]®L gMv5$-^[ׄXb`h : -ԪsSc(9=U`RU: m:P.vm]t?gQU_ͲHxh8$'1+'F-NpymKtvhc{7EAx|&9`pVڤ@./ܙ˘ezV'$b[ xbۮN·).b[5eR.:q3l !Nsђq^i,5&Tw = mnx,z9 1s0Za)xC075G G!'5yR68 AnrO&,sprTHĎ ,9N5*I.Yr], ߵ >.ݹ`iV.4hݶqⳆ kV5]咮]p]V0">& wvZ6@1P5B$TYݮkg6{Ox4I?\K%U}U_`X%]A W2G` 5RIh!\su#WI%\hӼ1JY=+Ԃ;}8G-0D!}8($G"5`Cؔ}9>咮qwK+7I'XkumϋٝÁո SYe]ly H떱&Mun{&Y0-(f%oD#]rYL5~\ GxyN%w4rЧy9)4&Ķ)O%Iw.qw5}Ǿx1cAqlCep7kwnWz9.( EOw;ʮkJD/ϰZns73Z.(H$C[yޖYA7mE\j亾\n+`8`ϋٔu;/rלjl`^U}&/ 6|55mkĂl;2g]@/.qI~ӆr$zb0MF0,O<ŚB%]CIǪ~_?C>&oLC9%DhGoH!4]N]t4󾤴JLDu*/ 2l"A9%UZ|Z !h5Ʌ6C \OUjI|(|LϋqRn!k͏$"fthĵhVO΅6[P~`bhY6չUAԈb` QnSrY׸?nzHc6(ZUn:R ,(̭kg73aOM)NV)ʢ$K>6zo&"OY[-mW[j\XJ'9i_Oq7=JgfBwm.ac;2ksk`<FE % dIO9ahnM1w8dzQ60-У *9o$S;]Gr f<_ \׻̚:W咮poqF^Y.D:ĵ|ʑxuB8u/:; ?!]xW~POf0,~]εWɁ@SB5 0}|fSa(.tM2u]zi,W#IN.U]r$JdOM(uF\kNKvo]QPC˪ Ո:ړ <>ebC@FoCҘ~ bly\k+PwF/*6ԿMmk#z ] qMrMUuMpFsiV#b8U] @RbAtt r |<3}6˺&OqMA8RأbW垖|/%K*R0r:<8? N*ܯWf~_+ m:%'D" :Jw ʝZ|uM\޼]-?fy~+$s\9ID{ؖgȊjk m(t{ENݽ@w?ī*ۉu3|A*zcss5>abJ\WzA"^Er 0oVPrKy[t9A.@ծr`Ɋ_ٚ$\X#9=jW1`A"̚KX*lK_Z_IB_#BMlgլ0u9{e򀺕}ܣ6UmQ]ׄ`9\;_]mqۍYE^U%G"qb+ص^v5Ʌ6KtkxZeP;.ɁHMc")f]qĚ:].4"@ \D}Q_ wZiɁ8-HOj$<1 mˮk܆+BFNv${9$YεH@WsGM5j\צi뚰-&򘪗X8S.q5A^$gu<ۄFԫYgJڴ5'm"ktm4pXB·#.LEʑHW AC]krIdAR N + k(fYfo!\%#m# q( tf C0@2['qJ\8S?n2߮FUnu;k*R[$+X[ [!ZspɁ@ #4qMu}e M1p XV$ՊK9pLb'` lu(DV)MI0Vʞ.tG9eѮ~l~UEiSaywVݳsVzy>k m(t}a܀TZ`sIH݅-}W֎5]q%mY\hCkM4jXr`U$m+AwrYKKu.\8ۋ4O.t̍-9'\o>y$QԺ$΅6KZ/jXH葶Č=  Xgq#šԶ%]_xu]QN_<>"!N$=\n0|FvFiq9o} Bv]Sn`1=WvՆ  #J`v|up?u.iB~q]SPb-$ ,k&GqmהQcjz׹䒮Ԕ΍72O'xθOYl.n0hF7l$P{\5O#jVseչ$bF"^.0ͺ \%]_ng8;۹zSt#}n<2sQ>x7E\y|OYaWrjXĥ6[>5dۧrsy37w vR1Dl-ssḁ\_|﷮o"Pps`Jr fΔ8Ma uuv(޳ĥ6\r]_^Lt0QK7d0"v#Ѳ +ik m f5yMĩ LXpͼ^.ePĈ{r.|$Wҝ m\dq6Bx-(z?WPek)3"#`(aץYAȤ8wu {ҚZ m Usu%Hʕo[qkfq j zLuw]vXƹyfL [so^жH8m`^h\B*uJe]S򕝏 Sd+\vyH;kel^h".0#鋄GԦ*u4'PRf)pd:DNYxtLdɒGwYnݳgkO(N 8fcek#V%᷌gywd>kͰ;P.uhOe!rnLɁCq *iVլ )-F}&>C|\Yv*KF۹j$9=0`qvEzIYU m(tZŽnԛtV1FBA-εp@@ǭrMuq8P.隐-b ́Cϥe..r`Cj*)')׊sMS뚲שѪd/TiSe$Pε$ ~5t@j(%ju.r]Sf4pdUTę$vqia[/!\}5S'`j Ӗڬ#[FlF.]Hz;nD?Ry RsMU뚪mkR-rVHT}nƔ#` 0HJYkDf1W%]-9ֿiࠀcm(Gb;PJ9ns!JdݮR뚠v,*֣yR0 }9v:ʑys0of(5ɥ6˺s.}nO=&0}^Hs+lD*z%˹ Izs4u}a%_" >6;oF-Nt5]:{xGu",I$_ІrITiH#*vn<(pL{$(kBY5'p)6 !)/l4bҝ`L=m(/ޝ6MB>6`D@r`8d$&W9咮鶥o04m/8#' Tb5ɑxe ~Z݌DokTGG#4sw댜1 aN3 u OUP^c"_x?>&YQ˫v4Cɲ:mqmeac1* ϙ"y~zɁH` tx^̚bXӝ_3bIE/wQ\< W]IxݕD>`Pjo:5Ʌ6˺a[b!s(>ˎyT8;$ײ$b9#:ގ5Ʌ6K&tD wqà evJBhmVrsd(YOYt]nzzi%R I@z_;RoUBen pV͗5\e^rYrC/0``rtsi˹V(Ic1>H&tS7s!PlY5)l1܉L eO!r%93ӊ!l:u.tdus<-60kL~""!n#Wa!׃hΤZ+ܢS-uuV5%}Yl;־j>8& qT:gmrhW}K=kJa_*Jfe7l0Q/ n.׷ ֫@7 ~%_Tu.)~٩7 ,]9*FkULJwd1XjhEptK{r~Q㲝Q3adf{~t@|볮\ ="޷/s *xwkb2Dwk"6L5.@$:N7DcH3 m~~5N]ƕHDiIv:[q~@7)s 7;@>G#YVIHuۙ庂(n``2+t#xBHe]SE[yE !N \Ch_yʸ8u W\hu]\b?7.熟?9΅c}ˁ5gM.pHn>G͹f*EuMɓp,Is;^T7 8JubD$<5]4+ߤs+ uMUX 5Haq%@Ԩ)@r8=ϰfAKKuYN5| !rnwU_{qVMrxCBI)U#kuUS;}g@܍Xn=hlKgM&axBuMeZ}(1OZrKpr{ ӮCh5,uֱ=:c&d s~U_nQTщeM&J f^&+f%vnQQҾŢTBY5 ~Y%y-($n1H, O.B%]㺲=5b_{RNv%B7 y{e{ lQ mbۮklP(پ,C{Q&.Aʑx] !p&@\.骧j#󈷚\ц'J9Bh/eEF.1Ln BgaqM'e,i;1{SWIr$ՉNY$ \hCk@[Y%iq#Ż$.R;rHdM ΄~@s {x5UM=eVyb <ftHX]ϚBJ!>.tM)V"LfD5Q& fJ3j1di&WHi&s;W cuMw^ǩrAQ v$<۝Gʼn;;{GL~΅6u]S_Q}w̞vuC.W>:r&ѕH|h;7[iGnbF &p0 sʑqe/lk;ĚSM?[tѹq{>,'9%ck['5mbu]*90gBjᨰwm #$"H'NGr֞Kpkw.\t(tk5n-n LQ~ta\qr`Paw81*,qI䠷%"k8g6Sv#wY X\M&n5E@_oR[\jSp]=!fe(FܣSߏs ̋lǸBe]Bs֪kHW8b4%7nwɒjqNsNBYptµɧ^U;PedAP]Ihk\׹JDϕrUM&VtUDwkEvQT|,Ҟ{H;=(GF>\\vkVKq.)^aP k&o۰Vݣml4A&C6/!7: 9҆rYHifkbj"c彋n +g?=95D0k$P.*nYX>Zĵ @zPn O*B%]6^ MᾊsՒ m! $'"#ۅv\N5gz61K43kJ3^ixآ()8wQTgKg?^Y35[-{A t'/Aºld,~F#9%8u1Hþ=>9|`%tg }q8׼7HV.Kݢca7{! ho]FlFCG-^IxWr$fN00Vr$/!WX'kkUn)1ty14) HD`{qzooiש΅6^꺦 MOp L ,;y s͌\g9' 55ᾮFC\jC2隀~M+]I @JظV#NAD b(,.ѡ ؤ*-T\Vg%7~CE/. "atn% N4Yf潯tq]R-*gy!|FK"*EHa)ؕ{sMS#K5j,-( 0%j K\ Hmx&Kn v{y9LFAAT#ˑ $ea=1(EYFrʒ:*'xdsxzXқEOh^#Dz(>_Ul;W,& 2_A{I諸[\DL(GbfP1d01%\hkMHelKp!Dq]=C-.F߮? q33s9ʁH? =sIUw;R$bȮݟYSPk m(tM!1"#!􀏛fa\Q0@Ԙ |bM%]'pw۝Xױĝ\K_h 7*I飂 P[W=c|BL&iSmcgwԈDιg#\|ٗީLs~@WߗiX:M"n}K'"bB*Lk56yMޅ EB{ @zvVyt=-Þk2 :~ӀB$HcޕN |hUxxHi]ĥ6 &mFZzI+qYQ#ToVk@.J৿Q3g/ kPTe2-,_v䲤Jxcl^ʘHI(dz.UN؇eȿi 5C#g͋OQ'` le4:dI$Th+ \QG{ Z&_JHmM~ٻ-hFB΅zG{5t/,*938 Rg8TrlkZGT rIG΋[ߺy NQ,ebwZQrWe:1~&YBi/B@IDu]+^c<ae%zVuݜkWšM&;IϜc4:bCeu Kr$Z<_ TmㆊiCE_ڵ]e]Sna^op8RZ~۔\rB)rIdK.bG۾.7U:Ś.5Epc~׮d 0KBε@mH]וYG/k>0(PD0K["|vV65#GE okA/Y6:Y(/p+*/钖Tv1f.cp`#-G_1F8kkhGt|mɡ4ROp0,ck7TFBC6U_ʎB]+:eYtפ { cL>{`ȅOiO;eGd QkeR1f[+.տ&@ CpWmLiOԍЎÁv<5풯@ˀ\Hb62"I; =SzlY\5a֖J4aDJ\wP,5/Jvzz] #S}w+ Vnm#___/"G*w49n"[J/F ߵ${?@Cxu0ka65nc9'c k-ͤHD;y߰97UݬVi;vlڶP^AŞ2wZiRAVV}M"}1lJK_5 P+8M~YΔ7Kiqoݨ67]Hǿrm.H/SL% fm)s X϶h0NvqXf?wJ !Z4CFGjml!i 9&bF_!-; b/ ,%IUMdJA>k-8l)k,P ;gׄ qׄO[/>7+JW$voUcmͷ !5"`8[֐.2qh+El9 O-'ڀ"GX؆gokR o7[E#-qt pyf FDA(%6aS5+(0#M[KZ:+XV>eJQX4]lQ{C`߼REZ8<=l֬ǓbEЅmOZ>Im KA=e_?mXUY^%(6;@CΠ[^,:M Z|.~Kb({ыHH gy%Zܱ,%gD7X*CY& ο a.1IYFegiUz0bkj@xЍB<àk,m 'W&tvΚ8*)ְ7T&O-90EY}Rהv r]gNJA.v]__S[{qW-#k*4O*;%' f,*":ӑ?I-]5á˅J r7mQpX 8m~;c6\;  ýRT|<73iȮ4x?f-Z V`(>Zo#X%__ 4#?!u _Uiٻ3u"ʧg`ÜA%_@P5k%@Pv]- w k?b1'PhB(@;qMi 풯0Z>ķV{}mc`NvT "Fvח9*Q_"rmBH;u5Ax8Z%ު3(87[@, [ Aؿ bPjجdOX. 5^yXIesY[H[mGƜ.>rLInYN42&nˁlsܯAצ~C-) vClFhu j,G{&ق(Qs?Vd]zE{&ZI4ۓC,)|8?֎d")&n =VY o:k=BO48 'XIAB'#FK֟2d8k-JX0&-_hdgtle_S->∎M L+Iܡ: (4wNnz(3 oKMYqe}M{8TԲ+[p Uס62UP^p @B;D8+Ev(=<(rsa%m4ЎzHnɭm ~xv׷~z(D%N!慎îؾȮsR!YSvЬ| .ҽ}M}i`#>^y1)ȧѭR\ʑ z!meL c[ oYo)nQbFȖZ('=S䗕K8*eJZ(ڬ{GLݣk%tcшf"K+E@mΪ b"!KA>e__Ӕى'PP`-kE@vzaΌfF7fƵ]|S=A]yX& jה(܇m%f1r wIvC[C@0#C϶ $z3 TUC8{懈ZzS5f__Aʍ!q`)B&vbu "pjpexNy&4{|}M9X֫>fr@ZŽB7F.m&f۾@HseE6F|b[Eqִ*mkJ o07k#^D֥X9 8ʸ/"Hr˜=a nqh/ U$k*V_ꧺ"_iw!CyC ֹ |o] 2i]UGKkpRï!WIXQI&=e s֡_>Q6 < -==mSwO!~kR2(xg߬ $Siɘ g2(8شe%U}MA6t` - )Iz/'gXFgNT8SBpPX oh|M1UCFI"-7U|qNlI,?aoh|}Q|ކbȡ,p}m(ej7K~KZn|(i) %󡊵? M.f︃kRKoKgu97q#ƏEcJ>ؔC˂mQhO9P+1ky)Y:풯 w/ L9)C~1ӭlJ;W)\*Iv k|7"ߌ툋ıbf3b nmYFAa-ܣ] K`lWR:Eam@SB:c`Ј儵{Qp*HKo_9 /1eD5 twT۶9PU[1[Rp@Z o8+Q!~Nat U6ftIA_!W֫J>ey 1ᖔD"?0{d / ,Sv@ڀ?Dp!YT$! gIKorV5ѺoL`މeкnm@oӎ@3>\v#CҢ,қ)ZVp3pxO32RYq4ȬYzb_qe֔u=ZxոhLqBfg-̾2zSI浖 e}3L@vͺkה"T%\\{'ĠSW5*xM>M >Z7^֙A!v`w:>U F<4S4 .r>@)NuMB^|KKor{|uOM]Z|3Ke=1=@?0|}Q_ FXKQ(l#z_2-TVbѶ!~Xv\m;ag! ꙐgMbs\kIvuv,D~ ͺnns&T]_U% ؜(j*v+I2b<,:Gq ^lvהs>t=ec~ǩvĀY&JڠxUBzψA~]F Wva`łpz|e=f2ξ~qnƍ+-a[2n\ |yمY}тÆ?JvJbIF.gdQ1!1dG!` B.zr1]5E3ny0Lp^h" ,m`Yrmk.0)(~&v{ Dmow @nwukkߩypVoʢ}؋hL =liM׭i RG]|=7 0Ab\TPhTj%GZzJn_41/P~[QL0y`dnZwp|G&Rfrmk#EJJ|E`RЏ𦫕ܾȺxDfR'vL<ռX)BZ.Iݝl)%l" pHܞ~=" |_j4#=o(8W-Evk8p} 1FA/npOѝU_b4Rخ'b]J 9@NM25+A3&@5 qelekV|%5)xҥݱPBɽ#~2pcL Anе W_\Ł"1>UY8zHGBBY!8x;7˾x~SoͷN$)FM^M;mmEikKUHճ&i\LԵ.^ׇ|=#.(}\Ty[ LXVwoèC.DnD6 嗱60u}Wٲ]W% _1u]e_i@S/WK{Ҥ9JgLYk,*z?Er獳z gĬ)x[" $> o^d=U__'Wi]/jgKvNK荅٫гW:/ZxUun_7@k!<_oj1jH!;?`FY=k} 4h-ʹ׳:b}`?npL{7q놪7n3po[ u]?Sk" md|_}Mq"^gH7CjSjv%d3xgO=6dᝧ8EU4+(1zwY__SF|2Yg|DYMJ-Ң"|h}3Y@I*u+q;Noʽc0Y]Q7UEOuޚ._((h ++_57K3^ΧG#:2x@$@D%ȑG`.Ö˘>0\YZ:E'ce,i CQݿa7Rzdek4FHa;Tns״ӯ};Pvrdc 5zKAD03^0.W˳̛D"eo<cr#-`)b;(x#ڬQG/#4(#em L;X{.?KC\_F H@StuF/ vHKo`}}5XTkJ2F}6ϴ},[KY{=kZ'H(}H;:_ ^OLKcsVJJ5L=vtt]<Ŵur01UmA^QGsw١ԟB)Y{Xהn -q8 Z)6uM&bÛ8Ma3r~_C+LJ_v'N͉C+Qu6ܯ;y@Z>5| :u^&nf|B[΁ȴ g}*&yk,/ z%h1'%OKsҎB{} TWB\>+>۴v3cQ6G C;Y)8+trAyl7!VkJ:9{vԽ`i!}=t!l7IZ&X۸i(kJaDcfsU&in0zPx*[dP4F5#Aw aG&{@KA}&̏:eGe$=֏7}vkK{{ 3½=bIn-0xosVoWdz{mݲ˾~ΐ =SL`vjzZg8028FA]6| vIKo{ޫŃY"|~A;z/AMZ+˳\QA&׾). V5 9T4d#W HvLQmHKo`}Mex.Vq0b`[7@TlAq}y)-YjiD} 'ZķBK!-bid`P jK!/հ/vꂽ!AOO 1v( .E"i;vB լ=cZ@MWvx Ckig2ZVz~n LkkbF9;Q CY׫57[':c noӱBcSw+@4K#F; l&$TDm* +0ppjڱd]ƱZ$haXMK1|q:\sWr4%_߆4f]6"nn)l53HaJ)ΠMYn5!Ua'# pǦ񴶩? 5_ag&:p":ye_?-Y[>!LϏZj>Wrm5\ۆ&{$P0vJt.wJCvd00 Q9Ufה6]%{]^삙<>"&+g͹ɂs%\ " 8|}MzOyUs&y ӎB}D dκfSqu.'QX}P=sv,ovjNly;wRZx㠏}} 3hqmf,/'!Gꡠ Dv6>(Z Cq4 iȪa`VvƎ?ZxC۲E:77Б2%gݑ{n~|jXIv JL9 ު*^(vOWHBM!E턒bi>N\S6J oh}MŵȾg>4yU6~J"H;{pV?uUEّ \=_>%y!+UxyBU^ڎzΫ$kkm Z}#K&(xw1o?:$T~}*jt.A:4+綆pv mn&wIL6#PrX==rC_ G&۩0H̝"ؼ6T!vcJ\;6P⾰U)-BhGa e%phT!p7׷0^'XN;=ͽk-Xh' GXϪ* 0;Ux.6@T,9b5mmxD; uc;QT:57K ^21PY΃iڠKdj(ji^ /-om__S*z8EaV(z pQ845B1&-٢۰ߨI{- %GMC HDM(o|&U g-/*LOEt.zا&^!9Z;ɭڟjw(9#)])G%EQlh ?آtH,|Bɵ=[Go}QpX.)"P}i"6iGaHXgkNlzx.6@Q{ ~Q̃756f|3vhF+[sݞgb͕,lQs_ hF%{4Jd ģDf;~颎'5`is<CpX+@eޚshEɹoW-6n*ڈюt#]/*4iMo_݁_D:]~m76;%-ČHy+;sG.* _eA_Psٯ<('^,Bh&¦k!6^˾>;z^k`5AXnf ZAWK|OI<UZz/a|  f+ÄEibm< S9h+LXpc^Նf*aa_SNc?_hIBx\eF8paB}[RZitlflޔĢYsz؃R͉um:#<1̛($' ,~vSyp9Ll1d}Qcr$;rFo5ەڡ:\6 "77///ppЖΦ^i;7EEh%.nã '^VZ06A-]!Ҏ*;EN-h tk%_Sr4,Ԥ1}}-;BfFԬUl|.J:ΩiZ{--Ox}k6^ פ. v3mT9*XhmNpw!Zq= %__Sz ]=ٍxI׀hjh;$o=]&NVhվ>w<~N/၎ f"\Xh/R:sح FvT*T Vb@O肓REƵ]uꤠnk 쏈W0wbܢSpJK67Q= 'ei0Sгߦv5Y@{\, ] 0GqoI]Z@юBq~#_ѬLֆ7K~7 ̘6 Ʀa}KO><|%"aPV4wŦH8(Y=4 RuoY.D7CG&vdF\k:2D~ԑ9mWz#3򻵝7̯5", SLL@ۂmv!80TvMyMj 풯 /t!Y?0/g2WJp&O l1wqL׆^~U?SmD0?2ئCeCdĊc'2"N3kMӉ}MnL  D[r*[VOylWB/=bamj~}t` ҏтalS]\S]4|ͷD㵇gM$0=^6F[ל__)xEa2;$HvA웥0kaG!(|X˾)D#7Yrx' 9;7-f0nDBknv z$CNϚoIDbcyF= TQ͚G("UvO/}vޫn,樁-@~ux9iGM^k6'rR𫻭=Ow"Rs }QwAGMоƱCvR^õ ճI-]=<mh eQDCo*֨vXS4)CѬr;e_zگO%}b7J`m!an5GvN۾\ȹ!qm)m 3֋Y]4R8^py zMZf.h<m e_fU/=|.daɎɽ>Ȩ?͆D̚qMj7 sz: vvFBl ;IVC()&kCI#'"`rzB{l*0rP] Vi!>k:DT?Qd#UT9]EnqSVueFQAfX of#ce^k .k+= *1ߠ_tZxuoK[ca" FkKpU3o_ڡF!S6~WEfsrg/*f;5HX(JgB86qyQ([qYi풻 !ǿ"hBM - ZOen^+ƹkR oh|M;4P;)ޛe 4`AZ04z^£Kv֝I9pTrmc (fRX6d!:vjv%)#L?Nۋ4^ȧL  9uM9}eGa? 5sr%_(BA7F>SQ~(xQ4C; 4`P.@ZxkBQ^%H1.tK$Ix98lz0]~5}1 7=$Y'Q3n @Z~}7Ԕh!2n ^ܮu_$ݸ!aT:qbRpKv}v*'ʀC{Rpj[ o`}}!8xF# [en<. =eK>4Crݣ!uSKh~)~  Bt` :L  5+/sFvהX%5+cJu'!:ҸIv"Gx 'k<&ڭ:|MGM(_XA졎C/kY·4J16Tu!bY/vΰ6Dea|J,u׀sS풯o jD|AD^T*NHЎx< t-;hcT ZJvOԯ)$24@ߩ: 5ZQLQ "vS\XK{kRKox+0<+ 0"u=Pޫ;EL3'6Wf_e_SAPtQ7q5B6I"d" *mQȡ8K@w895s hx£a[6VDW hf2]5/Y/ 4z;CJOHxMsێoygiRVGt}`)= oRH>N둁O(1R&tM A}S4N8ջNh H_uy:~#H[JK# mWGJtҒpę>%Vф_"=RDD 4IKQ\/$v#HΧGZR(G@+[&w8w]ymw 8DÄ9% &vji#%ca-)JI1xcwI"v|11)8ԭL w03bZV֌ ЧPߙDya{G}9e;=5ebYggƂ߻f=iɮ1%__e{8ʁv_{9 w`BIW/λeG%slh5uRnaoh|Tٟ`EPgP["Iү&-iG!=g"l}=g&~j 3=5}w:P:曅DV10q5D}|bԪ;MPbY{I63XRK POFkuڒp]"&(\D yX('$ eױ]UN oOK4CdU7i\k'nO10CuGrvk 풯)ÍBWc9 LAO [g:A(/."vAJ gmm#__@T-ߍݹ:m{ٮ\ Oov h}}MgD 'p6]LkDdG99lGIbY.VoPhj[J`Vv)V e5 ##jdT. xJEX)hJBijd:9p"ʢ6dt)z()Zxa_S0ZM hZCt^av-=CPºY}R!h[[hZIխ UiUmeW{BfDoa~ .Ԇ7K&DОɯ9ꦷL$P4jya~ȯ}Jxe}5-z8~>Bkl+F/p\U~ K~NFA;iшF6?У5C6')ǖY!xӰ7[::JeN2\QwNfD=u2 u2뀝mN lx), kV'.Y08vה,\ %JIE`%mD$YOHYF܂Y3e9 (tkCyQ|A`ǝrNv QbN-}{K_m|}c[Q}qMW5 rkg4Wv;b"߾jVr |ǰ]-e;43ܡZUfm̛G㱃X˗(0iK2 qw6EW2]  Օvګ^z[I-])pcgl R= R, * gr:d|CqW\NZTF JvjE3H+RJZxԭe_?eQfq}!ϥU,CPr̎4iV4\i )=8ioX_1|}A8hdb؁BpzbHKo*%۲]W6T =-k#';S;Y+5m$k* h$KC!0hCuy!ڎ2 t8 w!9=^l|P<|N4*}4>h# ޴a'!i@iD x$EPױΚ+*JDyYnizklOKM7s;g`;iGfxs~M|:W&xהe2H׻`YΡsOY?+ttI;>'՝biG3ԬtFlQ3pD(5RZ ~ժt^]Kve;Fvz/ً0lagN(h9YՍ*+:\a-]5dm1@lioljM|TI(o\DT)/Zx3q!)*rYU-!n} vl,ì ה֦)HYDz/Oۼn^8'";`Vvi맞9R^AlQ6H,M[ !WʑI+s:n<՟ߟ^5 sˁ> DGa[HB"|03:f.r=#5G]UQwۈ8f? {B!ąn JP9FpYыׄ. #rCI]^@/>:WmK^ܫ0 ` A _Cdo4T<ֆfg%Uv U/.ejB)ȝL o3!5EcAqKmmnюk@ֳz.9Ս`i਍)J+4'\=៳8SSm˾>oxfxnY'}K㌂n;#%IAo| &֌Qa\ G(ȁ%uIj6]܎cT.M!~4Z_4Vuى.ξ,F`ҟWׁK]c d%֮>*y{'ϱrRpZ o75e$ҶNRrz< wy?xmSSnn*t^f.*_v07y3P߭`WcM k-)V \@h ]F ΢DbZ>G1T|,pB7׮bN+m̡O7qE7b/QؤVn3eOٹ*qEogˮ!YC,bY~}Md!ר6pMk8QH)ێt(E;#R__j.<[p\FbsҬ-o=<%l7WemiJ ($ 4v]ߘ57M5h=x,/qQL6w_J"D;Ab`*B(ݳ·UkNEϲ]vX8Y'HZ,[GvFI g}I{^ހׯ9̉VR652숚_jYvfƎBU# fM7fWgK| GUkbEkHnO(U0RU 28O!=wrD̗;q@DzZ;m8 0Z=T¿^!ˏ@V3VqN ^%;AZ``og7 %BH&DL$JȌ;$KzC.|B2zk%}3JH?.B5uNA3ui_]|+UMf'F 3..iM׾~`@`nc팭 |I@ҚȎY3Ich*Kl_'E~{]-p¥%? c?K T$mA$"BƟ]AD0J3^ zƶ7U5'X5'bhXUnkZ1Љ]!0j|iW"Y C\F.>}A Tv[V?l)ܾ_p=Aֽ-A~M7iGŚQE=(Fώb@`; Ҏb@Jk__SH%R}zjn9 =餍ҎBy_F;e>R>J oh}qL_ 0!C `2E ; 絻``f]99uv״CrृQ2 _.d: .v>B.eg#Z`ws7˾`nŇGIrO7.IzxE {ށPIY5=Ec-e.qTq8UĒBN0^!;  (H6vהKjhr{H=wEbqڮ*;ѮRc`;vɹ27` óqkb]"$.H59p*ѺkVv[[XP05Qʁom7٠ 5k+ wbV+*F;R{$8J= f5+l2*Ό`jA >cϜ--jo"xnb?E8S0 `ٲv1 u@'v И`jCm_S1Vn;E*MP$(na*:O) ;gkSґB/ Ijm Ȯ.uO m&SHjMurkzVR; @n(ƋU))jn쯊 Rp*[ o;k:ǣ>߯?q'cy_ >.k{T. _x;uy⸸fwF]߾e+-\ c̻ȖaB<{n?e_|0=M|Q="ZǬ)Oع\7\6\lxDŽkR o0*D[G ?M 5F߬^Ff~ ` S\vׄ>u!ƶpV;+;(hF@>4  +"]UD-kMwlzVFL5xT,:ǎ)xf VzB^NWYYWbkJ.EP, !/>JWiw!B4+kt 0^.?Y/٢cwB ԠL@ ɰdI"N8hМ; p{xTD+ܶ풯t}Ř FـpFZBbd" ?qDoVwMi%_b:0p17Fl9qB}\H,'J]uRÃGv^ ~߉`d@~ﴵ 0GhN>},ImaV |2EO?3̓n]Z:KQ[n0:?Ɠc__ H;-2TsYlo X ~EU]BHK>=<5_ PuQ)Uw);6-Ay9(+iDIU7a֛ 'ur^)ur^g(NM9SR ByQKojyiX8?C0!-펾idɾ9wnPg}0:B.4\c :!mX07 h.li6 BV˄l=·ܲJk-z@rV[vEn-ڲ׷apyVm )8|0qD=UFD9_V풯G}"a6VQE~v0 '7WBVk!HpcV;Ȳ0 x+qu n#r$ݹ;ĬaXKEARa.FPJo+4N:'!;m"U=kZyojͲz(hcǴz=D ^yfϾ&40]ߓhPeqU )]yRA櫚ZxkŞ2U_,,r](8v +AXcn*j /MZz3 f9a cYgEɰ180EN0f'#{u}opc%hl_)8ZA~I; mN ;Wk.8+Zj}}MЗi*>_"y0:^w 9aoK5#l575!`!*v&X7Ym qNkԲUg;bmm QJKo65{^VakpoјB5BxL7=<FboHR6Ma`b"9 t;A`};ؖt'FFe~ ] ۏF-rdwz!` ]Mx,N½#Tnŏ>e\Bp}$=U-̑϶.msוڿkKO n9d4o9NzI+|hUOx]Y;֝cS*hҬe_S=ŌZw~=Q#J)ld=XeKZ(l8ؖR YOwj.!ur`.=-vPI(ut$$(O$8 >oya{>ޯ\~\֜U._5,*8]!rb_Dj[ rU :BĨs%]t%k kKm,-5%BcQ2e Ck1@މ8o!t'ug tkrZX:X #qb!~>UDhPJ\Xh-M\j=å^E2N6p^D}!.9рV!& woB%]Sɲ1S3Zm Q$/f1%Eg[V`Т\].Mp#wb ;$|m]^A^5bkg9xJ-k Ct$J*9Qaȁ@"A"y$F%ì_]c7^ M -冈-l`Kd#R9]ډ4Yg*G~f<<Xx̟P2[\2/:RD GbÁV?>kkv(.tQ|}Ķq 9*n; JFQ!مs@bS1hM qos ;B1tnt/;&k\>v77]y,dە`DJ@;䊬rI:TaŻh#ↁ18̂I:w,bFkR T$Ac¬=ZLBY\W 1%u\sAD[jõ:P.JlHG6畐Geg8-+Lr#P-ǹЦ u]ta`f: Zx:e#E HD::.K`jY{fMBoȝѸmܑEQ3`-aPkڂ٦DD.ו= 9qWTYXꕅxr$|7lׂ(z@f!KuVq 岮 /~ J뤢Aюvy@뇖L/vD4VRe]oA<%x^@Ϊ|Q-9M"!iγs|kx{*CZ_S"VŅ# S UYtw> m u:h6owy>nvacSr Tm8$I _]5;Nwq`}fkXɁI9Órsk m(tM@?1xJν+D8^(g/SG4)|u CtGGe}쉎75BGFA葐֊mxl|a9?%]fӜ`ug*#s4*z L 2#sH6 mgdvC-8%rndoNs۠QrvH'I*ІrY0ުUyoa ~:F}0)(GzerY6I9Λ51ƅ6KwOnF1bgzXe:ǬL7ƀs,p@.뚼uG6KϮ$Qm`c bggؖM뇛yYg~ޚB%]S8Ƣ'dj|5%f #Qb +Ԭ <SŅ6˺~Ҝ6]ͽa*V'n\;Z$bAS <; mR\WpTsZP;*iը? Ԓ%VD#C>wuߺ&zQ6>jwEw@erV$99!ʡvv0qͮ<.tM0dFA7ap\=;hA\'0_†{*Q4Ġ|;R=e]<щό ނ[$zA9'R <_XdVrY^7)E$:\Ŷ$eȽ>g\&t/Z{}u^΅6ggl' tY!}0e0ɑh9:eEAH3ĥ6UAm5`'u;*xw٥vC\)QDn0ΕܺeD+oʕ6˺&2L>2 ,A66I C<ꅄ͏ssF9~ m{_s!hRU5Wӊ9O/́('.ͶϚW_kk [c[/ ^ѼQ>y<BKK*.\5YaF%L#QIm;թq~28t*p/W"c.vXkT-M3̔PO[J Mm+u5zMpT A໮)xF!Z@Vdˊc˱$Xl!mnmfӫ h/Nr v'}hEfmqFb rNY[y&Ц JuMPaOX1s z$܅kj#` QZ744kus:kPuMXZ{;1+XXẐ^klλ79U۬ > m(tM#C}·#^HH}tHD<."PߜkH.ZDnIxZl#g XhR8-荒sd9\5YfEtTlb\FO"d wA>맡{Ц)p&'' tte(2i ZC#'FYCG\jSG`` Nx8#ԘpնJkh]*hY#댍5T.rIH E"\_͊ר^2Ew0 bU)i^LqO8QF!4u{/FIۍy§h@T-X:r5hؗ2f%.Q^Kv,@.${:ΕQӇ+uүpgP.0xl3o ;ג3s-uÃr RK 0ü+G}5Ņ6&V܄ji \.dыkSut#ׯ \y=RX%]i`j4m{]c-Oqvv74ΕTsKme5%=P͒4i\k/@JV;ķ]eI2']}nPz~wXK, Wm+B5~Os-Vr …B(>,΅6]|kĐ'ԐjR &LzMr"Őq1ǐ&!P΅6Cr]߀C*B oq ="9-ZrUМO: m u 빪Ox"!LtvS^\M%":b`j9լ SkH./Bpڹfv ٛs] j莔S|֒˟~|)|uT¶Qt%F*7ۅtB"Ş2ˁHk1k6؅~S "x%]խRM<¿CeǶdl#B.bG];t0;вެ+JU5.Yq] O THq¬z"vXEeT>WM3uY%&a{GSnS.v~'N<&b{tuMPq8Ke]y A'.lY$v"r f`L:Ib;wޯ0r'mXos*A2MrHyqїqG]ׄo쌻vfpUMaƙ<8ŀ;h͒>+멊KmuM6ʮs4fpsv/Bwdr |}Uunf zMQ5Xl*y0Rļ9 xQ$7 0W׸loܚB%TL~o57 6gގ.$>)RqYuMW/C(Xqs eqP\# 6^A$]µs`wr.ẦAџ40hs+ͰlL݄s6Q-F t\>[~@WH:pY&3ԍ*8l;4#(4[~z;/$qk2p20Fs:ÚRuMd͡~C q ,Z`&n=Tq%̚ښ +krޚYֺ0'gl1IsU\P1] ,|f`COp[\jh9:a0?Lv; p,C0?]gBs.Jp]S 9aM6F!]]qa8PD̊y4l_Hh͹Zu'mj]Dtr~rB|$w%g8-?约|IP|!bf6Vi^ "!Zbz@,ӊWׄ-.MKٌ ]{䱡 rG993rʘo$|U_9q ;}U&Hӧ8w1s kHx`8_]}ѥZe }wLVTR G}7rD(+nET >PzsKZe?z@ܫ Gs4(vxvP͑ȊT%VR;ujjROJJ [Ͱ\qN+'õ† b1^Bm\הNJB8aO![GF|l[skq.W/!NF٬ ܂Y K n+{Y_g-3=<,5Ʌ6˺DdPD{dQnWH_D͍Ѿ)pF#{UE 1cdf]4IV[fl.WښLx0mHO')sꚾ`ãyIse;לlQZ6l`N{WK-\FrId[` tWrmQz*-$>$K*b/Mkr+:zQwŒ-i8ʆ?cZ(u%bExS>j6V:1\.2\_xeB2Q _7{8VmS|=)\(uruls=x,7bv8w1RzU jZmf#op.;ޒ~˱V:-JgO .so97i3 N$U6a<]S5Ʌ6[eFkFR54ჃrPw,s[S)*R+ź'N..^~\w:'f_x}#y#-r 0!ŝ,‰).ԃ\5a ,;0^ @%?{?,QM9 ܨ]NX+OK,Q*WVh׼:M6ɑ(U2Tk+c6*G|iC=l%"| b#1{XkH4A/*a6ȟH$qAngJfUm+eM4O:Yr$_85 tA{~]e]SxcٙkuAi:J.UOƶfgu6;۾Ykx&ІrI3MR 2yiY/pwW& Q2!7U;3/ Uzu]Ohm )9hqMչfQf՟^CCr$\ˬ]=e]b4061"%TDq0Զ YCDn(Jc\5iYQ@D0Aj1 o -\n+Y\Ë|H?šE%]CBV1=b3h ?0s{$%DXbr@YA59#>_]`f`NʠY'gRwH@Pn7¯6\ˡP䲮i) (]zd^i~[r$>-HqٌtZTH;A?)MX'*E(۹ !y`V&>Q2%]#ܥ@+P~LKm-.)Gf3ZR/%+O$KZ m uMIv n=\﷭ >Ct|oamD>hB'}Thb lʣN:GPpȱx dK@ۚ.ǹ,{u$-$r!-.P7 ": v]PjqGSxu\5Lbٟ-EX(zHݗLkE’3b=Cnn46+n6\Gkܾ 9BjvH~'dRx,#eȞs=&zM`ޟ 2UfoŞ =F\HF1#aB Q p5=#I#mGL⸄WP)=oܪGs{ɨUg==ZkO0y_z#peI]Ig_ҽ-)q\3F]Iם muYOB-nˉ ~GB-.SMNɑ" Kf( >ZӄZb#mu)ƶ~m5C<_Q@.f?͹(n 8_Eńʬ@\R>5!A\Xt,O =*|g1 Mڤ.ExE,}5uvzJn* ^ 򸨃 Y0Exn)$ܲk΅GYЮp۲KF r:לS\(G"5@N^IM\hk.Q3e^mv"Ll$@B"0k2_Nnk($IG.;JHw]Rj|b&윢|))K&F9 [A$P:U/>ZV! 8f9+jF'|TZJD`YVCrCtw$w ~uL'ڶ3*3eKČJu]>)yÅz~u  :A9)m8%{iVzGrYf%~5B~Nչb5Ed*5a :2)z>]הK\(D=O$]Ixd:t+%bV?a0\w]56˺JSF!:iWخu#܂j<HS uk®ZJB7Ä k&CElbʮ.k5 D@=16P)ptᦻ \%p`; L߳j(Gbl94R#Z6wْfLK~SUq`xfJ*~L9HA|-"we7|uMշ#s79S >$|\?i_aYg8hKJk-Bw`GcVE?>vl v`G7/Yr8J9k4`MFn-! ' nZ:@|:n+$VY{F*չ+4\P tA_׮bˡN7`C S| *U]DŽsMy~0MANѥ>I$cR\˕\giՉ|F<{Bw 䲮)JygD[k腄jGܭD)(ӗ)зߛsMe]ӱ2f^C5 G~C8oE$K&)0R![/EH>l;wF4vtn1 @ oQ79΅6KFe? 8pXs#}+Ӣ%5#%#C#J)^CIСw>psy-6 m:Y!0p:A&un= lÁX&*vB=^㣭s!9؟cZ{<8kTNI.\5H/PvF Js-%9!uY\Jx,Shk[Y9WoUr`R7 { A:][ f@0$u+qAU+qA0Ojsì N$b`kr25+n P.隼WY񺩬x\/6ov.+nno%o4va^ :⤲btaY1+嫫 nqw lϊ-9|y'A8-\k-9&  w.|6+)i#k\ ][\ ]-Y g碑r$fPaMY7B5e:]3=Ko5ߑn5l)j O$1rɁܬr ".m)ˏk m uà %ԊDw/QVdIE-Fkmd?zWxS\&v' wqRO9+!n{KF0~' w;ȧ4&sHHFJs4/IPtRm+y rIt)C؎K5?ScѠgڮq{QÍ+VUe,$R֜ m(tM2`EGanA/Mwf6ɑcxl /e˹ЦƘO8pcoN?K\hCk4UGA;,l]z|)j@NOBtYk+'e`WKƷ}}-l@ J rDtB|w؃?gK\jSU&ǀZ5}L4L\KKNDoXlr QgퟒBҾia@BT? Q_w$D=H(!pT=΅z8^o]'5C@#и: s3St%&foMkw:e\S*EL锩GchtJN5)ܾ rN9ϯ O~)b >BHB P.7|0*+^YAx8>` u տ}40wqmO w2q9㦶ibkKm uM<#jj!iۉڌ&Kؑ36$Gbocz.U( wЈ >KJے˺~`J0X"YxHxHn ̔׾HDq'9DS'1sAqǹʃ<E:4;5e] _"`y6t{$Z:.HɽYAN\hU&rTYī[:FW]d o{"Ƞ]d~RDUn@i_]B/hԵ4lS(+X3Yqv'94HŬ'RuC-WnV' txWvhl P쀭R:\>U@%.NkZaO0|MvZSzsi.9+ f LĮ9CBB鑶zE?i 0RZq.VmJa*fbͺ0* Oj 7!Rt5CF Ȃ m{ ̋oS.#QV0kĂ5OK.tM߾/)_'̂)2' tzO3kts2_c¼I¿\h3&9[ կL[% W#%N9#GOyYR(a..\5i,f3ѽRs :2'hkw@T}ݹЦ+[u4nK%J0eq1;Cfi2v]HLGSFYj脬)z,num }ӽނPK|qဠ*fq;; B΅zGzkrٽ5*-K0{%YǹZ맳`љk=*0$jvF/ME]y3hA `/9ux=$@.A:57e̚?3bz(P:"ff-.-bt"fWxuE"Ooz$pI]k@*F. teٸ)c4nP&8?Nk9Pu!g8c~zc3mG.\?I۫KVV= s'Pn;yA7!^% ms9>Ҹc U܆lOnC-u8o_>Ѕ4>kBbẦ6'-Q}$үvHx8h9*$7Xy>u rl.7"7ķ%]zQ' 4:&Lqi:EܸbZ6ǖd ¯׹rY=/{mߒ烄[͹%[]s3=${ m{ϗT£NӓlQ{|ID C+ܯKx3~%Wd4Mئy |ChLEsine;|uPťRE覡t\|>ĈyqEBW=kixqǁtm޾Y;&ԆIa99$BBiD!VoW\T 4!o/P &ҫɱz+p'ҲWDZJ5 Ey6a a`ɤ@zkv.YJq]5N'Y~p!c!n@\NF5:.HPHx r[~.aZvlB"] Ȩx07q1 t g7e]^"g HdRJG#s>D5'PɩI.Du]al{3"Mpq|ɹ$G7UXGזf{K?J\5=PZԵ̍D[H<;ǹV!dePV[Hľ˵\5ef뭰#"!:PA+2d XSCݿ+ Y5S\?hQvCF@(K̻:i63!&SoZ@Gr5CNޛ{wE$]M ,u#ا-jjXoͥĶ$uU^Y}y~LƁkEM7ZJ3ŝbSq>{'Se}w6K,BCR9r=rF`V1]R']ֆ%]ԭ]*+]"j#!nq$@$`2 4\_&`2du\?oon__r[~ğ_?5.ӿa,?jݨ|UGY]NSدdж?⚷t ?/@Šn/H翨D:E:8 4/o'~?_7^_e=s~?_Wǿg?KZlT7BzKOsOBzI?8׶-O1;Q}=ޫɤ,Xkm>s7]}mezl'\ >=;O>G _rYP[m#vRHXzSSfY!󾏹k=X Cgηzh%es9b<.k`<>wSvM>l֛i(P 4 QQo=ޤ; eAUOFܠ&om)ez{ڱ"<-S1(<n.K)l#VOy6ԋYo}NTʟwS`_zA~+?|[Jo]8bVoKNspqQTWG, Zƕ]Y_zAw &zQ6su%>B\m|*p6 ĿHTSaXQ57)6ԋYxwþWȻ4sP<%̇LJ8),,ysɪ^sjjQ#[} ˺kXUߴ xӸ,$1-*Mۋ8}mezƌ0}M|xM یg CeI9XK6ԋYo!u#+Nt[Gϵo.KjVpYKמA7/ey `Gk_K2쥖yܞk/ ;XM \Q ~Ӎ׊,l;KzX=W/-X;N [&eIy1e݁5w;&zQ6r ViЏbb^8P:\T#.kyAᯱԋYo/O{+1j|kS5+JgίU&mOT!IeN>ɒ+j#Ł|鿢&zQ6-ʦ}#P##vpMEYRݽip:R"Fùr}meqV^7yL*'F*g'F >Źdi5%jnR:_p4Ggy,N Jn @6>Y-dvjnRYCv魳O]:@bwϼdI-;|Bf;jᶥ&zQ6m#o OaҐ;?0QF6 3>7(5zQ6ϲlZt -j<G~5ɊjjBmZ]ǣɧ^?^Imwho];=ᗤ,^"l۳%pnɧ^zo9׷plɇ}6QѾiρ,&lsK-qa_(pe_A鬴l1~ vbH(t7Qz?w >b%5knia'km򩗻Co~UVň.4V}}m'lz:OïA@s_7ŋ_ Kﰓ/Vr cE ; vdgsS_+b(Ź=Zspmɚ/zknRw >5GoǢ+G QƵ̖5߃U=[w˲\>1TUmpM>Go.V6KciRQz߶">9l#G77(5R6=2U#^5J!YFh51ox(KjJ#2$k }._|E٬>3`G ׏AJVU#FHvɹW\|E٬wPR#Vp_{f{CL3;v&;tv4&Z!{ɧ^zvOnGӚGDMUT@D|P:ۣP;;pm)eފYi}wCfcˁSoS-pqr"_ I .Yo0J| 힝o9n [%y#VVsOkmeޱ3cM| uv% 8|KlnAȅ;;ԔY\v_nduywd|yw7`[;%Uw.d~rnPn|E٬/DL#_xe!Ty#6=eIsdǦͿg-og|6ٿg#ׇE lr-JOܞ s:SUsF}K M{mṋ{F6Wn`uaN%J9GYR%G݃vlW+g&zQ6EDN.&Uޢ1?=tXe}meq㗲:4GiAbmtO0൹%d~LY<"fUk&zQ6|6b6613쌍|JT᪏ OV&jW}mec4\zj? (YXp\=Ql٥[-dߘ8rLz#&·Yqk6ySC陋1qzLT;5-,${h Gۈ -7E;thgesZZe)-e7ΑhmS:E =5ogzFU!Js{L_v7/KO ɃjW wb_,;=}l4d J>R䋾z|K8*>b5_{Fv9j%+jEG&H=}OeYW>FYn{& >nv"*%<F#Hj,b;bZ|E٬b,QG*Q} x*$K榑~L~`Z1(']k$=y#@5#9v&޾ɌŹ|Of^KȒڑȑy`Fbgz^Kw.6+r7 gdnYE7S}+.{br`>l;1JUoj._n#.eI -F6 fNweKO.(WA#;k'ymVU7[ ?ʒ*4؊dC\47)WxBWnXGEIW`?$(3ㄲǑ5 ފpsרEOw/~6)U3&jxF:쵣h17S/fN~KlS/eg='=Q+8$);#\|E٬wm^uHפQjV<3Q+2s,8S/f?s.݃if!98ew%7ZlQ2+LnDkJ>l;v?S5+̻xՎ(y#r~+%j3%; pT⹣۟zQ6-r,۟o.Ү;DKƗdIO_DuCGF+#?&`;va'`U`e 'eUCqYz5wlawY;0Y\tX>C΀ނD5.tG{5(;px2.jZ/Vt#Җ׊nԧ=[oY`ϋdEϋ0v\VTJV?=9N|< (:܆k[6Qan >۔%ȲWR_s7~_m)#k1fC׋lr|s,z"#/5dkhm)e޺W6VՈyu)L?7;E)˒Y#+$ٍνkO(By4A&E*JK1?d̯DMR_$ۑ_vW":!{%;B# 0)*hxw|v,*,R)0;"~_Ĺ[qmWs;bI5lahuddrG0_UPv&2y8-dKdsme)Wy0bg7ҫXk>: 3_HqYP[6L?.ڹ>57)Uz'%3S /a,l%< {Կ|ʪ'5"?#]Oi12^ 3cn,*\1>$_E> osU]M91fDyf1l[QV%@7>{&{DɤI 8! s9b](kܤ&Bw#d8R1qx:cU~ z冨WskȀes}nP^#=e|14!F[%FȌ|ˠJȷ,)9wʷT ԋYo^UK>ٸ)e`ѫڦ(JZ[ci,u^[&wUKo>u )u9pI8Be DEŤFU\cnokO(Uk4m("LޡrzBTFJ;n3Eા6ԋYUXt+f/(.Ul9^[#=ujţKt 1瞲x|)6AVwGOdt Q~6Ó!٫ Z(ͭM>JO .i!F} PVIwD[sk^H3GHՑ˫#Cx3Yt2+nsD$?+H,aeYùim2N}Vυӈ܆L93Š7YQas؋; bnP|Eُ` RF@6zd/B!D鉚Q7Uw#ȩȫ^Cј[U1䑅J1;2*UNɒ%wc0"b0E]pīysVskQLԎ ,NPv*boQ >l;] ֣8ƮXZG]_@t@ù{8w.0/wqڎ律Zځ|^ 6nN0`'ܠ5KYwnwrOή0U!=uxd#\:HƈWo=c(}}r PΤ#iۙdIui)v~D'/^MMw^sds;۠UJ,ZJ𯪥Mzn>@1lBbW#q6ԋY,V8tfLh$o91 ڬׂpAd0g4mp١eҎ?ct7sr ;HֽiOޱ6Kj@w.@ŀhȟ*8JQ=drn|Oޟ]xl;,bN.B47bqiGnW,䕬%U#*1+Lnk;zQ60iȯc Oiĸd#LjĔ@,&^u┬)M;Δ~0Yl-&ٌl;rG+\z#kJUrrFo R>J8FP#)7<bz-/x"G.Z<E7>[, -Dᕂv*BG~%jEgS͐E!(q2fُ&+.  >TR >QH~b̵lUnQ[K?!wv\뮜{k\|vYR2$/GO%ԋY!ikr|K,6)Nj(tˊ Α|KvGkߗ|ُށC;_)#CE y"{S֬ Kja2˞V DМΗ^ żK=GmWeLh!^ω,&;quI&zQ6ߥ[1 űhg*S4#y%kˋz ,ߪGz_4Qw8Z}E1T47)SS~N~~w$??z{TX P&fuYQ'nBX1(S/f#*d'7+ÆXĆX(K TJTu% sR(k/#z.U=N/q#1o%bt*yYR'jF8G@9|nPAqX\'O@J0n$}y*:CTX Ad#Jww4Jg*q!o36]]o;]VԊ#Sgo=YYYz4*4W'wz7Ŷ$V񷴿ݦ[%ch6C6=􎚑Twp`C-(=n(Qիsb$ڔCrJJִ_zǹϚ5'Bxt1.J'9]Cv'9G+11wΧ^z@4$1汄S[O9ʒ:~jªOVM>l;|} HF,gd;ʻ5-#UhT1wd]u_zGuJk (ziZM8Ysv&Xv!X#o>8_zAwRI 6+Чc9[.Jo@cNcFk$Y!iSS/fYg#V~fNS e<u|YJ?xg@dky*|s[iק lx =6N𻽦%4$[UEvќ/v<%4#S}E EifX.#9pBMQswfwKﴏ1 c]s3EI;;D%[s=.yKE(?y*MR2toA?5dL{Jwh>=d7JsG_)=UY]l2w!VbVa=$* 1b-YKߚT)*'fdW"#׿7 )f ^:(B3d#43B% 3 qݽn+K,}F4B-nVuL!̮Eϼ^wuCy^?ثFԽijvGݜ掺:MR-~oE#SHow~ tH(tQTv4판,85wpme޿ ۖ#O\#mp#dI%l[®kO7N=S੹Lo yU&+S8V %ҍ_=5.C0rbrXjXj] D;5/%D5ym|Xє-r. ݕ8vVE٬w`N~SdžGΉ3V9W&]D>Rm./l+lBjZ/Ӑ%^!D>ѩz1Vbhn"Y$Cv KL=l[eʧUϤƜ]$Bo+PʬÚo'^B+u QU&"oћgݑ5rԧ⣋!J;SkG%dIx4aA,> }/S(64d/MzHNSz%jF#JS] ٬w,Ƒ9GBu4ψY0 teUEnH֣mr/ !rCﰓ4kSH]*0|f{RT] Q]msS[K/Qil~.Kgo55ѥ섷sOphmeqcH~! ~grb >S("CvK[R3D|9+SHR]]i:ljPQ;'F}s_cmeQz/Kˆ`u"ہuGRO:I~)-/шLT nsN)d?zoeNԌgB9LF5QZUrU.+oiT)5殞s,bj3>=z)Ov=Ej8|$dIwjD,O!´KcmE~pWj "z_4Wy; $uYQqi}k-T8zQ6>؊A_0b/L /EF)-Օ$8㰯/s:c hߚbS,Bq'l_hoJ zy /#0Z7u4vIz1^2Z&l ! #:C_vS]`Cj$E]lX?J!X}ɵ t٥[b:2-=2ߞKj]S419lhK7Ji[J#Z"/|~ҵx8Eq":+fuX e @ػFYז~~:2'z|+ /QQwZkQXQG^f~^3ȡ"/o㐐$*fEBZ^z+\)5grXOszyD.OI;xiK9{p,%kSOhv#YTΕ\^7r}|Coތ,mCC+lbj{'֫D~Ezt~qLz/Jcwu={%<0e.fT(Y~Ujo?/1=-pXyYzBDm)%4tTɺLYERۛUg!QܸRtTC\ΖNWIR\ދKN3o-8I9KuUnAwT+H}}f>ChMs$c<&mΏ)ϏǴ?q{&LFgL@$8jyM,ymꇸm䆶زCx.GP$˴)#M&c˃@z˖wrӯ8{|%{sF< 'v!_{Ș |_)zK-(n\#ɝm;Ƒ/ 0Y$>p%故轵7%}ΰZ;a_1TQ/16Q$˶ ˦$)`seхe"vZ X\~;z'k>hf8|{qԢB GιRw:Oa5=㷿Mah`44nr6*}G`'Ӕ+ m](hpU<֔~6{_KXhD rN~^P}p^>sN+(q8k ~dWA+SM+ȟCJ['vg6 6&l?&Iͽ@DEDՊh__iaDZ$\5Itg~XE͡x8\HEY%wVݢbȓ`qu>[Gkim;*X2b nucM5xm{Z4{ݯmp]&]/IZ&5v"Eo**}\D^U)IopFSuد)I+NbO+UāstOn}G/B[Oam9;SRYN8685LTX9o$hKch+ՋmI½9xGbb#|?q?ieAuz? vih*8IZ4kei٢=W{x/~Ϳecy/ }߇a5һ6эV=އCo36M= fGlRqNj幰EծNUˈ#lθ;4O|/%[I\a9Ώ[Ztoq9 p65b4?4Cm{tf_/=+ UED/p~l)McB2lڒ{wwy ~~6pgZƸ[ȏ56<fGTTRj[J8$\@,"FRtGCk6A/Bw`|kUoLR0Rjޠ> o2o`:=ݶoqN{0OB]Ӧ$ǚdԣ+D+h-wQ]z/"k\9nئܛ$=ؒzɖ68W MRd҇V/Z%u~_YGܭI2'Vޭd)Eus[_2֏ߞ!J,OE eȃ}$E%&6_'IS HnhN5q▨+M?|.Mh C/Bmۣ N}o NmF"]z[T pQF3i`5h>}}@ۮc̼s(}U4]zE/D'/D?C v;w15jxI:7b >]MI痱OKxJhsOB‵ר+\^u$O0j$gWQf(ob w)?T'~]IjbBj޻d~V_Uh۹qwi M{)03xSHW#%;Њm)wlj>/mf/K-ITv>ֳ]o PH@=umm Jt"I¶%)s&Jג$(+ \%ػNkc%yZʏi6N痂>'Ζ3%)*!^H Ε%u`]lfݧ$X).g4qH-6Z)G8$'I5jZADZl=}IRpH[~5c0{wrM7(cB%9ScF!ږ;m]z/r^dFKDEJ&-I[H<xR*OR8Dm;aĹppGPB_Izo0QX'LB"Wb=/tkhv;8X ȅawIOwq;bin b@{{V@׆^~Mՠg nݡ{Yw$45@q~ygi $E+ D\w-}X?~{~L @>GanEew 5 bd$>kղmB4+kSOhv#Y%ժƚ$)Wh6y㝮;r0]q$#t] ݷm>Wlo#WON2G.H:]GN^lA=l r>)W,ꃉy]{%zy+ #2F}tbvR٪"ddboHzS[s6'gz6*]j)ڞM Wxm ^t'k ~&#:+U|>ubȗORNp<FsYd67EԧƜǩ8ANJ%ԒjĆjT]?~+7[c6A+Hc2#=mÚ~]T ch{ސs&$:~N_p"ݛ*vk-OװTYU9ͶSWEx*G[i?~?l]3V]Ex`"=SϴT=zH'NӶ(S\ѵ,7<4,ۡ'Њ52J9_a|@,qU+/sko#/~8)K8Wؚ QrWu~وIx☟˥-糸wⵥ'U~%\x۩t74K㌡qZTZI2V^}\M)S+~;#sHw_C3۱ekplY9iEݠotD .Җ(Uo8P4av6f~Jd{m8_VavME1 gOaZl^8+HȶSͬkSOhg=WTIc>J=9iK} {CkKdNx\O2P"n@ɃlD5B[IVre]Q{Պo_Vu+zO]Aha!/k*E+COXԑy.xd1[:axNlA6 5P"}3?W{&( [&^\"4o_NלJEab(B_+VW{,EÕRވ!rǏz'S+CMpjDGiNfi%8j-xbͶ$]C0gP5ڏ]p~ 敤8P'l%̬K@Zl.ppumH]~ۿD\i5( Lqy+vvf]wVj[ҽ4z,M=m3+}_HTIʍkUw0FH[qVǕkڛRd9_~'7q #A%)fj҈9>tpWkS?q߮%U'wd8ǓÊlDWIr?V@/~\M}(R?~<|_ 9Z$)(Ȃ&>%ߊ6 -L(ҐjENW!tƇ%_YUt։!7Z)l(a"ol40׻$7q*:,yIJbCg1)SܽKR|ԧo_2Z\ix5|+ V8kw%J/$[j..qBе_UOv%,K 3WmB9 v.eɭ<L.ݑk_~.F臙꽻hoLUO{㕤o}#v%g#.oaxmgT߳B&un?zo0ouVqjڢ t=I3Z@`&;|G ESd>Qss"Ab5٨Go;uIU"y0!&{U絥_QSB"7˲'rIzˮc=!ChKi{„+ёLKvO~6^{pq|g]Y$)@fÆijF)qq|g5,T&$~vuGv3r@bZ%EZ/O}em1%β_8$xVje W낏͂e$цij[J9W(P=Cu6+ci..Cb>pIx]˶Kt1S ۘvb-~Գ~l8#s/[I>Wz&9}浩_~>q}/BòBt*xg%Z lGWkSOb^~dY+u8}NWD]P̊Vf/޻צ~6~iM|\RzE5 [VҊӎV#[ k]zE췿QLjo{TՃl^*iD`L;l =Ckk췟6/+!SE܃nfHTm!ėĕ#;~ɈVև$=/}YOO㱂4v|+2 8f5h49v$yE+'A.tm߮#AOg1t.*1-)JW/ R"ŕ*6>u{jD ^z۳ogT!9Eבi(!t2kuz+a[<ۘ]5&_~w!7Zi\M4<6iȨX g$z˜OK!wMȐI{V|%WmIz'uYwˆ>S׬h]CI{l'~ E{=zQs4C$y?[%1q:Vp4C1q4s`.IZQG|`S{;Sצ~6JsZAt3[~8wi[JiZzh#%o~_~;oI]#o0Mk 3"T ^=8]}ԧ JECzѓkwEV0*==$ A ǖĽ AЬ}g)Y$.cŌSN4 }a/(Ǒ!8xUcWmG={wWαk[4/1-u5;|GwŒ$}L **ß]%靼K};Ijt-摀 >]?]D~6֏~/g͂C=OWRDTQ׶S{}=/ԗ5rv?Fai@4ؔ{˖Rb֘09uޙ1ז t+ >]hһy޻+wȒ-ߴwlM=m[KLk^uK7N\GTO-5Qߘ^%/Mwf00!"0Gȝ9tm Ȃ#IHH3aWmߎR Lh+Zˎ*L/qܝ" 1eiL={Iwº\F1v!^ :!"_JlFCq4YmO֒|N=R_+/ ^WD ]tr ז~6wry]sIZ $lKT]麈6{m0tzz~Wk}1`7d<K%u:OC\! m' =c>6횸][ '|+)%I2wV.2wmnӗ@g?~;/x &Ty 8QV,jMz>eF(&/W w$O|GcIeq;,ϵQg=iK/JAlկԛȽ mi6_kTr?BͶ!I6j~"c*rw4ڻ7-d!~o.޹?Adߪe/2tЏPJ*'sH` Iq_)o'/|b~,Dl٘:Yb0Za8aۣ{e2=œ!ؘkz'WNV Vu"̳V :oUs;I*l;%\D>|2jTjtGW89[}$xe:u/vgl5Y9[MlV#I1L) {X?zqeco.IUZz'ȬLU"u=n>~N'LH;z١*I#bM!qoedD#0"j-ˆCzH95v+_IQOX$T+Z{TצjM\iZ7 NH'Iiljb揠GQExQ֣m;;zzt!sD$g-T+Htm9i[?s^~ <;cwEOof"F^1 $wkekvjoJzk=m;-9c ^=%v4Ǖ. r =ǧkw68Sθi"GP,Wq\\Gm< 7Oj .Ϋ ^?vlـ,bˆ"mucFQ|-c˃Ŗ߫Y%E^[ObK|rܑO.xi+}%}+WzZO^wEPWBZ# Y$5^x5gD<\!9tDTkKOhvlCX~֦cZt0I:m&kU[1E׶oבϘ|.CjÈsa~*3t7d:)ܮUyU~ֳ?04Td>QIq292Ľcy7%==}wxƻp7}*)LSfORwn+ O{?O׮nighCs r#:JF5*f+Dxk6oϋhќ9x{׋@E&&8¢#4a}2B-}4z8$ƕ 2AI{qA?E[JZA[m~-?zro]S\pef)IݭԻIZf>R78Oz۹ٟ ?ӈ $)#{mE†gmkvyX  /(gd~J|[c>Hs첞1 m)%NVga_xC䷔%MwA[V!i.{ܞL&ʹCvJ:jj[Ik%~6k ~;tNjZZfU:D}(?G{Sy;^63r;|=>#(sBIgҬ'aKi + TNpʐ36k)jo9/c"\͊9ލ&[I +cdX{Ե_`og "8x}4a}θ2wKDX%lg3I6 _~B1Z_bͽ bk{k{7ﭹǩԓyOaoJ8]scrC*tuĹh0.9ckƗc4H6JM=b}}dpUQ! CH5I݈Cuږܻ;Rצ)oYUQ.őH˨a$uOa JYMzNf';|;Y+[758֗*I߀{_[:ldZd]{~{ٷ{Б9Gg왫籪'îXկlhoJU˯"X~Gz$ne3}-tqVbRE2P"֍UElo~?z%i6P{!Xˋm8BĉQ ͌k6,sI-x8[(KXOrZum|] Oq\ {vw]_5{[HRjF ;b\{ E˶oaݐsy"C|'d]Hz1W-%3kZ"@kC/`qWUZO`]"k%wQH,u&Vjgޙ罞xϵR9 avi[1<Ż8q$LRnnӶLqǫ9=WW*~+@+Eu23h/k`-lV>s+lQ7$Ŗd^{!t~N5mcCiN cD}mlPRBߞwdl(Iiotml߲%?lTx4Hf/wRߟYq-%OietҸ6'Ӳ)l4^$ p/ MMΪ#I,e.)t**ݵW daJhoD3[AB޷2C$`3'Mm ^ɛ-7ɛ.L$NsH;y Q7^ǷrW!!I乬_ 1bf }0!_5R^5;j1!{ŽhΆ8u.ֵ_U;ax}[.5i_HR%[I\IZF[nhakļ%hoIx+ɂ=`~D- C]+F֣#a/Z~yWrh XNߨ ލ%VJ:ym"oJ؞,ޒk=ߎa6sƸc!HO;Z5 L}_ZU](ˮ;i-IqG7$0|oWղ>#.qF\,ppIwE!Ԝ4  yn^z/7K}㱲qpZlP'znN>i)|x\u\{>nfUߍϯ`@cF71>ޞr&'}_{_צ*:wӉ{^]zEﱋ:qa|vDMx-%{Fmȫs;M=m۹Ǵҕm8*#I;6NL1e-@JEFKc0S8}V+'C yIhUI'з Pg_V"*=rJZ= b$)N|1l%9dۀgxmlNXj s]dzȎ"r"WRCՄ yD+q[wE%]Bv;m,gjGW` LYV t4 7C{d9u_~#[ga;;~K̅:ܑY]C&ў$oj s5c:pmlN4ŝ!:mH~{e6!7(!EEcY㷞b=J¿BJDHlU_ZRh 4㴣w<޻GkSOWk|*hf)˂@ hizz-Zi"5] К >XA = !B%h3dTjW,ܓރﱸ64(xq\=rv%GIFQvZRﻦt6wˬW^~uw¸eŸ2BIUh$i]GBc4؈&54y5u_Uf;\iK8ک=GPOND׶CbS MO!_~jRURoV12ƽSmV_~;sJLqV1@NT9Uo YIr7V0Y7%zk^~ěXDdMð;兔K}SCHR+lXv I a巾/-4ϕT~I( zn"4LT\ k\lT$߼6?3Mc9$)38Sɛ~v(F oX';{~& oe7N7NwncK1 :QM"Sr$%6e.q4&韢a} ߬k|SHŘ\!DpoSRy6~Kf[ƹZמmf]{=+?VM7Zh3k`(ihdle6M=m[>ZA/`f/?6@Rw-hKi]",قJ{yҵ_~;wSp"w^5~Y~8]uIƁ y{hEG.pymmߊӻr2˲dJeK@#J-`֍&g[qU6-~߲! ڪtq{ d煮Y ;I+#Mz m["xf6ԲPIȐ^B dM$Ok3ڛRti^Yղ߮\}woB ӑ` +X~!*R~7l[-CkS8q.#IMJ$3The񯦮#IQB/c~y!2-'FS#iɜ5E+2ёrN˼6+^0SH+0Db_EZAumtJ}@ 6DbL5~ vS2:͡tN4k[ϗ?mb4V9{טѵ/%oĉҌ@>4۰MZnUnRڑIw@D{ϸumxZ[qV򊏏}v,THx %D|;IGWm,캒TE#+kpj8={Gpqrj6􍞀QbTNceAMzu \[zE/ĹwşA+I J Gzm{@w)$4IҫV¯-P({gdķSRʩö:yQ͍hdg!R,OG=[ߗ{bU}8(ߗzkW3]Gܒԍ\ǽضb $ ~*ˏ`~K1OӀ 9*Fy-aTy3bfȣMi^ [۹>™F]/8abʖRI.-mpeҳW懣lI#k}?~ZV@1=:Txw buLu<]7<%[bepkKOhvNiwTk1I;gSfޙI*y¡ 6ľm}?~S +sX }l]a b8MTm@\}5jm`\ZAwۧ?HZJ}lM4t*e6=[צ~ 1soX啪l8Y@z [IFʛ.}E{Sް~s9g8M5OD>lIJݙS$meu8bn"}?~;N&ܻ?kKʏ貭X%f:qNآO{CT>`۹s6gJ>)yFM(j[J-d/[wﰮ]էmƂ^Haq-UWC=C飃\$OM`em=Dǒ?Xl~'#R/ZYE"zVR d޳'5<Sˉ9@k,Nz+W $ Or$zf, ~ut{Œx1=XO>J d@bo ]z/2O ҐZȳtGS߀O! [IHRMyc#[ki Uh`V"V.9vcٖޛdR< I7Nܔ"I rfhv . ՑR10>h- V.6cyC];ԉyiN ]'kK_r2A'\{@}bΒ(["v{CkKOOiNx;/ %Vh%^QaP?q-gsoHzn~6{l3E+o(H|-EplSvR2қV0" {Tצ~6mQwTxeG$}18SCQNp$;JYlycyd]{Y~vUݫI &$+)mTݺĽ#N&nicڛrv}kOwZ Rwή׺7iRIURڑYU!n3]{±Z~młsǴnOHz~ R:8u~W]…3&i- * v-f=Vһ')mq+[SX7%~63_#B+XW/tg=W'IFw ZId6"zӵߚy:ǻ"z7u-ⷤ{npTjbo>FsGt#ڻצ~+ocCMywtf68 C~˙xIriއ8W4pzw4pzה_a 9yIq4d2*t$u%ri߻;)ǁڛRE>~6F{XL%ϓO&7oų{X\?~nkŴpY='ےlֳM[Jg1IۍSh9\[zEcKv;(ofޕm$#U+9-8P9Rumꛒ)pP x$ݭJҵ>0#I(a)LDya&췿03gHvo .NږRb? &d Nm]z5Exfu{]韻PV@B:'N' oTiKViQ,ސѓϵ_~ÐF6üsnü3pQ %J"Uwֈ~w~JIX~\\t=wA:$)9- ʔnq_MxgHR s) y8c!%iVoDIځݡAs0$E-i^~-0췾G%C•/0 㺒p= INo؆ܸVg˖8vіb`^.bXϬ?m)t~m}q{ޔlJPm?~ Mͽp"Q3 Q!US?MO#VTS2쳍U$Ўkj~{&W˕-X~'۬o+4$W %ۮ6;$)+RoϼOg'Htw>eّx\!qjj h6TK{S_ޫUӺ~v_'z (#I*Z"дV/* D[S3:_XrpR,|V߅N|~9%|8$VFצ>8]he9;*!Ʊڌ)&UDLIJLnSFﮙ⥞{xm׏if;sf%bQ.I>)ZV l1|Ƀ_difd^~1+RmN BnMժFf_1$-H.j|I^{hn\fO^8,IF֟I+ {Zt)d!2m[])v~_¸ +Xfa3\WJ:E6jڛXO`k}|F7'Oim_N}Y| 1E{յ_~+=مN\IOKv{h-aq8-=mߗMv3q(pE/X?ؒD+ ִNsu6o$啅ؒkeEkʎؒwZwMYaCސf}=gwaCgUds\kیfq*g/ '9kX0^;7luGsoѝ$`JW{gmސKzEwDVUbZ!U kU}SOOPJFvobJ(۶]coO0Hu2B҆bu6W+)?߃n* _o  H BsZRG(0xVeĪQ2iם[E"1ꖤ/~혟1?W_@)N$ Rej-p(6M@kmn)&@X&>K$^m )PQc%x=bkX~;GxXy'ST8e8Q( ^>#vlK6ћVNwhoJaj z=/Q ބ*Dsߒ-#.қWKH Z9ztIS,CdE%0ѰTIRoꈴ~m]!!dl*MRԆ~i6UɱD ^$QKLl)To,X˯~'K+2m"Eʴ9%qw_96K;@5lJސ)󰭧'V>|F>X%54jM1kNT~q8[ &u]{ 撐ƺa;3Ha7rG'z싚!qorWKۦMy+D›EV|#.~mRG1߭p|ioJeUyy|2Wy龳~U%|rR&5I'_3+d_aww f?yP%oIʪe}E[If G ilGhwEGUϕVUиٻ$ӽZ&"E W0 ۀlP}N/?~OQ*h.m#[ɞopu%l%NS'[jow/d㷾/8>/>/˃qMIQSZyU {G0;[coHv7V{z/aSr=\!WsooŇ`[5utyڣU|w+/]"Nֵ?~1Ev 0B,I =[C%޷7 }@Re}W bKZEl̟p,gm&)uhEN6Eu{lF5>,$R_uG_?ӖthhKD. M}FM҉VЊL:}akS/`wCf$j4 {;w1,30KfءǶE&vomm4>?~yYee\Zg7bLKC& ;"=/cX"z?~o2o2/4Cwh9I/RsI~rF'ז6SKxJ\/x@l:D|$$ V $QwG 0ᵩ_۽ i8;ԌZ*n7ryO<_B޹"X#=LK2XOOi|ɱu4S,Y2iQXuJPZџ)N!%̋$ecj51I90X8=Gٕؖ251 i4I^ӯ)\^8F<ƕՎѧJһ]Kʖ1JsE{Ujff؊K}]}_Sߗ/+l%}12m !]ߗbM Dѹ9ߑiLBD-[kSOhU1 WWX{GDA3q=`ض W-[6wӎ-6/x* mcԊ4/r5٬[VRB,jL'l+;ٓז~6JQF 'ϭڔ~2_E ;I%ֹra䋽!bldG*W dի$}xekV iEVh&l\\U?f޵J6wٗ t'­F>$#O ۲ E׆^~oc)a0 Pٹs]x"Xն>%ٴ3_E`S:lrS:.9|ys^M[J5q MHuza^!;M\S,6Hv/~$#l\پ)W$V'C buwn&NPDXEƂ/Xyw]پzޔ&ޭ lo-d͞+ll+D&.pQQguZ>Y8boH[pmnCl|9݃u翘eUWϯӖ;/fl5<ƷGE.}ջ]f*n}(.7[Ե7%״NFVUJ s:Mo :pY;yw2zv~58jTߩJ.G(gt0S$=uX%IhAɬ*޵7˯8{G<:svʯivLis2Ȍ&?I2kly Y>;t? T!o3MoO$^!3WiGԿw,~uADqbDagትA)\Wvܒ3'㖜IQlPe"o,'%uI gA˩tN9>qKf۱]v}٨oLp.yʹY)9W!0ᑨ1qU647gU>p?v'LȪ's&J)ֱjq0pK*YG [k׳) \n׏qVa!ҍe#/v^loMHTƒ17aY)!v(yNP\[w}ݟSkڛ_vL][M=cgygfvl[ k_=w1 J~acߗÉ_[; Jb3WTŭY>DjX1vl݅u)[8 bXg6(gZ]?j辉.vpNgL@:K?UW_IXy6?N> <;|͆C*0!BډjyZLgn'0hebliuݞAwb  } N?&ŢPu; RWT˕'0ϱ׼v^ϦlY TCBN-[(DY(rq=s(GhԶ+J۝zޙ,L؃L&$AItLԉ_8DڠtrŊlkPQF3묉!8%88S ϵ|6 _v"P\C8. T<-c˺pLVbƏݾMM`(+7cN]MKTnprWP6)+Zf]oy9*1!ж( y TTFD'X MJY}-_3Ə߿茸U\ 9-GUMffdnWu9ZgِRN>?B):G_lj*s<[cqow xcd}M{nLrS8z푻1{vQ7۝q3}_kL(;8J|wvbnƅԶelw¹b `@veD!قCHO>0Igj.!gw_NmYEnF)]]3mCWx lj$t+AZ*wANEu+FRqmPVtkvQn*hl9lVfm 63pKC;:Ǻ[oWToumm]6sbz6k vאJr0P#FUDp,? \B'gخ-@ڠ",g,ۭNNQL^ 4uwCHr ӫ^Iij%VVv~U14wcTӝQtWjD&pͲ㫬t{E4"wQAQ)zrNO&C8Ц^)c.a[nYaL "FV0MUeRH}uxvi)snckJqfT;^At{l_#bDkR҃6۝zQW'/.쫛H-J{U^DuOo&SV06j{X]ڞ{VŊ&m]سϸTRL\oz!dXp6ɠZΰ6(%|.f,^3,1×v9_j_ZU]ZNN8 j):B̉3*/;!煎Cwa>;ӶM,k!bde)?*0┭kL;) zSX@tQݮQTE 2C"ajg9fU7V$9}9I??xΏݎ]Tb+ވ]Tz調p>q{N Y"KJ!];M IwtճaٯU~Zy+jmH'DI813ϦvUn_SF$颰j/ySLԒ)HD"|x^f~m;î^ ɅpuH'(t>xtp6)8[ /}GZK\FeBq.zACWu2"ER^x-z HnlwSbe0!٢_iG ZTmTQʦ७ d Jʵ-v{OVDkƞ,\oY(CBkno-ړ=/#Veo:UӿeD;Q4Q-[TJ{(εvUn-*E9h?jD񹮻"gڮ,ElzX%Yn.*Ūgɍd \Ama]'F\' ٤ʉvfBPkveB05VS,~[~bbFJ9O3 J~멖3Clwº=u]|v ב\Y^gJ.zTk|h=?vpnu#N&3ԡcR~t 1vFZTba^]QϦvUn.XzpC_pmi_]LsW s_|焮zKrjK]]tг/Ò:R]`q/h9ȑxFKȡ@ޙjq^Z;00wYCWANG*G(fbfLlN9dtVř{ 0D]>ɗF:*:.ᓜx)^ϯg7MFnKVYT)X\A7/ XjעPVvLdƍAd%K̹֟JnDʕKొ9^d+2Jz捵AE.i[>4bWӌ8DD:V.Jq~hr9!N14y&#]ENu}:~>]#mDjZu]3Dɇَ횪ajl락?rD`&!,pd4;䴫 vSN'zǾރk̬te3ۋDXC9O>Rw wG;89)ܵ]ϖvI7۝}pxp U Ps ]kǻ- [=~E'ڂWݩYg,gtS<򫹍+Q5&-—8]Nneut>)7=QWS|yJ8Z;+l^6~v'=V) d[1رPFVꆖ'JJz}\gKgحFB΅1*B8jg\e?/u\ ϖR7mLH?%Lȍ_S)aBQ0mYw ~=cB„oܸk=MC>`8jJFTv& 'w'۱ Vm-{ZTO(.gߕ(WQ @]fvl=;2SX7۝Mm@ՋsQq˛&DZL]Hڤ"Bek&3S1s8<%ev/8%j9DD!u1Nk{>MRUl[?vrGY$r.&6E}J(',Qu!g*;[ݽvƳGv| 28s8R5Q:_;FPKj@m)NijƠ3;)>F#F2EOHǎB: }֎.V]HF5iWvY~S朑_QS"EГctI"x~J *rElk{xƇ<Q4Jos3e(]ҭKčDi|j ϖvQ7m<_zߊsx"J PޅEP5O$p E*,1*ݛpi(QθpuIUWR,էMkwْ.f|<2g?`eʇyٖ}O!8uEȠ8Dkٔ.~Wb곈{*>MW1!Y`gd_к(ym\v%mfs^ѫ؍ c=teyCU!uIyB8[C+}I)K1lt]}Y2pǨx_F7O1wglư}smq&=p/#\6gGZ[veྮ>qqz/ԄSqߓO DmpI]i׊+@''Q&~~C3s4˻Y1u4S(6v[vugơMˮkRNiuݮQ½(/1yrElwàcaX 5%^"-1j_qX-t?!k8̶| c$0Ah@5F%@DVjܮ u6(}Z"~6n Ѯޗ+$1uekL=*{c'=yv{vU4v;po4Y8LofR/7qNڑM-[8LYÈ2Y5TG$dSҴ,%I\j;,NFjm+ոWf Qs>o\sB bXMTo'b\ڠt2ρSW\So*ld닇/gYa^W._8x]6z#ؔPuݺOx2p诬+.[U=j &NYxE[<oYh2G| 4X)Jt9e)@,ӟlὒOy{^kv;?kHA_E)ɺVq (א:bƃ =rElh0FSTsUߴ(:TcZF .T, ^Bv #`ESk;&gSNv}~]?*׏+D~^Ef ]Q~7ڮڮӳ)_BW}-GRRTQ5I;Yꑯ=UmT]Ϧ|DoM;aAIXsKCQ$`J.)cfTR0*acSߋ8]L[QCT[j#}ѭh.%[1osO ONCwe۲nW^Xu ո6(Urٵ?xmawϢ)kGe喾DWs.;&9oF[;Y4tbz@m (:_ȹڲ^1 Ga{TrLr.nㅺ ϖvQ7z~bM9n>6~F䕼ISH /G]R=k,]YڞægSNPlϗu9cUr"`u?'ûG@͌eUk^>hDvz~䭷kޒ]"ο-gz˭#Ώ-a-@U˗؝b,ڎcK⭁3c6SmAͨ8%L"F|7(vmfg7es/M/B{y]'m]ڞgsUGe?v~1)^q@ ct8_nkjL"hgSN`5TVOń Xq{_쾋1ݱ3i~D\/إwx=E9~N9lH3YoSKg$ yB?C~wYb3ۏƵ>9\r0[e fpr&,3؅ۺbBCB`R_v?yQ3QZMsbm/.Α}_FP bliu#OxAydl9bMq_,%r{e]wo@oE3nDf]]@ sG38t(.ƖN_׺\*NۆX= z.nSrm`JfC`[ O,Z#ʣ2''BUe<ն|PTLr.b;YY=ĉܬ,wb5QFkvF#Myn 4_|Q9CɗYU3s'41csڤsRf],2uiQֱRs -]伵sz6M}c؝jX9'2%F| yn%SYD#Sk:ٔwuLv'|B`C-E*٘O4'a?MQekj%5qՙwujTgZv;Rb.Ÿa*=FY)j|*M!Ҕr ZSli>TzEyx.h-}s~Tsߘ9ݚܷۥp&}xpmRELZg~^DF11;xF8G %zLHЛE=e>p~ #I5!|c ViyrnܐnK4XDE]*k v{laA-mh6OW+\#ɷvc kGdʊA铯fyTŞc1&"XUT\cOMTqfk 'ISCxu؝1Ķ[Xc} W҂EiU*(gJ1vtQMil $34+^(Xm6kƹҳZ/}̣Wr kY/ΫCUˌKg+u ;D݃:W}R,M*Ұ_v e9솙K~cu#O)x51KI]<;䴋- ~že鸞/hQk8V'\qvmy^M9n[X7W#6@7A| ;:K^89Iݴ zO3rD4ǟU,kT!&TQIݮE_r; ndU;7 a'i,)S6R)?t@]R+ęek^{F?J>]al1Z1zc򕪁Ӛxo*H.ZJwaVcC]M9:,gjs=?v;J$g?q0%˫{FxW,Pߡ+j?Zo].~ٝ9}Rp7{,W/ giռg3 g~ٝz9-C伩/8 Mm蝮]h>f]#jliu 0D~q&WP*]2C~uIńnϥ8ѳ%]Ecmw»3B؍>'# X޴1 /!eى}מWle6p氰Nݎ~wQ2ĕ(#Su .͖cIn_xCb5Q|uAkT}mQq^_C%n+j"GQ~;D.v _v7ց-mF!mGޢti(0.Ny굼kj?vVw\G&gm#6Ʈ܈ )%Ҕl*gՑu Jqbi:["{.uIuǓa53=gҮǮluLjPNc <=`)wp-敖,j"ѳ!Ӯ.M z~8/qMD:Mh'"XTɪ%QsEuSpi=$ }qnܲ?X![Td S017QӅROzz65`dΏiOmb\ąpn0༿/8' A6MЍ817qobWf2MXʉzEݥꙄ"7zu;<ݍ"gwy$y[ ? JHL@׍Uٔ.f ƠN/XW2Ex)Joj?.4.Rⵛ:jF]v{a4_(<(fM ƸPw.)gjŁu#ca|,aeyDF; öQuQʋc9 y1X,jjEn/ FOAMɌuHiD {tS-9xin58z;a26u" DmO[oa k*pzavIvc4u,Gٝe^l"#z&2b z/~CWrl<8k }Յ FϞjoحw*i"fQ}Uz_fSwUZ\SNkϨ2׳!]q JUW}* 6c(g u{V ab݂'.EUf[-Yĩ>ՏnoW.6pBWT9"sQ?x[!\Ҥ79{CyE)~os?T;8MZXkWvAn,U>r61^TbWrJ+<ۺGaSȈLF{ѳZ7m kĠG|Ϋ1r}y}ODYI-pZEvSϦvQ7۝lѸW9mp>'Q<Ǻ=wQqoac{4aB}I#P}'ۃN/澅Gt\U56(k9-n5$lq읉<q6B^?gRF˱nr>Q> _v{j2{E*4'gĄޤ&oZr[etvsBضluV:5jlOuE-gəʯ%ِ.~|ԟ~T+)~!% 9ņY+]R\KVAر6(k*> ԆsQ:_;~BW49ou;?vEϦvAn +WۣK!۟V[chcx3 m]R%lMJ~ [vInǔy\1Yȡ:Wa^SX;v&p؋D~ȉ؅nMm|K{+*RnFR1ph+^QqP$]cӳ)/Cc/9_!*~-䍓t+*uĤ:F=:~ƇI8U(%a/EbwH]N \N_KBq ?'kckGQXp* N [<+źE6+:v;vfD9#Jmޗ~wǵp⠞/u# ӧ.)‰z6龡v:=rEl}F?|%|9"_,\> w.rLnB],?v{3bRٺQr83c˸*rVRTWrf^uy\:gSNS\sqTzgxܓVʻֹ{PJµA,:l)tv>u} -D+ οpȸk%jDGV!X%fq]:`k~:X ZQÈ֮tb%qCq%70v0^|+ѝӓ4]3I_<_Q߇(e{| &5>8&l^5~RVL5'7༊D Z,Q)ayX"*crjX;l{Tc} <aC<\<d0Ȭjj+iX;e.~mCߋ8Qfֹ~4D\"]ic\Ǎg|uUya0{|>Dc(8wͬD@C4t?>ʢK#]6R^LN(x** KTH+Ttq[./Uځz,]nY0 #HdBGeDO(Z(Wik]kmWiٔsK8ڕڢd4ۢ9+Q)AN7Nb0n]MNa},kl'O?X򋽁Jt׫_-6 cDˮv8+9zγEp,w_%uZBVψAd}$n[em%N ?T5" y߾%\ @ۤ[.E>9cv/I.|KrQP&{;ޜ.XDRm=@Iڤ*d('zuSČ$?pHMP'ԫ=/1uk6@6(fpn=Ux͝ݭkkC]ȓβn.O+",}cJV `;Fvc1 [<BentVIWal{ T(D<}Ql!J~k>Hp?9]3"# Q#۲vuͦޓwcGɊ {Z+oEBey[hK7~3l#ǰn?O{Q;!J^nw%#V'tUI.'צ=DKxφ\vAncKKʎ8,W>ݖwj(&NL yO]gS7~vAFZ\p9B%)8ۢ2t5<23#傡<\#ْo!Gc̔r$ E)ȒM:aS7SX;wbΑkN˫Qz[D7vv9dX/G=o1!WKF8( ʵA_ْ.f0^a:+3q/uIOA PEdD JW8O-w;'ܞOCptCԿys`@!4:"j`;֮ v,;i**5Y|׮KXOwik0KqֳBW؂C1alc/AUIV- \jd[y8'Svl6 ߴ͖cޗoaG8/zX'An(EY䘳+1V{ uVkU=e`]F_?vV$rl.(iM듏3.mHϦvQ7z:wx# |AG1ӑuFԪb8~ŖBnc穾PaA-OFTߊƿ&'`nCA_7P~},gb^:'mW8X'c[=!G3gw:g$ _P@>SW1RƫkJڡ+F8E~'p/߲\s|olv4;q&:0DuOeE*e[?ɵ+liu?Wze3Qdϗ.9Gsk-aySpvu Ǯ^qп pvzE)Z %jfqп&ݪzE[l5 _v;6^q- ;qOxTЕ!t=!}|+rj#+_I&en;A ֺWk pU~c%pZZS5+NVQqg7[ 7_AenM7%A^SrEPY6(gKNN1l3?Xj92Jw oV薣<.f buπ@r ̮d9DzYU:tIUG^I=~2a4FF(Ģ1>6q[ǸWvT}/Qڙxb\xuXTf#ym漱I9qrMT_qz MPWEuƇ>&^(w yxr 8(*kgDϦ|jhqO9L/U7_Y4a$jG8 uN1UAή*$̞cOCwCE^SCl+jz9CA7Fce1vTc딘1)?ؒs լ"ʣ*HȘuStߝjmRjKmu^q^&͙=p4աOjn-XZDMMySecWEлJG 畺@|abȧhj^*ػz$PGyUgE?v矰5x^rߎKh:3Q;t ng3Y75ř' ؓ椎9Eg.{zi)MkһϷ4[ /+ lsBiP\׷w?.]Q˵ E5/^{zn=5ݘƷm߲!/4ɽiS{Ҍ T6hKjyuއI;/# _v7q-vz)/N[4qOrGVQͅk<{6itv|(Z2F@ w1/w ,S&--U)gSjc+9 ]݅l,c9'Q̓qUƷ캦fNJ'ґOJcF 8%U%m_ϜrϦvQnNŧ0QgxݺqzY.b m=gSNN[hҬpF@jWQaBWph~ˬt͑>rElkG/ӥ煎6+[c ǵ.NZ:™kwcYvQ7x_:j |K$!*/uIU.'riz6 _v;Šaӣtǜn9j YurXOiZ[;]Q ƹ_ؐ[16VQ#|7B&ŵpSuDf}hNc{b-J"߉Ʋ} lvM[.o\#)v[owE\WV MT.J+]S,͠ija9Z^I'׽r!&jHn(]thQCݩt1{vn3 (XNV-b!dz b {g74In*j0gK$Z{WgSckQT;JΖp}H;o )@ߔiKW;yM;TgW(Z gοItȿtL7mp\S-_e4Nh&.괵liu>+m\8Sp\%eeLݖ)N8jw"g71kncAS(u*#JY,`y|C=:x@{SsvQ7B\Q‰YLJCtQw 8Mk_[G!yx.f~KEB&t'cv ѭ J=\gC.es5\8h/JUTįSOj){,(L.7Ưu>)w:rElϗ9>33Da٢+98jSEZ;ȯmݢ9#'^c.fO.<Ofz.J/U/]K;CNu[q^:O.Ӻn_X0{U$N+h~<!ӢN 蕮(o+ȰAXwӒFnϡFn'Lh]}%Hw_k/O+1,.f+ߟ:T5v5Q/w5tEizkliu݊uܹO,9pC hu̅ 7P+AUtQդW,lʻjZ>ɣyj s9}Ⱥeһ_\:mUrƘ?ک>.Qَuοp^f<:.t&妽,G._~ ?5]c~{tN%;S_k뒪Sƾ&f9n;}޼? eE.aPFe"J(F {*k{6zRmW¶vMoEtSn"kgqxM9;v(z͙:aoGzڠ)v=bc.\Lx; HzͳҾՒ+ci}3&3g{ٔ.f=3d@驥i ^O3L,S)"NbmPayD Oe\r5P gJ.Ò.)#{C#gSNxp,^~K & bݣ:Nk',hqr~?m`,x`3)>m V1jD"q."gSNgO> 9%GYu'LsBGWOT.{%Cc !XSx7If ZWwF5nuFfb~='a(Xw%lsI!ՍM#6e}`nE-M.hzv q@"]jmٔ.f_I{H=,p6CCO=0ܛux'E0dM\z]C#nux#s@4ϖH;QCGVĨl%uFjԞ1ڴ5"Kklw`Qc!zμEEfZIm%"tc٢"s-]v_ ~16N qgdw=4 ;N $q6"leccnn9n}WF^(yY[Tre%eBqP+݆UsZ=vu!Hs%jpdZ!E=(@Lo7`kmR?|4cwE'dq PtRNwTQWTL[.QͬgSN鳘'g @hv6BlekX{芚ʨp#&0cEL{K*!9ԛ 6h7[ʧfD9,Nt1Ik;gSTiqݟY**bOZm_O?_x?OU_׷)k#nw?_vZђ.PQm,kr_GJ@uPCo/ ݺnõ>OWG@u ?&ȱ5tIMBPw֞Tѳ)]vC] MΈk2!JhY#ENCUBkKzvZ vNjT9C,/ =M2/]R]ഘ']cx@w!J.Fm?%fI'rmP;}-9n׾ӕ?/Z׾2E {eCTsڊu|]",g ?mýCoJvҞϭ]RÍ䄧A뵻쮬vqutljysD)%BW Pmʢ[$lj];L<]axr5;\7R4Zu>0rr AI+޻(}\vϐך>mDZX,fzkG"/v0q0zvJv~E_Y_Ǻ,Q,eX^%sy׏uV͵VgSN6B\W.>٬%emq0\}];Eٔ.fu/}s)}6y(%oΰ.ցTCw^" @T=[rEl $F9|QzMDg '5R.~٭s\q0?L+w%ozZ>>%1Eb \=skoU" NE̯w_ ;L_`蒊̋x!tUgClat '!oܐ]]R'SH)vu7]pK~mg߯OZk~!$/-]RDEW֤ lat7'J0n3镠wܞKjVj.Q'̜U%輙E)tEl-N?4g[#MJwb튺KiBH#MJB4iún/]õ|b"([Bj})ww6nr j[ԇ.)N:mWB-tVXln-'cyZ BN~mxAH=Uzj_ā}8 ?MTt ]5tEMߑA4M]sNr$NeWуzgn}OA> TJ(EaPǯb 9~a=QB{PŵA)y䴔n0t#(JTLL*=ybh>oMfY^ ayE>8Mٚɜ^ϦvQ7uFk:xC}x;qG1Ue. p%}z6崋nkE$r\g\20۬P͵[M޷݆=(s"r{ڣ^\5-)(yBW0,9ۗ.vsITWj~٭ [|XX^LA*deY71"phts1-9*¬ړ;>qvߒ{jˮbFiXuZvz6]>?vyh%{% bQD'5IWԊ8;ntGLiN=+qa:ψWu%ߒ;WgװnWF46VbBQƽn1؉HDܶhlGN119;2^^T$^fzY i?vy9"%5b8@knCnճ)Oc1pE39 ۮ2x$%cق3IE]`hJ>rEl/D=LS};2&,ug!OtDu,Vp`1Gc(f9n?lޤzg|O1ӷgOn}j~uy!g: ^[C7(3ң6x;M9Q g])s=wrҽE(C]RuJp0"q>>[rڵxmc722O9Nlj(A.)gS)Bݠj%z6崋nŸw;PkT9bX#uI/u9klatݮd(>FϴFe ([]gH]RM`tѠGEliuݎ<-,^;>'Q\@5#$}6(ceKɉ30?4p:56 ym8MȐ[x5)'NΉ/U|r|4Έ]-U+/* J9{,?)"wBwkɪ |v<2F WD}y%_M5Qmf 9QaNv[soAh~+'϶կ& V?fݪD}ݨ)ԍcwAc‚` RoHI蒊Q 3,y\&:b(]v^o#*yojF)]||.Wq$W;k* >rEĺ/i' tu=N뒪!5\{&ϖvQ7{e?TƚH`޴\1֕[7y*@qЇ!,*@=߭?v;4yi1Ե:v?8~9>AxRz=TEDn`1QV|/҂˭(*1O)^gSN7mw[nqߝ+b~ꡖm\NznU"n9C.n_t'qZEu5\Sb@ XʒڊMd OڠH2aǖBn0(|/̄|/hꃡz^ayM9n[呇$mq&`;1Ȋ YpvC>ktc&jD8ː땈ݕgS~I~ٝrAb= 1Fs2o]Ei=JUMboSE}n>eshҞ_ݟc)[uAOw+VH8z(Z|~AOun` fWG_rW }YGmRunݭuެ;";4EdUU]vN/$ǁ{w= V #ge+}u1@Bkl{݆:cp6/<\V'+j n㵍=gS(m\]}?x߯($l= ʠ4 ݸ]4]gSvX"#9>LY 1,hJTA 3svRϦvU~K :5#?ê-r֩ۺ]ʈ{kWwe}/.~w5 P38L~sD$?8>uI_ y֟nvT߸~ֻώɜ){8W΀1嬛(#j>t߾k{e| _v;v1X4"v1p qϗP|Η ;KG4DBIH=f\{zDCSnKKKl1'viݮNuZf*n̋jhd J^Ȯy5wv{cl;r|YQEE y-8+j7=YϦ|)WƏݩTw3.PXbOIJƒ3Kk'g±.괵lʗ2۱p#69[ "%m-FxBpB(5tA(^gKNv8syA,uDJU,+ݠjJkO8aW.|[*n/lB%!/'NjJY3f:zv؄Qn۹׆xʽ6+E"zʽbݫڀ{U^.1 vˆİn۟Eu- :n?#9O-)eV Ju]h^YQ1 v%F(KߧkwbmSr\q7J)_eoz~~YŹ jh xU]U'iL-侧ꕕ.*k俻#W"UYV~Dmp,oJ_Y+0؇\vz a;:.}w{wzGty"*7Jns䃢;/vX5sJO9%*pCݢuɞF|YM94RŞO^D6}s0Fi_,/B>FMe^5G"6;9wN'jKϱk,dSJ'nҕ[WY>X_Ȫҗֶ5G>ۥϽ^{{븖OyH+?Jʏ ]9t~n<2$E^< vo!8yb}n4þŪ[/6n'gwquv3̤зv4%Y'N 1d)LN6{fYJs#͉V,+ٱfVM1z׵1y74wm\EF.Y:dOʊDUEç+Ckֵ9?={F&ll. 4ÊaE WêvYWEd%qUh'|P/^|CxuYz3 XLHtFT| yuYz[[v0ОHquҚ,|[GlzcZz^f%sBZ-G#s00a$KJ 6A ^Fui8 թuo0#K޲<}-Y3A^`lqlkcƽO܉K-[y-tȥe*FX%˻Kvx.NJWߕ,)X|OXzW>in#G[2IQK=M%+)}s^ P]n;ݎT kuۣ/o}~FTŀZO~&)x&Wrg1/I>r'rO`v1Ww?GumyW5{S,pfV,yz#+Fioܩ=󌫆6YxyS65ٺ4 $p'ʜi#`HK=p6|62'`G'c UCӅ(L'Y#vyD|bj]MgB$q\]7M@ӛ&kjץ}ckYJ}s)7Nti$6qʊO]IVsP6T!*=WVGOm?q`C_en~5EmZ^D?]zqU:n^Kpyc_Ns,ﮎsj GF%WkGc\G9~Nu1:_D2"mRTR .D9\۹Qh'nW6FM"˱Wn{(2%+r1R0IbvC"6|Nxޯy&rz IړhQ۾{9֮е1wb:8As;:e76*aeڲF+ik7WjCg?qk%>n?ﹹ|b~aL EycmXU:0}{F&bEQeglJpºn~wڜ>bd>84 ΐ|i1_ GU22Ÿ#Ǿ2֚Vx&'n_XeXIdmyB6 'KoExBMkw/Wu\q;GE8a|ҧ7Y{~:@j_XS#xїo# K93m:ңsNx~Ve#cpQoVوOŴ{$k,Uʖ}-jZkHq;ϯ<ӧ7<߮F[=nidJN뽯d;{]kOo$Zqysd`3=9ztYb=ޱ>:NRBKR1G*vIKJu\Ug ?WwA{,"}fqP<}:'3y=O3,j( uͭ;Bj>[l gC=vrdks>ۼ=v7't/ڻxZ*@}H e_v6 gksٵp){/j微}u"˩o['q7ǭ\ߔGĔ@՟:jSPʁJ筠*}jfnj7+}?('ֆ +aoq7S߿~*5 T0kr}_[j kG}?50O\h\ѯ'Ȣ?q'(v:#kVR%gdUL9,#Y>#kd[Sݻ@vB܂7joBl;XI $?MfFydu+F\aV/'Z]3tO'VW$ZB,x{Y3+սN,W4žx?^{YcIfq¿ֲii4o79Ȍ6YV#|}#+umBZg1d4siZ`-6Ւvv qmOO[ 'jzo.T5qdR$˾3Yn||S5 X94:zu\q9TkdB+yG~U91&kDGF".vs=*!'O΍3CLte&2vDΉ{׾vq7޷TqP|J8E&pӵc(kwo('n/dέ_Ȯ[uHD'[dzx~H&ŎG#[̩|yEsRo3rB@tm|Rk~utpkIG#8KAcڰ✷=AO^SFM dfϖ燰n#Y~sb߉s=݃kk͡:Q#Q>Y# }FEE|@ϦX._Z5yMԠ{ K'1:v߯QiE痫`BV|ꭞb9:2 P#xtZ{H߯FLՑud:RrYjPD,+jSL6ݡSlqjϖը?xo㓇:+ӾSؕL/aϡҴ{58O3%#=GnSv{>xzGȒ>2k{3%F6'Õ.> F4)w|%$+kc^q+'swYOO| wsto,Ja 6GW?qbG?lM--\d^xb1Oe:v[˕o^"s{UbT{M7;,3IiLӇ6PL~6rSR+`$4#_% P#Mge2]6tz[=`o#LXؗCoFS{e !)39-kyoϧ0yN<ɒgĝj|L[ɿueE&r| Uŕ) >k&[ߕ|vsS3^-xW)C}*fHK'|'~\ޕ'o3~b1ӥ>֐gj7|ixchd?oWڰ׸}s N-okdƎ)+=?B/߹^;iڜ_y6~L]'Zs`8{Xk53dcؗWY̨e2YU_1f3sY7Ww@Qx33Yw@J m+&c"]8wU.Eut~y]痛,whiakc^q+n_xx{5D=\{kiŎGkiks>N37ǝ:ٛ=?G.М-v#Z x}:C×ٴ*>ŽJٶOm~+yd/;{窷sn+e. f5uRid99ϸv-iL/W;F }K]]ѝFClvwib ;IK ]`縷/C,hK{{mڜʦ/@#. \9t21XQY]:/)3zn-26{B;q}7XTRJ.^l12FrNDY嵓M r\qȄ^ѯB9N:]1^gȤU5sB#]>ԕk!-v~+b08?Ϳ:DIaǓI# ȇ&vv L" E9?q'^|;inHS}.|cLnB%X {^lw;.渵v ̽FށW(`Qkf}oJ_8B?}ڰnG6GZ$Dְo۹qrq>}N>ol(4ĵUFWncmXʍy%cH Ց5yc'hh9F/d+EM#/M/kG'y߯1>[*xZ>YofL(CʉaE&}hDq;TGյ$\dQK"`w2~Yh# _tLjmWZZw\qlNe 7;diWBt55O>۾N_|S筳}sܩ&Np}#$]k@I'XU$ g(onxۭ/]I'1o[8o`Ԥtޞ}_Y0PP!rKG?IvX{M|Xzvb(o'&9CK/ˣFU/Y=Nni)~Z[V+n)y֚W*X Uuӈ,j:зizT_(e.$oyFf8[X2#K{K>).wDѓuP3LQ2Q>8g8|aiWwB_YomɆ0[pڰxg;qFw_fC m yi1/uddY+M#CYޙ]ks)G{O܉+SyI/j}_X'x'+vo1RQ Yks6 W ĝzF* 4&szKI=?-r_F[$߮bi!*m:.渍S#xHI:y$LjSV<$;|~a)5)}sڏWCP?u:V%*1߁,sj<%#N|2۵O#@n0[Xy2ӗVUIZXֿq\I5&wEQCfḣIMV7UvGkרYڜpPq:ѕܸF:[> } 7?n6ߦнRڮY# k;ksJo[CJ'd\TWe)y=%Lߥn~H4:Akz;x67@^g7}੎;|w]3S`הPM̟;|chmXۛ n呁wwSo=z]ʕ,3$i*[}XFNIƼWܮoo$6GWI'owO"ls% nXΗoUj`B~d0v5Y"SX;ɬF65zFs\q+7Ȥt5O;_7|~5b =#EOC| _Y#5*۠t߬ẌMF&z:amm[򙬤|u!KJ#z햻2|[̪?qLLcvm2Uwa*'s}k>XFF.c+J}[`8c'B-"Jֲ[ f_յvb]q7~1hEO=+u(^$Vqix&`ݏYgżW΍- F%'s2X|l.]B%dm^UU>U4}Ikq>q+nɂHea82^ Tp?|ݒ2^>nVhi<%Ny@0呩 ׍.+Mu,%i$_v%ŵWVJ}I;{c?&U/}sz`FTI:{;[*ę*dMsuUMVog ek'TK¯Je*uޣ.u3ﶄYzӟd@i÷+'zE=3ֽ>؇1'][BԻ==E5j*O;hac%wa)3?F~~A·I5[Na4/0k`׵9ԽROܾ_~{}~)&6N3lըb;s\9jȣڜHK;]޽CTx&;lPax6 \:OjFR4fN}נksq7ǭ娪U;xhٵ&&-8e;;P34@K K6b^q+nJRc~i)`Eȃw)U%Kɫ:&bmXD4"j{KgrU_fnq,Fl{bmXtpD~2Pʍ>eU4ȍYҝg7\GGs5.s{{msq7ǭ~ʯ]oǐDu )y_ z[u~V6bj&Pk3ksGUz>O)5׃x$tϚTK˪O`DS6,5y%wǞIϱ{Ό[;X}i9o8݁kۯBό;:KUz}=Y=NCc%qTH jsw>Bq! rDd鉚G!N=vdthw5]vL]p*4us~3x{aԤ^YibN.J۷Ƶc6:L~LPொ/Fm~9-4l|xL֯n8.渝 @:+P΁'}d JVof-x'n/H#%_xܚ,}|5 15#*o=ν2 {uW);nJNeeNfS*:]v5Sb&7O_syշb wI3OusCI=P`Z,=7u`vdw#፲}{e*dWSqCTNik_ ϩHXvv؉SjkʇG8v\Ni]cfer ٿ*|BOxG(<~Fks~ xO?)᝴QI`Unb׼:ºdUg|-ZVxC~ߟJT& dۮ%훬c%6xqͶĵ52wm5jֺ7/q'ֺ~/-<_Z|k]y G uXkm~3&p PWoP75de}i7A#/hBQ!vY_s/V]$ntb_Z#f|/޷Ia8Zak /fvqTOx~k@n no~Dwrf|`<voQ|?qR#CWAEHpOWazKJYsB獵az}r_x7qo_0w|w/Y]su|W |ں_Ȯ~#x2-zIV78x ?\ݢks>*o!Jv>~8̧筅,#M&Ű/ؗj|?qL̽xMΏ[I0'pn\s鸺pA[ 4֌E#T)@\I%kd9, e}s>ձ&&ི" o䛷}-q~v\[}F!=q*=~ w;ɐDKe_5YމZ܁_?q s@Ue懭΋Nk2\;vGaI#dK` SՓBį}ӿi"'vf֬'>aU=fXLb qΏɳaGyb5sȈ(Yo _Ǿ7j9 _qG~Ҭߡ ,v\F/_bVOoU\<5Pks~ ϾO[=Vg@f_XwWc5z}RC,z횻|wn?qf<,1.Wo1b}o'Y+w\N3}s܉_#/Y/ -YF:&F~1ڰe$܁.L?q{\"GXkxOZ|EAgwUȤ[biI8s>g#W {y#ǵ9ϸN=xm+9rws89ъ,=/򓫿+kF'C 6kS߯G/Wo'&Kϱ]~1T!>9]r_sKRꆅjGlZ_vqe]\^[}mzF|a]0kᎏu%꘤zey 6|Œ@_8'ޓ.D'VP_8éRY^:#v"F0d/,yE9{YE{WJ Εn#9nk8ڜg\q cl[zELL gh"OZ(SiER]bq+n+%T8/u(6\S>||~Fxc+N痮99nġE8їWvXc{Cٴ_[5[2U¤טW\Mvǭ}r%}k?/VO{~Ykg޺o;GW5 PSR|]J55B]譓z8j+.~wP|+ޕTWDjkCr_j5^a9c_jQg^x OV5$G ]=ybI^E~6?;~}rsq@ֻހr/jNEXk[}\kZ)yt&{F۲o0K|'QDN G6?8 M2ۘ>`ӾC\/9P?]5ֆntG [䦺9HJR~LVty4NՍd 鵋{jym7+5kBf"qyIcVʲFԓo}xJ]oks~IͲܟ]g?XFJ>ʊ<|(fk mZH|WZ..H⌆#B$FrHe*M\:ڜ:! |>|ס7Y_>X"җw xwkK5ϸ;&y1N~csd#]_^Y{cp]Κ-/z >s\a)w1痘szdVZ#7ΑT핺WηaߣJldN _9i6wX/lJHIr5<1yT\:^0Dd:.rP!FE4 FcetT[}w^6,aJ|Q=s͟U`1w:3Tc<+K5S1IG)z3Pю{=G鎋9 !VnY$dhV|~kW?r:.# e35?ŧ!],#\42/Q~+14NyKVܧiؼi{GXy÷[tc'_q}6|o/oOA?yh{ͷ`|IVw+UuJ2ʪZn'בEw AkAc,nKJi\) PeFoW/=kfֵ9ϸ6w:HFT8!},wi,W쟵aqmx̟#V Ȥ7K֯s؄ch!cڰt6C>K9+aF}6/=vSYdYR#Р/)+um3)/-F/UEg]}FW}ҟ/_d6aᯫ~uo?o'nK :hj%]t/)їtQsR|rt*1'wW^e6Vd|t"bPk=Ճ?,Q}iY9D#O@;| TT$כoR,'nבVA#k(1#HL%ٕŽ\EL%O%Y*˵/rZ{6:.kOFޅ<;߯OUcߗxz5]WkW|6Y?q_p#]%ՕQEgJϖߙd5be·@kG2]-0W{}|:>ϩ:X@DL k哂k'#-̲~6v#1/O3+} NWLlEPn{J/OSRd9|o(QOܾ_X;"nvC^ka78Y+5LV7Jz&^y҅6F7[CM9)e!&eY9: vPM%zF*ՃƲo"&6v4cL.(p5A9WV]{ZBpH]Kȸv=Ҳc;"\ukA+%Y=*i`k|lk;k3t|SO܉w4ydC]X:Yq]obJf8U bEpIg^Ч :=ώro[#WȬ\囄5ϸsJDNxg'Q~?8oc⩶ks~_~}F~Ȣ/47j&2';u^CD8"HeWNvpD#qr`/+s:GT/Հv&U#Mї, +n?>% X6y-<>[<֎OĴPXNg\zE߯wޠ1<#=ԡBtieMmt[*q['OG|m_]٠kso쟸_Ro\jOyjzt~)B|^Wѽw3 5۸ !FTf=WOM~1yDν,14S+F7Mw\=k!_:䯊]ZE%33tMֈFXſ^[/q7}2d ,k5񩎗fu$ky_#u^&>kq )w:n?ǸύGTl@aPI0iAf葬G^Evaz0V?q/nXG4F-x~$Xo@"VPܟ͟T_RW}jEWtu1oT}Ӧr?ݼU}s_ȩ7K/+$hst|r5ZBf ?Sh}s)9퉧RUţVar'kF')!{Yq7->P_y6Cģ`Zz< _Z-AG|D/~W\ۼpmx]d):?Y[,ا1W[d|hNe _]giw6'O#.*kr-ɡ:d/J:7n+8pCH_侵s6rg, n]B:,=gy2jWhG|A_6ֆg\gKŹޯ878\ wIOI_Y%N}jmX2{bqI'ǝ8UXse'^jOYggM lڰ6">9SS}ݭ5}tw8=i_N$p|ς#Jڰ\&n9n/qCi)HBG>g DM_Y9)xGw]_~5'naj0]q300kӾ00k300kC~ΕҾ̰yRt|ۍdFߤ]\/Wiq+novX"YO|Jp~o~h%HO#nw> kkq7ǭxUejpK6OoQ{ )4M.G0}sPk[R|@;.c=4iy>؈%+p"|5]#_ tWkTo{1MÈ N&r_/1d5,uREUU{u!+ L=̏]ܿ̏mt3?&e:wR^C{K%{9R0~&jcW{Btmi^D-pB> Es}-/;f/]g&Ų/ B~~VϪqg/)k}O~ ?Pj`]Peʊ}FmڮBTiPő14wXJ{\ރ7V0zSNƼGۿ1*֌XeA4YR~ᬘXJ9,ek'R^[GNX#Fg3_.dZGL;Y;|#B^B]K#g7εCLڕ_Im(kϛՑiR9n*LR)1ߨͯLVJTH`)^|g7!0ħoٹ N1 ikF-I#Cv=jI6]ĝ0< 0<̐g~#ӴvaɨJ+Йflq+n \0m]~%'YEjKMF=Mkks~oO9%uӞ,r)b骪 N%y"Jj @bޣzfnrT鸓nBpG[*]V4KCG-ߪ`{z6)}/ ~y|L,PSsQT%Y#OZBk_wu yEw _yHW h:wd#lRe>5 v"$^rm߯</+u rI{?mwq"qr/-j'℠Bksq7e&W56MjDOz5兺..u |YK+/q7%qU&ޜ D*Rp Ug"NUIގ#- 6KԨOܮQԧѱ/᦬u/]'H5wVzcKumηPXY?qʝA(V6Dag+U/s ɇ 1uCwYҼ3vJ(81֚OdXGrky~VU9Ƒ)z©Z6Ԕ%o۹ E >Px֊=P.^jݾ3ppAolm]o_q7ǭXRRk/b9Nބ*FP|P0 K{ϵ5O[8v ]P[]P-Y\t/k_iŒΝ]U|&6H) !ˏvF}GPF/vmgǞbIʚ>UZu6`lgݞv?q?Fxq;X?"GYQ|ok2K'ŌaI ٘DSOܾ qWX&p*K*" uW{?b#][]UĝMdGKH~fJdC/1 _a?kkWj]y|~2'NwrX[bÖ۸q׵9jnhxm/.>AoF)sӔ+YђգI#<Z~Qm )F"b`7Ly;@wpz<8?{cЗ_s#7qX/)|2/l#7֡JbzW+])ޚ0cڰ8zq<T@WQu"a͑p6N$M@`s͂u*k'[eGy~#/}?Ky~#G_KH]#/}z ;=x5i:t`#{ 72Ffͺks>Nf*:nث=ogYFa$'}otEE5jKQ9A"0 We#eFW^X>B&tzuS] ֞ѵ9ߤB|s)wE#D֦E){ +{~ߩ&9xI':qWP烯  ( Fjm|'gMU퀼djךEwW^Z _Fs+n~G]a?obXJQ*U仞ֆ7G\qȍsd!}P7؏IPEH v𰦻@}ٷ#}؛O_?q`_a+ o*&ֻb>T;9V:x5PkGпQ~2 d q&HVo,E:%Ϳ$ޱվ #|׽٫o۹Y0ҧ䁥OVϷ{/Кbcn*j ճ"=rfshT=ݓ.Ild+PlyjfR jӾdwR^;؟ 93y<4̧fݨ<t{=ts o6X8&r\ wOf<6O.}kjyWV/^Zu1] ᴟO^s"z Az jWxI7t>q k7WƼW_ ǣ?Y^Ӿq !#whwhʝW'us*XaFcW]wǾ'Ŗaߡ 7ZR7='9BSm7SO#/um.J[9 vBkJs_w%_Z;<^eXk`ҵ9wo辸},UɇAnoZv&k<zs\E~cu1z껠;XlsrWr㍡aҗl\y{󌔾9nn$$>!t㓮d=q\x|fZ my{~ yM]yVדz}NõGc3hEwyG8Vl)@_Z3jd:9]OK%˪"j<_F:ɐ \蟼U?Y#OUs?ωz6Vl> ^I7imFn}}j|u}O=#qm·V?qWfJvͳ1Wм1'5tW&C^GM\< ^gǝ̺3kc3eE:dYY#/QyPTW\zWڜHKPʪRxޮ`sKֿϕCekQ싎Iz6v ?ɤzQCP!5"n}`|˾ S2^:%k9.mtm/asoy=?,k+&KXI3.L~|'^5O<,[|R'_s̳N_Z uȑ |; w+Wym3.渽dr>?9Ī=J\}3i5G7UX_kֵ9ߤoO܉89%m׵oWkM)gVs~pVB+Vk[KV.nq]j\4`I_puwi }iY A#8N>B \uwg_`O;jg洘o)fմo'ݜw9ϸw"X[}?9=d&h&;ACW$(N k=ژW\[JbR{K.E؞b{V'YսՁJ-RYWޕ zs?<#0؁WE\\fWǾмzZ~~Nf.h\pA\нx&g1gb" /"z;Yg\}ET=q+}r F죽jwJϢ5g|,!za< ֆɚҳX'n~5L; VwKDN#[Um6,dn۹ ֥o0EmfJ3-Y*՛}a<]Lבq7}V쓥c5^U:VHJ:VVI*Y=:L4_|+eVXY'G:Vq7>k{BgAW@& Ϛ""7,4R|#֮:!ĵ9|O h<hRiyD] mUKo.ӵ9wgœE|-*T|ڧ2}aFڗz<;/6q\/l"7rj윟2Ft+_`h1v3OJ{ҬTw]n'oGHLRY e7ks>sf[^8GÙt'\{0EśΊH |gQқ챊9g}± v)-U/i]ӗs <%F-2mSBGp3\w`5)Lq,U[|'|'v \Nx~DSvU٣|rA^fQ&kAO|{8Nۡ.%kpC!F_ܛ*n(J!a72273ic9.渍448*1<[w@u.3@+AhvN[}sE@n"&>`eݫ~qRTpEP;XĮޑXuyzٕ{|d):ZOdlŴ ̨;Ok;CN=#cr%һ,($nsIP>s۷I+H%Knj2rO\I]yЈf=Q[i,42|me{u\q;*OfbWBgv9-#42&΁Ѽyttm/ߕ<+ُ}\r/jYzWډW|tdA̪ks~土]{eXv9`k?6ɊxKv̦% ;2i 2 k:.渵vn w4۸' K>'_q}6}s~QxK|:dvtvPU I;qv_ٷZ8CiHH20<eHJf{{W?U!-vP*z9T ]<>] ud`%YmdCf #xbnK?Y嶟~}Yx_pm6''wg,Jx!23I+iZ `֫BsKc>[z50LJZ~1NSvxm gIFmKXPߟ#UV~*'hߠ$a`D&^Bwhmm?VD5{E{2:hj VS|ΙI2ucўs`7l%)0b'*pFY g!;ߓTs> 쨦2ru_w1}ߵ#.HtÖ$8)]φח~Sed97 C Ut9ɏoKpH8r ]܁Cφ~Voa*uiBjB3 9ΕP(.Hp^qJTƫ7"6 @~_lE&;4+fV'8+ z$甔N ȶxԿ1OJ|Sl‚F7k8|̖^HCbCT?KIئ9qnrIa/ÊܑcE0z7ϭ c0S&+yKR p9SU1/=~H\iHj]b3:"k(I/@5sSNuv'p rUwo82UU\"_+\&ͯ~Y0WfLͭX }gܮΗ)H"krӯRXgۤ͟$Zk,>ԢUkgW"R^~'t r?<P1d)r$z֓N7 A\RϨ>^ JڼFޚl;:}ޯOӸ3JR^~ظDŽϱܛKǣo:[,IX;~6_0JtVvtФX<0WʐSjWr2ʙ2b]OoaBJD5^~+vA r 9r9(q ܧlWp q7 1t4 Б_F,sbxb5ހV4ۿW3g+GjH0B7 Q^8D oy97UPv%ɏEpOIE;%lzeqD6@m[8W7p/'1)=]=+rIؿ=-c`*@cLm(Ĕb=W# 0Y۽^ MR#Ks]l}}+;noo W%Jؽӈ#n;p*d/S~6I uJM:%5J;Qh:SJR G"^~{Qw(GPiaEqNam2;kI8%Uo~'x2HOܘbK===NjkF۷nZ)w־Wܘw"J)|D@2g+T#b-I=/icDMsWyJu-ad"XVMƭ;n5* 翙UVaUQ+DCkTb`q~U'i M$/#qwrnmT o/q. F:&Y)o?}$~#^F~OGφ~E}2f֘4F#̳3Ys8o$#7 FDىgykpQ;ʑv?ewg<soHT#6l;8E>φ~6Ϳf S#U]/ .V%i 5EsY D~P8;&=6>Ѳ(16|ySV ܍ES7f_qDѷ #tEo/`g|%Ś̑zU]s9ŚgC`^-6{pQ}l_lOb}+7mS|_x6#nŻOQeyV\R#uHgL`+)p}dBt۽3Oϳ_[֨3*<'V siO =rxaWrnR>ۈ2G[hc++|n=*mG*\HPeT5$5UQUb$?1a^Ģ2&>/~;Ypܧ8~x@-Uh*ۡ +p+.p8LhΊBT$X0Rn lۨR_ o],滛̉c٣DJwEu?1fNf#|oࣙɺڪ> o[V0QU(qa7-Sx[Ie[7sG- =m;ՏbU`3[W 3IrҰ+N1X<1MU_~ \81Vit(1y|o׶3rphkY3SgC k/SByd47fޡ _MZ*^ 0w]"gC߉!Woٲ'x}+ΖO<{.lJ}U}E#`N9qvG1ߺ ̺3I-GO{NSNضx6,>߂z#/) uJ˻QꔖCN$iuJ@4f)Ўi b/A֔پrcq%yªu}ùxJYSGN/i;'`|lߩ֎Ưڞ-EKvr$‘Ǝ,jh*U^;ɸ .xvDyphagК [sMnAyݚ>Y[~5;^<ʽ q9NzMJ|2|>$1rĄWrFE檆:;jѝ}T-CG:u cWbX*bĞLCނ0v=rU``bx r9E"1Q#gj^F w`O٢N;Xfp0gm[wd}HbRA2#*)} !">rd{+cnφߪ~3ݪA5zXOT= &إl/rg=dbPB^! -qKpW+1_/2 +s9lx爟Ks+.2\ o^z/;PVO%fS9ݾcF$if(.3F֤/;.p3p7#=Aqu*Aǁ-ܦ$uqm?V=)qd޸P̂w-"OO]}N^@dL#JvcFELφ>y]sRvچT-34"Ľ>ۈATlߪّo Y!y]07?mFfTOs*z4=|6#;aN3[~C' 0@Y{]8Ì$͸ 3[>àg*s/f<c9Z*ߘ4[hC5f)9Uu U~[{ǠK6!?!A;l! p#zN$|6/S{yg8i6S 6–w )`ֱ( %o¡}I~Vg'*%?eZx3>'>m?V :tnSf8YoO7W,9R.3m3g$ }[vG|M_>f~W'Ʈk|xrcek9EؕQr~%֩2ly=q_TnlpJuZwFtd-ٰ-N#⫲h^$h/տ鎐Tp+ MB xB_mOZ(T6Ԅd@K S;tG7PlU#qLRgaEzdNcwpW@LFd`p{%I[Ɉ6rM-LhSr]XၳX'}y|f^F9$up#ö:,9̤l dx#vJ3 r|7lUV;_"yEzK92wknuDFܞ! Nt ٳ&iqZm#s;8ck~ sxwQT`iПWY]2e ]W [x~@#'!?/JX#w$iFC#d;Km36'E.Z^~bi{eسԽb;;!?+I͑qOoƹG`֗Y`'&'Gjۭ0mIKۼ87Ia; v(&=m;aw J$$3]^ n\3I,EA Xϝx݈'{m[1ǑpZgw?~>)XWwp<8 l/[5 ۊSWA߽Bk..Z}ZfĬƑljꧯM[~6؅F7V?IDb^9$9#`Q5RnBO(19㌰G}8sXN)Go.,(tN7E23.IXoY4"kg[.}j3b&uzgjrLzxh^8.V5_SI:Fnkub\fb~'^7Z^w c|JKi ozRjqJöެ3qJೡ_~LdԹ?wVy(#U9VF9ҽg}c泡@,/z/d=DW :wgQkUR$(MVg 3z܇KDP۔_n8{ŧq9E7ɶ<ə2!hTdOKyR_6YKUSg8A [JCK-vwE#cw%>N$z߉vy{5㖻b1:Ci=w䷮9x6 oY8?JzPN(1 hcudeȑ1nKA%l^wYĻOoG8?IfE%ITm䪦D$gꬴeS9@4Gxg.Ȼ?ԕ[X;q@>985 ;p#f>q8rínA?cIR%8GsF9aqV>zwznw}_=Yx_Zx??#&}8KJFz&ʷfR#m?N5W bw(MCNHKM#[糡|~^~\8'_k6|-znVؗNH4;I%:02]n W̝^=dN;[=V"G0P[e{Z:l#] 'Q"[?!`f|G;yJ~Xj'I1x܊/[ Tu.czW.~#'ip?xTi˖bV_?-/U=R[XIGeXh6auٮ_ [5Wd YO {,2\u}+=IJ( qb:1Ox8/_٣~;\`I:82X$NjWszX5GXuo/l#Dτ.bfxvg)tX3]xJgC (;ǀz~:pPؖ>j$MSh_[ +|6-p?oO "8Pk\WO 6{#I dv s pVmΆznӧne%;@09]7Œ6w/d{!cn }a/ZSB=Zp 2-VY<ve۸^WݑQ|녃AO͝8GUD/՛pZ&N.TG!'7`zywәjbM 6R6%~g) 0ßx2G#+U!w?IRWж|:%aڔ~{q\m2m?bG v~&}eNrIdAd ͭ\z~ 4tX~jAvx ѷZUT4ZFS)LJUS0|KN7[9=&ŎHIޞ*o0^0/־uOw|DnwuMH=I&:ľǕkΘ%eI`V b!]pdzIed{ v oB<$iD#&jTV7]Qzc_Y~c9hy./mH̦rx`C1K܇kX*ߊ)]c7jwwCmwA$ o# w[oܟM=m[0=ax= fךz3OFo8~sIͤq^~}!7ޗnHPꤾ&lkzqa{W Ey{0àdxJ+*#Ӥ?n'r/zAMKdX)fnb%)zO>lR΢Q?X?Ow=̓_`br[~߿{G]rN/)m)Y`r\@>wsĝqy蒘AWbd2u7OћWzTp9&ui kvvu_~.SwO=OīD$JHN!@/gƷ+mD FK//T?X|3@^Mƾ wQP$Naxl50#׵[{9r=sO(1\MΝs&iG}2G k.1;_~gxxu`u ١w1Y$q>ryi뜎[|VX"Q}Qٜ]J#I5Nm]"OgCcrPgFhƥs( ӣ6qlIj8#cgSfܳ>uhφ~6zP9P{(Ŏq_d;?Ra>J qV=?vyrq 8XN9En'hv l7 XE :K_)H-rU,o[Dxt\qe"3N&Ip酮U gC_s/{a} Ϧzw]'VP]bdQSnBQyđM[/fuyKJݰ9?{c{sHkolj-$+9wCs^gC`syhPb@x"NR,d{ϥ11=m;o6/3ޟH#/3+I=/iTE" a<]~6bn, c`Γ\P0F6v:6Q'dQ/X;YOy8?KG藋ԙWYk6$5#95DUx qǑ_nw¹;4QyN]wo-aK,zm _0$35:F$jTT9> Xx؇1%i#GonD1$gC߉e;aBoڄ<nGV;)$j Fs-bJ[1%>#[{-\]I~͊, `R؎ٖl!@,HA="Og~ºMo/#t(9yy3cyyLϹ#lKtoѫP\B=3J_$_z~dP~T<&췾:iX?0%p>MŒ ꟴ>Z巾eē/H{AqIҭעN h2'sy%`9jz+enzIZ 1uh= Yަܕ H5#j8謦ct ?_=aEr27\6 };(;#&E\Ѩ]EMo45޾_5[g~G03Hldsa*zmq*6mJTViXܤ !C/@I\6@"*)℣b(50}"7Q$bG~ roc9mx1-mƲe]Le[qJ oasW C/' %H7.Йj-DoB\]t[[}H\ oSGK[aJmDe^mgdj<љlǜsφ~6u d+Pg}ױl#+Ö(>KUK0TGP}0w(E=^$#YIl/:/6U+ֱBSǔQ#9L[m+G_ndYU<G#K}#Oޅs_g#C;œG<[JΑc^,vq}dw|emnPT=z5iQ`An ݲ~E.N O| IhQW=˜$@H>-ӖruRWtᖍz*5`PI!E 7nYɛ"]rتD,zp¶SUyPi{1*s>oJWs?;#wfszK , ӴA/O3 mLJ^s4ݎ! .&[Hjȏ[/bݫBf]_~wh ԹϑcY^FU!wqR٪lo \mHum?Vnx2:':%Ɠ @–Pf##/dO(rWde7J7qm !|>ћl;9Dz5"54wV\idGc7ZH?= yY>L"?v ֑ m oRcdKog]J}g/RoW vlGwr;]7.#,]DgB(FIxo|5]XW#s03;»`=#\?ImS׎l붣_x? oՏG)#+:o oMC]T ŕ},؟Dbs'5`+gs.wҔx[Ys#'qKBU{,g!+z,&sI\ҭE {jܐ.ˌqOj32яl+Tr_6ٿ.zuƳ_~뾏^9xpʻLp+$ ELQÈ $,-_G~5bKd'TK~q#`I!igK>o@8&wEnEꔔ؛ɩW4) "*+7{y<FqXrӿuwy-zw+BƑ 7n9/fONM\k Ǧ4cUTM+F0UZ~"`NXj>=X.CKl'_bXr+&/j*W#Fr- Ggo'OtYFC9ѥ<-$57.f^罒φ~yChy9H-b#;H$=3z՘iM;Jb.=a`4J\>! Jԯfpma!s/f@ceCOU1BZuj"񱫏/YT`zjgG3\!ɨƓEORSG.HؖùKF^]}a/O/y ޭ#Y"qYaߢѰ">ƑzWp޶ φ~6;GUNYUSN%<9f+l\bnxJ 7s[ nĬ;ȷW;bX1_77"?ݣφQNʋy1T!/V(1/z`Rے9B5G /V+`lV~P~G{0- L5L`DI&MvV,̹hrr/%g%oɑ<+`FT|G6߻#b KҎN,g==#gC_m7N6z2Y|TzW0+G/h@F9#߮.<ׇ/ϑm#f Wߢ*6IbHȻ-1nl/[qso.`:ZEnZpz79l;;ӪfO F x}tY [J+82o0mc/9ͼS~\XxOc{|ܕ͝84pv錘aKIĩknE:lWo,Uȳ%GŻLF"%,M%ͮܡ F8T|6#y wi%9cZ7g )v:WJó_~{l/ƑM6.F) ƮGKRB6fuέ}φ~oagdFc/8N,jglevsNaX;wV nM(qnYcKztV41MRbyd,-y>E^~{9 ;\JG:.5+d#v4Lf$c[Wfs5^F_nV֎rEu߾X:( Mz9aKT w78s*l/}=*Fwћ34GЫ)֨UWJ׵;pVw؎K5Ĺ]φ~o77sElqxW7~Sg&JB*81_Rr[>-H+;n ⚤m'*bwSnY>EЯ̓V"v.刔CJ;T.:RT5E#L!ש1 ]}gdߪ!ʪp{nv70 y#IS=akq{j9Q~O9/x؎;VwHLRB(*[cB1 '܍՗ O}cy?cz>?iT|+IZZZ.6l=ƹ{ ٕVa|7ms⨇fNP^]&i|Wm?xn9q|6^~+{@/S 73K|[U6\O%IB+ ^e[sZ*o["C4\ZGBtYeT{潃 rߓuiDr|VY^JSy%wo_1 {E_G{gҖ$1r5)97LE[ʠڰ/|!uEgM >td)jOD~%lj_ {&j#[M~6Z?#JxqWV)ou) o;!Kێ(>KԻ_~}e]#EC.]8eTvg ;9F g]1K! Cw[/uA4_UQ{rW++jT؃nUf"}B} L>>x4/Vܵd3kMT^}T$#" 2޿llO`|ݽyJ璾10ӈ#m+Ɍ]⾏5~ DyjFe!xqhQ|&WMRU~%W9u;LsGv} f/U{"G&x1qoc~I-qHz'箙g&ߪ~'%G?Sbx;0`ɽY7v3ON[~6͘RԻpMLS{ᝓ V5ٸWڒ#|q*|"uΖ[3ΖK8t%pǠwG)E&k% [.]O~47gp}A^ 7J[!eORBHیUvͭe*_^~sd>5CލD1b\}eLR:%I^z"g~No#hp-"GҥDy\UGFxiksuԻ_~o4ʚ8 =T2mzRKÂΊ94w30wo/i }?GS5`'m+ؗsinaw/fe06h^C ǿX/N.D9Gn+oVޘ/_~kD)vr/J+6A ;I-v8{\'X􍸤{2,GS"_2ØG~*ƞyd,oVsĿT'z^5WI`kL *+l1QX֑9ol9m[xJ;n|H~~1y3Ra'3o:0Z_ܭCESTٛN5l[s:%<zc+QWm_m৬c"vCUvwk֫9"laz#ZKj S?}-zQM14-φ~WZEk2+|MF5֚_VaE%I#d`-b|vcD~pHL+"'vJ"nllp:VJ81LU4njZ WԀ<1u&l(`D=^Cq03vJ 9!l)xZ2s{fF%3O֕3_mAE=HR׍$ǒmx,'^>zEv+ʑ8l<K̽>.)12{5F%~BOs[q <ҜqTS@ҙ7MJDE`{Wĩφ`߉M*y#Wtyz''?RNj9zU2J_~P=̣∣~ gؾ2 gqɳC>,o-%upW&trm4wvG m_~k޴ +7S3!U#e )U7V;^˹s?z~'<%tpO#ի 4kpUrVT`4B8UsvH2Lz~ĵ]D..ߊV{ _lQZmɣZtq,*M0wS̎&oKE8bYC k@ԣV/IG:z>+\ċM9_~l詳%D?^1jzwmg Q 0b|lI&oȹ77VokF[xJpuNv#`[1pVpjGWv4ꓣvE7cgG+Q;_Q[D]=7Izq:k@7ax}5mKj v^ekvuvoBT*`Nʈ}8\o$E9`^{~C[1> Xo[,&##-&}T%$i'}ԨQ3RFѺm;q *{ce< rг(ѻ3BPLQ<Dv;X T=*@>jGw,'YGkU(qMb$u!VzYdcwn.ސW#֬r#+;08r^Sxr#١YmdF³]Oo_P]=5Ȋ3& ~6878a15w ⾁J_~ x_:Ϣvba%0J#9 Rr $4;S=5!0Tn: ,x %!X5IbnжOVUf#ւ[{bX%b:+&xL+]Wm)U!YtVGdWMV/#񽮲V#,.ޥ47%1ݖY`f풿l$z3?ǕqΠI%Wk~G&܉ φ~̿tbo5FsO_yyK9ɊGϙv:/!xo൮&w·)ԛ3-%SMy-cy-줙B,CT~+B q@s8V`Gjl|Ήd;y Ux: }N?oNF%F:y"@$"'%7=IM]{}+\8&lc%N}@EXЈ @d' }py~;k?ϖmX?S r? ~o-|F 0X٧WoA7㙤nF~Kq9wEݘxv!v_~'+t!r_=N \Y;ZgJ%5LJqǩmcT]w##:[9q1lm TFyAd KPJ9X}65wuφ;qs sƘR/GU螋{$.)2Vz8ҼU>l[fsߟ9눀G.?DI2q7n6b>aU':R<.u> yFwggȧAosGTk]3bnb8SfO.'kaé9|8n<f(Nfi)—J_;e #+j6(\de)|GQ$8WmYbnzfNum?Vzߌ7'GWk@7bEN1rrm(]oN.8 wel[[>= Щ/Vt$%Mt=ekoM(,qe/fōbTR`@v/__zLz7A1E#m`|bX b"g (1댪6pjIҽ#~'-)QHT3>w[|0~.B_:@aWacAu=Iz9b~ϟGsxl+~^~l+cpYVE7OWS'IN#4>x6]g k{8bncWչ:n>={[i;o5v`nmLArx/z㌀+o/{ms\8ruakӶw8mx6-巾9Ҽ=#\\S',n" uȏm1v+'kj9W~6oi 4&{pZ+'݉Zz>EgqpDym['#,.8R,{#{$m! }F]ߧ.I` G.#__P/MGiENR|[$Cl+vߊ!C.57D:U;-I`Ⱥwݚ`DMP| ql%Gw~]nH Q}. 6$f5  Θ1f_טJ|;q|@\ H㾿`6$ #x{]by6mߪ@HEVC}B.f&RSI1–ȵ lS|+ȴ&>Ŀǔ_;aJA!ľE)0C*؏>E9v^kRa1>_~_lEw1a2wwX'c'/@Ѵlo,J=OI%zE&3;OB*@-"?cn~MEp{؃-D}j7EENN.![DZjQ8?GO;Վznc<#x<nVyxf UKnKi #B%kφ~u2WŌ>>,gۀ;sflc$i 0l%F jEqI[}I+Kzy6PK kC3 <^-=UPUM_Ǘ::joH꧿7,_7ߟ?d_nOm߂:1Tf|bѻշ{I?.pJ]Lx+|B?Wǧp%wgY*qoMQ.]Lz rL ?|~7ODg endstream endobj 91 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 95 0 obj << /Length 4455 /Filter /FlateDecode >> stream x\[s~`*lv$v2);ݗ$EJHv~} h -dgb>q]gzvꜳwUGm*/õ?4ڌkpupۻ?B/UW]1?Q5ZHg46pKȵOzJ;0cXtks6PI#$`"@$Uթia2]DX2Dt -cu;~ ׫M4Fx]Kq!9_#/]mǪko{f\s|υ$%5"%M,"`w .f<}C؈5z2UKjm)@ovAP~ BMS'uM`sb.M4b02e֘n;=۱g()xG$7.ZNZ,?d[5~wr%^ %ʽf7k) /W*rތ:xt͢a=:̔r'h&Di,k^0 $~0N& a@bLǿywyki31Q}AkWNLKa\JuցUe^*:oZX N֊W `DƏ&],Z1 PP1&QFNupndeb2lh+N^{q9}(i`9WG Џ4^A\&IxuSյ jT =d ,:iʔF `_J;@T;-ER' O}lk P66\VE *4j%-p﫶)wtaxwFC=SQA]Cq!G+*6bˡrt7Eը[a ɂCYg MRSI Z 9iZ7RJL{5Rևȧ)2u[xem8ɪ#΋ )ePԂYt;iRN%E:*^b-i}L]%d*2sF@iJ޲^!>T-ãVZ?<fޖ,_W`h`d;S9AFLiGkG#SCת~p*XvVi|w^:%e`9G%;2mxkDY^,+HuD$lAMBIT%(鋡J=]ٹhchh:*}р7X͘iMb}.$hvHqhCW Sǂa ? jHiD%QzpR Cⴡ;Ba0&"u]x ֝x}'ڷe(V97 VZQt x8Tg4[FE1nzmNa)="_|A{C.\߯BhqljJb;O]W^%ЯhvTuL|9:2 6 (tROj(|6`S \ NEW;dJREa=$XOѳ󷖾([ )4y09 0gy`^4ޘςyCGq`eIyq*ig~?3WPhNm(sՕn9ss yWtL k.@jN ѫ㐩T{F:p13x6Ćޙp}+TUۧ99=dd%i6Pm1(1Ah)դ5Iu`ΊӜ999&Cat֕vN=`'@ !?M<)]zH/G`k! mABȉ/H!_vɋ ~O~3Ԡ PNj? SxɅcJq(E(*[ǝ_N١Z\k9,9_S(hkL#2$a):OOpSK$u% odZNuCc&Us`mJdږƸ) j|C ;|YLDaW5'O`]'A8vAciolr["}$}u)Wx;zsə>j]ӎBsAgI4q>&/D$!τس.6"A}mw$t ->DV5Z<%|v-X&||O1M0·NXrNf;iz inʜņbfARQu1i0C(ͧBpY%n ĖaIƾ!!2B%D,5 Osw\v"u/{,Zɘ{,:.az XP4D&Hd`m^ª(0<~"'ބWm&iJ:Prnlѓm)sID(:2g8 1!:N@waR 廕* c1|fo㺐Dm)GI/qf//%{L4 TRR0tN8D6 ^[1Sy}w6E,R@8*A \bFygI4/;.WA@ЛVL&k;I} ?dYz2%4$rq+x nu9IeA=`saq9::':ƗhC #@e/#dy}0/wĖDuŐ$Il Aju-NBüfj[\|:'b1ssjw(̥A(\]L9,>J\-˟(N2 GZi`%|\$Wv6W—4MҲE}wc,OeoBJ=gnSlyPu-W_X !-77:[[?Ғ [=OoDc򪂊kظ px>Q@g%$8Adx{~O姘'5 CzY \@p$E =s? -O%%J~e ڜ*SIY;4DfZu6K7!|+vhݗ7nDV0f#?[!uKD-< <5\^Am[QԫUr !!R:qHzd{oüR;n,~udY8;c>Bo%)2C+Yܙd!}:0Fofq֪Ԃо?Wj!M H7˰Mr ݄Bz~z{CZDY bhՃ6~f)}(B7buk}@xZAvi`ZͿ!%=gv\tb]اLe7='y'{w <"; -ކ7=g~/rI?ҍ}˪~쟾B endstream endobj 99 0 obj << /Length 3464 /Filter /FlateDecode >> stream xk #=3")QTW ܥ)rE.IPlύ˾w^H[^ҦMJ"Ùp^d1YM'7Sb'.TQ7rJvp'䕺8ixӭ|B<'H?y4qMn&QTTT󙞮:7Oۃc_{pvÍ0Kw6o ]J%7?}/g2 'POO=bGrVV|33t/!U0wP ]LsdnCۿZYǽ0m]LAn!:H̆>D*6}{—qNf ) hev+g!@k+hۢ*GDDjQ盵C\eW5 Ja'wh_ƈzdR@cE~`L|KS]<c{Vu&6ȽǘPkA[Mb_}f--.Ѱ-yO1@R4Gw$Hb! c89Bi"s\^rז[,k$="B g$7WkD+y|4c7ݼ.}ty+xآdV!} Y$.2څ}<$vKO>ɍ%2ς.-8z-!-=1Jo׼㼫n!%5p0Rzy^ 2rt)ExX(&BLLuMj1M#EBb@8o[DpKJ}>ܖhxRz#7h{ьk{l ):xwJ쐼{L@٭ B Z|Y" *$v׋bdH0;)f랦럮]BcJ;H]. 37s_+ׯϖ@v?pgӹcz9wUc'vme:B]'OB`c"͎>lmmi&3k.'s=*:ِk; ;wah:$8fQ&x_!Q1,˩pce,XUQ P]޿W6 2G.ԐGOٯ}Ż2F|mߧ6 zpaz: =Ϗgr#!զ+н.)zdf@%IRZ["MSs5H2Мbg(AWX)x .OU]^Ǧ1X޺1f]z 9\KȅNe^ R1!Q4Ow.!*uGPmc{t(A4;l֋"`~K <3ԮwL %lxU]nLbÝl4 > agx>sIf+e\Cn[$$֝dЯ_[9gjm ?Anȡet >ᏳxL_P,5e<֏J'*rrгۛ' endstream endobj 92 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-mgegofcompplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 100 0 R /BBox [0 0 288 288] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 101 0 R/F3 102 0 R>> /ExtGState << >>/ColorSpace << /sRGB 103 0 R >>>> /Length 8987 /Filter /FlateDecode >> stream x}M5m1M>Kĉ02n`Aw;v#Cn$" mt"A鹎_uW)5WO/_:o8_fC 6 Hxv8V'6 vOOKU >H=ZwSlf״uJMvc:W|2QnK{՜EXC)[H l ՋiHzU^m:Ch\gUe:;Sa`fUf>&P۽!Hx^fz&D+_ WFcqǘFZ(3$MK[ ‹{`}ŸnDokOô)B׺/C/U|0Xj`'cV2٘cnV5yջj"9kH@V/JF7M=6Q+/6)%paeŁ֐Gi FA@b>GM&D ~:OPU:/S@C$|Iv&29Eo ;|H z;A?#bwb)C׺N|swbi 6+WO~dWh3HxCӑe1%zpp[Q+v_7 )AoK :j/F/|ttdgV5g#\AU-t;:m_N|w5696ܮͪk!'6 "F +~0ϵt+m4`O`mf `\id~]6f% -CmuJUQ6;k bk> ӊaS:kk1fܾ+ö1YE{IN>qfsi+ Aw]‚ӎdecxeǜ eS;('rJrce,;~1,SilitIʉ˪7;snu;T]Ы.X('Nv`/N,~^3jP(a5NQS'f[ENɷy۔uwܲeBs-Xd[%tsԆy.-`F]U7(9ڗ- msLt%{o٘HZyCQQW;nْ=M[ȹ4.³D ])K~R:51ǶGU7}ɁK;nR0k$Lc`խIaaKrKW,rtˡ{ݰuo^[Tgs}V0sfsyKlkFgX(sY4[u-ֶE-f[54D1V- +tEeM7뮲tO[ENH[tg'm!Ǘiulv@JX9(ɶw "N!.>p˖n#[85ޯEͥsZr N(]߳cK'چ\fKӾHpniG}=1?ʉZu^Ww}p˖az2~r~OY tגW0CT_ 9 tSA.\}-;hI}/Lt>/R=x!Ϙ$Ɨ.(-[@w;Wݠ-sɉ;7[9-/dٰ% KPN[K#f :,[Fm,a@7O[ l>-9rB-_m6–@Ϩ|mu˖0Fr✄L_\lqj#$Q֦5tIy( = ]'nP˒twܲӠ-dߕ5al钗mvugF۔--_7k?w;WW:$,JlkQa. tI5jȩbK)z\.-}"_/|ýlUɚ?q1)w֞?@=?I yxJqd&;ԝXU7(ֶElIvұS|>:_ƒBUFvɻKTVRVp.])'.-7{asNSh>;N@Ũ96Ү{)vJ_.eKP`=e 99~fGd֔H%UCdwNl 2;ֆ]~)˦tEqp*&κl;ߏMwfK w9Qv%\X+~؂ݻe]w[o[[TPK~r×x)rgooZDYIT6Ek6>wmٖ}ΰl&J=mYrveK?nLuQ۔teKC}NEL-!-+Ljz>th9.1"6n9Z3e+')u_g3CZ쳑nu~a۔ t-j= fNQUEɖC'Oxt'ֶ%[z pAF0]Y3{:=;X-s:{.=) !ﰜP7J}M@IDږH^t|-ƕ [U_DY{˂-k$5F[h[|YA_RNq˖neȩXOY q<ܳCTYk1qnZucے)uwܲYokdq|6=iX.ۛ|tEy(fK׾U7ǒueKGF?wNBĸ٣ߜCl}ɓ:cwٛ%n %[+-[p&Xs b`1eZE]]"ɑ)]RW?RemʉܴeOL̊ֆ,"Yv7(W"*ХWO𐮨{\>/\u6nxU)a\ OR@rɱ ]R9rJ'bmȅ ܴk,+ڥ?7QooZx s*eI>"FWmʉ;nNŭ~sx[Cvп_s+/W*53IwTyjr[$ߋ8-n3_,=npYjWآns2ɽN6IuwO 3ٯҫ댯!^rdK:t^g|jrkj}q/}h}u׸m =S՞tI}_I{mʉ;e 98e=$U\@{I[!o~#]R-F8.]KW90jr[d+,_gC;Fjk#NFR%vm6Yuwܲcx;+9ĜDN0秜zx[|ΠK)6nrYYs%_5s4OƵk A;BWT+qn\ Jr-w/[ɰEg-u3eKl>Ò-5e ˖p ?Th85gϰuh:}ٖtILSqnBW#uוiʶ%'.eKzscxl%89ۍ Ph..(ԍ`@]5nPץ)uwܲeO鼒vQ\j'5cAy{L˩ j=$.yP- MB D|n)^1|E2 a$y|iB(M=M)%'Re[O'sy|іtv b)g[ L<kf JӒtwƖ- ׾fly^I[y:KyJQ.]nPkυ;nق?>p.ϖdZPBggW$ui?8XRfpӖtiTL;}(êW7ZK*)K#8o&Qslսj[r[$WoBz f԰TuKPع.˽u@;h[r[d_7s\y*^Q#.ή<پ.'ۇ.Bp.]1jVBM9qQw-[8GEBNR= `QBg7WtO]+mʉ;nڒ_sG@C7fMsKބ5 NR *}Ʒ)'.>p˖[S K=VI:z KWT֎WpoKhr7m)E_+'c _R1OOiU[=FirdD]lK6Ep˖ݯ HͰflɗS㼐gDV*)Aҷtjn?_<__?q|\ǯ~qY>˛rM MIA-)s$&ɱrsՐ\_j׏~w\~@@(_Ϗ~7_yg`Is=mi<(seƿ/[ZR{.1M[W!mΖ&= _XrZr|Yw֣:[ O\c?[ +~^ W`1tTPWi}S]h?e6O_}}Ǘ?/7p?_?X o /.J~׿OxtAc+z+^=&ǃ|xrO=X zOhƋE>I QO.:Ar͏Wt9xxr!]9RxJxK1']NC\XOr#r8x$k4J;C>v:M:#Zo8B(A^Yt}.45[A.nK/S?Yp~z-ҏJr(AkvxǞfVo9Na18\oE߭h;V,ֶ-{Ο/ٿ%%q(˴ݳx|tekVoaL2|?ΜG9$'}t<7{{$\Tu+l[Is.'')ϿdLI_l%Vpoqc.쭪ϗqO!_vps)np2ɺ=w0s([W}fOў#h[^{6M|>xBO/k#0̦!/>]%JO|j_]Or{)>CIeu{# _0A8ן)ۓ/,h>S6^}}x_Ɵg/f+I+SxJd=G֥cY3/4t04k j@那;~{FSw@ßF/\ h ;4WHhǞ?NwStFB)ÒRCǻ}b ~4۷G6VpZNC=}! wY-!S2i \&v/{a!'߶xOa!=1d3+| & >+T&^+#aGBK'|f|: >Vs'3ܾIca 5E* > ?Ohg9-\t6+0D= qE)+4Ag7V >VyA >38 2L_| >bp*[| O=|IOMA >O-  >ٲOmcκov:_KA3|vc-<|p=c--|8 +O|-4glS#pBǏӷCoGLϲS#~#DL3GV[ >o`0)/GC:|[!~ >#o >#C:>>'gw̏|P'HQbc:|coN| Κ|M)O-8d𩜤37?a\($ !+`b2ch-$߹|΁'љu8|XUsO|?V™OWpaZ$=|_G+-Fg[|¾{ >=OfTL-O|O@f0/#!1L>opv >m.an'OJF')0dW~hOf0Tɜ̬W)(| Oaޑం >+ʧ0c"` >p+翂|+[og|+9|@C:Xt>#|61ƖOY?ΝhT$d>uk,Рn ~ŏ_˿~^͑|C|+h endstream endobj 105 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 109 0 obj << /Length 3053 /Filter /FlateDecode >> stream xZm~B0T%4ڭ\i =`VJ_y#+.rSA]r8Pd9I&_%rR*7nb̤LJu:]L~ng&vZOצ63{xojlO3C [0z e陮޸1֦ h k8^srb:G=6܋sX9#2rX[zu=s;}NrB NC 2erlLkUe@dm6dzbzt{Y]/rkP 3u=ߋ5'eӢ?#%@m5kzY~ttF.7ղyDR"6 ~ UAjd(f^^Kʂ2@R&Y^Bm-=0;}إx$I"U"]jҲ[DXtȦx8p wr$U],pfʘ4lUb"p'rc3e>7TzjOuI0&XWj 9e۷I(Ff֌us.XoC#7;$2ꉬO D2DsJYC0Dɶ)ɲ^W5olZQV9N$FUA5@IOO v+eMrn)ߛ3ǡj-+_F6~.ɹ\u!v,8?5=[HRׅ0 \bOTӋ>$빅ͿM4nhޣeo4<$=K@7UeO+UiHϙ€JVP+ܾ($HQX4$>"j3?uW ɘx9)CWL/sUpH̐vS<^\]'n@O3(yEƱ {GAa iHu<52:F CG"ZCK!KUܟbPYzQ%-gZKAK.e3 X7$z&@_:9]<'k,sԍ8Eivt>Q*-CMF^|%+;: @i 4W¤-yjDkOsҁ&viGT{dpBfǖ_!S,%pz{<ɝ8[=?܃jգ у/c]k. S^diAdmx[)+dʋ7úC;WD n9@H&!<SfϨx“mx7qD [a8&K*OZ'K^:8̙ suڼ.Q=U$)@6oV}䖹\=ZLrU$LORkQ9_ $ BjPxѻlho9YcTqqEJA7޿Z(~uU|r*.ܮ#Q7tr%t@p ||o0 ND 6+.}8thc96)FdcʔJ_5+c5\l eЃJ|yncEWC)LCwgލTpO؝6 @p0T,zSRN`(" <^g>teANjƝS*KF^u.{4j{!o{,mB.q&@[ N@5g@p28C̏q14#\4r)"6:(2_DD`JAs ;]d`쿮ipͶ%_yxNn['3EX{@a22%,RڪzՏ U{ ,~'ĖH(QH4瀐͌*M)'$=C#c”0nqxN@>_R*df*U3?qq endstream endobj 106 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-danishmmeplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 110 0 R /BBox [0 0 504 252] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 111 0 R/F3 112 0 R>> /ExtGState << >>/ColorSpace << /sRGB 113 0 R >>>> /Length 243964 /Filter /FlateDecode >> stream xl5`Y"ՁlI {ޗ?:^[*Mr< ?32jf?_˿U*_߫{??~ן?R#_eo߭ʲiC_C(_}|o;q}o"ƌ19n9x &ƌI|7*Ao۠g}M$,$X{:F۾e %gg ^/ ^{B~Gu<炶O[ܠ GBmeCXϧ+e>*Ӈ6?c2ωG9~ۼ_R?ql27ʠ};ZCۈ$xx -g1#dx~X[~q;W}z~?c~m&1Fˠ}q;LGe6nc2/Uk`FmlA3 AF*Ӈ/Cw?B{U Xcڱx/-(~\fӧÉ͂_n6mc`(G軈[[1{1fĭq71:ģģ1Hk~jPk&7űWu#v e߁;:10@&v~k}Ϭ߸FǰGv( mjc`L{WW тxx ^5WWbiA,&FhL ~'/O7OP2}h10@&=xB|\@?\ψݛ2`6ic`L c=k||/}.hwpls2h7_Efu?+iwCwC2E~CS\mbcVkGz"v*H軉M,+DIJ~%D❈{uڃ;8@k #Xguu΋">D<1bqXQAK";qAML({!މX<Ē )k"D,q E/Λ ıbA\ &+ >ofB]CMܪifZ>cFjvģh7hAC,X>Ě%MK"Dq/_wя'ǞFmlw0}F|"}Le4o=!3#$.oт 5}Ĉ wī71@2!! %cMĽ$b YnYx &FH\&&+Ds%K"މx?;'rɱyQ (aۈ- g'TF9yjc`L{ww Y8A4LE[k b71@2%x'bIK"މXbMĒ!D_#6xrl> 6J6bMa2hRI4$>'㍫<=Ϸm;$6}ć#<vi&Sn10@&Qۼ?߳ڛm#^6Z`|h>#ƚ`1hlؘ1gĈ˱yrfm#;)e>kMg5ƁeW]ytc@npltm*H]_h0_CXB'ڊ_e^eC B1 m#XG,.^}c;x1CĒw"Nr9qXO[/;8mjcY;bGxdN|"vj8.Qb bq+71(713'^&FAuēOy~6_,2hG P_K l I|N,'Whls]QOndN|"v x: xr|Dbۈ󍚌3b 6iaEY}AП|r]f(F,63c Lc|($zix &I]6%e2!phd:x RҌx2c/@O+lژN~2BekB%d:CMVmlp/<u3'j>mmIȠ=|MQ3>ĝRl=\'8P;biM٘N~2BekBd:C h> ck޺/ >>Xq7`-g(?a?k3փ􍸥1xx6/כq >ƌ 5}#i5x &iu%x'bIK"މX<%CV^|71@ n35}AlkFĚ%MjDqZ]^{׺12A|c̈ ,+eĒV׾obā@mk3݂xxPڃXM=D$ly@۱emLN&dОʋn~7<ϲu2/-Lo7fϷwoŘЏi?!_3$XML#ĻĻ ~#Cĵq712$ Vv~rqY2.1+&s;IeK3f&w"6*8~%D❈{븉12|@k ĵq7qAGq#4]&=ĭĈ}Z>'HZ>cF i&n-G QoQ3D,XbI;CX<Ēsu<Ђ=з,}Ek.#| 5 F@86@e_rOhO+/}Z/6&2ˆpO&3MrOh4\G> }F|ތ{B 񄾽m_k;ܔA{>gXox45Z.qyLl'!l19ŐsOy d \t6ā$ FlmނemЧ5}/Ma`c/MVOB7.yɅg& s{Vm ؘЯC|>w^d mv!]&1.yhW:6$ncBnV*]h>k0]&=2nbAFǚ>bć黈;Od|dhL{Zx 5}Ĉuwk Z֛egm ؿzmب)l[џXs}ӣ ||H,Xfߩ\|죒?\F=yجVM^W{ }qm7qA-Ӛژ#>4LEu?ĽĈ$XbIĚ!D,XobX>%]mw**˾OgM_1cX7Xx_|q򂸷 =cMq71@<{~%}~/v{)3|>Dio A;bG/f,P_Ď&w!@\&`l'Lo2۟7aV ;B1CTEhro2e_/v~/v(3|~umA!"v42!^! FcMģ$b UnbXJKQWN\&&F&w"bć黉%D❈{bd8A'$NQ}<1hmoy4RI|/>Ē5CX%&b}5OψnP^>@npz~Ѧˠ-f/([Mg-ƁeCMzZ'hO#>4ME<_ģĈ$X &%kr#ij,71@2']C_Y{~5OtcB?eH8|ENӇ6ᯡ"`q[?#FF۸bć黈 5x$ت15@Mk#>LE<_ĻĨX\&D,XbI;CX<Ē `UW>8~_.0<_PCۈ{#I|U3b<#g/1nbX[kX\&1"Uӑ2l11C-f8 CۈW#I|A k91,y:r~^X_.U޵lpoÉU^ٱX\&v~_Bs_cF8eЎؑ0 w/Ŏz3WLsj+3yU } 19!vĎ R;:1cBA }g²/ GG"exq[AM\2/c;?y:z~+C$seN;Ŏ;:10 3k3bx1ʼn񜧣߼~+ļ$e[#<_m$&71w"bć黉%D❈{t@\GGGĈmw#s7AL.Qob<#Qĭ(A#s%lޱx:F+8Z4$ψ :R>xc }F؎ۼkyhevl񰱳K_1I>xC+qy yo2fۈ1e-NN~CۈƐ1[軉!މX<Ēw"X$by%a6y8{āvMq-1=QQ-7(Y_,D[6||=qBOl1ujxm;/m#; I|/"N!A,+XN!މX.XM=X7fڃy # #4\&{BP"o02|@k/(}[G0mjc`('|ϋ{Br6η `Ľۘϱ]}M<ߎEm2#4]&=uĈ@k u1|Ag31g3bDJC8P>;Kj/0}h10gĈ͛~8MYml2|~ۼ}|4ā~mvV5jcypA>yڦm#66G>}7"N!Aʠ]}M<_Ӈoy˙'m9njXF˼A_Ig2!U^< ך>njXkk|ψ #$.x0Lu]!}̊nczl |Ҙt};gf$y>< Fe2 2F_f&qAMqv#qZ6fĵqm712@[v#@\&K"D&4C%&b}L@>4LM,x'D,_#㞐W bA,&Fº mcF|b }$㍋<=;5:X{CiM1[+CxyW*5]ĺnbk188AW#>4MM 3@8L y_^>v uwcĸ9heom2WL{!މX<Ēw"X$by%Ogoe(F,6f#v~cEh!WLs:8m_^)ɮ֎y뢮/bG"eK$bMk"D71|IXb bdw[> ⵂ8j  )%w 3@L@&x }7ēO;xd|hXN!N35]ux: FG븉uqM3 #{ "n&nXǧc̈[!AApX.vĎ/flw|UdC\M|c#X.cĵ،8q䃀.v~,*dXmL>Ƞ#e(;SuRm -]mղ-ç1fĈ黈18Kq2/2yG 6Ip79q#l6tƇJcۈa0XbIĚ!D,XoQ&b}5 Bw'@.' X&.vxDaDD6L~{B n /Ӛs|2^d:CEl -X 58|wsx2Rj2!!\&.yj!T2I;N=/(#NEbc`oy##nfn6Ij1{5Cjwzv5i2 l10 fgĈ_@'6icJ!5}F|{6mc`'ψ)ͫ#s٘=}Ms6e6b10 w뼉12Ak V1b71:q}{3b]nDoI%Ӛ>O[]F-* Ƈ@gT10L=K"D&bIzï#&b}5?Gq,lu7`kۭMV,5}'vV߻ 9/2//Ss7`fnmO8]̚7k/[gh}]Hge_#R6oo@fnWq7d^Ͼje.0ݏgĈ( m#^T&5}mݏo3`.xr7E&pTd^˾f~7s<_e_Ov~#G%2|4j<*烈YQMm?!@"viq0]&z~- flx 沶ǎ؟ >k0`L bD3ef>qd;#|`tz#qĻ1cGN n'z#`L ns}' һ;Ce2l{G'|IGYq2ωױ): qq~3$_f2l{G'|?hZqOhtd> }F|~==|yF 738|b }F||6O? gcMwP/0鳿 f>C`%1"%n9Q74Ge2lo[g1wa|b nbyw"D,$❈!D,XbIz=s<cM}A>y\nG~m[( 鳿O]\g4b>>#>6Oymcew鳿o6,W. 6OagVDe?}^4u?T:C@uĈSXfm~Ok>~ 5}}+!՟w1xs ɪ/NkHQ ;b3CTy숟+R\&v~c#m#bZcGof>sE$ Ob3՗4F1[B2x }4CX't(24}ik@zC#cLB|Z2ВwZ$hy%A@[?3"4s}:7t=F@yC#k7.hhxFfZ-g nhz#[@#1ZhК- Zoև&h}z3rK軠A .8ZV@@~C .8n _@kt@1B|<КQj?/)x(Y,LBtzL9p-u {^ulم]#zM% 'XL#=lls y5]:nh<#B#Ӛ 64]G@C4Rk;Cq.I]Jl``餁ac /[^읱%cˋ-;M"&lI`iW gEv45M:olNg 3l5]ح=<îxkB`حHh6fp:k3l24 42;Gr@ao[MN8n [bL|zyQu=x.}=; t2du'0:VjG=`x=47lCJ 'f3"hked`qXp(~`x=b1ЁREۂM%Gmłduح2HaL<`([C3IЉH!hѲ]Q{TyL&C>ث?ث%v5y%ĎƳsl75k l$wcˋ3dly%c-&lI`K 2cm^ܕA'r#Qܱ22%5fDZoijuc=< $$זk5yoAQr}%k&ח\3y8UoV&r}i|z[CނC8傼|XA>M>V"7KC["=מ{K}A>M>{qc䣼[I>%h)gbpAqL'Fm@ r3l'\kĥnc.sSl.imi 鸃"6 ʤ>$QyA 9怸\zo c@#L r‚`Yav|ۅ]p]k5r,*T"iP1lU&h 혯SU!.Nw"g{gDx &sarHtcd rM!mG%̅x 6#ZU1[^:Fr)M|)tm#X&sa:@X݆tRp b#W;Ŷ+/iNIN_eK&i {ФDwDǞs+mB <롆$T;k>_΅ƌ6C>./P:cRP.|"LjRa$7{];rȎ&zu%:{]/=jÅ.`ILo:7ӎs3GrЗ](̑0'r()#4vuy֙ o"Tn; [BTP/|"LjR\=JcgP}AM :fQ}j @}bM& R&v}5#E{%7sȎxǶe&vY/vb0lYsӺVάX.c7(gj{$9 %X(i wE[ʋ ďė5uJωxJv5VA!vaW/;M؅cL0d2u (i*Ӻwjm?6vb#~n nY Pw=鳄֒Nu⣤IꃏcVA#m8Bි[}MQ~@|ö]/0-`F4˫9pW n;vT؅ʌ셝#|QTHjy+1e>@NvVXgh-mnVWV2=eǖ]վz `+ۭBkI'A壤V0i}ŗ__|NJk_,7kǚ;JiŰ ?gŸ +_Yy0D]b | Y]R ӽ:/vt9D*37whVgbԷ`lxZtx3K`%: uFԖk% h,VYYiYn$ٽ"S zvՖk5|0!'܈Ck!~fejQq5a,N$/ & d['xaWɈ-j0H[ 5?!>y,J>L'Ķ1ދ&^]:^(.4f'Zk>B}ԗX0i}_2wƗ_3d|y%4ެj~-E#ә6oͧ/v9tۿaȹiu֚NW.w>ceX9$՘ior鶉.4&p֚X>*C遚>K׌/f|#5닯 ujz[I3᣶$c/JmVOY, }:~CJP=&&Y{iCDZflJ|A4;VE[4V(hI덿ʋ :?JׄʃDtJ—jes_+_rK;Hs$>Rԉ#xu$|-i>R ?6yo(r/G:=Zׯa5mI//ŗ3%ˋ/_o_烯#vQבu>d'~ ΄I3V5^㙗n[]k>ZNĵ>=y-6/scX֦m0N-<2'P3Қ\K W5-MI{'],vt|Dה'Y'rbwu\cKr yP.Kb`BQfbBܵҌ8AD\:~^b7Tu`44-i}ŗ__|%k_>RjZz&DD|L}y\ ? В5#щi/㏖GG-z,_y(.[c`͈f9^,cUg{Azi Xr; {fɅ^C^|Q3=džl 3Z{:84.3i5|\nαNDu'4[5?jSD rkh՝A/o}Y6Y;ӳmxv֞ ֦]7VwtLw^bmf"VM`K$"] ̤uX1yD]WUv/1y63k{'r0NލoSuvav. I덿烏d:#Ês>s&=>o3G#g#e?bFiVY艊Q: Z= g9׳\b |- nVv/C\:kr.`|Iwďm"+L;ו X[.w:3/m0!nwYh3#Pw]8g@`e6?mX_Z^|MH#~l! քKj4G`mxmM&a>@/2k&7~:?LIQtmv ^ID'c n;srxirơ&4mX˶ߡ+,{m"z~+YgyZN/FC;c/d>\ դ.amc5$m;嬳<3!&7~aN,3V \#JC!V~Zh36w'9QU!>-˗ࣺYZ-Ϛg{gO%8,dr?ŗ__|_%k_>Kb&or+1E V'1 /G:˳tr5c.dIZ '_m7|,ScGҁug9/ReN]b |gĭGF c 4G:˳txIirᗥ!.vh&HJ|Fĭ wWC->{w䬳v}%9\/N{%2Yij;>ZUa>DmVpi3u YV3i5|zZ`{w91|z+څ -fuS^YV3i%~ P;Xzv/W}svX۱j2bQڅܬHlXRy/iHSrٞ u[BJh FX&P[J1Q5Uu hCz0]3\n1:?9(FQ_^%ˋ/g|y5KƗ_2ެ7xU^P>;⣈*6Tܶkufa.ώJMUAm"G̈́֋X ?N!X߬`Gw[ah},SK&2|! mj\&W/:c.ͦ[VG`խ0xv߻}-^M>>Pܶk5|.V<׊]0M&[?”|a:/>Pܶk5X NZ9Zlg ]Gs{.(l y!SY>ڰ]r?\-s~^Xn.w>CMnu&l?89%~"!ǎx/0ŵcjfmI+;hnu;mk3:>ޑ)@m5@׊{z##"~cu$(S={ެ/_J_5nj >6h9_of 9+]b |1yoﮅYv/Mh3wZw" d4'ܟrk{']PfUZdf^6=)A9DlKm䊻9i6+Ra,lFdfi>&#䦮&M\+: +R_2f|}5K__|MHѓ5vc1#4'~!>k.lu:2Y\o?Zҽ_PNv+JpVIrӑQ`\+sx/M!> fzjuu _UMZ#f;'|Ե>w/rc<'6~l!>fHq X.w>Y:7>fϖwMq wM[Г_^%ˋ/g|y5KƗ_2ެ/ #D!k>k%| ?N!̄=i%` ʭ S5ЁGM3MU^]b5닯_2>G _3Q`$75\΍:'!6JkX#>jG?u|m ߲t(kOq kOxwIm)/&|Ԏ ~l!7y&YKGw>¯ N /dKůG`x+%~l!75$q:~ ?!~Λ5Ʀb־$Vzm"~0zR$MpI<\+:i wG~҅ʌ/ 6}a}F6\P,kM9|&.rk#ZcO8{zG|#n1!Ddx+O@p'cO>y΅ʌݾ6^b利SC{D'OEY:$^53]b | y߻}mճ{G;):g 59D˨5 .yGcLs$|q ?rk3.۹P-#@5~ю(亇e\ &yv4X]IIUdްw;@[ bVm+K1iH5 M8ۓj\m_>;^ޗ9rE~a,!Nˡt5[*M~3#-n/3ҼSE NW#ưwuTSrE~S'瘛3nJZoZ||E|Ԏ ~l!ք_K¯-#\b |8խq3:jcv?緲\7Gm ehenJZ 2 Gu|_ 6ss~Y:PXG#k>BG-XIQtcY;8|=m[BY:PXGӵC|zi-X/d|kƗ>f|}5nJZ7nz8c@kR kODCY:PXG׊`4.;igqQMxC!?X& ?17'|_ׄrďm"J9_0$8KmX|e;'2~%_f};yv<3ON'Γggɣy;y4O=n_ɳYywvEy[#>6?_B [M>-m˶A/-vn{qr^l\ahe.MeNZ lțpԏ=m( mu{ůu: /e2ok'˶ArGh-,X_)sM!#> }Ium"_(G;;Cnõ :~Xh-,"&.w>HwM0 \5CюΐpI:|tֲ FSY@roo=#6\덏:_=Y:G`M\b |ӭGލrKcr᪣Bc֒.MeIZL_r3~wƗ_XGV6⏑rGHqyҎ]/>O>ʵ?քKGkMq&|-Й[sX Ȑ!!Nm"V PGCkIgfn&7'cZDfGm_<)V;-Z'W;i.GS*0=N`Vˎ|7ܦk5|0'j4~ FSI냯/d|kƗ~c׌/&PfVtϓv\b}kQx+%o(3{t|&7~+/ɷA^M0&Pf9~+>JwgX0*hj:I3 !~mr7>򶈿G-YٍCҬC|8v;^.4mPBkMy[}4)JjO۲ N-n'Bn˵>*/"1|Q4V(IϝN1_FRsy_<+v5V3rg1dz#j ?r7>w~fK'P.:~_ }i$ի7w~+wȱ}/40Bn۵>;וzQ굆\f |: x|,{ȧ>݃hM:~BwΊ5i5|A<a>=R &-:졵y줝ˬ>_rۮ3~wƗ5Gs{.L>X{5L3vO'Cn۵>VcGI֤ ~nwOX̿>um" bFM\+T&\1VuΟ3Kˬxw`Jd˶/frjp\hm,Zzm!Y2^bo(r & (Whm,Z*zm!YQt' @Ԏ8;{'Y`*ѩ!X_Ḑ}w;+H\%MGafpxe]:-gI3zo|W~ |W|]sع f,wD!Ej7 3g^ w/ 7c#_i"NJKJ &\>_ҙ9X?7+Q|Q~oÊ<[XCbݖ*HOY6Y>} XQG|VQ套UE|T 9G(=e⯨||DᥗBmyPC~!>jF)|on|K͐ ()^з` 62gE^kB޳r8Jz!!?9KɾC2.1+~[EB{NaG!{9k H;e-gI3ٷ`GeXD ob2f'*͠G!{9k !wΒfoHYl VC3=Br u欤[0*~!3]EA3{1;#-i"x/g [x5uSYL-Xb5]wёAQ`FLD,Hq^O F!G>c=_ 5w+M_K#MMm ~ݥnV|{\4fw4S_izZ8$Y /sތՍ36)Ldꐻt=з`UoFrD`m#B{l2Mh!w̖O|5@߂-Vu7oAC >n^zVp`L1+Sҙ#gj[>=u7|ތvs+g'vQX&I{Q+SҙGύGύ߿_\cX#>ڵDVB/YK} 1.[>cOnf ڵY*Mﻲi"3_GI<ꔻtY,]X%1ЗnjS!ږ3vvRؙ&?QVܥ\zZ8u nd Sehى,eQؙLYVܥ\֬F.Ê@Eޛ{XV{3JoƑmA U:\er-Qc?7+Q|Q~o/>*Z=KğKM/|X)kyftd}^@Y$MdLP9, ȵtsF,-0ύZ=Kwυ>?G`JOYۅϊ<ۍoۍn|Se-|.abE;! wF ޗ}HeufEUkVzzv";!|wi>,>eu]:s6ѷn|S?on|W?_ׅHGVWm OuᣏKm >X |Fj1"v|J+Ko9]Q  q/K 5+=eM_hkg]svwri =@%w얳[p mzvį4|fZMKi{]8lk9۵GM4avzri5뢏gY]r9K;G>NL#wCGEUDַ%M06j#>^*K7픞>^#wC7EU@[rvtri5@VY]r%f߂#V8eu5]o#ggfr[iWꭸ-g@|&S‡ru82hkEV!Bn+>|] %wM;_Nu Z3="K2MdF.Kiu~Be:۵Y*Mσ*= i"O %w0ט7픞ᣓE38q3^8Y*Mσ.= i"3##/tZO)|/|||W|]>bϺGE8D.L?ߩ*>U]O)q]ğŸ^Б])&}+GM7?_\ ;V&B6 G)k^k X_\ ;Vޗ | }v&Y((᦯uw; |&j8z!jUGDK,i) 5ծ /xea_un"G/vZ |F@G< !OΒؑG]w?>+.HU7B,wF? |@|rvrJ|W<p:2i,i)X |N GBh;_9;(7z?O B|Y&Vqu;P'U Lr;iA\-Bx)/!3zo6M7G ()˚b2t;oO9;!7ONg!@|.^Y en;fC@j'`ӻt(=e-|FrX #;gg#i5L !Obׅϛ~#^&i"/~K.|>'ܥsr6>cOf,[MD,S?7?nw?neVD⥗s]s ^_msZ )X{,]۵>!|= ]:-gg-V[宻'ٮ@|>zߕ(<&LbOl-]XύoGMύY{~GZ!WR*q*T'^zL @~*9"g-V?#ed"obBޜ!g1RJ-J@?- dgPƄZxZ<3gWR~zѪzPKOY-8У"g ~$^>˳,nKQKOY ?#edGEYsv簖.[gte*gѓa߂-V/|/||W|]ѷ`U0zlT2Z`?4MR_)T{_<#L]N)k#1e;/EEz>4Md_)T{JrK6L`"k~}hu6*n||fZۍo7>"ZO_1!V#@|_w^KOY(pdvv Z4مPgmU3z>B4#`؋]:6s4O4_|>n">۵!V/|!>[>cO:q3a_eB]! VZ |GĽ>r%Mb5]vXv'}i"h#` 7Ga[Nf2yjhٕNgpdȕGa>,?(oXи]mZԪi"-gW! fiFgq ..w~X.=e-|E3W ތS)EDzήC@j㯎bVVKg[!X |9DRwo4]񇍐ǟ ?>~X.=e-|Qg-,YkC|^g슗)T@U:$er27/j>*!v&.|Tߚ[QJOY((.- ~R}2q}NM]+B8GKV@?aUW+=en+#>/i"/>߻{QJOY Aogk !7K/#e9ϓ†b~~|.g)= ޗ}LOYm6i9:Rtŏf,;' ߆#v}߆JG^z̵]#ϣ.|;ZwBk/=eoZۍo 8r;i?oo76_6/|ֈ9}^>JjG)c^C /~o>k%Z{u!fJG&~IjJ=en|S?on|W?_ 5]-SǺGk ~_-z~#F|Ή߻&_#@ wo~ }o||Yo/l[o|uMw]w]ۊo_gv] yGG_Y*Mσ)= #D8鏒ՖV[wV}Iț8xB9"ab5ܞBo])&z7ŷ|Y S.XA#,&8"$tj׭ 1xԮk9KγKXO,@슠BnVOkh'PVܥh>,SGts o덬,Vfų䊈y qi"+j9J$~bՍ,>K>HDWuV鐶0ڟQzzv""~{~k~?WۜF5GG!V?Cgd`"Y,;rv!uVݛ^gc ȍ(=e-|e fEo}2뵻%Mɛ+Koe@.wu"t.[9KC~GY|X^z??.6Sg-]{U-z}KH<ϻ"VF:^Iΐ[]:H1 *Z%MX^z?o]:o_ ygዏᥗk\k t,g)X%d)][Dިfw?-SB3td"6KOY ~n[)` #Y>NvF, m,i;RLŷy ;k^%~$-)uX7i>`#_i"&y?DTz`gKMӿύoGMύGZtsםtd]Jg4>ovǹg 3D80菒աw錜%`߂)Vbĸc_E>Ky~oУ2M({YzYL-b(+G‡?~oݦ;nǶ}+g7}q4L<:.n9Kɳl]wOxwݷ;k&dnQi"O$eu]:,i&.S~sw+MQ|\Gt,=e-uϋOo9Q = +D8K{Βf2*h. όl&1qގc]]Vܥ!k3ROvTz392= q`JVV+ 7ℂڟUzZG'[*I^+]<(T@U:XV+ ǟ9XJOY ?hd`"o`VB;{P9LV錌 gS8Zl/sVzs@9sv&`O 97~+ϝ[j,]EVzB;v8/&`Y~ S7Nl7y 꽙&i"svz/&L|P} d`JOY t oT-ٍ7vĺ<]6FG`ё)K[`b(+GG ]wCYlbT-nY*Msw(= ;DvGĽNKg,iX |D ZlF?u6;ڵ.!OnTB4,XꔻtY[`b'_k{wݷDٍ(LqEβ:.s4+ .n|nv/k3R'PZ'ڵMmvp`#SVܥwΒfECPsg~dB[ri5뢏]Vܥ=gI!XύoGMύGzuf,] ?#6}X_w^KOYo/|܌E|k=!|g }]:?]ѷǻt{T։vBvp`@)w鄛Ixv9b8ZNOEUx]svRؙ&l VܥnNų{ruŸvB8KCn+>|]|6.;9Kų/su,܌uxp*5!Op)r[i52/{2J|fL 1)`]kfi JI!L(8{+* !gؓBvAQsZ9Ū3RO+;,1* ǁ*j3S?8;X~4x8,ңP9lV`Y܈wÛ?XGVwr&?%Ml!}^#@9 U]O)u[8DJ!~kN_| jڅ񾋺- YZ=!Ot,jˁ>A\VW_3So8eD3WssMyrvJ0fio;/BH?&>+ZtG}o].k)k3O7]anA_>!fi5XZ-_H[wKCVzzwG_ߏ?k~ozm.M7Gn|Se}^ |o·)>KKMsёUwrx7]n3v*#@՝VG]UW#~O!v۝!VXVw_fdk/=e-|Frx7`yxi"#g7xg+(GY~k/=e{X4+MI_|ğ]g굗>vn8kx;"DfnA!V>$N,io_/|ֈė4I ڂ˽ƟG`A|I9Ň?J=?/˽_ύė4_I' =/wM|]^Yx.q/gYYxL݋t,^<[33ul]<^<[sste^<[ųųtl]K|y_|Sz,࿗~_/w<9&` *]GDo#`5,yiB%a߂)Vqu'ݜ ƣwDi*=em]#_i"_Km ~$>Q|Kgljc=u0nX/1,9~ =XGUrxg%V/|/|7 >.K~}_8Do[} mt*=eG y3q*%~ć^>3> }ܥW)|u]<^<(_MO]e۾.-m ~7.g܋glŷ/kt]D^|&~uL]<^j_i"okh<h_υeK^v"/M7v7ŷ__6[jU-z6V_@Y*Mӱіj^J'V!,hq[mzQ.i" P}1Y*Ϟ?7)Qs7?7+Qs/k㌷eP+Qz1Kn^zL@w I,h7  į4.>.rG߂-Vu7@[N OX|C N,h7Yvį4-g 7%m93i u7߼ ovkTwe/= OX~g< !w΂zZro«Z;g-"Qh&}H<*_9K} L>u̻^`c&+㬥d)L>Ѳ !OΒ mzvį42J/Ǻ k ~ݥC|޴Szz~M/Ѯ&B|PF%>>wtϛvJOY0Rcƛ:QnB xBn3zBW8eu9Kg#V?CgdGE8YCLrxXCbK欤y^rjy9t P7kf?rҥh)T@txҪfl9~⡛ŃZBϜtN * N,iJ|+KͱѢ"ϰ<8dO9kAJrxJ#ZFf_Nves잨3"qFķ{)T@SV+ 7cBCP/=e-|'OͱQgX/HTލvjˁ}(O_3ּ]#)&z7ŷ|Y=r`DEY7C⟙!VKijJ "-kvr҃xRh#@QVK'4} \^7?nw?ne55ٮASD^ &>Bn+~ 7g >X~&hJJ!~?~ᣏWK >X |F'mzըc]NuLIû(L>m9'%Mc_/|%>ڵ oGm otGflZ%x+wQ&>r >rݴC=e-|̕mz_u/eVr擳3Bn;>\?O>r}S§h!?9k"jYA\Vܥsb\;TJ|[>N(ׅ>>'~ݥC|޴Szʚ Ghʁ7cW{3d* ytNzYmzYtM>}xYw kFsC•~r0r* .M#>yxVo#g ~;,-#!(M|,iubmNҊZBϜzKr!,MO=eM20"0m=O @g36id,-h:;RtNJVo,Ir"ԣP}9+5ܞBϜ%MgG.Vs\U7%i"Cr;i?!6hKOYo.!|ǣ.W|{Muz)|YG|S|MV|ۍo7>+Z+^y%g ~ݥC3)X[YDqJ/]ߛ]:&ֿO?7w7[嬅IO_7Gcȍ.qݥC'^{)օJ!>V)??;:Cnt.hKOY b~%k6&x%i"|8SzFpmMz!7u9KΎ]u=܌_cIH9kF^g-]:M>Cg9 '[[%i"|8/= 3D,_GÑ)]ұ%͠; 7c#_i"NJK6.|C.ć;j3 Xu;Mܒ&GafEgz B{Βfb· 7cn||<^GM7?_ 7c#_i"NJK1/Mt(=eMY.;:f7qKcGafȉQ:vK,i.S>ÀN:2(DU![Ξt,i"OA\Vޥ3r4g)V땻wě_%M=f&p >#SVޥr4g)V?hd`EE>kNo9{bOO ;=BNhYX6YepDݹxNXO9{P = `N gvSօ<%&Bߦۺm /u|_8?XX#⏞'R܉tFFjV9=i,zo|W~~o_|>+Z7?D moG`m&f)]G|B|{S'_L|B >w*v)ߞzį4.& x!>k׷t6Q7<<;-i"<ﻲjˁr mlhGv秞>#emH6ck$Mɘ=RVp`@82eu]:s,i&l D宻\eu]:+gI3ٷ`!iIn滛ý^zV_ B[Βfo_.9Z_i"K.| ^/wX&>l_XGVWG }o].#KOYo|W~ᣏ@[~q3Ѯ&B/7?[.⟭em\ hJJ!o]m\#@|_w߇o7zZ=w]xW]!=y +D80G`pYrΚ9;s+.&Vqu G(܌f۵. !wdC4'hYYr:9h8X%F#sލZw !?9{ҥ)L9$'pdԻtzf>.G>CM?yG0J;gO]wXS?~w(_#~o/>*Z=W߶۾m+}Yo=.|Tzį4! > tM|-pŷwG+MQ||{.| ?/w<9[b·  n||ۊo7Q|S|Mϗ??CJ!yᣏ(Kyr6;rئ6>Ѯu_GD1!VWblx>>D3W'ڵA1j b%h.+>ܿ\9pئAv>C#g25CnVoCgR\Y]zYlvhb5{ꉏp^ ۵A aj$>eu]:X?7+Q|G ]w?&>~w)gM|,^&s ܥc9[ekwG|4%M }]:g I|^"i";gO8YZ 3.KG?,S)#rXwg4ٓN2M}.KsvE&V5y3q*%X&>BnVhI|/wx&>&Vq߹v m/ ۵>!II$);(+/;RSӱ փ?NTf{ˊx3HI$(T@oT$tTnꥧ7 M,׊ >HN% ߖj~|t?G,2&2r6#]fjCU]K&X8Q X >6<;]vGG.VROOT+މ@?exwmH[ms+RБg)]b[Pg4>V)= dtfȍ6%#E 6XkXl:B [\^z'\'z;ZwO^KOY tXkgB[Ξr_lz;Zws4 A Ds6rSu疻tVSlnDV!OΞt6˕^Z'۵ӣp2M;Zwrvp{]Zw_l)&G]:gS^oN;hj!ȗ~z-i"0$rs]T^~w(_Go||izk}#F|k?K#M+ʢu^KOYo|>kgV oC ~$OoC.lZ.ծu>&B(HyG.I/|S#n| @GM/k/6-w݅ mZ[OξwۇX%~Ît b0*⏞;T~s{7Vfޗ-|\!|?] |S|MV|ۍo7ߦy7]?ᗹB;[jk|r F|J]K}r&Bo_H[wD`m&] ˃Z[_OzO O``R U_=gAC=e-|-w]c>[k!~YORx2M㽜z? !G΂zZxau ܌"=ڵr㽄Hqu瑻t,u4 _/|܌E|k=!|[|FZ! ~ݥC|z-=eMC?7w݃~w/~vIsC“i"'֝G=g٭ӥ!hX |X&;Ri"|PfQx2M ;Bk\lC2K/׸ 6!>[]ٮ e^'`G.k)|vv7ŷ|Y #ed" :k~ɌxSz* 8C2ZN?a 5' <8j@|{rc3OrTTRS*;j(ql3l9ýglj9U:X;+ _!hX |B<]6">;k,&w]Gr9+-U ȱC9f٭ӥ!hX |OlNOh8dB  D=֝B% An|S?on|W?_ ygV Kr[i߶%uN9Kѷ#et8Yzz|9$M䗻Y!V xh@psz<T>#tdyw.= -D8@Us4O48N|_Fv #ڵǦNF*_9K'gl$>4~w$9]!W:!V߄g< !-gIDCPŏfv;/x=>tV_[M7Gm ()Z _ ѮBRB4<#@V!T~kwG|k >Bn;~G!>[>̕;ǫZ=?9}CB4<#iY<J rwxգ]+eWr笇U8̐+ܥC^[)k3nߝ͎vC >'+=XGҡ[Vu|dZW?s÷Fjc}]:s6T}wG|k]!|qBgyo߷]:gSg,w݆G۳n" JSm2vf=ҺB{ΒICаύijJ9%)Ř6>2z)kg 651Y|Z|.Sz* -hBMb5t:>'|Jw=Grཛྷ5H[ms͙Iؑ_N ڃ]Z4>V)= ޗ嬖yc>6nNz?7)Qs7?7+Qs/kQLZ'zGY*MσqJB{9k= nWV?G`AJ!>V)??#Cnv%hKOY Nyep2XkxT95M笇sUS~IƐ[!9DH1j3Rij[Ѯu+g=;<> nrk;ݑ2C>ܮ'wAGuzGY$Md笧S&9r#mݥnHΎC~sw+MX^zߞ 5]:G`m m7ŷ!7OQ|S|Mϗ#x#^KDޟ"<=]r#mݥC'QzʚC#w :ٮ@n1pxO/i"1v&&w]Vp. X{_U#4i"-o0"M$:Qά.+X[]wڛǹ;"i"=B&(wYmrsGX[]waB`m#,&2bz!HLb+M+gIyvYbOr_D`mA>cQKg]z^_u[Z=?Jb@i9^з`ImnsV/rF z!d{x/g KVW[ gߧ!L)L9gS gY-i"/;P.69G`m>h鲽yo fޛ%M$ !{9ku_!-gI3ط`g-] /yYg4>Oû2B&嬡~!mݥC]zz~!;&B6G.uXۥ?7+Q|G ]wG߂-VuqB_;Ri"|we0#M$jt,ilJ|c-ww` ֛и]B{ ^3Db`OYrj9K Ajgw]x5lm=Œ4#@@/]^KOY R]漻«Zg?bz!H>XVܥVΒfoGk]wᏓZW?cz!H><=eu]:k쎯[`b5j]װf?NkTwHf`:.e9K&V fvO1p aFH X:.rvJ]XCXGVWqBW~|^ 8.#vJOYo/|܌E|k%~'zO].#vJOYo|W|]I/|||W|urj#WIH x &׮I'z!H LYV$잳<GEQG/4GW/|S?~w(_ |W|]^rދgxx.gދgٺxx.i_ yG+Mcꂿƅ>ķ!6.|G>=t3Tz=o1Lo L )#/'i&zۅϊ<ۍoLQ|S|Mϗ(v"o՛!D!VJ c rYL-8b5qH:X/ kNo1Lo L)Sٞ[p*;I٠ z\Š4#eu]:-gI3ٷj3. FCE5km0BX&}xheu]:;gI3ٷj3R-cV>Ky\Ž4X#@^Vޥc9Kž.V/|/||W|]ѷE0=Xhzc_}vz,ϾM/|TuS ygCrG!c\j7~n|OSz#_WR.| |>M>t=sA\VW_,hJOY3t.[-;O4'NZ?JŐBxOzovb5{JcA7s>Ky<EH bȍ߻t8K͎]>hu:2(z<%x]yR/4x/g Ő[]:3gIّ {g%MY1pTfNZ |NŐ۳C|Ylvb;&B|z.߻t8H7Q|W|]o]~m_ AJ!>VI·}K߾?.= ?v32I`&hxeu]:+gIy,;Ri"|O,Db`%q+[9KMw .|ߊoo7 >BnV/v/d3W8kGW"zGDW@|_].'gg!V/s?7Q|Ss?7Q|&>sLxa^>/ۢN,i} X |+VʊVo=N wWE!r1`Q@K,i} X |KWlL^$GDL2 FD=Dhr%o_/|ֈ?W+"*|lŷ/kQLmOj싾IVD z 7ԛ!7Vۜn9Kc߂)V]QGJ!oE >D 7Wۜn9[0jc';MuQR4;N)d{x/g4܂.b:9Kc߂)V>/|ֈZ=Wm gH6!>k3>Imjة;Ri"|weQ?O~~!mݥ=gwط`U/6O kov-'R 0B 9KþK~ۺAJ!/oSۺKX[a{y3wċ$M 7Cg|KloG]w?>+.[j3#o:/ zGN I^:A= xijUrx} Xqf,w+M}?Dž>C.KrXkb]l!>1pZCU3*=~K|ݥc 7c)&k+GM7?_ 7cZ_i" ^y%g ܥs6qvboXGVWqBW.|M.{|]X |Frpq3^_&j&;`pBc^`r]|v}XV§#Rfyp*B8->zt]:;yG+Mg%WgldiY%%鷟}ҾC첔DS:o3>ٿPDD܅Iυȡa q3tú+Y}ϋod⟌o[J@Cz./a-ਸ਼n.S/-d lAyZJõ;W鹠ludwQ/-d3l ޞ.oqVrJ-`sBp^nIVs<(D|k%~۔/>Y>djҪ{ Uwc\+%D<ΕSz.Oa8#@bUջ} u Nۋ3e|{-o/ŷ8VC஺VkoowRυi"luxda݂:>hZuwcAV>Ky֝+\(&†qXG`Uķ[N[pO?/σ:2yOG݂~zQ{%H!^ !)Nu%tNQo/+Zi"ķ.Ɛ۔Մ? )1d̋L/p6kDo(Kz.TO:$ zISd\Xװ0\uKD+B4o-`C _U?KB$ҋL/ jvkk=܇|CYsz7 UKB$_|/*|ތ|?D7%GNϚt|cHsc`-< /ot_" W=#QT]K³?%Yu|G q"wP`v?w\p|N.!r_pJ++ d/i dUD/{v&9\ޗs!rl(~~n C|(wsA}Bp^Vɪ3wdz,ryBzCa'UKŠ5Y{1W#Z ?ۖ_)?G&|Vo/kc.blh~"SVy+\Py_o(#@VKKkc5Yu|xE.x"S= mYu|F@ /mrdkއw~w3~;Cn[V|;g|u<F??##e:#Q&_V||w`A&![I>#@Q )jŪK~a?K Vr۲pWPGjw"EMV}>fį3#e:ğ3᧻tz&o=im y3_>)M=#f?5LGįZ]:mɪ3UțwəKr3Yu|LSY{?Z]:LZ Xd~Vʈ9_u44BnGV^aȍ.qKyT=Yu|:Zu;0*jG\o4BnGV^aȍ>eKgzT=Y%` J;k pԎh?m]=N4qe* %ݥn,KxZuxѺ Ÿz.4i03jIw0>tӪ;FZ֎hmN Mt QjMwpƲ>OG1YmK 3s!r̓J(m>kSz5זi"~ O?[9'y-㟌^-2yOG݂:>}C.Rj9yV&4Ϝ&RܻSzý*CnLtzi[0/>kY=G{O%|?#9 ?!>kSzgIkR;.;gJ z;H:<*Cn}P`&~XsZw/e |,[;:kE~\p|Sosyw ]t)ʐ[?.>2kSzϛď4⯚$|55q!7֦>2wƷd|[?_V/e /% #FwN^z!7t78Mc݂:>^9Vbތ_+jGY"Mcwlsa嬮~!mKgzt-Xɪ3ЧU6L Ô;gJK NsaNK-k $ݥc4.+Y%Uw5XP;bɥN]:ztd7i"EMD0tJy[ȄՖq?e'/k&u-3E+܌7.=N' -ߥc4.;Y}gW/e3}Y_|#>?Z)⯞WqgKw?D?F_=m$|;Yu|ƞmT[ųz|H̻v鹠YG'6: aUrٌ DWSoG%7tX́ M5އ5arٌnYеRn݅vH:Ȅծs[IDqV&B>BnCV#@~KgyCn%y-㟌^-`?'n%e3Dg,&;W0uJ uHjwlop~kkK(JH! !!_:~ ?ݥ!QU:Zuʊ\kuzMY%X~Ow N3X$~;'|ܦ>w/e}xq3H)MWMY⣎HqX;>&&R+Q>ՄwՄ?ڗ5Xk+nƺZo.i"M 'CnSV;Gz]p N3X$Ԫ{'Qr|&pq16eA~!mKgz -8ɪc2ZZuZo6Ni"|8L0uJ uhat78IV~V݃ezY՟囜2)6 p]: N3rUǧU-FޛEYi"|L0uJ uH|jƲy]Nŷ[K'|LuQHwX>]N 5Ū7$FY79s eJυ]o0L|+4.'Y}׃y2zW?3g׋2ܒوK ' s l@|m k  _lfOIV_aDat#qȖ ?9^=" džS:aU9S]EzW_j̈́ۖ/>̈́HQUg ~foޝvo*&JPy_o#@Xv%M>\'kpԎo6 ͐ۑUǧkқ^\p N3 h?G`A&+|܎~w^>_bl0ֈOi"[ͧ!܎fE&K(ڥa`LэG؟S:lXG0tN4HVu>#i" '|?#|3]:G!kQԪ;5|#nVi"]tim 7ՙifɪciZuSza툻j&}Qk&a| ё 3ݥfyAdtAd֎Ii"|_oEO [t[aut!??Zo=G-{RwCzVOn E:;Nfo6v_IOp)]au9Lٟ)k05x&~(Q8.6~O lS/J8CVg*t+Rd Yq"@=<5 }Z]MBذxJ)Vg*378bE:>he[/Dgp!ocȱas[ڀ?au9ZDXb%~Xs^9쌿_+Yu|:r=Ya.8Vot= * rV[ s78bE~O}X#>?Dk?%)៖kMQ6-}X#mAF՛v BzýCn,ًm}Xq4lnrޜ. +vcːp/gmVWK3h6+Rd_ۃQ;&B~ [t<Ŭ%|Tɪ3tUwэ,a5qjzLtp/guŐj#͊;Yu|VMG殺]UX;JJ}{;^iRio*?ް7Ȃ5v#M'~~ wx\O,߰_UX;fDzH04jGZQntV)-d(j5,έUR/ݗ$NޜB`[.ϐRvu ,Yu|$M_+nZ/ iLJװ%NtQ3mmY [S[`*E`)Wh֎?"tJ rVϋod⟌o<8-K? /_׃_9ywLuyxYI<$^W;< [yaAd)v W\r_4Sow!)ttqX;Xx1W6yoWUS/Oܖ=uƴNwUxƊ%Yu|&|L'SB?\6;WЃO_0rvKYOۄgHQUgl c Z,&w\VcxUԫT(\Q&B>BnKV#Id-]:>*Rd<§\!tQ՟E?ϝ+WAUjq~q([[|)JJJ?w9~[*˵USnݹrX%>C#@D9:Kw霦iHQ/>>;\+#M'|ܶ~QG'K]^f |, Fk%ͭDz;mYu| Wכ .O1+NC+;[ĕ!-e3}YbP|祸GhLVxVBd/K-Yu|Ѵ6-gQ5C{oףP&y菒x*oeáےUgMn 7ŷ_^j9MTjQ(JAKl7υ-S(d:Ӫhί;rRoK1$tuGFV!8xߖ:>E~r0Sc6D᎓Y||$У940!ZF) W=zeEYďA|$j Z9ǩz5)*`U<8IaoEmȡmCVS@^OOV-cEejO{/{J\ޮh>Jix3lP;W,>Ky0"NQPy_6z?O@V!8VoJ_V,G.o#z5j?R(/S *sũz5etsh'jGDHQ{$/ uP(W EH1}h7ֈOi"ECQOi"z2~ ?nW">Jˬ e="0}Dz{DHJaýz0F&nWb(Jˬ2wƷd|[?_VOMk0zfeV/.̆ nԎ೤4lD%U_[< )V=i]Xݨgw04ᯩGIl z҂+Yu|Ѵ.  nԎg4+ZDP:BpI+H/ #Dz{?Hg<ˬPV݅ Д:kGY"Mϳ\BBU| xբK z5:Ӫ0"60qv?V];Wm1q` ؉jQ+2惏{RGLg$3~ z<):A">Ji"ķ&@YJ0[KqX[Y_qDޯ<gwpW$N8qX-lX% 2_烏y?3Hu>8C>~!~ )Vxm1x@y 5xV)M~2z=D= cC)ZRٜKʊ+Y}ϋod⟌o*RdKrnC牼_rOBzT嬮W~!m^TVX'򈏳zď4ⷞGK?c$~!>k+2k#J~[. "Xc)MdND:Cn]V3n+ onNVo i5x(E0rHQp!!gi_BwGF`B/>EFO@'`5\p!bHhJ%{5Q"vXJWԣU 5X;bwrJ=...W*'u N?1C, 7cjGXu!5w`tܖ Z]:+ݹr4ᯠ#;at7g1XGGOO-Y⣎{OqqR Ⳙk?25Y;~Li"~+~$K#g%-ꃿ||w3~wo+2߾/>>;\+SHU{O}<& ?ұ\B/,rW$Q|lՄwXX.Yۋ3e|{-o/ŷ/'R4^ϑ|L@=\_g3y1xzg(#pn -ݥsLHQ/~-/I8GSS2I<#@^~ܥC^>*RdGVA`[QMy\CP:8qXm.sKΊ5Yu|\ b|7/g\D:>s&Cn[V{Sz37+ˬoim-w~PWNY>"f?5F@CnLn:ù+ˬ2wƷd|[?_26 k~w^ o* fcI1ƙ/3wqR Ϛ{K&B| =ϞwK~>nWjY2?2y:? /닿փf+G1",֋oUk֪4e.֎kJi"7hqDУ0&†NK'6_R=2k#iZu;ݜ|H`DУ0&†NK ]~fg`^f|gۑ2߾UӑA.zԎD#46p-U9C4oOV?~BQbV\p)HJao'V/Lm,^fo/ŷ3'[Ʒ2>l(0^p2M|mw(D@ wظ^)&DoHi^f |:1xy7Ofi7rS.E鯠I󔎻qaQvfQb$;[Ʒ2⟌o^|*8ڿ԰x".'Ni"7װ>$D@ w: pC5pBQzG`8EH!W&|O es X\#kw<"?̟\У}/f^giDTQb&_|ֈzď4z?g4 es #F|#~Z4ᯜ?`=J'T$|#~ׄJەJGE:>El һ=]p)hIJaÍ^ҝ_ꭞ6ɪ3RUwb5]6kGYRTtκ46Y]oxoVOeBh]psXQ;U&2zGHJaý/@[= )VOG#Y;b wDp/gu.8To4TXɪc  Ԏ%dֽ݂[^6A1 ğUSIXJaý/(Zuхˬ!۴n3ukGiR NSRE x\%d݂:>滮UwcWfq-Ki"|8У&2  _ˌ;Rt c):R쏅^f |:1x'``YQ8rTQ$D@ tgNˬ2wƷd|[?_'򈏳zOi"SGmu_g¯G`B/>ܮ"@yI2㳤4 ?rU[X 4Xˬ?0\CG'kY])$Dy#p?,t9G4u NΫ\C'/Y\p)hJ_AQG`c:]:L@`^f |xM.m0Ȼ҇gi"މƐ۔UgtVgKNJz'"nIV?.Yna֛vR޹r4oШ#@VgK)s]^f |e7ֹr,Zuy\BV8qX.wsh+Rd:§yQ.z'ڝ+WQJ@Lw0+ˬ/s>;\+SHWr[G.vzUq4sM:,z'Bn[V7H]:LrJ52k#@\`&YD'Ɲ+wQJabO 3ݥ .ܮTC/ a%bl0~vw|zOz-T9yR O?/σO?/I[X +l̎;3b :>Cn+e nWjYϽC/c`bfG>R8Ga+M S K~o,ˬOOK.X+Q;v<;CȪ۪[ qK);X i F`bjDs9 Yu|LG8._ˬxUwOq`b]zjB))  եKH;6Geg JgEO“Y?d.,[tX`zEbDapEuB/>`9 ŷ3~wƷ/k㕣'.`Ԏ%y*OQ=)" =EuB/>!mOeq\H{]>"!rl6/\rVHV|{wƷo/e?2ϗU͔68V8g4>ϯw6(ˆ{9+~Bp^lVɪoeXhX|Hz/ЫJlR *om3Y}ϋod⟌o*Rd)61 1vD. +._`Jaý5vBp^lVY;b_=[K&"|i*Yu^f}OyOg) _˃_KgEd>k3~w?+2߾_bhy=v#M6zz2>rִ<~~/kㅯj՝+U!%yЃhs'M/ݓpzT01Vɪㅯj՝XJXXP; {Xu|!qBp^+Rd uӪ0#˭ٕ#~74_^{ءX%~ctUgk+2k3Uw_/cW֎m1D~[&oGVqF̔Uo*Rd?/eϋ2eO?/I|Y_|ֈď4 zw_+sc92??[=GBO?s$ /닿ʋ>Ji"J =rfȃggYYyX<˃g/Bga/'fqz{ϻrcw{er])fMzU8ڿhŋ` s]7 @ ater7YT'2w/N2~-_Y;b#៞xLu$(C| \6'~\pc܆:>\ *e )UDŽQq"oaa/.r4qBp|S/o;^"Y%xvD`oXU?ף}Ѱ92 L@`^f | &`D/`71\ps= Q ^J' y؝)UgL.ۡcp׎0w=26ez?@YGw3Y"Y0tU 5ڍ#~4>\s = Ei"hXrVY@|jE`KJ|z1W6Ti]@Ԏ8ӅeޅqVr۲J1˒UgFoW  Dӑ=Hg4>Os= Ei"hXrV<Y[_Q&gދ-~p!wa OLK[G[V!p{]^f |Ά'CGZwTY<ΕzDv%AYS54+ˬ/s>A>sϚr3Y% +ˬȋ=H[fj"dJףP&uf*? 2k#\PX+D?F44CEV!])2\wK=z??J~m>oW O?/OƏ-`⟌^d2ļ bq!s= Ui"l0Bp^ e |:ZuoCK m A&Ŏj"#ޒ۪?ugq}.WS{K %*Bzw\MBpygWzɪ+/54<؝i"7ӈwzKnk :-cS]=2%<c%nظd֯iD~ V閳8\2ZMiYHΐ61Q莶' )x?ȱ^vQ%) :Ou^f |\ ky2˟E~?ϾG!WKIJ zu"LVoS.dݽϯw$5(ˆ{9+~Bp^Vɪ3$m[y2i"|_I]ԣ}pl]ғ/ͨH1^-ۋog|{OƷo/ee}|Hs&H!W{$|O^ ̄+̄חU|6lAn\gQ\pލizDp/guƸ]iTvGE:>&#ӪF8Q;ŸEK?ϝ+[QJپx CnNUw4vDE:>CgZu=Zbxv%D<Ε-(T^z!7V4)VmQ;&B|5[O?]i^f}kyOGGO'ך{I<]i^f|g_Hŷ3~xAE:>\UwD`n ֎QDnУД&†JV/ xcZufCn`툻7Rb = Mi"_A{^ae?zISYb%sn̆(z},pԻ[BS~W~qZt2XۡY_1|e%>jG?Df#c k&5|veUw@EqQ;:|#\v 460V/C~BMNV[?'[?>d⟄w:>^V / EY',DpxCG)) ?x"w/ w/eaL.ۡk:ypVow˥/nh׫ [zǭQ$_V|Ȼ&)MbWMYⷖGMQ6ˬЙ\':7yVd̔&wz];ҫ 0#nWB 6ul'nY}5Ηժ|(ܥSC/>="|z6'kGY"M3\CBWL]W~!Ѫ{z"B+,Zuy\CoK֪KW}*/Nz*a\0ZnCn&ħnSz!7-E١.z5j§ ,[K)o(zDgظk *;4eo/ŷ3'[Ʒ2>#eSrzϱ:>L [Xm LOr  5imUOS CTHɘzDؠ-``~Q7C/ ժAZx?R;"NmySwCnN?ˡY]MbȝVwFi c=F`#F@NCY?D]gUz/?U\p^Oam.t u42kc<%nX~ɬBoC3|DvfXmlx+2kUr=UTOfuz IУ96{J+T6 j)FJ|\IO@g;ɬ>\ȁK4'O1wWHV[*#Nuˬ-%mbG`f,̺DWJKQ?J1ַ o%MgE:>vH\'jG0(Dy_Tek 9m>%MgEx[.ۢ'еgX;b{i"֞k 1esFUNMVV|e>jG?Dj·=MD֤r+q)5lۋ3e|{-o/ŷѪdՆދ#Fs#UzDw}ϒ^gȍU.ʪˬOGQ{vX.%z LnV]w{~gvޮB/>滢Uw#Ybaװ = Si"l rs8m%`E:>滪Uwэ|H;WУ0&†bz!7v㨗4)VJ|]Vݍ(Fff)M~z ,̽U.Q~gvve/ktdbrv &‡wGa*M u͝ZugW/i+Rd:Ӫ樼ެq0wJ>zMђ0&bw^gmNwx)vG`AH!~ ?ƃ?f_##C/ a֩Uެ kr)47 lOV/û[EYoSQy߽Y;ŸE?ϝ+G虿L|ծjh02닿惏[)#MxC'5|l'05 xIZu~ͷ]p^Q%L%(a =~gƲ^f |,;RȻɬ\A{/{Ky>)jOes?z5GOundeY5CBlIo0B p K 'Dgcș.1xKs>ŷ2yOƷ>Ԅ2yOCE KV0]l v-1d..8Q#/n/GT8ɪ#Qzeqd. +<&!_H`=T6.Ɋ'Yu|\yt/&rwkblܦ:>~uJo0 o%dE:><&`DD]gn4;WУ}p+q`eO?zIZ*ʆywxV.zDpΕ+(Dy_6ZlͰ:Jԫ5-ɪ3U"`8j)MLcܖ:>Io0]{KS/g|[^-ۋo|Yse7{w=D6Fa3f?e``ȭ ʬ!E`U[se7[0;糌s5&lLVoKo0FZSJY%dؖ:>&#/ʆo`x;/_58$!7UCnemɪcE`Kj]OVlau*⪢Ygi՝ X+iG-.`QJ9=T32ki՝{A&ZT1|z6ߠGa+) LV/LXY( 1G7q&rA/7=?-Lesdz;[Ʒ2o .ۋo|YYlvnOf=(k8SzCwe,M_%ٟ/ob?'fu!,:ȱaWzoau94)vnunK/X adj.W( Qw%WI^;T6guf"%~e3L axd%D<.#(Dyе7=]pWTdjfS`v.8RAzқ96Sn^f}'ᯒ#Md=MDVrm)|ko?9 V/e3}Y_3|ֈď4OOgjG?Df¯#וL}>ˬ/~k>k?SVX;AVRo5ෞX-[>\Uг/l#~k+)Mf2(Doiz{1ZuR/i6+Rd׃į+GJ}&^Js=ˬg+ +awF`J9/Uݜ.M$_|/'#MxCY'YY. =Ke?gQV_ŷ3~wƷ/kbl8^_@ԎDo(+􎿲-|Q0MV!8~W/i|c$seԦ )ރW!eZu-`ϏBp^rIVa@s !1D R䏽am*+?!DY@3ջ<`ϗ50 J7U*0d֯,Ey{Ail8lerq^f>G5)#}ncw|h#-kũz;[Ʒ2⟌o^|0~f F7\qUy R@x,CVS@#lɪcs[hywZ(yr3Yu|L qnS)KˣG7%_B| b.8V]ŽG{fȭ Kc'c3Fڭ<N;G̋&giXe=fQMA{4Kz`p7YCKe |δ:2صwHE5;Eӣ1͐Ln3.e}|X# O/&{%3>Y Ӫ;<^XTң/QdY@|n.ˬȟV݉"ku|CТȹ{h8գhqm qj,Zu9.ˬ/Y ׃_C&w¯+.zUV݅!౻>]7Pia*s]:+2kcZujꅘ?ˉ= Zi"l-`sڮUw js .+Yu|6UgsW݉e Wz.OaGUg|+2ƃTP/-\'|>Q⏑xX[YPHתk=vm&#/ʆ%0 )^fWs Q;&B|+?R2Yʃx)mߝaDjG?DF¯=יH}<(YB/ bblh~v]{JmңEB4oo-ۇw Ꞧ^ɪcblhvVg툻S?ܝ+\& o> gMVD]nl R]GS| CB4o(G SV!pφ - {6}X26wgiZJ<Ε&=xC?J%wK_Vw^0Jo8?ƐۑU'~*ת^=Yu|FʴvS1q a<\DΝ DUKB'@Vݎ (v:Gđ D Bpz=Y%>[F`aOe޿7_sz7)f+)TNfOo8է%( zt856 nm6bއU(ld(.8Sw\P@zKp gZ>\*mѳيwgcPz.7Y]0q4W%4l N&ks16x2FUMDoPz.7Y]06 ?K"+Y%m e& 9/?.=T嬮Wr\1NV[?'[?(d⟄";Y%G0k7Zz!4U9?p2ƔӪk֥4_)Mdwo8E=xý5(%V_#+[T<o8}3$4O{9UϹ=>Y>X3 kL)Mcw\s{7Y]2BڦUA,?/eϋ2eגO?/IKx!bl #cOo(Kz.tO&`Ut=>OG MUklvĵ;S7%=xoxժS: P-m,dj*db;ki"|,=M| 3V1J@a"kQڊ'J7S?ܝ+\J ժ~fe@އ5GKɬR5 cHs(l+OJJٿ0X`td 竼)Xo[z.D@zrĬҫ O@?lNއ~Qw/Nse[;ۗs[g#d#Mc$ F9G!*kc2s[l^ NfwoJ{9U_Dٜ3K^5Yu|D_+Nfs7|ۖUG|U_K?= )I*|.M.[;@|e˩ފp0f?-%ƐcqJ7hK~dڃoΉۃ[Gdz¯-)Xn %?[2?2Y? %?[Xm\ΒGXli'NDNٕasax7Y]1ƅ)N NY%sVݎ\7V'jZu;zORYu|V5qNgއU 6頀z!)j"wEooD4baS:އ5(j"H.8Ro_oD4CtCnm NYs$_Q|ֈjo 7"4?JU> {}Xۋ3e|{-o/ŷ~jt k_k~[g9$ ON;6sg6 QԪ;1W"vwnSj"}Uo9vU D팖զbžSz-E:㮏\{m Dyaa+?7>gxfk]X~XYג ɪ|g?黉$A mZ #p$UeH6.pvd AGjYڼQV~ _4rx 1&c^b\Vk>X_OJi"J|%8|ģ_K_tրtb`ͬe36|A-?ɨ1 r? )-6L<"|";\Jo=oBJ+eRL%,2$w)ƽC[:<>y̵4Ҩ:ڿ0UW"fJM:A U4 r? )XmlJ<ofוD Mj?Q:RYH>X>>CKSśY_)Mm.↗Uqp-F~oHe!%` x CqedM/v_nxy_5g besQRrVݬaJXh橤+ DžOUq{1ף}`F|*es[/DJi"yoqaJQqV,u/ztž>X>! ߽k STʯKr2 4%?k _\>ᏙGᏙOK|> {V`u UTwrZ$gz5Z SƾĨ= =}|JM39!->e zXaJQJu[:<),ҨO3_ z e녿2W1WaHxcFsg<~ ~!|l?+55ϹoG ?n~oK>*ʆEa۲oU m`6-܎ʃ%ģIq1HtGa~/j|k,?nj8=~?n> {v`}vyy5؜'~k|ģ?Zt=}^;?y g灏xTO^'GӨ_}>!~ ~|̈~Jm&qKGakZ?| P.@5۫&r'hLO h:TEX>B3٘˿i"3|~#"s#c=[7xKGQO 4䓑F|WwU\$ 4#=hn x|58\8k!cGo+nf*CAޮE`7B:[ZQC9x5S0!u}q3,ޠ㍃ /陼!usVß`=dAa }U{;4dj?*?Ve>EE=- !z!Ǽi8.@oǩ5tK YgYr3_ )-`W3 d;//ր)[\_u7#H`/X!{X~KZ$5 4%?w >;ԭȫz~JL|CX[_{_~ zkZ?| s7CʪW9 0z;VtuEW]Q~Ko5d؝F|찇ajD!{;4dX~KKƅ,ӨO |=l0_:25,# _Wd2\˪255dEF|̧aZ#MWZfqc-6ܢ3/DBOWLV8iTG>}=XPuaz djNo۵[:leg_֔!K B3w9iTm,ʺ1=쮏'jNWsTs}w{(+ϖGcbw{x0G.qVO:VPwe_Wܷ}UUN_(Y/c 1)@ EYؕ-CvIGcyR@GIq1t~oK H)]6{;Frlw2ɲ9-2? g'?/ v|TSV"S@!~kR>foj2xoyv|Tߞ܄6ʙL-uWO>\sUÑ -R?&??^W Y鷧$%yBJ#2ր5PX[/4qϯw`UíB=) 6RE(9Ҩ_ g+/ wX>sUá1= ӻɐ1w`o\@t$9 d|TߧI(iiTŸ|՝,OY<^ȹih սw@ߐ[:l?J_$ |,~_lUwƖtnKǫCܵ~Kg6dY,Ҩ_{>CX;7a+:m nWVž+2VϝUw<~qs3i\;ʟ4W %m |%uGXsQ `CR|e߮;W8;P,~n(M (6DYQ3|w}\]C3LU,n0x/mF7%"C}Vǒ96ɠ2*%esje/|>J>D/n o3_/{lN 53P=JLd[!si}$U)(S/cw2? d|iT{[ų;x[q3\"M|.+!ۂƱb[(彄U3J p5}b$0}ː`ށE~0UíN_$|ު}K~Q",Og^eg~0Uq WcS}MwC;#T3]6{B= [*X4"eBTu =ǦfЋ]Dаow/gbk lEk6g<&bZ 𙀆ž#2րOW0oBH&r"LҮDL*P[ۖ!{,F| QFuvPMK c{(&}oBooInG+C 2VMRU v:;&Dν ^ӋݷDаob0xoն %?-JJk4d.ԥ"C;>Vģ |M__5_u'3r"[ɝ~4aƣr&J{=L>W]j"Toؼ״^qxxIr閎R̊/c M_u>rcKOIQXᗱ_+~ e2çs|š] ؐ=H^[?s|եxcQa>wj8X>ᗱ|-'W o+D֔v5ǥM"dQ l&4#T)>y#x[&e^{\!ȱ^)2%k V _큏Wi"':c ~ ~~ ~Ne/u 򾄏^j>nuX?/ O3%?y%?O >5¯3_g-|  }GCX#'%?HgOgϞIGYq.QXTPr~3LQyXתBIhDSXQqrX[!t,zQw8gu{ȦXwo/\WW\K4JUK]D:'zJz Q=Mtx1-XG!{KPQ UTsUC;@lٞDN^󐢸Q=MtƷZ} tjJBF|ʀ3YʢHw.V3-_u?#}(m\)P?PӨbjh|̋ɐ|00g:O7`~GQ9-*Ԟg$plϼ,?p?1Q: %7)Z3PQ S;Wēx\j"?cxaj5JnG?eQŨ%QI4*q,檆.a TNj" WLh&2%#mr[:/(9/c ghPTj"ީy+M#UH㖎FwQG}CX#VV^?J4xgMΈbwQ 1PUw!Vp+#D5` -~SºPR1jɷtWU՘O04r>yȧÏFrlivjF Agaٜ~kw_j1\Y=QgoJ>y:be59ODٜ~2W_'~ |=y |YF/AᯙK=Q6g_W?[?_i"wܬ+X>?4kv󣚈!K)hxy_5g_&=1RM}F%rkuYdމ/M>g_]}ҙ{N >wC &G5}#hxy_5g Ũ56esve000 a D(D5D<+ /陼[XH~5In0m%ƒ'*s=d;@La @2y?D $-C6+w$usUàvTD sSSu7L4sJmW3%2րbjXxQMĠw"~48*%7nW]B)ᗱ|<sUÐvؖi"l?yQ/^ q_+E |iw}2eH>0x7%N=QJ;FӲt4oK >W>9X{'G&2!%tK鎦1mi/|sMOgNߖF%|XU ZŲ5oU 7{'>QOģ[:yo׮oOE_u>րx Oj"\{NnG{ґʤ[:zgp!iTZˉc6dH޻b hs?KC*Hᗱ:|Ocd3=Θ&ҫ~wijh džnbu4#n^Aj" zR7G#8$.CMgϕF·}&}>L|௙-gٜX_?) |89C(/cu+mc61 v]Zqcx깪5Jn. ql|ޅ5h Oa .m]m_0PUr kp.cE]ok uInEx=Oe*U0Y'z!}:L'w~KZU ~][!{I >SW݃wqmy~4D$2FŨO1v/c%|^3sUÔ@2l޻ 46g_e>?6gJe_qa rF .ͤ0OaqVuJnWv_u9_ X>,aJXEø+yqy )f#6ۃoM >u56/='g4+-PV0OaDv_'uGF|jO랄5 1q4e 4 qܺ/C8,4*sbj3/]{^10Oa`_/|rYu??4f_-[:9~kGXbgjezlϼTTndύtt\I >v-&Ü*ƭ+}!r#-_u7׸Bz!K\srqAW]nqQ{Kg5SUwq+4s#XG8F-ž;2~> FWo#oGv' iaa,1glN 5C >y2c>[/=ذ-$Q 7gٜX>mMm`d x&>w]G#96{j;b}2X~c81Ԑ~̋vxQwQxhF!{fWKA{[F%5+Ϲ̀$n>_~ g3w_;?_/|suX쁏W{יwK㖎|AF%|n`U6H~Q/f m`}c!JFAuz/miTN\oÅ)@^!{>C܎*B 0g-~lFliTs}) *g1HuX&'Eּ7K4,cE_x 3 SSauGZW *CAh`d47X 9񒮷9L`a8o2j!lHAÁUސ@ ӯ7 4,02_~#I5b\ihh3P@ӑ6]/F L lxTZi/9``/(̞0i$1@xJ{$qi H 4~&Vmm0X%3`Hb J> `e;3/a> '3ؙ~|:%ۗby?-epGZW .oIqK0#4i n`Zb`̀ $BU2-1o Km_ ? 3涱f-=a#-+l)17qguٜ4\+*ey E ?*J#aΈ?Ay//书aP 8]45\VQ[tL|k`b0wI\s JM꽣u5U^Z=rݎ-!|)amdo^1w~9phn^qhyj\%q?V0fb 9@1wKڿPmXVGKsj-Wrc!_ l:kx[a5sjۿPSY? ^Gsj-R*BV:Ds?aae9p+sX/9/`0) q~/&K _Z*^zr#L Tmu4n48`rDxοh8Sny`qe#Xe fxldOZ~{兂r^Na-a8(p~Qd-?=*:aˍ3g 3ȏyqX`q[UeCR7>LbT@V_nF]7|4ġyBZaU rNo&IpC-{U–0 =-L:J:[ uZK%D4<VQ [.%شV5=?b"eC\ۯ P,"ˍvWQ,}o cAƲIB)P,g1bt]ݪISQMK,z~ ;}F&΁e@+tɆ9B*5[cӒy PE!u,QQ Y64jwK8ULUi~9B*C[\cӒ PAHYKf,nsY`KV3}$aHU,R@C&IZU*R MK,(N}&؅JA7cU-Ea.c* d! YYtmFbU-E.>MKrzW@ז~X,·|X`+,Nbb-cm):@h9 Y slk`:}lZql* yE_jGqN 1Gi_5, MN*!k6Te vO}YbG qBNP _A $40YP>C'`Mn, 뺺bʷ@خ.eqbbi/323'd?o憠٢-j#n,xWj˒> PWva>,:?X(qbXXB~YGgdg,,j,xYT,,xXXN0_GUeCw@.T쯽S+aybo?=E wPq iw5@XT vGXE'VXM0r}=dAB5kEE̢ˢZfGfegfaY=,>eC<`Ѱ!wo=r;oGE!gθaLѿe,:!f%Wq[m]VS~ܟu"P#fABl$YY30,la253Dkf 9X`zl|w?0 r?GdT.wu)O[ԺoJļҸDa<5PZĂR>肉IPV K6S+5%E2'tJW`U-,gT AEC=}i5xKUثt4v m` ݲarqr"#yoH`/o | 5"߷E*F&*_;+BW,Y7LxjJЗ/nMc^ZVeXc?<և|x<*>$QÛ)UY+__Z]4RoiQѫa}Ń1;,^Vv}iu%xKSL=]C23r<8xq^ |x?<+_!ljuqž)yXw pS-| SXj+Lz8q#\x.Ior`E8M.zW1pH[6,{8j;/?<c}x?<·x|A<=<$DzccYqFqqfQ-xhN#AZ|= &pa}XsW2i.?wHC\0O-NcP2.?ПilqY o1iL"˹'5"=-]``)}c%ߌ/p.>\.e?\yp'.Pv̱~s`+ylG@r}i%r(yhP)J1/:ӥ4崗˩jj/2S3^.g.e.\t,f܉ |-'[x =ݹ`MCI+P8vwlE#-`Q"\@O6d#Z$?pC,|W..Mӝ/O\͸ΣFl6״xkH7KP[Xwr!}tyd }3nq8Q2)LiŭHHfz²|I0Q*7.Ϫ-R1OZJ^x +R~:v?4? .S'۝Yb5Ҳ2eV QBQIyG/2\kr#srhri#sIWȥHc wW5}JN}8XQ|~C%}ib)}3 \.+se?\ևe}wXDlINJ%VEqr.3 %zKkF[P]_*\vW)!*v.%cߌZRf~ t;򌆸n|G"Ȥі&y(OTqխĺJX,}Wؒ/FrפW yWRyoK Jr9{\\\\e.P<7oX*-[ lw"h"M߆VZsĖ5U|6f>Ic #vKcE5X4YF7/yGl\,clX~ۢkY.'ԯ+DД\,ڑy4e澿(Ɔ\Vw=ˠzWWoQYx^QI]8}/rR).e2:?\.e}?\և~pZT^fTdR~NKZw c wg!}1~il]o9k$Ԫ̣)CMci +KgM/GUN:bVNc;x;$y,ߑ_Wmc)`/GU+ne54s1c1Z1kc|aesy~/GUN'ҭ~X}$r5sX}X\V\V}nIc;_9GRyߩW,2-iFܭF˹%-]3 )-=JOVr=s9#s9rK홋g9jKK/>2jQzQ w+M#cox.5-[*SVEPڃ;qLW+ѽF˹ǯȗṾ-}Wq4c#Ɔ\v|3_>x*7g)f5Vr KDl龿$Ɔ\N3(~ilqYTbg4I0Ar ͉ە\:ITLwqNe4'~/Q=a/\n߽am)˹XocU"hV]ܷl6e9C4lYq .keZsKD֙: .+Ɔg+v4e Jr=s2z2[2˅q4잹r=saUp9ʇ\Vy0&S2tS\N\4C+J"Vk(G?~QGJlݷXC9&'fb:l#i17e]f*d֎yʉ_t;ڣ*i̛t5f܉ _;ޑ]B]gqr'K.2e/e˱hFXT{P*7.J8t=gE)?RV#T[osKcWU=~OcKzKWDv[ڢ`Jߣ=i}x^·H]S'efKדox.|f'VzG\.e?\yp'.N{%Om([sYZou=jr.'B|p@^-OQk1Gկz-zN +*ƯVQ<_HzUѿPN\DuœX\CGRJVQ<_HzY=|? gfː~=$6v:?w֠" }eu\·d.< 3}Wuڣ1-GjݷICkonfIԬ 3 _|i K45ųkƵyZhi*-p 3-.cg4)+f;>"QV]_eexMi*'p BǺPnk|{/+qVD_Z9$]gM=[k(~il炨cیSxFbk.9d9+Tήj>vR9_\B[nRUIKFe_UjK+l7Hz_7 _WF4ic7%ndk>"vfa%-(B4W;%鞎w2 H;^+nVR99·Cz;{o\D~Z|ߝtYg])Ҋj|(I*#wpw_Q |YQOTwmͰZoE>UF?q7N\mSnL=;gyQ$߮0?wHbGҫA='ߌ;qad[ k`]qYeG׎Znq!ң>$`Y=fŨ;nbQv}ܢh7s}NkyC;Gqw*Eߌ2FZkrٖl{~b3SQ+3si$\gY͸ˤٜ vXvcG?~Bg:Q ^5,r>jprp.r>\yr>\.'si`n+,QHybKkzZ,=B:3p7N\O|T=j-˹؟wh7#ү;G1RVӉ~\njYR*jՆ<֨ykdї#hÊ1#Y)~_izPpY˘.>\.e?prRI.}d.}\\g.< .ee OT[-KJAhF.tgGs#HzVIwB u|Tn|{\F} kzZh|v{^UuJ=$ߌ;PVn,)-)Q&YC'+}+fTĺOmzVMwpjYzυ,+#5=H-I=UeFťSk2qSn84eJ[vo\&v_'oS0ڼ@C_ZI4&=4IbF |3Цjx}FCi%b?~M߯d15Qk%V}3ąm .xvWFMe9J_WW^פG1gtNW|9jx\QH+u<= ;$vuפ5[l=jx*~o\W[:s<diDTs}T)7 _/zN7MzHwpIjteKwQ2(N)~Sn>פGQKz(O\͸pQB%\e.^.߹\_Ge%U%ojteKUq Y2zOk"hJe%|MzOѲ^e \Pnl\ 'AzO}7"h+|(|mߴ\FZ9 %K\֌ՏVde"65=^_Xw׎S=ݼS)q X@82ʈ _?YUkqq yɇl {1fZSkq4+~WW].9.sa7AJ5JG]#BU+~Wi/r1]nKC1,_/5JRv#LK5}QSi\y{jeEϱ4sp-/y]8N #Q:RY]sFn`Z; YyCY]nv+oՅW薳{?J8L5kj򲴉弞<5EWEʕ8mV^w(UʮZu5}zU6q7@[[u9{R!{KtT;qG _xȴT =&W ^5\Wڻ^UU?xWcq,uɴCvؙ+AǛrM+*'ŴwUsHWꂣS ·V]]C~kZZyչSn Q~w$r?W; :T*ݗ2{rurxSnhiz*bڻ^Յ3|<<;l!ίq0~=mYZ=^gϼƭj#)ץsޭ.a7ԅGE]RK'2-Gv3~尽7[?UxuY~ȉtɗTSmg;vVK5G=R>V]#[JDsJ0O<eZ*.g N  euYY.u btYy<*xΣtl|N=E[ꚖvՁbڻ^3<*r38_ꝴP^,-2Ufyuybt٣^5͟ hlԨIe;L)a9Kʴw.#e2C]F.+e2C]SnՅ_ [`F1"gy|Y.͟mѲuni1p.^NN:*n106t/V]&FXZ Ҕ7)j)Op%ry]p?Ig:^]?~%Xc Ί^u}}t=QΣJ:P-0,ayPV9UOp%x]8Nh1Q-)ttgmnݪYyCs5"j)ץtvy唵⾾Pc/ϟ;->31F}lVw=)ep]rX]ӳgpʊzkRK1QZ*䭺uC e3%eڻW]Y.aap =#..BVk7RY euv L{[u6}`1q[z#,gcZ*䭺p9M lܺ&g~{]ou.3eV2B]ouY.3eV겞rVCbuY gWho]6zE{H.uIKjo]^]ir{]к$焝Gx}n|'RIg_ڣW9Q_CPn gWclW~)e-=gǴRI'O(-UΩy0׫ 겴$#xf9a?R͞=o(SUj}}s\薓3U.xN%t:PRPU|yHKO.y)Fp1J}N:ƕ6)o(Ot,ӆr{]*ք[NRgGE.R*]^!J}N:NQt>l>Q\LuѨ8Y]G%3NGdltήTP6Y. V]DO'gyʐ(PQ_i>yD'֕6Hz8Ŵ^C-'i%~ؑ~;9óY]}JiR]xzU^*FϨ =yUhEV;M'8qk3r1m(UK. F3GERVh椥l;gi .ør{]x+Fϣvsiy$8:kpTz^U1d#Qθzx̣\0!ΝU+C"} ebڻܪ KaɌ lq:%}yliffiUNF Ofߞr{]Kq;'uTtQQSv8i5M;k7}$ʣUJ{2l%Ɍ=[MpԐcR*)}y߫ ׫ƕ.ebơ+d,4炞-szd7Yű{ZifBZw$CH}rr?zռyޯѳH(#VMGpxC/2-Gvsni?GO|ʧ\ZWڻܪKs/_)'g3&(#KG:ɛsrٯ+wz69Ŵw.\/Vn9Y=+ ^(772mj_st Oa=jM>H[Y.˭4gLx ^tT%ҭ.I'J.I>Tv9_g֣U,V]*֙Sгx3#QW<cCvhFGrNKa=i}L;}o^.˭4-g;)!OYOJ[(ᤥʶHN8z*qz˕4oWު:bt).فY<sʶHN8zj|J+oՅSг󄪣qJ爞K#ͻ7=Y{Ua{9ir{]Dq;şsuA]DZ)^a-6a=ʞ-vrW^^. V]Y[NE򺉘F{=QtK҈gwi֣\zOr!m(ץSn9U=QiIti:O#[GqJW-z˅^ʑmpV̞?{DKc5i)e,爸ϴRv9_gG)UK#y65!SѳeF;<>j󌷗V#96(|jij /҆r{]f- Jϣd)$fIv9A, dyg[W6 fO- !eJY]sSZb;䜯[hζ^ mO.<[NU7c<*ZR]Zv^ВLKUl瑜yK{%Z֫U. ꂫbtiy|##Q@<*VxQ/~UGrζK{X֫U1V]xGPn9 =oW𥳐vy.yQ]SrUm瑜qtrmJ\BPn֥JZn9M=Q}R k~xQtUm瑜qt֝\yg[&n1xV]-uTc;GMHN8iϧ+AQ{+btiswv^mD]Uy$jW֫?]J}uC14,b/殣G`"9<*-UGr@i@yg[&PMOU~bti£R*7WkwUmPZP֫Y1xV]*Յ3|FyT!OSbOj[ W{ r{]h169N1Q)եg#´T)|6fGXY.uY8~͸w,e^Nوs嫜ryGRi ֣v|>nը%y.ѹrzq'_KJuYygW]:-X*|>|=s=p+4|F]xT%ҥوŞi ֣ʚ|$+Ej^.˭[RYn9]=?qYJysRydw9얶`=y_*:Crr1]n g-gO*#QAd1 ɹ2ϴ]ͧ;NI|]|jir{]xVnVyMQkvk|۟iy$ 1-mz]㊏D[{.erd[.y8tT' ʣ8߬eak»SQ̻z6yS\rVﮋvy].yu)KK[u5-[7GEOx#9얶`=j>Jyճ2r{]DE1ty&|3Ժv9-mzT}Q'=V]|d~(=?qCJu93-UGwdO[żWNbڻ^j[NGr!bF$GQȧF4mjHN8i ֣w*8j .S+F?4oIY]i#9a#+Uz6/W<]y.O[NW'ԥTԜO4R5y$b=mw\UcreVB]ouY.3eu_ uYeu\y.|ҥrz~Qї9Tvnn]}+tH1t gcIkni8ڞ+UCY.uD1aOGXR*ݘ5VuGr`iS^5?/W|]yChFR*k6궇Dv(-w,QG ]sSo>V]f+zR8H9ĉ~,dKUN9g[=k95/˅^J9#Y&vt֘QsAo;rigVG-x]Qr!m(ץغ3;ea{~>jΕ6b+&Γqr-rY׫F="zʭ,kl4wdW/<*RjwmtaG7kGr:Lzn^Mu|]y'3ѳ!4%yTBu?im G;`7@vlJhU^bt˙GJtZCuͮհGr@i@y7[&/zPSn 9(F(=\ ·'-հGr@i>>5WުKgCWRT]OZ*_#=kro\L{[uJ9#YO8zRV|`ǴC3lpQ?)rbf[\ڑߑTڎ^e+r1]nKȶZ]8Sd ^ N] _6z+<^vG1U]=ir.]y_)gڝGER*]ۇH+|K۱żW bڻܪQrz~Q1?)e,;V#9_gQ̻z<\L{qbt͞_8yT&jqEi<{u=mz]ljhT]ir.\[BbM QÚoG k\/FZi;7K϶ eg4^}LU. QbtYg ˺{afG j9JbZiQQԎS´{yCY]q iCYoL-guF?R*ˊ˹J[4kޭw' \L{kbt=_q񨨟JW{IK5m瑜Bi(o(Յ{w_[zʭ$Di[BϟNYRj'mS=f|>tr,pVrz:ƣ )tܥ´My$ *6 R]VSn%㌛[BϞOڮ@;䜐#JyC.-9Z=8ir.6-FEl68R]tmDS]My$lS| (o(;?,pơrz~|Q1:x´COkHv0-w0o(etEUr.6#Vn9 =yjALylGm:w8Lk3忦sќ#c7+Eqn%W]p*F7gy Q몙mvFP3J=o(Ku^ܪKQ18{T+1p &7XW|D~iUN9*{dw9瓈JG%7j]ꇳL{)F7<Rh/ORe.|]iYnQPT>/;m(T?S>RE;FR/;-Urݔ6O)o(a\%EPn'wN9J˺{vp1G6h瑜-&,gROڻ^>oTn:l59*mS<@IIv9B6mJu|puV]:btA4yv@Hi{T{D>?"R!k9'PIyC!a&ir.kh̤t|ZS={v-wB4fطw*_'ݻ%i+oSm܎qʭ,[w}_1~R*jy|bgG_ۑ2mޙ7ԿgIY\HˍT4Jgns>P1:1r:AN7dQ?u,oN^XJםxP5x ⤽˽/_?}_t?7Jӟh~tgᏟ=~CqyB9My!LyqLC^p"!/>N牊qH硲VwWlDÿ?s?$GiW=/Y?=eg4I{Ti gDdxֿnD6_P(|4})/^NSǨ8׉d9+~n=syMcS _M~.?F$'z=L^lG'_i/!h/ޣ gWW>\΃^:{Ź~ RxV8 j=q?_?׿?ǿ叿_os v⭳2=J[q|7{~;aaVם 3_ t~*tǓ 9'rO;:ǯ[99(T+ɰiT;[کDG#R'~PG7UZTlQBv"la<(4*W*ѣg쑮rUnz⮃6*QhUTGzT#lHsTGzR#yPBGE M[~PZDڨD셟@ "MF 44i7-+i7=VnJi*TGJs"MtWQ*4i7^D.GZMk}7mCVJ^ok#tѓm3"^l1DVcQ>?G)tb[PG{(j}TХܴH+sBBpC18sW(ѣ1 % =AӠ" 4T3v*QE:D^tR.ءs)tn@G4HKiIHkim|Ӗ]~#jJ%zT[M*Qht)E%;t:"MFMsz({a".셟ѕ/(4{aɏ==Z"lsJz:"FVmRBGEUb@Si]HsiϨ JZ9W*ѣrTGrV"MtԛL73b/\]Hy]*RJoz4H .P#i75ҖnCV?w(ѣ{iolTl٩D֕>%zb^=mazn88xDN셟; i:zR#5=t:#mEVJz"qu4f^ 3( mT8>%z4f^tŠH1:D^Jʜf PЍ9J% ]vBnTGBTG{tD ?t(8:/@R@gm3=:~MPl=~MPЕmPG{(۪u*ѣ;۪TЃm3Hgl.UT3yƥM)?t"GZ ? (ѣw=s@M[td[$HW+Ŷ?B™^(ѣ瘁f[NE Ms茴*A%ztK7myQ ?2(Ro:CW+o:{tVμ.tDMS4~P3ii7--ҚoZCW+ozܴHw=t:"FB[4Bf SbqCjz:#xDxR.B%z4f^gg8јy7*DPD15yIcu/PGOUT3b[I%;g^mG[f^҉mSf^ҙms=4.E ]V{\J(ݘsTyRM{tx4{f*R^J^Jzn:8TSf^ҙmGf^V{0l%]V}R]Mkz tFV?- E VRBƤ=z~SPGOHj&*QhO*(=98o1AsV΋J\ok%ݴ@gݴH[i]H{irQ"lUHG#UoMg^t:#MEVlez"-l}\6lk²Zq%|D>~&yAF~yA>|F>~z㼠A)+Ր4s9|E^z?kԐ4g|)NcD>?H)^>#-~v[5 a*8RFbOFfe|2~v4#tvxNHr-B`.)vHqW8|`;<$9k"__쟖%ɏ1 29Ӯe02g7 g,a!ixmo9_MRFg.)c 0&o$Ibe R2ȇu}uy7o%_k旯44qvrHq_$١Z aL*0V |g #O9_"_l3\_Q~; 8[4N%ΧnH.N/8C|C˘χ?IPYR?76?||=/0r))/||&IrlZ%ŷ0 2!4~{9RFf퐅0J䗳vHr^[ /|D>>b7U_5O:QHq=?{8 )#vHr$axl=\Ѿxx۟̄$1#l>(8_+x򖑧x*l R00*T$1"gfIq))N0F |OBX/ʒۨ_RFO~dHq_y__Jq|J2"$9 /oE^$a`~yq}Õ1{?|W qsˇ%)#r$99áf7?yI(IӨ3\i6tcEz?pҌ$ _͒0&ۯvIq+g3epҌA2~vm~iFf.)K~|=*!)[yx?{9 Rƨ3ف2c82l~Ɗ|=W3?WOny*K ԇxM/g8HqM7$ax/gȴw f`~Yp64[>|OR:8 /ϦnJq3p/σMJq3o-1)XY6131?yJØ_{9|4,w,_痷|8o?NZ=|G{d68zb62'8!etFf%0 oUIql8RFoJ->?q 8?!²c~y˛/ox8旷[>|F>-#_7_~MR~]Rd$INc.Hq/G@orsȓ4?{)#s{xa Hq+3 it8xl%a,_.h_l=\~;0=8\E7%ir $9;éfW3/]R0:?Éf3Iq쟽d*)cW~95Imt/$8e i/כ8;ÕnK3j [ w__4~g8m~i`O,AØl$a,^$MR|㟊̰IOIq#\'@`8$9sSnV?K%Q>x8 aKsa1ɫ8 /o9 ÁiK7V_2r/o9|x̿1-#5Y?KRƌ|8<(i$n-_ɟ$9;eK3 o?NQ~vl~܎-"wn׍;c{3+CŔzꁯ~s~0W_xz1_r~T,Vu[z9go'.׍kEzdTȽn,_D>~{;M轗Iu#pX_72ۯ Iq3/S2~{ RFcJʿI`{9XD_7gIq38G eR)|F>[=rS"_lX_7oo/׍b~/78ۏSuc1#_lI~ I)N^)?{W5O2,e,")[F-#c~y1<7Jq3p/yU,헪$ _`P #OlX\`7x^>"/lINr8 ~\)љ~T,JeߏE vcg~|=|'I~  29|8X`72-n|3-W ',wnG2~=IXl>$ŷ9gRo/w@Ho,Q؍ǔǒQZ=k~|=[x/>'|Ȣ ~vmq/$1jx0R<嗯s<\nT~)NcD>z \_!Hq#QSwIq|HgvjQe0 8a(e,))[F%>],_lsnxolP,*e;o/7LȁzU_%-E ix_{y?y3xŗ1#o2$atYŗ"_=>?HXl\`ы/wnFeq6RHlZ `բ[=z$YRFVo /gHq$INc2\P-e0Q%a,~R- 73j=2?v_-ʱQK<}l9$axl8Z`Od~n,ߞW{|+x8M)#Sy{ 8w,7009/nS7}mK<->ɗ8 /o9gc1%E%a,ޮZ-* E2pZld72/$Q~qCȗ۷jݨlRFc"I.cE{?|GyyϘ|_1gq~4F3܎-rernxi9_0ooרCٍ;`*)NkTd.)c'I.cF>o_2Ol3\i64CWx/7os3_ٍ޿pb,1?{Ze7&g|2?;\[Hn,~Q-ֲ [l3xn$ގR-w3sٍ^k ևxK/χwnINcG~|=|RERƊ|PAFJ<<rRx̗qDEdv؄R<2&y-#_c~y&ޔ40<v)a`~yˇGK;~g3m~o/@-^r%jݨo7ٍs"_%a(<$i - p{9Z ˘χxj9_-b9Qz?j$Ѿxx;ýeK7~uHØ-1#7or)s;?qMnO_0*gwxxc@nxO/g))cƒ1s3|EzHIN#v89Hql8RF)4Q.4FcH`yntj0g?i2V81;`| >"O5T~KRƌ|>/w;qlw{6ƙ_8Rƙ_NS$ql,1ț83'88 $ŷAF~?l|$1#-^r%wvkxcp;ѿr_Y0F |ԇL/gfXl};nY;sc!;~q 8kCRF/G5_[̿{8Y|g7go2?{;fnl_9_ٯ#7,񝃌^?vkh9_~fwv/83,g~9δY|e7g|yn2fg~9Y|g7r!)NwnCK7JW~\I.*)1I̿VIq ||/g))cg}bەw ^oY;ybf/wn'ٍwv;_LW-7>Ir=gwnSK7&o4Iql1%a3s_xz%\^rϹ]X|g7*,s2?sJ->~sI`wvcgbۑw9ȇ;O8yR8y^L1ɇ8 /A|֙\"/0Z w_%i(&) [|g709sJq#8;RFJrϞuFfYn_4~{:-ow;~5Il%iۯIqW8|jx5z4fIwIq9?{:-^ëgJh%)N_ٍi]R`;_ۯWIqo;~3I`;`| #O%Txx3p]_]FcͿ+.)c())c8 ϹY|g7g/v,񝃌<rkΗӵnvhKR旷[>|Ee;%Av旷| 0N/i4/op^S9ۥwvK{xe۩wzx끷^S8 '-wnٍURۯ6Im0,X|g7ooG2~qend߹X|g7J WߞNBx)^883ne0D8n/+wv#t[|g72ܮ-snG2~{[|g7j և72~varo_KREINK i \$iZ1v}5#ʿI(IqYn4ޮ-=?I=>K<|}#8;Oٍۯ+u|lsndߙNX|g7J䗯kx+_{9ߏwvc0sn/|D>?K H)N_wٍُwv#rܰΗQwvvaݨl%a`~p`;_ o00e_!8I$a`~y1x$ɏ8<)a`~ySRPSRFf$Q Fe,)N;?{8:,=gS?IrS8 _͒0V|9x^ۗal2,/W;_ƌ|>r 8ol8RFgO`r8,eg|/Oo`| I;j><;_gwv'INpxX|`&)val2,8~g4,_00'yFr\m~ijK7y$i濗w 濇;O;y1R?g8 O$i)^9;b.) wC|l\0,w.wٍ ;Q~rf/cD>^~$~{Rƌ|>r8]R00V|嗳'I~ wQFbL;?{`X|`ˡwvQS5± Q2,e,%)ˁ˕wvKk /.W2Y|gˁѰ_74~r4l~iFf,INKz9ˍ;Q3,ӳ$ 9,sN'(>W |y2f3oog2VwNWF-޾r!8MR`дl)k nI%ŷwvc2V_"ðn`~p;%! ||Ihl3\nt_4fW$9+CRƊ|=|j$d|p;~{:)NcD>~{8INviݨ߮wv14-ef$?H%ig|*3~AF~A>|E^~{8;{2NX|g7?wv3mZ|g74Iq쟚$iL~\3-+?IoWp;?tΗ"_=^~gaݨlsZ|`$INF~qʹΗˑ0F |O߹\ //8 \_σIi0s_]RFRCR,1-g:ƴΗ1$q+vh8 >K$q wvcIr+Sbie0ERƈ|<{?pˁyҍA^%a$%ad?%i0,`Ҳn`sˇO%)b%9 /oE$a`~y'ۯUIrכ$hHl,e3o/-Fa&)N7$9ۏ ax+lI.wvc0ܶ,S/IqgY|g709ȇ1X|g70ve/c;;%,|#^#>~pnl_l I.$˳G)np7VK0_00p?>Jq_=$1N\Jr_00<(iK߉Dp9gyt_l1 8gYE_EN3ӌřkt~ѥp|s뒥 :g ݚ~Mk/ tWZ/10s/"f/dܬ :|Qs˴~AMW_Y/6]C~M }9//άE/V8OԜE~'z~_J_ 9+-Ktj/NSϵ&mӿ ܹ~[> :3_/bM'_N :jY :_"\_y"K_3 :]znui7.N# 0* 8y8HqUqH]39ג)qlϬ1ܶQY5f1j_ms 9֐ke׀XmxWccՀv1jʝm0]#f{ trpϨVc5q1gjb0ϱl2kG:jbՀQTc5y?m,[΂-{c.f{ h3W \1sϰO1LrW||,<'8Ʋ+VRRjؕ[lcW~={c_qOHI5$ר7/OJMӡkOK͞j\/!f{ mm5jl<5V55Գ+ja0}]혏GSf5jsS1k#q;c7VjWW%c+w%cizF=i5yzlQPVyXf{ ́wɫɳ*j5O_I5$g! 5F3j'87l[EONS[7]lO=9vOOla1F18ЉXxʝePϚo5s ǖQ'c9q-N݃U_h`4&tbZl}٩5h`{ `}sz`[ xM?sZb.5q|m5*59h`}*Tctyo*lo=r ,v|\C5ԃU= jU$a{ xjjոnsGc^C=XEٰ߳<;عFg =V7b0Mc9sm5sk}kGWU 5ԣC0}9)sm5?o<6yt>V\^{m5c7wlm5Utiɣ5jaՀGW5ԣɣZ; ٳ1kGWѵI݃U/Vf{ *Z/VV{ro|"sPcm5|lLb>ǖ6$cU~aklhlq=4j55>ɣ'&fϱl]E{P'&öVc5ԣ%<~\CR 5}t}W[=|L3|,vw* "zt1;5ȳQ㳞i<"V]E7c<58{5e*V{tn>^Uy#cC͓GWUp;Vc5ԣն* 9yoϕXa[ xt>t.Qiɣv3jyɣv7׃铣 ɣ覣kVc5ԣ覣k4Ut`[ jo'=%[kGWMǛsPTyBq*mUthV]E0϶l]Eո_vw٨ܶ|''k)#1ܶ|iɣvNW=ưo*~ɣskn<7la77|[kGWno5ԣ;ߚgXcxycoښ'{S*7ãWk*<56j]m5Y)S>em5)[̶|w}+7؏}<){c%gAGWكm5Ucyzrlgok=b5^C=7X[kGWяkXlc [kGW];8}mUt?7:F{7,ǺF-' F̶|lܬ<:ư< 6O`N]E38OaN]EvU͓]=9yt=m]E<9yt=4<9{oz7 Ę'4'лSGP㎮Ԝ<i֜<Cht\b*:<SDWUa[ ,]}SGcc|ēGcʄm5̳Q<:kOu:w.#7OwN]EO|K=9yt=c{Z#6D=:{jiՀGcjGc미D'>o3fk+D"<:[Z|,o4 mstۯu7?_K^R}@y>Lۇ;V}‡/}i'Yw]D]3ښk_r/wibrȿߗ$.5ij KS4߸K3+}:X>l6H~ChjξGK5'pC 5׾Qyml[\w+6֦nݻ٭^['uUouDtGKǃB~'`p*:ߌq6wbq|['(uMsCI['7e{U{d]/^tZﲰu?~ZK#銟 O6ͭwGPnS?7~w¾:þM]w 7Cuտ͛z3H ܰ۟H N{N07i&+lMO=)IMZM=C=>d׻ l}]}d}@CdX'7Iw ¾ !Uak%l=3 6s>CN}M%wқ.6x}{N;:qGo@w4c;;)wJqGsĸl1`)qGwkǸ#+>@; ǝZ;qvbܩTqjtw27;D6Ɲ9J|'4`qGsVƸQbwNĸӡƝ;Ɲrw&~lܱi;m/;M76^wqm=0q N#04<Nc>>|BNwHrB?Ɲvp0|.Kqw>q wq wSǝL|iSǝv0¸07qtw>JN;~w\qcyD;qqGA1<#Ɲ;Ӧq4;zSҸSҸSӸSӸSӸҸҸҸ09'ۇ'v'vZP{?,~~?\O??7ϯ}RtO?׿Wo׿O=(?Dw.w^$B/?W5 TL?9^ə{`כMU+骬5Wq}YhUgZ㯿O ſ gt=K #֌ J _ogͳͳy$kg㎐hgg&N¯3I>r7_vc#$ڙ{>;[#~#/㟌r~-d|_n;bv/Y_N+oJ_3nCI^YƫaL?+++Ckժ8=vvR_|^kGa?/> +B$YחomU},$MݍK﯃SbW"W5{饱vĚH~FqᏑ$5ƻjQݳMݧj8~fkNJW5x饱vJ7^Kn=nJGԸ:ѫVzi(_rTvUnCˈTv$kU^Ǿ I4zU^kG+F%[j1U~$굻1?izn$5 F;5nlX}'w/4֎X J~,ۀK/k7K/#֌z?w'-5N' kЖK!|) :!ƗbQo[I1.#zu&GkwOJkMK г0کq{uy1cƨۖ*Mˈ^5FݡSu*U-'Rs[u01UKeD/~ *X*>J o5c> TeD3k9ڧOW]@?5 ggSr긙Ner3TiЎX "e>nW_2LzwriNer3TiЎX3 o[M(?jW%U?J:C&֒nA5کA9uTh2IA;b u*3lKg6:ev:/=6#n^ \n `VSQTiЎX3j UGKZ_ڊvJbʶt"S8ݜjh^zl$n^VvXet?TiЎX ;lKg6:eE'WeƔMLlN۫ok_0)ۘ^4hGb)ҩNr.\S6ճE;5nޮXӂHڊvJ)ۺ+@)۸w کq{uL= K5:u ungKcpk v/0|hXюX_vO!3|/#p@3-e<3 6ڎvĚkMj?k!Z~m+XюX%oƗ/wR__2>/̈́߆w5]Qjm~ -Lc~[/k-J~m 6{Kl?[Ÿ{YO?2a|aGa'ec%1 -o+EcXZV_˚gO~{g#>+{ߝxY3*(?JᯒX/W}Yw_7 -G]QW+e%|Ѩ{sdت窩a?wmQ3 Tg¯$>~5㷖[^;D>(5V :F% d|a'? ?2!^^V¿тS6#U)gm?ݷzKkw1e7ҷ~nj)XhG?NMD['|܆A 5vĚg{!|&0!Y XhG_;w߄?/g=-u](0{a!a: b_4$4/U#֌k߅g%|&>Bnz}w#S ԄD;b—__20f|% 㟗5RF]/㋗]r֫]:0 4hG*Ĩ{註u; K3M]i횅_t RcK툕oĨq vLvERj8{کc9Jv/{p|RDuϽEroq/^zwBnzMwߌ//kW !A?,8t ?^zۛ;9ޮ)rhGM$;( ND?5+ODcڹsolYa(SGS:g Zf6>u* k7 !Ǵ+[. y0_کA9ut=XW gTiЎX ݉b ;ʖm5/ O/.#+7&k~&J@ ܖ:]zow;w`8x}o&N+teo,V ïK51N ^0./iDcGUvBn/LA;b C hvypV֟v0ou [҅],_V¿0kqV-Zim"p֮[ No/M&@`ݛg4]6e`1|s Yn!7~&JM5utDjVx1}hܔ/֝5SuX4WGK=َv0ofMgkЎXwG` w߄_f7˚H}zv&:6o` #ޕ˚{M)~hBM;gMw%~Kߌ//_3d|?0%~^֌?fG`M$MDK ·m"?xf_+a5ϖXS?mRǟgKF%ͻfYO?2a|a؇O] #wm"ZkZ"|Y _xW/k=#i:n{߼kt?=N{ÀB]`!ob76nH`L?k#/`yF;b%|!DzyM}v8t3?, d98y{^) 9όvĚOO88' 4?=㔎N'|юX RqD޸w7&z7sͣX-n]όvm'g.wߌ3f|yY3~ 5Y=ŧm"Nu$: ##6fV>k}>HxCKjoG%Q3zM7 Kߌ/00d|aKS3}"S-MDTlm"pL#p@<ᗍhGŘ-s:E쬞jm"J} XMyW:"9,]-s:E,wDT_v0ocj|a툕5?'C`8vDG ౣᗍ'hGub{XDJvhc68Pb^G_l-Xѫo(ƨ=/1+ \XGr֫w,Vo7,snnE`mG;b%|(ƨrc{:>~&|Df| v:"9,f| _:AMD |ܺ#O2J:#9-fS)+6ߕrJ&ʻ`GuNd~[S`~-m&@ۍDG`#uFe4w% o^ _4Ro9V #`{KI#/㟌_$|<ac"VoCتA'o9B"X_֌O7¯ic2Xg'섏Doq?;ٲxgtb1qyβh9|洳?툕"e!v"ﳧYώ5<FXvJGW9|洳?툕"e!v"ﳏYpifE;c)kH#֌J?zOD?JGŗBR>J#/q"w߄۰^0f7˚H88MD <៑ |-ŗq"OqVOiJR_jGuƗuEE?sY`M~Kߌ//_3d˚L88MD$3̄<_'י$|-ϝї˄H#]0 +68y{^W_3N#/㟌_$|a#o^^Hӻ̓tĨzVNoC|(q^W_3N#֌zGޟNt?t(@#6yt=#vf^2!Z_ %#B$|N#VߟH$sUDZ4?_S,]l"7!J!Mmyt6)>U|Yv -o+TWvJ ?8Ůݹ<8t WqGԠby{ϴRHQWיV |;?_j~fLI3Fi+6;fHC,No/U<5zM;3rkߌ3f|yY3~ N |Ju>Bnz}G@ 95z}GMvzO}UGM# UGF&|% oƗ__20yY3 NWL}?gGߓL{>2R_-)>*h 4_WK#_Z—FHQWǗQp~FS-ψz(1qvjhUm#0xe닿WǵS|$U\۶^&T5k;I펞f5nD~V?(mzIN]:{ehJ?kMDwaC$|G§w(>R6oǬOuNsfqapf@o Q{j8R5RnәTQ& Vv0oQ*`^pʂc:bm:O#ʆJ‡v0oQgجʆzE _2f|a|%Ɨ/^wb7c\f#~f67JM"v0oQG<^0:rvJ~1v X(MDX/zܽ =FݮK.δ~nxq›? vX3 KGG*zmQ{G=e~n7"|J;l szxwDŘWr)g&y奚Xނ:6KLA`/' 񗕶Am7":Xv{UK/ 1N3e1wߌ//k?#N{>mQ{GoDy§w(>k1+YM)۸SzoQ}(q^pJS,o^ S3VknڌhQ}t罪a:O@`mz;fu&|Z(_6G]:K y fjQw^b-]GKm"=Z*&tQ}(^pJS,o^_Cg1}7c V O+z;շQ,W5{[0Wǿ3NtSdi.J[ńO7oX~3q]:KXނHdhXnZgaX`v0o|t\彪az3-ѫD1F}LNt?Sӟm"J?Fm"p#{UnVOѽIxtl.G`M2@9[ˉzB7Ovc hr<q9|f?oqnKN)>)̄/k)vJG$6>c֌_[ljI$|a~A^_jY &Ro"X_֌{·yg(~G@g'섏:b&~yzpT#+z-ϻtn*>ҵ*>mQ9 3#I.#6_<KGyRG^ UĨ{izgXJy6DiX#6Wßw<F JZ]:zT[p4OD/GmZ ~]OQ|֎cV¿s1,M*Uov0z$sUG< آKYނ:ekHӻo{pinA;=VG`#tRiDu?aiz=w VC9#:`Z]:x4[/T.W'sUǰ4 ~3mAv0z$sU?L z.1kd4_+6i۲^_|PY ޥ>%zM7 Kߌ/00d|afo7O㛧囧3|,yVy#mR-Wt<fkNuoǬ_7 Kߌ/00d|aA9]87ށb bA9u4;F@YTWvu"RîݹϓgJK[SG<Dc/㟌_$|a##E^_|?e2 -§#䶭ׄ]˙0٩5{2W?w'|Jiz?k'|z9xY_\>)>U|)wR)~< ӻt5zMv퀿gBnzMw)jבq |WHu~G| #E^_V~Z~>(CKjGGM~k/+Ũ[uCUrqjpen$G;#[F- HZf>>Iu&: !m#5^x1k-)>*~k 5Gm[/>(jZG d|a'? ydCş+)>*~_ /Ÿ"^_֌zǵS|$U>V(9 y_:KO dC, +< ្O!|kwߋ7 /_3e2>Ak$5_:H#H*A2_֌jǵS|Jׄ+B&|D~ V?e7gͳͳ9||a;se%|A9XqHй-ՃM$\ENlDˬRv̚kM88tnKd{;ǯ5)hYӹ-ŷ?ގYDczqVpnuv0( tek9Z)hehf·y?]m?W`0>J !7^_|R1 (>k1+;Q)DZD^YØT\ՁVH s[3z6t+Ͱ-zM' ?00I0a##E^߉bL>em\6RH <+z6 +Ͱ-zu|(Ɣ@'S}B|"v0"/CTDw]:E42Rъ)[i^fz8ZsJ \. pUo-䦴.d"ּu5D`䎀:O#^ZouYMWxn!7FZ42RFb7|gm-wD0v/; vWzޙ=] ?42R5n=;.?b۱^>{8h1m9 o+Ͱ=zu|ƨu"nrG@ Y^ZmݘqJGCT#^KӜ81,oA^_3>kODwvf|T$|z91ѫD1F~X*yqt1m>pS:]:X)h{O?2a|a1acۣWw1o rGØZfSƊS:6mw+G^KGZ{ӎcV¿w-Fݡe9*MA(m6hn8@:]:m҃형5G>ôX Km"*6 ƊS:G 8<8ʹˈ^_Cg1(\@r0yirc)u#`Gߥֆc:QQw~aݍᏀ{Gw@kovJ?t";޷B\כz;kxS: Dg;3c{Y 6~ Kӟ>sٟ형-N})S-MD <8-ZfF@9v̚wM88MDoB3|- S>LoǬ;l}NՃA(}ᘖGs[k1k;IL=XgFaziØ,ÍH Ǵ<v/:n`ENLٖt6o &zpL#@:@vJ)ۺ0N{F;#cQ^'Kg+u<-X_mY؉_%6|rc)fs]v/k054HwcP#]jm"ov0vQDz<J%u>iV ey Nۼb=ojZ ^ztԱ,<]:JAlrWynG:{P֓[Loc)fsݯG!]:_~LuXVDK6iN\]:2BO7cɽ-]kKo0㔎:Gƨ+,{[_VHě~u-]kO;PcS:Gh]:_|̬o?8v"OgDž(m6hnP@aS: آ3*ގY "eqDIɄKMSǶS: أ3*ގY "eqDՃy6-7( mt@F@TWvJ?8v~;E A19ulK%ɀK19XM$(n\>(y=("PP+)@mYǯd|Y*ގqHV(/ 6+a+8/nVY]M ةcVR&) *XI DOj pH`iTn^ v#HPQפd(8a')X`Vpާ%z}xzWS+ uDI 6)E ;@+/nV{R+H {DF vO _@N ;J]/nV %+8}@)IR 肪xjmY`cPPCb@:'-V6m;AscU +ж|5z} BBo#iQn TA_3 eE^zKewPXrBo%iQ~! * m@5J;J& a? _Ua 5̓r^_ uf -ՀlJZ7VI>I{gXk|Fֲ{GCWC}v(w ֒$P ~ϰR׀Is^]blq\ ΢kXQ~Z[kװn9kz$]g }e R-ՀPWր͎aHGtv Lnd\1i}.#Pb*pvUKv \ٶgm {=ގIb aoXB-*q6m'1zǓfc5m84۟pܩ6wJ5˰LKBm"43* m-59gqFy;VVc =RښՓ5Ht@xT5oY._k5 <i%iؕ4B(jiK]4GҰY^ag 6kYf g 2@AF 54IyJR׀-z}55 v 8 p5 & ZIeQ $hk _A A 5HpX5pQ-HU-"dj>YMRAQoڲ )+ @i,>wWmIF$7AQ%CqdGsՓd28YF$/meFf),UfP[VIX$c$c,޳XF,,v=dN2fO2f'}$/|8,J#㰌QQI*$c$c1jB&K}4t"1#2e(o(U Qӗ!gpJ dkI+r1~XQ~x[X%5¯)bʄvUUXƨ,@.c$]!dT=$!Huų(Sb\Ǝj@]>|?AMReB9dtv]ob"E]fXQl8f~7%,=_2eAR`@mw 'ں iI&ulq@ydŻU Y.cGy%8BvBO=2=+AC'F#ǭ2Nw̰J@x{Vd` $򎇁EcX!Cm[}jX{paxm:}AtFiP.˸æw?a i=oo ;:"|蚃QjPv 8 + DD9+ 9BIH_$y&!7"|4T:oP}¢x"<))9XlXA1E?ݎ,Bm[}u¢",F3hxqU[{ ZB^ok2kZVw#gKˤ$r㪶۴l'xÊZiPQb԰Z6 Cw7"U=+/-h9|vTStt)NifC/:u R.۴,<GRr-=yMܤZtƹMt2zjآ-Noעt9aw>!BmHm3=͢'^m^P]H@k$ɭe] u5`Bg  u "^+kQY|iُyȗyG|i9yȗy̬ ֲ'kD']̬2NRgR'kԷkA.y vtiiQL]ly[ΣaC:NgzgfTjܡeb6ĬD;WؖWLK/Q>|FSš ;@f-5&ZtD1Otz!U߼ȴR[X3v {yRߝߦuTNjܤEfSW:}Zf͞#;vίn4D*'enҢцF haѪaCPߝ߳%ʋlR߮EC1@2vm ݙ6(HG2eϬb eάeNֲk3k8h9P,hIm;,;aϲC8 9Ye(!o ;7Pg;a-scncD)٢ӑQa\rmū2^O)YwrVւ3ЂB;e/r&kGeX ՂD*eв(1JSqv6LˬQ>l)-"ng'~^ # "2ZւB;Ga-d-^X قD*7enҢs˭wN qv\KaŠ晚G;+=}^sF9/Էk6[qlb'jo;.ʇZk#x&F?/HH妶MZtcn1O}YXhUv N;MūlsKvNdoׂYz[C$ڻ ŲJxi_NmayԴ"Y'5-ɦM` $SeZVa#ay"h;Wmayyt_B}O~(/9__;dͳ%MkkQ[X+vRߓ_/&-}7˙|RXG썁mnkiQ>t&.\޷k5PF}O~ט(ײ{Ҳ-h/-hُr-h/-h9K!q-Ђ59ΣQ}'-@Zh `A}ccQsܵk_X{c=ZuhG|iyck=6{l|cI_Z=kԙ=ֿc=6{WQY A ݴoZ=+5}'ۖMZwe>H eDjmayϲ<%oA;-ʫ=?DFJ}bܯ A*r--ʇbn۵ ܢxf Iq*ȗhG|iG~ȗhG|iGIIxlЂ;ZXs{ߏmyJMBH֮ԖԖB cC nrz5ng:oYmoG2;s,-D1vTy%F2b.vƩf:X}e,9,`VtƩbfA,^< VYgaRH?0 RYEV۩K~cf/_2K#|s(IvXuee4eAHXj:7ʲMo`Y]Yn4bocLݷG/emd_w? ^mDT۰}Ȫ/~Xe,fM}e+ 4}q R n],߼|G2e1YG"v?,,Tk"G`ee#g \EnKʂYNSzX{ X$,|+3~tlg+RUY7eve~``A-,o=^Y[?[Yu[8rg' 2#[+ 6rfena߲BգYu8rݢ2ь-3ر{?`o;״YZ/-e1JydOҶ>%&5tۈ,ļEY[Xƾ?a){Mk9KYQ#,`|X.y~~yy}}.yqqykb[gt/_gccgccgũe>,[aJ,Wde6eUYvYP)ܔ%%7eA}N˥r "G`Y9l|d)KRRU)^zӬGeCW#Ylgt oYMW-{yؕY_9E r;-W<N/qew;B61^k}<ʬY̧/[N_4"Q꺝2NЧ7ѝN9'xȪw r7,Xu널f*9\l,bS-wHY[X쳪[.['Ivt0VlYlO N]t'Sn]QXZY , RoRQ/)˨"wʁ%j؉Ǿ쌂Vzp͑< \ة}JŅNzL12,}̛2LeAe,`Y e,aj)Nf[t;-Odi7 N_]d,e*K"wʁwΉz;;Xp&ˮ7 N_]d%כ%7eUYN9cUdERòC_{t:KI7 -%e;;VNf[t;G"IcewW#NWOOWz-Q+Ȫq?}XYy:@e՘vliF]D9 O_"v Ŷr۟WG棳>fwIO +0DD93+ȪdAdJ:v!IO +hZ_rî8It_,^_,Km"`MYbA}%XfSle V^ :jjpD6b$񤰾.ѝr՘]qv[w^_'wWő̘YC63^GβcvvIY`1U㖭|tv]Y{onS~Ȫv|`EY;XFQD1XЧd!QtWosjwdxY2<,t԰oȈ[%UtWvU'{t; >Ys;XYPD1Y,y,EVx5XDGٹdKrwhJZdIeX_DwxUq]qvRCG aй}7|wmǨEQg}J`k%UYe7 >Ỹe>,SYŜfY[*~̣o|(r %d rdwY[X7~\̃"Me|(rbAr5Ew;ӣwY[Xw}OAGيU2<N_Kd1jy'~4rû,m^ g+|YC3UEGxJDw91**oe,a:X?,`VUt;}FվcҾ^+G.|C#]x~F18KߨW}zIcAHXj:l]Ek1,߫Yò}e,`7 *ȲleA*%k;V{U#g1m묯ܮYlC\_,Ϙ/QXvYPY T݂EV XP_EY,K"**jң2X,y->JСR,%) Ȫ/%]Ncv5GYU}Bc5[㖭<5l(g Fz (f-9Kߩz~XY ׀E2;KG2ee;聍e^v?,,TUe#|2x摳,rg.sjIpƾm}@8r1y'}J[tWS/ Q&@1a_D*{MK9ˎu<“F?wʵ?΂Hd 55pD{ ŨG4 r|o;2D}O;&m w9Kad1y'~4v,)f{./zXe,a:Xò}}э'J7X$,uOWҕE Y[X}cٛ =A&G."ш̣8"hX_Ew;ڊyy2,1}WFdIdww!"v &J<_1[g/obG5C9$xw!')jغƦT~yU_tvdͶƪPk1Q)[(ge=Ȫ/~Xe,fAY,2E͂Z,ycYZW6,c(7 Ȫb儇ي[iшYD9O [=vuGbaʂ[hш`2͂>%`YIYVY"v,fae-X2,c,aY%8)vNcv GY,NO-m-tgIle֘Y,,%+KK͂>%`YYFYFVV._̃e,aY$vn_^Up~(pb)YU;C<쌓D V'y#//EzLD1věm#gY1&;$}e,`>Xo)!>Xòq&Kь}?kw,;ڶ(tdK-lxXFd%adg,N+l`|> tn߃#g1?xFsngA~@sٟWm,3aפE7YjwN+1-"-h]1?lUlF1F~4VM6{>'{xU_y',`YRƾ_ 3ݾ!X9q,;=bnJd3'ȂoH,EngA$2j1iߐY%iQn1?Asng9U2qܑiPEVc߯jxǤ*tɓ#g1?@snglᶆn9ˊyXW}~Kf%kǒj:K7 ,΢wʭw2.ѻ}cr d<VYnglAܲ0N9#Ӡe,`Y:X}e=,`ٗK7KkRȪ 2:K7K2H?cY?kkk>kkk?kklkl>klke?,`~X}te?,[YFf'e_%GɬUyGg.;ỵSǘ.BȂ D*Ȫb َ߲HewO_4em;,un9ˌyXng7eee5۲8r,dYd.F1aI?cÕ/_y RIẏe*|X2̃e]vKG$2|nᎻJ܉#g1?{#MxswٟWmDc.,-YH/ d9ӼjN؞y4yfMe^I趑7(v,a:Xòye,`Y:XeXL(Ǿ-He0{pW)Q#{)MS<27;t}r R]9:X0,%+g9KҊr-来naݭľ@;v!dטv293I֧dFc}7t,v⨱wx%MalS4qMQ#{7̆m#gY1l(]te[ž?یHv8r󫡢,F)2I97BrWUe+ {p'.,=,=+L"wʁ=EV~Y͂H%Y2,},aYɬmW5sIӞ{nr|onZYU5f'EV^[k1?y3F'?{Z쑺5xvDYbQ_'+kUeNn,,"v IZaXu;9rNV\n7 6efǪb'g}| RڃH#؃yg)NJ+fA,rMYeYXo)!>XòweCYYPޕgߟ`‚Z⮩ҹ*@&Gk,F52ЏKtWog."v 8vFqT\J̣/SDv2F3eߗlfF1SYF7F e,Te,aʂ(r7:X2yna֒}NT~uzk@&GêY";M[Kd x%gî“Ydv^KT:)'ebnmÏJDw;CAY[X,:cUx?꬟$Y"D9XtEw~`eɔ-,'}P? 2Y5Cf)1OgA@J9X.C^YafAe-XP? Y5`YYrRo\fe~`eeAg*#6w$ӢDOsCWq# "v "[V`}hg";=zۛ-b2e1*;T}rXXu9Xj:K-7KҋH?0 RYEV%÷HemZu[fV1vB0IN󰫲3NK7T֖UehXj:KT1E1,afaevpt`lu^oޔeVe;f; :TM]vrD*?t{i<⇘_?Ak<֧d2Dw;#RDVx7^C3gOvys <*Z~)1*;4}v? Xн,,߼|G2,rXl"v?,+,tdw3eIMIe +SwU._̃e,aY%~OOE 1R9EVD·.BemU8"K1]Ũ:)DwY:e,aj)L,Do9zTv>dyeo*%wʍ{'g}̛e,aR2ũe>,`Y‚c ^TT.9r{i1y'}J<,N1bvu,żׂ܋#g1"\>%nz1wr7zXe,a:Xò}~Ib]YlbAz%]YN9Ȫ(7  {p/.VedefA,rXVQGYY==b_𰤢ry͑_<“>%^t7S:OfKte#.WG{Ow,rhDx6lnz=vu̶vWz19='G2b~ i2]lig$)7WîΓbՎ}:ss,+}D1v['[;UQb_)3v& rFdɲU܅#v(pdW‘ԘL6It; <,vB9KE IsJe~{L"v beo@6/zOff}`YJUn)Kk͂$j΂O,Wd%geAs}Jҳ|2-,Jnyb~Y(td!ڙ#g)1;d}xngae6stԢ,bN}O XfQS,-j T=nm9Kۊь̣xՐxN9dpȪb{ƓO2Ỹe>,SYŜfYX'nb/'-UGβc~ىc3\7YEtѧg"Gī{xUq(䓽s*R1 \Y|?."v ⎱{Ov܄PyTc~ىd3\خ?V="^5xbA"jR͂HO_M\WӝyygAs~4XZQVn."v n%b"3OM^C2~>̗/˼YXY ẏe*|X2̃e]v?,,5Vv.%βͲzLF1l'd|XXu9Xj:7.ʒH?0&?J΂"Rɫn7Gβb~1(r΂\?[CȒS{'<4eabY"d,8KʢwʥwӸX^լښ&<VqN+y)c.GY÷f="՚ؽd-VhZ-~Vl 6rt?Jdi;ƾ:D*5{4Wf8(]vGxOɖ(&΍z\yXngA.f'D*焚ٽW?Pfw<|4<“e}JO=tYZ(Mt; |.T?Vt k#~#,n˖(&}Sn<,]D .~i2bp,={oGY,NӖ˖(&-T6UqO~^ g+׀L2@A v ~4Fβb.GiY~bmtdmFvd -*X.wawD,ݢ@#noaD*}ѽRso&KHh5m#V.j2͂H%Xн,yޕe6e#g ݕE1,8u,V<нNe)k#,GWm,+aɬe?,`~X}&>Xò'./=n1 "G`CYvW=,y()wdtUO4cXp&de`zx6XJUS4"v,a9:z:X͒5V5V5Vtqccg,+K˱8XeR5VdV~,E3>;K9XyX9X;X{X;XiKMVT݂E2rjYjVo.Gf7 *k2Le[·e,`B.<eυ{Lg+nA&G+E#nOʶEG趑7(v˰Smr+]SUڂZ4;b~S=),gYZyj˲ye=,`zXe_v jGüITkaw~.yfo"<'eO l]Fb좬rXн,y^efefA,z\ygA!1'يƑԘ<GO 6rfeeeueAnHXPՕee;G;DVE#xǤ 2<ݴpYRdm7CeļEY[X ƾ'cvn#g1y[G)0a趑]Qvc;;{w.zp͑(b,K;6Gd)aWb!2}7ٻ!#ۢQR>%8m#gi1L,;ƾ?ztgUỴߟuYrdIbXB%wkaWf-õe,aY%`EYN9,菲Eƾ3Fw_%zmRM3ȊbT"h{:l;GβcveG٢bifAwv7XʸYPD1Y,rX"vn%ztIewϷnũh[x,F%2$O l;lDxrenaƓoعdM2SoY1畈ws"v <,EweTyd-YݮM~g\YFîL=ngA\.>ߥJϣE:bT"O2-)fîL=ngA$2d}ѹdC2Go&VF1v^B6q#gY12$q,.'컍$_ڐbT"O2zѝNcveIt_,ޣYɂgr~5DYvYЧdI6ȝr`s"vKƓwLo3.evjbNMi t[f*;w՘]{΂jlֳS9Km^,`Yh7 +kUfv,))ՔqXfYXYk,],X5KdeeeYYN9,\v yT~hg48r^3u; <)*)=Ȫ7 "`]Y$,X5Kdee-bD"wG"j}/Hek>kXjbT#O)ٴ5wʥ󰫰3Nd+|.1i3nB]3rڊQ#RF1owq-M[X}&5X5[d1jyGMKtNbfƂ5`#`lu\o`UYNngA.j 1[k֡G\5[d1jyG,QSJDw<߫Y;&2LeAse,`XòQXYXYk,],`]Yy$,SYPi֧drkCY[Xw rOAo]NV~ڧf}ؼ%uSG|اz\1 ,ž?ৠ{9L<kp YgIcEw=1 ,vO}^UL<"Kr=OV];fî(Ct_,,) zpE2R,,SѕE1,2D͂;&`#Ԣ,=+K/7 ee;HYe:X}e,SB}e+ }qI7X$,m(22e e;2/Yo1i, <K2zO XvUS,* M o0 noa#Ȑ{4)M-olngA\2i'E1eM#g>_շ,G3ij:br}żgKd6E7Y;?wM;zp̑g$y,G3ijav)Wb޳p2[Y}}|Le֐hxx6EtNdD 2qWG1y&'dM !w혇]'%dvB-ȶ?[CrIgأ('vcY;X%deX򌤳TbrQN>鬔{tn"v }V%ضiT~U_:2ķ^1('tVDwD9ȪbU r:AeXu 2oiє(|٧wQ F'-j͂Z,y|>XbA,,TnU_e,a:X͂>%d~X?K7 *k[HXPޕe*222/QoTւU`#,(˨7 eUe;R; l}leA-X$,=,[YfYЧ,;))bYee,Gẏe*|X2̃e]v?,,*h"G`MYVUn)JDw?K1,_v@#ztdw/~yƑgT"=QɂHЖxj9KyϘ[X7<э'ٿl=;G|&b,l!r܈,/%Ɠ۬G8_dNjQ2}J67Ew?1;d,ޕ`O6=G}gkr4=O*q܌y5g}e,`>Xo)!>Xò{v|GQ`Ase*Kʢw͘yxng' tnfuZ֛}Jҫr3{΂X^ [UdsfvixAsnglwYdnaӓƓwLnfI;1y'}Jhǝr;'g}xngƂ39X4h| 9]łn`MYN=nM dVN9I1CA+=UYO-j k~ɾۨ<ːLZ!QD9仞e;+H?0,!{v? XP? Y5`Af `f]YvSF) XVY,fUee(sa e=}Q?G}&zk(|\vW9ˌCng߲kAP? 2<V Y;|`.;ń,TCg"ѻ-YHe'A&GêY!Qtvvvbrvî8Et"eo"پ!]9u_!QtvmrDx‚coYĽQo ݖGβcvM,/RoD*Z܋#e| ]Rhwʁ=C[X ߲Som{poe|M-,`Y~f/%vLtd%hy|I;û-gdF;9JH̣E1Gҋ̬,rX7dv~bm9Ks~QLgw;;en9ˌyafA,=8XU,) 3~4XVWS,b^nj}OHB0oms)#>a6rN΢f:X}e,ɲleNK{t5nD*ܓ[5β0HX$oz2wv?,,T='Gˬʲ0(XvS\E[1,]v_,;ztVݒfeXq< $e;V̻)_v,`iJ̃e>,ṁe,`˱Һn[}~He=3GdmiB#Ml;jmDZb.,/,Ktv' VnTʁ%e~``A^e,%,`|X.Z%7efaifAe-XPu <KҒ|,#+ʂ(]t; [_=Mˬ[#NCd}5*Xm1Kt}~,dveMYzYPٕE‚X^~ Z-Gsl Yjtv瓯97e^ '%=t,m[vx`zf$ ߒtx ,F5:w;;en9ˎyXe`A-X$,}(22ee;v˼~XVY,^<˨ʲz,*DN΂(]tewhǾ?;^*Gdi-B#Mbߝ].ƫZ,<,]2DX~Ǿ?ԻevUGdp YL `VXzT=sSìGfkk@&G[.!Q#<_x,;#R9B;X&'T?bYz_k(y [ݖ3Gd%.v 9   a‘d%<“͏Nn}趑Ԙ7 {-,)O{W_Z+ރ{q,,G3nw?NcvrwL=GK.ʂ(fuKҋȝr`a=/=ewLjPZa_J+ya|,G3n)nK%_yk'gv[w-ekwL~MaIpj!Q#kwI3JiYO)tKfdmm;=*k}#:"Gd5C#rflQ)G[rD99?; Y[n[';hU #M{r$QN{R7zQNmΣN,-7T?N|99r5Gb$ODf趑];9e=,`YzX2e,aY˾~XrYPY ],+ u_,y(K"wʂ([tÿO;ҷē𤋮KGJEgw>IS2mDz`%JYt; ;Xat!Q#>ISBCS{ 6r+y'g,;`o>_&^ރ{p,kSxasngA~@sٟWm,3aWN΢b=GKMVn)L"wʁ=Ce7K,`Y‚c {eH='G2|gkr=Om,+e'g}xng' ],=+ u_,SE {xaX{tI'ܛ#gY>_1)Q#>ISB[CȲSîD=ndsG7~vِ5(tdߡOB.Nzz!{-,ž͋'m@]8" Xq!Q#>IS[Nzz!{-,ޱgn>wYu;=AYt'SnwKYt;-OddܝA2 e;!{-,DƾیOv=G2}f+u;5s ٤ݖm,;aWN}״wkCx!,CXuVErH"=iv E1$Wne|<#rIfIGe`)Ɗw'Ae<#rIf;i?0x,!{-,w'[c$dՀ[!ˑD93-ln˙#gؤەv{->\UG9f1('dSy";i?0x,!{-,l÷,Ήָ*@&Gӯ(:I>%Oѝ=vev)Y}0·,.B2AzpG`ŪY!Qtvl}JO2;T,;ƾ_]ΉּYzgzbn,.3d3yp,iWfg*|~e~55 ̣ٽrc-d3\Vî8Ut_,9=,[Yн,y͒Ԥ,rX!{̛%e,aʂ(v7:X2ynaľ_zD*?{ͧkgA!QJ9<)a}YgHe `iƾD*֕oo`TRO FѝN9;d[4ƾ-H^e#(|[5ը+FVY[b;B}H嗟ٽdyTbpV F5*ЏCtgSшT==펈Tي5 ̣;k1Q)' z\>O Of]te_}-" *GIb&QJ9K/K܃ e]Y\ԩ,}( kxe՗c-<ك`iEYZ}YZSQEꁁʕ‚dɓ ngfoe++{w qYe`A\2}^"+e/?,,Td5eUYF{YP,))D*W^vY·e_,b9s,SBsQGY;Xwuw;X^2<][8eyR1:%Dw;ƉqYenⒹz&rW.l'z]'YnNYcv,wu;5pOYFCOgzDw;尓d O[\lK}l<):%Ut7Sn]QLtPw6kpOexzl<):%NbvuG1,o6jpL2@g)ȓr-b-e;U\㴫>nlN۟_1y` V} ,[#OʡN/UtwSn];--/fYc, < v_#e̛%d)D*d^1 dR˂l,rX){e9}|Xr͸z^d\,r*̶JvC;dܓf,0Fʲ53= CZӮKo/ NւnRR,,8)ٔev^vY·e_,b9s,8)GsQd-mkk9֮9696>sl\sl]sl}غذ/ Nւn"G`]YfS_)ueXWG٢;X o?dmS`9,b9e_,eA|X>x\cξyA ] -<'3Yy{rV5Y`!jtXwNoﭾ50iZyR=uJ蕈wk2N+BF:/ wﭾ5+eZyR))gӮI^d>,,b.Ų?,Q;X˂ e#,bN XPS,k( ",eҫ`R6Yf}YP,VE1,ߋ~Y.}˾XbseXr?,Q;X˂2˂JdYeA-"wʁeOe^D7Y*by-X(e'?-ݗ,[+Oʡg2<#u\q5W˾Xr>,byYCBsQUt?,{,8Y 䫁E*IɲedSٺX&_֔;kg55g,)Km/KO1)d~qUv'+Xʲ%QI9*3ɿ=yeby=;N: "WIVևŔ-eie˚_ul=,+ )K˂5e/?,|XN;q궳u`,b9e_,er|X2NwL: ׀E2YE6Xl}XLYRS,g],؝,;=궲`՞-<-˓rY镈u)7cv-]tOwTV%Pdy:̚#hYk3%QLXwʭ]{/,g],v؇ŔQ_}bXcòF7z#`AHX0kY7яW2E "=e/ş֚~wyǤ?GND<fYvkÏ]t/SZ.Ewz1V4exQſ{ru82]t\=ʿz߉Y4qy5( _G֑EVbv.^D*5`#` ! h̦,z\dάeXb.a9˾Xe_,;Y8Fα^.,8u <oS[cnGae΂5`#,)/ ꔀeue;v' LMu<jpYF=8rd)gJ*rHJ/,c,v؇Ŕe>,b>,v/  jpE2W`YeYSYPSx`gDbe`A nHXj",V_krȝr`9UY3[;XwuwLf/{V-rgI=RF9ocnf--my7KZ-X$,{& d̛I9giSY|Yx /e/%"ZO-$tW&{eX 5ʉS𛕜W^vY·e_,b9s,\,b9,,byYP,b9,rDr˂`,y[ʂ( /)K]ʢwʕ{~XjFOcuv7X$,Qe)KʢwʕOQ͞7$t}-Efz ,5aW^Dw~5X}ZܻEVoʢU3= =ﴧnoqU,RF7{e'f̣kk,Z53SX`Y9 "N1,ؓE2`eAe̪,riPDVx2|b[rsOW$[zX%>9sv+;X}0dӌmfS`9޹'=[ l]rD9osv+,5"dYٙwvh^}Ȣ%QN5Yx/ȪqzWewJo"D9SxRʩ rƩ"v y=j қvFVإN ߩ[;"v x=gj қȢSX֟`Y9 +T,d= ~o.%YDΞ:%>u{+X,aWae*N`YKY;XRD1-t,< U]rbifO[c+XVwŴ,-WrSnxPTƩ;X-['k}EVXwz͈bZěkƫ`yK1jxWU,vtd>,vF1-t,b>,vK/ ~Y,g,g( )K҇2NK/ ~ٟ5hƃ]3՗uJ2,SEw *>|.{$uxYgBw:%^tN㰫2NK/ ~yr;X|YTD1-t?,S9E+9,߫&KC.oY1s/_r<#0޹@snhH.םr㰫o;Xu;&dqrs(L?[Ew;%$o,^zz7YǕyTrsO( la>)r0 {6""qe4<;Xݎ-b;f~sE7Yby]!R@V ßVF"h0?6.z2Ri jr#A/5_S[@v0:G f StS)4Y[X|DZsnz^&[2r| <0gMUÛ"v <[c0= EcnkV{J!ȪV|.1p~d2,LJE!D9S=3j=0f XY[X|.2 ҟvٖ9s|xhIs0^U&Cml8Ct?,,8Y fZ%R,R ,87DVNoњew2OL2Nղ|edt]V.,q~X|Y,b9e_,eb9eA})c#}+9"2SyeDVVvgO:%.]Nsv5GaeA,8u <K2DQ̡,֕E "SdnaA.~ "|5̣Azl<ﮚQ> Ɇ(St, RIXbʲb}bXccOx-kʟvT釭`9>Gt)[-Grae΂5`#,(ˮ/n)쇭1R9EV],b}Ų?,bvfϩGc d6%}ījIxvWzqչ3[,6}|-DY #|Glx]t7Sn];3>}uன9X}]G%Gx4-[#3co%)G];3Uu|_woi/rqEGlslv)svuLt,IbS..Ų?,,8Y K/K2XVW_3U?,355gkkkg5f}|ؼXX̱~ͱyͱccv11܏5^ N݂E22,k,8)=eeeA}]櫣}fs-$tW.heewt)GtWUz`TȪɲ݃-7|.55VyleY;{:,j*HY[X|ӷpה!.<~,ZYٝ=uJa*HYr˂`[HX) #t?,SڔE[9,Er>,b9e_,fSBsQKQe`q?oz]l-$tCd}蒾/Sםrk>K/Kmʂ`#,bԡ,+)g9,E7Y<\55+[}Pr|ЏFsnLx5e;UN9k9b}XLYŜe],ae?vXxYp$XP<*9,bN XPS,TU?,,c,*fQeԗuJȝr`YUYF{_Gv15ەyr|( ̆*lq5X`uk ̣+/F1gd WrSn8rDwmԣlE _iX"# )[tN9q53;;X|EAu?jM'ظ"# )_w/ `qk #a5EGSr/̺ee7eY]YVY",,STC3̎drHs'=YxEnYvbe,8YKuR3/ae],ò.{&/ qc܋~c}`je8ْ虬SBDtWo"vX|e N݂֗VeABÂ:%`UYf}Yp-,;d9_ ^,b9e_,eA|X2NdilW4xXkme nc֕ohD1wn-eV[V5]Q=_܇`9>!CwQmEdȪ=s/_Y˙WQ'zQg6욲Q ^EwKuڍHe_kf+X,LJ?( O}j˛`99^=Er˂H%XP,yd9,bK"wʁ5ȪEnlF*5`#'t_,~4XZUS,EVNcßvD*?^ [rr| E2=~4mSk5aע>DR˂H%XP,yxd%2~4XTS,=DVx[0Εys| `''{g+طΖD9ѳxR+S!_Ȫ96E}~ZR}";C9ǰI9Xo{j=0dC ]3E7YVαUU>pvlr| hIew,?#9bѽ\T.U?,,Tn"G`,(KdiRH=0 RDVN|M=[<0d;nge+%ǧB-쎞uJsh^zrp4Uq- 2G9ٺ@b| ^F;z&)\Ιv+~Xj{Y ׀E2rԪ,,+Ko"w1) *D"s7אL@~h)\NjEwNp溿ig,cKq|r=[;3&wsW,;k#lM6de*^c`99>rG1]+̸wauDeXŲ?,beXŲ/ay|Yl(˜"G`kl|Y $ XN9z-SY3;;Xuυ;&͟mTd)hs,eSY\s_sX_=vXZYpRyR5ǂ`iMYZYP]YFYFW6?,|XԢ,yZ.,,SƢ,,( +9^.XbүZ˾Xbb%g,;oy ClmYq+hQ^T]W5zTUɂ'kt{*Q nB nI膿zuue`99,SD5,XP,yٔQ)a~cSSMYP`A$ <0d$ut^"-,^B-MEddWTeyoaYon :%؃Nr1q~XFw jpE2b]YŴN XjWS,-,у_;5;W2zOfŴ,!畤noq%=߫~Yfeb}X,bZ~Yb}Xbُ|5SU,''D1w& ∨SŒ-9{dͭ/_Y#G_ZȢU2{ GVGv̡Dw .~y_j,]G=CGޓEsiF>㍹8ߛD"soSߴ+h gdddL~4=`9ޘ`g~ׂ 5C^[Gەys|SU2{2^IYiDVN~skjc+2)jOFb}'h杦noKl]tGgαoY$dրIGdђ(ٳBcԭQΌ"vXV{YP,8? 5`Af`YeY]YvS"v KiOe}1$ٝyɵtlI{<{nrxdL^QUK߲JS3+#fq|K-rNwBcԭQN)na]N߲Noad,ZR{^IVX7~Fe.28[ClV >O-=IJRȂ/Ȫ/=} Ylz $ meK*{<^d[r<2Pgn˸Y#`AhQZW< 2 eCdna7OMrӌHedeծ̣Z-٪yuJ&sT]le]5*9n{P+}KWg+NvfVF\C3(f"k)[`]QLte#v/zo4̣;D1G& "tvR0^)/-ju+ɺkzlKṾŨ^)[%g7~E}-r|~r?e}@%P [rr|Ŝ,=e+UV",#G9?{DF7z:>PfW4IgsnWaɝrxX8Et "+Yz1}z $tKdyFf6w5a,c,^<ʂ(  ꔀwe;Ȫѝ,'MVG?{0,GYZyYڕq2ȝr`W6 "_{Y˒.u؇e_,v؇.a_, <9,+K/ 2ȝr4("vXFw jpd/K\*O."[bg:%EtKeY[X|WŷtW#;fD1WuJhnqڝ,q-QC8uˢWQɃQL d1-eUg,3# qҷ>kǩcl'&cNSrM;;aWge*Z>,GYp,,\,GYjyYP,()^q%ӷn=~OZKj͠󷰉,Z#3Y֋wʝ㰫2NOkK߲9`5ڥt 0ldBw ?`lc ̯GN:n""v'KC1ۊY˵^W74;t_oě[6F1=\¸eXŲ?,beXŲ/ayF ~seeĵ4[dyuJm]ej0g76U?,,T7e#`l ^ٕŚD*XpaYr>,b9e_,eMsQMt?,k,Te,e#`l >,,{)^/^=v'KwrS>zsXyn[5GdyN?sGtWEf7jxwU; BI0kȢ52=~4|"{ƫ;#]d/,T. yB˲/Xb~=\;<,d5 #aEkdz"J65}z`#߻&IukAfzP丅S53= @DtWogȪ_ae_,ò/X\,b}na^s 5|Vdlԑ D93<(2Z ]2 v <[cSPx~Vʍq dKwk)yR>@\r<Σ2/Ų/a],r.}˾XcẅKӞœ5x~M47qG$ʉg$sΧZ #MU?,,T'"G`˨G2,R ,TNUŽߚdN 2k`+Xz[xgG^1 yEDw // k@fa?-7e` \9Ӯ8Kt by/p[p kf+X,ǍYZy~\M=2^-횬D7Y~uEWFskfc,清w2=hƫsݧvҮ(&gxuֿrzﭾ50nl<2x`R{8욬b;X-s7Bp[/qzM5}uEke1GƫTȪQ>,GYP,y쾺(/ ȝr`YEYXYteKuB]`U^:[YVfM=r4P?,s,+ `y36w_Cde"wʁ"vX$,-,ؓ<} U_f *)fe̱uͱqͱccc355gk-,n3cS0Ʃ[Mc=-|-rg?{h=0FY[Xׂ9%8y4s)ْ('z&O+ߞ+j>4Nb+Xf[k3[RݸF9E;]HY[X|ҷl83 DVD"sn="߹^C2:s/lfkgz̓,+a2/ "`aò,y,{$1loc )jQVl=,V.,,*K-RR2~YeA,v؇Ŕ嬋>,b>,vdnJz X$,{ 2nuJ2`(K/KfU{ܚׂu~h"-,7Jej2߫K8StqkWrD*^7[b9zui ?[S8,ݬ3E7Y-k"9\VY/˪fq|(-Mx ?$u{,]Cr-,庿ʿ!^-Ȫf}Yo`8M!畤noB8Kt,ò/s˹Xr^Q.sQQ?,c,Tk"G`la1eYKYzYi jee6e]Y$,}5 _9źXY+U>,GY'd&d./ivY>sl]sl\sl|ظغ̱uͱ}ͱcc"Oz*OVXF97c6BcԭQy:ed'=>5:s|#݌c܊#uks2DV`>,,{],a],ae?vXxYXYXfPӕ北LeCYXX/LdnaqooiO;,eQ=Bv q9QGtyJۭ1V1e{Q>쟭[s䞨#r<6Qӷ[ǟ Yk[s(,ZR{:%F[GV8;XwLs/KZTlOes`]G/!gkV8?H$}Thk2XiXȢU2{:%F[gYvq`zX߻n`5SkdKtq|bZ&.}JRȂ/D(j Wn 95 #u ȢU2{:%F-u{+X,'SE7Y$jt/_[Վ(X?[SӁ7-,Ddׂ.K!,Z53Гn}K cu@CM#1yɊYsDvǝYfDPgMU%[2bKBp|/;[DỌSF9os<^qXuf]g͏۽We#ukp_vUqslG__m:k?B}»!G(w"v' _#}O*e-xqɢ%QN?)񳕺5ʉ:%'_-, -?TYIH:s[E-쎞g$wX,='wܨ3Ew~~o9ͅH{dII~oٳ%S,#aWae)ѻ-{Kwd7~~yEK*M|!?Z2/Ų/a],r.}˾XcbCYT<oPdy:pYjfxM..pэH%XP,yVY7K:%Һ&%jQTd唋(K-/Kҋ&%j^D*b}XLY5}Xb}XY8Kt-/"ok~_!f`WȢ2=~4 ]2^]\"v {߲TV}iy֊Ȣ2p[ƫa,8쪬D7Y ^zoYkH&_Nzݲ2pgOƫhy4U?,c, TdMeCY|Y 5e͗JY[XoJPelEw:4{Ȣ2= /Dwx ];3/\,r.}d9eDwxaoM\̡G`,Z-sHSy;}dK"Ri"v'ˎ?yU ޙlIpn=e Owz`ZY[Xף>_'`+?Y$ʉG-WVce`#,{*^Kxr:&™b_ӔźHX+ir˂r`]Y&™rcZҷDN.q~dy+h-jVƫ`Drv5V٢eed-YbM.Ų 偟;\=SV '|-쎞g$wxXj=0 RyDVdOߛy( Kk2H=0 RyDVD"ӷPfO4+'2 Ȫ‚X]͟D*deܝ(rgxfC-U}LUKuTVU!YYsD!5ےQLZ.7yܙ"v E[αy{.5<mdKy_7(gdߌjw 9dž=V,lˉQ&e+y' [d"v yzα ~_LVl]_S}|d('{/St77<)j5ҷ𹲆8?ٺ(le=HƷ%k#* MPg^I}uE}|\Ξg$#li=0pqr-,ko9}EA򗧵x~w*|iQ_1>g,[Yٝ=Hfmݴ2pr-,]ko9}@5$Kot润,[Yٝ=딜^t7Oî8StZKr+jQf(4,[Yٝ=zDwz`⎛Eò:΂5`#,( 3eb+7U~Y.}˾XbseXr#Z'1l{ kFc+5G˲5"=ZEwx-\fʪ6%lbغ">gkʲ5#=D*ΛȪoђrBסx.˲5#=딜^tWowDDV\[Hk@&G;n)֌# Srh}=U۝7.U:sX6<==qekF{h:DwxvgDVZ{KTbۦG`)֌# mg 3Ri"v "-gkʲQN <3GtwlI"v K%ij;tVO(&,ߙUVîMtۢF7z|9YQ`Y1gkʲ"=!;,V7FP߻`y5cQg۟؇`1gkʲ"=~4l={d {Nɂ(PFEm /|a,lˉQ yB75x]jO\ΞmeZl]q:VW F*}$$tWleew>(fg+XFܨEw VE#k,+G˲+bN﫨Sòˇ(*"G`Yb9̣d5e\]eJbS..Ų?,g,Tk"G`,+/˙RM4ʂ8[tw[^r ׀E2kIVKV՗]dĄ|`߹^c+Ju,[;2 I̩7 R TdLeCY|YR>ϗʓ^D*5o<Ҫ~,?v {P-X.^a<ҀQ=eڑys?elM XuRHXR>)\2˂HIn95;-[;2cGfx-i/are#`R6YfyYfU+beA5撲_{YXg,v؇Ŕe>,b>,vnaq/=jtDk@&Gk,[;2~noKqEt?CQ='l=lWٚlvʲ%QN/{nrocv~Y.}˾XbseXrI^gu[Kazz fEεH;i#} ˉ =#5vj;ė'W_V_1̊)%UXLK߉%>}d1UNXm1bLe9YьRbm!Αg^(%O=#5%{t'0iD,X:gmaU,(uX?`ԬrēSwh'V=?-Mi VgwXXyTXGZe/0l_qpF}y) NlhKDRhKU `hpN[N/jHpV c u<^V1R?8)IX76<(]waHNo'Ә:cl) 9XvHrwC`[Ċk9tz;OK)ҏX–i#} YEl_q q-:ŬI"&$,g\>%=/rwC`X,QޯHNo'mP]o/:{VI#ףOI +! Y+nkNޯHNo'L*nJʖRuvSlJ=2&K|۲G7Fzvz95v()EovR}J-Rb'[KN,XнXXQ,,8*xv+W?XGwba5"GrbX|~R,}*>XEl_q]X\{ HX{ay͸^XE2befU럸 x[X"z'kɩG_[zVqEJ=j77kœo+fE딒%j*M'mܰң(W܂cy NI`V٨F|Ml!)7>`uQ^L=j߇&{U,O#֘QJ,^o ?qމ<Ŏ3}ޱ<%2%F@Rb34X ZWy0#ޗ]@z3'Ndb~2KX^5m'_X[bA7b/,U,,r_Xb~eaa"Gb9SrbX\[[ķ+9[|p2K?ż;w䫐oI?0ߥG\w3N,q Y|o;OQJ,3Y̛Ki\/N 'W׳j܅ Un9bw'"V̊v(%CK?+bZO .Znʱ`W\`ł',r,"7Xi0 :5?X_X SRXFNC|'XZ#vzp~r-i; nX \oG\&YzuWLeǎwJܷO~bzOcWr [[Q-ʇFkIlqm-zVUad2FW|1/ո Ff[0,7zgh6B?UG+Y,e#}N;`*g<k4J!W|eafʌ :{u^z5oM,`n';0+ c}+UBZUyx6v9žZy/~f+:sdηWu"'`g5+4\8FvCmΑ}J;{_GjĒyI2(vЯ8-Α}Jr,sG}yXqwb8 K|D#0W+|~0l!L0Rb_o+iW3V3YE)wrç}݅OXQ,Ry,(9?XbX|s[ bb+Tƻz~xGI*EwLP"W](1ո VXsMw׮ovU-~L؁,QJ,^b_,T^ b?Xbr }a?X }݅L%ܥXb1M,XGK_En 1ո?XN%S ,/Df ,+),5M,`#أ#LeE6/6`1=}qFz1qM,c| 5ܔtcbqb,/,_XſXGW,ߧ`L%XbqM,`e"7嘁[DֱjݟSЅk?FZĊYb T :hzқr}sǍ}ob'j-d``O 6{SJ6b~3yl! ˹y>[.ޔ k%` j[ȹX'VT{;]gM9[5-}.UMK|'%gMGD>L$;3Q;V.ޔCVsYKj܅eC|+ܱbی'gJ+js$a97no/|iWn9Gf- 8-wy03?97;GvܯL* {[g[%"S'WlD+;GvܯNS"pRyV.,ء{YyQ:8Ӂ~l7ϡ#;,Z)"wVb?X {a/,_X~ ,1[7 0;ooJe~}j[G9ѧd1!wUݛ]j܅b- Y ԸWϣBnUmY;YNX(=:٩Y|'dr.1L㠔Xz7JUyone,}O}2 zU#}b[*u:_,`*Ml5,s~̡XT,}~XP,s~̥XT,{~X-X"X20D'ցK),` Zy^|չq6XmX20D5F)a V9ܫw2!>q}GY5Q){wdIvȢ lUS";J;N,1N=}Y?K/yZI*0r"^.jpuSbq qZ=VGپ1IJK[ҭ#ȣaWC)#Ý^ggbXSJ,Vth$W{_ߝ._, ,g(<쾶&_,R ߧ*4pոxIɼ68>)fj3#le{WD,.u߻N,ml{< (%[iBUC$P ߧ'.waKGmR(l$,'FnTM9[`a,b/, W,},5F|wqGrTJ/ gx$,'FnܔKloa9'ybq Ƞ~%Fw$NEœxQ#Kff7꧑E=iћrJ.fM,Q~%FLsyQAJfe~7g=mA)`x K0=lXVwb;YLO߉)w3&dO2x)%KtJv=;Gn)<}?;$b9-ոK'SWylVt -Α}J6;AS_,徰 `b?X^X'=9d*g̡;)%KJb&+9s/*!<ѩyob9j?-UwyM.=߉'*=<#SYIXpnbqZ/,`|gJ<:ZKۿXwHºU.;5_bEJGϣrˣO,KV[XżzS ݘj܅L׺owi4Jrn>J<:|}_VRC"GΊSobkZ1oOylKϣM_-)eFy4b;$bةwbAf[ǬSycVYwR(k'XZZCJ,ةK__,`*ŗbKXbA ,s)XЍV,kLWy5.=bKawb Hۿ|Xv3U\|b/,^X `{a,⟸er/J޺z@v|X3Nonr uո 2ۚc;ӛbѦ^O|)`{5c8=3m{oe9'9cbqb,/,_XſXn{aw3N,z? dRyt;V+rLvB.ԲS&.Wƈd*}hRbҟͦ!n[Zy[i^zDj9wb5'W_<`YҟXm`IgwXܑ ۿ|Xv'wv,Kp];|<O9%SېL:cĢOI|D,rbhqv%u$0+;Qy)lOfnwe%;IJJqV,zaA61}x()AᷡZUňy)Inc-= NXVdу1vT=yt/צ%<\#GDYLӛrlm5n߶S*xK)ߧm!<sѬ,!%+d5 + xZ/򔪉t4 GXw|BjUy#̣KʼnM9rwa1puDƬ:`x` UQd}c)* Ll5_,徰 `b?X^X'6kNL~b`]R-Z!wHĂ})* \l5nT96䍷GP]/_J#-*r=ʷo桱wb s\`mgQJ,_vK#-*NZ\|qV HTtvO,K_/~܊e/ܿtոł;OX;@XFW,c|XP,k| ab_X+tjv2 J`Gҏb[*}>_,O?XbS ,c*1XT,k(5XR,g*3XT,?6gn 2w3=v_댯îizWc& [XbmSWicG'WC-mWa]҅aq58i;=129_AOgIS+vgIԫ5'_eRb9_[鳦=N& ˌ-|G1+,*98bzOcy4k5wӛrtIJmTFqQJfe8[H*gȣGC|7)YnKl5nv)TXJytYCo-QGFy4wӛrWg7YodX`l"=n[ Ҩ#h?7妕qu[|ˉg5j?1OT5Jϣ\ 98NI*0ҙGq)KXTK__,>̩X( fR,rSK ?e/02b'KV%rbrK #"uF.LG`⥷8ိ#kH0ҙG)K֮9v#Ċ# 5ǀnb IXN]X:2۝Xz|d=fՈ⥷^akq׺m'_S>jϮ{tXՍ{2ui\Y%a iV呑ܳl{Rb٥SwXbend*cVM0Rb97~ն4x"xZd1/bdwM,I,y ĈJɬ[Ͱ5~"@ ~wכrSq C|'0ߖLe< [Ͱ4k"F.ޔ߇`݅ fłݗmbł<͕rrXM,fn,2=`j,h|zSoOM,lk_]%S_0Rb{Ҭ#!M=ϚBK|'wnFd,J{Űēoed '1Ybq [ͱ rchvJ/z|l! ˉG9 -,g֥a&`w$GŗbSҷbK"hq`eTݭG2be ŲbYV.,k'ܑ' VT:[[o׸% <^#(zSn#ɻG|'k-O|T߽vJJqb[Hy3O)nG\w3&f[xTƬ`w=$=Y#YF)̺'n^r_Y21I)wɰ$12O7P-hq`狅Le`G2b[dQa"7倅Vr bYeMrbʣrbX[XrKL/FҢYzgpUGεd1q:$7P]n&`oۭuJ2uHRbYyvk_d1y>ЩwbݓպfL}b=`IJK"Ҫ#Sb\1zS<1j܅őֺ~Le|/F)x=uy(ۙ,fD,8C7f[[_;20>\0R{=f:O8ge;,=;ľպﱒwXQz{pѶS,&k9K ShI2m8)wU뽤]GYG[V`Y|U?.a. xYX+K %ы7妗p'[|Af[LeS]oKbeK:sdGIKoʭQz[[˫ kAߜFO#0ȣ.7JR:Yyđ}JK|/)ݘj܂`#nkk([J'+8OI4[|/)nf#lĬuƬ!S#V0RbfNVqdGgmKoʱ:V,=X_d`rc=P%=<ߍ_5K:Yyđ}J<+қr`NƤ]X,Z Y x.LcX/Tq*>Xguո 2ѝ#x-SSbt~e ےZe}@f5@Um2C>wb/y 2,1imRJ,#-5$9̣zS5Cncf߉%y:byG2 K昗qXo#ٞX;ꐜk5^yH.s7PyfNM,~%F,H'; ywWϖRuvyHvDrSP+WܿX}ab/,~ {aO܂%U]:yS3`oHĂ-wbwhֺw ٔJO+ɲ#Q R Z)4p$иV={G0jPN|{.ɲ#Q Z p(W-XJ9=AHS~ÖeGv7}C"ԦjeK֐W,)վX:e[XNbA5(yƤl_q<ʩ9#+IG>)w~ [Jrr!a d}M^KdPXGV9*ls-b99$SrX/W܂%96w$=fՉyF)aKIXN\؂{oe9wxގ]|'wyҸǓorK-%a91r;a \Nzپ.,J, cVM)wyϒ;GOV!%zuy7sޑgJbXXg-d<`QM9`a?}~{a,r_X `%{t'0[b-,}XV,rSY'C| v٣yܘ=عM)w_pȢƤ퓕oHO߉%٣y]E5 %[ίXLO߉%U$7ZRdq27,dT'֞uHh"mCsyidX')7FIJֺ !SC)]32lCobnm$}C"GΊdobyjzt?#O<6X'B)ҏxa|ˈid%㶊obA6kݿȰbnQ6$&6>oHIJWer J`YK˙Gy4R,rSXl)W|RL_+ݿX}bM e1J}aA~`/,b?X徰ab/,AZ'S+x)>ϿMmHM,`LKR" ]wf&?X|| ,w(;XP, + h`C>O܅ccb-CrJJ6$&4ٹe5v;rSZ+R\|jD|RJ,#aKU < )G\Zi ewt?w$Xq:)嗩~>d9'#|XwF7vپ2؅eD 5cX,,WXYl_q K?{by2͡6<圑sS.l=lg}-X#=u<)%+ngzIrNr<#|X Yl_qb_,뼰*u^X{a/,}aO܅倗\Ďdey )WU\l'Vȓn>YuZUguVG|'=enϬxCVGBJ,OcTcnmD:Mo1yĂэNz vRsK{f5}Cځ'W|ǚ=+k]ʼnP$YIg]Բ(FTFcpAn^h=NL|'Ngnt2'֗ӡNXWx$ ʣyI'+IߐH}EW܂Ld/thSJ,3BjYy#OFhĚ!}ۛ3.ھ?&'{ts'O5J^黤G1sidXRr5~?q ȷأ##HmPbtj6Գ#g퓕oHei`=92]J~>zVq乖 '+IߐqV.,3R-baVt$VgpԳ#-hD!%o䆙ob=92_?2zl<[Zgc gGh+}CJ~w}.,ுwˣO,mbaQaA ,+{vł} Kg JNt-Gị}XfW]|':أI;= z1~KVI=+8ҘG#<RbG\-wM,Fb=研V/-GịQ/|7P5rJJ@H[HrbM=T= QIwV.,`E3U;IX([Hr.-|| 9prbNC$˙X|)>K_,}*8X,~{#`*O`18&%b9+.ئ7O?[/FLJyJ:fbo,L%V-,徰',}}_/ҧb닥o2be.ł'&!͑I򱉞F{^znVRuvH>%{%ޔYnO܂%V7$S쫣~.2K-iM9S23V೚j?Xأ̥XV,}XR,ṣXV,{X]XuG7G&k/JS_QE[HnaGɺ#ޔC.`jNk3պOtb iM9S23zw{ {tlC4#*x_`VA鵃~wl٭cvh䣰:j=[Į=92'YIJKl!)<՛_ }y!Kd͑'+fEsJJl!)K_,5k͟96_slc5]XNtdI"W:spZIrbdME~{oa9{ޤ[:V7ހяqAXz!wpdlܬzZl{QꩳPTSq 8;"]Ŏ2cdE{;8#nYy9U,&"UΊk߉%SEڈĺ"{,_<;gnrYy+c5݋s'W|/2r_XXya?X徰,>q d[^)`x(%]l7<<.۞,桔Xn`+ł۶--2_2z4d#nw0ͳ##v$iK{b,^X/,b?X?q`B2ܭXb[R,X(K_,}+81M,ynud*okm~i l!<7xأ#OGO~<;xݗ"ߣʇ*}obw=9gDY1ܑxODCn-+02G]|&oB^qer0f D6̰'r4YytXK/ޤ[[N+9۝x+~}'VXp,gV3(zSng},h[ވLGqUt}2BYqr3!ޔVz[X?zos]E4C:AA%裤Α+a;bD,x笸`qˌ=9rT>6/4Ja"^RuvȊ>%d1Sr8eV.,={ts䐩tDӡK)3S9NIٝ#+l<-=['O},=9rTz<uoOܴ-]GYѧd3-ޔs/=₭]XػXF|[1+yOП`-]G5k$6<=G\ոK<+o$0+ڥXNO#+U|O嫚qV,=`n>'K)%+7pvU~)I>9J?+F>wb =9r_xOdPJ,'V BUytXՄ<uM|/嫰ϚbqkN'q#Rb߸[H*0Gwd%{)_})%`gcrnG;JNt7b[H*.2\؁E>9j0#o咿[ˣGMdYyGXEnX=%^cmRf7*:a TF6Mnp++ N,RZ72Xgk^+/t2#sjmܴO6";D68jZb8,czqwYj֐\fCvnU `qU`w$GKe62ewŲUM[|b/,^X `{a,⟸ I\ޑ|h`!sl-$a9/9uv~c~#K8v'\#ɴx; Hg7Ur',cϲ]Gқrqmlj/X r^X r_X`\+{G2V RJ,7:ҩ#S۝,楔XL{^}C"y'GX-Kl!ݪWx-[GgQvbbL/0[bXR,}XV,rSXTjĂ7{tsɮ.@ϣo<:qGo%ݪ<ȉ>%nM9T>Qqq"{tsĒD`d#7ҭ#ȣal~1C> {t2XbG̭Xr>e/}^X'nq2)S(=n8CiͪԑG77]|~70XV٣#Fl⩰G7jl`ak<#cxWmfշU\'wXbucnOb\J/ [@Va0V^񽋯~qE7`nXN/|O- Zr+` Q|s_;ļcnƉQJ,{`wYyd5#F.wU/Yi ļ jD֢Y,Ŝ-[5$9GzS|7kLj܂%-9lPwTC)[$,'FNTM9s A?#waz1f-GSze%[$[[D5.2,*k̃-IXNc{ٞ[XMj܅b++î"ÎcRzeXߞJ#7HVv&ޔ~`&7 O_YY j#"VydJ)ָ#ܸ#Y>zS{GYMl5҃q2ocVC)]zT9rOIe%;<[>ɷx.@6$[<\-$##/ze%;W!5V.,Xأ#'w.g߹uGkSoq [HVGѧXs~wHy;JZ--XYG7Gu'1q:t(%]zbϒ*Z{_VRCJ,'p{., ]O,+=5Jz=vu2Yyܥ퐏Rog|.,٣#Nz}_r%8[-$#|g;g?q`aXV,{<&V,YyTXbG_,O܂m'bVI);zm ە풏BCW7OO3׺"z0+s(iO@es<Rb٥ܻ#?~$r\ b/,`/,`5jݷL =n?yz'1S Ăh|g/&Kzgͱxb$ʣS.SYmCRy4{Hr~ UM&3kyu$Pytܑ?H]X1OUPY|w靬̵tvw4_;$r<`^\3aqlC莑 X?0+IiQBjٝ#}JѵRXυ~,gJne@?a )|'We%;?<[J=swJRGےXyѧ(!yH+}.,'٣#oՎK#Ou-Gi}J%5 ,O܂j'f0]:z=4!rRR#4<:c|Xm5n_Y>x0OFFdVreKeF3f%A)xQmߏ& }d`*w̱^4[–R#4F]S]zdߛ>:V9>bmއRb٩?+粒ZVayш|Xn3"X,v<%XfP"S?R#4g}-!Y-w,g~5˚_,k*3˙_,ȣŦbbS 7rW,)ݾXv{aqr h`XxS,M|;tkxT^k]2?`KeFX U p%b٭ߌ* \|Ǽ:y:`ѳ˔;/[_v6GVrt]l5nkNޯ Hz(W-GịnWw7Yl_q`݉OXV,wܭX|)_,̣am V ]>G7F&|fEkŽ_KYyđyt9+(}]hRYyđ<)_WWg>7=12G< <3{bBYyđ<gS|7־n~? ~LHHRAim|{Ue@ Vv]SVHVzGEbG^'d'D7p4mRh _"<$Y]^ !-/h;*FgUx^ouI4'4l%ySvlw,KW淊Ȓ,*IOog9}HA(8U̯1 "kL1؎w})|OXYN!qRNA(jGӫ_QG;}%e^`U0{[ĩYN! Gq؟h/^חO_J9})e͗O_t}ieӗQ^_F9}i|=<+™=WE' =&Pm壢$#&ӫ__˗˸|/˗y2._Ɨ/e>>|}jtOe8\aH2_l)yew!f-5$/l~/Yn"3( 5AyͣO[%.def#_/^>|a&r/x11c̗z|VIoQ(_8Un{} D 31oQz֣"l)e;y$d/.GǙJW`{y`U1ܟgIKr='[JN _g7ۨ|>bz W_?D{F _^Kg1-l'쯳mT>=?Ul~0 BާQh]oH2_"\vH:FxWd7Ym~b5K,/lN/K-/G(W_ s>F-ʳOrzohK)#!Iq4{ߎ㙯{7}ljt )_j)5>Yw]vHHRȷm+_]. }5lyyBghK)#!Iq`h;^\wnhE5KI/%tN/H/G(u؞v_"J5+It= [JN IG$v|UЉ{۳Kf&/QIȢjU&I'hK)#!< uN{m+_]~I|m0 q窈C]6ȖR3$Y8Fqۤ|6G*N׳_I{>ږ/2?TaIpIYzL=w&[JGH'dsف0_=}Fk,a&3IEmKrmӕJg{3E۳KG|u\Xc;"Itd9әmR>Jg9|Uu=E۳`./]LyZdwzTm<`0_ bctۤ|?zJf" Gt=1G%-rv+#iәjAoxL%2Nv\j5|=*zͣ]BO6)3g/_T}%ӗ__|E'ܗN_j<}ӗ~0JrbU1?4j oQ8G=ɶX~v/ԧ&dL=|-_,KB#g5J_UK^]:٦+<_,ڞv_su|I8;״*v5i$}ўF<ofʊ|Uz'Wo_/e^/_˸|/-\˗<}ijt }X$w1ѪKN _g7ۤ|T,,V]mKݘjt DiUгOrzWq-b'쯳mR>=?Ul~/h _4%wiheK#!Eq4ߎ|xr؞v_FuKdbu=*ɶjoGB{IGW1MbѶ֟Q "qwIWO=*ɶj禓GB}>gJy*m/;s1Ns%j)5S_Rt#!Eq4{_R3yv-_w>IgshzTm]D'|櫔ޯbѶ|a5s0ja:F<ywET Iջ&k=ΞJ:u[(~G kl0N;,̗+td9ϔcGצ>POD|" L8OqyGY͖ґ$Rp2,'M=E;3~J&+؎::ΫeS^]"UZ]:D ~)gf?>{Zh{?HD9v^ٽ+W7ZrrVl'7=_ӝE۳ 3}w%ٓl~0 ּkcJ2_v3݅):˙>|؞v_*|ȈQ:vI'yu}nf6GM'Ntۢ|wWGJRg_ҕ/+m3;ydޅvˑ/gҘL _ubQ${gQۜݶ(ŘW31?e~2._e^˗˼|_ӗ~I5iݓ}G hK//0~GۿTL5te*|)'I-F7B[p#"Uq4whx*+e>+g_C ET 3UR\tlݥ'EqGUYW omҕ}=2^& Dۦ7ݟ|߮87ӟ̭3۳ -k慫"TI](o[Rj~Tn[\lbKf^r/"vIWE=+HҖR3$Mܶ*œ5GoʇK|"d$>pʳcл56[JGln[KGωrgݗ;O5Vp Xc y$ɞwvmt}Bv۪|O **_cBA*̗mە+UCrz]|3m~/ ;R[y&I0zV-# vG,͑a{}J!3E4j; yQ/ɶkf'4 T9ڮgv׳_=}6/NU5jlgRn!Cr4j 6yfꇢm;GmQ\~/0I_j:}e͗mk#ӗN_|Upo2.XUc)Kɮ pɣ,n[[3_U]_tjt _Y "Iƨ.u?y4;6jdOF-d(ݱ:%ɗ\?-'4]Ox|NDfWS>I><}$s5N G-o:ngj4WC|}¼dw_s!hP\.ۡ(N Evt{h{}Fs](ɞ~m) ?y4Vq4ߢvfr}{,܎8> Ѻ^d$׳rm) ?yD+f_ |N $A<ږ/F_qD ZH'Fvi;$g3IluYSu}];|-_*#jL$|Eekť'UNt<;:IP>2 _'XRЪXO5 FR~dgfA;U<]|V;l~/YU_ck/Xc㞰zt5KϚ>۪!qw_ue,'+ІgKߐ(w;OdStd9k3[͑M=v_GW$2')#L۬N첍 q O0_۳߇/FLLd8fddgm)yew"q]+*!{Vއ}K5D|U=13bڙUgswVƁ|Tq+I2_۳KANH5D|B_*RޥzPE5<"eo'NE}QT͗Ψ3_qq<q2q2mE|QvE%6$E|s_H!z#IU]_y}R vHܟ꫷ b]O FL$bG7oGq)#"qE+*!ޅoW5 pUG'z_WeemUFV'uvٮۆdqku}Tu߇/KN/g>/"5IKu}UfR vȑvۆdt[OCx/]5$<*Go+i[u'#!qt mC/|Jo?oRK0 4ﺟWv~ v|M=E۳ Ū-$iy]Nu䌩ȌҶ+;njGDt=E۳])Yn!3[~|Z-$cf)ѧ/!HR4d'DSw~<_5c~R7B2fgPӨ,<< -[IN _g7ۀ||ףmґGQn!3; F}b5F?,+[IN \6 ŶxmٯmF-$cf EbGЏ̲䑐uv GM;Qw,38""h[(* g7ƽ.ۧ$҇?}n+)#!8 [QBp}8>/JV[Hݹk> m%%;y$N竆y{x 1zBMo'y4v*4VRGBp@< 0-V(Sb~$oEhD}@81/%ɗL?5ZJvDNȖv|հ\a~%h[$< wq"I K[I?+n;hmYig9 WݗaȟOd`]䝧HU]Vg9´fs䵡W`{[L?J|zjv'yl%ySHڿ==#QoE0_lGr<ɽH۩Oill(_kC~±+}Uq |(UҵjG)RBvڎҵW`{wQRH3gUHnYm<d;5bHZ~7}AyR0oYjy45"mK+-_gh{}T[H'U$.gju+#:%?tm/ڞv_ #lpW̙gDV>%5F[_ٶEѐN PvItm/ڞ/Q/Rl{ IzTܗmQ@'fK[U6m~/ F)+4uH}ǩXR:D>y$ۄ|TՙkYѽ_=]Q56`5RZ$_Zr=ψЖґ$/dvX+gh{}+TlӸafQu.yetwhKG:f䣪N[Dm~ԎN~_)jBsJ/s+%.dl3QU1JH/:C1o~_)j|᪈SzE4%>}lnjkHwX_=-_-TF Iz7z-%.dtl3Ql;{/$%m~/)FE=Fu<̷SjhEUJu}ӻ<~/|B<]J/~\< 9mF>j(stm)5;C"djXJiay$۝{=˩kS~-+}쮷\5NJ}V\K?]o;hm{Sצ> \Oݗ+t~[5*,>E v{-ڡ*)d`7۝{=˩kS~]~_)k;|Iz-%>`InlmWM{آg_+t,FzMR]_ӖWvgev|MEe>/ѢtƖBftI]ig~I#!Uf_VXU6v¿OmVE$_8S[_񶊶x0JkXJצ>ovH5t,댠,x5&Kj䑐uv-;tm/ڞ/|٬FkQ| iK#!f[v>JmW[ޟ~0{܋81 zGʻozo[{GBW̶|ڮ!dm~/U[Hw;WEw1=mv:y$dlj*](۞/~ZjV[H_VE$_8o[ߕٶ])<nWԳ_=$ 20Qh@^hv[D[_uJd[jZCWԳ_=d`#f"fI]L7"hK#! q4m+QlZJצP0g$W#I<%!OcvE|ZW!|(Y͗ƨlFMg&y4Y5z֑-n'4]gv|M=E۳w|S^4|5&%=%ۡ(@'4ѴG5 z3P5ybyK#vO-d`f+Ci4K^h2B|ZG'4\J=ڮ⵩}}IFXU\HR{v.u;y$djzצBOsPn!C3{%_@r|RvHNs%Gޯm˗Jw!}'gI%'Oݳ-#9s<=ZGצoҴ+!$Y'v{ڡ6gs7Nv#E۳ ߟB䛷]o}]5I]BJڙ}lM,!sf[bGk5gK׎C20"N<ݬ],B4$rVl (}d9ymvC#>v_e">OXC\)H2_!޶&YӐ}$lQS'<,_eн_R;E|LpUNG?|h&YewCͶ!Ŷ竆f"׶-_}w:$w>5*nsv|Tn=E׶-_Vjt 5U1$ҧy{ۚd _g7۶Qv|4_8W53?U1$2Qض&YewCv'4嫦\_7|k<ĖL/Ujt21 kWAzmmޢUg]hfRmCgh{}ᮖ5 WEԻ\S*{4N>j+*!coR7Tې݇V_TԻ\?W۶NGw;mC;Eq=E۳r|X'5UQ$e~h}nۡuЇuhzېK/l۳Նjt21͖VŜNGymCzg8f2_`;*zd+xB۩5Sl"q4lq@mC/j74ob;~~,9`fVhc&hi ~543s9`f<}I߅6_'oR\ߔ|kYQ Lklb *i_/O#IಥYNCveܣ,-8?/f~_)dg>j.bz m:rb/[նg9umS^v_%>?~[뭯9?{ R4o6.ͿGYN]zWK书W YQ V:)#VE*STWo-iX[{"=˩kKtc۞/+䀙߅V_'|t^fuG,bw}J4xې9s[u~e۞/MHRHy&G VR{(۩]fq6wem)= I=-_ЩW YQI@̢}/JKɖR쯳vE%6$ySKBX[ȊJ¾e*%wOm4/ٜφRij^oRdn!+*Y3UHjhz|\]Y.vWhvEX6$Nl}.u۞v_5$*eFٶe}ʩG쯳vE%6$ۉm{[ 쩧jt 3;k?Ai_7c'"l)mN6|ʲ]}!i&WKX[HiRfbl<*Bϊmֳyd 젙ZzW˧?5fs$w듶Zض2B1۴7j_'{fl~ӗVF!;+a_CQkQSQ¶tHH٦qVېƵAl۳˗ǿ?Z! ?_?GO9:]cv WO[2CrW?EvmޟHq@+v\7ˍW@bC+ҴǕ:]t[?̵z.oǕN|2܉@c@>+`@>sװvct1hi+}tH}j1u˄?bwڗ}k_+n bZi)T:7E)#sI~&s_q9?ޒR >3q/~ۿ>?_w? o~_ٿvP47nFDzom?w*5lǶ[pUac(=/}ʏ~Q4=~䳅h T_M@(=V/}k>[K70ڥ|gLhRh rcyI#E (~\\};E@Qz^Z}|M@S Eok~Jh ϧgM~to}>W?nx^T}N>W?o|]}͗G¥oe߀_?wfҏ~ϻ}q~c>.}J^ Eo Kۣ/җk5zAhҷ{=zI Ưw듢?>g@@}VDo K«@Qz9_}Q'?D@X;D0n㟝 hz)JWS(=oM`J)~I?(_Ag[@ >Wo}\T}>W?nx^R}MW?o|]}+Ma7(@OkR4h[},>GOk~VEd'h  g[4ƯL@HQz]ˆhzG?ʥO_M@Eո~>Kӫ~>.}j>k>#D EoX7Pѷp[xG˥яxG|֏G?5?;7D0Kg'o}\R}W< ~^V}J4~Q4y2B4_ǀy祟%Do j~>O^@ >Wo}\\}W?nx^Z}M`蹿 B/C_A4=.}hc//: ~_ Do˹"'0M?;j?0o|M*Eok~Rh pGxG?5??@r|~35~Q4ƯOdƭ~K?꣟V('?xc1yOҧdh pKx_DoK_ˣoҷǭKO QzG?5~'3D徳C4ﳲ o4Hҧs9qǣ/~h xk|h 4'r(=.}O~G=/̗hyc<)}h `Nr7eo @~s`?Nƭ~jhи͈1|Ic#hCtRlLdcfwцp#6BB/v(D*I10G)c!S)0.zl Eg ._Fer3Jy5ތa4HHO7/|ev3F{3ߌ/~ /?2tV$iLWlD*S1d]3 RtA60˨F14\.AD3"85syH6o/cjJ,i)])?1]! 1]4eJ6nFN_ gKY "݌^F7hFJx22r3fIXq3dc̭1D܊!H̵ Y !V%Hn7#Q4+l 5܌aheti2xCc~ @f3}1Ø7#k}#HӞ%]H6lW*#HCHeX<6dcxl [7dcf2fnސ2|Sc:dc,h=ecfИ*%HӘ Y "=݌a̗1**|2Èf2R)|1/#(f̭<&dc6]1t3ZbhLw\4|mHטe.+hC>ɈAEםl ES60.zl kc\|]>W_Wa2>])? ޵Oe2Z11xwdhLwUDcڢd1Li뒍]ecјdc:㛽޻#IWC1*}J6\oF/Qc>2joF/?2t$k;25;R*1EQ!.S6nFL_0Hf2tvR4 dc '"hCxG Her3zyî$K6cp/DE.NY !S!@>]NP6OehL;R(eTʩd a4+뒽n#=݌a̗1e|3fSS~uDbnF _**JJxīxeT\iv^k|ev3z{C3Wd1LΘxmјH)*/H)A$jLDc1H7#՗5-JCƴ%R(e|3j~-܌ӕSl ]WQD2&ūҋdcxy!*=/c<2fn!ןw$iVx̭hx zGfn!WwQ˨fИ.@Z1]ڊף? 24+Q&#Sc2ū|f$wIA͈e]{l "* h*ecAWUTw(Her3byI3k xe{GrnFI_ !@t)^ޑ1׸wkLkl "ux{Gƴ625-HCxfT/at3bbhLwTmݵ]~9݌UUsu۱WwC3/H̭,T \[(wdj{% 鎭#Qc-HҘ+;F܌R^F7/xe4:Y "=݌a̗1LJl "a̛B0b1[93;]dc.:rĔAd$vї01|E=e1`ƅ1`}/?~3wգ!HԘk.@4+@RnFN_ ]e床w*TRT]%U 2|M3dcf2f.u FS3#Z/Dס(Y !a͈et3RbhLWx}Gr1-QDj5|1/NEƴt2eLʐl "aQU}m(HL7#/fnŚի;4sMZd\hV2b*)ߌ_F7#/fn?#E37^}ߑ;s 1$H7՗5cJ6{}GF1=O% ~MM C.Cp P6!Fl E`1p]sBY1z3j}ͮR$]J6cۼ#P/y}GA?~3T}?ʔ$ƛC3ͫ;4ټ#Ycdcј}fz6H՘(@ƴ$ F]cZdcR$xez3fIw]К11^F4H鋡[{f2ܐl fnJ6L4\mkDcڊdco^}ߑ1QB4D@BT}F7#旑HF܌\^F7/xe]ў4Jl ݮ2$ȰAD3^}ߑ[%?[YD3vͫ;]t׫;])!Ɣl E._|ep]pzͫ;]).Fl ScwDvѧ24+@]eJ6oF_ ]e?#ތ\_FgW?0˨f2Z-U1hVM)x}Gƴ 1-U1uyј7ͫ;4f2t!!?2joF_ Jl ݮ$Ȉ7c/xeL4/D]b̭oD6HH;5sDcͫ;R(eTl1K%q+z)T|[2;A AW6k͌Lf'yɬGH$a}X"pE۩fjtE#ډLuv :;;y (M 8ŏةobW8{4rΦ&z 4rI;g71M&f|"ƛP~A"fpj둾8&NVM'pJ~%"M&jVD+7џ7џBGWk{3t#}?|"M,\N|;Cj'hvzpFn_N#G#[NQM}:#éNa<3D4i'ఋ>E @NЙ"pE"E&H0' j'ఋ :~)GZqD~8U#Wt4r{w>"}?&z E̛H35r5I;AG5Y 8߄_"&A{^NVMYt|#g^ļ3YNiMAzpjit.bobXޤ؎_&4rۈpR}D<|EЩ޿H?t6i'4t:"}?P#jNAM6"}?vKvѧ)K;.zbE.zbED4i'd%?"e_m8:Fp?fA(N~vF>"&FLFfHgK;5G5gLFTS=#}?s*#)͍8"MTմ?"4t_]vμy]5gL3TޥGN~)Fn<"QU 8I#N3&#G#gkS4rsI;7Q"iD~8͑hOY,7T:/ #Z)Dg5rpFOi'hvfpFNȭ*u&EׂO.+H.ob\ĸ t/"_\ߌÙ1o]K_藾u&j~vNUMm1k؞&i:NQU \iN$-+i3YMAhZvb;J߯{H'i[.bDo"(z"}?7=G5IZ,+i3G5u3ڛ&jj3Έ.:tMi'pֶAQKѥ(C 8܏9p?f :+H]ob(MZvxeF~8C5mEYnb}JT}rFW :"M$zH'7{ENQMm「v!g^ļ&DFn߷4#}?ǚcͮH17"}?ښtW.owѤYwFB;QttE:Jq-cv;tE̛~ w5Hߗ}D^S;AggnV.o]hܑ"}?ڷ4G5mC 8U5폴:M5wH?մwi'tt_#_PM#-Bκuo]EoS3E/|Gt U 8ɏҥ(S ::ʾ"}?pۊp;MLK 8-Zvѧ%I;]/bJTޤE1ބ6I>"}pE̛Ȫ>"}?&tvitj_B;7Mtt!GG=^3t}rE~8ӏc#tj#~__&E̛@toV"_`EpE7"}?t*g\ĸ^D71қPM&fs"䨦+Ivnvp0k#4D8"M`?Xuj'?ʒvc/}ZǚSQ;]tEș$"蠋nv pE#ޝ :ŪSp]t`)j'}S;]tE$rA]K_fTNЙ"pE7gZt/} 8]5YZ%itfu"QKĸqI#7:Y#7tE̛(Z&u&jpEoG.}N"pE7Zt/}}wr ftQ;]Kĺu:J8JQkrtE~ Ni֤ӟ7џB#gx34r}J3ӛ郘1oba]vj::o"7MnvD8DJ"蠋Ft?:袛eDR3E$i'ࠋFt?:O}:JNMvˏҥD i'fQ=I-Nȭ!-BFnMi'ࠋnv;[^"gXNA.mr",I 8[᠋Ƌ EAfH?qMtvx:I5]q.pT2ۛ&Jz%}:}#}?:i9#}pEEMry 4r}H;gi;rfH?y&jjH]tG.bh9 8J+:\j' ŵ:;>s#hwEWjr.$-QڒvbHߗfWEI9ۯFhlpEF#}?v3p.z`n"pEtoy-g^ļ vѧvYκuK5Eډ,u];y T^Eɪ'+hw29:(NMzM#g"}p4rK;7Mp?6Y$lpEOCO')}'jrE`mק.ھJNЙ"pEۗZfQMktZD/o"䨦djtp+G $7@"QK_cV3E,i'p?MeMY$ᰋ5.UӱEQMgAg71MLtvi'̋7.ˠ6B!gȏ:2 j'ࠋ/p-f}>itbH({%H8"M`?6Jj`?71ELi'ࠋޯ"蠋v :DO"Q~.-NA-B :"Mt)é|EQM&ZGZ> Aqe 8} EQlpҪs3֛HnS;AgUZ^"ENЙ$ktEY+A7H*-譛pEwN^"pE1(}I`jr!ΩyNVMے!G5yNQMmh1kSuݧH?ew)i:ZN~ /cx 9CDv^1.-Bμ&+͑藾%I;]t4D~8E5YS7Qb\ĸN"tt6i'訦J.-4wEq.p),-w{T ::}#}?H1vc!#ױOpE5A;H?I:H]K_莳a)ghEAzjtE.4i(}w6"}pT}!E~8I5wH]~B$Q\.#"p9hrt^5B8~!"}pZ&zHF.+%A3H*-w#Zt/}>?"}?tу].z<"}p.t˨."蠋Bjr!t8-A71/bfx>AJG89SĒvNjo"~ob^E~lأd"蠋Ct;IgLpEkEA=pMÙ${]GA.zXVt ^(}XH-h8Sp]KQ.zZ=:袇=B-Bj ~l6ZK-B2Ha AaEz]pE%-\9ʑ5G M 8V᠋vZI¾aSp]z#}p}U0G~8I-聳"蠋6]S3Dti'ࠋaIZ9ݩ8AAiS :؏̈́Ù$kt6G~8؏MSc#7-;'G͑iB-iG"䠦v5wEO{H 8'|ˑ8SĒvb;JߟH]vD,Z[pEϊ߼zդEA=f] yHY{htH?Ag(cJl_#}p0rH1E#ZD8"}?t;gH./]4eA3Hs.zC+"蠋#}p%t^xO t/}D_"蠋^A6"twy-^IJ "A> gp[8#}?ǖ- $ZAeAtlH]*E~8袗E Rg5A*.:t wzH]# (}SpEXj'LF~8H] 5K Az]t8袗QLkcxZ85w['9D"~>zOw[^OguǺ芛ߩADi'X]Ǻ#-uOg(CZvY8#h985؏LuчPS~榺Y"Y0K]~PH&-꾰AcfqO?ۏ}uHF.?E<}pl?Vsҿ~p9_>9, ܱ.z֥Eб.;|O?~IuѵY@ 58×:ٝC?y~?pQq插nom';RA-p'뾵*m[۪*v#UvkSEǏRg5#lj<=b;١yon*}-Veަ m6@hC|XϞ34=+>|ݷn 9ŝky}xO ,C3uGeY "=5,o~AmW 9(ݹmkwa{K3-Ow)̄eMW&x{oL=_t@BLvٴnVi[ϟ} {Ɏm&l;J,_{0`.c쒆{5zwA6{mu]̅X0Wꋧm, X'+>o{G3~om+hQϸRph~SC.lmj>[CO[ z{ǡCi ͚ڢm ǡ-v't!-E;4w-C78n&:e8mnBw{K͡%58#y~R?*TZޫнi=*Hnq=֣+ף}=ףb=uC_QÙ._Z֣QQ!ף{[}=(}=]hq>zķz4q'[G]ף߇Jףg|c=jZhIO<˝k=*#zY?GOc=zQhz@Rc=YXkGQZ{G#X2OQѿzTs=܏h=jz\:7ZzX|}z\XhXq8֣G #\z{=X2]|=x>ףk=ʋף'M|=]}GhzGoWGOzqף> 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 119 0 obj << /Length 4727 /Filter /FlateDecode >> stream x<َHr Wa[\&om62KR-բ5_83TJU=+"22n*Z]W"߯o.ˮڤȒ2jR.]\onf]p=k3+5iOorqW+yFr]\;vp݇J?{/̹-KF?œ 5\$X5ued'j,o7P?g[ nm%;Z :38 F5PWc2ݚ JA.\i1پo~0V̫x`"wV$Sr ara~zO"wI0J]\/,#r5 Atܨ=jE{G=[xaqWH76#?(Zpֶ,zk 9w9D8 WVRn [H[+A _5*zKzL7amϧ 7cwP ũM8x" TR &]D_vꂖ>u,﹫R;vڸKԆCS(CaX5 s6'Q>#3wԣ冞[櫟'ƫ6xeNއ.4J)=md^3s׏zM9P|y8~k+ގ1QIL姇''xs/+j߭vزoڮFIk}C+h]6a"'%U^/~Ξ1Q$_HéBTZz#s7Ly3 u<&#'-uVD&XJ\+tpQ=?XӴ؜}+p<}8F<{>7?;?r3I.!A?{[W{iEVVe9|=C8=;Z ۄe4Sd\t¬j'idXrl Nw,.E@>9a;QS:i&׃f^+a J1 C/'N&4 **8c*AۨYyKt^=E\Tv^0IÂKpfy%iI;\`sJU#YDG74fn| b½vR ǿ :R4E^tJ\`5DS/D˿{L pR& #??yT8_1|=?ė/D~Tzn,uO =^JIRgDzdu[ɉR):!}B5#vͤgXxOcBC4$UԹ#\')]z4%o{g,0 z&4Ci4bq:m5[eQLz$cy |A,3LlڄRh]1ru!{QqȫPoL]RSnU6xyc 6͏Ʒx]p)nz@mKU$r4JLLY~KdCLoW .܃݉qKSx)Gk_=.yRVi}M.3|Ej >v{p!LCY;tRbŐl.78N/4u˿phoō䑊LIG"} gs4,_RHh5iј\a0-4%LxmL*a6#+Mj?ksu\!pέgq& 4f-!Fu9$rn*^ڔ+ٹjUy ͯBF}}t$xu"BP@:f|>Y%jNF¡&Z:i$3mLf0S*.%3x@QjAb8Gd@GsϼBN7HCI;-g񪅢NʠԩKyڃIǃ,qN?|ʜT>9hʪ=Rxj/@:S$rY>蓺+/$g.MS.X*JY}1xܸy@M7.@:MeY;9@6x7MG\ %Oh'"07*FY{)eg糢,Ս9ӒU1JOI^d~GeMOh8o.LjG;~AdE\p\O#(KRJpo0Hz]@ͲX:'3-YxUeؕ7f*3*KZ=ABZDJ@ ihBwxz\VKJwP~3L7٨ϛ/| endstream endobj 122 0 obj << /Length 3359 /Filter /FlateDecode >> stream xZYs~_UYb\Nx]7DOń$: Hڵnd,},;jLzΖgoʫz$MzɃwݳϿZ9ɤ_\>{ժ.L19r3˭S =o}X8SͿG7\],L _WnpF2L;~-b[\~su+8dcs8&vܤ>o,st8//_̥,2 ьeI{ htG~֪d"OÃ2yP]  9m6]+sv;pMnO| s`fyG43WQMq tr0XeNu *Mw7q mohpuwƈpl au DШ" ];(t_b6},O# rXa7(:ٯ[G1P+ 鮓ŧȀѵ*Au44tGqeB/~`p#d> ,MӜN|O2C%S*Vo[WØ/+x抚(h"&];0y>' qQN03XwlnI42k03BY6+7DnD*C=_Dԍ9 RuvXsR]1lhmz:@+Ӫ*`Ū _M^(WtnӦvh;%x3}`W'V%Y|o# qd/'d3`qEzYQؼ%Zi<rh_hјvb:W=?&g ^0kv^H3zMZ9 $%Rmn v\NlY{~rGrGAtJM%dT sbt ~&~~%4">xwIBs* sKe`iڈ f?2)TU'Sj73ZT3G.ﳑ%`zaė"􏨛Z '} Ј -! Ǘ ! GWb G4PhUv>nXfohP!bIplH?DDxa^ <^Sm PMѨ@Y>C7[H n"djv١_Mi,nCk9+ eX|[2pY7`p~W7#0I #au9.#F0}, CfɓY5c.`֖r.ݠWuNޭcu F`qY`PLXA l*|HCI)ڤ0 OBU'(LtR!3PUf8;%zZA =uHB3H:yQtKx \!~a,# фNI0KI'Uړ~,B:rș=.O>;x<A0klȇU(~.GfCa&+a7p? ot穴#~;jk[^[ӳz+ >L~Cy ɲV-jQY?L<֩^@ UvIB]v0v\*쟂Ad'?ںa߈`!g8ӢSHɳ}x8zMׄ&@DloD= 'x'=>тWM3 $awxhvPt CTzzfEhVXi$-1\RǐF5oGaNc]zEDH%!M+0*+j2T/xKh&y29 ESNgJcj4U5`]㋭s/}ͱo 4R/J-0Xx8+ⲝܶS,WUmhh9@29j&LV6zsc\HhIV z~`$#[@H5!>P#dR *iUY'&,P& ~o|qmnvht.uu9I %(i15EtUZ£'C'[+y\oq,'T'|t˚ y#z(:?qDPMŹ1 B"Y+|W|Rr#֢e(%08ym7Ƽ䌠EWV%KsQvmZMz-y6TIiC2X0QKIOG cc\lNpeQ ;4#ެHyJw& /`DY&{p$qD}qM>ě~~ӭ3Jӛ\bLHcfOgh:1&J{f-؅LY]|DpUE}&2{|}GQyRqp\W)JcsM?VrxkԒ1GM>CH`YijgScǁ{[8_\xЌt/T H ?ǯ*_A.: endstream endobj 116 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-danishqmeplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 124 0 R /BBox [0 0 288 288] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 125 0 R/F3 126 0 R>> /ExtGState << >>/ColorSpace << /sRGB 127 0 R >>>> /Length 124072 /Filter /FlateDecode >> stream xlu;GE˅1HIc]3?J-Ƴ(Joǿ?Կ_c*fU*ft_~O?ʟ_W_*%ϚGdFa߾j}Ws/CY; I|/be'bIK:N,&bIK"֋!} ⽃׾OLju*A\w}}Fr]23qN,3%tDIJ n&I|q7qA#XG:F\M\g}_y=ĭĭq4#>D>#t -G>#tCMKĿE\k7z{ Yx֛x&C,X>ĚzX>?r=CnⱃI7H~cCJm=m%0{纉 ⾂׾ 9xx + /x=m 3ǼGn+yx$&wֺxcF1R<ij0 $j}樃G~>}|#CijZbi7 ^-WW bA,&n:r}F, zFX6ƹ Q~{$7ǣuA3Ct~#;m#n$XobDXb bD̉5CT }r?cr"6f}?*A3~>]L76a}`v3ybnϘ>?kFsm~Tgt gg q{FNL>DB?(dX`HhCu"{$78mǞj:?*wFܭ qxx ;ǾⵂxxIb7 ^rw#!9uH\@?= ^gǷe:흶Ce'a"qK5xx 2nbS-Wg;ψe^|A<두`d8:>w#!:h{F|Hodp{mPI3b0ݻbx}om#AGnxL[.eĈZ58N#!Xv"}F 9˞lx'Fb:?*wF q=#>#luˎwg@צcmQTzKvn8 {F|F摐v"wybu,/mZ33ʶm:흶1Ӱ7e 8cN|~Ex79qݻ @:h{F|~EN${7tW03jݝ'r¶ G=3.ө߯gYt_#&XN|F_9Y=uvI1m:R;F< +5]:nbAGq#^ۮc:nbA\Gq:/7L<Ϙn҃XM,N9f/qAMquzZXMxmzĽq7qA\YY\>a>}1^ۮcĭĭ(AMw lx0D3Y׶gZ#!dN״<3B:HqΧ#oS19eMO!-fNj:od-Y3:!u#obs@MxM\Ljuĺ ̸ĈZ;6 F>2obq췘D<8qAl҈1#nobm@|Ĉu =-3nĽ1.nbm>+75q# ģyK#ƌN{{y5q-715q#&5g bˌ,A8XobmHXb FV1f$Dq\|716 F>mmH~cXx ̸\|N1tɋy_B>!n_/w>9췚=;=V`Sn[:guCM 715u#^&^3eeƍXF#a"&Fxx F[E,3:!z#obs@MxM]LjLg|4gψg'>y1oSϯ :&ϿONVz1vPg3Wum0wM %C,AAMX<Ē⻈V19 }Snj mq71fu_z$12H|#5ua\(e:c8Ocz# ӽ'om~+|odG$(}EA{nȓ3؆̸-Y3:/;t{!o7|N[l>(c:ˌC'&״7<38f q{Fgu602ya>mb}jI 'g.7[.51Lq#x_:<N$ysH1C8c:^8> }`f3b>ݻ o9]&q֧Ow+@v2poOI|Z716 F>c_:Flq#^;eXV#a{u~ی+mj}z~A{nȓ3q˫-YY:!~#obs@MzK bˌ ә_gY3bq+1f+F 8߄}~cmx&(g꾂لf: q|O #o3)lxn󝄎-3y :^8> }`Xv#}`l۶D| Hj}oLޞQYEMg}խ I|A|ꑐ`,;:D.kVoѧ_v:hoόC^'&<Mό8N`}6l׆~Дrӳ:ho@^ߘq7=3BgĘaz$5>_>z"oo) }{ޞNL&ܯ1^9a1Ӱ7g' ?ĵ㟸93Os=W<Bɋ$ >iV'>>`b};7FO;NnNΤvU]://6O$$OB+׃s:ho@^v#+:hoόC>{b{eb I|A`9Wp CsZ~ ꠽=y(Mό*2s5]2obAf2XM,t%\g&F˺b7 =SZk b71 &~:"oF,-d )ce}b2#n-[[ /XXK\O>' &9>ĽO^]'zWIĚ! &n%k"ևX!n&nGˉ'3FA &+{}}qxW{ǸG68N oq5nØ_(fw;_Ϸ@A[<3,6{h>Pq91g#+X:Uٶ\OsB:hz tdq_xl~:!! F>ijij$b ]nb`A%Ę7I|/{'bIK!D,XbIz=IJobm@|׾bYA,& \1{h'qs뼉uA#^1b7 3c8N⻈Oُ FXM,FI/# g n#۸1#nnbm@|Ĉu -c8{Z3;n5hjˊQaψO3XP  q-1 32 o~T36a}$9u:/LxYsnl}GUmm#wuΘ,(-mofuW _yzζe)1ن=;=Ǧ7=IA'ﮓd{ ?*s@k 6pa m6i}`q=;,~7Q!S7FO1!vPg'uds_8V7c8V&Nsq۽ȀQM+]l4l( gklF "Fػ<^ ̌;T# oD,Qω:%֛yk"ևXzcKbMkk;HhߊM;UelƠQڰgȔ uD/ qy0aψϯwM;o ><Ęx &ƌxN{{12m/Z ff܉{ Y8\'=ģ<瀸DA*63$ ӽ<6_TԘ7BB+t.v2uD-{cۈ$ >ty$4Eަꫠmă.ְv8d9+N>6e}Ѣfػ19 &#w=nb`A#Se}FKY.d"^-X+v"V:!z# ]xכx Zob`A\k wXC,X>Ě%k"&b}5Ͱw&,  bX8}XI wX/eB"FVMlj뺉⾂8U[gĈf#:Ms0 ~⸳cmQigLj(`969Mc(Vػ{QĨobkt =Sm}F8n=#ƌӽ:#v%mxQޅ1Ǩ֮[r mb}`(Vػgy5Yi}#^kijij.A@zN^b$bMkOIzcŁĚ! ^s}2%#}n?*e}&tktخ\NLpM9 q{qVAQ#V/ >qW _qb*F)" 6ʍ೪sr}?Yi}}q71x w f='I|A|"ᑐlؙ S?oʻ0~s|"ۋ 65sr'RNTڍʺLʶ txTN1Ӱwvv!f]&e"-W nb v$>cUMnN ma{Xf2nPR6ri}`輕=#>s yZsQIF<)Töf@ۋ Yɫ$ >j6A|i>/ɔϳ/ktYw#k-Y$>'nq#n6/};׉\)yxMLm̀rb24 /m#s-wnFyvA.[=,3NAv%5zNt2Cl5@v}#^qb ⵃ8n3195|A|fӽ[;6m";}nC2-i[* S;>0tJž#&N|~ET/ormBy9;t (oNlC.obm@|gg݂x3Xkpb̈dXMK ^5#bkb:N,&f:‹;95|N1tOo>B>;Rt9eu{=Ug盭 usgfSqrf$uQmm̀r t m#̠#aψOd^ܻue؇}bU6Mye)`A^O8mczػ뼉 y#^Sq:o⺂ @zNt23h"ou3ݶY 2g|?]k8n=#>bHhXyof>۽d>;)! (/&N966i}`F#*s_}n+!_8lGfTᮋaحTaψ1GHhbl=L<9ߚѶ)26HX Fmلr9:tw[p"tJGLiqʃ3XPnSQVx+U3b0=Z;8cs`;26ɶ˷`.|Nv1a}ϙm#V<NP7VS;fͧ1 q;1f 3@f+9mFy}Gao3|n]96a}ssq;]nbA[ZXM w ƌxN滈lrb bs@'S@,%k7(5[ ̀9v33)I79sG<t^v2P*e}.C\M Xw̌qq{Z@EMۢ~V$L>Nfu+GZn'}ۀu&qA{qsqfbs2~#obs@'S@zģ\qЃ8*܁dx֛gAL ) FMljgqĻqT1n|*1h8NxDAMC,%Se}FMv"D,ډXbMĒ!D_cr+[:_*d Z7L<9*a Ym:!y?Q q2Ĉ׺8̛o3b}F8nXM,7QGq2{ qc :8*܁L']k6AxQ q2ČLKċ@ZG;\6zk 8bA\KzcĽqT1t2ˉGB,V*_N|06ʋ֙wo3XIػĸ}ೢ''h:}2^Mb !A@,N ucv*Ώ u)xkt (/t{65 q=#>n*UFeۈGe:lo߭yqar{3U|Yn1Ċ٧GBz87u*۶U(sw5t (/, ÇL'UV,}@u{M'SPQ-a{nVgv{3U/vD {lrb b˄ExmrqTsN{&$DD71W@Xb b)Cl5gAuо-qbb l';ۭY춨87@L /8*I> 2o {gBYyĬؾ-q229>QĬd:/1NQ*ӪrM&F<(j#Mnț+JdYfH\1V#ڍO- pLjvn~ͣ|p,j\hm-[ʫdZ4[]Kրƞ%c1/_hYВ兖;A Z<ВB|ǾJm'ظ@m&/h\;q5@[&fG@HS3FM͡缡q{74;NF|׸yyGؾ@1m&/h_ NF|w1Kr*FM͡wqZ -qX Z'Vry\<.Oph'͙r5g^!!3btNHS0nٞ 5œ7,mհwA뾡u%hx%+u?ut74vWɈzE#qn&jϑ:Zz eelQ?`m,g: WbHq~:v]Ǎ~#:N|[1ʕ]!]msol=Ry!^^6;NքK`zcg YoY' kػGy5ac͎qحdSFqث*7Jc Ŗ{-[^lI#y!&lI`'1|~J}'\==S.{{=fŽ-3ak8 l[f`uA>u'9p'qd`iD0 E9 =>Avsu\3q;<Lgػ>؈=bab]k`zcHT5 'F >q Q`|dAqBhfR% j}5}a+rcq"sx"xor`T5 N!K;uVkX)nF=<гj*܀\\ G5ӹ0_66YjB&o͛ 3ȣ n փ?3E~X`{8(R\PSt5 S t. 6|y0*rؼ'#_{Sτ@5PSa6r \AЪᗆEy FNg_h] kR t. W.gpz aF6vl(H&>{59ȫC$T/&zok5؃sz< dF34v{W 2Q|8×iu=p eF6FP cșL;B@3*"c|.`pcFp'B6(r&d_x>rǪ$U5xo3 WEۘrw36Gl(qJ&B;&{e(g_`ήDll(J&y IOԘ&fsom7Ԍm싲ƒ+e=D)*e&v[pvٮWxqLJV ^_M.B(ߋ$RU|8 v=xY8kX- ;k݋c .Dj /_a*?xV#.Vߜ(?K[ϗC]τg!r>nOX-Plh*˝>u6/&f ~==<9ao,V$.E1f|}57cfnׄ࣢Yjp#}Ns?,z 8, |.]͜Ԙ.4??,4dՒ .FSlJJ|c4ƴQ cmBxL+%AiJwX[%3 h]i;N7*|8(AT9]τ'+Y\Ւ=0jELMY1->p%NtSCR!:z&eqjX&3 ׻X_|,5)W vLTGg_Ca*O`qX:t{ 8YUz;>\*qL xoCr,}qw%$}dn3>h\uZSyC4.2dsle\._]44ZSCT8ZP]bu$;Ά_+]NN2rJ'I<dJQ i^a;Rd ]y`xTߥ{A)G', z:hw>gHVq"v7oJir2%(tߕzjuwϬ4׻Xos"!V 9=<dJ5Sƺ{<|F{l+m/Gȉq7>f̙*r._ˋ i1#Ȕs|-֜/ ?UN{|}3|kǚՌmqׄWz/)0#9F|>L =_vO5$|Y_:>cJXz%fxp#W\b}x;&d SBxLc$">ϖ?%~~ g7GOݥ Y_QQ~ Մ?-ᯚ:|ݬ9ֻ "9vojbGa>\ąRQ@.O%u{mZ6cYܜdj5?Uv#J6!_N3~do< *fgS/vL}Vum8j5{`4'hGz#F|$LjzV2zGIzk#[0=d@7{wz;떃 >k3V '4p_ׄGyGm%WMR~T$|yQ%ˋ/ |y5KƗ_2ެ/>*ek 7 s|[p- _wGz/GTⳆm3z_F·ԙrk ׻X_|i#kO:| 'k.y5>,J|TK#~Έ/b3~k ?!~qGz85;N}ք_-'wX'lFj\Ϝ<]b}xQGX%~# ƃf—&QRnɸl‘ WV7yow:Af(u+z+'8cq,M n'w7PoYng9׻Xᑇl f:qßqz>X<13s51IRw g7\z'dУ/,.Օ*tnF~jE[օ%B|֐n|3]ʺ7Oփtwu>JK|?Β_gZt7>ggMO׻Xo&*eUowz-)mf@os&{;vCBgyn-xb^f}y^R-K8KF>*[{O%I| Je`:{/c+z?8(ĝ.|yWy[-q ><'\UW+0^{w`ЊQ?9z[@|[,H^ ,,ds_|I{'Tzo5">{VX~lv{o7V dmR {-c&g2m0ɱLHABXCUZU0{pKVHqv` VXm&XzoGY]ZUS0o,r_fs'7>+>R`Gr>25_냯-ךLqb^f6$|MH_ʃ/%kJzⷒ;>r=2?%KƗ_ z//f|KכůG H_;cBꍏY=Nz59bR29vޥ lTzJ*mԖSeb ɪ#j8;9R`ɱo_mZUB ft _x¥  |#Zط$!;l}1,=%W+gl7ϑ>$^~~ s|R@M>&n!)/cm`{ϡӃP&>FBlh%0ɪ3Tq9 &ker2}C>5o(u _xs$7^>R`Grs=_zo+wו(Qo^fu| p@$0!%.;cV_P;fv.*}0Y5|LC9ڕ{ c}`{( 䄑[-O~d+8'yK /H]'G@zoՓU/j&7~-/&|- _˃%k· ǯ5({I?gJP炫v#96 w;lB 1&Aәw "WB/m?HoK|:~[ V2_ ?JWe7 1וL}=P~%>r+2?ƃ#~~ o+?f_#GQ #F|$Lj{Ÿ-cVo=GR[ _G HAf =__-KMQkG_>cğ%k$DJ|- כ51XnVl<շZ ?vJS{zExD2?WjȣI8NDiH} ?@$Ǿo/;,B 1xPzLV!6"l^fu鶇lcV-}AݻYM5gۨQ(u_w y/hYo<#UEj'g7z_~+~ }Iʼ_|%1|ko%k_~/7ksg= Q:vw zްPy]L(r0FƁz59mգ,ɷY;]Z,. @o`xؾĮ'gɈ?k%&|80C/R^|M{G8KFU2&|)T+ń^Ǘz_|7|K—׌/_^|z:pS8.^BZgpZ W2Q;TnYU<{`Ϻẅ́_Bߥ \m&z51Tw 9صL0 Tw+ 1(R2dᮛl ߶wHg'#Msl.G{I@߂ŅgXG{̰/ꡳyˬGUڬ*=,K"]5g;`BB >Hݶ1Zr潤˔Jj%,ǗeI_ֽ&~aNjN>HݶeIX-ORƮU*ɪs5{`{(=|PyV=ĚyY_|V |>މ 7j _j—KwJw,bBƯV3/2k#yêx,ǹ} H@B\3,{$a5.gVz+j?AUt[o;࿡7l¬8-{gj;gOEJ:^)7kcgU<{0XDD;&S(U>|x-U>52_׃Ϛ ,,u%:~]~ ׃\A a HW5vBüh.ą>â6]e|%Nlˬ/~>R`Gr?'~>fğ="{59ط.a~iZ>8|ӫho⽤iYgy5#9F^^2&Y|m,* ?zӾ[U<{0;&c.MDw1 qF'rZ4{jb.w)o7cg?<djQ辒znZS:4gOV #@ X&ށ`z& )C\7ę Ézŗ#F|$LjƃFZ wRjKEJx˼Y_|mքw{dj9_{¯-Ǚ ז߬?wd ۍXk&z[މУ0,tWjKEJ[v>!1R` V$]m"의 AB3mWc n%Mɪssplݾyp29֖ ?w]~:g L-)m{gfuѦy69Pic_}9qS(>|p6E:t~⽞dmfuAwǹ8R&|vCBd|9' -)i:ϕ>OCűDr|{w/ӣA?ag@WX὞df | ¯)ka19w;W> ϒA笞;T;%+XY_U^|MH V2Մ/%GRf |}3|k_Ǭ5닯 G HW·;GRf z#>c__+L|9S1e߬/)0#9F==o+3בH)Q3o^fo#_z._Öz"oٔq>H1k}&P~m ׄEJ߳f |--';Qfrݾ;ɛAf iP lj,@|p^YM >٠f;͡=ErOm_r2{Q!-p՞rV$veC =}A;K gZ`j߇P3o^f |Nq+]l_r2{Q!ga"\Êf/Qq2{9j _Z"ǁzNJgMq&]>fךH)"C/__|׌/_|)_3~dy"A% ?ΒI—E^|uaxW$ve_׃G;Y2#| EJ;2ksS1a&S _wb pchbIՑ⽤ ?wJ|dC6X{ y37}!_uL0 ?%Y5|οq ": rΒO#q2#:RRFiXˬ=dSb`Qnwly!X]}`h/7̰@z5KpǩJq L x!X\X!& 0TZuiK&ϣ!rE#9{wvH:KƗC9CBG{m( ~!a dž&,Js&|,P~)%>V$42닿ƃ$ ,,ds5|h$(RJ|ˬ4klQ8ss2gQX!&Hau"[4&@`v:Ǯd;z~>Xf|}5rVJ8!O8KF\ _ /7닿փf+Y2⏕Lk=8K|Y ?ˬ_x|`8!h:KvB3-hX}8QC/|%!> n/GΚJX]H)'%zŷxsgݻakג>8KZ~>k^fū&|ֽ&R2& ~ [IQzr9x×//8 _^|ŗ7__Wם,u'~>X`'(Rjܬ/~>T+Vn-6|% dg&@Xǹ M xDzr*='(wE.s_K&ɸl2g7Մ`{'fЛ>mc&MW.L.5o(u x/i]/{= |ֽ&2%+Ǚ f^eg⎳qp8$.˽!A)SaL*ßKmK&ɸl a1jԽ+ß;-Bӧn}^l-Y%~(8;~Q{WL0|yvS*f V!V%0ɪaT:Ynֽ& SCB}@N9՚{' ?{j qvf/Hٻ7qAUGF z#v {/gOV l?Pݕɱ/`{EmP~>FNn}'f^;ΎЀ5{"9 {ﴐO`αMJ*W%0?ƃ#~>L =3ᯑ~f^;΁#kȺwW]A|z`S> *3N`ͼˬm'ȚvG;}ˆOB}@N9 P^߇ṃ^f |οq8ڀ.  {1YMUg7U?xs$ |$Lj:~ ?!>jˬ~+vM=VH_ƃ/NL=;KY=HQ,azůg^#9F|m_k· ǯ=~#vcdJoǬ&(RJ|0 |}%k_3d|}{ׄs$7~=ŕՄJ uy5OIQ3;7?փJqm%ݐd8 eg3ϑL}>}&9̎sgǹ_ǹgŸfu)m"A ]ս&/7l"2k-mwf$V r32ɪc:(M2{^u yﲩV~cz/7u*ϕ}ƆHHŕgɈ/A =2~+EJz59mq,¡*|yXNL0ǰBG{jH50\ɪswǹ88h #ޥd}:zˢ掳qEng^+Y{}Y{G8KF|-G{?kOEJ:>ϕ!5᷒,[GytDU~*RZGY3[!؊CU 8nUM =(>28knj.Rڼ4NVoC|\H~%#~ ?#H ;OYcms(š~Qg>2{Q}%~qV"6N) ?wzdžGϑ,H'=|,_G"NJK{&|Խ#~%#>z/^F%T  ˬ/~l!>{$>V`gɈkג>X:"~ ?%LC/>Em#@YG{8Ttu<;Y5|*8A3sg>2{- K8N+~JjIEJ^T;Y5|eC V`.q ߇*ո߇Yx`x^fu|dp,:;aW`` _wa]zoʥɡ4TtU%Me)ɪ=dT~ ~{!/ s߇*pո߇Yie/.6G8O=wd|#;uzʐv x/i*OIV ?! $߾ V`.q s޲mpmGֹ%H@tK߻E.#H="X pzIS~d ƹ(\ ]1/p %]t?-Yu|ne3NHX>KydУ,߿@jOa"{4%_8C|!>"ď1ğ+#V1e1>bYqlƙ IU" ?Ի4u M 6T\V"ʄa ǁ@ % )_| b_{·e }e eI~`vor= ] 64ժH2aB/>bT*LȐ.MGBÆ^ qODkiAd?½ll,Kr04"g\2>z"lhL%qU feͼz5_T߷wΞ)z)!aCcj/GX}&%Ƅᒬr=⯈$@D`qr~f{cHS{#a*߬^42kcxl<{3?S.=h~.R{ # q2c^f |x^ eI>D.N= ] 64xժHz ˬ٫ax^/Ȑ7sz$>lhL5jߧ1a&=s|[_'ۃ^Ƿo/%]otU7x6[v].xwaE?*.JwzIӘ0ܒ/Y փV?3-2kˬ/W>ju[g#[O6| 9GF 0Ά[`#6rz=L= C 6B%5!-%Mg斬~*Q{G:#Մ_K¯-#'B/&Sˋ+/2yBO<&Q~)%>jˬ?ekf {:߇ Ka5SzIӽdsJNWEgP-{6aqsKXXt2-( E2؀ 8ӫ"4gOV.ᥡf=ruCE˽1$>l׍\Njߧ6{d25pvxy9V Ի=]P$cBiN5uGt?{J7}epЬ_@Wn.xwk~k̺hLDӽds\nkpBcKW][3\0`.TZjKEJTo(V{ r@mx_X\ySg߇ wzYm[^9Yc ,\⯓zHF:cWs`^f}m=K|W^.| ߷΄o;ו~f*ŸΉ[`;ur Ga*U};TQ& MQo !G|л}MB} ZG#Xy32kc4pN 67awѪHWa"KAs&_\ʼnl7(9vݭ\[{ $>l]3#{0 We5p.#?NHEVNV{*Rʡ5Vevoo;Ꮥ='ᯝ~#ax^f |.5p.έ(v>/ 6,]'8(LE20'=)S \*7%mÍd^ݬ{W\p|S7 ^G2kJ3~`ͼˬ΍5{gݻBwHWYXHhϝ:>r6s]u ?Ի}8EBÆzsKwN~doŷ1G.w?rɈ'|J}&>|$ ˬ bD$qX\=)Cob6ʔHeH!8Q/i&ϝ~{{Q{G%#>zGj/gK=HޡY_Q|D$ď\2ⷚGI>ՄEJYd|[?|:e|{-dspg QFW>.PCR.&CG$au"o#"C/>6\ GfAŕ?ݾYSBÆ^we5{΄GG6~)%>";2$gqesO'3^.JXH*>dkKydУu fkeHor8&m)=CY UdTu 9Tnt2WQ}_& 6^,& db>"ď\2⏒-௚OIq +(Y?~^ŷ2yOƷ/b1Gs?s'|*~q ~!> Je߫ u |d3Kp!T3zŷ[O{$==>bKV6~ ?{%2*eI,#p2WYJoEJ`Sůy%4t =6}Yd|[Po^<شe}y^^< [OJb?` >"į+< Js=36}Y_11~ ̈́?04?ށsf/ks.`-iԻ +alxlYmq K^f~4pVE(v?8"] /cb*7E1Fef>"ď\2ܡ']|J·ೄierpk F/ kXc[V{p8*7f*]ls+N]LwkN^"l׍ܾ( S^3/2;> b X5Tz7hX*Ī*ߊzugOVЖsQO#>L ==K|\$6~)%>jˬ\nk5š 'rZuCE\]V[ߧ50Cm$/eb WZWn@p޻?z`(hdzw~d7M#ğ5{?{eݻ_`ze>l87w PV[ߧW߻CLV<#>6Lj_σ_O #o EJy32k}y&a:u,u^/ ߇ n'^Q%ӛzw01zHJ{&(RJ|̛Y_|%>?Έj ߷΄F?=>?=#ax&_]>6Lj?ۃ?[5%(RJ|̛Y_S^|K{G:#*o Tf]B?7C/>f'V# 8s!E;{4'`9EIGQ"p?gJ'2lsSݨ.xħhN^.߇ n>wx +Yu|E1~lYN>qw6Ά]7*e /~>ju[gķkOu&:~ ?!>jˬ0k [`{qsSz"hhP zHV!8V/hY+.mC5ֽNf = q~}S0q4[Y_Q^|K#~+~+( EJy+2kcrG[cݻQ{^;L!ax^f}~F|l?WŸ'H)Q3o^fmT8hV/ Yb' ?we^;L%mtey*&lNBPyW\BQ$ *A7*ǟ 2ks-m@މ/Bq 넀1w;|NVV|lcď\2$|_k"Gͼz|{OƷo/e--ۋo NVЖoK|Խ#~1,IH7\ne Fޅu,u灓Co]qnk^>4NVm>{;]r.~COm>m%1~)%>jˬ?\ne;pЬ^@ԽD.N+.mpe^3veWz5 9jb:{;C&M5;C`h#N]pѿfe;PwhwֽD.N= q S{Ie>Mj:e|{-ϓ_%[Ʒ*_*ce;Q亨uj\2>z~6j}H>Yny8a؂w|%G*\d<!^ eI{w =xG!aCajGj3)L.ɪc,xlhk+Q {7*:>o+-"%W]H* ޫⱡ,ahD;.xħz~6Tոgz52k7E ux=P\d|8;(4咱*m'a" c^f<(K'$3y-㟌^H6t F`o}\CN= MdpHp8sqT/i_/~*Q{G%#>zGj. 52?ƃ?zGKF6>b[Vc&5~)%> je߫ eI,#p2w -#c^f |c`7T>G2F%G2zǗl+N72TU^-ۋod|{ŷᚬ:>1prnqrD.NK'&m+> 7 jeV7*al+wΔuϖ^eɸYB/ 4pv`` cuރO3VajժᘿYWC/ UvndpsU|ߵpz~6FR2U0 26Fe\s71>i4CBׁ641<Vcf}B/>zlsͱME`~_OBchUzY|>Sӗp?Gۃ-0Ƿo/%^ۃ-ۋo /ks1.mp`bsR#0k>H(>lC^ei#'1>dlˬ/X>1෕z1gk%(RJ|ˬŸ\Hwͱ{l*z G!aCnx;}eںYz__-cs?'>V?=GRc`^fb\.` XME`?ܼce = q;ųߧWA3Yu|5pN 漉]@lYN>q虯N:S -)M 2T>㟌^ŷ2yOƷ/o9Fogu'(RJ|z?T [`| ,LA6qY_1xm$~~ EJG¯77-E`d~k~ 9-e}{}{I#~~ azϚH)glzo/ŷn(2yI<$q^݇csWx|Yvkbݻ1\ȑE'iU/1qי(R:KAs%ŸF5{^䒍O3-5܆qsɎa53zI30U-f]mֽv" o:-̗M.[Wצ:S{If\5{wď\2ז{M='~ 0U[.ȚvQd|8-Lzl&^_e^ +Yu|%hY_P.71^z <"^Z{EL^5{wď\2NIHiQoۗU\ O5{4Y;+{Vr:ݕ-^_G^ l?j#s&=^ fOEJzח?g^#'L<2{;Yu|컚͹'t14=S.=dУ0`.Tp< KAs'ecŹͺwsKY\!la5C ;2?^b=d|[¯ו/_W¯? ?jQ/m=3u?tR.8t2{ ?V)e>.ms.:|Xd|8=W].[ghcJJw~zHޡYs} [Q[>Y"'f~Hopl.f*SS.\]qMEWiS.`hIVtqsxͼˬy6kw#؇N=u9C]Uz.8P/i&ϓ:>xK.\$Iu 8~Wa=u6Cjո߇9R]D`wqMu K 6B~{ 3)cyz5l7eI6ޗMz )tУa1wc?ո߇90lYndix#Pw}AvO9B98''cQt/fd[ @̚xQΟ%M{H}ذa5Y' aB/W6xl8n/R.=iot2WQ؊do~5p̏3)%JKUǧO5{=vo)'s|au*ߜ(Y__9n޳ޖrIpCV$ Pzñ5o]Y~dxl8,Kb-˘MBÆ^˳jߜبYnWca^2쮥\2>z拆қIEJ4jx*˒}ԽD.N=EÖFW$7'36jeV7L^ ǯ{4~5E`yd3w[)E թᘿ9WB/>dž-ceCz~6ZuQ Kńᖬ~m=qc7nXő/>Vį+c^f~U`9V o5SУ;eJo1_zI0ܓULJR5pvIy#uYc&V/tK1sq^f}*35 7~?!W$V ?r2zŷ1ג-cUOY,> zeσ-0?'ϋod⟌o_b\g-41>KuCb&Az/YKt?{JyeA;iͱ_*G)H9z.~o׍d}1ߪzv֗598SkXMo8E3\p<6W>*]%ULJ x6kbs܄h8sAx]nMV{߇1>Y?p4pNTbsW|x)ኄdް=tĹHV!7.H1T:>]l?@A.8\>p7S{qFҾԻ|s&Ήw=ek4lKυdް=tY[ 1T:>^"m /OX?.G~o8׍H|w[wϙ:>8'6v@H14GVq#Qe"+{u9JV?c\HF=GRށ9/~o>1G.kK&:EJ}j ?,aSU<40OjbsbέH= ]xùn$fj/QExJV|{ŷ?NƷ#[Ʒ,_p=-MAbh8=\nP.E2d}'ށU`4p. 'xݱ96 w)tV(pL )5.zd*Yc #~Nf^m$T+|+Yc #~Z?gyYKˬ/[`#p2ꃏ^ךSRS~dm)/%S~oI(o\zE\Ur6G[Pnv<zşu5G.{M$Y|k"GDb^f^-ۋod|{ŷs'_u|^q~v_ŷN"GDb^f}zL{G%#>.Gj/m%(RJ|$ ˬ/>{ ?rɈf?##tKnYzŷ, QKF|8]zoGj/kOQ'|;YC[gyށՋg)s1/~˃M_>?rɈo%a%"E¯yky,<H>Y.vߑ"?(=G20KV!8V/i ϓ:>yH=|%; 鹠}0[V{ﳵ o)WsUr (KϺw o(L? Y3/2+D v#Cw:wGù@=t7bd>Tk(YKTdžƲ$_+"|%\sz$ S{Il zIS0\Ub| #k㌺w{)  S{a5oT3z5šx=ǟ #PX?5T_kՉe _+gȟoo8$~oL%` q0c^f~Uнf/^D` #PY?)R^T^/Y/W |)ϐ?4R.Ÿ ~+>R{?JGF >Y` wa F`G 8SO]=G2~}ah8o̫Y_|'>+?rɈ'sK/~OŸ;GNQC/c=#>"ď\2ⷕLc=C~*RZ+/W ŕdćs-Gj/& >26je>"ď\2⯒-~q. 5)-E?yY'$3y-㟌^;pZ8w8;p+op2W}yMz'''6ŕ?p xWυ oh\՚֢^4/ٜcu [jB NI F^eE.8~S/iϞ:>c<01]w7S%tdxC㪞V[*RZzI~dA`r:<p{$~ohk̺7ydi`s߼Tw)~ sɢz -)mUƒ9U^\aݻ[S5'/ uƬ W?uKNs$_|lcķJ?F% |W"G !ƃ-kjyݻBƿ jHFෙHqY3Ozl5pNN09vgS0߆S55 sɼsUOO`Ֆ^t#Yu|. Ef.`ԽNV$~o?7S{ILy g8'^hͱ\hgS}&ax.7t}. -)%M9q~~q\2>.=Tml t#SRS/iϝ:>6;L.ۆ$ o7ޙ (=t7 Ց^ ;Y%ڬt 怸n\g\2>!=İa2tDVG*RzI3~d1`Tl(K%r0KVG*RJ GzbRT}dAc']sa@ &CGt#GXHR/i&ϓ:>w N8{_p-Axdjոh=t?O0@܊ʙvq$%rrG%Dd|8Cz.~oL% #)Et?OJ|b 0l邇ʇ7ҁ6L6VG:zI3~Zx%8S]Ϻwo8U3\}a2碰:RRY3Oz?b,#&]>BGķ@ 0}Xd|[?|:e|{-db1GKFu>bSV|pLO )- ||%!>"ď\2ɜ |[>R{_WOEJzӒ>q 1GKFć)c 6~!>KJJ[UpX9ǚ7.鹰`bj/Vg*RzzI0\/W>)ϐ?d:#mV~>R{?jGFއ51xU<6ٻ. "cKv%="lXL=au"g4 %Y%~yU<6xϺwͅ b!z\>ްk<]V~y>ȫx^pcI؊da1x NUoT3z߫ 5{ yG.Ls$9|τ烏*ks=/5{DY%sa+Q}2dğ-w{K|k ڃ*ꃏ$GKFU) P@X]\^TzV7%7EًuJucEs$~oX7zYp͇zdl4}X{ 8֭C1>h灓yV$ Dݪnu"{,lnɪs`  k@ݻ2]pZt7KŬ NLQ78fpKVq f/^lsz+WυHFt][^\ ~-4%[JNWE.[+5{gwWV[}a^Ŭ ΫQ78fpOV=Qw{\ז{M='~)%>kIuέٻ. &=?[5' Bo,f]p^i6Ϟ>f/-ۋo o,2g>vr\Ω5{ z%Ax=BuAvf*΁0ju om> G 64zᘇ Hi4HV![.Ktz ?#W{X̺ m1kIc {7]⯞^=!gg6c{<}XepLv!pV깠}RBuѶ a+o*yhdkbdد|276MЖdpUϩ* Nszd[ mr*~Nx6Mۅ}\'XVG'#Cs&_|>U~] #Ǫ}'(RN|Y_6|W{W]~ #o+Ꮩ~f>/~>ku _:~ zϑH)Y3Oz[`gݻ?jHGO%߇'??K5gI>XׄEJϚy I."3rslTR.DGa~oՑ\ɪc\8'fo҃CMsvV&VtdBp wzdr"lM}9 nBHZ6ta~ox"l:>r6[csl {BR>pY w~d3gy8Ǭ㳜OͿR%aW$nq"Z8>rnCeޅuVw!L{KQÆq3"eu}xNϓDUq*E}W76PYd.7zS'ZD-X!U ߇ >{ia}z >+?rɈ_W33tĩt%(RJ|D$Lz5{wď\2ɜ 11  &?ď\2gK? EJIf/GMKF|8SzꃿZ?5#aؤa}wy-ϒ#d|K< 1_~)%f㟌^ŷ2yOƷ/ށssyB7F$LzNe382(Krƺw R t~RXd߼a+6ӒUYb1j^/2%rG(fVUcCcY끺wV\H6W #uY߇)Lɪ1lhY\wVB i+İБq8橏(Rʣ#wR1d/ŷ2=Hu|[GpMV~ Fq "ď\2דNIQ+^O(KB|D`dćc=Ht%(RJ|dlT}X_|?#9>"ď\2زgsLQ+>v?*˒BRksAxCaj/KEJ$CFއ5#K%#l -_.oݿҫⱡ,ɝ(:#w)wMsI>PkS)aUoflT}XhllVcs4ekN;81>K`Rjzt7Q+̺ md NS~dsι=؝4t2-(4aCah8.~N{]z>u  Gͧ%~oOWuQ NS~d?10YcUO> >X$-ls 7,#[(~olN|j߇A2dl }X_=|^|l>VķH)W0a ||G.LUuipsu<`5U u2械iɪd8碢#26>/~>1מ{K~ EJySz5{wď3ⷚGI>%U~dSz~/ o #Ÿ5H)wI~Y?>j:? ^|'d|>IK.L-ߩ?@lN@Cpގ] QdtU/opFs&_=|%>?Έ?g#m&߇7a}xF|lz??Sz͇Bo7a}=K|Խ#~lo5[{'~C|̛~ar # bYJB%ᷚH)Q3oJKv&kɺw}K У}>טuѷ i:gůuG;y$~=/%~~*Rz!ۗUr'ZuȕHvA}!qm5(Aͼ%kc 5p.мq^@Խ\'^MXkIEJ78M%/>ju[gćBO?c$~C|[={G [OEJ7_Vo,9\ G5{'nԽm}!unT5r=Aͼ-ks@'_ԽWv֑0`.Tj -)ɪs@.Tz]upz%AxCNfs@ ~hh:ϝp%u*.8c z"7Ζ^p _ɪs-Gޅu,K灓9BBÆ~5}8#aHW۰G}Qn89(LE2؀ 978%/~>judć9BO>%^~C|$ }Xo5p^6\{lɜGa*\DcK)fɪw4e3N8h6#ho> -!aøNfqXpA°IG#K%#~ OŸ;GRfIf/QKF|83?惏^⯙~#aؤa}xy#%~?{Ÿ3HT#e |.݆Śfݻ_=?ۑ= qS{7a5ﳷ78͠iDžo ްX3]`PoG(LE2؀ 93EJ^A K0㯸uET 9ҿdУa0׉jSSD\֗gU-[OKF|8;_^{{OHɪs1ބ5{PuGN%GzR{ـ 78tz!TUUǀxްY;{g\2>z~6Lxո߇9QC/ a5pކ-{lpsO%,zR{F`?oˬOWe ; ^lQ.Y1C'߇ :̺(%dpKVs=#>6Lj׃WGzzWB/#>6Lj?ƃ'xLg$ >26Ze[`ggOUYcUO| z?9FU|8'&.Jw!Oflˬ4p6 +89V ?ݡCȪ3P7Vu2lflɪs@.[-$nXz~6Fv|3dlˬΎ[`>6jqMyE USÐ]p\ įUYJVolo8*}lG|z;\u)uIo2v4gOVm<cLXbL =ǁ~ ?ƃz5vlo8K ">ɴУa]7#3jߧf[`[}[MU~' {=2kc8u 6#N7YZiG!aúnb+}4gOV٩c8c|ڣ'U^/V$au"t2WC/ `Ŵ K'N=jv_pG!aúndwV> ]H,'tz`s-wh m,M>h[Y~d\O?@lYVkz?= qu#O%}Q/iϑb&3 99X/.8wӣu ՕX3YC[ʋo c?%#zR~+ ?5feos|1|2ku?u%| ~] #~ ?5feǀ4pNN۬ͱ1k1C/~SBp^l3Yu|6].;VoրGCZa_7k*ՙEt?gJsq.qz9gi8<Уpt fV$^ zI~d??K5gIl ׄEJy+2닿ʋo c%[_Ǫ$(RJ|D$Ve"maAA#hOKVm?ȃ!k:~[ $~ߧ7ϗ3ו#u%>~_~ EJ}B/c<ȃ'>2[go#ᏞxK5~ߧW(l7ud=ϖgK~)'9/zGU gg###yGGվϹ^.aAYѠUYd|83 sNEJy z#O?/I{g[?'ۗ5~bvtk "|%ɜV* z;8)3l,|%la>l8L%qՙK^%w .O@d|83(E2ozHV!8V/gOKV=&|ֽ[.|%Z~m>R{[}[¯7Z׽[.dF's[}[K&TtW}Y0pЬΕG?ZlF)7 p ЫgͼˬU*7T%cw|kz _ t \A8;s87t_TUpͪxPYwr5ֽ!8~Sz×9C.^.Yq~^f |w eI^wD`tzMܮG( nYK,1d9*7T%9t7Apޛ&z~4Lcj/O}e'cpIV eIVD`qz=hJ= E 4LcBp|S/8d ʒ^wԽ悇 z;@$>h^Xdu>=dlˬϽ>>A%1K 8~Sp E_Qrҡ|Y_|V |%!>?rɈ'sm'ם~QC/~WƚGKFӳWa_r/kkdUl׍Nj'%J'S1߷>9;~ zCU:>άXE.8Q/i_/`exbsw.zoY$ף^7zY@VKJs$ihx#W"8(4咱rUOVK.RKJs$_Y^|K#~/7-{$C&]~C|Y9 ;h4qQh%UՒ[`~ # ?!>jˬ/^>{>6Lj?׃?W sɄU=m%(RJ|ˬ/>kc_ )ʬ]5FeVO Fsbu89֋ oAXДKƆU}^z 5)%M%>~1*@Y<)-ᷚSҪ^o-cUO^~*RZ+Z5{2yO¯;2?߾ɉV3" z'\/MNaUO7r)e/iϙ~|Y#~~ L">ϙ~xGO#~~ ?ƃU=H"_5{1ɬ'n [‡9Uv91r 6yYCBׁ64 xjEJzI~d\Ź't ⏦ީ9H}ps^W岍^4+Yu|h\6ejlG@ W$ZS1KFs%#m%úwŀgkL_%MU>i\pybrGSsؐu V[*R3M>'ku̅/>zz?o=GRf^e [KKF|k ք_ۃ{KQHˬ/~+/^uKv1zoo5ᏒH)GIp?WJ& H,λK6z'2AGa@ :CGa"4NV(vl ʒ܃-u,K灓9BB3{}S{IEJWU/i:ϓ~@  ~[ ?rɈV3#tD~)%>"'2?ǃ$G;G.d>R{GOEJz$I =ބud|8#( aCg'\4IV[.ہ#$X^U]$>Kb -)%MyULJb<\xuc\2>zİ3tD׫՞5@D-A[/vA@:`Tz,㟌^ŷ2yOƷ/bw\2m%|>BGį;GR#"qB/>"p-BRԽ[ZHS{#1jOEJ}4?Oɵ [ SGM *Fu|+Szݧcs4I߸ݖf_^5<\;== S 6 n̆#FHiW/iOK~{y-]s_KƷ˃^ϒgygIWciTǧ@&{d@$=tw = S)K:,Xq P/iOK~~YȐ'~?V? 턿a d3L3&6#|=_idУ0``j/wS=KAҨfJud3,{NQ}GSzKH{bY%`K~wwK'n o=GR[O{|Yolƕ 5{DKvw|߇ kQ470lY_|+/%|D`d%[·#$(RJ|0 y'$|O?/e/UcfY#K%# bYO֏!~ D\ΗR{20\Ө_|'~? ?rɈOŸ;['*6˒>]WON/֔a2Q~z51nMDN'SF= K_ԏ1TfdsM~*Y(L%#>z?Gjq}JQ0\Өo܌klXhYo7c|%0f/f8JsLp = [ 6,0FHi%bF{Uz¯? 9GF 0ʚ&Ά.htRBpQ"lXӐ1LEJQ/iK64*2naM6ֽqKG¡|Q}ذIɬ6\ ~%͢9Ҩ͸& 'tr!ѻBoꑌ"v\1EJzIz4*'S&XX.xw (>lX׌~fǨ~SAͼz_ŷGyG=!|J"ć`^f |옖L C.α>]pޅ;Уa]3r 0F jˬ/>{>Ms'=!|o;GRf^edtdMLpuL{]pޅ,Q}ذIŬ]p^,3& ; .7:,['g8(lE2ذ'qQW.Rjm~L-ot1&@Y<)=ᷖ~f F|8LjokI>ׄ)]ˬۋ2e|{-㟌o~+2a~4*উ6]`X.t%@p|S5 = GdmggQ\ %ͦҨ͸Lŵu1]"]n)!aþf$O,f\iTv[[gswB5w4\26l 4*_%ͦҨ_|#02[ {}y+2kssq~α_do[wzrذ\4*7f\iToem|pM|{W\Hr.@BÆ}HM|Ϭ%ͦӨakYT>)>rذ=tO4*U\/k}:26aŻϺwӅdr, q5#%^tKiT&4qnaً1>Ky`dУpKƆ#0U zڄӨOSE& ͺw꽧\o]du+27iTLJYP5qn#"9g\2>zˍãF@|.,azoGދ_+zoGj/GMQzU]y#";| ֲwEJ9G{s:&m)]U;4?O+dL;k{mE˭]XqS{8}VS/ϓF#"A~?VGk'(RJ|D$Ne5{ϺwՅ/>zŸGj/LQz_GDc$%# ƃHQHˬWӖv` ,dݻW.7wua>l8L%it7Y3/2kT98,QԻ|3s (h[DIEJP/ϓF%?d3K@<`UԻ8=Dž0cѨ"Mc0?-x"iqƯUB ֲw=jsDp:EJPf_Rd݆5{v!kٻ`Ao5TdM6Kvz5Fİǃpm]ZԆ1hX#.WPB/>.džʲ$Sû4a=z~[P244}7٫KaCDwWhdУPt  *MF@|ˬWcCeY]˿n~4z` 4ˬOo `\A/. z?@ zY|>}xl,KbxD.F[)%xkurRSow)k1l~cY"#s=ɝڮ[J5*Ore߫ .0#K%#>zGj/m$ >26jeV78o^αR]`mQUQOi,bW_k*7zx‡ pF =[}%Z~C|kYUb) oI(%]=[I<ˬ~ O?/ O?/e |n5q68 1>i6Kr2h#c^ff\pkvVn-jMBU$ PiRZcԒrGͼz5,2W*끺wm"Zኄ߇ .E1jߧM2axQl9F9֖ )TOBS$ Pi9`QK.RKJsQ?K6foOw} RBÆzS{Wuѻ CLiTǧ@1\`ptq"5w = M.IEJT/i*ϙFf/Q:#W?=L}%9~d32?ƃ#~~  ᏙHQ7C/=K|Խ#~Έ[Ÿ5L'~d5fe.09FQQ* j"Gͼz|{OƷo/e%[Ʒ>ϙF%@؍ :ny(@:za?ף`.TRbԒ2Ƈy+2kc.=2R4wmZg>lUf]*6sQ6||L6V¯3GRf 慠džG; zz?횑o=>Gͼz5UMSw|`mW]aWOTʚy+2ʋojC3.ƤBO<&Q~CQ>ϕF%Ƅ4qn/ o (tE2иpF"4ͯL~~Q{GpFf=⟄?w}y;2?փG;෕Lc=EJy;2?ǃG;G.ad  ;2kc2Z87':ufwCM-$tE2и8OZSR C/>-ms*:y:Yd|=ҶLd7U6Si4?wE=8o`{6a=:S.Ff= ]ޣS8oiTLJ'd 5{'nԽg%\z~6kF.ƨ~i%MӨ_|>jud;J|; -R^>"ms-R?u,K灑Co)]d݆~-F,F*j<\NMֽD.F[s`ΫSz1iH%MyҨ_|C-ֽh\hd~k>R{?ZG 6uM/4js9_%DUaF&( 咱3t0"G4?O>ulK)Gݻe.8Q|$>lLu5ZhM4I߰8 ;{l]] >F = Cdl pŨ-)M~d1Ml5{7~pԽ> )!aCgjcԸ߇1aB/>C&NJu'΃w ?Zᆄ\26t|-Q[*RzzIz4!^ eI^D`OuE$>lL%ŨqJFe߯~\,#%|*F#tٰĨ=)=M%}Tv%ʒjx쯒-_42Wm0L6nS{ Q{*Rzzu* %ۃo^|KU,qR[Ʒ^)_VWW@,X.xwg.TԦzI30\Өүd1 kۅ]42wQ%c.T^tl?%%Өo܌o\l:8idУF ]3gd 26Zej5q6.N8aα{d+qd>A@|bԮx! zeëaVz88idZQ}p/vά K \AFk+y~_8ǪGb4XĮ.1t̿9+街Y?69֪ 9ކރz>dKo03{ߧWA#)& =͆|Уt CG\bԡxz^f |E&XûX[.8TQ}p[t\p^L#nk\[qk^w8qz-a@ 1QcA_* dIs솻"t4ӣ1j߇ 26fef\Zxs~GX:.{|^QX:Æ#.1t{CF~W%|dzO La15qކ7}sl {1l{x>FǒyOed-.|>c|!;3\BBÆhzS{ K iTĹc\p:İarW?ɈQG*R:zI3i~4*726V %p!響 = qKFJ~9KW3>c__+៙zgDĨ3)ez5>Lw.wα9]pރz~6kFn1j߇@ۡYk&͕ DM|Уu ]E1LEJ1>Ymlļ'c|灑CV$ 뚑ۉ{:SRyOef\ڪj")KGa@]v1LEJB>Y5l(\`w0:a&SvNGa+\D]p~H'h9x PwE.ٍBYrzWУa\2Mf]f1aQod 5{7~_ԽaSv#c42gQ؊d*Qozjouw i/>ju3gK?s$~C|$ [eՄw-ᯚW{WO%(RJ_f\3q)E9|{g gޙg߇ &S{IpE°^f ||[&DލOwF-Svc13(lE2؀ 7K_z)GÝ0?-1^ 5{~I\g z= qHo|i(Y_|'|%>o3zm'~)%>ʙˬ_xlGF {U{Joo-Ꮪ~⏚0F{U_K\2ג-gIQ#%e<}gϋ~P?/eϋ'$ 4P1qbB_u~o=n%(\u@Bp^EL%JJSe:~Rz? Yu!E|{ qF%H[|/3E0Fu|8+W*1,%r<02wQ8d*)t4*Ut jneI~?@ԽwG!afj/M|" c^f}O}Q?rɈj?%&؆ ?'0Ph ?{ŀR\oo,qoɨ͌z5>YaW"3 p!{ۣ%E2; fܜiFFR;UhjmY΄wď\2ܡg)K~C|dlˬo4U4q6.N8αR]OQѢ6\rZQ!<}B/?(l8׌T ukgWY=Y8;^^8ǪG`Az8yR^fȖ6L%BUS亞 s[wO;}D4U4qXGW`9gY < ġ:>͕zHBp3/.0w} #·Sjo߇YvXq? Rv}QOG2аz8^r4ɡ`^f |LE&1\` 3c,y = q~>̺pڸg1j9ҨŲj\[V] _5KBQ.qWOQ!8Q/v1#JL J^F]Кra5-jCB\oO.l1C/>sⅆ sR#Xk@.(|#h}8vj! fe.09F #=ᯖ#'ؘY9&sf!X3{Y$咙4fcƃH)O W0C/o/ŷ2=d|[gp MK\`pG;z祵%咙Ѩc6ˬ͸Lr+)wc8Rs~4̕BQw߇džB/> ţs w4tϲ4qyC|s4qr]a FsQdXJx= &)Q}3WmcŜ.8RtϝFu|E .8R]\26 4*?r/kdxE[xy9Уojum̺9(RS,C/o>\`o^|Kd|{w|[o*C_Lb~A=xN#s߇ 嚑ljF~iP3^f}zLu%~ zϕH)J}Y!D_Lu~ { ף\3RaQw߇Q&;Y_|D${=ϖgg`H)wOs|Y_U|%>F=௖OMQwB/>ۚ8`D$~~萑]p^zĘ/~kFCӣ0?O?>j:? ^|'d|>1q@DwfW Sp!kkp@BՁHt<\p^a~4惏G;'|_gOL ֗5aŁbijp0M1l Ũ%)]K4?O_ۃG;G.ad~m~ EJz5a(Ɓy gc3R.CF=L"BG1jIEJ)AD^f |]M&m{7uYd` =L6EzN&4I0ŁBj";N(BhgS= Mb̝_m.1jIEJP/i*OK:>2 /jnM 8Ra3=͐F+L$sKJҨ*8yi.h'{Mkؐt #PwZRR_fe |l*:kOORI}PI޳\p~k$ 4*++SX.p!{ lgbkTo6z BZZRR^f~8~; XX.$={'m~  Qk`-2kcbaAX1Uئ2tDj: ^f}*#>cyBO_Nu?(gB/~İaF|8Ljփx0Vq4jo:az+hY_|'|m<02O ΄G>-2j9vTF =cWO>|-2U#~>z-Ϛg}qO '[Ʒ2<72: np9vOSME` &L = ] 6B%5o.^iTLJe2: 3Tx=6mװOӰ*Ƭ FNF=]ApO?4qp52Q~0Jol; M5'1jߧ.y5k\pܣ\@85 b0< PpƨM1fcͼzUF6.:jr6XIO Q> Q,w& 4s9:1~ZxPz. dx.T2'1jt=ƷUGzU )6LV1{Fsr6X~H!wa +2닿# N?;f ࣺL:# OY~[,e |x&΅YtYV7X%t #ހ 9w.w=\iT\j2WHuv7X W%~o׌4E1j߇v[YmM+U źw|9+Zኄ oJɈQ{*Rʩ5Ve?2OƷo^|K|YĹЪw V@o #04FH%͠Өd 5{ͺwN242\>p/@̈Q>sW᝶k 5{qͺw|#Kυ oՓxƨ=)K4?wqlkꢟͺwR:2k㉦&΃_5{~}Խ[ osaz$wQ{*R0 jˬ/*/%|Խ#(>!__5្~䗄QoY8 /jn<{ o8H7 #1jOEJwU/iOK:>Ml5{ovedȜsAxøf9Ũ~K iTǧ`٠fԈw|#sJυ oJێ"~f^f}mjudć9>%^~C|$ [e4ar.ơ9<&Q~)%>"z5id3L{úw8)s\>p]o0VMC; zH,]Ɇ͚/"w>)>42\XK MA:RR􀯠^f |l*6k{w sh nڞ JszI30\Ҩϵ~3]p Vܤ]\2o:QG*Rʃ+ˬMWcfރuYr9C#sI cįy<&Y~dMzDŽ5q6/={c,`5*Fu|L;q:5|MzVwneuXipFدoLz.~o7uQ I dlt}X_|zJUFcWO^>|]z.09F1|&__3៑#'>ߚ8;`is25y`d\~ w$u@WХa |,G&[ X X5rhd\>ް~f-f]p)Vԫ2ϞF%f\ =atBXK\=#ncԥ1!kP4lKցs-zPz.~oX[̺fiTt]4q.Kαv\ Gbo:R. >Ÿdx87oϪ}Z쮷uRdpAƔއ59RoSÇ! Vu Gbذ=tĵHBp#Ҩ_|k{FVl ?r2)ߚ8a~1@+t^=sؤс CGxF@|++X }26RD-9{ 8yU2Ƒ}᾽;YֈU[!e>hSRx_[Յ:CUTz.a殞>Q!5f\`ćsc=c%5>#v?+>?+|5G&RzۉoJ zg3(Rh&j}XqM3\` 'c~s@L-F6_V&" pmp7X, E&R]lrn"٠fIJ|:Lb`.C|w Kz0*V a |L^ y㳘L6>%= 8w6S{IEJOS/45wz+%oǮc%(RJ| >=WCo-BuqQ,ڻ fj.8PM4TiPU%;.$4 Gxý*XK|1K 4߫ w5ϒg}gH)wM}Y[35]e ?@Q8٣HWXQ/' QOgWCV$ >(`՗]g{ax~SM~zQ{G:+{&Uz25{`(`Tǧ\.hTK "cJXmzL\,u~^b(="h87gztl.0ZLL>oLl.LwC!w\6V7F}pn$ì eQ7zVwSgZ<X-.8j k"7Jso-Ҩ+Uw14G?jadj #cK[‡s26>h* pBrڳfSυHJ 78_ӨğѪLɕ zq7?Jc̺9 H!ccJv;c+ϪG2]=GM>L}Xd|[?^2e|{-iT5qNpҭ^W.YE ͿUC*]} 78_4ӨwdZQxnؔXz?բ1f]6r2)4?g& E696 o/=\dpWl Wa |,l /\`?8cNs깠}&wY\iT.ck\ؔ숅v:n+/zjA="l(M4J:>vG&RN0RȄmt7kdV5KzVw4ql[$F<BU$91vIKZTϜ#kL&RtYvz~ūM4yska _Ydž09v iކih>ipWh|ZTOA)-^On|8LjokO~lGO9/UψoACCd@[K??O_>ҫⱡ{uy\2%=t7\s!3F NS^'"| H i\sy.7TIbԒ N14|V#? ^|'d|~M#>c;ϕ~' ?"kcxl^\۴ 52Fօ}RE>ϵ>&N.N`?mZԺdP4F-Hoh"F%ᅴWؕnc`rwM!깠}9Wu(7iWK:>ܦŒ4U\ B\2o 1PPcԚji𹔢^Խ3sz#ADC)ҫ̺0snw_h-ᡚ^Mբ㍠ c;oRyC]="-F) }>2:R9g662ꔠ}]#9qQk4zٹ{K;dž }0idZQK wdĨ52F_>/d\(/ c˙%kp02-(~ohl8cԚs278MӨ_|F$[{[K&|ꉿZ^WХa}gy-9F^|zŸ5#' ޏs usu|1z1jMmx"4sX2Z$ s2dy~8oi:ϙFu|n5qN#cwX:۵&/ Cb"'Q[J/bi/~>1יH~_ ΄9GƔއ58oDp`ҁ{ Q:}]}3zŨ- NҨ_܌d[Yݮ^@8,]v߹ ͉wRNƨ4ݫQmM #9vcAKb?qQ:Æ]=ORj/ >v&]`/c[r= 52טuao2[cƒއUO5qnpMpgUo%bo CboSz??[zY;36>/.09F==oǮޗҙ|>26Yn\1>ˑ灑Cz\dQ:S{Idqm]4ëQk& b&&8,#^wjzk:Hl}X0]7l;\`7h9vݭ\edGa*q̦(Fdovsa|D$2cWŷ˗5ݖvBwvڽ  %a*{ura2VELiTj34.NC1dDžs@oע6$~o77"1jO9ɟF%ቦL6tM_#\pqUoע%LE2p/Tr^_d1P}Lzd4W*Պ3dWpyƝyfQ>0njoZ78`°Q![&%[0z"l*^gj>.8y"4DžMya!)$:k^wok桵u:.qK3%e*7,V3̕ Lsz;8Qd^z o2`9zUt*7,V3 w-GAxøk׊r&52ks=! )OvߠGa)\^DC|g ݹ^ʑ޽|GoN`F *|zʦ&Ύ.α:]ȎC#BR$ PIKʙˬ§UauϜkF^5{B@Q>0)'։QGɠ#2ksspj:,S!g8(,E2؀ [:Rjo-q@5Fu|nƫ1Hp0y]3(~o+19S7ҨğMBD|pᅲz/w? G2/?V79Q/i"F%dG~ߍBUУ}a^3 ]cԙr2FWoq+ϕFu|A&b8,绁E7Ga+\pQgJr&+2kc2ڡ皑7Lꐠ}a]3;`Qg`l+2ƃߔ(`FC,1+~>w Ϗ#e}{{Qx%pkwי{O%''c2cc^f |8&SOށzC&N_&cT"wzoAF_rKl G&~frMZr]zУ}a]3RnΔ,26vej35qn|pM/pY&N>OqQ؊d wbWOΔ;z;Y#?xLͅwpY0>ϸsevG2[[kKo2내,26veb5qnwx_ZH1vu^X ?2G&ہ ucl%zt7kFRo嬋r2VUoq_`8>A^8Vw7Md"#s1t̿~eWd.DF)'d[g] / E)QŅ:33(E2ذCŨKquWS(,ů+9F|>z¯ľ~dg/%OK~zטj9( ̈́փv+~ee"TlαEzְ.Axþfd1Hf%ͦiiTt=4qfwF$soڥK*&(wndQ)8Qc|Y֔f\P GG~q!; n%nzdJ\DzyD@T4 GÃzIyQxO?/Ikg[?'ۗ5R +|Nqޡ%xI8J@舀Rp*>>Vcᑃ}M(8R@z~!೨wRfLI?DzyDPp|SТ%a3t YQ)1OY w-B&6_JQnNxugjŸX O?*CR|w)w&#v/VjF~sb ^w8rS?z(pTQ+Ի>*3c#2΃ψ9v"į42O 8 ?R{_A *ASe9;#9ֺ {D&Wq0Xf)'cWN־&΁7 pN~z@v\>*_d4s݅םGsmwgӛxx$c=ZRp^ViTv[d}pCE>*o%a5Fu|O[; XX.{?3>cWOxkQlk+Jα]pASļ$8zw)Q)߽[xJ61`םαBl^z)ӁA2Q)z14*il/4]`x[7޸Q}&lZR ϓFu|5q.N>@Xw!xj&@zJziEL'L .ߧ96]pމz>dL_qZ]|T [QCh~4*iwM.z~쀟ZGףPt fgz{z|2yO;2?߾ih4tsnH"n*RzLwbaW/Vw44OݦƆJ cVpQIj q@\ԻKJ$LIbbP3|pp;ťsù]=}G@|e-CQk}>f?@8,S&F;-ݩw"/6Y*İ.KqMӗS$`WoJ;h/<.z|{OƷo/e-ۋo ugZbo; yI~= ?R{_A ů^ڵ2V?yBORV¿Nm%|3iY_::>o3ב|:"~ ?R{"Y.|T}ثh}>\ףP`=~Rp^֝iiT|5q6L8gꝰ7Q)8R/iY_|VKŇyBO<&U*>˙^f4t((gC/p1Js?$>ʙˬs sǝ#vK7߇ NR'<~Sr&=2닿ǃ# ǃg·m<(gC/=(d,ڒ^tL\Jmkd[\z+U?߇ OgZRNhꕗVĹveαnszVd,7G 1\p^y)a~4c2V$ qnK #Q}f^aQ1zISYMoQOĹ6t?lGM  'M4WV^tL\2M4N:>726axՅyBz~健¬ FNl%MӨ_|zJ{&=~LveVwd`?\pWWԻ0@BÆvʬ -26NeZ4 lansϲ5qy6Co}x@+cFj/ (grB/>zl# ,L*1w\9BBÆv-F)'cM6wVsrm lαOn]Ga(l7z'Q[N% 2`U= :ϕFu|8.L.P,:vzagK}{@I^ +2o po+~'~ ?R{} ΗU]ɶ1=b po`z7CBÆqHuf]gWoMϝFu|87p&~_8t!zr0|WwǨ=.SsQ`56lLt;dž *! mtuf]x8D&Vdlˬ&Õ .}[.8T W$LmE2:c^ 'J|cL6#\`ćslةY?~(̺^ F[3*8ٰ;x=ޭz\e8itsŤ9ӣwFu|*K\[0α3]pލ7z[L67W:.tzoې\Ҩa-=9f.8QzlNsWĨ=ZQ/iY_>xlXt^8,S&F= qvO̺ mdXU/iSknK@^:Ǧ ķũl:Ĩ#kqˬ/W |KtM02w ʃo5ג#'HYMarfte+P42OQ: OĨC1eY-|Ltjÿ9X^f |8;W*:α9thdZmYޏĚ1Hu4um٬ lK׳E3 0)6ig ^:|&: [ǚ eսG#aUEw5ܱ1#.c}? >ű& $Z1']K feombvűer8qM#w/Qqqg|\+R_X$0(#ЂӐY=WY:^Ѳh&ϕz||,lPߗؔPш}e^'z}|vlX_6ؔFsZ1TD3o]u6X>)B .2cG{ Uш}Iδ'ceH?WR?S;2-#ι4VK&ĥ}:MSo+V86 M`{Mcl17~׸߇s8q|iN -8 M{MPnl_c^879'hq >$ա8v ,aLUpm'c%c=qE\ !~:>>ճL|!mn>9\+\ɰ)e[K$ džÃG~LgHAm7+lJ.b S#t2;SSO-a9|qOL%Igͽlq{\oŕ]D{2p/ln /|qᷙo3#?Vf:X>}bJ 5dzzs(, {2v/ln WDŽOߊz/9W!۽AjU7+lJ[{!ǽDyLM~t~# ?!˛ b*۽h>2خ+Z~6X>gX t6kxGüap(0𭴵 ݉zԫS-E,o2G!@߇ '>3=C#{%g&g=NJ^SF#<\F:668ΤG\1>pv [] 1r9>q0Ыc2S~"^3;S?8ݮ?q*Z,]M#o݇F= 8%aÍ1zx%LFe"U>pN~J!&CYu8IqG*G fMSV0#.c >p.$ccރq0Ы೒1y0J~F%=^kJ=?-=Zs^ @xx *Cރaq0+᳆Y= |6 ".c pކJ l ql Bhd+ ?!HⱡRFqNm%3L=W-cHkCqŸYTket**%F6c7%n^5u,(h&Y=ղޥ7z|NƋY1riq4~45%{-q~'LGrij|/$'?J}Oŕ;ilQgbsgR_'||pV_ P+u*ÇF>qi ~ ~Z|;SV& y8vg+/"dq7N9i1 2hݽ 0hT2{X ĵ;ap2 e`}0Fg'g? ~gV)K 0'ǷT}xM#1H;}{A_ss?MPHlHY4\_-&1K_KTb/\g0:NJ']HdhNCX=ЭE2R8;A7! ̈pүyD]N #C L 2-[M/I{58Nq3vh|4V{`Qa@xKф-Ըv^*LWV `mgcxM5\_-krҎK@Jݒ)tO l1E5T\@xKѴFK;{ 0?ݩ[1sFgdj/n@Rn{A:.i}:\G{m7fU5NtiٌTMWnqI;ww/Uf'ueP$)'3ePkbKb7{;NeS l兌 1j=Э3R%ct\>`*2X[s".%lw͏cC^[Sߚdpǡlty[~ԛp#:.i5PⒺf3ad[J#4ҩ>n5-J!gt\n`ݞa/`Y鱡S5ԭz4H@R oC*pN%ʍ%uee4@R#ge A & %2`lF鱡K;ÓU.Bt˯z#֢s^N\RdP%b6tgx)bpPq2jZN-A踤\`G!2`I걡ܒ+KեG/,.Fy˽u]6b-vuPqn0@>f>V|PӸzТ)C *h`[MjAD557::Z :ZSbpCh_-gK|qd`q 7p.iã) tP:jVoiaށhi^z.ýr{z9@i#^LH#^+ġ7v5QPLZk"%z~nZe-M]״cw9 u45Hm[sXj=ҭVaޛu* 1tMwU'?wk&d䥪RFյ[.4uM{H s]4Pnbz%g[]o6yl /Is-Z1i_qǥRӇ/.Y5r1z[~{b=?:2/ xLUW&Un2VnuMw*oWN+Eg>.-{cl0Z~GW yK7*R!ӚSRa7+`p(oa9Xy9Xv7<|84<9E 80,kౚd0t/{~:2M99{Bc[N⦖YVW[NirZ'7bM  %y H!ou|1ku\4dDqyszL*pLg& q"5TI{S}ō&Sڦ30y a=+KtW-?# > uWl)*&5: Z۝,pwTḳLb3x˽cm^-\4CQ`>a9IFvgʁVvYj4Yᯐ='"ZC%oW>yl\X PgԱXpƿxԻ)YW='RZBaeG&bUrP{X,Lg3yr`8IR7WHh V^ Wͧ,LJS_:YX̞Y`z<4eGfqzfqIG~  (c,SV\\ C 96ɋ)PJ,rJ nI}wߚ|ȣ;c^tI.$Ev$tu ZDj$4[{ !;)e%_yɂSD.q0_ۻ9Ģ7 +QgR"cf7*W߆@StfX,0?6pr"BūbyMcM>;e ."^(}ǥE՝G~  ڒtl|Si!Ijzw Be-6H}w|-AXa1Jbjf=~g1Jf1bbbՇv:/@|]ߑvdGN=FZnM`eHZ SX,8噞 n|"ܶLovf '5ɃӜEgDz덎>{,([HX@SKo k-Cd-&}/n=Ye9:wg[ݝ om BDo:,'}'Ww6@xGZ }nὠt,gl/IMrHKɝؒݙzP0@v g75Ż]e䭄^ȓD/4 G콖D{2YeȆMS!K,+%e&2#GlS 5_ԱX09 x٠xal]֊LUKKzpJ`gYaS3lr+MMa(4 G % ԤQRd!E`EūM"ޝ6yO [fX+3M\{uG"?T@v0A6l$;tTVM%gXKMj[6}iL}ƽB;c5.ʠTA6l;EZCZŪEGfLd-6#~(wy#j4EghodFS07`J>1'6r3~NiG ݃ZFh1/9lHy ՊiMJ;ŒVÖdYZ w`twߛJwscuK!%bk=b83~@ `:y'n$-3yk]clmyqR#j6C=aA<(Z/2Q;Rl}"O,|EN+QZL~-LfqyI Əd}dp`﨣0#l%WmE-y6o: [+Id}wXZ. ~Oz6pcLjAs.($V$X>.M5}9P8~ZTS™8IlKa,7Yy-,=]J[6Ԡﺢ؃-í-\rQ-j]H+x5~i(a9~ZRDo9Ȋ^Ƣ%t5jEuayWd=-.pi X -4ciY,RS`YtG߰˓s?p ?r6H.c\߹XE fb#srᾜb3?\vP$2e:_\Y/!)6.Bu.̩rV򜪇`iciYز#nAuGA*q'.NvݩَQ6ѧ!/eK }r.+ES܉  .xNN,mae|r.+4cp/e#5;CESlp9ZƤV Brr@Xg 5 ri;siB}d،ӘP$jr̥DΥ̥̥ϗ q˅R^.55 Υ̥ r#sLQ')6.l{ 9~J;l|.RÏv;yhx=nl+G߰eeڒv. ~CXe 4Xj\6cuԔ5Էsb◞:Vj&+u%[۹SZ`]cʢc~/Ǹ,-f܉ 2!^[DҪud9 CيrP)G߰ą_=Rl\ޡg bO53Eqbdizl Nc4pI} h},X)Z\N=Jз,lx}Z`P{1Ol5dtGVUOl1LB_jQKc״w<ꇿ>R[.+忋<֭傪S~7,2o炷XpSSPwCgGV?46V qH3,I0lizS]oqTVsskO3JԕR2߮H=\z[\Wm:+f~O϶!T&6*C)myl5lZ3Ҋ~RlƝ`.Gp1ַZ1YM3JԗR2!3\fB.\F\Z\Z{r=sY-sYmC-f܉ ޡcrK5wrNk4Y?46V:z6}Z\͸m20rM:|3,cDN}Vj"ԵjL5،;qc2hZئ,|G'H*QoBK=|֏X ˹s c32,2o\~rV;dK j3^.T:ee UK.c\F\\I.md.g.D:13525^.Do)6.1{1c]JhAX># f Fij$ұ1&'.\V\F\I.f.d.D:2՗6ԧ،;qVcL>&KiŃ\fFuªQybKA'\v(k>4Gܒ-Mj&FZ៨0V[*2_DZYӣN7tb3V/g#j2cKZT"H .<(-fYz;ΥK7 XY|FR?>5 EiJ%b v$ #T،;qcLctw#F`9 ZlRAtL}rTQz͸ߖjbV*V¿03vK啧[3}cLSi5xήǵእcO:Msy>ׯPE9)6N\DnyPMxƨ4!˹/,գӌ;wK3^v._71*d}f:jIYN}׼_kmqKLq)]QM4h[ϮVQybKC؊MCsNRk:bOb3ࢬc8η&!TO37zZ6tp}I}׼o_-]Jw񞿻KEqf%rT7PiSg#ci[ڶ"cOTVځ~ʚO۹ 1&1rQi$c2Of=gNS='Ub3\B5Q\p̥|؇b.-.CYb˒xNj-;j 2biXs Rʇ1\c!.}\\4K/f+:>_.}e.sf.s\t@͸ -Kc#e-hG ~c Vfl)v?mE͈R:T -A\C*JK}Kd6%]nMq#]o5Ӈf;թJk褀~\F\Fyr2U^.f.V2+/y)6.q.,\> j,roPk=ޯ}GijF͸j1qS'f,112ZŚ;P?Ӵ&*}bFbb3sY+sYVrcW4 -e4b3ąCcz>l5mr.+&UƕH2sfiZX枧b3IeUfH7(޿Qya4b3\.>\ʇp9̅Y.f/B\\e.3?\NN~r?.g\\\I.̌Gu.g\\\z4Kp֡bR o;F+eF2Qyb /ZR3،;q6у \ՎAg][qbiLm;iI[R 枧b3O;x)?{Z(3^)֔ٵE#?'.f?w-gaqnh%'Hr[.34FĞ&.[pSKwpQ ƪ5xXZ;*OlER:%.uq;:\T5j,|Wqob5W""vbOVh!pH.~s3s+sWrcW r+sBe،?wԹr~rc+eFb=O#frH.Teˍu.^yr.T: Ub3o;:8Si][.cBkZPR":sJ.r2*exɹPК?kq;:PMYǑ8,qҥtGZ9}K2y)6.cߞjJe{'+SK=g-dB[ڱ،;qFnym JT\ff= Ė4gt?R}q X;0g=() 8i+Oj%mKJGk\'z.~s5saK.ӹ\Ty .g.e.\i،;q玲:|ae`9sk2xkGIe8rŊWY>2WXYq_Z62XI5-9\yg/4VׂݟeS-5a9~RQf[\8sGXEVb_ C֩e#E-[c3?\|쑹̙r3s#s933_.gf.{=fѝ~o/|MkXYqZ62ߣD-_GykNwĘ#Wa7a!2"_sזS΅D .h9Tfr.[&*Oj1dGX[=v[OUKqCUbL6:IE\mǹ`ZNdkVߪ7ޱym=MGTybŐ{,b?ˡc~boȚq*,qV*-H\}h&D.}\\\zԕ\\\zpӉnq_ Jc2[;iRukX6׊ be_sŖvtoX^.~p:B\z̖r#s=s{2ǃ_s\& Fr2Zj˅JX\\Xy*\usGR*2߂ye|W6e;j({w\ybą: .Y3Ɇ̗5Z+Gkp cXoX帟PY/R1N-jQ+ sG34bE'f[F;K=C}.~p'.vpXD5w?TɬǘLv̌wjQyjElxO;c.[q;[ yjo ?NU,N-W콇.:-4QV m.~peee/=3323^.gd.{>psGee 3byq~7;q6crǸJ5bHf;FYcf|R,'AVUkԩ.[q'.ѣY Jۛ)˹7L7EK){;ni)2u'䜹؋,]whգԥm91:ffΥ%)r:<932^.4#6_.ToSJ}kCs+OΥee̗˘K[1[n3yVj,qfq7biōwjiȌ{;=O;b?mĘlC5q 5dy߱ zTҤt1wW(PsG23Ԟ'2_VfV"mBXZqZ2c{Rj(VUӹjʙ fQc>خWҤt/;]s}WSVR;\\KR"ee+O2ۙK<{pj:w4F2̷VYya<w*J`FsBK`^pVjʪ{sGױg.|E?ްi[ƗKӞb33;.mae[,59-'A6)^5玪e"gr.|E?XgVKGf\Z\Z}їN\;!fr.FT؂ۤtS%TQz[\p;B9*Kn,N-qwNiHwpbLfҘd%!xiHiM=T+եԷljӹl<53[Z|q+6,q)U2Ҋґ3aO<qCۈ1ـgp4j&˳~XZww*iW +uO\͸ 5T;wکY+vhL}mԴnG.<q'.V3>X,q~ܪXZww*iG0㡊rRl-.Uc lqQVVe}2,oK+nSKGٙ;n@f%\=XpesFqӆ,?4;?Ղ4s~rbL~RQJsG DrH.k\\lf.^yr.#cOS쪬/wqZw=eJM4|_4َ16ѧXZwK 1wwUJ͸S:wT-KjḁHf"Fbiōwj|зwx}S͸ sz%5:Ic]Y\Nbb5bzd} (=f{rG5ι72ߎ9ݟù+c2n^.RQRl\FDnj]kR֢3zo,N-/c4uW:N5Nk*k^K/B\j}ԚXk r5sBe،/}pr|?\N¬ye31y#碚xAx5)8T3Eu~ʚw۹`1#xhѢ?`ΰ;Ldľ;v͸Vɛ_r֭Qi$c2 OSY1!I_Sl/B\f̞얹xɹ쑹ri;fy1`F"5o.3 `,kV6PPR37*Ipј}QM\.'#-\FQ;Cӡ2Т3i犥7ީe!eĞ!@Ց{Z͸@\ŴnC'Fÿڱ-{PSJG~8O\K*H};|tZ y3̗Y<0+Vx̗wxM?q16. s)Riԝd 'LK4_s=)cYL;kԷsLQ玪Őt/=|qGbf^ybB;~gT'.f܉ wMsǩڊ]4}R9kN))w J^keSg1L\'Yd9u=؉^Q5^+Z1m+eIq،_.{e.sg.s\\\~l\\~l{pJ玪 hߚ+nSFؾijFRҪ~bl/3=2=^.{d.g.g\\\xԑN\T- 3j"[$;(\·d.̚O?w-HM)Ji(`W{EBBzk?C3D،;4:w-/9Fdb ?nT,7ީŐ"oiB}S'Rf܉ Qnamr.= cylR:ئgkRR΅C.'FjkdwXX=nS!̎Ε'jRfj2Z2eeeꙋ%UZ;sG*Xg蒰<׽{,7ީŐn9Iܹĵ8'隌͸ˤr3Y}bCgX=1ƚ<"+}r}o .23_.\nsSpbD.+O}?؃;0+>1&o!_X7ydXS'SLU}rM(3>-.lsGRm?0!~GXZq[~YnӴ4^S ?p)6N\0ֹE #If_Qci<)DߣoXe^5܉ \02QM֣Ii)Ұ(+aX|+O&maOӒ&?Nż~AwQT玪JM3&jdW>Ś=dV ta9YuI}\B5Q\p̥|؇b.\*4!;*5fMJ͊[~ԨXZ%v$#pI k#e3o jTTϒ\fɥXZq[A}GӍwOs=j1&WT**d6bL&A)Vݟ<1H za9 ?p)6.ԶuZ*fMo<7ٻ7ޱyt=M^H'j9.f܉ YY*0-[sY7Ub'Z:4UJ ˹X|PEioqa֡sGR`+Fzdye17ޱy{w?J})?\\\e.^.23c̥ZRR<.UKC\le.^.̌Oufe}ri+/\&cIӋ,k'@jd }GJG/SO\͸ˆ"@X} ;2__=j8\#7Vֆ=Mߵ9f;\uĘtHZ1nJm27XYqZ1[}\y-ąą .K:ҡav/beu_s=Jr.'\EI}Ɨe@ރ{D|iOy 71VVx{eV?Sib?UZ9|-o˙R TlujM ?q5WQR?wԹrsU˘K<;1b+ L0%G~XY\w*j<Z?<u.̙ȅ/\F\V\V}X\\f.̪[[\~waW>+~܀XYqZH%-"ond'p!; h~ aۊ,rߔbeu<w*1}רbe <w*ʓ WWV]R;qPP"qf؉XYqZp{KTybUk\˥هp9̥هyr>\.'s\*V?w-<1 W |r.'MM_aōwjǦy콇nĬeҨF,3g]2.7v.4fX+Oj݃mϫrZ+noqe NhuAY儿oXZqZ{Ԑ7w/\ej 3_r2zZez*Ob=sY sGق3^81n6XBWGqb? m xSyZ.~p*cBDbb;,3]9΍ʸUyR Tlx^.[q5~Xd]&1fr.']ssb'b=twϕ'XcsrM'69ez>olsʓZpb;ssi. -̸ ?Q->"85H; dƞ{wϕ'fom.~p*UB΄qYmXXZ+Oj݃"U8RƬ9<%q+%cKWsciōwjȌ{Mƻ=G \CYuK};?tZr;oed|bW>Қ^yR TlxN3f-ťURT#O5YBWw;oҊ2wUg;n烈~2v̗\\e.cg.p9˲eeهyplP玪e!gXތnٱDe 3f콇'zŅ UB΄ae{k wQ?!+Ol݃R:>%阁kHEoqW^玪e!gj"˿'ue^y{7ޅ{zbl̅/rY-s+Ozp߹XpC6sGղ3Uԥ2ߵd˚=o,N-qU+Oq'.N k;WOfTґ*Oߑfe\cy$&D $@20ed%jYFW#mU_&m)VE91S򔏴gXPQ9ħzK3W|oBydxifsEghcNl(J(dz :wTBr?yew!SN@ikǞw$'g| lkzl 5&_\݃L[;s |ߋ+OH{;bQ9 '').y1Rōwrz<ߨcO]s9=>b\޹:w )%N=ȴ%gCy,5854Rg+ΣQ9 uib+PRōwrz]h)]oVcj}bc)O U;9=߮xvYy"U[T+8~%|q!L=P/Bيmx:T߯!"38s:իNdz {P:wNg瞴oR H|O U;9=_7ūzwU ߹>-RO6)xdڝx65ZyjG3KX:ZG*U.忀;ҔvX2zuz:ۿk&Xy8TV, ;WU3-۫b%oN~vlkshii|&;rƢozb1XZW|R<ѩ{iD}>5>om%8g#1τvCӋkL+7ѩ z4+];~x[=V,8/}~~(=_hop^4J}DAK7jO#XRQϔe'ܥ$Ձ;TxGg< {SDs >ג|G,sB}DFkS3iCiIdںTs>^' :wTNV>YN)҇V*nYϗiž&<ƍwlo,{xld:Y};{J/8/I5N+|Idݒdzj/չr2= k"}órgd+oL+7ɱS=tzv^X8sGd{Zb=e,_KoB1T'9{iwφv;WobѹKMg,9h&2b1f"#Xz>c3Z|+zw{ʇl5GTWAϡJΕ/}ĂߐSp+jٯJ_Ϫ,-Ux'糞/VNϮq?\B+ u{yҵ_2[vJ$w2nPg^>bA}sGdOXc͓<<Y؈zl O[:=ƍwlr i|ԹrLQMX-_ޣ8 Pڬz=~Ϲ΄H{;bi(+;x Jb)IJ+_Rbڢ5<竴gǍw1fH%W#~u>@,5HRe| >i*ZyC}f( Y {_Ă}{Jy,%xL"\JUٿ?1J]W~^EϗW}CXZ%2X8c㍥+7ш}&ƒ#X,RKg,x}ﱴk.' t>qU|xo*v츧$gǍwlr+W=g^#=X')3e OJVpC1-Uݟrp~^RW;y{p=}^GXkfߪovW疶z&z59=t7nFOߺ"_L{7#uҾ3G,bYg,{ce]Q3H{7q\m^2X,m2˺bj5˼bYOX81" ~5ϔXFpq´Tw#eHT)屬WRV, SgSEb=߂w6A*STڄNQgr&i|G,oQ9U}&ݫ&XEηg*n3ꝕq>Uيeqn"gUSf +oR)w*mR}ϙuFUٿp;*ds =ߊ{5 26k EZΟ7ɳz{tΣL%GKBSrWgX*STڤ.)}f٫dzD^ʩ3٬iCϗo_6_/|Tq㝜/=tNM5^<,z)Y^ 5x]i6>zQH{uSgP엥;j0-Ux''ەy<;ng>X:{ch1g}C[k|DŽis%w*mR}=G3G,3ҹrLmwJOzXLԫcYV )ϴT߹*~"mF}޵y\e{gXV?cEkqz,k&yƒb3BY+9 lGwdyT]+9{PiQ {l̷֑bQ9 Pf-ۥlqڴRōwr zޏgǍwl2wĢ$]5;v_/Yw9+-UwV ;}nxv#b/t_/ &B~*nS]sNM57bTw4{K|(xJ-JUJh6>gMp #/;*3'NvH+7).LNM޽V|+aط\iLt|f1WZ!TwϽi6[ۃi|G,A-eofn=_ } ~qEJōw잯=t.Zt[wIJ82=Ŗ| @,uRetB^is%w*mQ}>]38WXR;cYEkNh)b=߈3_yXJ?cIɷbxo;Wr:= }a=4| &ɓk;TwA-V\B+ v:wTNGgjU}uTk3fV*ncyZΟ7/L8Ε~¸zXϷ~Xu_9GMljU> ߏg瘞WKrl}u|+JKJZ1-U'9i6ivoE/Ŵg#UԲW|kF6| { 3TwA-ϳZz{L= }gG,狫Koz+Orpg_yg3_L{[$`=&'f ʿ5=x)gǍwlri|G,׹ry㷿{"JްUO<݃JkG<ɓg{}¹PO؟W;W-moſoHk;}6yo'G,H [G. %1Y,)em`'or_Ϯ&gwR0"ѹrpbFx'fԂ7D֊]v4v?;ng3_L{;biQ9}u/nZvo*EKK}ITZ[NgW_yg'_ZOK֯C.27Q0}&rד_Gڟ7ɳ~!y[zY.G}ra{Ўg#:wTN̨\g.LO/]-f"pJk{I//=XQ9VY׿QZ\"Ru_y>oYߗӞ>b<3*Νo81eSy,%x;LK7i_igǍwlri|G,Q9qDϗL_uB·F3ʓ=p=G3ߊu|sG=ZQ9;}&rnsLϚl=tNM|1#=􈅭#jryVXZ25zĂ|ZxvD|1s:wT@a^gULPf|jci}fP3rzCct<;ngWjOKSQC2w%~q7%jʓ=M9녣-8Ŵg#>3Dwȩ8g*n>r{q]YzӞ>b%Gj =߁׉wjʓ= 9^s_i|G,Q9zq;PoWɹ+ijhDNq>&wMʙt3z5| r8DLK5|ITڦoD}oZ2|+ѕ3X_VDNbZNNGwj^ώӞX {c)l}BBԹJ/_ޖPWAmF}Zpi|G,scv.RQ%ܵ[UV*neZΟ7ə/=L8t~)җm> 3竴vp?;ng3_H{[Lt~ϲY.|GoMuTVjʓ=]8B+G,Q9K}&( 5[α=Xi;9zJk;}6ԬbO#&:wTB.vomPn#q4JM_yv~l(os i|G,bBǎyMyvJ۽[qAZNu=tzv^XJY vݺAy5RW- u]^V,KD:wTB.wyͨyfR,3xi;9r6P-ng+_H{;baEY1;uRXRƋ7Gݟrp < \B+ߌe8eZQ(ŲZp0mHH+O-櫚m68ֳ[x4ۓakk /Kt^kTw݃L:_=U"_L{;bQ9 }d㥟Zw(SpϴTq㝜a=_mv8[?[OXzg©AC7+2E[jO9{iP}Μ=q#oŒֹrLYu|*宵 ymkIΰ/6Nnq?[<鷶֓oŒUg:C)NoQ5=ٛ7mSd6P}rZS=dԢ:wNge=_Roz+mS_.ſsꞶ=tzvWO}&s􄞯-R)w{]+*J?i@}gC)gN rĂoUss/nhXrp(-Wƻ5˴ӳ[xb%(GNwz?lkfۤKmilz<JpPocYe^+X˼bYo,3XM,댥}OKoHw=Lcz k;[ڮ~~[ =lw‘[r.yR8NTZA7əwxvE>|+`sEwzط |n`Z(<dų8sʴg !^~(߃3{BgC)wJ;9=_l-ng3L{;bܷ޹?{WR,}=-X4T|z>75 ΟKi|+޹erRpoQZ߹p`φoH{;bCI ^;{|[l?^V*n3=m{7Ż~!i>XjQs%'oUFϗߨk ow mYsEA-y<J[gR3ߊŮt=kBͳgM JōwtP)-3=ōwlҞ|G, =[s%'cfԹVe_ǀRљJ+;Wtd6U:#_L{[ؒ:Էi^ܟ )n'!fZdOl:_nq?b+ߊe;Wrl>ߪ}E (P1i͹>Rl(9a}#u;*^@OijNҤR]V-WfJl9Ynq?b+߿E\E,oĢ53K蝫e|#5XxcYe'ߌ[փbRN~~;9~ξ1 {f zvVgL^BԑVȘw4=ȴgC)<ҞV,5'?w4~k&|vWkL/0-Ux}<{L^?[޹c/'tNZyVR,]JK+9{iB}soY߯b3G,Q9=4YKczƉKR >T[ڡzS3r]mvƻ0#_L{[TQ9;iz#k7%PWA?'}69Ŵg#~3:tq_&rKpܵSsn{q>eתsG{pf/L(e]J;UhITvٟ<ə/=XF:wTNص(~ RmRōwr%Ok/;}69ŴgKW/^) S=߉|_ LJ?ʾ$w*gWӞX&z:wTNIm b4Rq;`=tNM|1o247sG{8?VX51ninQ<֓o2ԹrpbF_Č"%g>#Tx'v?;ng+_H{囱o0:wT]װ? w;? ~E5ʾ$w*]g3_L{;b)( {`Č[Y:N8eJK_D؋.^mgǍwlri|G,Q9=صzRz^{TWٟ+2iq'ߊ%a;rpbČQЫ>9*~VW'F3EZɟ7ə/=XXc_H53Jb|{tg"Gü.=-mWH9zJk;}6y|X|sGf =z5aٖʓ= x}_{i|G,Q9j~yk&rtv&LkNM^|ժ=V,UB;*Zg=f=߁;aOsŴTWAMϻ梽wj|1o4sG{1m~L./YLd*-;}6yCO#وcvgP.(ƪKhK4ʓ= P?Ӟ>blSg7|g"X'z]Ll=_$NM4 _דo25^׹r*=6|ٳm??L/衊<݃JP/oׇ86>^V,ӹsO&L̪ D1ؑVgǍwl(SUX8B׹r{&pzAy,+4--U'9{Pim?;y}?7ihO:FsG[X?}u)n\_aZn,֖q.di|+6GʱR u@kkSmj+$w*u{}6yU[o25sGu@[Yw.̕4p>JiƻpvWi*!vx&~ߓoƲp.c~I 8bz'Sk4^TWAV{}6yU;baORʱ%_ݟHwdڦV*-;}6yu[:wTN~Y{֭k&ǍJ; ʓ=s=;{}&/jsXZ7;*Ygq[w-vvC=oNZ="7޹SlEi:vx|vڸ\[L Q98?!!!p3.rRpܱͅ'wXJѳls<_7b_ƛzU玺E;MݟkCUJRl?b3ߌ%O&pp|~vg`{ *hJZ.sy>T2xζSȮ9g2簟_M>{oӿ&"yO;<'[OD')N}o)$CmN(ܮz-UD׾>_{ܚ6] W믿w_w/~:?od?ͯ?i?'wwJ ?ݍ?thAryӽZTh'M_uy:oϻuvFԤH NuɈ~Pw=`D^6*QӉ%j:~jp(QE-*Qӕ3T"n % =/:oQ/TG;h7C%jzN5P, JtbD?}K(Qә0)ti'-bS#Jtg)A% ͈~oPЃ O:MW='hJ'M;i:/:oZI˸im'=|Ҟo:ѠR eT5.IW?ic |rTnP-Iuu:@GE I[i'tDڨDM{7]+=t]t4>EKE Isia)Pk>i7mIPFSc@Bq>n:IG'DtXPM[% RJtfD?m&)ta)rDMzZoX ?(QӪP릪]]t~UOI hJ'M香7-,XDMWOJt'm"?% .n:wzVѕc}(QӉS@Xcҁ2*] % .n%jc dJ4((vz )bDiPBOI%(["ΌDMw20(4K"nV*Qӝ>*Rv|!=Ig']c @Bq4nIsi'-tҖnگQg)6XCzqN:MW='kꢉix z]t43&RikDMWFk5tc)L)ROMw=t]ttf5IW?X~5T94vuyyS.I[j`W#T5nQSq5N88ES=i7夹ܴt~7m퉨vӡ:O:M"T0m< n\68R 96MCðAǰaÎaQX Hr6v8ҒaÏK|11܌!%o~Rg+*~OFa^ aTƷ-X>5Io)N_r1|d.)c1R|CaQHoF)# ˧$QpIN|V0:IH3 i|Hq%)!˰Ý(i$ƷY>{RFa|/HqV>i GBuVTa×a:Qðj}$TgEz6ͭjmsɇW e.y/m8sɛrRnCaRhy>.Gh>||9h\,RFR8ه}C(>|BHq-]{|]|zU/1SxJ/_7_y>|88V.;k`T2'˧fIq ŷ10  Ј(9szxa|\7@èUIq]w׋$9.iLg4c()5/'Jyb|OVsyxa|{88[ e7Ϛ0lj`q7l4FIN&.ys<])>o>N5Spdɍ:_^)o_4|`>4&+]Rb!)c)oX>$nxx/^ևrV{zP|]RgW0&%$9%6OyOx^[!aHè?|mHq\t>, _'lՆNB,A(o Iq,@ӨoIq38WHq\|OƷ0gIro7!ŷQ8~:1~37 q!a`tʛcd;)eL*)'l)o>g}8O6p$7r~Ȼ8Q42gOWA(Iq峻0Zxu1.>g_^~?gw!adgI= UOnת8ɍV/{x#||=|΋@o~DZk4g7 ad7\(,}<8 g}ݍ:.^[x,=1X0&gfIr")Nc|^|pTl:RFb8\.Kxu6.;[Uƨ\|t.>9~:Ӹx,k(oJb?THqH7b?Ut>~8~-00~6\|O8RF/?&Jr,)|r1,=)c.S<勧.˼x?1\IN|$0CØ,ܘ}oa0$׸xb^"Hq峇HsyxI/$y0zxo>|vw R˧UImdv08هe;Ff|;)|vw(0T*)|F$Fx$azY}w ŷöQ`EUwTX>;}Oe_$9m}aT/fYFc%)->}e???]6KS'}aLݜgmFa|9Ͼ2 laRFc|9;2 pU]a Ɨ8u9/>ǚ })/pN)#|9adƷ[ |jn^Y>N0dߋFg")c0>N}?f3]|/׺8yyqn˼gOfߙF%_t^ӱwhߒ{hc͕ c1%ŷ͚dO\`xFbOFf|V(,=\ξk3)30ZxKyp!o>g{'&KX>{}WaX|v9q70~+(i~?ɹYS^̠M|QX7_c<è?SS|䋏plRIbXs{>ing/GFf|x;?(%=2=*0iat`|( 4/>WJ/_7_faPH?<3=*#4å{Bèo }onΊ |rea 7$9KRb|;Dep谆RF.|td}aq<^K{x峫E=峇S1{Ҹ? ,o4 ً̏]fp调:(a~6܀)ț8 Nyvs)S޼3ݜ@iXu^|/i^>o>׸8^^<Շ|^Kzzx_wŗ%a ϐ1ߔT>KR=Hr3t.)#1n0rx/,4ƺzxcN?|OX Imp%nxxV|SRFaXs;QèϚcߋFcXsQϚ[ߏzYs{RØ,IXoImpcMRFb|u{S3]ȌoT|jc͵P 2%a4NR|j))';nxI7$7Vq8 ̏?x^>ɛ8'INiӁw55 &d|I`.)c12%ŷ[.Iq]eJ茯fIr峇51g}_c6M)Nc|=<͋/Ë⛒0jx-oo'!it~ݥ0A,6%aLg]ݍý[itb8MRFf|u` kou0}/8MFc|cI=?|u9/>W^[s?F*O߯Fa,I._MRF[>|䋏p?MS}a,,)O[6Impq/ai/NRӰ%on-8 ?]oo5 ?7$9raK|2>k|k峧oSRƼ|xO]SMIq峫[e$̏U>Ir_h5.˼x?1]C<|())OX7_%OY50l4mJqq 8 ?o$9&4Hr6~ER0KR˧|f:8/sx/<]}/W8>.Gh>|勯|qoqRƺzxb|{|k峇kQK{x-eo |ZZ1X>$14bJ27O,kN|k[c|>.^aY>{8|k.)N38V$W8^c͑o #3|k6~9XER.ysmtɛ%oSFs[XoHӘ$7c`~lHq?00~:+}4X>֜0ۯ A,|k!)c|'INc勯|qog/'6Ff|{RFaOF--]wƷS4X>{0kKRdOb|uyHmp뾢%9.x/?֋V.û_$a{9gTIqS5Iqc͍oѹ7O)?<+%)N峏龿5r[aTno 1%atno c0ݜud")Nc|=|qqov%8T/sx./%=~Y>v o [p00~9Jq?ٵ$2ynY$a`po c*%9 p\Na|龿01~:G,IX\[/y]<}/gxxi/^և7vFg|H`Xa W8әW8^)_k|kc͕o SRFg|$1X>H`|IØ,ݽ0kSR|ߺSyxfXs[(Ϛ{u\v5w7g/wvd|#I`")c1:'1uq4=Hq峫[(o aT4ߚ0gW{8Obq7P?)>ɳ8 8RO8Ne0?$a`Ro }o;󟺤8 paLOΒ42u8[Ho7W˧TIqy\|)%) ob'%9T/3g.9|k%)N峛[èo2|k38f$1Gyd|{;a{9[.-8 ̏u4up77Gm \$O0PwTw70~q&1_N40~}:^ȧ8pFf[(=|:a4W8KR{&)c|Z`u@HqcՑo #3݅$CRFa:av[yxg[4X>3IӘs<|~qoSx*9=|/Y>{i0*[IFcpU5/>'ۯS z,}kk^|͋s}k?? t}k?8 {JrKi:atƗ$9 parYiW4&OFfazR^Y>eHh-S]oOL``0&kMb!) o8a0w$$9<. %0jxo<|vs3}k^1xbJȬOyad7%i|ta78}o 1)|vu=}kߧU^,n)O^X?OysNupNyv翽:4󿛋[Ø,=]3}k哋$ Ɨ67OϪ{Ffo 0=?}kS8`Ƽ|x_w5X>uJo[/pϞ5tad575'IN|z[~xgO\[,ݟ5/>WK<8 >v0 [è,a4Ʒo |V$1^0X>kJØoOOO?} o1~:1?vʛcd)i,=INS޼p`XJq>8 p\n,g=I>%ŷ1Y%9FS$9'I.峗fou͋^ouc0>nLO0$ߺsa0=xxf|V],(,b5_7>t0$iy>>=0c]|rUN7Or7$adϮVouOa LINO.ys?]6~me.l^5 ?]9]:Y0__0g~fp%oS}xf|{e0 gwGo ~Û0:gWG1~]}0&gwwo c1$iX8 o]|k6~Zb<8 [v68 ?]V_6~Z|a0\%ai.)cp?]\|sv[H~Ua|JxxaaTgIݍ[ow i|Z$1|*Hmpv[Ho'!i{9Ӆ0 ǪKFeG$X>H0g$[u[Ø,Z5VT0gזo O&6)a㧅"0l&INO )o O.a-8 ?-;b|5K˘ER|ߺeaK<׋򱟻o 2V$e|[h5Iq峗#o c0>0&˧Iq*) o 'I.c|=<[(,=ݾ|kYu[h,IrϞ_51Y>$*օo _0m~la$9 C)m񓽘F){AwayO.|a0Z$i`dPX~.w3^lOǗRFfOF.^|FQOJIN|~X4:[MRO]ҸOup<9^dJq?ً0Jx:21~{{8Od~ؔ0秹$)U o]݃RFbOFf|5I(,Z%aTW8i$ ג8>..iLOϒ0UR|ߊ8F$1o>X0 gAIN֋YYFg|HӰi90ΞG: %@m~ˀ,GN6T9l@|Avp>]l~NG~j85S'7`PjQrɾnRɾnRMRO|G~:{|r~qײ$ uבRj q~qǧwIo̒'lh<>sIjs~8YMR3gƑ1CRuكUJnRO6@q\߭O|7ί IL,q%qSwnLq+' xxܯeAUo [t$5N$I $50k|k|q.ێLq[\r s~Vμ5@ү.q㳦ƾ1qOGo=8)O<ߺnG5m8[ʱ`bʭ5^54p;z}z$9N09%5Ncq[,ί7Ie;%o 9$50x|#q)q3$ d^OO<>;%o=緗K 9Ny|f8@NJo߾]8@ٷ[ oUI[nc(m}] 7(=dnJn/֣8'o 7@~KJ4qOV(9N0k|k6)9.߿I,}U{3Ir q~vzkc(5^=Oz~pKP;@,C֗r%KR[GZR[۹ͮ'lKv&w5ۑLurvr;,W%SiN$yItZvHll׃ >25ۑ Y:rJa];HtvHl}V؃d<5NJ#K:b29IA9;HC cc܎$-ɪrTiwlXC ))ݎ1/Ǽee܎ގnG.iwt9xAfWA#ׇ$S;q#7F&Fj9HJrd6̞*)S$ ;+ VlO= I&ٖ!y9۱T=N}9R{;RY+`r9T{)> i^ JZ{#7$Cs$SG׽ Ks;no5A#+A6ۃ$B )(v,ǒvHKt{ 'Yr4iwIGrv~;f{;fб[otvHz lzI܃vq;J;JUGnmihvtd"{+Af;":rvf{;Af$KGn iwlžX7"5NRcJ$':s썹'YriwIGNr.GvHkrtiw"ǔvlKd>t.-fsaF݃vvW7);@Nu5}/a EGndi9Hf;;HtƔvHl9$]GlwVvԑ۫D&ta#Ȣ#i9TUo|~p˱nooUxANM[5۽gxAUېR5۽x#It֐v2a^j8 @&|ˁLv2anjw,:#-%@&|ˑ5ۯNj9H rTv.ޠ|ddߨI Gu9@&+$Ȅ/}9 }$;@ _`r>jw$֮|ް|I^/޲|=,śLsjxA }S;@f;":r9j僌vy;lYQ][mI] YGnL+|u9@&L0F (&봠v2K Ȅ/}9X= #ȔcJdiŵF֗#iյ$Ȅ/}9Jz;J뚷9jVzT'MGMiwvv;f۝25[{=٢ v=o]Aajw &tjo}>zLM=a@?"S!tr so>\LꍷB;a/"Ez;A  Ȅ{KA z7E0R"$ȄC-Ilw".}y9mr Xm_؄=[۱&郤vCGn,(}d„ΚA&ܺJ0axA _r0v\WdB'̄ݞ0Ⱥv0vlgc(vOdB'It 3!VIyގБ۟D&tR5۝EIӑ[C XQLpJ fB\S+ ۩O.ǺXQ|#)+$XQLRV}fB\Sh}IAL8,g0fLh?隭 3! ]j a&jLHU=Ad^y;X= - 3ZRߎRo3-RUsdB']OZ a&wRcٽ7$̄VkLHRT=l$̄Ljw,:#h9H ~XKdB'dŒAxˁLzCIa nݥLT- Ȅ[giwllE Ȅ[Oiw lw?E GE'Ȅ~D- 2K_dŒA&Dj9H }K"S&c{kzA 3vyVo>2K Ȅ9s'Ycdl r fTo>2a zA _rL֮}dŒ՟m'lv&ڮ}Z YGϼ Ȅ{sk8 b;@ sM't$- VA&X}(cA&ܛF߽$K.}7yp&.r bs5NҗۏYcdŒu-aQ= nݥݱT8@&|ˑ5۽ Z)GvHl-̨N 3hR v!p&VόdQꁝ^r f{O#FvzA07*o ? dŒ4[-$+d{)a8@&[vi9H2$Ȅ{# GEGv- 2I_Ov2!PAL A&[ei9H };H0[[ 2^ A&K$ȄIyA GZdl'F=ZIǮLXoټ Ȅٛ7/2a_'ȄxOE^OmL~d’+A&,kP~dbo p?w-vA&,7d]u; _r r  p8A&:I/V_vL9;@X; A&Chj9|kxA Z(!yIյ$XQ,W߼ Ȅ5yAX Ȅ;7գ`w6;@ Լ$rہLX:(oBwRY=m`My#AP=UzLTi9HP=2R!2-уzG3pLX:آ=G8 իGd½?pQk ZEp-җbXn {|HALi9HP=f 2aEbn,:k9H kƝBtA&܋|4N kLE72`CdawNэ^p8A&U2ad½ԥ A&D7zd­;@ xB-ȢcUi9H _ Ȅp8A&DÈw8Np8A&)у VE7A&JAL풖p* dŠ-у ։`tA&D#Ȣvi9H =dv_j9.TFLCG6GdBD j9H wr,:fp8A&l mtA&l[j8`Eq߈ei9H [Ftb+8+ MPD軜/i8 6[FEsjw Rܤ KK0V-SAL 5NP= э%jw|n􆻍YtZd}Li9HP=S A&lxԣ=9 v<)эK&-ȼvzlwp8A&rztZ#Fsܣ=G #ױܣ=G~2h9H ݨSAэ dŽ;AP=5RAL 5A0~эcG7zdŽ"F1ң=2aGQn ȄO{tdaFL8A FL8G7zd|n ȄcztA&э~nA G~"FэpG7zdaB daFL8$8rэp?{6Gd‰=у N^-=2" d¹pfG7Ą!nUp=2j F7zdefp8LLh,p8LhmOEY氅1j8X&B2vuc[,.dhⷓZe<7]n_f/IF|}2F[/x0h Ont4>xNl5,4[_w/dWn>߫}{7w[,hNy+$ձpyH \Xˊ})]D/ m6/Îm]>:^?v{Ec|_ʱ0lAťb|o]V~$_gϟ=4o*[Ӣ5/8.Cm p{FZX W ƫ|]%ЇC; F@g{~u肛ZCw{XڞF}(4j(tMkj;4Z]WRCIh4 "T9~]r{.<]rgB^|ދ Oyp`aO/>uc:>,>'T| LlRYxk^|MՋ^7y5gWu)/>)ċOmXp^|:$ƋO[14Oôŧ'Q|vYG~^TlP|zŏgEʿ.*>D[Gob⣋.Q|pq:\L̫P{CŇڋj/>^|P{CŇ[u_"?.>z~q`ُJp-dٗŧ" 2*>OMU|U|ffAhͅË}Q8=׉n/>4k<$×ᝯB1`(>-/^|JUa^}g/J>H>SQ|qQ97FELfJ>WixA|$_ɧز4ziIg?(G()XƍXU|2oT|'O['3)[` +^Ňgb⃛(>HQ|⃛(>8ߢc+Gi]|ڕ|=q(>HrQ|pFQ|>,Ňڋ<:,Ňڋj/>ԿW|b۾wuƒݯOyO֣M|_?~ϟ[yw/,)??g|a?駿.}+_~ҴefI[z7~֟?m@ endstream endobj 129 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 133 0 obj << /Length 5270 /Filter /FlateDecode >> stream xڵBjI8nV6Z)ݳpL̳ql#K?g&Pe+`d`m2ަЍ@ E/PP*ASc:EeQE30fn͕*"xY#J_`=ま̦9!~ƣ$<^NUB}|tE^36s\w5<-c\׳>R3n9f Hɬw_벞CmR6E]٤ʢ2Dp#jb [Gkϱ=XLy$9W|VP6f6lH=zt| l8?-Բd̅[+jvzvInLB=bJѽi8uGTZy3wIDuzV&CW !i%IE@<"6Ґ?<^]3]ojTŨuOH4ų۵ HxЂ6i -IX@*T)r[)c*޵ _nXcdі!2̉;tVo"8q_3u3:{4ion"ti?`Ht׼3gTS/#AgUMauLDK.j6QLN*'1(a|~Dôbvkn t+_y}ndp{X AP1e>nL|"P7Dfmh) ,q7S.4F=zvx8†y+22= ]"7{"S;"rA1 /;v*D|.(v,2`I`в"`vpceAdٻFJH%pb?D>9-pN Y Kr{Tnrɇq9r9-s1dPfv؂.8~8щ w C/CЅL`?7bc0Ŷd!ێta/Wٲ b0_~.fэ[.73)qY.r%GԶ1I=YZo^+53:&ǎ g[%brFyz-a;_)YmXEgap1o@Bpd{ɾyg@U?R`dJ!4CBX.;cxPzEܠWv )N{Յ0N":~!d—Z19_a0'_H۸.gEw^h 0`ńmx8ԉ{99,Hb(~֥biwzO:w;"E(k #,P(X23{71 83 +E$ᐂp^hhc"<@iʦuɌ2Z-S=&j=t@ÎacK7OC Z-8b!'r]&R(?9~d TTIGuilP8;>n{[.KÑ7\8o H# -ʽSBDCsrx3Lk;0Ho&a=ajR½.^%ȯrvl1ytF28JfxrzF%"by1ȅN|`ϹFs M418w'g hrr:f+hK8(jHC;&0["T{r39fE T~do]oqK SL:~\i͖̎+&͋̌bdb (rNi9zy#D% bPIB =+IE*40좻-5igc7!e.iه{OVH1aiګ7 pOd0z1嚑e57a$>0kO`r!~q@<ۘgAp JB Huf]8&z\",f](T<{bظ؇IUz24q*-l̾#[+gᲥ|_q+D̶-laaԻQT9lREYFឣ*9l6:7)^z^轂!6 ~̠=\ b\DJZCUGI:\Go-EwU鯠Qf}anX>.d]?t_؇mRg%OXBb~7Χw {;z) ]5E_ ui+v%5Qen41Ď)t"t&){nlx*G59.K7{RPS)%r;^39M6܍)d Eg',*_gJG41="!J'ʛ)Ʈ'$VUua[9GDh$hً%6xE*GN m.m(5mb@Wv1#5-,I.mm"+)|B6= "z>dM隰F4h;`"6 ٳ2jL38zJeu$@%K4FSzE}u=Zj/\_WQ9*-CrB ̕KgiL#W@Z X!s*%?H>JY͖ c!.h6F=/,*ݥ DIRV3<<¶L_F"37l$X2^%]Gk^vV~GFq7UqqTd$L.H/fzNRtA#b 9u}DXG·8gL6$K>lLlXM_q c0aH xM]tiVUwcлc]Dp;l3Xy A_e\">d>( иw^qa$E$ $p%win2Ëփ5ESv|ۏ~UQhP}}9_s$k?/K ȇāCzZ&#YF}u5@0/$ ؟՗2)[vNWWp,r*V`>?W c]D㪑AnȾK=WupyF\'%bwQտzS^6}E?{P0s3 eU0`"'7K/\][ y9ŘtDhLi-_(rDRΣ `_Qr,!)gy3" ٗ_9?:O|_݅  (3&q!o?#>K_qVVs'Xe2~0XW!&0Z$n0S#'ӑht 'ۢeEɦ>T^rI"? $]EBrcGoHe=\-hCEO(a9-]cɽFA=ry!j]4еXYs:8sH "cqvoxT˵E/(^әsUP6%稢>|=vGʢ^Rea*uN DhOA^xL u`c%y|>Dtx˪go|JmOTmHpb6#ICH&h l2.S%c 5M >.s;5&"O9\Hjs2AZ鲟./j}o2Ue~ $n/k@Æ2LO\?{} :/.RδJr/BV<8vT M`uu߿^|Մ F"<)Gi(qM9!qqUtg/ҏgmV|6=HY6!iNս {Ek;ܴ9th$ưh<&!,bE&$'q,TWckؕØC٭5q@KR 5@@w64~ӻȠፗKJIRMh?C B>?L- 2ڏW #g+9 Bs, -T IHR4 iCXVECT"UIԂG-\=gzA %~%>s {Ҕa&^b%ZS s$MzK92\^lT(+EJbD߭|Y Ti ђr$^T7эI8 4;oPC32@S(R8HAL%tX&~+ 5S%J[!V;ЃRp& 2܅ p9ɔ)J흦s#'ܕ'^ޙ~v=VN"o+UO#? ?.R*Jqhޢ\Ś)Ԏ aghLҖ^.~h\rw O ̏am&$Pc{U&^r˵-ZW1EUNT_w^ք#yyKZ+s%# V\3c7)q.o y+{@]T[/KgQpA JXČ 1j%_QX[EýF3P%Cj6*L+_R T{_^*psRBjsmLdě_nEH endstream endobj 136 0 obj << /Length 2913 /Filter /FlateDecode >> stream x]sݿBJ#A&]6miz~Ahr}ww A eǙt:K X.뉜L|ʉ('tBM [I[D4_luFRL~go-=-ANWm \hLC+a6[A, \ +9%H("HL9bNO+ePT~5TgVȍfhVRb iihqo@1'[}' M] sshDtwِTq8E74㰉PAݕ>ӡj w'{;iY;rciRH9\K 87 ݟoo5T'yQF3 zmDO1efzj]eC78ܙ h-8EJS!uX;iO#5S oDŽ5OIZ{݃**R` xzMYLN̔@ ߤq*SKZ_%BPO8;^z'qQkm&Մh0e_Vv\ L@HTjHljN)M^ӵn|A`2jllA}<0"SwY w!46]G"ߞUۆzb1w8t|#zbM؛,bN1L7 dt]7a jA!arzl>}/y+g&T, m9\WM f f/2g"8eˆ4U])G9sOYkT^=D.D| ɱI]5Jvӓ1Hm 5Ts|J%!I(|9V dnȴ/K'TnGf: }Bp^އڢ b%TQb\xѡT'wR8&{Fr Ea)cmw]>Ć @tLnriͣK?*uo;3<,?aѭ}YQ-V@9mBgWH:FBj"6ElOZD2$q7vܨTܪ|θֺᏕQxOaq.ĵ1kivp08ܗJ^w}CM5Jm P,m: ,=pE[u}qhYTfh`QG\ WVבVQ{VW0]GN'6̙I6Q.'!+K!G za\2PUWH%6 c?E492037hSeś*K #x͜;`&."z~SazF*(AT*ZOtj> /ExtGState << >>/ColorSpace << /sRGB 140 0 R >>>> /Length 1701 /Filter /FlateDecode >> stream xKoV7߯5-iJH] j * \!>u~=It/]tߧWקCN~}+Oo޺NѽğH4o59[ѽ~4,V>hz OSq1xɧi<=.={1ո_ ӳ #}%6~T/]޺'᩻p钟mǡ|9ν3_@99hl|3@)rs{s=!;\b倫x Gccx{=>udT8~PQ7x'_>{]?|c7u/3HO79Vw>__w%wBBrP8NL|vwE<1>" 4?*J=.&(4,7. 5&pD7]ŠK*`*!T_qp_@u j VȒkb,"JG32DT ´[/]b3QOtؖE0DuD>CނW{ VL$dO)M[#ӖxH3kTj{FUM[]ClCO`[bJxTRh,[4b3[T"e9@T}B [h]}P<&"ᆌ:x#gy+EP)eyǤ"6D{lGg٦=dE_eJR̹*ˌk"C3kYRl\d VW[뀵Xkbu+aV:l $++KD(=tqF,T"[ !&C'D΋ȾMDLK 0T錁V2$rCEڵ?AGVMm^;M[fscS~D\=йu#5| 3n=Q6!$2e)TӲ-1R[FssH\x0C@o|TZM 0Dx0+oPru3ك!C)M^QRa ƱE(`A?V,hW ȼa=9,Lk ,h/5"Apw.ԄN11 ϝBX  6 =銠Eu'LE4.C‚F6(AH`>f"V tM\D0H*P!,q/^)>oa `!MFJ2N AX0H]#,hDtjJE4i6Ҏj"^)$IttX )bmMB: aA#+DdCFXP[T2*r2`i"]F0相`AWFXPW;ݤ`QQ6RVr ]ե,٥,Dզ,$>@SVr c6*2VV2 ROja }v"W+2 L\D0HQ#,pQ#`R*fEPHaA`6xuм endstream endobj 142 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 146 0 obj << /Length 3908 /Filter /FlateDecode >> stream xَ_1X0Y1$'u p #Qy%Q}nͬc%U]]]U]G3Z]EW$7]WUXI~uJ0K(MlnW 8gOs=K* $PUy1<Hv='$Kq"[q"Ђ[b; L"j;މJ&;"R (Gd7=`^喨pX5$NBNuo_gyPn/ݡQǷT~41[ډG%(M(@[uvS[Ay‡ j}EoXPb*9Pd /`$P~7%T{zf28a#ݲ` C<ʫZ^8ok;ֺM2qAH -*JFS-Z, ~@sf  _y۳P\N^uF^e)z\ rM%aZV a.h,ez[Ѧ}tFdE&z=5,SEǏ/ 4a>1i 4/dLVsՅ\ u, ;yCZEoa ?2Q6nOW/|MNV#. ]2@b0#. 6s-aAi"+Ҿ@ >ҁ7K$ք̀F~!]]!a~U>XMkj:n`U>2,ڣ6yIVc`0s$ǚ(ca3@}Hggjt<hI5'%4 3ŗ. HmXDnUs53Q kٗ{ww0ݶһe[G9q$N?^KXBwj?H^Zu"8&}YnaUDxIe{qD/PVEwLDc Ԅi?͊,?*ŚU8=٨27>mDns3MdS$$rL wLqR +q&W7ޭ6RuPٍzl2w[i7+t\w2`഻); Gxʵ%YblMD _Tjd~ _v|9L|oQjfFͶv [L⩊ϡx]&#.NzfFtsD+f{vK"K::H"_m|:&Su]\M$3d`#8Χ:,hFl<"koAxH^[ 'E=8t=Mڞ[1=<_R%aO$\߄j{oc <2^JjlʯlrCl"#O[S'++pSDvPeLtǞ] uwl& K  ֿgN6 ؋RXv'1N,жkyv̩ɖ=,[Pd#CT=Qk7(PHLH7 |N`u{Hdsasi)ăO55 `}l#(\5<n}CPGi5t⽵DpYHTƄS~ V!<ڥpi10s]QR8dHʢhexP%꽿|GҚaNĭndu哑oe._|q ̴/gƟejzb43=bhdDc+ʰ*q7oE_)KM[cHlBK~Sɫэ4v^{cflr,jprmwn#c^KY9P"/ dusM}+t6=hIBٵgE| `_l$W1q &})⊐;5L7*W6(I!IwZ'cxn?p..QqO9LTeg)ݑ9 _[{NS!FBdr0!:SZW|޹ %bqgeoL$ ٬b%s2{ohu\džAOFu',8yݸ' Qpc/RF-NRÉK$~h̓MF Ui]V% vLTv{ 3(n(Wod=3hf&6$OLPZfMC/JtlVvrbfJܪ؏Gvh ٶ;GY&brSPBF#jYN]t\3JJwaaw+_$у }ʵo$6~"DzwØglĚ(S~0 w<6me4ml2 (^ɘI3c=+cPi3R#gaŲz/QA|:fIBe ؜4, C59t囕&/ hD2$@Ft90ɞF ZÒ?B -dc+jTzG}RG& ;){*t ۔!fx@P}c݄p!:\e[^5eW.rzwt=;{^lq9 @EH30z>fx]k;-UBԦ#24gxJ/:zuDY#Mj6jj`!fZ EC!U.2w8VMX4$?OZCt^@ӓ,М57Ìd\xM~it&2fˬd|㬿 x!Q¿^@?>S*JiJoy٤ _۠(q:hlO!'~Sy!u#1q)Έ/Q endstream endobj 150 0 obj << /Length 2151 /Filter /FlateDecode >> stream xn|| 9ē 6C&$Zd%%ߧA" d!]]G[ζ39Ýx+xʙF8kfV!b:}kM'-4xAه֖2wOw>VZԅ.fO险P=g\~bi+~,d=nRs\w>cXx-!K0?#FлWᱷ]ty[O'r2[#/<&;ybqU @'n!T\ Rv m UϭCl4"JLAF:ؒB ##:!+׈L{ Ѣ=R kli 6QY}vHɊ VVF}Fl{$wxX,)˄MǤwx7[0+DlaJxբ& 7"<=Fadž'yGڏd)o;޶iwzD–V={b'gheNKM8 GzwI>M>3x8o%:8Hp |$1ܹbTA71QQ+†&\D iʀB8AR7|!NhY52 *^tBU[xh0}]ˢ+ :gPܷ}CǠG@"b{%$Ń֣/6Y47qH$(:Rtlʒ%"UbhNL5S^B8-?Y=7JdOqu&nLcaqL=O,y+A,YfǜIu+uݎ#WBU㨪eo>QV)lK3UHqt#qck;?$G-q=M, m9uR(L`ǥ/=NO?sE)*mΖձk:Sa#("\`:&CqpB1WHIUDŽObYa}$)n_$%ᒒTY s$ɗuLs,Le:㪰]&ݐ0]{퀞?%u8wA$=( s(|T2V#U6t9ma;de)*D] 1D%2N^!{9aj5܎jKx %!5T09D]hBPU u҇V CAA:wδU>59Y~Re]7vש)Wg]Y.Htꆀ.vDtx>FiMDR.r@Uks/A+ξ+k2v]9旬 }hX i9ϊS#QRNEGhSG8Vo7Cp$qN_"qHN4EqR8Zs5f JBb4&eSo" {ԥ(Žy3`K5ní&SY p, PLe7כX!hqJ(U锔.'&{u=k)~Z/8mz7Ln aEe>Y-}Y=aJrS$fwbntB)^6tM^\hE/t%*/Pp2ؓp_uoBQ@mǴ3"7mV:]7U&5cT'R|ĪJLsJݴ(s ~'r!YoFIU67 2v[+cBl~]} "]c,Ӟ 9v-$R9#kd&1|7r~ߢdW+!E e$j6/KȬ*VVMvßI+e>3H8NzPV_KbP3)g=ya?.* endstream endobj 143 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-fitsalinitycdfcompplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 151 0 R /BBox [0 0 504 504] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 152 0 R/F3 153 0 R>> /ExtGState << >>/ColorSpace << /sRGB 154 0 R >>>> /Length 3656 /Filter /FlateDecode >> stream x\K7}pEdHCn&ۉgˏJRu 3)UI$ŏER~H__Oo;5+ow;=}O~i yz9L&CoCoz@!Usb~1_ٵFD3ߍ(t1x}UnC wo?ΐ̮5LֳsՇV/v^LB'&kg!* rsRlv#&;.وavVߛ'?;B6 ҩBv|gk_Ȏ/ ^mt:$E|fn C$2ݜ>=٥2ݝ>'r:ty%le;k{7o^NM=o [,wwӻLFDɴ:BDI$H,"MU0" mM8HdIN*"2sJt0sԠ F3md ^ !,&Vctv܊y+)ni1$HIt!Mg`idtPE'<]?/m5߹D> : 4Ah̋(ĵEgMPDj9cS9Ú9xlff ˥h0dj;迺x]K|1wԼp(s/j.j.j.j.j.jG9EIJfb);gC2۝eg&#{Tb jO$qȌRVs`@z5XZc2N/WH5A""Y4DY"zd$\A s㬈k"k 2)،OԷFOIؾMy޾3RbpeGb]jԼ}d v]}t07UAޫ#J0mY$qEDYЁ;KHA'EIY /E@XZ[C "v,V gCᜂN|V5>,eMaO6ЁA2 >2ȃ(E_XQgQh y8͔"-UHl~ AGéXփ~Ɓ'i3h^YDBQ`hy8lBJZrۤΐ\@{ xd&䑜mfs$&E_2#1Im?b٠3pHz=B$,ét$6#=b~C,EC#//nCyй{ y8Y  KS@2x' 1[^?RHbdxtN#Et$f 5h-k@g~"A~>ЮB 5~Y 1A!C*Ȥ22q2Z d\AFف]Z]AFK xȸdT:Q#dtd , 2b dAƗ. 2 u c2* >: d*(qȘd9 2F2V/U*?M| mAU}Fw 3 7\ӿ?~rzEKxO0.O3`zwswv;-9$pٗL,9 +yeQvtM*ݍ W4t4t7bXY[ib?㪉%&B5ax]xcwM(]dL`FrV!QmQnD戲6YYV}$6ҌMʃyNbFtz 1z34 )r*c}5dVvȏ~~ta&0\uwJKIiNEE }\X=q"+0'UᏂ2]қg|#9 )\ iN>T|$\)^L{f; 'R{f`tJs=_?W LNp;frp# y 28ڞ+#Ƈq#9Z8*}+:1SGM-B ߎGY(ݟF7H+$_B*$PB5nBv|[Bv|dYB6evDv@ jd uV&o^<?AylǙ~#$ٛ7/\/m^cxwaYi>o!;>9>o!;>9>o!;~}B6~YnwTdۼUzm^$Uθ95R6*5\-Ʀ.Bwy ֐L݃B^pb<oj/777'kr}UDkO¦!{wYB8EQْJC /NRj~ f9m}5dQ(J[~h6 Һ[~! QGѥC>s2L[~( HQGsmNz4@CM͂e(F` ᙴ<kg%UTA->[ bZBv|IR-|! -1XIWu٪6ɪ666 E2ƬUu@ 4U. iB#PTFu-#u>=U9Y* RuF U3TFYr q&!OpbЃ4=5C5ysdw7wlV٪GQpIjHFk2*q7Ҙ\T`HEk* >Dk&JkYwJ& EkC&j_3QU]&j_3QrmDk& clDk& aqc&j_3QҒLԾfPs$3QB? LԾfJ=qDk&hw2QyU_B5j+ÚsLBIY2_k9nzH8 ~3(4@ e #弣q`j]5=3!B^1QN3/qKEg1ITV IO"i5E-%㤡PV(E h!j^{RK3z2l\FH!WˬYC{fpB7/Q-[% endstream endobj 156 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 159 0 obj << /Length 3244 /Filter /FlateDecode >> stream xڽr8=_,x&[5f23Ʈ٪=hKGr}/(;S F_n8,''oe&581f*t2>I\$e^"@0%OnH_\?yTq|r};IuIUqډћ?,͒HgY^Tn{okX[G}K{;*WR`~Rw[. I/zcG'|X,-ta;{nčK<l6xjٰxy_Ư|!,~gv<;n|`Ŷ Kѯ aY?SCEdZk>);# L߰0`bR4Zw 3g1wNvd:T|d";wvτ!R,Rv*^΁) +0e8N3 )%9KK**Gɸ ~ϪxaiLC~øy@#=9G~B#=yb:*I4&s h$UŁBUL`7dB6 T@+g[ 2xFhe@T ɜ]0 mClzr#n6[ߺ.cMqzrPb x2{~pkuB`+Oc7Vk] GmGN13ĹMwKqVgQ\&]Vc:b`%I|ZA}lWkG[5y~t6r~[O%i5R8|kg2EkJjxH_/4-4Rj$ X=g0ى1jaHe:v kLHilu_9!e1`z 20d V#/":]`104xі&\=V ^{Yab [~ |89>l;IpM +Mw1JGƗRkjmaY]<  5*5lTѪnnO]vQi (By]r"w,l"g֡q'j Yf]1Ir=l&+F#;;AJ8L>أv4vNDt.̨v'Mc@y9QY|(+;)aץö dpDHᮟfLĶB 8(Eth,#Ft{Ya8K3pqAv~Nh.QXJ>Z+?@ a o<"QLۯSff6w½WH:%aߘRKt ֚=vJ 9 /q?ՙeY^1vA+ qH|y8ݔb+X &uŞͅ#V@13@5y1c @1 bA}ytR\%![cD΍\tM05bToAS3HQWTAƊϒ-)76(o b&Wv(^-rpuX 1[sH?nnpAή/%qٓZBJbԃla\s&ڃ!!N8)Gm9\*!%nX5[$+1:T~+ %W*rvNœRL!])Fd (5΀zt֓LsIa>_f+Na2EFr+ik­CUZuۍ?݉7ns%+%"gR2~hm3&-AR@g|{6^??J%7iITӱH`&`ݹv6Br?&sщ_z (Fs},z1ܠoׂԅȀ>";@ֶ}A^pH()dOEvJ{ȏ4G4Jœ=M!< 8[l{F30vx&> 4by璪IFnɐAbjURKT-`7K a}+ف% wpڿ%Lv9φ`'q#-N;@Ĭ-Oar C*5f* 1r>S endstream endobj 147 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpw3SFDZ/Rbuild1698e4d4c49c5/fitdistrplus/vignettes/paper2JSS-fittoxocarapoisnbinomplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 160 0 R /BBox [0 0 648 324] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 161 0 R/F3 162 0 R>> /ExtGState << >>/ColorSpace << /sRGB 163 0 R >>>> /Length 6884 /Filter /FlateDecode >> stream xM%mWRZJRURq<}7㟿||Z?h՟).Be{}/>_~~__޽y~퇏~y۫~/]]̡[5:xԝ?u m661^(me?i۷ߏOק:O[K-pwbPiV :yO8S)??~޷nw_.=:9ʭގg(ǔoGrՔ˰)o=B ~+߯;qu)%abA' (O9pcT./0)wT2:d= ?cA=Ks& ?I׏qe]_Ka._p!iwSXwcRd:wýǶqkj7Ѧ*JLJ4O;T1O)ewsǤyxZ[rb@=SʸJtb0g^ibPcub0,lhh51S>T`uTHr !C+ K}0AiV` {%zU֓ ݪ)["4SL9RN}Iǥ\ݜrŬ1[(N>QO喽P:2r1ƥL>Q!NSFɔ;dy=B^/LCzCp+N1!햲;d{<ѭrW,ۼ!@]!sݪ;d1Y'9?!I!?nr|Iz^Vv'w)>7GT!#qr,O? 9Gȓ>,yG͔;$hShScwPxUŇ-ϰqBD30mg?Aa 21?pDaKi+S cvܝ)AMqWHtωH),m@)`rƃ3ț$P@e@ǎ>3~)g<(sp3(E?g9~ahm 4;=(+@ )܁<8ǎˁ13@CcfLN.XWP22JDŪKǎ>,~dS,C~Эr`jy Rb4L1;`\ 1x90[?fFh(r-J43@>f~/&tq y b\, d> UL4A|h PE[c`*&1*& Ж@C0YE\G施\P3щܿ@ð#sa@Dtb7p+ʣ%?&6 hJDtbN?%e#sa"KaX#ss"ڿkχEB d e щ#^g"R@JQ#MU^~E\Q/AܠKJ>9rwM#uS66APNDnH;|bZV͢ At ӊA1y4:4g:kzD\nMeZ{,AA'KyLtw soY5k&?P/ڎWS8呞nNˋ/'e<8BF64T_ իFN=0}6h!v_=o߿,O>~^}{lԘkviۿ=&¢ёVi߾F4ڡDOOxNm$^޷gW(MAnP Q.P!̓UT-`z~mUqMHy[7Rz|Nrϻ@j>7_Xܪ3XIe*3_b ~*oAA4]I9`r(>; =HԃBz=T 7w"uq~CC|9[iBq ) T77 H((.F9R[#|18"r1Tt%RRHtgB]]^}RK^H끼/*+m/pd´Z;_2-`-pb4r+m{_on=Kk"r wy_F./1`@V˹>bTʊR.vD__2sK/k/+f@֦;6Ejt|i;.tL/k+fB͘nc՗w(gy_T[UW(^# `t?A/]i#_R1/\\#\.ܒ/4}O8Ǣ\;Ju|9wYen=*+HIK/ՏEKua.v/hD=`*mOY7׫6yNQ[J82ͤ-rKtw4_Uhx"z V_*/Q´"rKtݫ/tn$WKA|aZ|9lU]!n2'}`(Z{{y=%j+tJZKձVKձڝ{ླྀŗY|)k.1_X(j@\]o[8tP_cVt̮Vsc@.+FU{Z6ݬc-'%":Vvjaq4+]=>\B2M&6]FJRT}I>K2z5GUuc) KӱKӱZ[}dQϾ`VtguNz40ߪm+(>E.vAw[}->HV@NѬN;Q ~e/WtmԖJ_T7Dm-r .h 0ɴN[ByL4ZAAK.*^SWZI#6m*D} ^||:, KJLWh^#%ī.<6rإnSsz /RRxVhH찕+kQl򃖕MW([> hǚl,E.v[|OeEK'F{+hq<ԭh ^]m6rKtKkz/ZyVυ{E\2g;`]c&? E5ZT?mڸ.v/ZiD=Vwu!xmR7:@h& M]%n&m&O]]V_SϾ$rUHg`k9`]dr9$B6jPʯk O.]_нix%|-_Y 񃘼AXQ[JFm&Ԗk\]o/zϸX{_끼/*+w5ZTR9R__D.[})4-D~%gfсFu:(UJk$fXk\bn__Pt!N6 |\R^%Nfkv%nRv^K tb߲P䚕pm^HVU kdx޺lqm.v/~ٗTit=G)l)Y EJ!MhS]%n_ 7Hf׆\b7|wxoyD̶A,D׫8j.HFm)D#g8}IGнz_}lr:3IVAר#3k] 0jߣ5WZ>kLO>13avg|tFY|~x@?~nЯ/Ч~1&c&E詵:~@>–>翽?vog|-]/[J`ԥq}MO})m?o+rx[yK V5XR5} 9m١0j'V^jhٶ!8kml+/5pf[א%03jH ml+rb[yK lo+>qEU+eF ٖRۡK l2n+uԐk6TZ`f[y-[,ca.'}J|?QCo(R\$-([\z3gVeѹVƹLƌXZ射7h%XK:U_6$,7Ņ],l+/54bI=5$ǂLq+A?ЦtLVs&K1}m sjJhg-Hx.uJtʂN/$η=ҏD'<uNOKxCp; )ud3o>uv͑WO$Y7r 1{nNk?לv^Pg8`W?4i qÂ%XlgDc>5 QX2.c̉WM8s}^bOcz"? xc%n̼ oF_3@zɴ]1{_2KO_`J<`kR;\2G)0?<͵K=b$p#/95Wzp<`f#w0 >F>%Ӈ~G8_LBܽEQLuyĉ"_\sk#ƾ΋(8ro8w-/9qDy̝Y^rgf^rbY^rɒsۚ󘎑I^rɒ?47dBKy=(y%'nμ\3c{n_uY9J$y5#/9qOZ^r9č?"iy5#/91V-/9!U{ 򆨇D.yɉE8*z='Y䚑<~K.Y7o%/91s%Wyɉ<k^rK:./9sYKy+%g̚-y%K^r %gu KK3./9s$/9se{5/dK{.{k^rEKX^rړ5/*A3Kμ%,yəy]3%/93?-/dKykyə9ޱ̑%,yə飚3/9sfּ,y%K^r <^-/93̼䒳3?O-/xOɝۡ:؀M)zrj&xi/MJK_MV endstream endobj 165 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> 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 168 0 obj << /Length 4940 /Filter /FlateDecode >> stream x[KsHi0ѨB՗ I-X@8CMmu>,@PvlezWV>J'<~MqRFefgԞNgYhuNQjlr5uc5P3U;^WC_lTRFʣ(5 :#?Ê!'\ïqqc7T6~|Y8i486.Bv.ϻ&De2Tش}qҍhzO0͉K (B MV>jB\Ts5;)ڣKb3mA][n8ڼ# v9<5jh5ۯ8s{4uȦ+fUKA%*,`V Y WHLT˸7u8٪ÜX]eJK|]H9l悆Z)GlC$Ϳ)m^RV@ 1ْ$ s>N;F|V4+.<&{ }O4X:iJ?S 6Tc/T3)mh^1С{!5|e'E,k nb qq t~|,s:405Q;!H&N5_GԢbBX٠+ཨg"uu{H99f:gXBlkl-|pkOⰥ߾i- 3. &gS; sˀz!O V J9ɓV}GvHQJ$wܮg*Iz+,';B9Q6M<.M>}o+‰N`Ī4luap2\->cIO{b[o `5wmN{X2nr]-m?2%*F$\"on٬< 'ٵ^#;G< 'I:*ռSj~[kWQz=}%Fqn 1')& #(Zyl5u uX AmgXC$A*{v1C^nH- 4*ד6oQo[g&Mce;'.&03k?Z,ݨ ` EO$ _ZS4}$7"F>j۽G#jWg3`|CMC|7i335aSN}#3"$]Bge]61(u[sLYEAԲ5){u$$&XR#6Z-/p=QafjSSxj'ʮ8>RG-t|yxd9BU}^bi\EOC2ϬD J32-="a.vW1}KeeǎB_1 &@Y܍\(GgR(΄d#}d*9e=[W񺆠%oGфSDebyFLai$<5gF )8jvGM^D" 02md9WuS%}zJәCg߂piy%Q,VFE5xTZS;" |F^:ADU In2 Zvegƽa=nK]®-1j)X+'uѮ2]>zT%&sW]<YDiT~V7,QT9ݜ&;",Ys3$Qliz:BFz+炓?hVJi$/| "lƪZ팴R^~ma@Xn9&jY.L q`K[ \~dSE4nFm]F56>Ufh !)^y/]E+6r@ܽ!6@Fe*gݽ)=^sdyF i O]5Mχ-[xs]%C %l 7-i7hH\ߌСUK(5qKq5lf3LD !®):uuZ>/piΣ^e5mRuLښ/2K+DI+D&Ʊw90D/rW P,Na XA`X̚NiᲰFHQ6|[16Fqf`‹lL/QGζ=PXop@\"*lю H 9a ؁ù}5Jp&›ώCkMŇ `(Lh@rKSۦ %0-d+E#mHz6laeIl͜1Vu("+ŗ6Pފ7A3D"Ak5|ijQZb+rHbpeACiv$xC|.+efUO`>TI6~/0qv"zQ#`-o#dn(IPvY,[Lj!-<ţEs:w؟^w{hxoK=VBO\G+-at!ERE#v{e) sQ8לE]h.s蜧j]@yk(umS2Cޣ=7c$z5|O$@N9<\zhFr֦QZ%b`ntɝ1}´U/H0%"-M )a̤8Z CE;6Ryh4@|gSuA@$/3r|I-] ^&x_$?cItMB;N''L(,9oĪ52Xآu EahT+دWMLX\f:Lhu}ԶDY!e-wXxĊʢ_{I(| PJoM&rYL4lޢV->[]giidrͺm*F )x7<* dH>-mN!iF(O!Rz4y3@Fp$  nr3撫nmjp@XV-_ItM-gING1tT,XjjyP3" 8,{a8tA/м~x/g D? QvXs?8J@ æPnWHLdȥ2.gitqj endstream endobj 173 0 obj << /Length 5067 /Filter /FlateDecode >> stream x[KwWhCM$v)q%%=iDB$c>Tc>gh;]u!<0~2='I|}חIԅ)NNIrsRYb3{r7=4-oO.KGIԔ=\trNn_fMf=4vvOF8E.gGvZĝQm^ps%6]:<&,\f4˸0\/AS| >^>w}iN+;j;YN}deI缙)-pi1s.Uw0aGn~-_N >}ŭgRcC~--N^ߏ^&nqz{eE2cNq: @iA'ͷ2TP02rq Ef1Goϛ0tЃ䵅z`dIA;!?IWW5n4-<4^AO 1|QKܭm]k󖚜bB;>N ߳69|T.44s\Ln@)"I;I+'e- m ;EF@L BGMռtܠw7 pXpgt0+p+8kGîD{9d9ʟ2R"->A5o(H-/{ Q?Uu LbJDt\y?/-A0rQĉ_ `ϛ#JLˢu#G %lď&VTBfuuO-K(d_ҎfdqYbv<ݰ{mIIh Uu I`A)XA)K 1F|yv o^@/9'U!ިH +2^9Ӽ^TZ[C@_o+,$>RB 1Efbk dYI@nw|Rb6,pp}N㛹 )7_$``^y語+E @?4̢co 7IHs6WzR4RQ554$ߦ9V&n5oYZUIϠ@?7>3bkXx0e}k=u\Bh xx-rAOK+q?C{i2{ 7ԀF@ fOtt7'q6e-MރU]D fo*g$/݊ɔ!0uI_tWXܧiޅIb;# uAܐUtD[he|{rK3=ϤB7.g[npk|tS~B2ɮ4~ےnl5)0+dC5/Gr!UT86dA5Cxv!4~?Q}T3}NMnN]eO9ذ 9s'Ite[^lkUv@'N$7( -Gx$ Iߑɜe-xF6_RD>9nT=̓8ѐdDZ\uHGTRdO8<t}vb' 4٢`L9V=>}L,n2Arcu/QW>4Q¼ҵR,:RD p* at#jC4#bĄs`N4{U#n,#QXn0 UޯRQ vs&Rd͛$hPQ8 .by␠'kj0DOQ2uT pƤ=!YD7 uJV|t.R .tfgó tWmDu|p+n!b.b)х/ s"f?%a9~h2$3QcfʉP;1Ny%Z}=B&xQ$\22F%=Pޑ-jȪ"(ͼO|Ub(_UxABl\".]>'C Db&㊐a+vc )/ZŝߠD]`O%1!YJҕdI5urK20 [-&z+7zopy\_}~AE$ېľfgrSAe2UE!yTfCo>1o!$ASIJ i:]F.+=8>ڨdHj; H/q{1PȦWܱ 7>;ՄZJMTkth&=RBf^Gli $Fu߫#Hje3A[^hc:FA^Lɹik #~oQVօfQрs0WTfSڣIo,y.B*@sǖBw?"*au j oBi5>nֈܐG2zYRHextևvK,ؓ* qkq|>eI$Iq :Ce[YȃGم.pV;wEPgfPE*gyVH!߄_vp̢ps%VeEt9>xk= 7ZeM'n+fLuזRbPJr?zuE}!d>ϳ; 0 ?CAՑBҎA@FZr\n!uv#cPo'9_AL'iN%m+:O&yL5N1ݝpM T]V_䋟BʿnC}.fd{)'d_9%q p(z\{ 2sUim噷];Så@}UJ/F~E`;ƝIg $@}90QFi-l{"εl[nܯI;JC?`"M &kIIӓt H0W gl >!^&69XMkفsu~r6++Kz>2i7%. endstream endobj 177 0 obj << /Length 5238 /Filter /FlateDecode >> stream x[Ysȵ~_X5D4yubiITN Ŷ?v7@UAbg΂dq):{v_ߔ'UXI~r{b0KN(8=OyAdj88 Bglow -NWhz!v}FYWIЌHvetY4ϸqOwq=3?M<Е_\\)Kz<՛ ̀AϓJ|22>0d /ׇ}S8,MDu4 ĥ:=6kz-KK"W+Y4 D'%6v˓3hTa W.b͖g䉐$:-2,t?hxEOoțIiwpES ͳě+pL8b\g;%=SiMB%8k$p΢e~|4508\A!nSei LsF9!򟕦$b-w{n;W&qqLDç5O8IxF9((1Qu" $aYMM j2zSK(w5& ,E)mT[Fr~w8k3\D+݌SɼSdz㘐M2===jb՞cqVYp;ŮQlhkTM[ʚJ!{xd'zZX*ێ;D}̸jݚN,hYoP j,/eRYKz"X&MLt3JIEdӲ #/H=-Qd- KD6<mޓodȽJ;u.[N˯o^Ԭjnc#tN {{=bfMg$ Ӵ*IvjXl~_FZbL (֙qẠJ2!eXf"C(0{D\(ńeAc:Q 6? ~i ''7ɞ@^jB_,[796/cEphyެmĺSp/ id`3/X 7dݣ\ݖ)ӶFb'42 ~{vf}̃p%mlS)m*aO$ŻQ1J$4UZX#/ַ%< 2sEߌtfdĖ$% [Y5±jVO)N 2Q oq @-X2ى4-4 HeObvx1@Ír:(/ ;0+!sMyq%0TEB9A)xA8BlQP=J'YSқHIKeNоn[j՘)d%TtM ]84k#ݐ_W] geڍli\iLxT jxӓ&AR_;sI3¯5!Kz~<T︥Z*i2.Uq.RyǾ Qa|lLM\JW*`"\r3'WlЎ$,+=0Q^K ~=J ,Fx١X[,g> -x CyL@beX_|&:ealw5V+)1z AЋ@N\|dt=2D#LhAEG9dxv;f%C: O:`D$8 )bxARW V:{1"X"ǵ,>mz`AQ3ֹx=7ll=}!VyilIY#!e "UŒMRWtW<A2XVЏ-wZ"2 (d!ɣ ԳC2i@.9Ul61-6ΐsFFs΁4!RX=i~-p~3Q~ܢE8d |{1tdž [ƕ*xa4s-sLQXECʗ8:P+A$7U+ )aPbͳ(nc(\Ui]JѼ#C?6_o;btYXeiı"`lXykj\Y"9 4k.}G^Uq4*ROv}7^vFRb&X"I=YGF$^̤GYiDK8](>[QWb4 ؘ0.~f<]/I\"m|ܯ~'5 Qrr| NRւz+oCrYvuȬyدD{ 3c-ힹ4av<%!kƍg8 j13=t>rLUfqg팥9 8FYrθ{GrtVm5[517Z@X/8m^9D ı ^ivhՍPBΪǗEl)F՟Ye,{l Yanޏ 7!2WqOd'q)VNWPpya7K <_N==fA+4Z\V=I={uY[Iҋ|޸"t) ncOee?⭁M:Tp!o&"P$sI x8(Na 写 S$eJlrnq lhVnC丂 ^%֪*Rsc0t4q,LMc$CcϐBZm9(mEDyj^S::48)r\jcUPoYI {,O;@x6[ǒ BS0חwC|(*}Ǟ"WOb߼qK.OLE3ɷ< uxLsy(ͳJ@шUd\ٱ :,\ˑJ 7tSbY#HCλQ!z6x!,{YMV:ݫ뷍61/(^_t[)(W2rw"ب0pmKc ݓq,qĽ::3- mYDHM[ŝVS̏DGcoF"6W'`> <*x|G0/ɇEYz%Gt ƝBpfz3,}W.@#.94xnGS%r zrUҋM VCd.://\/F(|9Rf^/FptDIR%aD>Be6P$>y+8C^(f~":0W*;$5jm,e値|;+25WQ|{Ko֧ڼ5ibKt8]^5+UVe9r jB }ڊN;\V箚GkݱWa$]aR 7ښ'|˫;[݋RKUQP[9%3K M(>i-pΑ`'Մ .xB歊$FϋJI H2 3o،W{=9߹c=fv~œ Q;k4bYvuh+[9R..NMՔ{Emq&Ϗ&Ŝq̄y1qs-E:<V}Yh.N1J֔A]m' 9o` cYUݓ£zJ=X`۫_Tv[岓-β5"YW%e\P2й|U7cy:*^Lz4@03ᮝ"2x"}o]m*:ipm $> exxds^9p})ժ֡b7\)ACXCy!l֢wMʶ%NR/P*)U a(`|ymåƄu 2XBدGj0)Z$^րj88:*"%j@ߋRP+TalA "HY}&ʢ?pkvW;el w4aZ:)V>#H~ODmh%JoznrwGRUaz9*)ܦcmef ZQV=Lzh_.5/7INU3}W)]~}\e7ޫ3"H8/8T X&GG~7^z5G|jEʰ=s%m k5!%3Z9 dl%Y_Ս_@/2b͵=K(ק&$( al:_9%LKfa:²,$;z}K endstream endobj 180 0 obj << /Length 5161 /Filter /FlateDecode >> stream xڥ[YsF~PabPU8>W]"!EjRn"oh:b$UYw_f%Y|x-ʨlvvsw(gEl"g's3Y??b8=&Kx|j%RK\amI#Ti$q4_66^ W.|Ѹ (7,ϧ.N'qϓ$w(hoB͏x[`[lYDIYі\ԏp|a_dy pqf<./ZaV\zB{q8pMA&F˙D6ϦDeA*hqXvP9 gp\ ~'VEȮuH?4ܜ繴"U5AͲqpN\.` +g.?Z8-"[-cGt8 ~lA&j)-CaA+Կl=IT}b`>byίY{}5]IAH`Ppw6E9Ձk>+4wάP0˒/8ĭ6`8rҴIxh;4> g_:%wugeX\IU> WA ΉJg]GlrHK$2iWfs69k \|M~jqS"=twG{<ՁyI]"$K[;J\;p"&1☉8&*yl_ry4=GFocc7y/Oo7gc9Jwmujd`Y.~z֫PD:|"sjVJ)31e4FƺEs5eJ^O+Tkڐa ltuܤl`cyTZ ܪx\5o)7V)O$r*)UU˗̔n Y3Ggc;~[ޥȮ7ƠvPn޶fx+)H=ImE>eIZ6;`sV%r"AгY1{RԑInsޢk^ ډKWEe8d* ,.dL<~:' -9*y=㻛|*SXB[ >L㠾~Rϡ::y;3Q^ǯy"6`(PlTU`ߡ`xa$.M fLR<1AI*䗵 Lȟ 3 m׀֣(3Dw)P2i6 vC[vFT  _ WLCEyxVN4l uB毵 +w-)KCWiXCNj[/  gH4~H(c$!JqNٰTjQx8~`2=9e> Ӎ%܁,wrdkLy V(x *9g;ÎԢ MCudY=W\sǽ#E*݅5!3{o`:($#1c9533%VW HS`^m#a>Gi8ު|WY!^̒پ>C-?);gAIz"qK(->X hżvF^S=[WG՗6ݠZgi¥<7 1`Ɋ,̸wU3]Eji-oU*L(\q͎e lZ`e4 # O(<zyOaY )ӷ(.9r.?i^Հat){8'o׀MZ_Q83/(u7:`MYжڏؗj k.h:!WHGXm96ijޗznQRIvp̢yDfb&m;@8)B60WU͊tZ$V0<ө-]աE^\>rIUXբU&đdFXS+f2 ϴPEyF<\tr觲fIV֧HQׄ%Nwg30TϋJ|H-E׬]ViG/[֠^0\Td F K# F\D)՟rH\F̓ 8c'1`hw[vR|JVLVUFg5k1$B@p--j2S 7B/?Mž/Ѐ7B% ?JeFWLOtr9΄㣪sq`b>%OcIH&~i~6 !46`)(G˭o'k=ZH-ǯRSQҮk==NCfe6k =L]40{W" 5/*L'iX٣2(cK[!ŚYVdL176x3?x 57Vɥ6qܷry} @ޠSc횹ԁR8 rڰw,iԾ{?<ӌI>x gܓcGzhь00oh@ֹ먙@dGg>(KN@[,)_̎8l"h~RJg\jwmFC+|G1jJ({̻G! ,m/|҈WሮOm.}8;e/ T]˻]pMpi)$;m&zy!il_{:Iau;x rt̵/z:h렿6N~j,MgKx֠qn)h/0LiSOfJ5-&?hZGY`[o#{E*rE2^ԾCV*QuV[9suS N]_[ A |$#J·UP+.WF&ddO5vdp@w24{)"zz.;6 /(ߖXw*Abbh2fQ6@ߤ=۞5mU\Z+f=}z5i~ {va.+R=[64jq;a$0QFYiChծwL-enjWd7K[82E/ {ڬ:_<ՖTIQ|Q9 XA?Ko(ߺ=#N z+A1=VZ]m 9eghaC ?_wFR\?bA͘;o3_/,žnRXb]LlYhY7Z3_5<ஶT?ȟrD}}bEeA PE1jeݍ=/v;nƇNٓL(@<=Ij#R}nW87Ԇۏ1+ģoV"mal+M$BS&xW‰# /4U<]B8a%]NTU{C!+/Iڨ92Wi/:_Qfۢ z1 6/^Μ@WE u:&t ʣИς tGMHL}[w ά N=SI֠'M =R܌\HyCyy3>_%{`U9$'rXM 0K8b&y2&;#⸥n8ޯO$״ EբWHt&gQء[á#-}N1Oai8ck\)_#2o=|*G E.Iŷ!dn)}wH ^GaA&},'8Cb*8HМaB^/=ɉ.@ʗ|irڅvrq]93:bN/,&͎~At{_{X:@Mbۛ 3Y0 s cQ@^ c,ؒrҌWOb4 \>luˡgnK&iBaȦ6ul+hX?QR:}#Ǽ?+eߛu'IS}GY,⸇B{ %OsI9yVj'U!t!qzM%iþ?wҧt&a0BHҮsDirm%ÅDsY 8W|Xv/ PMM0ʄAOWft5>~>쀭}W͔q O 苽RҺ3rd>$ z:.K}> stream xZ]o6}"]~s ɺak؀ ;;׉m:x L\CREOJ䊴!"iK#iOQ 11[3@ų!!'cSd8uf}]FH*E4xFd|IYӑ/YK*Cc&`HxZyC^Q$=o #p$E#)082 OF>Q V3EqWw.䖢K!dù<')$F͒. o V8rx;?1v%G3h Saf4V"X1Qv (i,p5lFJT\(k!3vD DN` P\aX9a@*Yp5`Y3S,9ua b*х[b$S0#~[ƴAjY,:'-A B0 KۈLed NKH%nV0|pp0>}QQ8tRWzN0>TbVVsos5_8Gv_`x?ēY~j`VJĠ*^%%WI0^%|wnU>ʖ^e ]?+Ȫ[`y/MˏUM@ e5iK5*trT}sب+(ރ鰳Ө8+.9[zopQV3)5{W}M%koC \/%/ŹAWf?U㿪zTI9&g"‰Cw[-~z:=J!tR2OV/m[g&OMB$b|4YŴi-R u>eg*+E]ehV.O׬Uv^$> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 200 0 obj << /Length 104 /Filter /FlateDecode >> stream x313T0P04W0#S#CB.)T&9ɓK?\K(̥PRTʥ`ȥm``P73`v(PՓ+ L5* endstream endobj 206 0 obj << /Length 135 /Filter /FlateDecode >> stream x3631Q0P0U0R02S02VH1*22PA#CDr.'~PKW4K)YwQ6T0tQ`H``(`   ~$~K  dE@Yb..WO@.gC' endstream endobj 217 0 obj << /Length 150 /Filter /FlateDecode >> stream x3632W0P0Q0R06CB.#3%X"9ɓK?\ȌK(ʥPRTʥ`ȥm` *og`?: A u } )v endstream endobj 225 0 obj << /Length1 1967 /Length2 13211 /Length3 0 /Length 14413 /Filter /FlateDecode >> stream xڍtk Vc6+6Vnl[+m۶i؍m=9?5Z5}{Y$ B&vFv @Ff0̂@Ar6B dg󇁈LN b <@Nff 339D ]A&YF#=<i@nnNB6 cC[{FcCk1pvabrssc4qbs4秡-JN& mLaƈ@P9#W3sv3t4 AƦN.&e)?2p+ogCcc;{C[9 dm atvwښehhdoj64z7rC"9;읝@Qd+{lMDllLmOhjvN? dkb {&U[LEM̜@؂*+3񲷳0 x9]L}ToL@#Ss-¿Ŧfwg`'2eVLꄅ^ ,vf==`OJٚMS?A߱ާ@03?.&(oC w[MGmhк8/_SuVꤜ @M9MM@?rտvdk`R0}/[e7;_ 0tt4@x?wo# `bs~w9"u&D N'3I_ `qdE~E\,&ѻ=Ὲ d/0&? d|Oi/ Ysq`/d{]3S&޷d?~ {p|p{2g G?^\\\\wo?{x?{5.ߗDajnj8gglYqUatENG/ف뎷B)}h+Ũo_Z`ڒ۟v&&2z8xXAwKS;p(bܻ}pQ<:3s4CjN@,EQ/\Rg"8Zswٛ7b:/ ؇_*,N=xxZD7cS^8^s9#↖'Gꫀ\)_'8ZxB@IE\BQ.aTK6\C{x!#RN7s|MDŽ .4|D2+Z—kN;5̓!/ji@<QՀ۽tjsPZ5wh6>up++fNiz ]_N)Жzj-@گ1L%Z[6Ca#]-A(נ*Vwe%,4G6dh)ߘmu;ՓvGv{ƹ6*:zAśk(r)G:QM|>PiV`&o>$}kUXTӦ\yg.5daO#bA;Z_49$?2WȟSPO"-Οo|1MomF.,O;ES㔹Wnʊ Ҕ?`O usnOŕ.񻿤3/>UJ28O7Rqfא V H0ۅBCCЇ(U8[E5 gr.ܡ8t(eW~t.B6l;K.U߇},myƛ"2Ů)\&皬ºgʯu`ri2 ; 9ჀLisCdO }l%߳]Pv+>0Cxf45p0"۬N: t\%~cǤDϐ\1ܥxaE&9'lxd]ɠ g>*01@c]'f/@X!jqLↀЯMYgy^sRAG P]իNcAD% H;?u<@O.X8<(}Օ?l13>!v4H?1/Z)[g @#{ٱ`D|jۓ5Pc~ :^ G[lyIpB5'N$F =zG(Sž19}En. F19\)k :>v໶0'^[A aI~-h ((}*|!U/&ŃÒ񅙹i6~T XCr"^ID*'$Gyoé d'O}f^@O:sު'1y;lW(iJ{%!6J͔?vrFqiNMzW:}prlIf_n.Kn(ddE|"]ysjarrofz'xtT=DZa=jFYXPW̞4PG}gڇԾ7Ћజ\S-EN$_#ERDqqPԽu>N0WP!OB~Xf}9MW.)АbDfEPU3 6qgNe=^d\j%SXFTIyaiTlR!mUckAm0H5{ΰ䰝Xm0xly2Vⱍ/+5RMI ڒ5($þ+aJhj 4!ȮC3Dw\B)X1p﷠'ha練fh^!3A||-sC{eF3`~UG0FH#AZ+}]gΐR`05ؔqA\K1BLt#еz/YHz3!hk nnK5G'+ɷE@o@_QBՎ݈s( ٜv:ZSnz&ËbYb:Vui'r̀K%E^5NE:8B#p,@w fv!rkI,Q0LN)V5 쿩'=}ntPZΙB)/*J2asN%SI̗cΰ 3䃙Ty={jJ5D9㑸ܓ5# ]wC?GJF,1 TR4Wfoyr~[ C1D\gfy8c2fv PO?.`m;4^+^TMX]b|TwDW<2KbU~Aw;-#ѡG9βvRɰ ̦ͭbL?Md$±B3 9D=Ѫ.[Z`DtlBI;>Ǹh>h;qֶ-Q4p7EMMS!Qu҃I 0Ld.Rck A"-r$`[wi 1#Y+ݹGJ-t(&Izёw0ZC"a3JB#ގ w%$Z*33u8#eKcvX~şn'w)*ZWK&T@pVg؈B)0WNi!%CʼnN*vk6ZsE bXGumR\KBgDddsgDE iU+^RC4ZwB)J-*_֑ ‚v;f_MryEY#C >Tw@~Ws1lRTd/5 T_&9B l5᩸e|1L 2XXJ-~,30$ai jgajj['t *!^Ω-!}<:SMO Ԡ,&VOl%h6/~! MR}DKz9c-xTn!;uR1EG|iU%:ԉd1\?)3by:$g')`Ò_";me$۪, O$>R싻[Qe^N˔'_`yX[1Lo4WLoT$ଫb\>&K>q9ߝbU͟z3;_R !i>twdst0Ds%WR䓷/JCvsVe:Q0H$WONl~5кd+s=G!ϮjFZlTb{1߹t|O߼2$Z 9yw̆Xh76|!P+ю,8֝* lH$?pǺtj^>)zݢJz!*֒e=Ľ3/S>\CZ,\if/LF7ᔄyS0mŚf0\kȳWɽghٰ}Rݛ0/[(.Z>XgSS8c D^F$+G2:YY60P(ˇvO!֕Nf]q~u,E:{`M|R _x>~лp|i (.ۻ$.Ĉkc/Wt(Shu#&H(y?ol*Jח=r '!'hO9bN$">B>Ӏ(VM+HL%2J{V }O|0 M +wQ\i!~BM2e/,9&dCW h_ 6ɴsߌr+-EѓcWDZT^6PxO$FAOaE3=OмOC<#j|:n ?"#MlŇVpP2ŕӭdu$Q6^ߢI+RByCkC;{2,vt33uZC_.RmEv$ɧ=2c;fg'7zv6xA@]&7l6誊l&ݼvi>}zh,]~ts^6K]Tc9ٽyK3[3~CFՅeٺ&yi "gxP,ξ9`!3dKU>Qy\z0z^x6S3sE8mS(cj}ƣ۵h[azpGWGgY83=[S2Jqi3JO&f';-B|!Zs Bqk ^l?ҭXueD 5.30@ID] 2o?ˁR],(YhrkQ/F-OzPPcbOKFR:wyWvI8y6wQoRAs Zy)KAK̄qQ6-4-21K;M*BKzDK&8mzRљc~½IF^K!KD`ӫXy:$8g\Da1#h9}Wͥ,VAcHSܢ8z/Û9 %i eǺ"J% $)hH͑jSc7~C#W}?udd3֘#YtB0/#sFB-n:fq|^ɶ?6C`XF\46~Sݢ!ʘ ĎA|UU}S^<.߲*g!%tP25QXR4]mU~@Z!/I&c:ů.¦b֝ ,)bvi[$cdWƦU,P/Db|U L2w1ڦ.h 3RUr#On-RׁO(;Dl!n!>VǮ2:j)+62*%^`O~ N0+ӑZ-M*[S<@O&Zf+8\ g r>mM"5> 67;q`<ί{Q7Ty-)1c+7Ac]e{zdG<(d3v7~5;QS)4qdg:_wDkT<M>a)Z-3e_|FQ'4eq WᡱuIe܍Pu邐ZAB=kbvJJEayt+p) 7T6sAeTf}P @';C[kz^[|OJ<\ݼ5%]w ɨaU#5dUp&C>j|#M5@%F$]vY?c%䢳dx0F!C]1 eN^E9&\ׯ-_s7Q(ScYHKa!BU=ّSiN 1 )*BJzGDY`LW Pdp⤂Cu|X$W9DpPemj݃~xog5&n -Ss6o&87cI[jog: U {vR 7(sb"4tlTo$} V+sG[1A+&7Lx2/%oKS7b/e~ v[<<Rހ+=>[o/N]^tќS¯Ԏ]ǒR֥+ }q z-M|ḬE_OPh!`2@\햠 :J{I3_AN$rXv-^U~!|9'.Uݾ/bJCভ%n F0npg-U~7ro{i)P 'z2nObP+vAh&5hs❓^jceW?=t}7"8!M[D-j3~qGKfU:Ox!Q k 0Lyf^:AJBh){3ZzgW\i|+/\6\qK#1 e[BYɄkUq8O߇pF h_pK}@)E9o6 e&v;0hv"SIe Yb l:EDW+lOeryYz Ks)  ~.âXn}4:@ &!!3Eyfn Ugǯ$t\\??n% r#EN(FEm6 >v*^[όZNEnͼĿВHs&e[U,歇jE2 DR0mpW?`mZ}=r;kY^=|'Ĥw҅էkl! ^jo\Nľlˬy4 5/O8]dO_L ͐5僣 >:^7Z gnX6#6"'N_aen3'`rRuq\6/@4M.isaqo_e<8 4v#I){.lx",,>V%(}QvMyb3!C*z8gOY/ȺgkKC&pg{;q?g&1p7ђeu-elǶW0ioń82醵t~R9s=yΊzC*Bc?H,S4&l][]DD0l{pxb pD `8D^ or y^NBNpBL^J'9FtNj{STo)秵M @8daBeA0 K! &# p8!*yX)z*S֏հq)Gr<}= F D+Q86C0<pH@cM/x/ \FO8oCI8{oCe`3CdЪ"Y^?_a \$Q\f9@aCGB{k[7_2wzӺdș(jW.9$KlͷWV8 % N!ChĠZZ`97.M];qT*y8Y~lCp>Y-p?ap(roܿU݂,BAWF XMp5BSNFw 7'Li7`yi}ԁN6cXNA$JU_)y9sC5pNFuRj;9um 8[@w~k7ޗɒ"Kic Zį~ L݇6FAkrW0uO+m&DM8UbGzy Ve1tOˬ_>(x?+-%1 ɯX G̤]vO?GLn_I =7sw^]Y7 ?=,,~WL{8yd̬Yv'N+,WBxе:n,hfmF2>i+ ߋL{dO󒖨%`jT髼u* #3Pܻ#AD*d-l^Ty~V}FƱOEycJ4QTp1#9'=R%/W5>'kOm7elxǶrIkCmC @=6]O=OgNW1y8˯>nmDxㆃ;J.fZ?L@Q\Ʈe5.jĊlk~ \+y9/%no =Wfm,_CG9<8Bժ1q["a|[KӚJZ C[0(릱[-$ ! eekrsf,⌭wc=KYw![XyfLSpEK nJ[:G/gSFkAZcHOĒ/*( %u0oXY-4Tϰ*Kl^͜C7r2#oM =7@hl%d՝A4ș5a,_f%+&50PLXndž<&xKAS+'jidiQmRҌ}G3 ܏̈́϶ƕ$s!P(Lġ;4e}>qP .jc;L׌cwˌt?Mf&^=;npX* 㠫DXTfiQF(|u14.#w-z;ECGrD3^O:$)P`(g G.p ٢_K%LL +:PT&e㇂pZ|WzHlEŲvo/!s1G$GV[S!g~Ӽձ.Jge~BK Ղft/+"|U48[y{*3URz{ـL9דK 9MQfKPC9#9D켤FNČ D4Iɩ >ob>DqLOH@߻-g &`n5mNW 癆QUb0` II!6`R&I;"虶kЉ-ķ# b f5^NkP5YEv{xVeVg+,Sp f98eq_Tcٜ$ꖕ.~I$?vO9_~ d/={5B&E+v?C(vcݖE8-r6ȰK`"<T2,,#~=lemS5$&Nt"y^XAYz7"\pʂ =dieАn;NNeb#,Ӡ G `ܾI";㛤Q|Ji^&,~hk [d̀C"P*SiڵUj6[>Ov t+~,"D"= S}_$NKeV\.&uBi٦;yjuGSb(A5R^D6P4LɟF}˶2gḒּO ٯA6MI(a~$]>G!0@o6֚#p^:[K9M 6џGp#_7ՎQ u$CߕkFN;gC _;2eLEx hYv5śE0Vq Ҋ'1)Yu)wj^sɃR5ycuI"2Pw#W+AMVdY=Ǣw]q#CDE&iq o* שXxTtD͒!Wf(^*0B~՛Ѭb؜Q&|\~nMͼ*:w[[:=9{pŔ> stream xڍweT\.nиinh,XCpw ;3^]W{H!e 5C!pnN@FU@Gy9@,FF0QsC!"@fG \ܼnnA  d\UNrb:z6Ǖ ``p rf𸢅=@j=+ (i YpsY~ P3s'#@Kjw3{U ȟd? 쀿w'C6:8A<kPWᄻfD3{gcGfy)Mcul;9q 2P>Y0 d\[!V[tq҅\@MXجAp? w ߋx8pa~zl=ay9p ߎFXK`ChYU"~3}ԙ%bW4TgPw0|;J,qS_J`kPXK `oR,ߚ]`01q5UT@sS=NQ|@?`gy;R S9uϝ=Ҁ:5Q@>q~.,r `fX^܏i rC.Nx`a>ZaAoӟHe7]?eo(|L/ >rpsݠr?/v{.q7@ ihmePe7>ӈs M9r3YȫU:;ݫHfT+ vQ*.yھxn37 N9X fs!%ʻ7$)JC/k> rk8dZ$MN85գ{hA~t zpj{{O,bVǢ!qCU{<4w+?Iut"#ERnNY?l/?B`ow##}3w;@p<ڒ.!^}BӤ4Ħ3qg" ؟,ML:+ w~/\Q8" /{-Ss|86">#ԇj(!S"oTDXqQʕ́|ۓ4.r*;.{[k6*=- 0R]҇k~H`UF q|rq!#9lI/LhwȺ!|Zz2T:k6UNI8[J66BrI@ʯ?q@T'If֠cZ>hM] t>0mkT:jl?\ f> 4X yq`HПP`4K17PPQƆrܘ].f|&ڱi`צ#t)ISdλMMVuMTt&vɏ+ !Wsv[|>G>i! AuYUeY!dECM $9 t(/K׃Ls}f`<*;%9C g6΀3R#XծV9"Sb7* tDbsiV6FH|d#"0=fu%C1uQN7qS4{0:4 Ł6Q"ZobeQsSd߆Dç{k,l1N]0$H$;#Wȶ"'[;(`EzV+b3}ꎙ_j3HuqB- I&s%v뗁WnU~: iH.BaZD?T^8bk/AД)kaGJRj9m%pyt=Wu0`;$Y)0N̏FxJ5WEC6^ +MRR@|6dQ6PS+<y5e|b5nѤ2*ͤo«ϙ΄ jͧA*&rh:gtII~V_e͵7PK*sDSɏl9;{[aD~PJ4Wa`_Ws+o |ܿw<[a~7a, .= Mf[ؽ3c׵-;4i𳏝"AhzFeQ߃@0bf,O'k1H9!Rb׭>w ]wCeS/[Fzќ; {lB+ 4xN |U*+7"Yv/_7C>i2u&1a]0S iW.m9 5^b.H #6pe%Wd6u!dU4YL>0\#aL?*,w@!!a!&BCWAfSW{ ,yvGholZu{Ӝ "GWakMϠp %dQ{j)"Csv̐5~+`E v ݏ4+l9qQRI`|GV|j+v 9\RhF(UcnL eG%1LdKsbhxͳunYdzfq˖c 9KH[UX8J:n'+Wqs04(T4Jyt'͗EH<.޹"XV;_LyӢl0=%j\يWZ:FbeL:l.Z%Sdsz` teV_25'}vEs&ÐCm>Ƭ: iY?crԶ -{zcY"IX]5-Vjtk;/NRzb 6_̰qGEGU7y9Lg>foG(%wO{<,4L2miO|խјM=c>7@!v^,zKwLu2E{]IJ`9#T3P9`k3`Tx>+\$8JUfAY (D"t`!&Len@FHڀ+lka9d&"{RdSb JO_|(7d@(a"&C x@5+>ρ ~h9!+$^frU~aTXdLG-O2|9Ìwwoj>FOhuE<ɓk"Ӡ^2gvϺnCsD@ge>NYNG٢[y؀XVg֡s{(vWݩ"uKNnȆ7-FB`}s&|fW:re?򫵕JG17SN=kq:}Ndƚש>˸M^1* au'˳uՆW(l}s.mT¢|Ý4ayOH[a;K6R'YALmgdQS.k䷗DzH7rc l,CE6TfMrB`DJgy=^-+:-dZztB0IeR}xQl>DPfR ȝy+Wq4}-l[`.~n^T0!ҏO#$J[RTr(^X w\9}|sUΩp"-ahrߤYu`'k0'i9,k(|dKL4RΡʔgf}\ stzXnm6ܜc#BQh Iގ([T/6sNU1(6Hw?JB&wJR2 5Y:\iD]pQIߣ43O1>g9&U7s#t &Fvy/ @u<\IJErTkV6qβru,V nVg]!uy+!}CdMZ^&2a0U@C٥.满Ul ?7mJ:%uP m"~o, Tt=eVz0NB۟'ag6sHZh P;R C[BC0 v,7NK)݊;yVz8ETҟÂfNelG5_*O/smfwYs*6! W;p" 3fEF0 j|O5eB:jWIƕ1%[ 1K?3T36ݾ;*^"^#uj^BVĉr/f5Y;bDX?: ldlA:1`J4?ג9?%WsW,`mA٣)fl3Q(=Uv$ҭǠPzLuaqO)q"!_\DVvv"$d P `~I} G.ڞ+9 :G)먿M}w ϕWG~Е-7̦(]Ѹ>EFqGj ?eG*iSRGa"g8&"f&~kݮh1{UJ|n_mK'{GJw8A(JrrTgLq}积Q1 @ 6jwr˒@.(vOt6S=@ˋ ( J$eL;3(d2PSGZ4&kO;*+^Z$#|)`4A/T^ r]J(bc31~so0 °=rV(Z[\eN\AjcTX:."ZnQ;q{)u&ET=f%lIϻ?(vCZe: I,SQ@߬ϡoxI#HI(dNӉwX;`i%+ip-h4k;'Z+j6>?@;!a܏58 V 0h,VE$ZҘlp@% ֑b'fӟ|2CAl+wmvf uk*.sdK}Bmv9!0 =I;yeM'dOi[gL۴*8q5:h?n}}"tul![sh.`):K3 :!o_3 9p9WdA|L!N@ڢluQ\n\ +п9d.,كDY'&SmƥYzuwG(MUd|{KaJY=֠u=eL)c _9 {TK/q+/@(l*OP+&( N${Vc>Qfsĥ=[6stJ"CB>u9+K|NB3ghƘ)֕uF]զ~4"T *i7ĸj?>IB-ڞ2+U~~AU/;tjz$R{}J  UV @Q{N$Q)9 O1$-ാτ R'jDǽdV+ VCPdt@Gڡ 5 &?]KEp5]dӓajKӨ)xgD羢y䬊Q9W0\B=j*z`\-aSΩԾf/9aNd.9g&UqO,Z.ۑ, \9l^HMetxCb4b` 2H :Wز⁸0d2|ڪ]T]?{Y=> stream xڍtTm>JȂ tJJ H..²-)!]%twJH R "K>>=\357'>a UA|@)  Bd0#oKD BbuAH,R h9bRR@ @ p<`?@q*!=]`vHE\`n8owZ  {#GaPBp!R 'W~,7/A].((h6 Wmd;} `00qC.}uMcg(^ O_` 0 {#XE_@+B` k,w .-].0g++W` (!p+ٯ\`l=[!6 9 aܠaUdlH(PB\(>@=v0t6 RcvF8l@}a6P+ ]ܠiD&(H5'':V CR0b(} ;z=e-uG<UQ @qq88: ؟y:WF3Op$܀F` pCvs()_QwwJ*n\" 'K_7$v؅7kA!07#AؕP:K  с!vp}s:Wد'' d`3%&+v㐿Kbw)(ȯ\\@dc%Q,[ z6@@b]r}6_S(R!%KBҿ`3Mlvɿ( &KW5W)t[!M96JR>DeSP}}/5hO#>VM[V؏WG ޘ[)qroKtDRAl9)}Uw$ߥ+Rnnn*Jd%i|ok&zp^֊SLjyxv*#xJyNH T$tקּ"ĕFϳ QRiUiAJxi|\FKFgRrʯwK)h88?N})n}}$e|v*O66lJu~HQ6))xJho8))]QHIVp)Sy&/5%C<:(-Gc:W*GńDgHqθEtS0U9{wq]I65ޱA}*)^պ/ެRZ% {}&pA@,|S#t-եşj)CT{#eJk \6"L/ygOW2^U%yQ Ř~y~xcpMV]^u<Տ>/4m} 󈰔Yt!BDzBӸHUi{ "kEVȨytH.ƚHj(Z8;8>9cg]-DISr2ly-ߥB"BDR*AO%?2ݫ (Xb7@[8#M,y:ۛ1s+z-۷r$|섞r(3G]^EGu^bHqvbD  QQIvccX!LLYd,JzjML@#BOh϶X$piu6`+:+]Xs-8ĘNA [jf-{!ki\(k!ghgޙU\*Pq*<Wڵ.߫FFlUE zCN};[Gdnu+X8b?ܴMyMMhTbYc~U;0dGŻW^39^H 6 ^3:[lZ9)BB3\iaS\Rj:y%( 6i1fiRw P,Ozv˷GJۡWqF7|zO % SI!Z\sԭpxJL:OG^I=V+E-}Eax|l&ZTY;ں=+&>HCC HK_L΂MrAǟ\ړڶHa,3g!NKiek^p/]\~;ed<)zvy\RFxM/<:V̊0>IXvbuM9ߍ,Y@d=ׁS-0 OdXX8S\E;X h&b|p]-Zr&ǂISR@=)C%tm ]f `=@Ele-6{/jVR:?T§9Y =CЍX!h'"!66jpH )I9LXg|*1@u|t8{]cKS`TnpUzSZD( SP##nv̺wC3wg;# mO1+4KQWH]~Ee==E4$3hQXj[-˛-:J)-?kUKO0Ih-RI|m)`kkMB^yv6f!e`b}n :1ڜ%x)7ä#fn&)T"KRΘhd, 9z\(tb|G-U!]D[D͡M))`W{pyn]H:opдaL~{0Iˋ~M6o8-}ΔLD譾FOJƼ%6HxbZ< *Qp9/;s=׉h:۸-Z9ۿH,)X<|{EED։B9GSYۣ#Fpvv%Om1w^S#/ nO҆XO-2iqFqϦ\**WvE$w\NrFĖd9,Bӿ(&~Hw #NQZ#/u'WԪeԇ&09+@fK tMC*Dz/<]MY^c F^T>pkޓX}ya\;M0˟xg^C&\Sg[^zC)nlϚ4,3i%MTW8FmPI>Z;pdm._bޮ9DO5R lȬ\'Ϣ%&^bHfsNv mVth|@ahm0q6 h&BG~g^ݨc+sw mWC7ר"?PjWq(i?c_Sў4Oٱ-I ZM:]@`B`/c]C㗊WaՃracD&obx 2W?$QߺLwmeW?Iun/OՏyꏐLv}_ (nJ@HS 9:<6K\>kS%2͋-C s)eoo;'%cNUVywA3}ikiMJ ؎G){C"ikH 8٤bY-?}0^1bF[2^<5~-9)u\t>{|4}ӎ6L32'Dő {TIQ[ y6~vƲ8M!N=-CiNܳHƛkd[WkrFݗgt~8JQ2Ib:84@#Hׯl@h)/xb` ELkLk*VѽD;Y͒!4 q!K ح\\)O,'I31UV!)#5o3 vY.Y=hMBhfr@XZf/mws@ӈXKEď2ٝe+f,S(j?ɇTzBߗ!ɫh#P-a5D*k%\ʹ/>=3uiv#zsWle@ @lvJBPEILHJMŠm@?s7dw =b!2Sg5FJiVo|ze, 썳7A){J. _ۓ r{2٬@LY>Lf8`7H%lT}A$\T-cE%[9J.nLf =Nm-c|-Ve#sH(zT ,Uߒ} z{|aWfkS5rw0Mwon v*e\0|g`BJ'wv]Հh}I-qZKuxL_.pgmWӌm͎`Wd>$f` Иp(1H=#%IW~y*+&l&tGZ<냕z8Qw~Mwd|K/P{<]kR$T/9̽ȾB9Bs6ܺ[hqgok唶&~v mntCX؜:y$f&rM%pUn3Z->@z6Fw#Eu-"鸔i2 tŎ80q@RPXz1ƪmJ$ |}l|wb0u!#^M]1 2 WH. P4;s^ѻl';NZm'jvOG3{F{+oHOPB@LH:ƅ#*†Q/O :x`Lm^D )M{g;1kE4{()gJ8L>+)% o{\g(M/>I> H?+Z) [ xt~L^;_5-yŝuݶ74,j ,of{z p#n5sbwi<WlHt:]ݹg~~CzډDbwR,Iݵ ;_ er1])߮1wvAݹ{{^<[ƌ=7iv~N$Ms(C-4PIQkB7W|E1@CyEMYI&.s-g#?Z3|8[x|s{2/CTY]I{2vTf!I)Q3! WOB9˧aGSbvQgmyD*`w@t p\GxՒHNӗʠ! 48-Тt%Xx _.ۙn$c,ب8Nf \stC1*Y%-IǟlG8cUE2L;5|PQA'A<+T0~E7(Oeb&}A'f\9]fN p ĤmTcZfdJK}X*[^JIewџJw!k̪$gʺZ0巊xNx7z)hܯ{.P; |x;]cGI1ckMD"7[>͓Ss1^A|1,YQ_n{|nNo1_9RYwUI撞!䍲9*{H-w*'']UP6.r-4^U՚&y<ɲEZڇ]̫G./H[n>WsTǮ^,dk~j>Da!L_FUiE?5Z8ftO篔cN)=LA 55+*"r/X /W(={mYVWu^2~Q*ScO.Mk-fّhNal?U7IUUMͲMdv9"Y4{cկTB]UKi~QS}mT8F#J:Wj"7'Ը}#][/7ij n[Έڍnڟh$溗rMFeit 8wOVӍ }5 Dk>c\NeS TG6I<4OoIxY->P,lRT `npt6A9-TJٳA h}PL@.}Yn'љvt@nW -B+:IOG-_YG_cC!{)<p|y{zɚX"I/4NƧF >vo8<{Vo,CcRևhΗMN - endstream endobj 231 0 obj << /Length1 1583 /Length2 7014 /Length3 0 /Length 8058 /Filter /FlateDecode >> stream xڍtXl6--ьnl0b1rtJ ҩR HJ }ǎc}ylLz| ;* J*f@A0! !`(!!`ԍM!j#^0(B"" 2<@!lJw?$ u_\8ow `&=`AP~)B|||n,/r@!I1APDT ..g =0O!"{3G6 X:BV.?*+RrusE8 q#]/h#nTS_ qy7߬A]j%_>FMUi]%'XeO2)v}oQ~f|0p+Qm(t:?Wf$FJgAKuHq=)q$Q(+CFX9h_اL$hU -铻yLIA>VŻĭЌ"*ިO&l]\aKҦfdhC̟"pN-?x͡A=zJmhu7׼FB#b 킖KKB&]u܄w~x8zxIvDѠntBq9wR49R@=DۆG⢿5~FgYR+UɃ cU~/X8uf}%3,Ɇ]k-y3w"ׅQ27}V`U__}=>" lI`_ mʸZO0l=A޾(Ty_RmHa#^ ۫*R RI{8_jޓSbrtz?AnA 8&&gm7*Q{hTpܲ;ԫrh+\-z2A1q/\|C‡*gS-o/F[mA_Yl7?Λ%B)M UU.).c(<^98):<6FRE֜sV >"{T!2y*턢%+! G͂b|Ωtó8)#άdML,-l 1٨e?Z;cKICO=TŠ`VL-g:d߶$OzFBrW>ͲGۤ+u,gkX+O?)-x(Џ#ehC.}[J&"ZĤT2+:Ni<K-awͲx*> oTF})5#n"(B&t}?Sbnxś9giq9 ޕVP KXs-fwl__w`+MF頃#?5Y'*Jjl6׮:aW2}|:މs!w^LZsqhڥp8,BK2yO-t&Q/{;4<'E$|`eƠ>e~a]d/j-"1"L y+fX٨fdGFns+~Kwa.x,H60MY"!oܳu RD}a@kG3*[|9TR(IpΗ9?9QQ) h뎃{FyL,_ѻghS$3,⪬ c*m?QģTB q 32L -czWbuX7 _ߚp7( `OďU6m &XɭöIOZeɁ" 1XOzj>JX5 ]M7ChMp.BsjuE/na9ȘeqW >5rAE3D++}Y<,d0J)ꄄUk\ϴUXǠ*IWstujƵсԨ̗.#ƈEZ`-W1"0O]rh}Wi ڮ6"zIGjEL'>a10$McCN=JJI!{+wT%'h(y^0V5R@ $%L䨍mW23/;F NZ ;Jx8;N 鍂kM^=>r9Gaj5xz8h0MzsaYqU8c@ R`lUr S~o0Iz-,Ou>ɕT)d\l iV 6VouXB?9-[6EQ vʃ}?Cna-ECݭ鋶wC!j,NǪ;Pl?6JD_Lg"݇%G%wju'af--G+6b߆ tqN"i#O*>&wAԧ䒻)Ҍ?ݿ}%5KpƓE{G;+_7O-6Z1J#E²onөEP;<)Üտu;"e ymœce>t4+~$dLCq:D>W>='elr:k^ CjJyUVǍ3ߕp&2 ;J"\s%ԭsT5T#?[&cXIG+T`oCM@ie}kMU(,Fc wV ĉo7_i~hM[és2i2120[Oa}hz!l$G3 bx"|Q(QxK]d){ci@b[2tni9`A|ؤALqWd4x{}}ʜ So{8XÌj#?Jن<ɽdCuZ<1O^E]AnPNO=!a s. ?!XwCtMƷ!ۛ?0$乥W֘%oZ9%љ.R~4tܩN3*OJNx`c7=~škk'0i,#Y IM))$k2?,p,˨E|k#BEHwj\8)$8*TB],`Cɷ8ˁa_5t$4?Ϡgc"ej͗ )9^؃CҠ@}e<] pupg_ҩX).,;-7O rIX|M$v>Nz0>OF4 0Nx9rGIm6C YZJ$&PN<'Vy[t|&5 KQv\2W"{d[O2)[ni&',ў[BnY˗3B@Eqr3ҭޜs6M0<|&V"wSuqk')-̏po&ֆ4|m_,2M4TbdvK$n{B'bò| >3-V}ʱ弖eѪ/6 CcÆ[[@t4+NDu!oΘAH;=Lڽ{8ifƛMՆOO6+z* #ʪAs/t83MD\reMRY"#QR!s 1Gv M`rPu$pwi,Kl҆,_bɎ/È'Dh: `ߏ֘ pG Mb y[C] oӟw3UgdgN2\. >{31[e-nue9ڋցnd{[e0<_̕Fwiu;s2a[54#-&= uuCB7Oɥ:a(Ihq'&_u[YB/ȇ9L-;PjTz-\%LIZ S`Rb0+ҫRgögCTRUiÇؤϰ_Nymk1cȟFIZm(\˼;/7 >v 0ۑks ]{,axIipSohJWkUϥ6L|-7E<v:Z>F_+~to䤖Qe?z^\YJG"[;TY^4DlcZ{')+R6V<9Yg(: :iF0HA{1_I!˫ *=iϮ62S\E0|ׄ_W쿪\];l(N+g|~Dc5 \o3oػ(SAbU,ɻl=ڎE/v#&ȄaUL֮%ȋRX|_w5M9ֽ6+~:'Cb9>\Rn._&K0-y#ڟ1^,fyW&Uj10>{HWael\Mmoi vq 9pli? \D%e|O\ՏwY6)+df̟zEȳ9nٞ?xԍNۢ--*_r5piVZiV.C0M3af-6%hz"'W'b+ibAA?@Cޭ7*֞P]H*7 XIz y꧄Ղi:q}˥}EFx9giDD?/&eȈ}Mq9P`r,\*t0W+]L#Z)?beP{^'2J ʏ5 xLJa&6[2u* 6K^^/gXUv8[ 4Fȇ3|gaAD2YIanKkZLy#īqYL6%#5󣳭&rnG#hvV>aپ'U e`s iS>:aFl6_0v󧨎ь'\_x~ qfA(Oait(@ Oc&ۑ7OhzS1m^ endstream endobj 233 0 obj << /Length1 1904 /Length2 12830 /Length3 0 /Length 14032 /Filter /FlateDecode >> stream xڍP\ ܂v!h;Cp- 8r9\kU)>( mtL99)&F## =##3";":ƚ_" & X-L,&vn&nFF3##m@'3#=@H!bcjofb ~[?jC?BV {3C5@6YhS f`pvvZ9؛|8M Gy)f9Tl@{`ifvxKq6VHlA[? Y 44ZY,AqYz 3hmG -4IR:?C{3[=2QmŬDl@`?ك ݕõqv2662 #G[5k3;G1o&l& 0 \ MX@[66@fƠDwwy `dfL̬f&?&>)?ABHLXC-),lpca11Y9o[Gh7JY(߷gE@͛tAhYU_;ZZ+2t;M1ykv@FfV+ɛXY9/gif Rq0ybd?)3xF޴ 6r? z!fmhc1@WķClw15n -ֳ'fg0a qDA\"F? z˓/d0( ?譊?ʗ".mXne.ѿ7"&4JS?!o{c/F_!?Kѿ q'm +5F_mO;om߆_ 0Ŏ鍝?97F@Rފ_H GUo:x<2D\17o"t9ML7 یQIK])_e5K_tߩ!ue#7!5{y7~KD6 L]`H։ `dҧBAUݳLU(!*YY*Cĥ{Kd0vGe(L1ƹmc`xp+Gw<.3H$ WQt@SȨd&ZtHu\'~qo{bt,$̜ R[d3-b ץɍ'GD)~r1|/;=(!*w>ze[Ph0kq&p7{AgaydTPk.Oݍ%]rɮ":#mfGn)ParUG˦쀕Mg[IuB&ufpljh1lqf{N/i\'u>K; 6'?7HR@M D]x8Ǎ(Aཥ/~dv` N8@Nh/ ~hȑji3 E"V6뻌Y˸FMqXC0BtEAJWF(P@3#I :x[d3j&!b#52$Y"Г$_.-fȃkG[LXdq"`wwWnA^MIwWCu)J(vj={9`pjQ px>uTKRfCjA3@(3m]o'}qW>ne;y3 SƏDOg% nyH0ㅅp~瘵/[.Nm;t)d)X,D <5(湍iH;7eӰW5+B)&SAJUxF|*ޫ @p(ŵC!BZЧ5~Bnf:3F[0ĔSV]#M. Tѭj-6%]kq_lƢڻ×N٨hʛm\僪$ѠԋkJ/H!@z%5&tCPG*_NO'1$XH30)pB-<[mArޘn#ٳWRa "IgyIKNJ[k5@st=>='AB `@ʨqR7F⼱1>4 EyQ9Z]qy5L6a$G=4DJ7QuJl79^x ln^8p؞$䎟#(]70+/R"w3kv:~?.9 G4CPi !ã!/K'l1=Ls |`G[wݖ}4n$:U8Љ_b%8E,`B0Z)y`%!v}Fc&3WqOc dSW}bsՐpN<$s{sk&;)븴_n!EEJt.+}t <m'X+?&(/W>8.h[yZ0T}[; 28 ,RnwCH*'& ھM{wuQdlok+{b"xVdhI6p6o|P(zQGn f%JקlrV!ru+UX㈅JmdiR@w}֦Q 1}l@F9~|ڶ W$mAXj27[Gm׭O $n@MjNECSs\;o;!=pqYAOIy9|{bтq̺5yĒ%՚ۅ,O+:Mq7}ϨFA,XVm 1b%'kn$?ȩ.uX0+~\n_:u6^C $e<O7:p H2U XvVba@(^},ҁ" xcW-va&lR31#qJPێ7ȝsO?X?wx}(IofZ PmGa#'WE4qa%YvtϪѼONl7}؊`R>HIDS!705y m{à=?RP)F}ѷ[Fq5Apb;Ɗ29_&]uSWN^dnxܯUX};3# Og6`-6z6\L Tc:=7H>0|rاP8cڤcn8ḑ#ߣLz[䡕S[D<6c!hr(A bf.%퐕F4nBuyÐqʣ$3%Lm`+|bJqG<5敽 RXB&c*!3O""™X|Q Xve: 48SL HI(XT^IdV_dSR(k>]k3#k͇1ٲCmieBgnb8lhmߋXZZ+}QN fv_$iٗ9XQWXIo+<>#fS'u}\ =6Ft- m~ɴ#|$a" aݷ&f@DcsZ eǧf4C} IJ'-e`5yΘ6|]~R(P{w.jcҕAI22X6s1qa ͺ]4x0BBdKu^sL|>XOS \BxYH\ºJ`Z";׳̅9´CDiE\-vYi}1&x8ӠKo~6:z4U[2A!A=Wci_XH$ RQZS ;%+<&'&?w5lF_$#,4l9v\xH6]RC?IL`yVj6&\ULјA[ϭSH0 -zb?PA$)sʒ^BAD))`pݘ A[& @T#ƾCla r'7G=US񣀒+F8.$JCY4hZUho萩3yevdUt5Rrp~ 4aI]OZh*ؐߕIMmjK#l8ˈhpZY; Q:4wEJK)wHWس\sf7RRcT &8Lك_{%D/XJ7/ aRSkdk nXj(M+ĸB?҈Y:b)#wXg-_ltČ{VtLMkӜ*" vS_v XJn ͐hIqnXp \{GYynά*ux55e%}۽hbK81lzX$R֤K%7bI҉m>NP^쾣SΤϣ@*=ݴuCͱK_I1vΗF(QIi 5 /FoKn;1<\QCNuHkv~&Tܦc# -YDF;ZzA*46ǣİN>?Jv,ľL5k{U74M\^YnFS= 8A"" "<8@' @mA4xʬB\ډ8aĀ:FGV)^8~S ?nɦx:rE:!rR'lrѼ%uW} 沇uF, ?SBV%IQ޽S([5"#En{S0;lx bB_&? 7%,>CwwA MYa P.f{CW09rі2O^sWtf|IRm/ T՟e{݅SHfqrt<j ;$&gCҏtcێ"uZ=k N~%^y?EMj*SHL mM EQL:F&i[h#F%ϻn6yKSq!;~tUd_9ͅ#ڲ-]敄ѬE%2hRq7L8,,VI+f:-잮;Xc*`* r#hJm&9:V¦N- AV$WC6Ow-Xs"qSF/vbeWLD5v'xV\׮<$S uI 9R5Kni͕1D%(Bz/؊tq-dO-*E&p<3n'PpM ϻGo-郰܄/;u~6O¸U 3pke:|wd!p%W"`rp+pb[F|a) ]"{AihʡKP+y5bRMX}ۋv?QT4L Q5!0,AY`>]pJmR9mz7ɰĠ]G6f*ViEƶTV-O=ON& $E[ m+ b\WPOuO`X/ܽR;3umɄ:vV IiH èwMSy*нv'ſTB H ?,Qsx{Ht2$s4gilPX?) )p%.W!+ZcA<ϛR(J^"qt.}56)6##T?Q*7?>J°X)G"ncH7&.dZ$hKT$GQ~wLM\L?x ;5lmw@~~(, ;<_'/)s T /rԘ^~ HU%\I`-'k \rƄv/9>M CavG2iJƶOc~ mD ʇ<েRm'gy}!!͐Tox":as1dx'446 Nkሄd-F,<q(FU' D_,P $zn0tfx*&eOeioʷU.x<$ Ė ƺYx*35Z^|`Kiyzx_&Efd !ic}~1UAt%rJC1װʧm)bL.6tsQ Vt ]U UeǸp.  :'2ߊʴG֤i"8CTmOA!lZ3TL BFmbMDu5* P6:նMhd_0Ul3CUsEMk.Fi~w(QH-=]dFm$!5X/YaA_1CE!jrfL+,\']ۉڛ(ue`[wGGҎE4;yU(:Jw;P_>{gagC^jlRdm :g ɚ4lt%Gvr %;$ [)qqϦXT{j--()т#+:O]tPᡛ6і\({TGmxQ>[!".P ]>2N3~S(G+ä6PxFVC;z߆Ʋ1}IX. vT0Xϫy$Il`ߗor%.A{B&n T !m*]3@`W. o?_bITs|%:nkQ2cQTS$U"B VpIi;e |죴_UˬF@):Ѧ=M8 sf9ī0h H<@a-)+kI|>_ls m%64! n5jBx>nɎ?$5JzЈ{:-W*TzHJЩu4!+ƲJًe^Xҫ< *0[&dn$&sEX S˹ 9y("uDLkLe'v+gq'v4d$oOgF"-/RROgUd3Al˖V"/xhvdȚ`t}B;Ш&F"OY/0i&\IH#5y,ɨ٠j.OuqO-u.@&Vയ,N1 ъ械%3F{j!)w%T\DOh8B$  J+}~SY =Y쐘 -E;/AW=pRiTrIЊIcNdV`0ǃy3]pGa T\j ʁկ״=uuayC`v{w=~d 8e8cB o1ba8rMr0}j i)m@rPE=5c]ք1  6Gv s"lm7_~TBVQ2Cpҡ:fd]H;2 RzЕ HL3B/OFG)Z 99MlfC)n9ӥDNnj+ӠI3CS)$#̄{ 1J2^*3 鷌0$0Ed׫^m"c{@8a\lz,iy>ZuFV[yc$FGS XU)} Rj>\ʡm.4λiBrJTB*ӹK/\uPŞ]<j]o h]يך 'n&V^ Z\NBl&4$_AҖ D:`5膿/WL5̎[dhHUpOky%봼sק_DwL8N3Dž|~|H[n}QC]BĔ!uiʰťr3Q#{9V X00BD*}ɞ}oUEkBX !l>8]Zi ~Z2 j?TG'재P)HQϹܛ}i+q'ی}O*4'm 0$֧#.[o^ethL'lj+9ɖDC^G-ԉ4*"^4k) \ !0# ,"r);t۠%nΛK 7jR׿Rx_+"ƣ1lc(إ:PxZ(7{w5k{hoY e 1wEk:wmujH:6O8R4cr R&;DC8eDܒqf<ć24,~<4-MbT9'@BIC\;۶%3g@,ɪΑr~R6v7HVhU 9ʟ_4FǪGwU6,d'Sj:c27ca:|zlTVMC* t/ vk⚓\$6a1\4I;l3ϟ_Ru9- Ж U}3)1 iBr>ְ#X#Qr:}1r^U !+/-FGL^JW1P.GXYrWMMՌ R+LKLLMf[$E( Gw:rzBRdݳPP{ FG);̲&#ĕ'Y6oC:PF ]c+ 2Iȟ-y, wjwoN2EJJV֙RT!Y`vp>Ⱥx.ϥ{òK:wܛ&e+7GLGu'ItCc =p<> stream xڍtT.)]Hwwww 0PC tt - J7( %?}uΚy;Tdd Pfv6<7Z -F9!0t2) NPpsyyll28 n` 2 @rA8z:32qۃ@2j hЄAPA'd : ]X V"Lw0r9, AUƂJ в%ׄXB݁ lrpypu9/h+TA+e7v @`?@ss#`ہ2J,P(`hyv@g?2sb v~;s,$!  {5Y[`a WGVm+H^ogeV ( r<̭YtQ?WqX>[P]n O"Tvv 0YPY ?0d{;O8y|Yeu%u7'/홮\FQ΂߮;_>_MT ϬMr#6n67;5ڃ<6x&+y!kߦVdvo<VdffbaKv{,Ps(\ف@jًten~7_yQ!A65AU$̛Bǩẓ& deLlH8]g-ިdٱ0~L"}=,A.PF EªGˇk6ѝDW!U[UI)ɬ_k6{>6p=(2T#n7*d@(h/}h@tmڻAaQ*v'h~Yc8ێEgMўkq@Q%#Z$1QsXߥf*kc'PQ./,?:_{aD7T)Q!W͟/ci?U+MN}7oD”1 u}^9rTzx u+9dp8PFm^玬Hq7EX0u6=ْG1H"ձV0 G%b]/— lj&WөP}4qLQ/ N\) %6S:iKgn<|=6"y8( w jw}!7}]]yPaez_PEF>F(Q:mmXl~ yS'9uy?kĢkUDc CI_MIel9D/^,Gcw@.n2JGR>'sM膔C-d6<" ˷P ֲ! 5^H z, LF~KR{Մ6^jI𓽢PwL9By]<$40f`R+>OfSD|\n&ϫjfoD4X1$?C={ȤUسySzŏ):w*U!V(Jҙ'V Aj"p^1G~0wCq-[BE~B'>zͪ9NMpBnNP<Œޕ>d:1.ylmh0bL-N($!R,p P6$YbM5*D!үĎOv=)nֆ9r%;őT{὿ 1Gܔ0=3LV ؄ږiEN3*ZrtS0c#?PXLߛ:[JTT9ϽL~`XbGp l`i֤g!K]_[.j[@I!}(AEr|#q[r-MTE5/nbf8Vha{޺X_wC{!<껭?Js_Ln$;K͸MSm޹׍IT 1pI\gKrFeNti^&m8ƗT6ՐRݲUnߴ04F.9sh@)exyR3p;Q?I. ~w$^G }2 +'ߝȬ!{)^3Ҁ$չzq?+zR 1i %QK 1N*j &e]tRh잘n(TYv/=EV2\3F⣎̔f- Y,~pU9y|z-|5%* S%?$ðph{L:7`k\K_ߪ64ri랭\Hң@e%RB孰Q}hy!^<ĤARY%a8xmvbg4F; h5S1BØǑ_Lah]p$B]3bDu $3GqM%pD("WMEB 4SW1Ê.:?Sl$|E_}ڤ]#{d\f8cb,z cЇgA J)r "w;QMhi;!>*VǪZMBZ5zzZJ$/PT{N>'kM7]rBle:ZǓc?ވ%[yz׹֛juSFҼ>m!%qm9$^ߘK]k3t@2@LuKX{\1S>n'hl2ımv?_'VDx-d_R3̯}ֳtG۟.Y. (O:9-y6cERƌ_)ޅͬL0cM?Ͳdnz95"7U@ؿ{)H]dkYɣ\bԿ~,10̖[eBA0%um<1fOY3m4~Իi-{4 duĆ#th*2+gCKuɸw>\~%z|q DYPJ^b*P"y |Kwڴw>5"Im>Ï*cr8n3X؇DiWeYhvJ^'f ?id$Pw=C|Eᢜcuqn\ʷNa"v'y \Ƀ2 =eXJP cAgr*ˡf+D}UU:%=+# Ka(*䬊C.!e~nUrCN+qcMeLo K5W[q'v\屩'D橠 vvیTNږf\Ǐ/I*w~k4Lf^Ǐ 5|}ȺQ^ʎԑu#7"-oȳ_K)HDUqٖ(p ÄjĶK|)h ,i;ؽ?H͵mEvVfےF F;xrf{ySGe|K5vİ i(@K7U8B@$=́ҍǨіG%ޛl8.2{q .+&y>Gv o2 3H}YGӝnN⣐6Wg7ahFEKGl4&#ly.}2%v(#j´CݷKTT{_./܅1u{D;#i_i@YѦY:ޜ/"p7!Q{n0scy{W*yF)mjt2L Ǒ'M۽KaB /KQLؼd4){ P͋t,}<:C@9bpveڛvMNC q 8x2Od;N]j9 '=ZjBzq;L5cnsq˫h7P.zb !{B@];&~ upkuyyW f={ՎL_1OY7?'w];\d%^֙+M³[f>?rm J֓'50O7lЗ_e`r\w  naA̮"O{@Dm iȌnU ENU7uXLqF1X3?+J ca{DLuf B Hn %k\dg&wm%J,GEQ)lYƍ5O^9R)8$rՊPT]BjU-3*Wdyג4fb[ ek Ou3MZ)YHSv vW Cv0$T\S;H;Rq-UO<|ظ(Hamې¯".]T(x1BpK4bUW؈y9 ST_;tfЩCGQ跐BĕzBB>6d)F^]hH\%1ƀxƿ0 Дevs=\8TIMHCL 9jYLY`⥞ ӪI S0"Pݧcye`OaGnUdؘڨC օ~9 E`$ti<"%yȦ`TuW"9ϧ`Kѝz=ѻ~+54_4 7>; W =+6p^6c0l}Hmt˺!yjWHh ,~ʼnpӨ+ޭbx t2 FbȒ!z뎫qsf]>˕@2g"ުX9ա'nZdVa]cvF\#hpBtŻ֯U36ӑ&C]52". vxΡye_'=g핚.`⑆ѐ>O\>Ռ1ny;n;L>1BgWr89S"\MV&:z _e4 [8J "4DZQ1ɇ3NoxX$tkQF@5;bZC|y?tv*hrC3[\ B7BڄliK7|~ kxdyn/V{?FO}!{^\%EPWR(D*~>T,5?>5b;ӻYu s5מI$To>#E ʿt,21xF 1vq~Bэ`%syCv^h~7]Ma7,u]_L k9K/C Q^9yNѹ(ϖz}T.{tc>7`Q(Cp2I_Q(⦓B˅۠Wnl`,۽.v |BՌm*2hrI^"oT]Qߐ,aQOt"ۗ*׉[1_ۤ:匽/>uLRI^ -PǯEVlCe r[ݯ 7q1lZ-(6plvB p Nr-7XO!>=6%yK4 ̼%織J1> %rǠ'21 =C+utL篵$)EٺԌ=e=;׌_F5fĦ(_CĐ n%Ffܗmi#pޒe;D6(鶇vU)^̈́H*Dh W;0kbmhlo3axmCd9g*Jd釓5m/7P̹jkH{ړ ?af 'iM0H1ͪ-yN-"g5F3"}=KthY/${':>EU['Cd?RwIZ \ǎ,*3Y"ɭ5EKG̽fަx-tK>ssջ ߃l\;'e(zZrI4.ͷ?_cg&N.ӽ%R;"Ĩ/ W5.oDB# 98iU0%-{4$%됞$AZڄ_roOlOh^??襦#Xƙ>.+=Vp.Ml'i"rq) Xd"ZG/VHY_X2P۪G]Tqߴo!Kj'kxGuC\=9+; F'O92Xj4qmif)z W5I쫏qT7MME˜$g#^]XLS[Nyv2CK)^Cӓ}3]Գ5+.oB|#fE,ݠ'0X퍙#ӀIIY&}0֭8aj>oI`$x`⍨ $ijh%3C_@R:7 d욥l*Hmx{/ Oi}phI#ӆ~JC |QM k붡viTTw}1S J@IAg}|/"U!q~*Cr8@l}MˇF#k|'MV$}Wb^+.?|' K,L{8>~g{\%ҮHvU*w <_k4S°qc혧<]gğ=He TrlG0GG)g`yɠڍM[ $#J ע/T_/vfzyaM¼vuM{8G]d㉌R>VGe~s#N%R/JЈT:ĺGMе>r0E! L)Wӯ;pID\Ɓ*l G XP,R) \k({xNlW'X?&*b1Ɖs !tem=_ԡnj.fҰ3{,FP~هcA` B+39f+caQrN o:C+7̏2C endstream endobj 237 0 obj << /Length1 1755 /Length2 10832 /Length3 0 /Length 11955 /Filter /FlateDecode >> stream xڍP\k-и;k  ,%!咽w^սUט ( vpebcfH()XY9YYّ4AvHT@g؁ gM5N wqظxYY쬬|vH,JyJ v}hl||< sS5v 9_%h]]YX<<M[uI".1ᆺk٠%>MΆ}\TO wHUo~ btEʻmRbH KrWi=|1ӟK*9/`sP)=1Dm븮"pUe:-T4al+q]4ƽ'Ro-X*fC #]2e{WOFZ{ִǏ)1eSRZl)3ǧ Hlwf_tiaXV!Gk<;i v]&- .d6Dt s],)q3F󑪻(y!s )[qVJ<*>tcs._(ثj Bz[6v +!UU/৙:\LJD6;C[/AP{0hpTʭF3`hģԩM!e k>M.<y(WʖymA#|Џtf:..yoRC=oO>'C<s,|o `1I󆏡u cFqKsnh?TxP8e渘7vePI|"V=fwN69#c~o6-B 32N,y!ÇirLlf(eM< eFPz/gq.86%%&>;Y逷kx|_+!c y=?O[#w^@pMey4lί>Z?JR^Ng;ֶt֣S.92Z~QZ[V ;>5w(  RlC<$Ls('*l5a m-cIЊŷzcC:;Фցyكr\vahm]:=O }yXFLd "z,&=, =ӿ5ʀ֩@ &؂amaX?N}hm&b:q(Ž},JuPѫy9F]y?(ʲ&oˌ3Tŏ Z hbVӘi5f-ѠoC}%m TqK;3h݁|H jsiW-'m{m(OZZx͉Q+bF-\u #.!kzH{0 ӡ} X#ƍOե˱mxA$ݍBGKM:=QD68ިy +vn"FfBMPyD϶ty3(;qz#,4o–2ꂹO.*oFիgD2ܝܐ}[%pK䚃d>Y# 6IZHD\xsCGqu~܎)E+lEYPGKńv@,# 鳓10">\*Ioް{S?t  XA;&Nд7E AZ[cIJ!\v]]1zԷ㢧 Y"4;Vދv%Iᷧ(>5}HOѳ5B>a*Zto?&$3$^\<=#F eoN 7vK"Re jOudm&XQp}5S-R-^-b*Q5 YrtmR4ZX"OFa5h!92E`ix/| dexx_ .k|v{ =Yu1[JS^ Wj)7?4T2'UpE*:Z60H|؎§EI+3N sz-u|%A eKzZӕ g: ꮊ8!QsD7<}pI=)ua0vDSGFUM?.7e8 mwo.y3z>Elϐ o*;!{6䅩G!kZ$x;%e/f=ϦDg@z@bz۔l矴blmͺyjxgj!;OS - kIZC!JI^ؖzx}Qwqϐ{^ *:?\6%ae΄EW}t4MQ;نtTe xӼRhj1-D]U:ڇTfS}N Fbne~?aBTeha`meLMԗgs\цZd .3|xI%ko7Őwj=/S@m^^>#.:i1AYJ~E. ~宰-uAvߴs\_#a5QG;"}MS[N\FqJکHmHPW!V񄝼O22i/tI-tu$1]d½`[}2 !#$//3Sk" I&G SpQ+>CXZ-JA[s̜ca'_'4koVawNcƺK|”5۰A})aU{7|gwgXs :?0hkHh ᠝a4H"#"/dz*Vo?,EA5R^raּky [.|)7#Buj֕Kp!'Y+yH) drV4ȬЩ5UE=5Ը@l!m<>JzI#bNv9a/nLTc9vDj`@od+(ObG/IQvY%ml(3=^.F޼AR_kEnWTkPV9B3`uQ%q^mˠZUq-qM4B^Cca[9k$919?ZgI 6ǯܯzgnQ&*be—@~$11aNc-*N1QADtrc iJ99޽ubU5fIX*>Y&wKj> ^ S[ΉJ$7U}Ц]RSq}gd.N[^3 tM7E!ޱDW9R ە|~YAw#WNc|,"Q&lcyQ|EusWV5FUlA۵]% +; k_3A G9xfu7.Ifތ,N0%$Ltp_Ęu/_-y?z2c VpJlxbhX'wHOqyvzXa$dy>RqHap.S9ƅ*DSCǾ$ ׄj&3&hMa陎da6V{&i}r&&s6Gƶ݄zk45vT"X/x]UUT\T仢A5{:>ɼw]tUZ"Xާ m>3u LG-Y"ٙGpʨjjn9OfN.&YiJC0/lz~$RXrׯ9/^#z 頤OأI[Əab>O 75%uuMt^$nQS2rX#]Z><'Ӧ%[1 ,uI6_~-"*Gh(8\K!'F#t`'kjAOgX1HB-QozQ=TOpD lX>> [[csXz#ڴV#QyYCL}WnQJ@[;cɤ{hX<\%Kȶܕ,lBVKK\q̽ۙ]ݷEQnRk#7Asr?TsKdW&l81w@W}5mD.J6O2 V9lt^+'ܣĪJ:Ϥ0qS¢v6n\;7y(=6FRN7z[@1+82uti}H:,kW|\) *t7i}oGMFExܯ |&d;%JK`ѯ\ƥopa5| PcKY#fqVh:qT풒u~)l]ߢCL5@'ټ>u5u6ۍ|`۪5nh"%$>빣7k_l~¶2B*yY}4+ĈUO~wSaZ\'±EGRA~w*AT+%;38Jšh Z%s k";6Ω_2p6mcVٸrS~\(rmG_~-գX6<Թ oWjhR\@9|\9[!ZBySҲu+AU>X5-1ɰVv}+,nӒnYc"<(iҳ{lݛY1b 4J$t;w-[@. ϮJMÌRS.\lgF_A˒ZxF,„49 iZt?ϦoCS!ʸhS i^}oriXi؂ʉ?T!וzI!h#v)pSK,03ja|,-np] D˕r &YZs::vCl;,yxhCQw+ӎ_cxs.MLOU1?A5uv.a =vmI&:d7ĴszSJyԖ[eBqD*Mu,ZG0 Zf2_e{uɨVv#;NpEuǕ[VX_Ofݳڳg}&TaWP:gNk֛Jߡ,z('Jλ(F%݅ ԗMa)+=`y{LqDHs|zszrCj:tB؂S¸a'jP|AE^kڷ|:;vbzMzލg]s2wX)wrͧr'~I{c3g+M߂.ODͬRqͰm:רPHk1V>@I\?ǹyj4e{,F$\?H_p̟]"d/o/{{}Z=\94B5,&' *P[+^>TU+ʆw7C\$\q Ԉnbp-W5tNXa )5Й|5 ;q#(ZMXcbɐ+4q+;V*lUu&V/YtcfEf'96N U@%M#!RMN,IX!O 8s4+"9;)WJNn}WտQO8qpET-V{Hms-.0Uљ>eRytf.4/`Y*Db?=l 5W[-׊BM mqr\ɾOyſ(M %bKA,RMLT@u;Y1p|Ɨ9ЋQe|Wo5 MzkJ[\w Tzwxt&R4h'Z'/$za\yd "A~ȫg>[w a Laxi798f,Pkc )ͬdޞx Y nN3bjxp%Hcv> ~r;Agp4mf;♦vˌF!¤ob\&Q~Owa;1J 2W"Sm-uBlX\AЧEXJFyC?٪7 }O4I[>CA=Kg.uYIᑥG)]࠷Iu\c/ ź0V(Bhq _kӣF P$Wg*Uو{^q媗ooaZa7MB+R|5HrWO/ڿBxuP(Us2-lg+g"XZo k0^[g[=a%z0Vଈ[]t&LQ"[ &5;N_6x(DVBP޶3\Ѷ$y"Ҽot qbEɳ(EP}JWKf n&ڞ4{!!7")*hjeDTc0FlF ƿTVbz'ˁT#>7 p7(nQfc='5 TM̮zG}fâ2z1 =N>#[jg ӓ6ا8 IA]p*}Rn5ǎZ5@# 3 3dHiWN rmk~uX|'GO$[iX #J=xL$T~;Z=3[_m[:4'/*r+;Mӹ9܏JO|~Q_TUBcF wj/W#o)ߖRI lh2h}f@YjMB)s\X5#Nzz"-0Z/*EF_CfKLl B LGI)PtʅHCN<8l~ԚNήJh(w&Rn1J,],KveCKPca|O_n/M+^Zi۱|&i%|sVIoe䡙~ ?%6s&G*V8VO|Lu*nF@G8\x{SʕET䌴:>p5aq|hu*X[m:8u.{?!Z]ЛtrXC8#4K*q%=1Jq%wL/k'i/[e<XLJnLw* | y| a糦[jCg]b͔^\#,٤nS\\yzd/&;ބ0&Xw|@X/*tD9dBw(hjl6!@ѠY}fSv2X5ÃV%Z'0$-t}?`;gb^/44]ZK; J$`D&@-}ʐ棢z∉<{ \c aK@ ]<,NM> stream xڌP wa w%H<5݃6UWT s}Ow2P֙ "B OFbl Ott#@h :l.&;77##vQCW =@O&bghaf Z_T&..ڿB6@G cC[95@ nnn6NvfT7 gsh0@wgds vn@`ma ueؚR{=ӿUdCcc;{C[ [35 .KL 05hhd7t564 .05O{NƎNNֿZdUb&"v66@[g'_D-Ơm`{Vvn^S [_M3Z8D ̀6FFF.t76gU^ԁ=d 8;}t31L,F@3 [Af4|G w6#H{L_~w_eВRP}v/:VF3#8@_|[FJٚf ڦ1vG*kہT P#1J_UD X[6'$ZgM,\lWtlͬF 'q wjۮY[,~]+:ht@WH%lL~1f6v#M? hg5Аlh +RmA~Pvɀ5c *fzmVU h-Ao,~9.~:/t^Wg̿v@#paa?tk̊ 6/ۯcq-xVPN eA#f`amAfG PY? h@Y?ꁲ=TRy]Au~@c9;c ˚*!<7qiTt^m.0 Tio߭lQ.={5|jSjaj~a"H[>ZDX4Y 'bڽ[ѐJvt:3dF$tԨognnQ3'^ch}#Y6f=WT:qHq nPGȽ潊Wܛx2hV3VZ|mv]lgJQmU7;(`T臣9WX MW[oպL-𗸾{ i7vyuX IjjQ/7sc3[YN%H*qTJ]rM|2 x!˴Ȩ 6ʖ}S^w.߾12o톪.jԑt~c"fB*9{-BX7XpQI/ZA$ɶp1@*%ѳ3_1+T\ [q8~]p`p/׭miƁy[P3;% f{ޟ4DUW{,xr-%_9佨 ߃S/M bڻ(emC j/x*9=7"".)dmE$CXǐo\QF5 .W׏G!ô0K)di_2,7=*tjoxKt:5HEBU&w2Kd+⥄l[TgO2HA"0 kfw}&:"X6qw5 ˤJz7%o{8WÿP<ŋ g(F7s#gvP%| SOB@2M'db,M~m99mxXH[2?_ Z/?J1HͰSP u#Nru cSaL97t.'(ފi rJe"#Ҙ7p;7!N@,kb wI!bPO1K3ancjf]u@[laSqh,:&d؅DAKkq lY[6K7b "ClAmV's9mTW&YWY (NAC^ِrr#2ůPԏ)G0qq 7=mdb܄jBT² %lh%"Bw<^#4lšcI`|}a.Wr[_HONAmn:Ie? c[nݿ4Z9VP(!Q|=-rr}Zϫ6e͞~p%$@5hua|=5/+ʃ8gkgP11Z# Jd!! 5BQ*T_o\ô/K~qq._" hpaJws_MYp% ] .:h$1`󍶡^2 q|;Ŷ)@?Ғ/m$S,,w\\ZN\( oMWəYP=vIgjV^swH 2ц{QuW $k;> jh:}Z4?)>^Ï_DOvξR+L֩]DKe>nXsI1l]sA7`o!-K(_52_^'O%#^|gjm{yb [ l y&ҼwF)Vk:n.H+cXD( ^Opa>I )ݔmL*,}$j[k4D&ZGzO"@5žß2C\gZaZo?hs'.6s[$PO.;(#JLw%f|oxZ,n^ѝ_28 FgYp& 5IRm{c6{{~f:'Ӱz3bw %Zdg~Mα8 n\䡏6Tu8aCݷEᲽ>ZwϚLa+\=]F? Aj)[W2/xo1g H\d{NIZrpT^y+,&-Fc;cەnXv-g!y(:Y$$(5L=e3: hHªɓ"OkʘFx}%iΐKHe DmgHjKCtob<JQV*Mx2x8.l8[ˊ0ipb{lOz2(t*2XJ喆)/Ha CJ; 6l2`0o50 JVHU޽"htUHf0)͝L}|cŸ|‹RxLwW(ȣJ!%t;}_< rų<\SXo0ÃcWק(qb{D%-?rp辒KͿ49WY=aTdCXwo)tj[3ՠaA gK$y"+Tk)$ 'Z@G|-+r!b-i c\sďFr/s0' lH'Q9Mi><54jE!̓Y K+HE?ԇٔntF ]yOSvB\ -7HdB0;.Ű֟=Y8,NV2MCeI[M/eokpW f )gjڧichʯg|z G V [.+W .>=4l]ϫxȪ`YTܒY ˔@qIhL2^: Z:dѪ' o&=7F#=U6Y+46ZmХc1Y,%WN>[5~?JyvGSm]x"AԼVgsPW_)¦/ s_T3C F9jrP>4%f\E}`gr zߛ$dnyJZ ΄XL>kXwn\MGt|w@ zsdB!b'䌂xDWjٰ$o|sK{VyK&'WEPtl(^!P{=a 0R2laTq9a'i&DH2-މ4:kE`'˽ 87d1J~mJ;)COlԂA0wG2rp =w-.e P},=SIޱі Z@*\?ړEQZe-j1Phc5mm0^_N 5EGlL%(1)v]y X=s{]~EA4~{Wd jw8Fl sإtVnpQK1`Nx-`.y_ lB.( S} |I5?э -la{}~S F9B~Z]`, GI'ݒ֥wG^Ze|nӒYn!se^>9o& qOi:+0 /1zC8[2M 9aTtNUJvy]O$})U)V{eWKҲ1-F5܉|ˊ2W}`7Ȓ ޴of*zF}˔5Ԥ7}*`=tybM|r,$!)<x:KΈ4V\:U|  ^ޕGoGΘ&%9* O4ՇjćPbuS?ofѽ`&Uj݅0Au0z\;~iˤm*ţ!,cܘ f:@R°;guz市{IBzX{2+"  =:`WCp.t!BaxE.;\Hګ%'n!u%U@:7@-p=tɺMs&@8uXrhv.%`X+ /օϧzG/A叠*;2@;ep!!Tn]*%^4,DNYOƤlDԛ66RZ'=j7,?ܼ W;v^o9}'^ZLR.K_Q~*NgaӰ0z~)&UD-++?sW|Oʞ9GЋWMJ #u G\i@:ַ1"}@ۮSw.=,5ٚUC";qS̚kw;][,f_Re _pOG92erItC= l҆^x0^zE$!.jawXyxd e: a$5>c}3u* ?Q%#Q xOHHBѕ|$k%Jb 2kQE(NصT>J]ۄn&TvsTT~8m%z4 u13;_3VZ_֤^$ jrFF&p[ G+?,R!A'xtfKV%.]QC^(^x -Yp.߳%iDI*zdK1RE0)CcWϻn8-5A08μCCB v:jȉeѧ/%cA^;|KGJq22&jy +셂Q[+Y\y`mVa+G3mF6V/KF_ezhoj<=B{WSn?6hȾ N7V3QĖ3ScDq_&(h9ġjZ 5D Yэ(¿t๎as~,}SJLFr羂a);{A{ܬo ]:Ll2o|I5|9H瑧JUI92z P// M#p02bڿW%6_b O5\̔<;`MQ|&♞Q\NJ7qmGǎ)t1pp"8z, z~3̊ /LokCX0rC?C)S4'Kn>M *(0SAA~>1B-'[L]=B-Z4  V\JThCV]3g^ -iʞGQn?B4Y}u9y:D 6PEk S8[VEw+Vyb*xKJ)}' (AԿ">`d'UO s;*z&"Co9؛㓎AZg™+mK; =)ޓ$^|6О8(Ag(2+o8%' w-j#]+$VZcg64@fcA7_=Ө\yVDli ݹPu  зg)kЮ~| `b웉ױh)5+Ἢ e8Egn,S62Q mPoKQNL5Hb Qjjm=dΗ9J%9'ʂkҔ|ݾ*cjzO6b8ؑg=$4DKzsJGu49C)Q'CGP{X*pd/VR̴0P0*\=Ð +KWbyd\!GjZ\pv]ǫ JVl0O^>P΢W]rdc)GğcV4w|išk3`d_O_$0&YL#3j-R5CȈzkXS Nh:gKe`~sW@߂\xV'2  mhEXޱgMxӱHY{1{}t$Y{sBtm_Fzs (* D= l)\gm%b&خCWTIq!O_O󘑧Ulr_{r;B cG5^)(=^}ډ\2q: l|nL[k19F{ͽ|{1BryS=VJruW: ;|f - Ȣ "*'x6 Kqc*qczE6Z9-qʳ46\j%UzJ$ݿ &r\K.;<^F/О['rlT޽ Cvl#Jey/!p%3=d^wis%/)# yqVB/WD3av[j164oϏ?C̚C"'ރd6}^Bsꉐu91 2 XhfԮpgec4Xo=/Ccs[WYJTsLƾMHF6bGCz3`rADtLfٺdi[ t|:7zESWSYtkƭuGD/KI:tJjlf\!h}EZY/\ Tn q(9o.ͥVxJYb@ٝ5b"%u5^%p|9D셏/ra{vԛ`]&xް#'TgN;ZjIRFĞ~ ZY,Cns8 eftsgK(6EFV郴5\) 3EC⾌+%o&Fя&BtUv:F>^8Z!c rsDT߾"ѺD`2'n}9_4Z4lT85ُSʨ+yȺ h&p[~󐣅]cSDGYG{QFCNRkOp:? Y!씑ܓx}Aۮ+mdfPWv^wc+I@2WkqX1ZBUȓﵕI#_\ 8.Wz90Ugʵ\8z,V4sXjpt3<:Ҵ9u5? $i0Idp e.ϊY!LQflZ[Τe?g-SpU$N?Ȝ>XE8MlDG.Uj6_ifwn `1ziuOor^V?6J> ;r~$(0iGU3h^J2Vª5tCC+צ3L5j\"WA+êRzDt(]y{ E {-++4;4 BcaIjreym7aT~k'2"jO{YHb 71%5qE$?~"X ) c(qV#`-W?rՔu,\BdP2 N,_l-NƍBc]?J D.noQ|YW`NK uK֎ 30[-soZϠT<"AD0F'2}XCqIvvY3מ}Rn!vSs WRS%knu?oi"wNR0^NPG#NTX3JB )NEnt,uu>b)_W:0Dk8WaLLyIs1ek7N(};yz$*Ut9fH=]p˕/9Bý +-%_¹3T  O2׶ְ{ .YL+G9zAcDSa# ᩳ~A]v,=״Zl磢 l9 Z`$g^rج'zt۸qg˧|~\s݃X4xݘZA-"<.EU3|v0F^6Xo|K&:;E@AxPuNw|dq%?S1 C558!۠C̉i<u L(R^^Ū\O3^Dqߗ/'[kvE^9ŲDdGYӮ{mը((͗uc6D07g煒4c'6wǤ: nDs8^/0"h^N{lUдn'P=VP:`pޯt M07t)Dlem2i2'lʛu[`lDS#nZ8ˮ+X+,n(JXLdR( ̈́ؖ *rr+s1cV#T(Ir*>.mWn*X +=~ko}}iA*')A7%d;qD ƥKUYA $j8u[u.m3>wyO^ΘʰT5I̹y):JA /:.9 d5 1T2(Ƕ=gPk{Ij\ H|'Z ]hc)S*ﳌ;©``#ateZ]cyނFhggV7p2'f"5~υPa7'ezc{K1~",Q"kݫElgw7\a^h:R|~G.Szm!Gv0w}Tu5Y5g}ژ9QpD3nbfQU'`߁ Ճ9?w.9?1'gڃSRLdHU&P\5]ME:Aڍe'v#tV$X .]jVb'#7@NJL0][U; FDj39-FBg<YӗQN)$ØIlE1l08ЕcD]iq'j;JдOٺI3"N~k9ҰW<x`M=f(m\ Wey䦐) G]W庐IBcWPvqFF8<|wtll"i"q7t ha۶v=,jV΍hzL[>ՆVWT\ҘCv@nTKsUE O=GDI3CFi-\NA*=6f/R'c,x =__5d,_>%oy|fF9'xm,pױGUL 2ŁTD|z^4C`;=~K-m}Ѹ#lL`OQb5RQ^e_tCDrum1^oWAd)2Īa\QmnuI/-vkY# _ٳ B}n0/<<tֲRïu(hwJ6 z}6h!?~'~,d"SQD 6ZuJ#QTzUVw5!L g5X[ɨ\0Cɡ1O?lTR!2R)0r I;&6q; a/9&+ە#~IzxA4jAX?U!lYޤf}i$sRmao`I}@Z}mSY(16?o.Z1r+ M(P]Nn-ݼ|E]˒(G?a7ޥA[MdJ~ICeGv,G,Ō:H*&U7  AT{b]O%ٲ%->/X4DkE7-_C]2_k@IFA0ϛA =+9V9JӦ*޴z Pk ~['5@%'ljqGƦK@7~Sfg%/GT9s5a8y%ỽ[²C، qk3DR֕ro_;ۚ'y!&}t"}kKZ'O<v;KJc4DKe$vC_jXsi J#*}|mqpo`:;BCFYŚ&fXcdK֪ܸy4("'hqZ[? ϣhAWG3jlQSÊj,r|>W .Rr <{ZA URqI֟`4wP\ҽq sƮUcά_\Ĕ=ќ HAMfP:|>H?q۶LA0anuԳm,Rw0X!y}:4UFAVs'mpbI#!rPtT\3;*7?_# y@x#{4޷ r~9+rV55bN d$odLe8%׆5L4zXoAk nryӢ[.0 |35tēޕV)Ez!]5X#K.dF㤰 q|JB*fq$ʬ#BrZW 0S;Fk%7E$l$VKuhf01l~Ox@`찶l\`)[7ʲd{*tՓTonL\- "Yk o?\ LaOX7ў|׃f)|Z U϶'T'9^8?d'I<Bנkth~xwU 7fʅ=aT $^HBWl,ЊwzLY0G:9G\)ppK"V`Q&}lPKlMef=>!L$]R)Iazح52*ÌёbEoޯgN\S^kє3%Z CנU @iWH@@C8ҁܴ/cX;L- rMMU j<'Qw GYG␼ء5P B:0ǜ\HY$>< L} niYh+W ՚Ys\-[Is2 \G]mrp* $t&\\&Y/( Fܿm2+&pA=| p~0aCsKDs4޾v2e7h3NΘuO;sN51~3BSey?| AGdߣNc_ XYhGq9˜q4'[|;0cqؾISr.x?<37{OEdrE<3P&=PǓ)׊J`p*UR7@pTW̋ QF6Ĩ\RKE#űJ.@'8o( 0WFb^ļ+]:zt\9֋ts\R ](set{ mIN :_X`S-O?DcQIsDn=oNu~Y}.9RNΘٲOl –O- V 6E7,lVG eNpB}IP\80<<@4D:l97=FUXIpqO\J!6s~!_\ _P` G/_WOUo% >=쇛$!]bUl7]zatk8ԏ a *2Q@᪡nJ<.|Ds%o&R.0W}D)C!CjfdFaz51Trg&Gro91CR7/jh)6rVаp] 4.ul%C )ʍ6rR,ԑWA6vC;xlDŽ) \҈h"'!( y#\yy4!gGi1 4p~Xwf5 d>4`BmX~l0T?℅q& -u#k}Z)@ պ"Qh}]seK\2ߌ LpM`ir#^*?%W*o'LּƵ~м)&0@H"(;W{uL}ё xY3 {Ǩ!|/AsJ sţُIb㦡BvrgE&va5LC? ^LTjxmMTBgb?g_hH6XVcga\_z~.h5UNOKt"]!sN*E_x˻knH;t%+[δ𛤤>i~,&?=qbI#Ѧ0[K\w?\k]'LGy/lƆ< '8]3V7VtCYkӟBlCo+܏{I|-[\sWZN}*ʻDUPPǽ*һRHrVz8=$Ë5X$.6 ZS8$܍Z17PEo,P"M)9ڬ(W]57s?_ N3#o/yߪ/Dpa% 'q;+cuf[Wx0|h'g‵JAGN1 ?=ܿO"fճ-T>3YU>P&wop[ɽӥ ??Q|Cq( à AP=!>wv<IjEXƻ7bJѮёB:14P@(56u(Wr7wrWggqM$=G1 є; ~@j3!iDt.+Μm&{[P]RFE[H H]YCKsI}T d=`ATkZC}2vzje7#oŖ.઩l\հye#7P}iVfk#3IM)&t~~D[Ց,9?v.zMt5[>V SZJ٘e- ~*3eq6o@ qP.\sI7J[v@7.Js1+RMpTz[!x/31FnooD&*2.UzT.tQf%Ê9rlZ!|!bIA|- B{ 5X xH̨gYFhy.Q9!Ԕp+Kzm5 ֦/E.vkO!hE[G?ZCPvs@FW,x(u-mSCt#rW+Xm+dO'g K"uZ *uC#SFZqkO4GSv g(^O-͓(vƲ>ۓlop5F|0Î~ξxцϣ$VVU$MG#ox %l륾7 7,&Z)*c{ 8 ڦ'( 97qD\֞?%/k/olvكdOpA55UtHPV\v` tʇDDɦR<myH0=t;3c>zz=qoY+Gƨ~ɮ+:! E0g|j:SOҺPB͇1_`2,G'C.$X-+x;i? ӵX`U9kʉ1 ~lK:r9 Bֿob Ը]hyg.ky ^sx;yjoWKa|͟A h=#iCA.Ô ZJ.{ I9_Z [CH%:DIsZoX"$pO}̪h&궱9AxG~N;^xaFne9AKy1[B#T]Dޏ}/:JVa- zIRqQn)?LnTRϖ;C|uޕZ0& TAfW6t*Z2Y"um^v`]Ыc4{ m1zc`a+ؠnӯL@L?GO8x_I5W߇9N,J8Fј [aN]^3zz˃@ˣ@B$H3ct-BG8S d C ZδšPOgdYo0;묉౗zRNIX4E| @=[inH֡ԖQQJ1mYeo `5mY%=_Q=_deݴC؍$r{2̪cl`f׵Zf^p̈́ EZoww 2ZE̍BZ: 0q"hF֥ >lO@3C=a>v :@Esó0af[;ZPC .(q3|m1+zy&͞rֽӏsኗa.d=Zǀ<]fuȝZ-gZ F#̳˲Y<;Wkqnb]wѺ+M.HC j/5cN܅ɞz#Qa5𰑋f4-;n' DZj9MV5~' RC%ZX`>e:2@M Eee2OLL1ZI&hf}n|>qt ^`*ϫl0oWȊ}b Ԛ/*$Z`j +vdWT6}OK/yD;jg\|(s4f⮓=~tn"\qh] [&{;daxb(㭻LD;v.rp'{n0㐚@{k٘/A97짲 ﶾLC)3־X:l6rA9٥GBts- HN;w2|kUGSiߗ ;G^|9)Sr# `o4G|EH D3ǀ@0rj>9ky-D?$TŀAkf,LC`pI mLIVuw[] =yL pvm!ݘ%ۧq`1чnV-đ+!]şuMsWdD _E4Oܩ}9m N9M:RλJs1@s9zYvxuuTܶ|RF228>s95JU*%q=rse |*ň" &fF\zZ~wS~}z&t{W/1 ‚f` I.  ;Dj,˪P u1CP;E}Z$"ŻG;XX3=؝AS=zk#mgJSn.U$)]Nxb:|11m0I_$jqFmpXJ'}@׀5ʋҬ[snU?^X>`+j e28^EU~EL?";TvUX'U.8K1 L_f"D0) Tn!PsD*y&쵁m纙5vVjB- OH, =xwT=kYws9n} PkD&'I nՔ+Y y4 A?,iRԿw&_@RC=lwD3SP1y! Rl}Q ~,h)n+JD&z&) $aUcO wNŁְ'Qm>\3'[KC@@pvɈr9,1=pG0QkHVݣSvc+d:Q}5Cpe"K$-}c=dnKW`J=E2Nu&Fniy+>v:a`yOy . ^ : 6AJA^va*KteXDn~P,h`wIr <( LJ`y/3?7 LΠ!`uMVT6U8!5 4\faG˵%`Gɨ΁K- ɗ:Qڵgho (}S|~HcŏA:,B.?a~2%ð3n? 8ydHP$וU_ .Ã]M,_s.vB~BD0#bcV9ia,$g<$TҜth׈u:g7_fj[]Gb*yrFg;f&ɳULW GrJaP%Km^+qP-< FY9"QVoRboTcF$nbgCO( U8bfI=:JOtn6e3:@*)S/&Ȍ0v]i%27֙ ٴʗ& (LfDӐ׻btN=26y9vEו,Vv=28^zJ8򘜋%cY2 NKZZZl좴.ȥG9mAKK.} eg@؈[|cD+6Ábu `?'3֛ XT}L$ߟngh42ǰo}K4^yJvu~R3$L+j\~ޥU endstream endobj 241 0 obj << /Length1 1861 /Length2 11182 /Length3 0 /Length 12351 /Filter /FlateDecode >> stream xڍP-[:ww>  %נ]O4X Gɹjffu{Rdr:AXl)e 'V یF "HAAn6isgr@>A'NPA Pt\h`` pA-DKs%_)mܜ===]ٜ6,O-@ z4 P1w-@] < s; <TP: " '$C 6trt6x!6k*0XA4wpuz70;[< +0n\-`g7W6W-y2+)'GGPؽY{'o` XYф36RlBmx888 ҖZΠ??:;9A?h o#4 `tXlٟ C^Cg|g,/+'oˮ#W$%\VN @,j࿫vUSn0;ӳhA7|?+ϐ?-HO7ß7YnWvzRuA2 ^7=83F, dvK,ٵX20 U98Y/"t翏X:Ya<s(YH<<_*Z0 xn`EFyRBv/]7zf*Fv?]7kA8s?i=-'n/[;C_n~.9xkq ϧN=W\os qYc+W\/7Y nNr?O_ ߐH<;}@пKIgp@^ K9'KP_"Ӵ.[ TƚuD'm+%ߣFd;{DG dZ{~.~:Am݊.j<*Gvjx_bՎ1 *-ș%zJ„s9su=7DȌUkw3ZCLCl@D3:I+H8[VM%tL:3h\N2)YoOr,JB9[Q\RkpeQM?:5hkGfcаOmD5aD  Y~^kj0!oze]tE550s3qw2i{oʑ6)Xd=5O3[rk6RDX6&CG/j;<~EnUhWGL~eтC|Ko*dX։s\:E8LҽN¢:#B#jWnۅpOu +(A:C{*/8l}f9=OFnlxӆOanBHmL\0 siN ꮄS샙#Tpaz{MK-Iw 4Q(jfoԄtz~/N"κc|1|Yx%ǃڴjajqGOھ ef7_OIgw/*o8y}͜l1Nc!ǂlɕ+':T.1)t2˦@-I?F}yηIL= ߠ1$QWwsAМ^:nG UcɃ4bCI6ͧ'MvZ*̐2y!1j{V&N5M |=p;pо0݉1YSKd(!;-؁ ,E^m+4H1gTF"uTekG< z\;jill/MOc*MtSxb-٤ZԀ' CV)ѫsX}b$ 2^V?_2mDr X|z~ɖ}VnPK4˗rd=7f(",Ǫ 1Ff7yl3y Q9כ%PPlxhrTejpw\"Fpa,octx>;$Ao38IKiџ2_?r3$u~QN;WMm3{z׋Ŗ–&L6io*K`k>w^nyo)Ml15MGv)LLFY]'AOku[=ɖxj ;5B|CE-KD<?LAnŸg%cZ ǭ6u QDjHE7lw&o#-Vׄ}&=V_\>kF+FOSˆͣP Nc$mڛW=[RsoiI5~ M9ɕ+ J0gɂMf?CMMp5V*aJ7GH PPO!^BJ>E[wu wV @[@#?Q֡RRXJl4^,ۍ:iG_V왴Лˍs0yy4X {d>K(Rq "$ WF +e\U&c-V-߈G|Uk#M=md`tGKZ.>D9!3e83]9C)lHŸ9KHeQy _PbvȲ)Oco eJp@n-8 TPz)jR#7DL:]-hB}\4MgGvoEե6%+02<){G`/Pz@ ~$ɂV|(-ߖ& P¢ڂKQB9P@zHDeYU+EgJࣷ:jWq<[|t( diFSv `}5^*ˣV Lb" %o,BcY!ʼn5nIM%Q6t#Ӡi6i,ЯUPhOQ)ܷ4֔C@Ce tN[A}KГY/1}ڮ ؾݯcXfH)kH?$|-*IVNP+6\>;r`q_(I2/Ja,#sdgQȕ+[BF=@R8z 핻`E$1C{קO#f(6HN[OY"*IB&"UI[OvQg\4L@D$s: fK,"_xRCY͆ij>({#5ѹnjWQPC&" =wB VqN3N?KMÎS81W;*P"Ȇ^bQDx)'(tu`Hc%uh0u>g߲ Se&#i : 쓰99HՔisW5stQ^m鲆Yq{+g`VN tf,޾נSw X%kq#5;7!kşsIpZB\1'_ZNBE  >vH{:;@:naԬQ6婲A Uh[.O}1\gW xa#̡lM⻐t'E)q8A=}cn],[KL:M+Ovq7(rBOM:)PM Ixhc6ZIJ>sf#p)2/gFZh,>m9cF~LKnt_h㶎v5zQ('|QoK&J`ub瞗-V5{lŖ ÜŨ9X<Ĝ|.ZVPU$1att+cxg@zr2OQ']=;H?~~u*{iTL(uDEK?ڍi uY*HDQ*K#W($#\-f1m[P`|6u=V\^fxDKb.ݷ2FD71sw4# {`w9>fdRCƖo&cCB>4U*ru,7~Dr\tlA+g)2D*Z3=-}\lag;p3mb\(4&n7?u NOH3A6$d0=[Z{B:Zjss+̕{Fa r7 4?k&.I5/@N SĽT-ZӼX˯ҝφr7ڄdK)*IȔ}Mc, h&e?Dќl΂}#~Ͻ8k89u3w\ mE3cjhժ[GD1њtR&D4ݼFXM,덶u뢐 4RC%j }`)|q/u ' ,&/UV֐ -wIWKM@^[ZcS# }Κ1HR .h^ K$ci_:v1ov9= -j{W Al{N,]:}b Ik쨃4_6v^jV5%&Sq,T} /똄5?( .kpmJp2XEJ20!> 7Ԑ5Zp"OL*C0a,s= Tr):/QB޸`ٝ9ϭqٯ?[-#.\LRj,Ib]nޭGmtqg O<}~+z/]C! ˈszwU:/xQQQon\ ]Gl-79L31wK"mbPB6SDoA!h-#q8i$h#Ĭ.W›h vyb~|]裈\{LL /9u.C[4qlC"V.C""Sobyi[TZr=ueqOg@Ŵ ;YI*W)|% X>Ɩ Y;<0Ǚ7=:f%<,/%K_nE%𬰖*sf8Qn[Lm "p0qGtxr_LWo d=#׶v1+%MΆ)k3Ʌ̸e6V]Ucd-~S;GZ[Oء,4 ^~P.(!N\|aL.~OG|u3BoŠ3c44oBS((@/tR-/9-MU[iاor?4n_uK/)-Nও#@Z8ӧ0 {YT߬Ϲ:Ab#YK'S[OD62Ry}؟zڱ\$\ng˲XhAfwVg}$B@h9*v3\<1}7Nj [\ڄ$ Pf,l4w@i@dY.,Zś v~ݍcw̏a ~ThR4GT ;%r- ,IDqΝ]Aa|FvZb#_8ꬔõݻ95ݸKj-]x>!V%C3j{[A1XH⩀3FL׺0pgRvy27M %ܦXm%WQzmUϠ;k"%TÏ,qe5+SFeNcKA_UzF ގcߤ6d;ݖ6ߔJwA VJ uڜd&5ʟmyx#4Y&)^G./$Z}y }ӋB0"?4BL >WU3MqxОw̝C:O@zwBxu+ٴ]Իj.ĉ687-i&KbmCn9̏ 3W󳐊z;)V1 9rGaYjjbhyu{9VL:q vOڟ[$,{!f՚#<ŽmI;2fՎ ]0$fC$V>}ׯ8+؈X*ʱ/5V:,iZGձ|h\A@ʎ_O>ஶ/Ci H#2[7ޒ=tdH޵ 9hl (ot=\O{2qy~o~ϩ^L/'{I%;JgR".87\+[N5 ݀ ξ}J65iG xfa4zD=S&*).μ*rwC;_/kYƒyn~2ޓ  ΢ cinGe4Zs_sͷ"E?}ӾT*9S>1/%g4vA)0gh5iFbdE[wM;.>W:J"8U gX\3kUM-\q#޺(=/BDmHC)ǫҾ(0IRskvA2/Ad'iB^.}*vU%BUn}1" ڞ-(>_ E}Uߒ]LWDAҏܿRn |9Tmhuƪ LqsVg<ԘSY jT >e+&j /#!/2(bS_:[| ơ4%Uz{B|Xm å ΂'v82It /8#jyFo<;h|Kyi|Ebo%T7L4s?t!,='BOx^pRGLvai++N٥H>'-:o~n'A`Hc/yCq M=kzδ9'v$SSUٛ$J "426KJk]~ZȰcE-UfMnm4jUHsr -j23M#c?WEU?INNPwگ#⯁} `GvZ` FmR"X͜4*^DʀzK 37im|Zpؠfj=NEb^!KLڜZi+T{<;ym u)-'SCl!AmɕutMq=v]tjQ]3BN6CAΕ r*jyl3n-8ib*aE C y뚎fp4㕨3xa$]a&&/'+ݯ%#Pː5x.:+qem9=ӯx //ċZC8YINe2ZⓚA^wj]L2tkI_ S.%L} 锎"iD*!<Lt #p%Lvˏka8Ϻ<#@)V,+/IGN59$$(F[pAz@{LI* ƒb0[vG3r,j )e ( hE/U#HCwY׌KQtdDt6Έrv&/ Kw@Z/ ɫ-x>>F!At19e  S~4XZD߯yc^n[+Ј[]zܮW!E T1˒$ XPNB5H3{Ή&k<3 {7,2se3p:~ ܩvZC+ Ty;H)~`xQ!g|aB X$ǵeBC&vɰ.1 %6Uzs>/4&OV"+/AqҬ/[fKGkˉ")SE¼FmqEyV- -N?u {)y^8gnק~VJAS5)h-A-=#mFDUyՃU%xᩩP{Tl4I>^Yز!,mL];VKIC b3u}H-~pIo2kVheMDv  +:F6-\D;BIw^G80WQhV.Q. endstream endobj 243 0 obj << /Length1 1629 /Length2 9075 /Length3 0 /Length 10136 /Filter /FlateDecode >> stream xڍP. %xp,݂ 2Kpw ,N\{p@={W[S5=mowOw}CO*a 3 l@Ab9 :`g */)g0I& r}SA n.  csH!e6 vA9z9Cm\#! ;@ A WӉ {&v 6l 6(# jT@?+cCh@\k¬\=@`b;g[xt0#x1;_n/`|/t?)E~,vؿ 7_)˿ /_):lc`O B(Ķ:R̃ukTd~K-#sO,TA+W]82 TjQ›[|M5ƷZKPjor ChoWƏ-YS}8lfK}3"}kvQ`{ibdWV T&O˫IG*Dft߃Xqoʵ8]:HH )._zK)zE4 qR1>DSf0 m;؉"}p6}zFU5z[7T_γSA2f fPa8b|e)*s::AnY/\a|HuX{+jbr pe}^N56E=km!rR^P츗\[i VZ@k<焉%#nDo4Bo Һ^nN]r^1yLpQ{9>LΕ9!uK>m)BXYk=^_Si*>TeA-+d2ޟ ?5ąf XB;4cjA G4'r9k5ؤ]p(=e Fl2gG;Yj.;BU[{S6(L,lx>[p<$[eQ o\|ѸEzs=yp~D%fR;KN4ZȔSeᖭNHS1 Dn^!}YCɃ,1%Gd05(xf^$oQhl1fô2>b,}:_Ԛ>NߴA:N*K A{\J湼.{yOn(4e_:j$T_đ֦e k}]t%]jG[:j9t4!SI焚×JgʽkczZ$/4B$0=n8tu&6Ґvp6Pn /9N+[t. ku~CÛ1ȐJs0Gxx>V"[AK{]1&7?yP*  v$\ܔ'˖#Ё UY^(:&"G!T? g ]mI1KDƹ,ZjPhneg޵X{icm|L5zP C Ѿu7XMܞGEblKtጶN*FH-{UJPc˥.Ox..E rݚFE4`Sf(;9tnI?᳋7vG%¶09Y([QJEF(`BR(3PDQ-}ްZľiFs ϣ5[?0^]wʋ RB3;UR3jI*.e4gO$:9N]&WJ 2pH`ucSNodCit Nlϋa) sTuzm7m[zRyGzJ4o#BQ=xLǃ Sڨn-`D-cf?Ҍ'P&Dyvh;&8} ]rmE 8S/֜9<==Vt&i⧍bnr 7R7Q^Et:~[q9 0>Vg,y,9ة[K) 3K*U0;D p/k=5Zpqw׸ֻ55N9|I~*UKEP!L{ "D/|;bm/;֨㢝@m7r."4D)3lv8,vaM4K !ﮞǚoRؚ,bd]XpxPCVτ!fź[h3f7JoG\-ڎeEz} UIW? o2I3MisE|" , ج }?PLHQVKG|py55+$߂)\[IN'ypdKGRbjBxAD^l[pHu IW9(t#𼁎t4qL= 䆠Nu2Տ{azyW^b9%C_ HY7L>˃?L 6`3_\tP>=i>lYymEŰt| $d!T-u s7R}W7f~j|+Ή ^B@8/>ElX)`ӫ/뜩ÿOxkr6/KzC/[r_֐Nt[.Ni@s]aB=3yJVaOtTC>O 4jTv^+ 1 SziZB#olG"!LrTG/v֓vڵ T}xføώ- uSfY"kxIPḍh3ݼ&[]/[l]HdrEiu;r< p$pa9in3|._ o{e(rp<+CRx؍PTc(]K)O@TQ|*Q+="?8ӯ_->LJErG dk I5A:A06eEk%4#׺`Z}z{gz*4yH/cCĦf֞y&(P_ͽ 9Xn^ ڈm$dՇ>ᢈ|"!Sm QɊ`CM` HtG^H_"ۚ7 ԪGnD4\20{d{pL^ ~<{J t>\wi^"+m eT#`[8\$PoWZ}&cbS(zuމ<x]2,%V״ C]g)+,ܫ{ӊ6he[eiQU|=Z#[%9w݄)|M,@e{H!J"\ٺ_oQ/cw+#YJ7rʍԐ:^ 4Je&֨@ԚS}5 (7<雗m w-zV^WBΨI.ڻzK Nj٧Cp}#ϝ3x^71݈W5ܬ=ne ']y=L]b܌`~rA>3@YUcZl2ZXWߺD$)O X=#ϱm#k?r?L:,U?3 <-FիI5ހ/S/|m;Cgl8s+_fcJ;!gWfBY 7fk%"d njͫbH 4$at-9fu,1?RK 0,"EI䪋yc_ႃHrПN)eS 8L&0Z}/]8R7d٧HU^MFL Py#z8a/P]7P]¡t9%hc:pL_dY0JC+vOwlշ?l,/ėˮ ASZR/#ޥ Ƅ ${glDK"k:lDrqߊ@`s>[^ GAY B!/'dĩS)[/+CN/]Z:N1.F>'X2&J!eQ"SϙsC?{!u<ŦsD°iu+H=\iOe&+O-ϿNkuH͕B!gJJS58*bGj7+ɖ 3{~Is@㖔<3z *%ql!l bv'YtODœI44Rt+fӎ%>Q#(CE 5t6B4\hXu16`#_;RƚODL߇ k[Q?tQkjC[)KqʹTaaI1ZB !<ϓ.]O~ǃ{*F]d9pZJXIhm .4Dqޑ,rOVz. c5ͬJj-Q+04TEn\ TE?[CͩNLTsNJƝLd2 }e|w2Ol4Y+;NuIĤJks,B<ͭOQJ[caM4Tl!"ݔZ8!+YI>1hbuoSoq*̴XBhR̵\> U{=IΨE.!{ooJM^+n W*VTD݅=SxN"0fiO \4Wu <nHH[ϖa`Ƚwh8: baNVH[DJW>VَٽEQFX4•(C [%8/EB ЫA !JwbP3\L7&IŬL"4˛]Ls}J:wMf&|S<eZD!%4;Pv fYKBCÈiaX )Ct˭!f FļSLZt/j-Bd`I1TlSّUbiwDuu?Q0 RK Q4kDjcԆkF#d1k@8CzFaavODOʉmNX8}Ѩf1a9 I#Q p!32s2KS÷gpܚ*9b J\z56Ւ2´Pb0;𺗊+末$۬CW\ \ nfRTb 08?.3owASEft/s}-Ϣ.Pۀ?y(t_D}i.i)XY{1H`ˢR\7؟PjZĨׯ֏a Y7?.s[9бa֨ -djN֤RAXu ]*HKr1F`yŌLҞ1+pF:S\-cuv7G { I atUXWGGYBj&~)I]ppd~4&x3y3+9S9ODb(xyGӀ.K[coK;x ć2bo :=omn&$kLTka9 L 6ۃ|f(,iΏѵ'趎95u⫮o0œO퉙'T5JxA?m];l=D#hRO~7^=PD9u%i)A+(-v_ t{WuDL 6n a~~7%.cAjλ׏fOke\rj䋉z/ ;"qS!Z9]f}!)йFz4:D2ՊR/#XH9^g3˯ֹ΃k}~PJ)F`tb̵' 0v(, o\bGF$ZX/.&+ Z4AMa ˑ,$c FsV.sܖ5u4^k=ﴝ93+9R /V:VB{9AӚ@lч@OpO {údQ%s-u qa 'yy`dj,ӂ J "Jb7>6&gII.viW?8| sT+PG`y|fgO;ማǠյ̼Y_dV>bEOJgbkK'P}E@4Xf$\ˇzyrՃkxsӅ 9k5p Þ)L/T8TeAwgF4txsj$3 Pğj1,y9< D8At m"WՋ6U^uFl?@{(re,G1P,K2Ÿ8̶K_ەZ7!_XENOρ/dC?uo4*ͻޑt19*v&Q`86X@Y ñ6 ?#'?SX[cj;Vm2z5@YvjK1& P OMͮ9ȨjnS6{gо%֫2kp{SEbcUdn*2ٵ'"ru]KC'n-8R[pߤ6My܍%ϔr[sMݕ3J0[wbm,lAm 5DPu}BxiJv&:}|p{_.p-;CGhY8EsZ.A1s<{ ZnG<^/bo^gө-<Ň7q3w%&Plڨf_/DR9!, Zd̖*.?HWPVrJ= G\ m/ϴðpp'@V<]9E2:Sj,YƆq*NVceyi2/ dI pGX ;+^J3;1˝cьx-5޽- :+O<< ϐo$-vB&@KrXʿ(}`-Pmb6߾641Ҵ䀯-!+ MSa"3WvW,Ȼ!mpbN+жdgR%MhC5cjUFJI-2qzVz]m} endstream endobj 245 0 obj << /Length1 1408 /Length2 6401 /Length3 0 /Length 7366 /Filter /FlateDecode >> stream xڍvTZ.!0-!҈t 0 0C)!"]Jw7tIRt |ufk8Xu`6`U/$<"@0%0{!0?[#P:ekM {DBB@ @#Clh aP0@#ۖ $%%; ZCZG+F[k>F+#&-(D"]0<|$^`;v] 8B0{ @)\ `( {PwAm70>_ _ ֶ0W7kڪojC[{YC\mP *Qↀ !.:5d+OEMGZ0$Ղ! )Rs#b@ PBRvm%7q6 RsQ- ` @xxb؀ P`?2jo)Eg,ts@-LU  -[OcUߴs0[PJEF$ƨ'ǯx1n0ek]_/lJ8{^2;MqCqTv YJ5RlOw' V4.r O↔ﭜ_VϮyW.צ{qf%M*<#u^ͤ- 44Wi&hмFbl4%{f.=45$#(`1zlڹZX\ϲ^܀˷iL>ȝmLfDc -j +^$G+mNjASZvWb#'?2Şg$Ê-M:qL|kV"2I9r»;˅9ԢF,Z_p[)M;~ڻB[t 9ybtgijw̥;v zm~h&lɹ&]jݥPO5l)};ML eH, ,%󯛤v+j_.SyoM_%&!&HSmӳ,@eǍfJSWšT W[QnL:wlA[5K7-y}2!<ҭPW"nsЮ]G΅sCgaƒ^ VOe͡cnZY !=i# w6)eQ(6H٭w{dnH +vEj(E!+q-a7*oϽb;H ͳ85_v%| 35&wJ$`w;^(@s&zY<ts}55p1_}y#e!Buu'QG׶5(a$!N =+a7Fsi]x ki׭.z&0 y~ bxyR#qp ;X%  ej>7g*dA=bԙqi-UZF@rSr=58CV@vaK~85Wƚz_5Oh9|1CB$( _B}]MYvzik*U vu 5.%o~>x|QFGZ](@S"f:kMHIԴkW5fRNL*q:NfsuÃNty}:a&' $k+0'#DolhwEyyj<`;>%^ЭP;Y1i7~BkwpV|~n)liY:qydHe41vB.Y >D*.ݽ!׾n>ę ~UJB+`g?v`f|5u0GK[>&hKTr'ٍLD (8Js.A4+ۂwrcS -St)-]kIUȵ'uM*;Xyl ?ջ ,',q-.N4lDٚD``»k.6n^ルno"Pԯgh(+2Ohm|NFth6F+/_BۓKԇ&eqѭqZ`T3RŅ'xNcxj{+M{$?8^Α\(jnV}+J'1 <*WT$813[sОGf R-tQt;,0pU)pћ,XV*h<\@DF\~WΏvsRXkNESYRз4EF6;2O,vƌ7pS~ohOYM!s)Aw.vĚX}*L6זiAHikh] Y)½,?ZEu)c\+"8xe]E6 NMߎo Wϐ,jYX6nدN (jSx/M pqH# ~_dIaӽQ=s߷<]_c;Gquf-иܩQah6U(oun_AS)DF8_Ul" f Yڀ,G,LLn`lHG,mL~暦R|=J{&$ܘ}{5x'v"^SyQfK(/9| n*l`z0Eku0E~'Agxݒ@Fo1ح^D"6,BaN%`ޅmHPw>t~;l~*-MN(l7D%\Pqfh8QoIi6K%S{sи_ BV t8I=MZxA9u gM5dD |"Omu\sQ;"~ri?\B7a̦}ӲJ ѾkEWHSݡzH0ynC;yfW_okvwK}I)>m;%; 8ԿDCY"ZUU&ݬ4P&-)n (Ss:?i_}\Kr;ʦ-HQ{nMY+[nzp \T e: grzUZ%Y3g`i=谪ȹuI(';ǍJ..I8^yK˼Jz`S*ӝO,&%3$SGNηF?^J8 ڑ4y;{7S[:L8^俿;ζTтW?Tcqa+0^: {6S=eh5Igqa9JņֶgD2v Ş:hRxviK5@ >erdý?edPfP^Wi)S15q7YZot O."9FD\ә+;59ʨsqP6%'ظ {nKQB GEHbz fzNO_ MȻ#xF7eM^Vwȼ;;ޕZW!lMv vBhEK}Co% Ќ:f;dpg 'ӎU+-Ëp9E%F\oU#a-jױMؑȹgc~|cK$WrØ-5ws&o|%r>ͣllZ&`|pYXTU{V|N@z\cwAQrbܖ¡.5-a/KSNO:4˻o .xiJBXXm+nq9ee޴$5}.'>,m4дKBJ#?~NPn]C w\T[[ԤD4eVt֗9~g⫚5 a9eN/.SN1exlvQ& sP,Qݻ]gm;~!=vp Ы“<'/d4+7#xޟZwF[ fH j>s\d[snrg~%'a(/9桏ODA:< Nr*ZU' vF5(W5dNʇ[VޝDyNq]7Euk _C| $uB8)zc8du1qs_Jtky zK#]GG뎕iP]ʢ#1yXΫMT%~4ܾ碟m&881|%xⓤ)Ǖw߬O1@ܔEw6IկZ¯?T>K eF39~}5I^%z !L??ȥ,<{ X }4?Pëvr@_jc2lRs8QB$Z߾ӸpւcQGc%4;"f*KuƠeڷMC5/~t¦3;$ߪJPӾɾ?%sպ~Zgx%tc^ M(f*5 s2L=.4GOϺ֖F&^D] ʝ^RO ]pF2T&O,} _,F3b'ΔLж:=Iq,6԰*Pj/duW հn_aw{nLGvw񟅷8rLŽ؏/>NZH۽|4~X]6v~i^+9@\oƂ$Iu S:YwZ-?y䀵6"tM&V*mZ=Bl!;ցI"Drs%zq){. dht zuj^>Q%LV^h2aٺpIC.NvQD|~gREKE4&vU_Z_m% E`}xBFvnP?PC>m'K0za8'ܗGjsTxL=BAD(|<=hUH}V(CUhnl!GY+7weZpwkU? 1"g$մM`R7NX$MϽ#Ш_U*شI9&|W endstream endobj 247 0 obj << /Length1 1373 /Length2 6096 /Length3 0 /Length 7038 /Filter /FlateDecode >> stream xڍwTl7ҍ #FnPBc6F74 !tJJ7H! !Ny~;;gw3 #E@5}I$&f0/- !ˮQ:qG:n1,d@>0G@z~H S_G "##%'E `8@rc*BnSE# !+,+vB y0 E@ݡ"\`^MN(_0 (`(  w"Sm=_Ww'!;`nP Ꮏn^L< s;`4h y`n'd  GyOB0[sp/<௳ {Goas8FE3@R2'Nnc8aF/BzCA08cPd#ah5<'[ p7\f:VIU @ sg#0.@Ն;!25ҿy&/ B< H|O ݿ?hz6V;o;( ]0ojD& u4 .A/oP#ˆahxaŐ%5ovJHH$؏sI #a!8 ` 8!$S\ y~+Ș:(_ H$f_NCh(dn|TvVrWpmDafW0`0:'|S%=W y֫ǭo^%%-VK|GLy=3"C-MnTHsQ ]]0=f^-KzY6!`oV X;NKG}ts:oU'$h'A8jU4|LԫɊ. 8WFLPi"n+64M,lgA-tejq uY<J |~ΌXz^Pij<@E{H6̒z*֪r6YwW͔%IOǘ=OC SAQ|`jo0(97!7q3TX ~(r'QDREE9/$6Z#Q QiqJ :uܮq=.gmnXN|\2~eZ/ SߴJ*K[ "`AOt>>{{\S*gȷ ^5Z踓݋|lQ_tzO`Qcvԥ{c5.qv]_$[7(4$ZyP,l#l}"kU[/-uinDdH>pG+fܚz`{AEWrkl>^yӏ&IqTt>V48˳mXmǿ`Uޒ|9]\Ti=&Fu^V—LkvCÍD9)'jgVߦYwqHARK=O՜4r$.4me] 91 ts]4)Vyv!9_"~ d|* GM5jH3l=xZʼnĨ; i8=GH=y[B~u:od-t$х>gv-VsOzmvJ/11r QqΎ!enIdRPY)/;<Ig^\]RKlu#5dFTڭ`B"#ֳ{ 9T#t,E/yi-i;Ǘ dZiiɒiRה"& NJA3(oSK˞01/|bCFCE@7{3ZlR}Qj5ʊA,Qx[4GG\8Yg3X^b%MƵ^8ٱڰ,X斞Ѽh,[gp0ߺj)yq_DnPOgYҷXaBs+n;'h=uo ﱵUtxZɷ,#&I0SZR=. Ӌ)Qw([r}FsVoȴ}0jg-@B!˓Tn]/Շ5)ۜZ,$Ģ'V6֪vt}v pgJztCXL Aw'*dw~in0>jBL[=lz+A`FR~>,%fC3f&n)K"ֺEyFM *VQg)&X*pǀ #Ȩa8@Gg_(*1lF V_Г 1ՎdT[E+bE蒋:y`=.Tfvt{ }LTzJg2U2f> <}՗'CoB19BųWFsXKUw'w)v zkjsȃZQBM;,/o#v6>,l "" XV?Ɉϑ7AEY ?0Lj3U5{ȜGͧW #M0z^#{1zD(źMU>)PY [5οДEG>>PۏOj:-%OԾ\И~\8 sXƭrH/} L^e}NO.( į{? qp3;|+q,Y|(G^Cq/&?gIU~Hgn›k-W 2K%#[j^%M#҅HDrin󓙿\K5r} я;9Y4TjP1c2>ܒ_hL[_^:cKMWf}pjgݚ7sD0T=[X鷴9I UK[yV$MyS8gIYܸ=̈́6*w) ]I t)Rut6Wp8W' /FUT\p+s?zm'JUDǮ9WvMhNw/zY -dp ќ{ONU)vf63V{dHDBt~A0u1WcΉ~f,Dǜ4/kn_vM (mF簪ŔK> 7k^?~\& !i"뭆l*Dە@NȚYRGEѮBȻ .Ⲩ+CTZm0W(dI?r>aV1|R43or/}Be$yى9ْ?N >#~H1*3j07}iON!zN$WX?;Av5njsϿS2PpMJ'OS_>k:qt3 NOߏo8|\n%T64*xƓ䫂g@S[28$7]oN1X.6=ߛ/$9 ţjcb!+Gfd$7t/y5:)vTp<^!cq! \8AM4 Xy'Fgؾpkט(=9O\rB['B3N#y &u{YfrHT'By^$."ו3O.`l8aIE@\z1~W<<iq9<ɧ>}X{ǹg'cԀL|}3usnB\"އ_ QI0,p@v珆ϵHkgiάphVoӉYJ9abV:Brc٪=]Ivo-b D'񎰇l,bɧ"صa{^6W*8{m;J&i>e -`G ? {+y^PZpvy*s%gSE| 3IG$^"汞JQ~e!72}{D5>Ju.Cϐ+%Ҭ<MHE_dq uh;߀TF J4U*7-"yXz(!B>u|.;֧H4]!:H;AJOqNJwOWXyRjYiiκriJ#nPQiYA5Vb w7cfwSY~8UQS!6s8:&*,p>G5K:"{ '2x+Ԏ1%_VthE1myZYDbAogogܾ3,楶`U._C@襼֣x VQrw7?φҤTo HW"I]:Xh@wɌ#83E*4<;;A x3Q=a×@ ~Q8 54~lFk+m{lv(V?mxnnNl:"Vtٽ /TnkΖM峣q)mF[6Ē)CFw?YIXȪl](72)-ORT,^| [nZ5Dlqq|M> stream xڍvTl7%1:cҰtt׀#6F7(%)HJ+4! JR@(,! "  Hi j!PK1Ys8RR݁P$BЮPOLFGGxH9^ 4H_W@='wcB.+ 6B8 H(xpE1F:{^Pc?F @0og# ]0(𞚎-~B k6T~@NhIHTscT''%= 1AJ[ZtK'}JD?ub٨NIR2ci.[=lR* G|ct?F4RI♤i]Up-[lȇslrslG շI HtB=Y ayo*r$}DNiZUl"mttǺVLj佃Ct~[ mN>~7EczQ)q&߈|F=~c0u>D{^];Pi{91^3jߦw'ILigR:`MnS;wV"֛)9?l4No)BtGʼn&zF4ɀ$K9Gd+ܿ{eeޙU~xj{$݄f9.0 q5oEMNMkGTic[d}; ԖKZ/Vd]jF):8RӾ-4 h%y.vwa (mpƱK>"g,٥'pA= N* {)媃Bc)dxlۄEL;x~g`sa~1XHuΣw̑3,FJ^\~iUm T*}wv5q S~˯pKLoɌo:{1Hh։7ń†qk;YI*PnʧŪ{@Oى)E|֕HI~P>Xnق~Msp2; YS  & )z1V#vsn}e9uE(?@ʂἲxF>ymf =\4/W9&!BC+2q׏B`^e#Pw9j>"J;Ќ" yQfFуR۝悌ȵWrn#K% BKS?d+#'R7 Dtd-ߪ{. a+̻y*aUp?]๤(pz V|ΰzI.qv,j2ba𺵩wmMsټiA[֑>zl3 -dӚ $7=*zϮG` ێdRD+{TRk/~>))i7ql0`ej!Tn{=9lZP\Gus 4Alоʘ#Jc~^Zk'$ vOҾ/IOVQl YKK>Yr1ݷl*O]{k>1Qtk?=/pjutPHzX@fexRy?U#/B` MK盹zDBuCֶhbOh/)(In}/"Uomze U۱+f<7S šI0 ὁWV]UĞ|p Y& X=.ƿP(?k(YEٖ4#G=pc35b\na'MQDSL~0b7(p[H5G eK܅ɛ; E-@:pq&u۷t,GBDP m%E +gR ޷ݽ/y? |TEF #E'۱2xRLCOz#|9. 3I$wFW sE3 Q+Ad(B~g^Csrҳ"T78~:AyXjz/VM(0LE700}4 VEw 1eWR/4]P]0[` `~5Ry~k$jN+B4if,id śCs]}ȫ^9P:wE2Qqc0ң\8'MӞ'flG4>mwm$E8_t<KҬ7Ҿ)θ73oNZ›̚ol8ttKX27]GV |_J>$Wuhe$*[岭} ,vkVdЋ RB1C`7o,?h+#_LTz2F:ж5Թ᮱uF,@ۏoG[$m.=.n4d5:!T9ˢt,#-S&q\A d({qISKa:_|/ȇ+|xrb/SrM׾}\`vXd^&9>ADXPYxᾲmKaDhhZy/OZg*l&zf/1 ( b<"o_{Pk0=NBc"=Es[kx2-^6)31ݢfsds_,od82PO&єl??.#Nd'UgU.}"yq3-zşwҋ2uzmܵh$IpAJDc9ێڮJ81N+h&t:sAkDh<m"Y\p-s*gKYRO9=h,Nv&܍ aeنMu\pwY6/+*7V|p" f׳#()#.cs2G ć1LT1qǞN lE6Kr(SpVH4z_f4 Qg3q.3U^y:qԦsRȧXR=?X/9ykOĞۼ N^w&]>wjTkqW^h;=٠Yζi̴Թ?`ƅ l#Ci~|Q{sII><߀[$am2<4İ-HH%n<7MA BcwOpwGLNEB9V~ uѥi1_"˘X’#Eڭ{h~M _:E0Dʐ"ў)e/bӕXڋ/mkÈWD8+uv8l3s,>xw7%'B@om[f:#`$:_>Bb**vcuy %44U|-C%ʛ=ȕ&(XGz>fmgL^1J&o>j6ij7о`o.#z\ .S}}i@[TuَJt~"xN,v5C]D!X5w}IgGqJEL(>£Ө 1, jb.xp )B,wX(YEj)Q8oڙC(˓vqp0&' f}Ƈl{r8|e(nxTz~@59xurlgH01|m?Aޑ4,cXnR#^i/XԈ7$8VL%{'oo=OJ 9Ve@ͮݚ_4[b_"O{sbUrM.zގQ]Dut˸fҸY)NYJ_ϬYk| lĵ ZQ<=^7HNd i=.bP\cJ+AΠˠu snKQqII^@If]keեr~BӺE!#[c@E.Ǣ h;K 2lej!j)U*4dtLD2s4OOaCa`{^ 7^'MP]u7!nrj+{UkNV¦ ׇ> P\"{kW.M Ϯ#͎o R(ݣU.%`'݄Ip'bmg6k=r`LdLwֻbó tw!vk@)zyk UK}uK)olY.?꽌H df[p}Q@e`l9|>p 7H;S=U}6)eȷW(\HQOu"tOQQ$D:3/ջɴlV-;|Cܠtbwr٪6ʕutu}4:&[5%w$i}))zvٷ1wh^)) GM#cnD# gyHޕ9]9GOl]}+^afp6 I̠­J$`}4S$YpcýHpzD']T h/aE%,$l ažVSa㋚|I2jMB~Z6zx2~)刿M|J;cI fZ㌛N.9o/QdS_qoJvוԂ:to9娏k0q?Ui ؼeۛjPdqa?lA䕸OMiYmˆ^%jl&jR-\k="ZMJ%(HR+>G/-SSwrdn$$U$-*E&Wmo%1zB›=7{Ml؆f}?Tw<Ϟ7S As4.-*p1 Z|hob}Fz3#UlԔ +mq%4-@cVS'e='w0=LΜ9ݯ(7bBIqwcC⛨NPhIܜ! AOFkS$npq$. tP._*y;C)|8 <7}:ZY8}`m |m燓7n)o~>0fK;)ŞUÚ~:$6/цfLOm;Y|nP=Z'A^'{쟗emЫ$fҼټC?o7nc(qJvLYFi~$ԦSe[o+t%1U%d Kh8O3!kp)(K CԿ}`e+MQw}~(3g\lw`zRai~'+؎VjJr<xnX>@{+/&'gi?yNp$QA>D#W yj>Gύd`8hcrZIxO5xN$zn*^y;ڌlУ_ l:D~m@ Hrpɪ#rʛxT6(3}urgŜ'X:gɴ3- d=LLIǩ/'HAݗvp>yܶrG|!c3dbA&W$ӳntLy̜#11s+ȵaKC^Bvo!!&>P <ɝ3nAOre΢G;V.AUj^y~ z{eda5*hv,C,IFN2Qܽby5|FL34 cp8Aq&p> stream xڍP۲-4. ww\pw !Kpw.!s꽢j1Gw#'QT21X;330D䔹LL LL,p GKR8ruƚ_z{LL d `f0s0s01Xƞ j 21mp"6n S3Ƿ[20sssEYAF9G3ۍF#\P}4stadtqqa0r`7姦@3;]f *6&.@dvx#8YowTd @뿍e64f/`e]ƿ ,l K77 ) OvF [G y+w| {[jglլAvN@)XLv&&&Nnft52c\/[^6^ ?8g o#8ff1`4Y&:orh1 3?'2tcWs唔hJ+@`fdpۋ?Q0JYJOŠ/y 6;E^/wKK[X,W'Ƿٗym ANV[+hB֦ r+jd Tq~PLLKUFo<-_)fmdc{X9npo-~C545Fk7 -=/=~rpF\F'+Qb0JAob0*AoF @@_oQ ]gr7fkxb| d~ _ܷ}g[/[to\۷hGo[d0Lw|c Ϳor|K_-t/۟ި@}9ٿ%׫6@@#y#󚀶j!|qO)NH2%}GY\"~8n{< cX^UpSS<Ή I1ΥWµty4h~WiCt>R-B,ya)#=! ڹ+ Z+t,-I$kKj*C\MBk) $iu9Mf*]y; ] *\F 8$ql+R͆t qWK$Kөڔv޽ɾuM^hut]RaNt/VNKS13%-y%ayF\c^eS/"U( [}=;!l0*+ƾ^_V!V5-AEvO¡RvKr\ݶz[`_24x\>r F=R'+pxQt*gIpi]"zb  H(|QL.!ޱЇM7]?zK~! ʵDHI|1i7ܙ-`YË]R #^Rbbbעq`.zԱ̹PzC)4_)n};r&>I58cx_HOq+N7k6#\EW`DGpubX8 /cfMq}"+E1j/tŢSKf-4ky."<~B$`I+hͱC}C prlûf;pĉ"z@)+p񺓒J{ܐbtu ZE|g,7Ql gW[_4#Y,ȼ[fhxMrT*`a[`Yjȓ6A9SarѢ #DkDE*E,o"M3{.ѿ ĞM5e⼽ %u=U{wn~o^h4dQ Zc10 $ւ:;maAW[rA>HOkGl.\y;H2MSYT5)Yh[~$ K,4ȥT7DF׃ӌc yK[s1 7-!K3;Np̅ef~3ASL ۳CcST/D}i},Yt(h!ZХbm[ː kf[cSKn(K p=@=xZ?%5ne]s|ju[ w`$f/,7v*m)A#; ^ ~l{8sۉ LBzUM 6BC^: 4a" SUӑM*J )#vmv"o՛ZGd*i$J`ϒA'V'ϒ@}RRYXYczXtUQ5v\p$m=F4#@%w/㨂SyB&[OWh\એ58l$m-);k0MYM:zt&>{e:tóŐj-v{`/;sg+s2C^4Ӭ^uc ~R)2Q甛-==ȯ x@OHeMI"9)ПsI.[\T!{3_IuO9wY3ĆաSS Tudn,"~ Lc5۴6Æe+?vR);y/HH =\1Z[ T܆6oΑ1#Җ\?ԟҚX^qvWm2pc>6֙t^>uò@9;>P l>w?\BnBdži_Ts2!w~@eE & Oehoa3^&Ih:3'>1XiܜF/JTn}TGn )mIXHOZ+ D_R%RH~8#;;B1lI1|"n79J3xD<9&*Tj|b"aI[E !8a ygmIL*+zڗ;測ً͝ `٭)I[X(dB3D[W~ƣ4 |K{D#LfˎJ* _/Oǐ8:="sx,߯(B^Ȁ0 -XԂ(Їe)[kzp!HrTO61YaՂNPT6%[^?hnecA9Jga vMpv!-.a<586$솦dH\C`nb>zeױ"w\;f%↋#BY̟EShhJ+!w >Z#y2ϔ55DB]". kqWUɍhI@w7i%|3 {n`2Aѡnr$*NnΤߖE濮S ݮ PD/nilQ1bi[A`Gѥ?h9Cξ> -0L4x=7?T4mzۭGbqئ$e Y4^J2)B}5eOzkoU0̈j{9MI=prكz iV"ζw UzR NB#ߣ* 5g[^7}/{6˻+%FpNЕ[Հo}=jOy* JiN]UxlOVD ό*ިƯYgÛfJw' 䑦. ψM ȞÉw{y" A=Wc4bʜ<=~TRtUbI0)|E0O_@GM4lI}{ uZ䋩2UKi{?0>.#PXӼ;Cͣ;TgFxgp="=\9OpZl">rqj^x df%̛{F xQ`~.Hi[bCZ=G?jr]qՊۼ_77-eo#{7WP<ӷU ]2.b uWZ-kԎY[$r5<[;}b]݈41BgoT&ۺDu50獈ʀ: 63 4 ͦܫgM)@X5mܫvU=4U zX|̩ ࡤ5 EU6Pŵhb# /-hYY71Y+t:Źi/q4`pzp1sjYz})|jx 4lK@dQi-Whܨ*yԅ߄y/?䴕H&CR:\ $fgt$APa-t cB鄵6 sn-~dB T. Tb'$UGu|`m\]uJ#PYzk"9' );rH<$ϊ-Q{J#x)98R=U$2şzWRڔE2x+!LVҍv-*wC'֮ƘAjY4вa@1uhL*#[ޯcO'T -?KpzRt8ee3ޟVdJMDLxN"F~ך3HS᳞̝½:{ 9!D-S^~mG4W1 $ty8g{Fb#R]/g:Y޵FD,&|Zh"ʖQ62#*#-0D `BWhXK٧ϫ?k iA;59ܣUr%@LW173dJUz'm&s v)`v4>ICgmU+&eyHna`* 'ONI+{-*IUntY"e\gx֦z^ ˰'ӲIh#r; )ynKOӭMu2 :+j+w   '+Xɨ}>*!Xq[56HfJBK.Ζxة&,*Rš)*vy)y{Antu_gL͗jn['ɕ~+Ш*ה$Z7 2lcUb ؖ;7EìU)NGe홽>d NHT**Ј͌A)3hχyƵUR,eˇɱ Hg]^GcM52a}5g(!nLjkN Rt0>@^Fwe _{w,nuQenMpuδΟ[DX *sNLSHlwھ*+u~Ucv -?d6 ђҡJAf,#*oC\FJ]ƽ^9:r=YRAUJݟ$2B<\mbSP=⪽(O5ms(UV;B=Z̙ebOMJg Kt[r~\G\xmdl/}_R5? bQA^[m1d]}F3ܛJX;})\faNHiXـr ˃S$*~C1<{P%%.'x<wsݧ<钋j W=ˆ=4̈́H| (9,MOl2-|g-N^|J$ؾcǠ-F-:=[NYֵ @{5RH%q|'(iWwvQ;'oBJ5^SG14:~wsT! ߨIaTJB`V gu1H(zלJE@c5xSF_ 3G<`'Cw1N}Nٔt{CJe6g$~w*XO\fE?WQ ͛r(ҢqtGVS6qa>M|b|AQ֟[::)?!]e׉$>PƉ1)*ս4dCFӏ9yP) -{bAx4!WB5*“iI}Ficʅ!TmKjtVHvjY_Di['ZQlsIIu_T!5gqo+5e^´ rOvg9cVߧ1~˛`rp yp$)OyA-%L2ޝRpM,ՊZ\3ɱ_Z ~v˵F1}vH7@Gp]k1&@?>5p;vO `ڽ. ᪨'g@;^'$a+*axv_35EZ{v)4 DT>Z[p uĠeϙ<9 5'nDkRp]gB_KyLr0d RPm:|ny e]`䬃1:/]Ȇ‡%dcq.)}1l[q]4bd|XNv[}A֭i:jT$8-M'ϯQ# xݯ~ьԛ!͒"ɝpQ ߔ*۶QٻQK|[M(u`_j3;o:BZt/92S~(X^ K?0\yRrVTwe .< pl>_gAy,pK (%9"wVOx,&*uV }xH[vn~ `ݶ'4ƖmAc@!\l~eL؝? #U(NY,ZWmH @WB`J+ #_/hKYEG#:JrNZj:E^c?rWIڐeE2<7L iWB0cVm͐9Ki0gF`tlʦƘɝ}O"7D椯'tu?ˑ 7ZǢj ,YN&a%sUm-˱0 IOlIs߲ҾBm~SvS%h~ zBE Je-N9zq8!zUճ3oz \$hu>}ERJthoY{ Gb,%G_Ok T XR˔+*zܗXmBGOSP}|V+8Vr|-zLŢ+opn밐b^8ٿr7_X`s-+FA%JC`푕אbUmnL9>1ܣb@t[i$uXGݝ4Z3dQϗet/UAP}G ~@zC@pgR"sRvhZӝ$Fü V> Y[k|t){Ƙ|y1OuRzv3Bon[L}k cRtr{G~0i&4,,h s {L4w5tӶ9OD薫:{51i$rY'NhBV{hvFKlDeoN vrOo.20uopH@Fݧl|JAH*2um&Mk> RlJn˥ɤs;Zbp ~w9?zfc&%KOKfaS̱c>I MqȦ=uvL ׂ ? ZKr|MTa&KR1BZػ%YCw |LgB] A@KX12]aׇ|K"t27IdJ2$5RnQE5ҚӖ(`s~}QA*9Lm`?+Kxx6u90~]0]%dZq$i=ȣ V۪jQY-4l; _tqПmđ~D&Ԍ~KԀ,&r2SX'Cɐ±qÄ >I~~Vss5$ p&yyy+a"vUBG1NBexnH1ɚ\ /Je|>Vбb@ bv -N)h~@F HiXԏ!\o- <7ʘ]di%3Di A]]uP9%"c:r_ HD76_v7IQ4̹'*H(#8t:t ZH,E=fئ>h!&)zl=UMFƁ9PTg tBD_HILBs &qV)_+/GmVm;sH+q,1aTs%7Z|-mǀ>q;*aMW;>6k_u-*"DO|%)+-{߲I$Ja bW@B)C G x$G@vpTfhG+X`[:E?^ W &@^\ɖ\˔;&E!rI+1lzS aysz3T;QKn`n K})Wa ]}ƭ=a!>Ŭ?XGA}H0>Ͳl`A@z>,Q_L!y@:IJ&,2X'y$#r [}DB'lhD- Bb@f__?  @|R,MM NkTk"{ ٮh#3#a\ge4? ̝_@A xM9 6[(o xj`tWnH{ [P߷Tf ++L3Il$yZާxW֝ c#3n|v(~ i,& IV6p 'Ym`4zt_R*ey'\QY?4E%G|o}- yCK/k?G$޺W B{d; ʘk/\F/}K2^QGU/ xh 쬘D5qfDcLbR6b>m|'xˇOyuw(,&0NxVhjaftuQ$:f% endstream endobj 253 0 obj << /Length1 1918 /Length2 13715 /Length3 0 /Length 14903 /Filter /FlateDecode >> stream xڍP.2CpwwNpw!essj}V?{f(HTDMv. ,̼1y33#33+/)do^ h.7vy7ȸX,,\Vff1w{;3yPXxxv@vycK6U{SBP[8213:3;YA.3 h.@71F8 %_bU{swc' ]`29;ڙgT@ˀXYlljjo`l lEI9Fz_6n cw7H(řdC¼YLh W~ '{=Vk;{w;=`nrtJ]`ffa@SKy:V%~`N 2y;.N@_?XXf S dOw1_@]c0ϓ{oxc2)i+M?*QQ{7 z(JƠg=_ɾWvS{0hKc\v_#jc/Gkl _]]{_}&_*4o Y gIL bjV\A- 3ҽOp~ǿU#%L.VN'#7=`˻ / 0%qL v?} cO&? d0ߕ?sf}yc.ӟd|e|e|'fGf4WLI}][=)ɰH0LwNwV{9&K'5fy||GsW':q{S࿗>4[Y7 nwg؟La^qpDS 4ҋ+A}/J}֚0Nef nykpT~#ϋF5D X E+7R>{G@xA5,Yh(y<RhBXZ+97b8:8߳h"om֘J5Vn\r\B{Joѣd%Ңe"Du#֌jJ]S_J'^n }/ ЉT0ݥHxi.cnB3[X"IEwF`)q(7>BSϕ[蝼 :-vH׿o0%^504K{BM95:Ƙ/)(3MT ] 򭲻~56ŁpFҵ+' Օ) GV$F >yɋZͦ+Z7sGy#miMesu(z1"8`.J@?Qږѳez*v=uRT 6Cp`6Q]Q.pQ; P1ED̉iF[#_3H/ݖdOil\\ v2)u}`G*VKxi;‘NPM{cU>zD~gp 6X:r>U;W ҍGBN:l[筴ۑml=wS*5~k^/'&;y)&+t̨DLʹ^*2 ed/_bdl}/z=IWmI VK ->Ha'‹8S@FZ"wDEtBb-KW#RtK7|̫3Csjy3_Ჺ^dł]曖T@ʠI{fMݟZq0x~խ/n~QGT. KQX=t f$ 2{>t#pD c႒~Z ^K'2Kd&З3q vg{ ,%.2Cψm}L{ʉbkf<Sc^8yYX3d%7u RMH8x2qQcY?'u>_܍ c*>|w^t2tu$\>i9uO3 Qv+nqrYhdS&?ƍ+;d ~;QS- C}umG?Ķ,۠}Ȕ68?(Mj)؟ -G n Ze y\FeCާ^!uk[6 e^9Ds3%ej kX?-%[:57B0[ELn|0٭wYs`D1FQ뀍^)#B%D14PDžcF&+~FMpȱSsՒ?_׸ljpȤHpxoFh")&#w21wu.#0RICƦ& S0UFtj!Sʫ\k dx`;#KgZk78Q QU! B{$g\Tb*SuDzԷNRҐ-&JY VpÝM\ z^29"^$Z:N4Իe1c)ڏ-"c57ypb.<Ͷ3tu0-DP`qgvAGVK} ! }K'* 1J䝐r4l3k@X P.>$I,~%#F2. c&hoGOJGZmɱOHx ApĴP^H&WnB_d$ -TI76$:&7~7jb]d:D":=. W?=Jª&m /uxTšF79 1?L1FPHj3dyRةthFۢSh8L$Rd }K % ]!N{{)%k_J~ /Stg] Kɮ_ƹg758@rZ:>#y`3#TW] B;g~AP3;wOQb~+2:Os#Yߔ/ M": &\)@({5_K# 'i )Cyjxj 'KB7OSKMR{+`2ٕ[ ZXYO>N)ǯ*2%a^?_$-&xO Ѥ?LE:f~rU[9e 0P_ڰP%8ӤHQ YtkcX_L}"_[>Ɔȹ,l^6:2𪰶 ~X)<w:gƼo5HsUD6u{LNY-dH -ɯbf=P?/6H-'oZļ_kgm8gWP9V Z/: DFwS-XPf:Vet{:e O"/H]f|{rK?mQw=/6cP#]<81Mr8rCWwd;SImaZ/l|S1;w8Y=i=kf_B U<#kCŋ0d ЩB3!!(Cd-'2t|hjwojOYeQ4Bsl[̱ 3?k/s)ZUk#R Ѻ'Z>>j`~|bl菴lB̺pG0P R#%'^-5JK#A#6F~}6]cT%&[MDF_.!?V.:GPDKY#>*-b?J7iWuIXѨ.$IkɅ8;lH;)҄"r8`{d_;x+Үg8Z߄Y ncy ̪Je,ʡ~9y:j[&}7]u:8ur9FAW:BxMU漽j!Z<[UȌ~6ҖV):M,³0ԵKJjð(Jv b0h?Pj}(mӉ~eS7nϩ Wǹ5$gQ8VE ag|2YH_G*Vq֬"AuG*^34V" Ta&JfջE1s$}yn 2$qULuý7Qr_+nnUV9`z62;?pj~ox`Yhԭ0df g< +PT|Əh>_-Y$lt슿 =N1~YC 9i@F/"Hƽ Lb\ЯOփ;]I"KCϝ>Ӎ>65XݬIf9ƭ%y&-TʥnC4?Ժeٹ9&ptS2e!҈˞ZJr@H {߃֏@5x4\Ա-0ѩ  =PVG͜>6U1P\{ S4"c!ؼQxjmq W>~{@~p>hI$?'r(,)y)q&.5L'5\br ՂW fza=8F_ :}bɩVs\bɎWzUY:}x 19I$XXfۑ߅+?8/[F UѪ0"5j< _v<`PlTyyA6oz~sru<i)#y;i^5F Jf6f>SbvʊZ9_`lj$3zڍˡy\SrAo7S݁*KZ0:gw`V:aG-IVgČ_3䫼i;J'!MɦobnE6Jd]d,QI!մ/r3^xFzKT>pk(tƽ=n߂h6N$..V0805n+?ֿȪ ~<ʺBBPĴIfM9 Ջ_Huq:0g*'+K$4XAI&$l'Zmo/[mdKҎmc`6j?]UzxwYl3"l_ܲpː:gdhZwFLamÅ=t@l14pci.;bin t%^qv;IߵpzhȀ$f, E1k _:-HdT3ύ3M.)Fm`l(.稗zFW ANy4Q) ;g$f8})0,l jh2jzx XNpJbH㍟cfժ2fiP iin0X.u= 9yd gnpɹ̮5c?CΡ] iY0O:p_:][3+Z;x}nƟ1d}&Xl10Vs/$–{|`ANpXdRV(X*(DAiqeqi%oB>ke/`9z^jp7âbV&JC>|_ ǖMzi6Ę_\ulka(Π>fvM-&D ʱ },"] |/kʕihs<ʀVWBb7QSeJEOpz/ہ,:=vVep; i?QJ;^dD텼^NxMhF'˴Ni=h9a_z)itU~Nԥ6#Ah!1:As?*)=uptin%}iQe O~իڠO N- E>=} Z$wCz(sWA2o|3'h ߛK[6PyWh+,Fg npx4.C (*Ц,dBr-Æ$L?yګōMS$ƌjʄ^dܦ-s7v7Pÿ́CN["VLC{Lܶmgj4!r^<˯tdr-¿ Oo'mP" 8#|NusNDaswVta7P TwV0oqz#g/ k|XD1WTiN2&<8lI<[WcI~[c+X+|BY~C̄T͸_) +32aڲ^U=fxP/HWk M{pu}CT {!xHfmxH`Z~j';i/3%61o!r8K)IL]%Ƿ. ރk 0``\ל~U&>"!z^$(yd>m K V{=1Zc,(lMoHih:sajzF'#WKD!- NJJ w+T@޵&,9Uh!)5@`XTo d8f)磨1p%?aneyHN5gFmXn\(_Ʒ'4Y'(cBc+\+9[%}֥ %hJ`蕤`,&#?b/^R>u5\6bR9I-^XSѢWjovr2qے 7y2oDl$VzR^3':8  YiyFj]!bMlPՏKl*w{o %??EB 7</H=hħ.NڿqMph!.w:^SC}Q@܎r`TZP4\;ىӘ:Rx}W's0a6hk&^!;p*vYxq E-ޡmj]YtHa;]0^[.Vc31^6A)"&.eкuvnO6*ѕ.U1fX*FI; .}#aJK ,Y*9i^F:>*!^} %CKXCd1?f[u@U:nW5} `Y3};a[}qD ΎFy\{iYM@(9O{eH"f[:o|hlC2 h?{#\R٬2,)9;;/'8p[e1޾P=Q!#2L4ac M|:P;09Wy*{?5E52࡭zbw,TXH!/~iUKWs~d1x 2]G:' yoJ8JYc2gAx- Z (.\ eF9gT`Ɖd$;'zsi߹' 1զ'f &qZȨnj^ļ Dʧ2TO.5OBuʢJ̛bӡv=ID_N? (H6JaLa+XahrFx^|9ŧ{<΀wF.ÙѺ.{-t?p#m`D̍.pjFSB:|Ij]T<ق-ClMՠut m*~:b+>+GeyY-a"t|՝v gQK[Y'd>2IKQtNw>WF0Mjes^f瓚Huc5 >7 PpI_PRExZ.:8x |)UG`j VlK}( g+&`)ʉetUY}=qe$@R\=Ab~l]T|[m߽.+@L n#ű`m0 !KKcYqač܃XaJ{E^(t,3 HZP>GRQk 9Azz& W\ g2otVwu#V^Q7pa[]A%kn5& `/E+I ZxI4 ;xA/9Nᆚר6PET@x-'lG'7ZJLu*CU W׾ )i%mhlw92$]}ϋS3}Է2rE v]aI[þ&K ^xm6+.gӸjΣM9gZ^:;I5;*4[>Sp`lIr)qkLXJD >^JYRA. )Eb!b%L< 9wUS;.羶ֿ%PҌ7 +dԊO# ޳Aȅ'1e5 ow8n~yu mZO5q'<:ZjRѢN\廷P$LWS]Z4MC>`7;Uܱ[4jw )0U=Al;г%V&"& :m 83,g30wvD~Li^3oq+rVݯa/$ix6OX310{`9"ze < Y~fp˚Jh%(#˃<jwWop!!㳏,cu GcqU_hAP~'^zP"Q-ڮS9~)쥪<xwqF!B(uIx g͞YT$.D'1JشoyxYؗfe'LKf "">&8JKu_ʒ.BT_W%)Y?852 Hiv.W9" ,%SnvTgqa-{v)pۤ0MacKoOr n9V>?)+jˤDR'`_5Wd\qn)]-z 1frBH/}] /SOlVK}II񢦊$[pMb7:IqYWgЗY@m9#fox!TFeOJN`SSK& xX9*y,j6^7N( "y3*?Zɫ Zu@L?d?s:"8x`,<ơf7yh?3}^gw*a+肭&y:lV^i\ZKS(e !Bߟ7erTmh9*='tOj:f¸]8tKX~l LR$9mUF*%<+Mچ SW;r> +ŗ.JbC3%\s=dM:W֎KQy< `i8sM))|,gԫRHئ1}tp3e%h]]S(3M  endstream endobj 255 0 obj << /Length1 2492 /Length2 16318 /Length3 0 /Length 17777 /Filter /FlateDecode >> stream xڌsxkƶb۶m۶m5vjlm5jp9k]WֺG<3XI^\ **`bbe`bb%'Wv3%0wqvtP&f4wtȸY<̜Ι48Eqҳ0YXY̜nR2O"pvpp;_`?{B X 6Pw=&v&SS/a+y9I˂&/ c{k;G pbys3kwv3%p8-v27Sv3ט[Y;+9Zu虙k8RWYL9v7,pX43<݀.` Gؿ8B8"'Q0AF'Qb0JA,F?( Sq dP QV5 ߈ `cWSkkSkSw?r`&#f ?{)vo ehJIa47s3v3-/;pgX?bvt'OD򯧠?M[+o'+sXe6Oߙ`r?2G  XtcccO ֌Ntsl~8ٹ#[s6mgJ1f`?D`*]ς)ZȟW,? X?1L_~WSGxycAn)Sw`#@^azM0727]Yr4 i|?bPp'bڧm[V+Ҹ@.<اD<8NO[n.(TpTPhsF>kh~ܤy'CRWĕO:GΊx0Kܘ/!Rv< bL6!p2=ͳϔ2:ph]FK" n &x<ݓ=,/V]Bݟ~S>ȁ%p*cvRK$.&YI);y L/Є,gXx[I]rqKQ]XM)aFHE.kL[H <|%Hp$~ǁ~]LvF RѨH:!PŨ?0€C``:,Gݝ͆~ILX9N$`͝Ē ׉7Y=ϥ?. Qr0GGREY_T12'\KuAb84U;"m0.!<So<͖W ~G ~a]ҁ-=wonjgAi!Y$2Oqњ] 8梆禊_[?EW 9K h]B֚3@tE}nTNeN(R :l(-Sjl~e.JXIϢ~*Ewrl+D]Cw50n:p"<%c oؠZt')AgaJp[BznlwTps|zYN.D&b+(#2TI3#3\QVnӇ`:ɪN!}+2&TDmIE6cּ'1V Lz$ٜivUk}iNzGVNV}*50 ":hh`˲q³z4ëmio7[TqJDoeV2l 52|Ui,6ȷGnyo|ۓ>o;l_t)/j*73]9uG%c{+fuy!H07=fWWĺVðX8˳T7щ|ֻ\WC"v -lh],?`HM_5lZOZF3RO&2_Ԕ Xhf 瑿v:cԙMcQ6zx<"ҡCp#;3F-;G6x:m{JЗz9鯛/˂+٣!EՇ12.ё~̮Ot΋W|:ud Az1EuQ7FYm[G=ע8X@5.7~Iq=Z񶄥 s3 mstou FoW\n|f}r >-+`g Nv| Iݒa96V[&X rcϽ~ҹH=RxK.˴J_r*ӌTR4N-b#4't9W&y srp8lD:}lU iwx;HWB~mW(F[cF-"YfWj%poz owW8#0*͌h NƬ]uFsGc}}U7:u=/$#2c[V{2'EӬzTP-AfɑUz"a GF\f^,~t`ԻR^Gp?tt߈0 |оJ- >]SǝkhھH,e6Y6@g7%nke`LiRYԓ&z?:͖"%IR_eR+keoWZ6ܕ ]FlJ%$ݗee-Sy7|0$K<NVNXM$L&˃shy~q,)`A# H Ay$X3擫OMIju-ǙnBs;5_?Ѣ)MGMJbBe7iy*0%N?s )}Ӌ5ɦh*MI5B(˚g]Zu3If \Xh= ?zmV7aJ)Ȕ3X=02aƭu8W)9x*'mOP_MCNΛmFZsIXd'R#02 Ggs?8a۔o=c }+ m .D] 9O}{_2Q M"Xrժ^"G>F?/nqXxL^\ "HGP 2C٤ږ#3~ -i0׫K.+e$$( N.3 }Tp,<8Bzo}_z+|v+W򻄄{\tۨ+h cNd/X.;7kS,ѥ='s=^9'-\ gժ_&&/>kX~" u¹#b)U_<R4W!_isfI K|%\N M'rlLZ(xO>lq!c9WSmͧ+ݤVeN~ ])C4nqS2ѵr`Z]*(qI7*^MAa@Ĉ0_=Xbb&1l2p~2U4uHtG'v&ƒ?ƚb]c> 7ur㮥0űzuVW"GedVVs|dm+I ~)Pm z,f;7󻥞lI8*͜^Kw GIwsw!Gx铷4 ;SߣL=۽O`zT_h /S%n4h9h଺!Ƹ!9#Z]ڮ/[km~R?}*M‘]hܒ#UVX:OO4b\d8 q\> ,P1 9]ϷW|]Du=roRh@=dܳ*+ \䕻AFNjifҋ-n+JNg/OG]q6& "Ĵh>i8|L2򥅵"|H$& Ui׍7(l?@ɕ=w͔< _^zRG5Z/S*x124dO_Qlc=I3Aq#j.3-GXd ))(33|E=^˸9k:p BiP=ʺ8ppH@!aw;Ee%%t^–N:#_& 3^պR1V' _B&fm/nңeu1Fݻ!o a~myV%_>wuܗ 0,tg{YFOT-.AV-S M&ixUBj%k1wFVGrrI 'lp3F{ 9O.+C'{^+ ڪ?AÎv3l ~8'e@2$l#1$ 2_g"#x Ws~8)I{zӗ fV'z]@'i$SЙע˧T׋vu!,Fy Q 9Xӵt:&YYSf3#﻽tD܎[Q]mD?wuZzĶ[Tr!5e(wPy[ѡ[$٥?gAIQ6U<㌪.u.b =˝ێ&ʇ6~XL|๭&!JEoB5aaxZ}WM quהzL xWzgρJ6 zn"%h:=d帓kcr|A;%CB oivx&+`n-a`}F" ,n ܩr%G^Ѳ6*'MX&T. úͼh.}ZSx^;1V~XWXyu:I2r=ZK"ۙw* /Y|P"ǙnfL2!NIFuzs˾Mi)wS wPACo4砬3ݭ]/wڠpfzSBn[mh?EgUjKg j6G}zYY0ZAC(ChOi<ӨnMRe(}K%Kjbyk1 'XSh5fk_n )f}iw/n3Wxx-呈|heZDJ.oH@ځSTK4DN7rɄS;@W\؂ Aeѡ,~K:xOED5YX|9!c I/so׍蛂(}Me dDeYxnSն5?8"ʥ,c^i0'L 0"Mi ` A߯*X5ͭLb#lޫܟ` Fr!X˾qܛOv@[Vyw~o<E3zaY#c𐓄{)aZJMs=wI6$BU^0 .tw ͑F69zaKw̿3A{bh$rHOoYd*>\nW?daC#+s:i'5TfYGK۷7(d|(^ؑNe$Ř[wͿkSEDoY9iggMмjI5EtUR~,KYUnя.=ngMܒDžSH?M'a)T]@*Tr$4,c8Q)1{?Re;5夦Avh) ,7ϵ9[i)[E&6~|qQ_C(vddXkWɽ}DyeᏝ|e&dRo0;mf2%euV8#iZ xele6v) 2I>n3%R*|K! \w"a.f`S-^2}{?LM:""#r+hS0Gl}[!4]d0;i+ !Hk.,V/jK[].m5O~fHL-0un}5=2}3S`͈pQ/GtxE^d]atyYpy1؂2]\ȓ0J+瞏-YpYpuʊ`#2 .V5!mX1Mպ6{)'R*U|Zl/ϿmHh,眳+:6}M·QPSL4FϷhթ˅%? CvI_`ӎX{rǍ: ن|a(g W:'rH\ÁDOiE+,xs=q0 Zu=|dVcFyWhX(Y*tI8۠NlalN _]$S4,.t"JB"nIj*/@K5 =K$Q5A޴?)FQ^rY0j *@Uk‰diЎƮd֏LQ :xB ݅1_eō9;53;t(;a-4auȭ:C'P'Dx[@k2T[`cOԬfM^+!Fݤ?ej% 0OCUVtRC)R-\PdhFė{Z2>N`A' U^ d,'e]F3[6qqjp;4`Z擉`_}R YqLYkIЍ,04ykn:\?Z촥-Ǣ ~$ R>=n~M߬xB~5ш6CkjGNwȡ*R{=`\5;q2g=ldhI9_;GOGMIm2{ y[+z0D;_,$OM\WDooi=*]"$upR-,iF2{{#OcWq_43Jکn/0u&zO3bXk$:7Oaa[+1 k5c>mW3,.uwbs9 SЌ虛 OW³=랐iHLnImLk4-=C0Aa+%6cbRH=}4uɩJFm& o4OSU4 0N," U3|YPO,kXxSrL+ IOơ 8֌&5B޹/Un{r;yƈi~wy"sL*W3m)RrD+PZ'_*_ /9qx%H-})ZXG[[gsýsE5~| 37&+Uj4Sho l SlH?Ņ@U=0Kēm߄z(U;3!ckᑍYOFoY.խk hL^!*\9U4O)(70"5 22zruٕ"g't,>0 ,R>ZIy'}xhԍ7daֵ`}.#w'w b>5 Iu0Fl2l(swa 1@kdS9AT6ީyA#صԷ~:y5S?:.{7ʏWp-zHje>stt} T\ 2!5s|2Fzzڃe/-2dT34¹暈S>E^Yz&6x2օϦ+yUwQϯRee{e(ljPP]~J3"Δn =V]bF6{_ Y#';p_uN׸3bϝ K46Bw[0\or G̦'Opb`I巛I8(&¥ma1x6!/-5Μ~?eH"t{v ('e08|a#f_jwRt!yE bL%Ou̔z}NGJ 0uX_x 5w)/Ny(bj_c"uUL4*7zyY\ H_V/ΞΔmkS̢pJ˝)xy Őv4vD1^ h,zwp&jQrt 4Yl*sl@H`=Y fQZb_Owmos=:-U;:n~鴄`ӌpX&ҼvDmG. 5p#I5\g5':.)nx9 Ш7k1l5vquybZ!S\ne)}yC95tB5b'lÊuzlJ~֣ĉA_B&N[μ-LZޝ@u1z!C/O@_xKƳi끱/9l' Y[Dc{O=(u-ѿc|n?=z^W~u嫀ZwD]A'^!62w5\|{"\<7;g4E aU$VheʃQws4MP4zRuH+8yTxmN2E_ \b5^0K=8J6<[&DgR=nbalLoeEücGA옩QW府qު|`4y>) xax;a[ Lss-qa:Ȳc5vh5ga,{櫚|K=Ģf_99.T=i)e*7Yϰ c~wdžk4-bKєMw?*" 1+ѓ B/tߝv4k@ 6$vRG@,~ J!«nl*a`ؤGkN0Ms\5J*a{oD e8|/钅R= 9y { {Z d*TU@SBOy9=Ud"9[]!eZf!tqXC)k{1ɄH0jT#=ۢ <&_dSz&F`gvrr&ZN1& ^[kEV ضc?ݩ7 Ӗ ~ڳ4pƝQkc}H-( r3D's'A>L V@)MjzyMiz(r-{!GsBYꆩ7 6gcVhsUr85kqZPddO7^̺CB̀ª!z"Lպ3V#ƍIyEs11/I2N-/ IG3K:Ksz{v?(oeHIr^C5tGCAl2f|rFASv ¾ c݊w.&]m8.8 ,:MkA4"Lӆ9.3M ű(WM ($vq"J5|Uc#{AP6!~MH.EЙxdtN C-%|B|mNQ1J(G"Zhj4Ƥ f,Wut 7Wk~Sެ>pi1};sM\o; 4wzw4^^~KTo )i}#d.a=«s!HxDr/N WJ>) F -nd*cWh?5Ye<%EQ:ǰISuc ȗk? I&#4 rRұ݆+ts@o0me !as{2t8`E c{ݹ cTϚʏjT?赫m7$}R1 U#*spzf4ٵ \FFeg!-6%BeSonpaaգ48HYߐ%^!/JW 2x#e >!`[7[_M8b>_ڲ~6SO Vaao-f  9iIܹ!v/2cmźdiL Sb,qugV Cj%g1"\y]p mX :iBq$0?|@>ֻ̉wjf%cMFFZ#t+O,Ru akKǩG6p{xctAtaKP< ;؀]zZcVtnGYV% A7jWGn"< ]ɰs~i9-Ӈ!ӉîQrXNQL~/Ȳن-Qx^QUQ]Hty5lS JAIS IqyI 25yA ao+$I\KZ*J7 6-SmnUϕrk'\"3jD_5dT|Cj<.`1i$P(8] γjn>XWxp%m rD2K/I,0c+i.`P%UZqoU/:Tj=ْAaQ)Ohvky׿*D8M9 4X< >UG$^_DJr)Is>ovTƢi,gRŽ*Ҩ|mV:0ObH~`J>qs0 SO TiXPTS\3IyO3-hz暭jm 2Jc؉EWψUQxWB>I.i2 |SoDRQӈWDKcf)]gjQڔB'!ئpt!ӛVxT p7o .q.H$5ET2AbjivuuE iVW%I}S<*9.NU L!#Ѹ*\/Y@;1(kH9"b0 QaUii}tVVgpIg} 6]% yXc̓ԣ?Vi;͌:M ]}J;~bJG g]aak+B /h(+b*(\NWDd>[Y O_E.vҳEt n /LF}(YiqaMg;MQ31ކl,1aNGA̧3ZX'5DTsxQ?+_Q~_SAX~Zw ]6/O +,ɠnjh4e*:0շXHLrJn&쎨iYND?N@)E&ʿBI {']Cx2Q -855 D #B1T'?eGWWm_ ~@0<&e܎&My^"Uc#Kd?e]!a}D9w1q~cʬtpn"ˋ 1"ˊv${<66ϋnn^^OF\2a1E3J<}c6JrГgVo%7l&e6M:DXz2k۷'&ET7%6N&o@2CRV΢,b.CC'0gڑ(\M|Nomv/W!H LMk6W|r3%E#Ppor!* @SC~/:6*ƦHjc;qtRUAlqk Ld7XN !tkaRz灉9Ҷ}bQ{QT,0y+p"&Y󩻨?Xh6j)yp1s=}*b{#RD:[%lx7?o2g^pW1!Oy~aݨC2I9R.}\:plLfW6 =e={bҼ'JIlh2IBsv%s%(UVLjj릨~o0/6ޔ`rz*SYw }ac[Fƺ(Ν[p-[Ax,VMc SnWS'Y55ŃO >oE96*DۏwqAj-H1O9c@bD[@Hūkc^U__8@ϭs21Ka;ʒ{ o{T̘v=7Rk㝂TACU4r<eۛ@pw0R{KGWyJ9&ĤqYɪeb [x!.q"iOU4ݔD+ endstream endobj 257 0 obj << /Length1 1370 /Length2 5960 /Length3 0 /Length 6892 /Filter /FlateDecode >> 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ڍtTS[׭("]JRz &!$$ AD( (# H RIxod֚=ag5CTPH,/$T20A A>Hn:؍a ){S`Z($PE$ PH Ov@->: s+߯@N(,..;( $P u9]uB((W N),-qrCaexnP< Ԇ8`: \ X7r8"0U+^uiu0_`Ϳ{( @@3u r_F5`>8yb10v(h G TrWA-@WA~yb ** (wW@^>. AO51=?.ki rsK0zw俪?y::s?'q]W"B]IP_Ղ!\;\AiD av,/74GrAy Ů}|p"J=n~L@X` ^+=χDaRW( ם * u`zm2 &FQPJu]9Pʬ-H1堉`YƮ'Nw<]>w˦wkmK ]'M0F;}h\NŽѳ@fՌz5sM0됔9.6\>~z3̒4cjf~=qPF{d{f]{[^FKH;I=Q+]q(*uYx|/y:͠& IKKMq{ޒTk)]Ķ<ᴰ# m17o},Wu16 c'T{p%!bkˇ؜ym]fƈ֎.C]h,C@BczAE!U!(z g2žeCk8Mhr-k.\IvxG|=O'A3d Fy"ݫy *r\ލPwG/mbIːS!%fF6׶<s`e'(9c)Gk8tҲR~6$.Ӗ6'"-p#ƶ]6j}oE96I`Σ7HZB83%+Gr kΗ_Uc_3lyEaOВ @vy ck/tD~1<(y}X%#Vv?szҬT6^SwY&sxᕓI4)! R{̚ܣCkk.-xboD TH'hw ~A}Z M>`L25QYq1(Mq7mRoxrxs;=C3X5+p*kffgGGLw9.٨{~lW+X+t̄@$4'B =4DNsX pkk;Ӓ]I;ܫtY6aLiy8/~~~Kr{ZD]Xx*Z#!3fHrMb!_]vL׀KW-5-DNUfF^@i"UFJz0#V'AfK&||x#=/~R S?^.fJW~|؁I̽sq"{vԍ4tX's8aC86&rK*]H`&>Aoy3^eA$!2hK}y== -.5`&!yc8R>u'y__,[$$RD;_sCfe2nXzm6A'Azx˖%%I$O?jz4oí? izX6ỹcy/x?u `WH`IcmyN [i#Z{jLX"sJ@ i~YhIƥ1ՒOE7< Le!V@]ɾ蘺_KC%ߋ-sҢ<"dV5̂Ɯ\ >b<=3K*| Clsm?/N a1E85S5y5!MP:XѳzkЌsE:Y\Gy؛bݖzZ\7զ{xu ᣇe79^w3]HRnq6ݎ>b[O૎*nPps7T3I|(iil&qO5:[2,i`(UX{G&E)?KGi$ 1{ fj7k=yWLbtxLnކT/>WrJ}o[I}zXGy`U6-(3"[=yYr/@>膳y]oීȹK"yQÒqݽ}[aU7o#duTT~ҧ,'GEnPm;WtpH>|csmе~x OK#*ód[sKٞjm{POwPϭIkJo?I+.MYy6#H^!]CՐuBd\wp|4q姇Uԡ΀rӽS7ܩ`c29[0&`TF@>@nXip\TydgBuu_2$G=3ᲀ z>ҨX(02mڑz<`2hRb+Qgu3B; GR*&M"~HcU7B}N'DGeGE9܁+{P*h:^ Jzv/Qfa5_l|)t_9}(W:Rſy&zkťyS3e֌WhB)H{ުeS9vMY҉Z[ÉJ0iu]tTe=UUD#/j>Y%xG-lZz*89Pܻ'eҼ )tr` (aI*}VeĖ6 vOA{C̷,!H⍲]SV5-Y謔򷋏2yюK:=rBΟy:[.டD3CxF+sH<uDLEzڎ_gyҟ(oRxQN 96vpF~$^,{^8vcY"d=uaգ'yW},ɢwjB3bz\qm}W[w&7\D(N^*Ry3t}ͿX~n]@Mӗ M$Yp-c+$%'qNw*vLgb1Fb0KmiSzj%A.yO傇vl8%SZdc%pbyMkyW~d"LhzO!al|J}u6VD\L>Jʆ'DVqB #"i7jn~hl 'tQÅxTvpX79COm8N;RDm"B"O5і1OD^ЧI;sM>Q }OVSn1ox(O{˪_VRz@X<CDz(E2i%+2; bߊE=I ikV"H|y+"R+pY:MhvJI67b[LʃkTazo5QQ N eأ߾)dI. 03Q xǗDE>5R]'mNHt]: 1S[܂T-ʍV^B7QL㻖m3 ,ߦOz~H,i>WK]9{3>x,;hJafC5;Ɛ#'s8^v*p8Rۃ_ld?dBG A 8lqf&Pmo?Wu9; 9zO؜,W$Vj.z9T. Ul *ȅ\hGcO u/چwſ>!EBJ\J嘳a@>[Z_]|^ySsKqW|<9Pw>] gœ[MFGDj}/} (#4yi#F[ri\AU~oʃkpeyj'#[%<ݯ!fg> bsVuKfx9v_W`Y;޴ `+|n;|{m癮hݗ<Ϙsk? 7.vGrbyWJ79keۦ"ntvuYko!Fs(e-_S!zv%{t疍dU;n-Z(+{*K q,oxb0zG)MBYӠΓ0Cɍ~iTѢm:M+ȡgDs- ߃bRN{|!\Lqeo{ }N6439SW-8i?\B)or͢9cオy璃Vm%)|e\IN;ܶ㍇cFotZ[4PAݵb򽎋\KG!an cw*2L힢nJUHh~ 3>Z endstream endobj 261 0 obj << /Length1 1381 /Length2 5936 /Length3 0 /Length 6878 /Filter /FlateDecode >> stream xڍwX>!C 0J;G+1ƀQ҈ Ғ]M8q<{:|E'o h>A~$PQ VA a~HnG;v؍a(w8!E ؔ h Rjx8%$A $*A<@m~s+"]}Pp{4_@N(PPBBw8PC!6sTB`$C+*) qqGex^pCyl@\``:vh/ Pば@PNgDp`tq |{UG{y/ xB w>ݡ(+ڝkH_i0UDhw(>{iGUw+ ˜ah(D܀0o>N_fHWf?Ce ecmECf۫IDA@APLTDzG: _Fճ4S$\Ab rCG Qs?Sw鿲dT<8D? OhA jC0[{$Z aazp4a78g8tz`B@adu113č\a%3Tc$+0IڰHl$~e-c^( U444fhQ3Ho-kl: Epd/>Y~Ϊ)p H*!1E{7 M,$rxEvf:*ŃM۶wc/ _sąΒ|5S5Kmu~ƌ=t` M͉4D zTs8a.GÄO!tHxd)B3gNOkJijH'&lF 嫡 /ҙ-X-?@@ 0$ ~LJˀ_XN)\JB훗,ݥy%Zb`6 _K T@%׳YFFf^9a?Es4RrJ]|0,~gyDpL XmgvW5jQ:&^QPO鄲wmN~ԧ),xϤˬ>JۨGZMTxطWEŢ7kh"Ljp_=xxI Ȫ]&e.~@ieI^8MƔ&LK>a+SIiheGO蛐jAvMOM1Q7aͬr8#o 58)b²83[] b$ʶ y9u}iy]3Pa)$JeXطqwdP'[M2/+KB)L^P",euPZO^煩OwayzIvb`oq_uߨOZ$($eJyj8%3pQXc6~v ټEh6 &ZsE)5_LG}*4>/Z 7Zdpuze1Mُw'oUn>).ZEв,%m=I@Hϊ7 Yd(O(w QOMO[Ac]7=|}<(dDSP7WUJ1@h7]$zT#wiT/Mpj޶oy#wTDiT$?L 󢂚y]a=2;ѧJԍU9Օ+L[@by g1V@#Ƀ2S%Jo,YgڭRrjvLE(aKL]7=[Fl.D4qÉ!P2QvMVg ~2yl=W=CH¸KkT`Z*akguDibA̋F-_83XXNHo6߭Y|Wdi.⑒RDcQ*PkIDU6 z5Sij.zjji_s~{qg~*qaA\>msy㵠 0ᚄķecl8ʃW(U2,8>XK'1~8sȸCRE꣠Wc @O"1Ss1jc5a R O+捖I +.m21)J}u{]4+fKnp}6(aNE,w2FSNvׂ/srX9Uf_hn0]|;qQ=]9}{]ijA5ys-́k0q93ȝ穂,A/8<³VdĴ2`5~-ާJ?X>dP$D q+M--LhY2)H- :W[9b Ӓ {\l~:sd~+£O^AuHAF#y=$ fzs2lWQo64.=Un&3GoUh, V.۷]dxmed4iO<ܩAMz+^^ |Ѫ4W7eu1;<2<&݌9|şp 3U{Vⷌ'RxIkxfZ<56=I!*k }84'=UcX"L<"-n Y[#3ɗz3' hAɳn$/k4eΪ6.IgE@ԺTKš~~8 0E-2X?Nyw[hea%3ntpոΏm\PE)kwlxWMEэPE9SBq+'F 'T}ȳdH.kq^Ys vByÌ6%qd>imܵBؽίVRG ,4w(Kd1$Tv|#cpR7',d,r 'gLO4\xžLyZʩIe  nGb&j!.z}ƛU(,h_--$0fDfocfaY)kMQ>JһOAɚ:/&iTGdSUn (6HVi>EkD {$UpYLgӄMȥ^;cc:ptA؍Kw/dݲ4C*Y͓ 󪓱TFz3 V26m*c0O➒@R'OH1} EVv_>n!,bUm͠0!ҾSksKSiRۀ/f dо5EFh@m7;ŰݼB_fIOAZ#|̈fY|$J<ߙa`6HV$els|2|g)mvMVˋ 2(ARIǟ ^*epm.;dB?_X^?㪍 QЦϹfJm ` FДM#On>ۢs?8Rng/'WI/I cv7;?7 /ް8F$Yn=Ͳ)="14\xt}ON~)?Sm&ueyR ̍R !\W4jZ97_IEN[ J~ -i|onQLYgCI|ѳBcŸ7X)9;VthvUfnUohMGUe5#/WmOr2 㟅h $i 'x;!ZK.l(ΰL\wNWi6ξ[!GS<ѐdG|E,[%Q:;GxjK]tх'w}6RY?/Rx~8Ǣ9JAdfv,ٽk@*'k40  * &o6EjLٶ#1hZabjc/ 7T3v5}L̅BR x2`0RPv%$,cםk[BRN Eh|YB@[xBHH{]yl.w2*mz\Kþ&ϭE? =eBUPz9u;D'm:/o-gbZ-8rۨbb?M<_ƖJ?Zg >:D尢hS`GbDMAb&*K˓4TKt*]]dXф5nߧ"R:ZZXDCZܔk}fkWJڼ1_ʎi=S$AJK7 /OoP'np◛z!_ukzÁ7_! Տ,Y,̈́!o(fytwt O_2Q } . -JY 5KfQ&Lwa!qe$.hlb7v٦';IjYàw)?$e3)vNKVw{RӗfS[OB-F&'_2?o472p8*r K:ؖ0G`2%itq` F:qE}N!~oZ,umо낵 {S׾ $H@dr"fK2HNWS SHEUKJ鿀f}urDv:V9 rny.[gD]| endstream endobj 263 0 obj << /Length1 1517 /Length2 7013 /Length3 0 /Length 8032 /Filter /FlateDecode >> stream xڍT[64Hw3 -  Rt#! ݒ H(HKK7z}}k֚g?{~Yʤ+g +a^ @AS(ee5 q\V#/+H&x@ @P@@o"Uhha`7\V+GsB@05d A0_!89 .|n|pW{iN']=_%Je8@2֮`B@`f v wi]x@ogkb v(BaP78A~n PX#+Sps@+ ` pgg0 +?E+xqSxmu _ 75oP wa^cC y!FпU඿MPX`j퍋5r% "[~>t k]q5VW^D6֮"Wk C,,_!0wdDgw(,! lşU#{Aspd㻰j9ZO/ckQ}׾X*l+FtJçh.ǽve"P6x~tكl4iQć VffIs7E~-pz" p1"br:vQ_2!M$q5Kw7P3E}yy!C{e`v_qzOHe8)5cjǍn(l )ԅl+hV+3 BZ FksR9+tY?xXYlQ·= ڎw3 S ԥP!TV @A)7":P;㥛G)RVR54-&5<|go &I#8=tpI{nNBb#.%D<Ӓ3.'n&P/7]CE$saJs"RRK"BRĂ>NS݋#ٸ"_B=㉃UcxHnͶtJO@KҒv/϶NsMj#@;7,ߌҷ?I~r=eKfXEb9Z'ܢOehovڄ=jphv!p3b^왼"}ṸFf/:^Q" d}w*Dk)J輇n0DYCGg~mAo9xgA3ZfHӇ'Mq&:JG+K)@Jij6wjV8#^Rq~Fs 5[F:Qi1-r (¥9c7v,ԫj^IR^=4I~̻w[Tgz?-3ƒe9!FIg8;\EK8B*F$˕tWK2-LWh& 5צ}hKMfLή$ֿQ\GCJ&>BB!z.5%OH6a EtKNR6s1VmHljt!u=?lVk>^:F`̴-oϣ+n,zIU;Ov7C54<ъoF>z$1;kʜʬ%pͅzSJ}o&h% [ D|k xE6ksW|f%xWpoĤçG)#;sWsNW֫-μ51%hDRyI[rg! gYb .QghfKL{W 3O!,l1_N͉Š)qnlaa]L_zOP*'k($Sn-Pp儏3D䥈?{>fl`WfL1?(%5 ͝I~A !w[ w }ܨ<[UrQy~M"dK@hui, "@$pmYmV<^`ϤrO{*r%YX$ucA ϛ%Ej$ ɑz=)qf^e㣢 ^.dڮI)f,qs҃B[/ x(}/#;ic>Q9B^/)nɃ; 7YûEDysz]sUpfB7-f=z`ednjf*%Pu;Zc2\}kf_#&"NCjO >=O1?%&MDDn`-;vpzIn3W3C1ŗU .++@tZbTrbAc'{CX~ו@:IH|N: m 2c{ꍜQ?+WN8I8\xߒyOAJ /"%/=Nϵ&:1"Xe~N‡Ã9vm{G- qM(A?m;ng4iھ _p) ?H^kP&MǞi2 e1uXX%X,OS~9% hAJ7j{O(*t j=oJ\dZjVBH%0["7Ih[_ QmNюˁش02kϢvKuP=~׼`R@-PxÇ> ,A}!..U\%g5+30Qi4;P*=-遶L  z;ԱXD6DGInz_V%Dju`nԏF >ONF8q`kg ڒ{2?j<=m(r -P@~*B/{%@CI9r|8^'[]|gy#7(TKS4H\)"Q |'F%ELgWۛY{r%$kM2_zXQ?y|cGgN/Wt kAYrgX@ \ڰ >ɍ%&:2A5 !RT]vLF0<1{Z8d_de{ԜrH0 :ˎC)T/_}pMx}oSXWЪ+썄 #jrS3Լ$ lzg ̈e+xI?~E!\ak{:Wv0E_MrXƝ " jx([ ejn&{VJF4j_{G:؉<E )m`(mL9Ÿ_t 9x ]ף/Q>NT7=כ/ iwm_*% ^^ c!7ZrAd889?ܭ"G?5]U*\ :OsaVNnVBrr5Aҳ)1t˟rĉ]RXw/}|$v`;oADG'(v|g碸}fdpvxD;t̏-S*L͙32aw\cʊuɷM!_mիnKbšbj^[.V ;)2!2;B N"s2TYYV.MUo9 o1\]کd4Dn}u-.蕜?-39kf9 kj׆?`kPX"Ҡĭ@7­eR'7<i5g:̭mӦ`QRrsl--mFx o| ف,WIlULUmI뭪MzS*.ȸcyO5鬰*KtG`/穨/8hՙ5 [D)`PLl:5H!-Uεl`ߎ裕sɃ7\ܜ{zz;D&@H?\:eltdV+yI?%ۣ}L!Vqh+2!_&)'uݙ0j)nVC˘F=oD_!vGGJk+ +*ЋFd+2ܛe |jnK$<WWR WeÑQ >e>nާ:jL\{!&ҙ/#=t#_l+IK3= 4!9A$!z}zivAw!lLAE2`_JWsƱbxvR [m8\q <;P[oH( *~jҬ#= ?QSޒF$/cj  ?kJ;_9时T;/&$~dXn^룘<Q4^ZSv[rqn%њ#ML 1>Wο$/~aizBz-)CW畨 jQP|9>I>UxߢSIy 8$\jCah,j;wژVpYޯZ~Ѭ,t LWc sD3.9ĹֺSn#hr,hA]Vm6]I8glfZ7|DQfhSf~cM#eaqn'/vކS!DDC]KcYxQsqӃ9܁!3h\ԗ$䵜 paQ'՟IXTTxUy8TR%h0ͬfHZ}pMpmI9 Vv3;NEum,,{YOs"no rB8YUt 62f*zwt%p%wb[cvl[6hN$}xj,jV>RuZdya[7J;X<`#ib)MJ8)'ocЀiE&!``3aqP۳\>-|GPr)꧅ Ҹ]QdS9aذڪrt ht_;ZxX4gmUC׮eZ^MŕWYdݖ%cHҭ-m%5 ˽Rr"Rj!be:ѸY϶2cP"Wz+`o>SX1 endstream endobj 265 0 obj << /Length1 1370 /Length2 6028 /Length3 0 /Length 6971 /Filter /FlateDecode >> stream xڍvTݶ-HoҤɇޥ*E BIo"MwW)"E*JGs㽑1Z{V]^y(!L@ %E-S 88 hg_r#AL @D%$`@  p(#0w"E nl-7 !!ȻPp[Ђ`.m!΀C*qqCq/8ЇP0(k`@3`w ^ p[၀Pfs@Mq!5@߳]oBpd-#;3 QC{AE8#1OC9P nοFUs"@O b݇:!^ ;8jk+ЀXBTTX0o[_ }\a`~HW3,n|C_Z*fwLx%aaq@LBg]o!쐀ğf1=?_opĈpG`-M[SoUnHwwC\> z1Bb\o1g`PG- pw7 G:Q/90];ףW c/['#!=Wa(A >D`ED?0BH4&!QD PT@0-̶Zv3 %FJ;ֆV3zn __ZiN2As9h?UwSV|ش?#ϗoŴ9h,5}oϾunA bk_mqO_Fu mUne& ixk+AS ( C?NZ|2zӅ4zD+QSf{OOSAX$56}#Eŋ~!z{mbW x7K?ǖD" C<䝜a\bքߓܔ(8EsQ  Q0*reRӔ q|ey7$5=9si0pTCuҁ^qJi+pATy:I7nϤӧ֛-f':"S2 j}LC$fz5lڥC`Ǩ˩O CcZ2ȣuY qxk~6>` lWjo\w$N ߤ?諑lJZD4՚깯-6ua0cVWkc@fl\7Wᜤ!F=y2;fyS_99DLifLPb$ک@!rא!Tr.A%f%g#W"POU/u1V@aǬ@ZwwC7{< o_HG|ZD,OuH钃dfcMQ/ex=wnEmh{r϶i}v}LfJ__8?V]l4#/D;ٴL'kyӵT&N#7-0836 Ookǒ`T3yr3vcѺϯڙĵli+ll r@ev!",ҪښɅ QֽRl%,C&註!`ulUӔϓkNa`vۡ8*&ڦ>)TUVPs*kiYU4(_f, ~kY"D[NDn$ryDo6/l`g2n#7Q#+e>;u+~-[ wXy(6Fv>mdq5۩^BCddоfޠ}v_5QaOJ6[zc/Ԛ4ԦQH!(-YlW]hA\t3ۯ2{zdG"f?H>g 0V<~rVc,T}^Y?Q/"~-lǻSCh[`Z~Lܮ1_,8*կJ"k&@4‘2ycW۹cM]3WB@&*nرΨ-)(8z|}~(%k)F/1z9C-VޱTnVڏY/]7G,qr6$*7ʛ~B~_itmPsrNcʲ _@b^%csAќ)4h8rD\Y.V{{E?DM|diWn9t$kZ\#0(Ц"JbIdqs.S积J9C;"պ:g&>h0 6%>Q$≔hMJlɄ$Ј ku7WOu k kt;C!uXwǠvTyJ<]z>^c?i(X}ؔ4vW~ rRᐕjZ1 i:֓%yNrr2As=MM0>ݧ/\m.aOmYmhWD粴6`{ Cy~:k޺2,~Cs1p #Ne=b/ΥNdA`=1 ?x( b[5N3FO U{T.2"*D-7<- .zŸ*bڀIrn~!fv5֬fcm ('=nr^3}A CBd%素Y6J8 ;~rSJ`U$uOxǯBo=2QD;ٻ g~{F>pZb 1R6j e j fQEp{ O !;3oTLͺܝ,вS $U Q'(w1x"A#ɧcrgqtYL9Mֳ@O;tXqHe{sEqm)S}M޹<M9,t9 YXo#B9?kP^{f>O4ȭܧϗ# b&br%>B$ 5]P4g샔vf;H:ZwML{3#龪I}lFC8W7xP0F `=}峒ELXG!LNS䢭)# /UwEggHzƆHfHm=11̄17V^2lo@c36 k)E([ Ĵj'o|!1V,+EgBG$Zx8j;%dOHnHM'yxlޥbó{@<,[+whsKO@ܥ2ḵŔSV*O!6:Qۡw%8-7e(Kmز8=VYOvoʥ֭4w3v8h"lI깱'u ֽG 5B.)Biۭ)B1Eog±*^=Hn9NKJ46efN M48–M~#(Gp2i!!Qj_cOqCk|1&aS]VihYp Qd#^3ޑ]Q*կ뗚V(cH ]C+Dt]-;z'[/n_h_Elb,x$J4hp RkC{飽-?ȿ83lX<\ǢSbKIxTqA% bFO戍BU`߸N%Am0ivٔ𽃽MLT3"Ltn 6XrO7:d7O0hFkCL7yߋF.t{q& Y(C ;"~e7k8-p2gEj]せ\/C9ts33>sVm;E}+%Nb\ ۑ Pg'אֹ5 vG.*w]uJ/7&UW&SZ3jwݷ ͏| O+LŽנYGW*ERdw Zg^OyA椻\*GoBAyѵ\q6ucS9rgab!nۀ˷c<>.40wUU3ԯg–Hf? 0?3|;E XTϑ-@ n u\ e~)"F.7ߴg5 K$goꈍթzh%P:xn<֭K9Y%F񡽄MP`V*k(L|5m3gE+'QG+9g |fUa8-/|.ì @ad;i,bU* 3,=.ɢ?9&kn-h1;,!uvbY;O5'z1ߺI׫rL!5]*/UcX$嵖Oc;,EޟE ﹷ|dG(!E5 ZX<|Tgsߋ̅`}E3 ;L ] Ѿ~|mjI-=CtG)8+MO^"=o>{x(31XvBhv)Jzusހf+{c27|Z]?T13^{# 7*P ^_kK S,%c뮃LPC8Ku")CXeQc>OeÐJ$7ADfM}WB tQPZr؜4Qۏβi̙ )]C?JبD+XJXjWZVeKkoB. M"6+)vvl^k_1fēa,^P40o('T 8i;`N|E2 /3T2v([]i'|M\x]+= ]'@$FvwR\6O4bzPN7_0WKun4IN۝/~3* euǔqޏ2PBjYrvbE2T[,won+Rظ%Yi[{:?MFusxK{0FHgu|XAsIt|Na6!Eg߲ O ':t.o(|ݨTU r"g7z 0czꝅCP+kl~62-9p칱=zr+Ԋ;]>.otd8Yyf*Pݤ ~+9S8IUCRy!3Pg3P~[3?ݩJxS4Uサ -,[/Sz{l$uYux,WAۇ`kr'kWܧn16sůͦ5{ ,*cJqkp+' $ko9NZ}b^Us &@jpJfń=M]9_j#-(5 SaiCwѷuky>)p?anoj'*pu}VY;IlbiVJug[ g?zd%unklILMn<޸/1K}fEHY~o5Ŵq{QUdRxy%h<dIt}j9%wۚgsqUY?^ʨX0ejԼERd S㠸 7E^V Bq)_{By&;,{@ -.nG^e h:JK M>t<`U, 춵(lo"B3"Xini-SQ.^rB߽_uFeuܧTCgCs endstream endobj 267 0 obj << /Length1 1436 /Length2 6428 /Length3 0 /Length 7415 /Filter /FlateDecode >> stream xڍtTTm. 1( ! C݈0 0 Cw#%!]" !Hw ݍ*wZ笽x~d痵BXBp?H@P o,"4DP _H((&Psu 1I @HPߎ$@h p < E ; E `8@:w W n)[Itww; 62<0-@EAh: \k;  wAG­Hzs@ @+W"w0A8:0 h+iÜ] !0( *x_LLDu@= _ <_0_o'f E]nP ߆@  XBm`pa50 { ?OBSKN a\ ؎U ffNAG@݀,,3}KmitPW'+N!&A6 ++l{7o4?WY_LrsdEs,E9ii_E.m95JÆ閉*jTC؞n3pl1|8!xϼ$.鲦ŕI@>ղSe',sĜZp+h %9ks%&~ ~!&q}9fhJUԝ5p)1'LʣRwjci"SEv^FYѪ%z{,_bZRyAIHH .zH![E>cU3tNkI"3X^?Lz,9q2;N$ kV߶e׳`G15w#X\e=GV/e W8:.dlk*SīlsA 0?$0VF'1)_T iT9 7VN?G]{?19cWA[GcT.98mY;+0$:lN"s^ vywiK<5O ΂"&^[1 "34 flu>5c=?0f~o'*8?rx}:8D]1.wˈ}b5"]{cײd&$}+n]Sp'w&7aҊMlNlsO[:>GԜ:4jp%槉~r`3֕q1YiwMƓyƹ^4%uD톹rdKÆyIkH掙PuS ToU;B+^ḽ5/mWZ ⇄9R%"lZH|>;w,Ђ*7~, kԕ0'5,L=>Au"N`˚>{x% :T0-ert^ajD]VN'O˩yU %Fg~Iރڀo#o542I^:ZU^ ښ .& 잺_= OW8Q" :>rvyԤ87,=ǎ}lmbo{v?ܞOEb瓡›AIe!Ch2n"xYqN"z/ *IN9 5kck0CJo>E3?diȘz؜4:zKzd:-4 uuOd4Ь]k7aJ79=qbjMN=rx|{d׾#DV j,Σ:vזG<n8OynWɏdIux7E.I iW slݙk^3=-[&GNg:VM5԰Fkz"brg>7%=۞B*ux)+?Qz+ȝoyz֐ۥ3pNdidZpړ3tAB%Bʸ4az6TˬfP#jj51ys4"vlq\,_avGg ZWȊB?h vUK43π fD 0%8%s0r lLV&-)@ryB<G4GUʃAeJMc T=ҍyҽZV5U:͓U*)k㏯ovwj#Y#FeC9_>{(Kܴ.3nXPiq/Pqsm+`Ta?c?o/YfLQmğ͡YKMuG bIxF;}N$XvK @2~x 6 A\HXi9PҊ^_<̎ tǨT:&oeu#:&0BeRn+8,wP~u9MDdMl/Tv (bhozv.sݮio{WK&?70#:в7=&g"UgmI"n?fK =qYFyѮ:֧k8o2D8.̂䉤g)>] 8\ϧ3"m:NٚoV$wXE5&7G֓Zzx݇ x OZ)Y&5eshc6'bgK :> 桃 E#2^g ؙ5I&|ϊ2H{D~)xl iW᱑j^6>CE?iʻ5 ZVSnw>bKso.>o$}c_k 6L1uJp[nyx9MłS09f5f. )%b[K:=PvFvZ?U,ѣPG V3CbfS)Yg 6h%.arjǤ뢤H^yf=k,FU ӧCuKg{PMz "]z>q S .M v,ݬ %AJS}tXya5 AlߏƒX| rQYzGDzr.AaόеQ~ʛ80%݌/ D/bxa͝uXsJ{UKҚLXaECOTcx/KIuDU$JQfFUQbڀzj4\B>Ψm:)wViȑ)o5Y뢹yݬ:EЈO!ٳ#%O[NJ%roD1hհvF;y7  ُVA&'555s۞-ar^{GOPvIG,V=ƨ^+yD5J];*^CoVϭ#*9ut)Jf_b>$ed򚓵`<$bc$zB!{'j|l\&"6NPŽ}}}@=b%RDyX $'Y -f- yNٱ@^@au7zW%63'?xEzul&ܝv<(ܲmJtu{+ĽYG9k]y!UӃ8Njۂ|=VjbSFt|LYe1Jz3"< Xt+6UQ''A72Wb$)G2ɞS_x^ێgI9^ϤU.x K<)dĦaUEublyPΝh24-Csvmy-_[Ӄ} *bXbOȊ1,;]sĈeT~_pk}ô74u^+ dpuSD [J {Fq^+"|^%"z1# R 3'OPyUNQ/s(^ZG|=)a+/[MwykuVgO@4^Gh"DfK^,*qܢ|c5&EEu!L %9d~z(ETHܞɗoGb.+V .m5U0Gge͢NeoJuSDLfuHVߦ百3b^`o|XܦИh7\+sH쓋!P:8g6M}S,.N|3Ú` %u|_lJcX;vVЅj)kH J>2CC̭C*"I|oZGFwo`#|hΗ-'8CU uw|HZ^nRǭDl_SP!|5 `b^G:ˡ&=3:S/*93-Ky;/rZ?\]]6\q!n%$`[l硇?(t :C>J;҇ci_]RwRr陵}պSɁcNc Ok7kPmdHо)C@j>vi endstream endobj 269 0 obj << /Length1 2213 /Length2 18897 /Length3 0 /Length 20212 /Filter /FlateDecode >> stream xڌPK a!kp [pX`qwwww   r#9޷jzzz~==w-*1H֙ &dcr0#QQA#Qiv|s9čl2.6>6n>VV;++F`S<3@D%fg6p~[?Z://76 G-@d󶢉5@ r|,,nnnF6NvBt7@rtJ`dwjHT5 ӿT̜݌A75d6x[ (ڃl,/F7pW ߓLLll=35()05moFIQe[l+G¼m /}`G۾{pllCf`[S0ugQ;y3!\<<nbj2eog0{K6 y9Ύ. /!L&c9O73_v`w'ַc[Z{qY>JH|dw`bbs|7:1hkfܷ}d*S躬\&o_l)(IX[=N/q#ǿ=* zjպ S:u[E3q2rvL&7k-H 65-Vzו53ع><^lo]i r,̶voSo9:\ѿLo,b"x,%nVbH!v'EiCoZЛ?EiQ/iQCoZЛ?EiQCok5Kod_xbdc]py7&%1;#/͟?-?-?1?-şvd7?%o|&|Xc)#Edk 2sce_7ovl]y{8ue| |?-+lRD[V[_oLL,kEݘv9Q.¯4w$]/9"DgEo`6YiZ{D-ַÚo3zOb >9ɹ155;mVv%2Cp;~ %@\y[aq Ox̌5OÁ!QFtfHt!2;T>kk`B|xj/{~(m$`jG16=ȟiTU=pgBb' b,=ݟ -Kq(nLO%^VESSV&-(ܷ(9uT˜)-W34攘1R8ݨzmq$"1tW%"3 jsz~{/429z㻣$&NFx9ɣ,4,-?X jN{M.4G" Bz2kP\(썠Ur8_mxR'Lj\gs0f3-$#_^B |>]Q-sLQP*F"妒ei,*>XG`(+PY<2nU9b]v^uno1ybx3fceDmRfPJwsf)d򈱖JSF]:38}RDp8X:sZDNQGJ0/Z/DFdZ\P^S<6- I7S,** x>)m=FQ;tc޾F;@dgp*Så/ _NΗlQh5dCBV9N{4"R~Q0Pr͡y3'ܞD.H}*uX un&pBxE'!)Ju$k=Mq9mUi~>r3X(Fo;I[^3"iV;%vr]C_djA5L~S.l@ݧN0|>rۦC:0L1eq&͍Ui>;=q Dx3 ;VgeyÞ)R%U,Szu!3>_')vQnLK&56*K򴋅"8ӠF, ̉S6~R/?,mO*BK`xyPf(]O[S ?|Vp|t p<6rh:>( X?=~K~˅m ":8f}lìY}sk i|)KJbCBw;9= cDdq%¥UNe!NAΕHeIfL r4 5 )-i^T$,VZߑAڒ۟ۺ"i¡ђjD'UP>:u B>;_<Ȓ&,bt/nZ6cz^jE.BѫY_xm%,3Q> ax5K'ƸdL6-EhӘq VXgi'8Ju'xxk{- M2=K+'Q g5J\)]՟kZA,uxIbr<ɍ{SIT|QpPZAm̩2(ͭVlkͼDf]_Q#G.<6IiDg|ӑn=p(_w}l =sBQЦ/G(Y(~C\e}!S6^Y,Gfs0"$F:$4*_qѠ[ ?`*D<}&\ 7Ȣ1gZY qo ^:x~B.¶o)2jVc_Wc[kKQF9[2XhP-4<\x x<׬>eZ]߯q?vXQDSgڔ^ٜ/Fww_gB+TϴSj_ SƘqP`GF!ke/Ţ +Vk%B|Ҁ.8v’3\)ߝxKԣ]MJi;Pf]tt[YwMHX0ߝXARRRvOBˮ'i{;S3{d'N4; /J a>JMr,%$r%ڒVГP ءF?oNt9NnȰ7N{1#lCЀr#iX t;Hbͻ%l8jKqd]TȲa1F ?rBD*`dYw^>U7+8!Pm2oG妈y3*E@Hc[hżU.{g-o:AtєHݤه bЯ'o]gg.9C.g7)\;9.rZzbAV:q}Zl-| Wx >Z*mp}8&čBL)pM2 lh}yNS !)+ps3lqx!3ψ [\nM}XUxԓ_jp *gh|Os~f???koќ|WSh=w+ictl0K )-uUn \1Gh:~1tHؤ7%,nZZr@twCX $}9v,!4nQ{ع Favᛤh 't @N󗼴PנNZzT?^a:0鲹:sη԰SPٌ!鶴1z~슂UXEF1X]Ia2H2Rqd+^v|zBфܸZ1&u5ׅnbnT|c];"D'6yub> gY:_ Y(Nm<NL-qt{^oR}-k^  玊k*4? /V$]rO&L_ajqv^֓ KVC;8)Oމ5jk )c?aC)V1D>{6AW=au3lO^~Y+Tc6.ڋ2zp9A+5dj@Bvqvm|ZpǮ-&6}(f{g&mϯ!˲ܫs3)sɈ_I7D-=3CjE;b-f;{|BNƫ*EǷ#Un SjX-t]8N_:*gkD'bC *Kh\D{k'hygSh}$ϻ}ariIbvS ~# ܈T $ry2J w-襓q!ƎAjlUIV:ST]̨U-Y%)ecu @x:2t4SǗTAQ_aP Z>Xlie $:k 4و*m^m@?iO-+zȔ+ӑt+ABCP h [Ј!*$DK?!{75pohmQ2lhu-K$3B8`N;-E(q0AwV-/_R`N -Au%`e:uUg?;HxWXfbL:i*7o:4҅fѯV%Gh D?+U,H/Fh0|ȝOʕI%bV~ ՖA hz#'L*QcqsQPDSfn}Ќ_9P;sYؗcBW`n7%Ikl* AddS,T&fA^9(9z\lӼyUe3W(ЙmJ6OZ7~Z(P C j˼_Y>%RU#rV4C,MWdY|zs1Mq\&,VXd&_t:l;V|aR5hD;Ѣ%)=qliQkI{9,V"̼\nd&Uh_v*uQ Tt/OlS8s{l_&hagŽj v2}1Фg%;MqdNSgAPU:X<du-l$n2go ۈv\HY k+u3_; _J݈ _HRG$nŗf3v<'c|L#;V"np-P I_a,94u< ]Hd y5BZdgN9~=;5-SdG>ݲ@)e|˙=_9Ȧ7e&z!T}嘰x,ng`sж< ) 7.qU{7|垌b4ӆQ [67n{̨'Ӷr;p^ !{sM0{}H&sM-Aw@]9'~EB_M)?Kۍ)YA׫(H`|7s)a, vBT,EV{΄d"0&$T#5^苢u3{:'i!6ƥfe;!cO+N5"OůquDF猰}K qnRl%xT ~uZ$qtBOi͂dWC<^׊u8 ñc!QG9 w8|)Yux))䏳wV#sP^XQ{U9&  IνRgXn8s!fV2b]G&3o=X air9lʂ!ʼn9|>ծBYLVcf{z!օGŹ'K<2f&q&ə&c9%mUOn5h ؾҊf!ji'D#|K/:NPOKL1gn%t,gl/)Y}Aj:c1aӧgHS @)q)bAfLTFBDzUՙQd<֠)[\69$*O[F`>P|ZקH{YP^#RPY~a!v>/Q{ɾ|Y^a=Kvzo(GϹU4|9cZ^<nmJx}1v3Ҭw7ZO%.[Pf" `Їfzy,T,/q3 1Ld7`:;ټI9 ꇯ.5 RKyA= ,w@X4$E ;J 5dVz5%X>ԘEIb2wrB n4:Ӱ A^4z3'f*-<.ֲYJvuHA_ƣ}R2St.)tmgsxt 40i<=\jW<Ǚ<NɽOfFݱ"_*" 1:; rW%ϾA tRB:15f2J_houVVOg%":?+>?pyº&_aԿӨXgNuP=D4\:=W&yB#q0:<1z聃bjhO~6>m t `tG%$EM/#Rz9~!\FlͿ*, VIqTCHk4Ô^v7EF|PU0ms?Ŋ{ lvl;ӷ_H^~NǶNh[+ PCfYػG<0Y ^#8F1k@H7[koomþ/.rWYfj dMA腽dg%$z"ChH~3 nBX[@|4/_ )]}7&хDQߗiy ]sqռޥ͗Yx,t0;)5Ap2S4#Y—/]X{AqXN`qn$c:JDCQKm[#+FsOy:f,+ m6eHN}g侹ߘmjJ 1GEBZq8aYD88_w6 e%SϷUuG%ѫ"EU~'inDo> ~`&rO9-P ܳډYtIp 0.'ż~[Zyk}+ d` tU7}BPrPLzݷ, }ГB=:جU9r5iUK`otJUE@&CqBԨP*~ dߚ3ЖEπ?ٹtQ&FUXy(}%-K0aaV)4D eװ $]W3ļ1#sbuXMDIK*P:;|‡[cl؞W^@ (fSioOjL\ 1(63{8w,[b! Y|ڐ'Kۄ#cܓm~G!Tq` 34)oA[u(7B5硑\x r vY(1#173#Nj z}D~ɊƪIm}i&W@aHfAHgJ;aCiI}- m>?Q-3 7I9uc]qӔPZ q2oFk\#h*瘈EVlxh\j rٸP'AGLb%<;vyMJ/fh/6;a6 8*ׇ u92gMQtĉ.s6.ooN#,_Hg%SSUBYBő\%affQX)m?6vrG35Tyn٤7l_/2;~iB}ьPÜ[uIdz쯐kpry2Ɵge/nrE_`ؖaZD蘫\*qfJ?&PtJëi:l̔/U*nAp軕surh04xvw?䣕Ĭ;JM8\+E?jډH $E)LV^AM1V֣bOlVVN^Y2V5A&Y0aS׍:+ϙ"C2#ܙ+VW>rvƷho4Ѵ yAxLJYp+BѺTooڍ؍K7"&>JȈhC!` %Pr!*kŭ'[MXXX1Kv`eMӬƦFݢq}-ݪk#H8uDŽfsSr(^KwCMg~:/UߢA.(]-|;kNi]VkzZ*_cX!5 _D yFJpBFӍ4>Ī -m Q)3bz$sA@ 50TP3 N_a!1~;*we] BXtPМk'+s`So[6ӭT|Q2U0^ 1Fz& "( bLo#@ _3[sׄӤ΋cv-ǟkѠ"z+o}D ['UէL]c%Oݪr/5wCum) |-u0jOlC?i8CDVN:K7V@iސe-jJ/Ĩ<Kc>s҇i_ i5s6V٤C4;6 K(uhdaLYgO ET+uxdH>\$Ko.(!mvL}M4)悔SrGb!V_:m }-&Ӧ,H'RvC2ދ5z  QH ̭mu)3^ ͥp4%@?ϖSfb  %<<qHeeHbdjF>x}O+$89)5!^;D8v9UoO83IKw"A*9NS”g~?.{J0lp3f%v?5E0M*RR(Bya{c \> *J[JY_"}u}C#={]!?\sA0 7e֎66@i*4P^qtѬ ۀ3 ŸiΈk <_*M0N" we>On|SݳfGP'6.?/Bwm9AG;Gŏ_,{G_ <;'ǹ灩[`hQ_S_6Vyە2,-Q3 bpt AYcm0l?n=_| xaQ.R8)XNH&zy笷ӊґRseok:m)Wg T{`@y+?z3At,e"H1k3ֽY *AeVfpCJ__RӺZO$| XqSDK9XB rw>q5zY#u uBLm]si n4/> pT2MQPZ9=ǻ94 <,V0qb/G4G)DI䴫Ly՝J%rBׄ+g&uR,IJlM!Ŕv((mfeE""@F-vZTQ;<@-cQ }Aǧj rj~ f#Š=;t^jkrP谭 #-7wocuZfQL,Yhi,)[O %aF/l MXHa2UQce;4>E MD,u6I,RяWJfbxm`..ДTK-W]?ZCAwc՛Ϊ{ڽKSr*Vw6+羷X%pLUŦ\2& 9/@=,퇅^_( Ry{/2c{l'S;j~DJUj닩ƨTpC*PW@u299$OSm]K]% xܣ/ՎݪDr6>gǪ"i:e819̎@#IpZa1/-*FBUeA8vƑlp\뭕:OW!`n@"UePBc@H57)2kCa P\c ꨛɏY<\>$k~;@<kɗF#{WTgzTQƇ+vdQM !< 6ݩtks*.l Sy |s>ZP .MX2iȧ3<)}!pVzE͓HoIk^)N(~Z輑qI$BWD/ʹu(mRA-&0#v"6MF+ 77[ʜbfa kr(sA}d/aǺ_m 9[] [[BqGWqm¹MyOijH C֝C\1 %~* }bFϗ=ZKwqT+u:k:dor;++)e y-Đ>oK:"~I\zir)^r2gI( I]{p('lGN-dDINZemɎhE+l-WYz *kqPXmS:BvcF~ 2ACB́ZvRI~3*6EBi>x<؅hHZ\?dVyst8 ~.Mtɥð-7_ҬG SQܙ>FaΥQ6w@}2°vAަ1?׍[ rR\ALmV) (^GrA̯J$DyHcoNjUpD nɽ`-u7|\tm 2&oc̃]ɔY\t匑4~}E]>vo6SQ4[&=}CҪ.>a\:|ml֎N ,6|+| DEsXl6@Krn3]Ȉ#Wȑ<:#wr_6k!#vj՗ΊI"_wTw]Ŕ 'J 5bH57Bz잭$?z fB)^I5}`,ď뽺Hs˓?_~Y6Y.!VRO<0VDŅqoS l#kvarvJsK̼A&.MRLI\h&5X|sk.w 6ZRM(6# ޖJ^*m/9^u2 (Ӏ/;vsҧ6;-G>,AQ;(% K.E&OAXlj[ ;1l Krsa 58U>[dMd&,%s~ _!em 'b0oe0uu6v$+r+ 8C{?57m~"PyMn^^wģx-<چdspx!a-;P-o o3!۪,|*FqW L ħJL$tYB\&ےB=8 5Ձ9;Ö0`v2xȊ}\<DԴFVV+9ߕ6 ,@.c´y"JlO uӹiE{;ЎW k} MG刟v@[jpf$j;p *2f2 :3>`@)ϧC6'xlOY0W׷2G1Q@%@ǫM,Wxb.:񄛁tCc]x9tdeq`Ae'#%)akCv_='BnZ${UXZ'P;m ߀_n''.J Z/&f^M"~ao}7^lI۬r?8:ӗQQ?A:ˌI©< s`OIP4:5Q 2kj> F`p.i .pn$1yX-XX'. $}e-WoI< ȥbi5 K}ʲa>Iǿn-ʲtuTt_̮qH6F0r:xC:Ґv5'y1NAV;6jT0*ݛ,>pQz.>q/>.ە Ww/gkɤ\wj7ھ&4f^%$ώ[l uJv6-I[c42` QpKм(L`2qgkw{Sh4G4qH*=pQEEsZIc0t:Hy}SeWFiBό&wWydq%q|>07f;C7Y<"} A[e3 %/ƜcD3O(nZy'Ua!^11ӮTCNu/q&y6m}F?rCɽ׵:6=sv-oMMĪ]Ug137p )mJkdk1U|4Ug)S?le~* v8q/)HZCi-3E}y+H:R(s,7$VWlO՘|PɃp62D Wx`5 r+ 1 lCdD@pEa q1&?~+yS 1Z{`Au]=qL1/ZP'shv.?r"b+.ÎL>%G=\Ɋ#L[RHvv0ۿ*}w%ON^Ũnd`f! K` fKD8ym EAM &VO@̙p 2/ř%td _7W[F:| f^C훺&w2±saD6?ůPi!;`Ԡ90Tu{N9+,.ỿ@o]]O\gWT Hn`/( 6usPXr]/[,ɡg`~#(Y# vAr< *Ls/REN`}HهnL4 g 9~c׌`SGu;-{ ^q/|:AvFܮ9[+e6 7k+Bu]Y P"2qw&"5y*0T`U㺁[rLaHa㥏y_E{ endstream endobj 271 0 obj << /Length1 2445 /Length2 17427 /Length3 0 /Length 18859 /Filter /FlateDecode >> stream xڌP w ָK[w =!Xp;w2*}9  Hޕ `ffcdffPrWO rvr3&*8dl,lN^.^ff+33 y@w+3#@O!leaԦ4."v g+S=@j {h 9Z\'5#/#΅Baj PAf-v[c[ZG`tV {77{33-;@MF `ad'޿Y 45us{Y[̭lA%IyFWOWz!U: )uw.V..V{df {31;; ĭAo{1}6>EVf0ssdҰrrɈm&#8X 'Ԓwu/G_J|omAo}\ ߊE,,3+SW O71?<zo`' 3sc3*jjK*?JQQO; oeUSbXoOAXos Ps}ffӷ_,/3;ߊ$lmSGmn\v@m?2rZW.[C'LXZك\~,f{[.Sm$Rv3J؛:^2VN6Im4y5&F{7[w~sgG`-0A\&?$$A\&?$d|r[>?-OAb0Ao vOe0:2qLlߎv;?ϋ֌-_oT}Coqy[oV[o&"-~An7N,-AxY Uj/ƛͿ9*|cѿQi]FLRqŲHpSݛ:r~ hۂ}AoӿL9Y9+N@.m? \Af&:,7xfyc_4sV-_!Sۍj /n-_OI|;27=@ַoYOoA"S7pxzA O)ꒃ)_uCh}<ŮV: Ϫs#2l MmvHh? 5&؈$'gc!B8u='_ 6Y|'7ndB{A)ơK*{rs 1A &90 h/,zWBޠOR,l,20mL ˠ0:HMu42i e;68#/ҙ{xHJ* DE:ә)*zmB6Lyooc}k]pT![dUN^3`=}85\)q [Qb4] NFooMR+/ӂ tn'of/bkӄS]*($ z{2aٯf5³' w}FOfhdt -QP 9֖4-((i~݆ᢃ$pl|b)X~Ż[0(6-zآϣcWBr&敃[{_Q⪊n*&V 'ttWe!8¸qq-C>Rqw)i `oͺݵdy|?qh'cqRAݣ˒2sǂ'~Kb%"j*ņqd_j{j,*nYF=?;@2S C3ݒ<Wpdp%Y,i>"e;|1OYlyv TU*ĊŠ k9^x~n }=&H8Zj2T"szAx"U J(Md>%jTieǪc ڬ1XuJ<]#!<`ZĦ"=O*0~ަŢ!v,U׃IlF';'``EĪbdquLzFs&$i.Acs`⽐&ZN$VIƯEP1Tƛ0q2@?>uM&^}7F_] J]^P9Fn S @U갴V~虭*c:QzV0S.V ޑ{h,- D[{' FO"ٮtiSGGjC1H|Tik&5`i]e,E2C; *b}рb&B Qr{ y8iv#E+I\~ϷS̤3d|P$)Woin]`+ SEܱEuQ'"?w6pICu`3-$$CݡYޏ]EyΧOCG"oiAf-gMpϩ{)hs;5N-7ۜxJWmD\DC),ÁXTF3=o%e'~.woO4NL&>VQ@`Fط*dLdh}[ <] u -K zRYRoi6RQo/oѢ@Ma'g.P V (NoY·C &[(X#Z!Rt=G~51)˘IJp $BI8ϼDr|57Zɡ7P+8&<;MfSDKz 괧$ٱ^:`T /ԐjO0*EȆI bH@wiK)U%#qB!^ YpSN`1QCnSHpڙ#/\Q[!X69ɱZ7Xw8_ȻAuMr]zu76+K?f2IfƤڏ,i̞CȮd`&: pлF/۰U{~<@'e$MOYۜ5-m7#߫\ԿL/Rf 1Z[D#䝑}{?WS$hoB(h+]\ M?wd>sHOGф fQ;&.T=#@- Av\: Y"$H,p2lViz ws~'ɮX)#_q}ƌ_"KRE=q/:+7xɗj@hVIz_Gz8RMSqzݷ [!{y9tcF&+ς-4"A:eR:҇Lpfn23Uoa{S+7-{ipl/Yh˱(t kj=zF`mG@KAmLCmF^4O!$'9~A#:}|]ZNU{|ocySewA`+%;2$H!ѪDe'L`E'A0}_<4OV7J"t7hA+:tN?h[r{ O'n>a>t'nҬ柉fYtӄϮzHG]0|tT.QWK!hFZnTx/bLiXVt80 [5N. ;- Q5>t0G: ~Ry">Z %{*n瑊 T|X;cTx@a>A|-iIp* ~uVҢ6]#M ta 4ucT/B((8eOlgFg[NCdYg0x9L~^peȆSgGAЕJP%&# ^P$}H1:nRQ:$ňnb>b4sr#/dz@E]A`s'rҢ0ރYwEZ_{-f#Q{6kP\T@ եv7̅;̯|յGҾjIu-؞ҋq¦ގa }]U'2C謯 <𝨎j:Lz:0}*282r+k"cׅvk2K+Fir]~Be2xyڲ-)J hD9&GP)$..[Q݀$FF7ۅT2pPBN4c3r?%q.(礔IYsrn@zu;ua`S!aڂ2~Cp!n^ttk Ud R0uZ:OF׎4 l woIzY06Wd>#ʨ,._ T;lm}N/U-<-0q'W@Ca,saF.sF!FVٔC 뛤Yߴ[2dKp{澩 à:Ɛ9pHS~H< Q n!c`"#L)!+d٣85ޠ/XЙsgQ)TS,: L }cY#M"C nDQƫ/== wU_LzKҀ>&rY2{Wl} NBhT({jK2K_ -Fc6tN j>J(-R@Qu# l8/JxbM ~4nC^lZ9 ׵#(bLP[ 8<`uOTZ^}zͣܖ5`+ 6gWLleSBs'iY&`>>*wD}߳w) -f7IXhfrTFz[rot|sϏJ~,oK?#&.SGf>L8|m"6 v1Nu8STy0J_[ v@\$آEK+6:{wxiZmU Jcna{/UF&·e-\$*}Cwl R;;Ęqʛg3#4Ԃ9K1=.ʿEvܨ-ѯ5h`ZQeȓdGP$<軋Z󮿸$^K~[Yfg?Jc!) S/qڦ0BRzA!R3}t'$mT2˺T׺a {?iT]Mo#xpuhmm;K%ʙ@kߒ=:7@K\%t s_݀QzjlC͝:4Q"j[K!+5 O,scM >$V!]I5l ljO%~-vh 3QVŸh3[H婰qU ͓HwlϏ*.cDOV j G8e.~vǞx/S=˵KCbT+efT8 ;YY4Iu0 C5e~9 h˳A?K}ASQl8@ EK5- l3/P,_)`4)֏[k܋AJG Lvv1\)[w'+%g5¸m&.f_z==LmbJǰ0I>*O?776v3cD!p6ӂZvW3GGȼ8-?3|#'rb&b?'@ۮ3񱷾5v;ΗDuzrsޒr.-{:lBRBAcÜJKX53Z$2<}MRsxf=YƎ="7lƾj1AuJc :r:nQM4Hs't2 a)09Bf@% u1b*o]EyAB8SA~ۅnMPPdZ\D]5:8וnfգL$XK*: |OBBйuQL"5󚮷,'Tu7-9sZ_='#5`kX߻#  Q;vintxĨ`pa,{KI{xUA:4p'R:̬Z9YM'<7YsҀ{HA-\1_X"S܇uɊ2l 1O` Aq+3/X4YR/uY1paXe׫->S2k=x3_ DC.EM`/k0mھF^X]tnTF#B}nQdڒ)%pgU'5 EW/VZȝb6f+[f Wo1϶q́j~Jꖴ3QDJq̰T~y; 9*[B+&aKWثWH 0L.huf˹# b;P#B#ȔgZ&эL'??GJ۲ZwqۻFyg |+ ׸x&ZrK{t89W65zԷH8 kCq(2|&_Q>gCiIWq0RF4j,@cΗj^r352ZztR|"D>'Ys̍qϥL iG Vjk؄-4ǫx¢[wH>R MN+/=P}̼EsÊ){t:dW>g.ETY,Råg_pBFP}GDؔ 9h~ j$&i1jnq=CgecY$37t H4C7 1x=^cMr~ADZf'#l 3p &_X?"wRǎ'v`Un{*IWfO7'i )<] ,?Zr4lRН%6\u(dR@5W (I |%wj/'\,GFKh_Բ+-gY$fes?cx,>. zFNjEU8<|bDm?H96>nsT"&41= NQLв?ziW0{^.i~`GĆ?dΔ3"~nkBfE0*{Fԡe)>.ʇEEjaѓ^q6?l;ntެbD`0FW2bvV`QHa3GDua-FK0:ϥ򸺢ɵ9rU$~5ky~c[6$Tnogm{<{1Ew+yf I"m{{)+7.[*{̌;ɯ bϘ|OyRe`Kf/,_TExO~KB^Xl0kT{HeZ7Tn&yg"X[`W tQ1t7}, --qʛ*; =gHッ t1C]HE1؈\W1ON&ZߣI_EA(b3}ьkE.i'=ǂJ%OC.p\4JclUv_R09K^N?0 l֑*WE NEC)D+9K<+1OnCG #$CgUtT./_V氩; רSm{~„t3g19xH7fD.l4'Yg8"%)?5sM$#n1&Y=Z 5bOUg ; /Z:bV2S>@RPZ0!7s'k|Q|#Dy`SձV+n6%Jbn ?DLW*'d]x9pbG{nocfuw,a2-?6\$33;_pL?$tْ߁Ip{ك%c,jBJ9kY I@*G&&[|m _%uw-ӬK;gʇMdM˾ |+Slt[#[(q b*Ƽ';|ꔮk)Uilg1#Wlh mJ8 N!@f[ W"rG!}eivO"$@)9қ;2"{["kljw%.PN`UFIxg/ioBRמU<\J7EkzN qjjht԰]C6gE*j«9?f ܥY&7L[]M4w֌^^qHW[dQbhaA2nSm+HfyZm^W{y@O^RA=1{0mJ n5U;I1 ڣl9Ay]r":Vg`zq#*6 bQ8ߡʿӏh!ֈ0ϛȎzC,Ô~iYb)IEư^-d59tM)T۰?KSz3h9G,DR>\LR Uo*ϺL<}O{&q 1Yjɧٽ"*ԸޡG TM=7.B$e($V>]'"A⇒~43ҳζJ)4597/Mb'V!hA!,{*suP!OD.CxiMxWf vgeM^"_zWMJT*~jx -43D;f3#&OVM,k=ڥOvҮ͙w³rw+ܬ΀fW {\mUz^t\2sPkAC<Χ8F{j!C Ç%Ĕw5A cPU8T7Ώp蹺8T 鮁>nDu|">g Q@Rloq.Udh8FvjO٩;g16\Q\]揇=ij^;[;-dI% 328Q3B)'#SKXEÛ՘rP8glE&WᒃFO0c݉dP2\]9e `g'm:oH8|GHPPjFkd KT`P>R=I<^ć# }q N `ojWPn).4Ws@0ti4vI2dh08c;:,%WQZɟMɏZ!z?׾(12dbI泉<-G[ ADVLH)4ٳ'?._&?ֻBXw:g/3pkX*f9ނL{^IʦSv"e:ܞF4q< U/b#ۻכ߇sk#(z_$4@nwf>$+ TR6O ŭ^ȂPy}矧Tg~)` }`7a$<3J_A0,ͨ:E,R7iftcevTa?!Ul yBQ_UI}H\aE)}$UXbUOA7G\?Y(`h̨k}դ=4d,zZCDdf~&SK90WtX&y/l/5fD&o#=0#LbէSsQbc1Xu}qO6B8TFSDPMnQLRĘ:]KNN zY T5`qC+( GoЪJ:+59>Ijb 82_u{XœoYD5 Co!хM$@>aSCڧ6Vb\Dmz_[{eV?AxwwRS8:\ܻEXU):t`ۆ) _@>?R3^]}"g8՚NHH5Bp_W$ޯHwT5*q/׏k  AERjUVS[fM9Ǐ%Og-y?=>x @J pWwfK6}qA6U~̶ŜyJE,vkG~Iv^VlYk)V9q]bANG5I&{XT*K;6ߘIF3 ɱ^谡Ċ:Hq1`X>,31T`ۻT!\ T4qG()؞{*9S8hN >}:ʏuu,J2L./6 Yí]29߲_A9<ZlVV;Oߴʥ:h93}d&FdA'(QUCgo ~Vi,%}_)aJX.o|hnx~m]ݜaI7_mNu'L~aetnHWYo#PWyX}(5/D0P"C2JiKrdMe ƇZ>J"uxnkĵB4z1xAOcNj9*YJ}]~z\U[w257eG;i~3=369g_.C8#!AS3 teHI83K_ۆ]M$f՟ 6z `u HiKf )=ly{ ɎIIخ+ROfr5`z5nV̽ݔM.,ukwh'32zkaKCV&pAfjmV_l6`gm}NFʜ1G& md@'W71z.]o&K6J0 BMݏ,Jjk͎``FdM])y? (e#[Z ǾIa]&.0k ܌{@쥳_E/~%Ci DАD?cM.[)-ΦǤ- Ů4{P櫨 /wWjb'$n*6E.cU w2Ky6ZG,S@h<ˋGڒ;͎R5#߀$eL8SKVl"̡9|G lRMw3 EtXsyl^#i.+Ǡ4im)58OG+sފia;XO/8Wz U)a pNlЗ#G ֒o0ﰎ'΃dQ!]~>{ qӠevdٛJTϖuim&5Kirt*@gj˶&,yz_dc V2SHI\-lgŠS4ӰJr+RUNn-I׉ޕ08*gqa{-+*xk[aܭVv'%ϸO'qӵɅ;~u/7YIp'r J[>i%Gs}R"'C o!G9<س@W#AY)([v0L%lzlUq@'~2VV3ss6Ꮄ_pƉgs~;JTdұ p/8aVS_O?K!ힻvbJ 8!zG[?u-Hj=d[Ӟ;rz"<!z"Gߕ/ᄆ?4CYeԪƥ;~ӫٜu^ojckǤ-~fvk_*PW@Cp'c&IIFZI vԅVn}! L|1?4#?P I9#߁=8h/gxoo|*–}st]!~\iN'nUF[]RM6}eT'GAL>8KUsXgJ)Υ~ -ޞ|b?vKxHW,- m6TI#<Ag%1,,6M(8)W~z`Ph\;t"s̎ID\sb'?KnGFjOv/~VU&,P#O bde%Y tUU痎ǚ#f)&{1Ҫe 葌݀#䁭Kz 㜘.R8^]ZγNBB_NFs;B3/oa4>ud:ʂ>E`7@49a'wHUEl>ȗ3q+ƚCc+ȧ]_U/V t~ף:w;.Fs\} V߄irɒa;^ =хH͏ӹaړs(AuE0ù797"F?/AiL74;a-լ AxX!Sx.2*8biTi8OFm("Φ^Bݺrw&C }nKKyi2쓾*Y@`GSb1r@5y;'q!ԔV)cj cIb(S'`&/?.Dw&wTB{~~um/"y˅a9nWy'*j/d:eN?tS+D퍅\[,,וe%9]c7"P7$ǢɎnE ]~;J}5/e\{A8EruDhKǦjب1fp2_$iSdteHk`UE[  ˔w+Z,/v( 25a-9m2#r!~nyXrXʪ6Y_7g.s3X6[>bM%OqWd"PQl?Z{S^۽[ y XVX[1N&\i ?aM4g}YE!Լ#TSh`f2R̓ |ZhdDDsԸ)߰^sת Cpo}\i<.8@阞 ^ݹ=JwȰՆmT}0muoY֡Ϋuy E'Uz!#/}0Ȉ~B^~Q>t\Ijz2:etӳA`$x{˽?5\HmdM rMTEe8 >ZKaoGF[*9GJc3W^`FpfţFYק=\bpPzǃKV7ii` Hџ n 7M>)KWXR~jgYORLELaHѽin,6 ij.\_&FH^$+xԎaKO'R`t*rѷk}>mGik4:l@ v֖Oӌx ϚT_&5zW=W /]F /ؙ O}ȣE|$z Ԥ6#ZEQDZ.CxԈQ0a\\h{m [v%BZQ6P;|pmo. jEgTpbb"\(h"-{(x0-{fV%,gh~wJ`Y=t Ξ Z233tK ^VB:F@j_%3zGa[%RtC)>0P'i&Sɀᤇ'B2/riVRjPϱEǑ&F'[{E 'TϮhk'LY9@Bީldwb21WIrd O 'Q&YeSS1&:λgLl4?ֵNT6K+,vsl1Ԇ̓HTxC8‹`ό?$d'aaq."z^cS :&ja ;u4gCc_4L#:,U SBj>lY mg,>vcya_*J3Զ?D)Gl8 _$ @ \nke.Kp? ZJՒK5vehktll3+E?2! CY7ލ؍SI\zV .vlKǓaWɽ wݯ^ME&vvZ <`9\@Xor[0ә}kj4s˽5׭W1p1/?}QaRʳ2b*w"@鍤k?CgMŤ2Wz(Mp,NhOt;d.*qGBJb>W׆-L 5 endstream endobj 273 0 obj << /Length1 1480 /Length2 2451 /Length3 0 /Length 3397 /Filter /FlateDecode >> stream xڍT 8TϖJiBd ٗd Y31s3cfliT\FnD*JpPdIL RY"JB;{?9|*;02}!+&kHiip ̥C fLS9qLDZ^%p;&`0L5L`̙06EPx}}]ta b+R@:I!n/%T \ M&HU3ā% 8 h&F p9L7dCjAbn;` Bԁ-ddBa2X #~ C.+;Mn(Wl H0|0/09X: Jp†Y\&RΖAw3 r0Yln{vdfh0B͒X,&8NO @JΖw cAsNe g1Y %`~00 W*L`~TGmφC/=<}ۋʋDa?kifok63 -@&:" G Bc󽢛w ǯ0f!@8"oϥoI Ysn9p J6ߞPwh~d!*׆ c`FcBTGKƼuv0929hqй B- :;_`ʈ@$xtP蜂&)ʎИlXp4f;RD ,DEe  Z9 JP㹻B! I1_]>Y`!D%o,:EN}ѺnZ?-3H2s;CY>I\۫~P( .o+B~#%u!&OUת~kI6T.1?"M)Ѧc|uzzZRi7n>}vF٤i(eٚbσ"޿_ƲM{ot=>Bқ{%DGQ4:&NmT)qۖKovQZr*%dWWhX5wl|ĕ%[יTR<^:&~ u,TQ,]DLyo܍n\[r09\G8ro7 r.FNbG7C|o|H! $|ಙS2%(\z ccm+)4CO5+srooDd> 2EDi1@r='YI_R5r~1|V(w ^rxB/Q1(W%M홌q;MҶl?Ef(6Wj-:Ȫ:Yp瑣=VG1eC_< )1Vz^UUёG{elP\<1o6E[.Fsɵ1+iyⲪ;nV 'F }jfiy\tķ# U|:)iȒǎB⽝h }ol(Qvq6PK_?-~!K!.Y/D#"gLdv^x&w&Az`fYb6ƩoHr_ihDaDJ 21ҁvF.c.' Y/ѠЬ#hO̽Hbьжۃ:wTI1NvsbN;R2$}&7\akۥ/廂Dg:";Pd@]iXr+["lQE+2L?K~ΖC}gWߌJ +Zק7nD5oPr`Mڦ¦)цeմM;<*_!nbL)Vơ8]<^؁wGg>zA  endstream endobj 275 0 obj << /Length1 1975 /Length2 11557 /Length3 0 /Length 12772 /Filter /FlateDecode >> stream xڍPk.w^KAw+R()C-Ph9t3LfZ~{ -&9He`eH*ki ٹX9QiiP{?bTZ+"/I,B!7{WO.?.); Pp\Qi%\64xmc r[!e ht^⵰ $ tpeut~ Cm W;0@+*-@\ t`  b r<'h+T@6`+;3 CV`{@UF e! @w hlW@:Lz.`'++7Ea, ttpA,A= >+07 K7'6m $/ɳ𰳳sq@ Z^N89:IVTW;uq[` A`b]Cy,!^:_6%}] G'! aprqx9SOy#@Z?sY Rq|Y7bax\wۈdRKQ^<yMuA2PCF dZ5=RstS,KWv<=gX8Z/N^.SxF?f ,~`d#wv{>?.6?.eY_&6@ngd|x;3!?_N@O_g=;;\?`N7.d H]7\Ϲ@.7Lyw3u㙬#O-eڸ皡rx_OϽ_kߛ[[}L4w[Q& b}t oTuvTǻ/Y{WɫP2mi6 >E" 0KS Kk,LE0|:_0pW[<\*MSj'̉߫_"*t^W0w[ 7eY; elx I0=5ӭ08֤ޗw`?`s4Zf/}sMw]]Ldz<X+g0h>fws3;QhׅH[$J3?ˢ]Ad-k.^HjOLZHPzH5tM1/#&ME(a){mP`4#Uٷ40ӳn=gumhRWgZ1y2;#[_K #T>~h=+7q1A^Vur}y80AP~Wވ?Ed..[dDHcTQ̡Nʝo5]uJ^;z#֌B2^w2-=tk33w!kg5Z,6Ms]Ȃ 5-g=IoM '袹ϸy8pDz$)?)\&y&ńT^ZdqZa W?~+kPӾ?&4L($չZ#ޯa7 Ş[ˠNtQ* u'"ei^؂QqTӿ>>F&0*j4ޥ+V"zO^:}'-6K~W)5l n"%(mi}Tf?JpWP4[:;)7%cQ =*^m;GKW0b/p `=P)MXgZSQ^$,68bXwFxbb 1*u*wؑ\KaRIo#"Q,hѫV*$E>{#~K<&ę1G> *vH{ >u*`ڶ_,SpYS uիϰVK1"u/S5Dl)6KtWwErZEScU+  Q䩣)jp`ac=:̤c{OT2WR}ȨWDy cʄk%s"M'ݣ/bn9nܓhbtR|a)̠n?7ֽ߬8.,8$n;yėRFBa53YXayY*cm/VÓ-:" 2'k `Pdc;S&g>!2|}аLiٿa6(ps1,=.bƵ2yAGgqCYtXRY$l=e0Q^AiM$k(g,"sreTU( c)Q^RC"b{t/A訦e Ǿ|icl5>Q^j rqS'ث}/sžS=mSѦ CiC=l-_e)v ?n`&ݿDhq߷ɣS VP_dߘ ˠ̧, | Mtn#C$z8ow=S49=\O# Ht2I~HАETs%t8Eĉ]KנPrw QȐԧsi@~`N(} ި̚[m;l_[<97X!ㄢĘ|-*zɀ)\R:$vvS둏nP>GU!h]eboO8 oOw*P.EoנՋQQЁjg@.gR#ҏt3gF~9xl'؟/r2XG#rK0jo8旹Jʻji[EV_MpG5}ihakz>! oݡlTcN!c5[50|ՏrqMplcV!%q)Rؤ:!kF ܋^xPX `2zR@/pQNh**N}L^۾GQ}Kʁ2:4ܯx'֘jmU0KңQSn`/v1Onϔ(Y/±F؟owhOUlE614B|n"Yt&gNpMRȳ,U'COPb*Wcan. ͭ6׾'I[9̻zljЕ~.2kzd +'~ -77a\l$YȭDAڰ! {Аd_w4iZCH.^;ھx;Y޴o9L1k ,5sRRMR==J"liC]W݊'؃WUf 2!#__"B*[[KM_Z/ɒ*9@{MaK͸?ys!srMQla_qeG1st:i3&6GvS_GP\y:NnH3\ho;#qrv]ǁ,ˆARYtOIXt=NNxp~n1of{pLؤ7X0 q >ez}\!@l*9-z8L߉a⨢ 7aBZvZ$BDt9H9]33I#ڬ(ZB N/JَC U=^,oGzth =?-]IԬ~Gl1u8-?ǿ3>_(qàYLU LBt3X>OaH~BRtFz6[>kT;}pcZNYk|Ȥ ЯU:*yKUMS0͢JͦP#rmS޸Tw H94/U$6i,nh#h(z_pFMJ~y$ jm%Ɔbxfb$ R;8FK3Ѽ0zL|&#,:鈧 k(#C6 ^/]~g7-ʓIXL,e7-K2(HVp떈tp7ҫhIX0gOU۹hrew AƞEIJCR@ xFC_]9Jbqp%N7Msșm/8̤.''DZAƴVӢ{%3Fvsյō5W4*j&aMןr`$ :}1c-qLAH&T F7'l&J QuQd^$"cU>3Q5$;8S.'и៉,m2kaEQ/"dєP"dDM0qIIx[vfۓz)[" ,?apb۞{QM 9[SO1Afv Q Խs0/f!#iI(~H>yc'tHd9"tgȻvs8eDsZ)8/"lLǡHNݏS>9{S& C(}s-,vI:&Zb'=$N SUV~ܰlN@0Td`KǹîhBNkP#`p-#xI(g f)W8tQL-ƺ~?M4Pt^" aȈga]^6]z2{KAQ7*o0b,LD>lcL4OBՅtJ@gcuVG#M:+/k6.E(>Y2EF)E@R-~٦B0TowVMTI*owK+"#7}ENqYqkRmqCpB!R‹־z[^ȕyO;dv[\V1-Nδqol$@2K4>j筵)W-3J ' WRk^]jڄf ^ż^xJ^*^)QXbis3u;[j$cO3w;O*Փ{˂JR!E6>3 2J=Q^{Fb-sû4O 1y<{TG64ݲ*Sv1#n#p _` |'Gϝm}YlR,ZWiAfRSxK}Viة%\GFd+5ӂ|;MfݽXTt KMp-eoİBzuiIeNmT6ʃ^WK0eÇ]dtwk$9QcwpJW1M~uTw gS2d.Xf N\ uvDzxP=&anR^AGɏÑ勉nَ |Qìc\u?tQ1MuA MƖIK01uR6g}+nU&ܗaW$7 }X(w8ʺ%&yA"(WZbψKMe+fjHF?z.rbK%XwÂM6w<6,T\kO(CLp6X&HV3yL(]*hnʨZZ (O~R?FLMu-/-~qL8(&{zE!F^)9b2y_8!tEV~\"܂Pj8m|C2d%هFOhZE/3v_g nޅ W6 a%tdgav֯ 0T9@y!kZ[39]֕'CStJ=N&&8IYrGwG=H;tfDMk9̰5DR~ kEl&znb%k[)灥f9bnp ;UqMBqWG,vٰbH3‰Id?ǮpHŴzD-9e(!b푲I@6B0O6$u2 Pw7#A74b)77=ŬC9 ]:/13W%þGpI-{){v|=2¨3SWDՖx<¨-Wv0|>}?R}{I;&PPPם"x R뮛_d/=neN[v>SoEdҹo&+`u&헆W ݕD{EY18;Wƣ(Z=[bkl#nmNkV6=b:˽E0CZe1O@ xd>_d D_:E` :C6G'Y:B^>n/>VP߿ o{:MȳcO<GQg"yn{Cv} |dw$#rzGK|psAGcv R.tk!+!& eHIS2Ktc.czOrs4{qiBlm-!"!11c8C<~"1ΐ$I-kĊQY83پ@2ȃ}ocruVt ؼ;qii\?ZϓG aEx.U*ӸE2>/ЂOU"l0g~C{6bASkz48Fd[b0imt|C0r,~H.bz+Rе<,j}1Kg+Lה!o% )'3l=/Å!Md8[]mInBBKN!֌^\vd H7ȕXRvOE1!W@1qI1g1&[=X۹ ^wՁ!.[ Ҍ ND7x?<(Qmu;[/_wD1z̋*ڑiOɧ F@>N$4d/w?C R /jnI'N!aRmc3'c%ʈO^+5^Cӥpp$f r?P+õ/Q@̯ìg@[3óAT`l8/CnwU9!fd/AB-ގ␉.q_+ A4f;"/֜6ek`~5D}; DWVKb7WQwBP%~E`;z6 ~-Fц55au;OopoV}<(x &ec"Sm699({_"L}GNہI{MާV6EFca)H(0] `8v]W|[y(Hf^"_Lo@P>MB5T(e[%׏xT_7.=pTM5ئ3 N#蛅%V[cSv( OA_$mĄGܳ!Fca0OP~QRP j3|Ŏmuy{L]s eyfKFLբc5#rW~&C|6%IY35&Rpâ EWy/v ;9y C8C#fe\~LVL[T^ b$Ķ4'&!GBt yx2J &5KmLJXZsgVU[DMf<}/o%S)m86lc{PE2xz:Rqh(Zvmv+ AGr2r!l5'N1,u7[37X/=ULɠ)|"%A2'9C`_,dĞŁ{q*v?uR Mse7-HU#9KDؗ3rG V]U!KuSWp:+M|!ce!wBUoGFQ*(ʍ2_3oAT];A86Ä W٬8HgAވxOUㅋXΑxuZ SQUƋ!0l:NCJT, RV;\uZP>vNv\]YyttиO&95R"_eK)Z YCe0c6x)lޒ|C @O| MܔN/B8CPk*9 X0yZeعLzhJFs>ִ̻WVf" #7mA: 8ie82'MŖ`NZ\Q!JMHUZ8pR]X h}(d?.EgOjU{O`).N⣙OMr˿YQܑRhB\v#FPh,ˏ OkbE$F .ЀRb/b Y]vY*լ^T5+C\9F]JDxQAMH*_wJE .ɤ(kuւc"20?E~HOܑ> ژYW-+RAd'{~nՐ X _vԧ-.?E!KOʊH%c%f'A *0-4/$\ ~j2f1ͤ"%̙!}RՖ: "-R/pn-?Oj㶳kגx*vOg7wMI!L'Q,wimOFuw*R2hr"mKmE8HD7?/5qU䃩@}w5Ӌ($`z:@xHUHhu=HPg6({M2!WH΅IՇRj<~n42ex *}>f WwRȀ}zҕ'tnܨ_ >~Zz} tpr캞#åK"> [iO3=GS Usx;A[;ϴh( ?SJ7H?9{_΀Y1/̅#si{:0Kij]EɁDRJ+ؼ\*4 nRnYIT&f ӸѢױ[֎40Yt$ݖ/oa V|7eQOd=ՀBoiMx1Xj˯ug.S271SG 3fS,eE?f?S/cNXQvp G\D7J$ ~%sd*UNx&L6Xg5FoέiR@'lEDLf]?RUТ"uѵ$TZZ%-~٣:$2gB r*5. 88k [;ҡNAQRYG}i7"GjV3ʰ#J"gGEc3H! /L>aC endstream endobj 277 0 obj << /Length1 1306 /Length2 1345 /Length3 0 /Length 2180 /Filter /FlateDecode >> stream xڍS 8Tޱ]EOQ-O2AR*Yk̬1&Q;]RNH؅JEI]ӖP.]8g h9Y]O1l ōidpqQ St' OvX"E0+pfJ gfjA[eA:j I,8c(,%bb p |8DB(pp,"^BBqWL a`%q"ɐHJ$ֆF@$e`-$'K#N8<0>.$0 B R"Cy'WN ` liMt qH  |DulW2)P|(B?OlzN'J1.%KF2 f{gD0KI %L7hاAy|e<"2nCH_l0T܌`r 1<)D abL Dp8‡?R .a_;H4!\J0;1  6S U|B(B)[re)o3b˄qo~H{| ' !2ѷ^'"v?P\L0\{kBgH"$*:10O<8t\BF1 |LBR)4$b;'G>0 sIM1eL`~LK,qG D/a@QVCSOY7;9Vq5hi JۍvZ=F*w\ɏ+ܕi0o(/Ź.ީ-/!k$%i14TbJY饹6y2eҾ55o_ݹOgxvhҖݭ)vH>Tů4,g5Pi/Xgn5 7D7Պ:3ya AM5o|I_Ԑ'{wζbAOliEiGs 2_fj4rgz9Gf[Wk3}/J9h~?Uk|4R[ٜNTش@__vdݼcp"=Oy\ظ+t38cZs2.-ӱ('5u]팴^Hb+M:wUz.& [G6Z̸9!k&lĕԭR?:I=tm/#Xa RG"2dtOW'=nU$ǃ/:^-2YeINVyé<-GDUn+˝qcxitz8gdYBR%GMܸ}ŗʧns7xfkP*3SLP~PoT$\1 w7Wu}}flYSW-*Nyi/ }xzGxVQ³:3 yFœ9.^o2js> stream x\YsG~ݘ0뮊pLH]Lh]=@$$aЖo~FuM2a<*jCE]5OGDO_%PkD_9S)TzkB/͉vThDAU6**Ce2IUlP4QM6RESŅMfX*v7NSUtD%R%al" 8KUyKHi+uA@)[0UQUTJMHdTЛ}$崢J9ZW)5&0$DRW 'iC384mV7:D- hC {"EfXC54Cلpخv4> 48F^ӻ4Ç@ux t"Q!hT3x n@ kDPc[4тd%@I48$, 4f름] hg L!j @ab?*pŽ{`2 >ĆD"2$*x$L(b`{ :I :%Il. h1tڌs2tN]RjCsѻ$xԞRF<]6:DO^7IzsG>l0&jWvǷv2c-rDϥZbZCфD!QW+.;GD !DEf'~ F2X:b\0nISb1ahMivp Pf6ː>Љ!bFF]*hQ$ցd5lt Hcl7| BA@JZ$Śe?6v RrgAY-cɲB#Ae`HFaQyRA5|$%]44)'P,T肻n4bՖ,2P%]1XVy ;1P;I’:%cX[-{)=7$b2r@fRF0ؤ@ &E=' ͜$ϜX 8"\zY#&۰V5gΉh{ ) (>mwؒdjaIɢi=CIA;Ok?:Z6\O,J@rI%ޣeIħ!$i;HK[(py֭7ee:`;Z,/c*,qx Ve vM`ug&~CmwoY Tbs=(B YH~eCvO$,fx!_q S}͘؟n\k;jOyOY9U"rRQI^1&cD,GglX5a |I T it{vHz(y7@2>ꎻDye٥EdH~Tñ%μu&66ЎPyD bC ~rRK< G5U+By& Q$h &G%9Ђo}*OxhFچwV~q8Ӽ=v(J,|z ]XHWuLr/*1ce)8BB,,=q(u'bvH,e)2ֳhNM,պK4""(|1qb%d>pȤ8Oa~du-jֈ,aG,9>KM8{֑IE =܍s'9q8TLZF9S:Nw!ÒDADRʂf5cXAZ8%VZlt)e.H˺B<ǣ\>e7)32RZtvlD}i19:tya=,c8zoXW˘2Qq ir+Ng%\c!/9X;Txx<:bA L-^AH\8ݪHfC`l5.&^ZVf\՚˔ִYԚwp]'*&!05%{0XN(nIH܋ٕRټ#њV 4Y) qpgn2..xOa:UeeY eUzaH[p_mG-sP9Uт9jA1Oī"#m<7.O&x^h[qk NQ qkzF,ӵha8j' )z2]N5f,\u)e < }b<"JqFhnc/6 @uc,_I)+ evN,JU X8;DҐ,^ƙ(, 8˜N$32eJ-Sl%]K8I x|k2۶rZs¡,9]x=Ze1sg2=xIʠ7.Z>-P6ɡNNb5,ܒ侹`Ͳ2DrtHkݧ,&}RZ A1΀ȜlMB^/֑yB|"8.U4y^$jC$Z8k6*eܱr[|;Ϭj{sK߬B KO[WI*]zV\zL`ö. ˄dV`YtijGʀlk!v|0ܯ|Q[0YyeD)_޷9ls Dl-O(\35;dHn̼|c۵1 6o_wk7,#X4e?6|v-I/dRq-(ߑ r)- 2rE'wNdh=?豒/r^gzj<4bii|w EV|UuWx:}h`l:edI% FL$"Є)q@]"6AzWr󲄄Еz%̀x] iT_:ׯؤMyӃGͣw6 _[W]/ѱMMS:6 u4kr:֓tt6W#rƟ&_e6<>NfWgW5NNFg5>?'qmFvg&{ۧDA7ea֔[aů$/Y_Q]}Ł8$q,HY|GsКu5iMФh4x>uif6ٳ7*񟴍[+&ٟxˮmd<9888b  ۏ wYz";b";¨;nd2Tj>nRirr$VӷET*#V,"19~G@ څz1C:#3W^w1Ȋ;Û߀[rͭ!x~΀`WZt0Nڶ &¼*n|XU8 C ?H=:tNagu&ݠlxkJmq* ph6A>d[p#vv [u|ǃtf ZpJuזpZcradeg'8T׸u^%9aӥp\"x6[߱8T:i5p}Ar:,ld%=xp`*G)u0!FӇb.[K/6`ћcd0+B'A5W~Sw&_Fϟ6oKqzH+%25ųv8`R}s: :gw:]"l<=zp%E'@7l.:i'G/1:C GYƯvЉ?æ`ryr1ό_|t2B]d7R,{O>͹7o L8d.^iǿ51,V^x[2H$+aQ[ u篛<ϰ y;:dg3TPjx3߄.ز7ѳr?K*~ƢI&m7z}@}*.F#7rكo>|$I[|]7u"[PׇnWh:o i >|*mwYՇ7=nw=ԃn;B{W }+RR*z/W߇"u.v^ஷ8_:k N\B溩>%]!qq EC`MӸ-wS}#S[ջi>\\-,J3W`'W.!}'z}6tT^[(~jݛ¶^5[\/oJoaYYЬѪ-Pg">K>"׋7W5]T[~`ý їbk;>EЦC?7MNKx/Jk%m *9UiTM~[JJIAO'Ox&y;aA?~e:?}~vP- endstream endobj 282 0 obj << /Producer (pdfTeX-1.40.20) /Creator (TeX) /CreationDate (D:20210928123811+02'00') /ModDate (D:20210928123811+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.20 (TeX Live 2019/Debian) kpathsea version 6.3.1) >> endobj 280 0 obj << /Type /ObjStm /N 2 /First 13 /Length 116 /Filter /FlateDecode >> stream x32T0P00T03粱,HUHLO-w/+Q02L)V62*RQF,egdsbIbN~:,#EA\婉eyE)yɩ `@k# endstream endobj 283 0 obj << /Type /XRef /Index [0 284] /Size 284 /W [1 3 1] /Root 281 0 R /Info 282 0 R /ID [<48CD5A09ED13D3A7EA8022794D4C25B3> <48CD5A09ED13D3A7EA8022794D4C25B3>] /Length 786 /Filter /FlateDecode >> stream x%KlLQͥ{fzj-TڪQTФ+)K;,$BhDve!l`! bE"/=ν1Ƙ0ƚ1od+M""}d EM$lV08ia'IElD@$LYXcEA=uVEjb,%%_i:]<"eVTJOc]~_-kI5֐U&kx8 Qyq6$^ca'H#iB8gX+iAZ ׆e̤k'S6::i`vud<5&uFW2ԎrFsUjU{'lcL p{7hw}C|4?k< #Z釽z^z%alT1o9 F# gTgpM#0iLg}Hx*|;EQg} z&3 3 Ig&=3IL尓oؗ!YM $[*Grp $+CV"*vFj佪}U %j2_jDwUAԜVљ Uuey=Dt :8}ujFUmT7FUܓFUHdW[NjEG>Űǚ2 G endstream endobj startxref 1337390 %%EOF fitdistrplus/inst/doc/FAQ.R0000644000176200001440000005360014124570201015262 0ustar liggesusers## ----setup, echo=FALSE, message=FALSE, warning=FALSE-------------------------- require(fitdistrplus) set.seed(1234) options(digits = 3) ## ---- eval=FALSE-------------------------------------------------------------- # dgumbel <- function(x, a, b) 1/b*exp((a-x)/b)*exp(-exp((a-x)/b)) # pgumbel <- function(q, a, b) exp(-exp((a-q)/b)) # qgumbel <- function(p, a, b) a-b*log(-log(p)) # data(groundbeef) # fitgumbel <- fitdist(groundbeef$serving, "gumbel", start=list(a=10, b=10)) ## ---- eval=FALSE-------------------------------------------------------------- # dzmgeom <- function(x, p1, p2) p1 * (x == 0) + (1-p1)*dgeom(x-1, p2) # pzmgeom <- function(q, p1, p2) p1 * (q >= 0) + (1-p1)*pgeom(q-1, p2) # rzmgeom <- function(n, p1, p2) # { # u <- rbinom(n, 1, 1-p1) #prob to get zero is p1 # u[u != 0] <- rgeom(sum(u != 0), p2)+1 # u # } # x2 <- rzmgeom(1000, 1/2, 1/10) # fitdist(x2, "zmgeom", start=list(p1=1/2, p2=1/2)) ## ---- message=FALSE----------------------------------------------------------- data("endosulfan") library("actuar") fendo.B <- fitdist(endosulfan$ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) summary(fendo.B) ## ---- fig.height=3, fig.width=6----------------------------------------------- x3 <- rlnorm(1000) f1 <- fitdist(x3, "lnorm", method="mle") f2 <- fitdist(x3, "lnorm", method="mme") par(mfrow=1:2) cdfcomp(list(f1, f2), do.points=FALSE, xlogscale = TRUE, main = "CDF plot") denscomp(list(f1, f2), demp=TRUE, main = "Density plot") ## ----------------------------------------------------------------------------- c("E(X) by MME"=as.numeric(exp(f2$estimate["meanlog"]+f2$estimate["sdlog"]^2/2)), "E(X) by MLE"=as.numeric(exp(f1$estimate["meanlog"]+f1$estimate["sdlog"]^2/2)), "empirical"=mean(x3)) c("Var(X) by MME"=as.numeric(exp(2*f2$estimate["meanlog"]+f2$estimate["sdlog"]^2)*(exp(f2$estimate["sdlog"]^2)-1)), "Var(X) by MLE"=as.numeric(exp(2*f1$estimate["meanlog"]+f1$estimate["sdlog"]^2)*(exp(f1$estimate["sdlog"]^2)-1)), "empirical"=var(x3)) ## ----------------------------------------------------------------------------- set.seed(1234) x <- rnorm(100, mean = 1, sd = 0.5) (try(fitdist(x, "exp"))) ## ----------------------------------------------------------------------------- fitdist(x[x >= 0], "exp") fitdist(x - min(x), "exp") ## ----------------------------------------------------------------------------- set.seed(1234) x <- rnorm(100, mean = 0.5, sd = 0.25) (try(fitdist(x, "beta"))) ## ----------------------------------------------------------------------------- fitdist(x[x > 0 & x < 1], "beta") fitdist((x - min(x)*1.01) / (max(x) * 1.01 - min(x) * 1.01), "beta") ## ---- message=FALSE, fig.height=4, fig.width=8-------------------------------- dtexp <- function(x, rate, low, upp) { PU <- pexp(upp, rate=rate) PL <- pexp(low, rate=rate) dexp(x, rate) / (PU-PL) * (x >= low) * (x <= upp) } ptexp <- function(q, rate, low, upp) { PU <- pexp(upp, rate=rate) PL <- pexp(low, rate=rate) (pexp(q, rate)-PL) / (PU-PL) * (q >= low) * (q <= upp) + 1 * (q > upp) } n <- 200 x <- rexp(n); x <- x[x > .5 & x < 3] f1 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x))) f2 <- fitdist(x, "texp", method="mle", start=list(rate=3), fix.arg=list(low=.5, upp=3)) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, xlim=c(0, 3.5)) ## ---- message=FALSE, fig.height=4, fig.width=8-------------------------------- dtiexp <- function(x, rate, low, upp) { PU <- pexp(upp, rate=rate, lower.tail = FALSE) PL <- pexp(low, rate=rate) dexp(x, rate) * (x >= low) * (x <= upp) + PL * (x == low) + PU * (x == upp) } ptiexp <- function(q, rate, low, upp) pexp(q, rate) * (q >= low) * (q <= upp) + 1 * (q > upp) n <- 100; x <- pmax(pmin(rexp(n), 3), .5) # the loglikelihood has a discontinous point at the solution par(mar=c(4,4,2,1), mfrow=1:2) llcurve(x, "tiexp", plot.arg="low", fix.arg = list(rate=2, upp=5), min.arg=0, max.arg=.5, lseq=200) llcurve(x, "tiexp", plot.arg="upp", fix.arg = list(rate=2, low=0), min.arg=3, max.arg=4, lseq=200) ## ---- fig.height=4, fig.width=6----------------------------------------------- (f1 <- fitdist(x, "tiexp", method="mle", start=list(rate=3, low=0, upp=20))) (f2 <- fitdist(x, "tiexp", method="mle", start=list(rate=3), fix.arg=list(low=min(x), upp=max(x)))) gofstat(list(f1, f2)) cdfcomp(list(f1, f2), do.points = FALSE, addlegend=FALSE, xlim=c(0, 3.5)) curve(ptiexp(x, 1, .5, 3), add=TRUE, col="blue", lty=3) legend("bottomright", lty=1:3, col=c("red", "green", "blue", "black"), leg=c("full MLE", "MLE fixed arg", "true CDF", "emp. CDF")) ## ---- fig.height=4, fig.width=6----------------------------------------------- trueval <- c("min"=3, "max"=5) x <- runif(n=500, trueval[1], trueval[2]) f1 <- fitdist(x, "unif") delta <- .01 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(min(x)-2*delta, max(x)-delta), max.arg=c(min(x)+delta, max(x)+2*delta), main="likelihood surface for uniform", loglik=FALSE) abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) delta <- .2 llsurface(x, "unif", plot.arg = c("min", "max"), min.arg=c(3-2*delta, 5-delta), max.arg=c(3+delta, 5+2*delta), main="log-likelihood surface for uniform") abline(v=min(x), h=max(x), col="grey", lty=2) points(f1$estimate[1], f1$estimate[2], pch="x", col="red") points(trueval[1], trueval[2], pch="+", col="blue") legend("bottomright", pch=c("+","x"), col=c("blue","red"), c("true", "fitted")) ## ----------------------------------------------------------------------------- dunif2 <- function(x, min, max) dunif(x, min, max) punif2 <- function(q, min, max) punif(q, min, max) f2 <- fitdist(x, "unif2", start=list(min=0, max=10), lower=c(-Inf, max(x)), upper=c(min(x), Inf)) print(c(logLik(f1), logLik(f2)), digits=7) print(cbind(coef(f1), coef(f2)), digits=7) ## ----------------------------------------------------------------------------- x <- rbeta(1000, 3, 3) dbeta2 <- function(x, shape, ...) dbeta(x, shape, shape, ...) pbeta2 <- function(q, shape, ...) pbeta(q, shape, shape, ...) fitdist(x, "beta2", start=list(shape=1/2)) ## ----------------------------------------------------------------------------- x <- rbeta(1000, .3, .3) fitdist(x, "beta2", start=list(shape=1/2), optim.method="L-BFGS-B", lower=1e-2) ## ---- message=FALSE, fig.height=4, fig.width=6-------------------------------- require(mc2d) x2 <- rpert(n=2e2, min=0, mode=1, max=2, shape=3/4) eps <- sqrt(.Machine$double.eps) f1 <- fitdist(x2, "pert", start=list(min=-1, mode=0, max=10, shape=1), lower=c(-Inf, -Inf, -Inf, 0), upper=c(Inf, Inf, Inf, Inf)) f2 <- fitdist(x2, "pert", start=list(mode=1, shape=1), fix.arg=list(min=min(x2)-eps, max=max(x2)+eps), lower=c(min(x2), 0), upper=c(max(x2), Inf)) gofstat(list(f1,f2)) cdfcomp(list(f1,f2)) print(cbind(coef(f1), c(f2$fix.arg["min"], coef(f2)["mode"], f2$fix.arg["max"], coef(f2)["shape"])), digits=7) ## ---- fig.height=3, fig.width=6----------------------------------------------- set.seed(1234) x <- rgamma(n = 100, shape = 2, scale = 1) # fit of the good distribution fgamma <- fitdist(x, "gamma") # fit of a bad distribution fexp <- fitdist(x, "exp") g <- gofstat(list(fgamma, fexp), fitnames = c("gamma", "exp")) denscomp(list(fgamma, fexp), legendtext = c("gamma", "exp")) # results of the tests ## chi square test (with corresponding table with theoretical and observed counts) g$chisqpvalue g$chisqtable ## Anderson-Darling test g$adtest ## Cramer von Mises test g$cvmtest ## Kolmogorov-Smirnov test g$kstest ## ---- fig.height=3, fig.width=6----------------------------------------------- set.seed(1234) x1 <- rpois(n = 100, lambda = 100) f1 <- fitdist(x1, "norm") g1 <- gofstat(f1) g1$kstest x2 <- rpois(n = 10000, lambda = 100) f2 <- fitdist(x2, "norm") g2 <- gofstat(f2) g2$kstest par(mfrow=1:2) denscomp(f1, demp = TRUE, addlegend = FALSE, main = "small sample") denscomp(f2, demp = TRUE, addlegend = FALSE, main = "big sample") ## ---- fig.height=3, fig.width=6----------------------------------------------- set.seed(1234) x3 <- rpois(n = 500, lambda = 1) f3 <- fitdist(x3, "norm") g3 <- gofstat(f3) g3$kstest x4 <- rpois(n = 50, lambda = 1) f4 <- fitdist(x4, "norm") g4 <- gofstat(f4) g4$kstest par(mfrow=1:2) denscomp(f3, addlegend = FALSE, main = "big sample") denscomp(f4, addlegend = FALSE, main = "small sample") ## ----------------------------------------------------------------------------- g3$chisqtable g3$chisqpvalue g4$chisqtable g4$chisqpvalue ## ----------------------------------------------------------------------------- set.seed(1234) g <- rgamma(100, shape = 2, rate = 1) (f <- fitdist(g, "gamma")) (f0 <- fitdist(g, "exp")) L <- logLik(f) k <- length(f$estimate) # number of parameters of the complete distribution L0 <- logLik(f0) k0 <- length(f0$estimate) # number of parameters of the simplified distribution (stat <- 2*L - 2*L0) (critical_value <- qchisq(0.95, df = k - k0)) (rejected <- stat > critical_value) ## ----------------------------------------------------------------------------- dshiftlnorm <- function(x, mean, sigma, shift, log = FALSE) dlnorm(x+shift, mean, sigma, log=log) pshiftlnorm <- function(q, mean, sigma, shift, log.p = FALSE) plnorm(q+shift, mean, sigma, log.p=log.p) qshiftlnorm <- function(p, mean, sigma, shift, log.p = FALSE) qlnorm(p, mean, sigma, log.p=log.p)-shift dshiftlnorm_no <- function(x, mean, sigma, shift) dshiftlnorm(x, mean, sigma, shift) pshiftlnorm_no <- function(q, mean, sigma, shift) pshiftlnorm(q, mean, sigma, shift) ## ----------------------------------------------------------------------------- data(dataFAQlog1) y <- dataFAQlog1 D <- 1-min(y) f0 <- fitdist(y+D, "lnorm") start <- list(mean=as.numeric(f0$estimate["meanlog"]), sigma=as.numeric(f0$estimate["sdlog"]), shift=D) # works with BFGS, but not Nelder-Mead f <- fitdist(y, "shiftlnorm", start=start, optim.method="BFGS") summary(f) ## ---- error=FALSE------------------------------------------------------------- f2 <- try(fitdist(y, "shiftlnorm_no", start=start, optim.method="BFGS")) print(attr(f2, "condition")) ## ----------------------------------------------------------------------------- sum(log(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) log(prod(dshiftlnorm_no(y, 0.16383978, 0.01679231, 1.17586600 ))) sum(dshiftlnorm(y, 0.16383978, 0.01679231, 1.17586600, TRUE )) ## ---- eval=FALSE, echo=TRUE--------------------------------------------------- # double dlnorm(double x, double meanlog, double sdlog, int give_log) # { # double y; # # #ifdef IEEE_754 # if (ISNAN(x) || ISNAN(meanlog) || ISNAN(sdlog)) # return x + meanlog + sdlog; # #endif # if(sdlog <= 0) { # if(sdlog < 0) ML_ERR_return_NAN; # // sdlog == 0 : # return (log(x) == meanlog) ? ML_POSINF : R_D__0; # } # if(x <= 0) return R_D__0; # # y = (log(x) - meanlog) / sdlog; # return (give_log ? # -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) : # M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)); # /* M_1_SQRT_2PI = 1 / sqrt(2 * pi) */ # # } ## ---- eval=FALSE, echo=TRUE--------------------------------------------------- # -(M_LN_SQRT_2PI + 0.5 * y * y + log(x * sdlog)) ## ---- eval=FALSE, echo=TRUE--------------------------------------------------- # M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * sdlog)) ## ----------------------------------------------------------------------------- f2 <- fitdist(y, "shiftlnorm", start=start, lower=c(-Inf, 0, -min(y)), optim.method="Nelder-Mead") summary(f2) print(cbind(BFGS=f$estimate, NelderMead=f2$estimate)) ## ----------------------------------------------------------------------------- data(dataFAQscale1) head(dataFAQscale1) summary(dataFAQscale1) ## ----------------------------------------------------------------------------- for(i in 6:0) cat(10^i, try(mledist(dataFAQscale1*10^i, "cauchy")$estimate), "\n") ## ----------------------------------------------------------------------------- data(dataFAQscale2) head(dataFAQscale2) summary(dataFAQscale2) ## ----------------------------------------------------------------------------- for(i in 0:5) cat(10^(-2*i), try(mledist(dataFAQscale2*10^(-2*i), "cauchy")$estimate), "\n") ## ----scalenormal, echo=TRUE, warning=FALSE------------------------------------ set.seed(1234) x <- rnorm(1000, 1, 2) fitdist(x, "norm", lower=c(-Inf, 0)) ## ----shapeburr, echo=TRUE, warning=FALSE-------------------------------------- x <- rburr(1000, 1, 2, 3) fitdist(x, "burr", lower=c(0, 0, 0), start=list(shape1 = 1, shape2 = 1, rate = 1)) ## ----probgeom, echo=TRUE, warning=FALSE--------------------------------------- x <- rgeom(1000, 1/4) fitdist(x, "geom", lower=0, upper=1) ## ----shiftexp, echo=TRUE, warning=FALSE--------------------------------------- dsexp <- function(x, rate, shift) dexp(x-shift, rate=rate) psexp <- function(x, rate, shift) pexp(x-shift, rate=rate) rsexp <- function(n, rate, shift) rexp(n, rate=rate)+shift x <- rsexp(1000, 1/4, 1) fitdist(x, "sexp", start=list(rate=1, shift=0), lower= c(0, -min(x))) ## ---- message=FALSE----------------------------------------------------------- library(GeneralizedHyperbolic) myoptim <- function(fn, par, ui, ci, ...) { res <- constrOptim(f=fn, theta=par, method="Nelder-Mead", ui=ui, ci=ci, ...) c(res, convergence=res$convergence, value=res$objective, par=res$minimum, hessian=res$hessian) } x <- rnig(1000, 3, 1/2, 1/2, 1/4) ui <- rbind(c(0,1,0,0), c(0,0,1,0), c(0,0,1,-1), c(0,0,1,1)) ci <- c(0,0,0,0) fitdist(x, "nig", custom.optim=myoptim, ui=ui, ci=ci, start=list(mu = 0, delta = 1, alpha = 1, beta = 0)) ## ---- fig.height=3, fig.width=6----------------------------------------------- pgeom(0:3, prob=1/2) qgeom(c(0.3, 0.6, 0.9), prob=1/2) par(mar=c(4,4,2,1), mfrow=1:2) curve(pgeom(x, prob=1/2), 0, 10, n=301, main="c.d.f.") curve(qgeom(x, prob=1/2), 0, 1, n=301, main="q.f.") ## ----------------------------------------------------------------------------- x <- c(0, 0, 0, 0, 1, 1, 3, 2, 1, 0, 0) median(x[-1]) #sample size 10 median(x) #sample size 11 ## ---- fig.height=4, fig.width=6----------------------------------------------- x <- rgeom(100, 1/3) L2 <- function(p) (qgeom(1/2, p) - median(x))^2 L2(1/3) #theoretical value curve(L2(x), 0.10, 0.95, xlab=expression(p), ylab=expression(L2(p)), main="squared differences", n=301) ## ----------------------------------------------------------------------------- fitdist(x, "geom", method="qme", probs=1/2, start=list(prob=1/2), control=list(trace=1, REPORT=1)) fitdist(x, "geom", method="qme", probs=1/2, start=list(prob=1/20), control=list(trace=1, REPORT=1)) ## ----------------------------------------------------------------------------- fitdist(x, "geom", method="qme", probs=1/2, optim.method="SANN", start=list(prob=1/20)) fitdist(x, "geom", method="qme", probs=1/2, optim.method="SANN", start=list(prob=1/2)) ## ---- fig.height=4, fig.width=6----------------------------------------------- par(mar=c(4,4,2,1)) x <- rpois(100, lambda=7.5) L2 <- function(lam) (qpois(1/2, lambda = lam) - median(x))^2 curve(L2(x), 6, 9, xlab=expression(lambda), ylab=expression(L2(lambda)), main="squared differences", n=201) ## ----------------------------------------------------------------------------- fitdist(x, "pois", method="qme", probs=1/2, start=list(lambda=2)) fitdist(x, "pois", method="qme", probs=1/2, optim.method="SANN", start=list(lambda=2)) ## ---- fig.height=4, fig.width=4, warning = FALSE------------------------------ set.seed(1234) n <- rnorm(30, mean = 10, sd = 2) fn <- fitdist(n, "norm") bn <- bootdist(fn) bn$CI fn$estimate + cbind("estimate"= 0, "2.5%"= -1.96*fn$sd, "97.5%"= 1.96*fn$sd) llplot(fn, back.col = FALSE) ## ---- fig.height=4, fig.width=4, warning = FALSE------------------------------ set.seed(1234) g <- rgamma(30, shape = 0.1, rate = 10) fg <- fitdist(g, "gamma") bg <- bootdist(fg) bg$CI fg$estimate + cbind("estimate"= 0, "2.5%"= -1.96*fg$sd, "97.5%"= 1.96*fg$sd) llplot(fg, back.col = FALSE) ## ---- fig.height=3, fig.width=4, warning = FALSE------------------------------ data(salinity) log10LC50 <-log10(salinity) fit <- fitdistcens(log10LC50, "norm") # Bootstrap bootsample <- bootdistcens(fit, niter = 101) #### We used only 101 iterations in that example to limit the calculation time but #### in practice you should take at least 1001 bootstrap iterations # Calculation of the quantile of interest (here the 5 percent hazard concentration) (HC5 <- quantile(bootsample, probs = 0.05)) # visualizing pointwise confidence intervals on other quantiles CIcdfplot(bootsample, CI.output = "quantile", CI.fill = "pink", xlim = c(0.5,2), main = "") ## ----------------------------------------------------------------------------- exposure <- 1.2 # Bootstrap sample of the PAF at this exposure PAF <- pnorm(exposure, mean = bootsample$estim$mean, sd = bootsample$estim$sd) # confidence interval from 2.5 and 97.5 percentiles quantile(PAF, probs = c(0.025, 0.975)) ## ---- fig.height=6, fig.width=6, warning = FALSE------------------------------ data(groundbeef) serving <- groundbeef$serving fit <- fitdist(serving, "gamma") par(mfrow = c(2,2), mar = c(4, 4, 1, 1)) denscomp(fit, addlegend = FALSE, main = "", xlab = "serving sizes (g)", fitcol = "orange") qqcomp(fit, addlegend = FALSE, main = "", fitpch = 16, fitcol = "grey", line01lty = 2) cdfcomp(fit, addlegend = FALSE, main = "", xlab = "serving sizes (g)", fitcol = "orange", lines01 = TRUE) ppcomp(fit, addlegend = FALSE, main = "", fitpch = 16, fitcol = "grey", line01lty = 2) ## ---- fig.height= 4, fig.width= 6, warning = FALSE---------------------------- library(ggplot2) fitW <- fitdist(serving, "weibull") fitln <- fitdist(serving, "lnorm") fitg <- fitdist(serving, "gamma") dcomp <- denscomp(list(fitW, fitln, fitg), legendtext = c("Weibull", "lognormal", "gamma"), xlab = "serving sizes (g)", xlim = c(0, 250), fitcol = c("red", "green", "orange"), fitlty = 1, fitlwd = 1:3, xlegend = "topright", plotstyle = "ggplot", addlegend = FALSE) dcomp + ggplot2::theme_minimal() + ggplot2::ggtitle("Ground beef fits") ## ---- fig.height= 6, fig.width= 6, warning = FALSE---------------------------- data(endosulfan) ATV <- subset(endosulfan, group == "NonArthroInvert")$ATV taxaATV <- subset(endosulfan, group == "NonArthroInvert")$taxa f <- fitdist(ATV, "lnorm") cdfcomp(f, xlogscale = TRUE, main = "Species Sensitivty Distribution", xlim = c(1, 100000), name.points = taxaATV, addlegend = FALSE, plotstyle = "ggplot") ## ----------------------------------------------------------------------------- dtoy <- data.frame(left = c(NA, 2, 4, 6, 9.7, 10), right = c(1, 3, 7, 8, 9.7, NA)) dtoy ## ----------------------------------------------------------------------------- exitage <- c(81.1,78.9,72.6,67.9,60.1,78.3,83.4,66.9,74.8,80.5,75.6,67.1, 75.3,82.8,70.1,85.4,74,70,71.6,76.5) death <- c(0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0) ## ----------------------------------------------------------------------------- svdata <- Surv2fitdistcens(exitage, event=death) ## ---- fig.height= 4, fig.width= 6--------------------------------------------- flnormc <- fitdistcens(svdata, "lnorm") fweic <- fitdistcens(svdata, "weibull") cdfcompcens(list(fweic, flnormc), xlim=range(exitage), xlegend = "topleft") ## ---- fig.height= 4, fig.width= 8--------------------------------------------- par(mfrow = c(1,2), mar = c(3, 4, 3, 0.5)) plotdistcens(dtoy, NPMLE = FALSE) data(smokedfish) dsmo <- log10(smokedfish) plotdistcens(dsmo, NPMLE = FALSE) ## ---- fig.height= 6, fig.width= 6--------------------------------------------- par(mfrow = c(2, 2), mar = c(3, 4, 3, 0.5)) # Turnbull algorithm with representation of middle points of equivalence classes plotdistcens(dsmo, NPMLE.method = "Turnbull.middlepoints", xlim = c(-1.8, 2.4)) # Turnbull algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Turnbull.intervals") # Wang algorithm with representation of equivalence classes as intervals plotdistcens(dsmo, NPMLE.method = "Wang") ## ---- echo = FALSE, fig.height= 4, fig.width= 8------------------------------- d <- data.frame(left = c(NA, 2, 4, 6, 9.5, 10), right = c(1, 3, 7, 8, 9.5, NA)) addbounds <- function(d) { xbounds <- c(d$left, d$right) xboundsnotNA <- xbounds[!is.na(xbounds)] abline(v = xboundsnotNA, col = "grey") } addLR <- function(d) { Lbounds <- d$left[!is.na(d$left)] Rbounds <- d$right[!is.na(d$right)] range <- range(c(Lbounds,Rbounds)) eps <- (range[2] - range[1]) * 0.01 text(x = Lbounds-eps, y = 0.05, labels = "L", col = "red", cex = 0.75) text(x = Rbounds+eps, y = 0.05, labels = "R", col = "red", cex = 0.75) } addeq <- function(deq) { left <- deq$left left[is.na(left)] <- -100 right <- deq$right right[is.na(right)] <- 100 rect(left, -2, right, 2, density = 10) } par(mfrow = c(2,1), mar = c(2, 4, 3, 0.5)) # First step plotdistcens(d, NPMLE = FALSE, lwd = 2, col = "blue", main = "Step 1 : identification of equivalence classes") addbounds(d) addLR(d) deq <- data.frame(left = c(NA, 2, 6, 9.5, 10), right = c(1, 3, 7,9.5, NA)) addeq(deq) # Second step plotdistcens(d, lwd = 2, main = "Step 2 : estimation of mass probabilities") ## ----------------------------------------------------------------------------- fnorm <- fitdistcens(dsmo,"norm") flogis <- fitdistcens(dsmo,"logis") # comparison of AIC values summary(fnorm)$aic summary(flogis)$aic ## ---- fig.height= 6, fig.width= 6--------------------------------------------- par(mar = c(2, 4, 3, 0.5)) plot(fnorm) ## ---- fig.height= 4, fig.width= 4--------------------------------------------- cdfcompcens(list(fnorm, flogis), fitlty = 1) qqcompcens(list(fnorm, flogis)) ppcompcens(list(fnorm, flogis)) ## ---- fig.height= 4, fig.width= 8--------------------------------------------- qqcompcens(list(fnorm, flogis), lwd = 2, plotstyle = "ggplot", fitcol = c("red", "green"), fillrect = c("pink", "lightgreen"), legendtext = c("normal distribution", "logistic distribution")) fitdistrplus/inst/doc/paper2JSS.Rnw0000644000176200001440000021727614067272025017015 0ustar liggesusers\documentclass{article} % sweave commands for vignette %\VignetteIndexEntry{Fit parametric distributions on non-censored or censored data} %\VignettePackage{fitdistrplus} %\VignetteKeyword{distribution} %%% %%% TITLE: fitdistrplus: an R Package for Fitting Distributions %%% AUTHORS: Marie Laure Delignette Muller*, Christophe Dutang %%% * Corresponding author %%% AFFILIATION: LBBE, Université Claude Bernard Lyon 1, Lyon, France %%% ADDRESS: VetAgro Sup Campus Vétérinaire de Lyon %%% 1, avenue Bourgelat %%% 69820 MARCY L'ETOILE, France %%% PHONE: +33 4 78 87 27 40 %%% FAX: +33 4 78 87 27 12 %%% EMAIL: marielaure.delignettemuller@vetagro-sup.fr %%% \usepackage{amsmath,amsthm,amssymb} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} %\usepackage[english]{babel} %% need no \usepackage{Sweave} \usepackage{color, graphics} \usepackage[a4paper, textwidth=18cm, textheight=27cm]{geometry} \newcommand{\sigle}{\textsc} \newcommand{\pkg}{\textbf} %defined in jss.cls \newcommand{\code}{\texttt} %defined in jss.cls \newcommand{\proglang}{\textsf} %defined in jss.cls %layout \newcommand{\HRuleTop}{\noindent\rule{\linewidth}{.5pt}} \newcommand{\HRuleBottom}{\rule{\linewidth}{.5pt}} \usepackage{natbib,url} %\usepackage[hyperfootnotes=false]{hyperref} \author{ Marie Laure Delignette-Muller \\ Universit\'e de Lyon\\ Christophe Dutang \\ Universit\'e de Strasbourg} %\Plainauthor{Marie Laure Delignette-Muller} \title{\pkg{fitdistrplus}: An \proglang{R} Package for Fitting Distributions} %\Plaintitle{fitdistrplus: an R Package for Fitting Distributions} \date{October 2014 \footnote{Paper accepted in the Journal of Statistical Software} (revised in May 2020)} %quantile matching, maximum goodness-of-fit, distributions, R} %% publication information %% NOTE: Typically, this can be left commented and will be filled out by the technical editor %% \Volume{50} %% \Issue{9} %% \Month{June} %% \Year{2012} %% \Submitdate{2012-09-04} %% \Acceptdate{2012-09-04} % \Address{ % Marie Laure Delignette-Muller \\ % Universit\'e de Lyon\\ % Universit\'e Lyon 1, CNRS, UMR5558, Laboratoire de Biom\'etrie et Biologie \'evolutive\\ % VetAgro Sup, Campus V\'et\'erinaire de Lyon \\ % 1, avenue Bourgelat \\ % 69820 MARCY L'ETOILE\\ % France \\ % E-mail: \email{marielaure.delignettemuller@vetagro-sup.fr} \\ % URL: \url{http://lbbe.univ-lyon1.fr/-Delignette-Muller-Marie-Laure-.html} % } % \newcommand{\Sconcordance}[1]{% % \ifx\pdfoutput\undefined% % \csname newcount\endcsname\pdfoutput\fi% % \ifcase\pdfoutput\special{#1}% % \else% % \begingroup% % \pdfcompresslevel=0% % \immediate\pdfobj stream{#1}% % \pdfcatalog{/SweaveConcordance \the\pdflastobj\space 0 R}% % \endgroup% % \fi} \begin{document} \SweaveOpts{concordance=TRUE} \maketitle \begin{abstract}% \HRuleTop\\ The package \pkg{fitdistrplus} provides functions for fitting univariate distributions to different types of data (continuous censored or non-censored data and discrete data) and allowing different estimation methods (maximum likelihood, moment matching, quantile matching and maximum goodness-of-fit estimation). Outputs of \code{fitdist} and \code{fitdistcens} functions are S3 objects, for which kind generic methods are provided, including \code{summary}, \code{plot} and \code{quantile}. This package also provides various functions to compare the fit of several distributions to a same data set and can handle bootstrap of parameter estimates. Detailed examples are given in food risk assessment, ecotoxicology and insurance contexts.\\ \HRuleBottom \end{abstract} \textit{Keywords}: {probability distribution fitting, bootstrap, censored data, maximum likelihood, moment matching, quantile matching, maximum goodness-of-fit, distributions, \proglang{R}} %\Plainkeywords{probability distribution fitting, bootstrap, censored data, maximum likelihood, moment matching, %, prefix.string=figs/jss %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section{Introduction} \label{Introduction} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Fitting distributions to data is a very common task in statistics and consists in choosing a probability distribution modelling the random variable, as well as finding parameter estimates for that distribution. This requires judgment and expertise and generally needs an iterative process of distribution choice, parameter estimation, and quality of fit assessment. In the \proglang{R} \citep{R13} package \pkg{MASS} \citep{MASS}, maximum likelihood estimation is available via the \code{fitdistr} function; other steps of the fitting process can be done using other \proglang{R} functions \citep{Ricci05}. In this paper, we present the \proglang{R} package \pkg{fitdistrplus} \citep{fitdistrplus} implementing several methods for fitting univariate parametric distribution. A first objective in developing this package was to provide \proglang{R} users a set of functions dedicated to help this overall process. The \code{fitdistr} function estimates distribution parameters by maximizing the likelihood function using the \code{optim} function. No distinction between parameters with different roles (e.g., main parameter and nuisance parameter) is made, as this paper focuses on parameter estimation from a general point-of-view. In some cases, other estimation methods could be prefered, such as maximum goodness-of-fit estimation (also called minimum distance estimation), as proposed in the \proglang{R} package \pkg{actuar} with three different goodness-of-fit distances \citep{actuarJSS}. While developping the \pkg{fitdistrplus} package, a second objective was to consider various estimation methods in addition to maximum likelihood estimation (MLE). Functions were developped to enable moment matching estimation (MME), quantile matching estimation (QME), and maximum goodness-of-fit estimation (MGE) using eight different distances. Moreover, the \pkg{fitdistrplus} package offers the possibility to specify a user-supplied function for optimization, useful in cases where classical optimization techniques, not included in \code{optim}, are more adequate. In applied statistics, it is frequent to have to fit distributions to censored data \citep{kleinmoeschberger03, helsel05,busschaertetal10,lehaetal11,commeauetal12}. The \pkg{MASS} \code{fitdistr} function does not enable maximum likelihood estimation with this type of data. Some packages can be used to work with censored data, especially survival data \citep{survival,hiranoetal94,jordan05}, but those packages generally focus on specific models, enabling the fit of a restricted set of distributions. A third objective is thus to provide \proglang{R} users a function to estimate univariate distribution parameters from right-, left- and interval-censored data. Few packages on \sigle{CRAN} provide estimation procedures for any user-supplied parametric distribution and support different types of data. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{distrMod} package \citep{distrModJSS} provides an object-oriented (S4) implementation of probability models and includes distribution fitting procedures for a given minimization criterion. This criterion is a user-supplied function which is sufficiently flexible to handle censored data, yet not in a trivial way, see Example M4 of the \pkg{distrMod} vignette. The fitting functions \code{MLEstimator} and \code{MDEstimator} return an S4 class for which a coercion method to class mle is provided so that the respective functionalities (e.g., \code{confint} and \code{logLik}) from package \pkg{stats4} are available, too. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In \pkg{fitdistrplus}, we chose to use the standard S3 class system for its understanding by most \proglang{R} users. When designing the \pkg{fitdistrplus} package, we did not forget to implement generic functions also available for S3 classes. Finally, various other packages provide functions to estimate the mode, the moments or the L-moments of a distribution, see the reference manuals of \pkg{modeest}, \pkg{lmomco} and \pkg{Lmoments} packages. This manuscript reviews the various features of version 1.0-2 of \pkg{fitdistrplus}. The package is available from the Comprehensive \proglang{R} Archive Network at \url{http://cran.r-project.org/package=fitdistrplus}. The development version of the package is located at \proglang{R}-forge as one package of the project ``Risk Assessment with \proglang{R}'' (\url{https://r-forge.r-project.org/projects/riskassessment/}). The paper is organized as follows: Section \ref{fitnoncenscont} presents tools for fitting continuous distributions to classic non-censored data. Section \ref{advtopic} deals with other estimation methods and other types of data, before Section \ref{ccl} concludes. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Fitting distributions]{Fitting distributions to continuous non-censored data}\label{fitnoncenscont} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Choice of candidate distributions} \label{Choice} For illustrating the use of various functions of the \pkg{fitdistrplus} package with continuous non-censored data, we will first use a data set named \code{groundbeef} which is included in our package. This data set contains pointwise values of serving sizes in grams, collected in a French survey, for ground beef patties consumed by children under 5 years old. It was used in a quantitative risk assessment published by \cite{Delignette08}. %%% R code set default options for all R schunks <>= options(digits = 4, prompt="R> ", SweaveHooks=list(fig=function() par(mar=c(5.1, 4.1, 1.1, 2.1)))) set.seed(1234) @ %%% R code <>= library("fitdistrplus") data("groundbeef") str(groundbeef) @ Before fitting one or more distributions to a data set, it is generally necessary to choose good candidates among a predefined set of distributions. This choice may be guided by the knowledge of stochastic processes governing the modelled variable, or, in the absence of knowledge regarding the underlying process, by the observation of its empirical distribution. To help the user in this choice, we developed functions to plot and characterize the empirical distribution. First of all, it is common to start with plots of the empirical distribution function and the histogram (or density plot), which can be obtained with the \code{plotdist} function of the \pkg{fitdistrplus} package. This function provides two plots (see Figure~\ref{plotdistcont}): the left-hand plot is by default the histogram on a density scale (or density plot of both, according to values of arguments \code{histo} and \code{demp}) and the right-hand plot the empirical cumulative distribution function (CDF). %%% R code <>= plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) @ \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[htb!] \centering %%% R code <>= plotdist(groundbeef$serving, histo = TRUE, demp = TRUE) @ \caption{Histogram and CDF plots of an empirical distribution for a continuous variable (serving size from the \code{groundbeef} data set) as provided by the \code{plotdist} function.} \label{plotdistcont} \end{figure} In addition to empirical plots, descriptive statistics may help to choose candidates to describe a distribution among a set of parametric distributions. Especially the skewness and kurtosis, linked to the third and fourth moments, are useful for this purpose. A non-zero skewness reveals a lack of symmetry of the empirical distribution, while the kurtosis value quantifies the weight of tails in comparison to the normal distribution for which the kurtosis equals 3. The skewness and kurtosis and their corresponding unbiased estimator \citep{casellaberger02} from a sample $(X_i)_i \stackrel{\text{i.i.d.}}{\sim} X$ with observations $(x_i)_i$ are given by \begin{equation} \label{skewness} sk(X) = \frac{E[(X-E(X))^3]}{Var(X)^{\frac{3}{2}}}~,~ \widehat{sk}=\frac{\sqrt{n(n-1)}}{n-2}\times\frac{m_{3}}{m_{2}^{\frac{3}{2}}}, \end{equation} \begin{equation} \label{kurtosis} kr(X) = \frac{E[(X-E(X))^4]}{Var(X)^{2}}~,~ \widehat{kr}=\frac{n-1}{(n-2)(n-3)}((n+1) \times \frac{m_{4}}{m_{2}^{2}}-3(n-1)) + 3, \end{equation} where $m_{2}$, $m_{3}$, $m_{4}$ denote empirical moments defined by $m_{k}=\frac{1}{n}\sum_{i=1}^n(x_{i}-\overline{x})^{k}$, with $x_{i}$ the $n$ observations of variable $x$ and $\overline{x}$ their mean value. The \code{descdist} function provides classical descriptive statistics (minimum, maximum, median, mean, standard deviation), skewness and kurtosis. By default, unbiased estimations of the three last statistics are provided. Nevertheless, the argument \code{method} can be changed from \code{"unbiased"} (default) to \code{"sample"} to obtain them without correction for bias. A skewness-kurtosis plot such as the one proposed by \cite{Cullen99} is provided by the \code{descdist} function for the empirical distribution (see Figure~\ref{Cullenplotcont} for the \code{groundbeef} data set). On this plot, values for common distributions are displayed in order to help the choice of distributions to fit to data. For some distributions (normal, uniform, logistic, exponential), there is only one possible value for the skewness and the kurtosis. Thus, the distribution is represented by a single point on the plot. For other distributions, areas of possible values are represented, consisting in lines (as for gamma and lognormal distributions), or larger areas (as for beta distribution). Skewness and kurtosis are known not to be robust. In order to take into account the uncertainty of the estimated values of kurtosis and skewness from data, a nonparametric bootstrap procedure \citep{efrontibshirani94} can be performed by using the argument \code{boot}. %to an integer above 10. Values of skewness and kurtosis are computed on bootstrap samples (constructed by random sampling with replacement from the original data set) and reported on the skewness-kurtosis plot. Nevertheless, the user needs to know that skewness and kurtosis, like all higher moments, have a very high variance. This is a problem which cannot be completely solved by the use of bootstrap. The skewness-kurtosis plot should then be regarded as indicative only. The properties of the random variable should be considered, notably its expected value and its range, as a complement to the use of the \code{plotdist} and \code{descdist} functions. Below is a call to the \code{descdist} function to describe the distribution of the serving size from the \code{groundbeef} data set and to draw the corresponding skewness-kurtosis plot (see Figure~\ref{Cullenplotcont}). Looking at the results on this example with a positive skewness and a kurtosis not far from 3, the fit of three common right-skewed distributions could be considered, Weibull, gamma and lognormal distributions. %%% R code <>= descdist(groundbeef$serving, boot = 1000) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb] \centering %%% R code <>= descdist(groundbeef$serving, boot = 1000) @ \caption{Skewness-kurtosis plot for a continuous variable (serving size from the \code{groundbeef} data set) as provided by the \code{descdist} function.} \label{Cullenplotcont} \end{figure} \newpage \subsection[Maximum likelihood]{Fit of distributions by maximum likelihood estimation} \label{FIT} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Once selected, one or more parametric distributions $f(.\vert \theta)$ (with parameter $\theta\in\mathbb{R}^d$) may be fitted to the data set, one at a time, using the \code{fitdist} function. Under the i.i.d. sample assumption, distribution parameters $\theta$ are by default estimated by maximizing the likelihood function defined as: \begin{equation} \label{likelihood} L(\theta)=\prod_{i=1}^n f(x_{i}\vert \theta) \end{equation} with $x_{i}$ the $n$ observations of variable $X$ and $f(.\vert \theta)$ the density function of the parametric distribution. The other proposed estimation methods are described in Section~\ref{Alternatives}. The \code{fitdist} function returns an S3 object of class \code{"fitdist"} for which \code{print}, \code{summary} and \code{plot} functions are provided. The fit of a distribution using \code{fitdist} assumes that the corresponding \code{d}, \code{p}, \code{q} functions (standing respectively for the density, the distribution and the quantile functions) are defined. Classical distributions are already defined in that way in the \pkg{stats} package, e.g., \code{dnorm}, \code{pnorm} and \code{qnorm} for the normal distribution (see \code{?Distributions}). Others may be found in various packages (see the CRAN task view: Probability Distributions at \url{https://CRAN.R-project.org/view=Distributions}). Distributions not found in any package must be implemented by the user as \code{d}, \code{p}, \code{q} functions. In the call to \code{fitdist}, a distribution has to be specified via the argument \code{dist} either by the character string corresponding to its common root name used in the names of \code{d}, \code{p}, \code{q} functions (e.g., \code{"norm"} for the normal distribution) or by the density function itself, from which the root name is extracted (e.g., \code{dnorm} for the normal distribution). Numerical results returned by the \code{fitdist} function are (1) the parameter estimates, (2) the estimated standard errors (computed from the estimate of the Hessian matrix at the maximum likelihood solution), (3) the loglikelihood, (4) Akaike and Bayesian information criteria (the so-called AIC and BIC), and (5) the correlation matrix between parameter estimates. Below is a call to the \code{fitdist} function to fit a Weibull distribution to the serving size from the \code{groundbeef} data set. %%% R code <>= fw <- fitdist(groundbeef$serving, "weibull") summary(fw) @ The plot of an object of class \code{"fitdist"} provides four classical goodness-of-fit plots \citep{Cullen99} presented on Figure~\ref{groundbeef:comp}: \begin{itemize} \item a density plot representing the density function of the fitted distribution along with the histogram of the empirical distribution, \item a CDF plot of both the empirical distribution and the fitted distribution, \item a Q-Q plot representing the empirical quantiles (y-axis) against the theoretical quantiles (x-axis) \item a P-P plot representing the empirical distribution function evaluated at each data point (y-axis) against the fitted distribution function (x-axis). \end{itemize} For CDF, Q-Q and P-P plots, the probability plotting position is defined by default using Hazen's rule, with probability points of the empirical distribution calculated as \code{(1:n - 0.5)/n}, as recommended by \cite{Blom}. This plotting position can be easily changed (see the reference manual for details \citep{fitdistrplus}). % using the arguments %\code{use.ppoints} and \code{a.ppoints}. When \code{use.ppoints = TRUE}, %the argument \code{a.ppoints} is passed to the \code{ppoints} function from the \pkg{stats} package to %define the %probability points of the empirical distribution as \code{(1:n - a.ppoints)/(n - 2a.ppoints + 1)}. %When \code{use.ppoints = FALSE}, the probability points are simply defined as \code{1:n / n}. Unlike the generic \code{plot} function, the \code{denscomp}, \code{cdfcomp}, \code{qqcomp} and \code{ppcomp} functions enable to draw separately each of these four plots, in order to compare the empirical distribution and multiple parametric distributions fitted on a same data set. These functions must be called with a first argument corresponding to a list of objects of class \code{fitdist}, and optionally further arguments to customize the plot (see the reference manual for lists of arguments that may be specific to each plot \citep{fitdistrplus}). In the following example, we compare the fit of a Weibull, a lognormal and a gamma distributions to the \code{groundbeef} data set (Figure~\ref{groundbeef:comp}). %%% R code <>= fg <- fitdist(groundbeef$serving, "gamma") fln <- fitdist(groundbeef$serving, "lnorm") par(mfrow = c(2, 2)) plot.legend <- c("Weibull", "lognormal", "gamma") denscomp(list(fw, fln, fg), legendtext = plot.legend) qqcomp(list(fw, fln, fg), legendtext = plot.legend) cdfcomp(list(fw, fln, fg), legendtext = plot.legend) ppcomp(list(fw, fln, fg), legendtext = plot.legend) @ \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[htb!] \centering <>= par(mfrow=c(2, 2)) denscomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) qqcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) cdfcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) ppcomp(list(fw, fln, fg), legendtext=c("Weibull", "lognormal", "gamma")) @ \caption{Four Goodness-of-fit plots for various distributions fitted to continuous data (Weibull, gamma and lognormal distributions fitted to serving sizes from the \code{groundbeef} data set) as provided by functions \code{denscomp}, \code{qqcomp}, \code{cdfcomp} and \code{ppcomp}.} \label{groundbeef:comp} \end{figure} The density plot and the CDF plot may be considered as the basic classical goodness-of-fit plots. The two other plots are complementary and can be very informative in some cases. The Q-Q plot emphasizes the lack-of-fit at the distribution tails while the P-P plot emphasizes the lack-of-fit at the distribution center. In the present example (in Figure~\ref{groundbeef:comp}), none of the three fitted distributions correctly describes the center of the distribution, but the Weibull and gamma distributions could be prefered for their better description of the right tail of the empirical distribution, especially if this tail is important in the use of the fitted distribution, as it is in the context of food risk assessment. The data set named \code{endosulfan} will now be used to illustrate other features of the \pkg{fitdistrplus} package. This data set contains acute toxicity values for the organochlorine pesticide endosulfan (geometric mean of LC50 ou EC50 values in $\mu g.L^{-1}$), tested on Australian and non-Australian laboratory-species \citep{Hose04}. In ecotoxicology, a lognormal or a loglogistic distribution is often fitted to such a data set in order to characterize the species sensitivity distribution (SSD) for a pollutant. A low percentile of the fitted distribution, generally the 5$\%$ percentile, is then calculated and named the hazardous concentration 5$\%$ (HC5). It is interpreted as the value of the pollutant concentration protecting 95$\%$ of the species \citep{Posthuma2010}. But the fit of a lognormal or a loglogistic distribution to the whole \code{endosulfan} data set is rather bad (Figure~\ref{endo:comp}), especially due to a minority of very high values. The two-parameter Pareto distribution and the three-parameter Burr distribution (which is an extension of both the loglogistic and the Pareto distributions) have been fitted. Pareto and Burr distributions are provided in the package \pkg{actuar}. Until here, we did not have to define starting values (in the optimization process) as reasonable starting values are implicity defined within the \code{fitdist} function for most of the distributions defined in \proglang{R} (see \code{?fitdist} for details). For other distributions like the Pareto and the Burr distribution, initial values for the distribution parameters have to be supplied in the argument \code{start}, as a named list with initial values for each parameter (as they appear in the \code{d}, \code{p}, \code{q} functions). Having defined reasonable starting values\footnote{%---- The \code{plotdist} function can plot any parametric distribution with specified parameter values in argument \code{para}. It can thus help to find correct initial values for the distribution parameters in non trivial cases, by iterative calls if necessary (see the reference manual for examples \citep{fitdistrplus}). }, %---- various distributions can be fitted and graphically compared. On this example, the function \code{cdfcomp} can be used to report CDF values in a logscale so as to emphasize discrepancies on the tail of interest while defining an HC5 value (Figure~\ref{endo:comp}). %%% R code <>= data("endosulfan") ATV <-endosulfan$ATV fendo.ln <- fitdist(ATV, "lnorm") library("actuar") fendo.ll <- fitdist(ATV, "llogis", start = list(shape = 1, scale = 500)) fendo.P <- fitdist(ATV, "pareto", start = list(shape = 1, scale = 500)) fendo.B <- fitdist(ATV, "burr", start = list(shape1 = 0.3, shape2 = 1, rate = 1)) cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE, legendtext = c("lognormal", "loglogistic", "Pareto", "Burr")) @ % qqcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale=TRUE, ylogscale=TRUE, % legendtext = c("lognormal","loglogistic","Pareto","Burr")) \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering <>= cdfcomp(list(fendo.ln, fendo.ll, fendo.P, fendo.B), xlogscale = TRUE, ylogscale = TRUE,legendtext = c("lognormal","loglogistic","Pareto","Burr")) @ %qqcomp(list(fendo.ln,fendo.ll,fendo.P,fendo.B),xlogscale=TRUE,ylogscale=TRUE, % legendtext = c("lognormal","loglogistic","Pareto","Burr")) \caption{CDF plot to compare the fit of four distributions to acute toxicity values of various organisms for the organochlorine pesticide endosulfan (\code{endosulfan} data set) as provided by the \code{cdfcomp} function, with CDF values in a logscale to emphasize discrepancies on the left tail.} \label{endo:comp} \end{figure} None of the fitted distribution correctly describes the right tail observed in the data set, but as shown in Figure~\ref{endo:comp}, the left-tail seems to be better described by the Burr distribution. Its use could then be considered to estimate the HC5 value as the $5\%$ quantile of the distribution. This can be easily done using the \code{quantile} generic function defined for an object of class \code{"fitdist"}. Below is this calculation together with the calculation of the empirical quantile for comparison. %%% R code <>= quantile(fendo.B, probs = 0.05) quantile(ATV, probs = 0.05) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In addition to the ecotoxicology context, the \code{quantile} generic function is also attractive in the actuarial--financial context. In fact, the value-at-risk $VAR_\alpha$ is defined as the $1-\alpha$-quantile of the loss distribution and can be computed with \code{quantile} on a \code{"fitdist"} object. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The computation of different goodness-of-fit statistics is proposed in the \pkg{fitdistrplus} package in order to further compare fitted distributions. The purpose of goodness-of-fit statistics aims to measure the distance between the fitted parametric distribution and the empirical distribution: e.g., the distance between the fitted cumulative distribution function $F$ and the empirical distribution function $F_{n}$. When fitting continuous distributions, three goodness-of-fit statistics are classicaly considered: Cramer-von Mises, Kolmogorov-Smirnov and Anderson-Darling statistics \citep{Stephens86}. Naming $x_{i}$ the $n$ observations of a continuous variable $X$ arranged in an ascending order, Table \ref{tabKSCvMAD} gives the definition and the empirical estimate of the three considered goodness-of-fit statistics. They can be computed using the function \code{gofstat} as defined by Stephens \citep{Stephens86}. <>= gofstat(list(fendo.ln, fendo.ll, fendo.P, fendo.B), fitnames = c("lnorm", "llogis", "Pareto", "Burr")) @ \begin{table}[htb!] \begin{center} \begin{tabular}{lll} \hline Statistic & General formula & Computational formula\\ \hline Kolmogorov-Smirnov & $\sup|F_{n}(x) - F(x)|$ & $\max(D^{+},D^{-})$ with\\ (KS) & & $D^{+}=\max\limits_{i=1,\dots,n}\left(\frac{i}{n} - F_i\right)$ \\ & & $D^{-}=\max\limits_{i=1,\dots,n}\left(F_{i}-\frac{i-1}{n}\right)$ \\ \hline Cramer-von Mises & n $\int_{-\infty}^{\infty}(F_{n}(x) - F(x))^2 dx$ & $\frac{1}{12n} + \sum\limits_{i=1}^n \left(F_i-\frac{2i-1}{2n} \right)^{2}$\\ (CvM)&&\\ % cvm <- 1/(12*n) + sum( ( theop - (2 * seq(1:n) - 1)/(2 * n) )^2 ) \hline Anderson-Darling & n $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2}{F(x) (1 - F(x))} dx$ & $-n -\frac{1}{n}\sum\limits_{i=1}^n (2i-1)\log(F_i(1-F_{n+1-i}))$ \\ (AD) & & \\ % ad <- - n - mean( (2 * seq(1:n) - 1) * (log(theop) + log(1 - rev(theop))) ) \hline where $F_i\stackrel{\triangle}{=} F(x_i)$ \end{tabular} \caption{Goodness-of-fit statistics as defined by Stephens \citep{Stephens86}.} \label{tabKSCvMAD} \end{center} \end{table} %\newpage As giving more weight to distribution tails, the Anderson-Darling statistic is of special interest when it matters to equally emphasize the tails as well as the main body of a distribution. This is often the case in risk assessment \citep{Cullen99,Vose10}. For this reason, this statistics is often used to select the best distribution among those fitted. Nevertheless, this statistics should be used cautiously when comparing fits of various distributions. Keeping in mind that the weighting of each CDF quadratic difference depends on the parametric distribution in its definition (see Table \ref{tabKSCvMAD}), Anderson-Darling statistics computed for several distributions fitted on a same data set are theoretically difficult to compare. Moreover, such a statistic, as Cramer-von Mises and Kolmogorov-Smirnov ones, does not take into account the complexity of the model (i.e., parameter number). It is not a problem when compared distributions are characterized by the same number of parameters, but it could systematically promote the selection of the more complex distributions in the other case. Looking at classical penalized criteria based on the loglikehood (AIC, BIC) seems thus also interesting, especially to discourage overfitting. In the previous example, all the goodness-of-fit statistics based on the CDF distance are in favor of the Burr distribution, the only one characterized by three parameters, while AIC and BIC values respectively give the preference to the Burr distribution or the Pareto distribution. The choice between these two distributions seems thus less obvious and could be discussed. Even if specifically recommended for discrete distributions, the Chi-squared statistic may also be used for continuous distributions (see Section~\ref{otherdata} and the reference manual for examples \citep{fitdistrplus}). \subsection[Uncertainty]{Uncertainty in parameter estimates} \label{Uncertainty} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The uncertainty in the parameters of the fitted distribution can be estimated by parametric or nonparametric bootstraps using the \code{boodist} function for non-censored data \citep{efrontibshirani94}. This function returns the bootstrapped values of parameters in an S3 class object which can be plotted to visualize the bootstrap region. The medians and the 95 percent confidence intervals of parameters (2.5 and 97.5 percentiles) are printed in the summary. When inferior to the whole number of iterations (due to lack of convergence of the optimization algorithm for some bootstrapped data sets), the number of iterations for which the estimation converges is also printed in the summary. The plot of an object of class \code{"bootdist"} consists in a scatterplot or a matrix of scatterplots of the bootstrapped values of parameters providing a representation of the joint uncertainty distribution of the fitted parameters. Below is an example of the use of the \code{bootdist} function with the previous fit of the Burr distribution to the \code{endosulfan} data set (Figure~\ref{fig:bootstrap}). %%% R code <>= bendo.B <- bootdist(fendo.B, niter = 1001) @ <>= summary(bendo.B) plot(bendo.B) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering <>= plot(bendo.B) @ \caption{Bootstrappped values of parameters for a fit of the Burr distribution characterized by three parameters (example on the \code{endosulfan} data set) as provided by the plot of an object of class \code{"bootdist"}.} \label{fig:bootstrap} \end{figure} Bootstrap samples of parameter estimates are useful especially to calculate confidence intervals on each parameter of the fitted distribution from the marginal distribution of the bootstraped values. It is also interesting to look at the joint distribution of the bootstraped values in a scatterplot (or a matrix of scatterplots if the number of parameters exceeds two) in order to understand the potential structural correlation between parameters (see Figure~\ref{fig:bootstrap}). The use of the whole bootstrap sample is also of interest in the risk assessment field. Its use enables the characterization of uncertainty in distribution parameters. It can be directly used within a second-order Monte Carlo simulation framework, especially within the package \pkg{mc2d} \citep{mc2d}. One could refer to \cite{Pouillot10} for an introduction to the use of \pkg{mc2d} and \pkg{fitdistrplus} packages in the context of quantitative risk assessment. The bootstrap method can also be used to calculate confidence intervals on quantiles of the fitted distribution. For this purpose, a generic \code{quantile} function is provided for class \code{bootdist}. By default, $95\%$ percentiles bootstrap confidence intervals of quantiles are provided. Going back to the previous example from ecotoxicolgy, this function can be used to estimate the uncertainty associated to the HC5 estimation, for example from the previously fitted Burr distribution to the \code{endosulfan} data set. %%% R code <>= quantile(bendo.B, probs = 0.05) @ \begin{small} <>= quantile(bendo.B, probs = 0.05) @ \end{small} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Advanced topics}\label{advtopic} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[Alternative estimation]{Alternative methods for parameter estimation} \label{Alternatives} This subsection focuses on alternative estimation methods. One of the alternative for continuous distributions is the maximum goodness-of-fit estimation method also called minimum distance estimation method \citep{Stephens86,actuarJSS}. In this package this method is proposed with eight different distances: the three classical distances defined in Table~\ref{tabKSCvMAD}, or one of the variants of the Anderson-Darling distance proposed by \cite{Luceno06} and defined in Table~\ref{modifiedAD}. The right-tail AD gives more weight to the right-tail, the left-tail AD gives more weight only to the left tail. Either of the tails, or both of them, can receive even larger weights by using second order Anderson-Darling Statistics. \begin{table}[htb!] \begin{center} \begin{tabular}{lll} \hline Statistic & General formula & Computational formula\\ \hline Right-tail AD & $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{1 - F(x)} dx$ & $\frac{n}{2} -2\sum\limits_{i=1}^nF_i -\frac{1}{n}\sum\limits_{i=1}^n(2i-1)ln(\overline F_{n+1-i})$ \\ (ADR) & &\\ \hline Left-tail AD & $\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(F(x))} dx$ & $-\frac{3n}{2} +2\sum\limits_{i=1}^nF_i -\frac{1}{n}\sum\limits_{i=1}^n(2i-1)ln(F_i)$ \\ (ADL) & &\\ \hline Right-tail AD & $ad2r=\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(1 - F(x))^{2}} dx$ & $ad2r=2\sum\limits_{i=1}^nln(\overline F_i) +\frac{1}{n}\sum\limits_{i=1}^n \frac{2i-1}{\overline F_{n+1-i}}$ \\ 2nd order (AD2R) & &\\ \hline Left-tail AD & $ad2l=\int_{-\infty}^{\infty}\frac{(F_{n}(x) - F(x))^2 }{(F(x))^{2}} dx$ & $ad2l=2\sum\limits_{i=1}^nln(F_i) +\frac{1}{n}\sum\limits_{i=1}^n\frac{2i-1}{F_i}$ \\ 2nd order (AD2L) & &\\ \hline AD 2nd order & $ad2r+ad2l$ & $ad2r+ad2l$ \\ (AD2) & &\\ \hline where $F_i\stackrel{\triangle}{=} F(x_{i})$; & $\overline F_i\stackrel{\triangle}{=}1-F(x_{i})$ \end{tabular} \caption{Modified Anderson-Darling statistics as defined by \cite{Luceno06}.} \label{modifiedAD} \end{center} \end{table} To fit a distribution by maximum goodness-of-fit estimation, one needs to fix the argument \code{method} to \code{"mge"} in the call to \code{fitdist} and to specify the argument \code{gof} coding for the chosen goodness-of-fit distance. This function is intended to be used only with continuous non-censored data. Maximum goodness-of-fit estimation may be useful to give more weight to data at one tail of the distribution. In the previous example from ecotoxicology, we used a non classical distribution (the Burr distribution) to correctly fit the empirical distribution especially on its left tail. In order to correctly estimate the 5$\%$ percentile, we could also consider the fit of the classical lognormal distribution, but minimizing a goodness-of-fit distance giving more weight to the left tail of the empirical distribution. In what follows, the left tail Anderson-Darling distances of first or second order are used to fit a lognormal to \code{endosulfan} data set (see Figure~\ref{plotfitMGE}). %%% R code <>= fendo.ln.ADL <- fitdist(ATV, "lnorm", method = "mge", gof = "ADL") fendo.ln.AD2L <- fitdist(ATV, "lnorm", method = "mge", gof = "AD2L") cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", xlegend = "bottomright", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order")) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering %%% R code <>= cdfcomp(list(fendo.ln, fendo.ln.ADL, fendo.ln.AD2L), xlogscale = TRUE, ylogscale = TRUE, main = "Fitting a lognormal distribution", legendtext = c("MLE","Left-tail AD", "Left-tail AD 2nd order"), xlegend = "bottomright") @ \caption{Comparison of a lognormal distribution fitted by MLE and by MGE using two different goodness-of-fit distances : left-tail Anderson-Darling and left-tail Anderson Darling of second order (example with the \code{endosulfan} data set) as provided by the \code{cdfcomp} function, with CDF values in a logscale to emphasize discrepancies on the left tail.} \label{plotfitMGE} \end{figure} Comparing the $5\%$ percentiles (HC5) calculated using these three fits to the one calculated from the MLE fit of the Burr distribution, we can observe, on this example, that fitting the lognormal distribution by maximizing left tail Anderson-Darling distances of first or second order enables to approach the value obtained by fitting the Burr distribution by MLE. %%% R code <>= (HC5.estimates <- c( empirical = as.numeric(quantile(ATV, probs = 0.05)), Burr = as.numeric(quantile(fendo.B, probs = 0.05)$quantiles), lognormal_MLE = as.numeric(quantile(fendo.ln, probs = 0.05)$quantiles), lognormal_AD2 = as.numeric(quantile(fendo.ln.ADL, probs = 0.05)$quantiles), lognormal_AD2L = as.numeric(quantile(fendo.ln.AD2L, probs = 0.05)$quantiles))) @ %\subsubsection{Moment matching estimation} %\label{MME} %%%%%%%%%% The moment matching estimation (MME) is another method commonly used to fit parametric distributions \citep{Vose10}. MME consists in finding the value of the parameter $\theta$ that equalizes the first theoretical raw moments of the parametric distribution to the corresponding empirical raw moments as in Equation~(\ref{moments}): \begin{equation} \label{moments} E(X^{k}|\theta)=\frac{1}{n}\sum_{i=1}^{n}x_{i}^{k} , \end{equation} for $k=1,\ldots,d$, with $d$ the number of parameters to estimate and $x_{i}$ the $n$ observations of variable $X$. For moments of order greater than or equal to 2, it may also be relevant to match centered moments. Therefore, we match the moments given in Equation~(\ref{centmoments}): \begin{equation} \label{centmoments} E(X\vert \theta) = \overline{x} ~,~ E\left((X-E(X))^{k}|\theta\right)=m_k, \text{ for } k=2,\ldots,d, \end{equation} where $m_k$ denotes the empirical centered moments. This method can be performed by setting the argument \code{method} to \code{"mme"} in the call to \code{fitdist}. The estimate is computed by a closed-form formula for the following distributions: normal, lognormal, exponential, Poisson, gamma, logistic, negative binomial, geometric, beta and uniform distributions. In this case, for distributions characterized by one parameter (geometric, Poisson and exponential), this parameter is simply estimated by matching theoretical and observed means, and for distributions characterized by two parameters, these parameters are estimated by matching theoretical and observed means and variances \citep{Vose10}. For other distributions, the equation of moments is solved numerically using the \code{optim} function by minimizing the sum of squared differences between observed and theoretical moments (see the \pkg{fitdistrplus} reference manual for technical details \citep{fitdistrplus}). A classical data set from the Danish insurance industry published in \cite{mcneil97} will be used to illustrate this method. In \pkg{fitdistrplus}, the data set is stored in \code{danishuni} for the univariate version and contains the loss amounts collected at Copenhagen Reinsurance between 1980 and 1990. In actuarial science, it is standard to consider positive heavy-tailed distributions and have a special focus on the right-tail of the distributions. In this numerical experiment, we choose classic actuarial distributions for loss modelling: the lognormal distribution and the Pareto type II distribution \citep{Klugmanetal09}. The lognormal distribution is fitted to \code{danishuni} data set by matching moments implemented as a closed-form formula. On the left-hand graph of Figure~\ref{fig:danish:mme}, the fitted distribution functions obtained using the moment matching estimation (MME) and maximum likelihood estimation (MLE) methods are compared. The MME method provides a more cautious estimation of the insurance risk as the MME-fitted distribution function (resp. MLE-fitted) underestimates (overestimates) the empirical distribution function for large values of claim amounts. %%% R code <>= data("danishuni") str(danishuni) fdanish.ln.MLE <- fitdist(danishuni$Loss, "lnorm") fdanish.ln.MME <- fitdist(danishuni$Loss, "lnorm", method = "mme", order = 1:2) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend = c("lognormal MLE", "lognormal MME"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) @ \setkeys{Gin}{width=0.9\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start=list(shape=10, scale=10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method="mme", order=1:2, memp="memp", start=list(shape=10, scale=10), lower=c(2+1e-6,2+1e-6), upper=c(Inf,Inf)) par(mfrow=c(1, 2)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.MME), legend=c("lognormal MLE", "lognormal MME"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend=c("Pareto MLE", "Pareto MME"), main="Fitting a Pareto distribution", xlogscale=TRUE, datapch=20) @ \caption{Comparison between MME and MLE when fitting a lognormal or a Pareto distribution to loss data from the \code{danishuni} data set.} \label{fig:danish:mme} \end{figure} In a second time, a Pareto distribution, which gives more weight to the right-tail of the distribution, is fitted. As the lognormal distribution, the Pareto has two parameters, which allows a fair comparison. %The Burr distribution (with its three parameters) would lead to a better fit. We use the implementation of the \pkg{actuar} package providing raw and centered moments for that distribution (in addition to \code{d}, \code{p}, \code{q} and \code{r} functions \citep{actuar12}. Fitting a heavy-tailed distribution for which the first and the second moments do not exist for certain values of the shape parameter requires some cautiousness. This is carried out by providing, for the optimization process, a lower and an upper bound for each parameter. The code below calls the L-BFGS-B optimization method in \code{optim}, since this quasi-Newton allows box constraints\footnote{That is what the B stands for.}. We choose match moments defined in Equation~(\ref{moments}), and so a function for computing the empirical raw moment (called \code{memp} in our example) is passed to \code{fitdist}. For two-parameter distributions (i.e., $d=2$), Equations~(\ref{moments}) and (\ref{centmoments}) are equivalent. <>= library("actuar") fdanish.P.MLE <- fitdist(danishuni$Loss, "pareto", start = list(shape = 10, scale = 10), lower = 2+1e-6, upper = Inf) memp <- function(x, order) sum(x^order)/length(x) fdanish.P.MME <- fitdist(danishuni$Loss, "pareto", method = "mme", order = 1:2, memp = "memp", start = list(shape = 10, scale = 10), lower = c(2+1e-6, 2+1e-6), upper = c(Inf, Inf)) cdfcomp(list(fdanish.P.MLE, fdanish.P.MME), legend = c("Pareto MLE", "Pareto MME"), main = "Fitting a Pareto distribution", xlogscale = TRUE, datapch = ".") gofstat(list(fdanish.ln.MLE, fdanish.P.MLE, fdanish.ln.MME, fdanish.P.MME), fitnames = c("lnorm.mle", "Pareto.mle", "lnorm.mme", "Pareto.mme")) @ As shown on Figure~\ref{fig:danish:mme}, MME and MLE fits are far less distant (when looking at the right-tail) for the Pareto distribution than for the lognormal distribution on this data set. Furthermore, for these two distributions, the MME method better fits the right-tail of the distribution from a visual point of view. This seems logical since empirical moments are influenced by large observed values. In the previous traces, we gave the values of goodness-of-fit statistics. Whatever the statistic considered, the MLE-fitted lognormal always provides the best fit to the observed data. Maximum likelihood and moment matching estimations are certainly the most commonly used method for fitting distributions \citep{Cullen99}. Keeping in mind that these two methods may produce very different results, the user should be aware of its great sensitivity to outliers when choosing the moment matching estimation. This may be seen as an advantage in our example if the objective is to better describe the right tail of the distribution, but it may be seen as a drawback if the objective is different. %\subsubsection{Quantile matching estimation} %\label{QME} %%%%%%%%%% Fitting of a parametric distribution may also be done by matching theoretical quantiles of the parametric distributions (for specified probabilities) against the empirical quantiles (\cite{Tse2009}). The equality of theoretical and empirical qunatiles is expressed by Equation~(\ref{quantiles}) below, which is very similar to Equations~(\ref{moments}) and (\ref{centmoments}): \begin{equation} \label{quantiles} F^{-1}(p_{k}|\theta)=Q_{n,p_{k}} \end{equation} for $k=1,\ldots,d$, with $d$ the number of parameters to estimate (dimension of $\theta$ if there is no fixed parameters) and $Q_{n,p_{k}}$ the empirical quantiles calculated from data for specified probabilities $p_{k}$. Quantile matching estimation (QME) is performed by setting the argument \code{method} to \code{"qme"} in the call to \code{fitdist} and adding an argument \code{probs} defining the probabilities for which the quantile matching is performed. The length of this vector must be equal to the number of parameters to estimate (as the vector of moment orders for MME). Empirical quantiles are computed using the \code{quantile} function of the \pkg{stats} package using \code{type=7} by default (see \code{?quantile} and \cite{hyndmanfan96}). But the type of quantile can be easily changed by using the \code{qty} argument in the call to the \code{qme} function. The quantile matching is carried out numerically, by minimizing the sum of squared differences between observed and theoretical quantiles. %%% R code <>= fdanish.ln.QME1 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(1/3, 2/3)) fdanish.ln.QME2 <- fitdist(danishuni$Loss, "lnorm", method = "qme", probs = c(8/10, 9/10)) cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend = c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main = "Fitting a lognormal distribution", xlogscale = TRUE, datapch = 20) @ Above is an example of fitting of a lognormal distribution to \code{danishuni} data set by matching probabilities $(p_1= 1/3, p_2=2/3)$ and $(p_1= 8/10, p_2=9/10)$. As expected, the second QME fit gives more weight to the right-tail of the distribution. %, despite we do not choose the Pareto type-II distribution. Compared to the maximum likelihood estimation, the second QME fit best suits the right-tail of the distribution, whereas the first QME fit best models the body of the distribution. The quantile matching estimation is of particular interest when we need to focus around particular quantiles, e.g., $p=99.5\%$ in the Solvency II insurance context or $p=5\%$ for the HC5 estimation in the ecotoxicology context. \setkeys{Gin}{width=0.5\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= cdfcomp(list(fdanish.ln.MLE, fdanish.ln.QME1, fdanish.ln.QME2), legend=c("MLE", "QME(1/3, 2/3)", "QME(8/10, 9/10)"), main="Fitting a lognormal distribution", xlogscale=TRUE, datapch=20) @ \caption{Comparison between QME and MLE when fitting a lognormal distribution to loss data from the \code{danishuni} data set.} \label{fig:danish:qme} \end{figure} %\clearpage \subsection[Customizing optimization]{Customization of the optimization algorithm} \label{Customization} %%%%%%%%%% Each time a numerical minimization is carried out in the \code{fitdistrplus} package, the \code{optim} function of the \pkg{stats} package is used by default with the \code{"Nelder-Mead"} method for distributions characterized by more than one parameter and the \code{"BFGS"} method for distributions characterized by only one parameter. Sometimes the default algorithm fails to converge. It is then interesting to change some options of the \code{optim} function or to use another optimization function than \code{optim} to minimize the objective function. The argument \code{optim.method} can be used in the call to \code{fitdist} or \code{fitdistcens}. It will internally be passed to \code{mledist}, \code{mmedist}, \code{mgedist} or \code{qmedist}, and to \code{optim} (see \code{?optim} for details about the different algorithms available). Even if no error is raised when computing the optimization, changing the algorithm is of particular interest to enforce bounds on some parameters. For instance, a volatility parameter $\sigma$ is strictly positive $\sigma>0$ and a probability parameter $p$ lies in $p\in [0,1]$. This is possible by using arguments \code{lower} and/or \code{upper}, for which their use automatically forces \code{optim.method="L-BFGS-B"}. Below are examples of fits of a gamma distribution $\mathcal{G}(\alpha, \lambda)$ to the \code{groundbeef} data set with various algorithms. Note that the conjugate gradient algorithm (\code{"CG"}) needs far more iterations to converge (around 2500 iterations) compared to other algorithms (converging in less than 100 iterations). %%% R code <>= data("groundbeef") fNM <- fitdist(groundbeef$serving, "gamma", optim.method = "Nelder-Mead") fBFGS <- fitdist(groundbeef$serving, "gamma", optim.method = "BFGS") fSANN <- fitdist(groundbeef$serving, "gamma", optim.method = "SANN") fCG <- try(fitdist(groundbeef$serving, "gamma", optim.method = "CG", control = list(maxit = 10000))) if(class(fCG) == "try-error") fCG <- list(estimate = NA) @ It is also possible to use another function than \code{optim} to minimize the objective function by specifying by the argument \code{custom.optim} in the call to \code{fitdist}. It may be necessary to customize this optimization function to meet the following requirements. (1) \code{custom.optim} function must have the following arguments: \code{fn} for the function to be optimized and \code{par} for the initialized parameters. (2) \code{custom.optim} should carry out a MINIMIZATION and must return the following components: \code{par} for the estimate, \code{convergence} for the convergence code, \code{value=fn(par)} and \code{hessian}. Below is an example of code written to wrap the \code{genoud} function from the \pkg{rgenoud} package in order to respect our optimization ``template''. The \pkg{rgenoud} package implements the genetic (stochastic) algorithm. %%% R code <>= mygenoud <- function(fn, par, ...) { require(rgenoud) res <- genoud(fn, starting.values = par, ...) standardres <- c(res, convergence = 0) return(standardres) } @ The customized optimization function can then be passed as the argument \code{custom.optim} in the call to \code{fitdist} or \code{fitdistcens}. The following code can for example be used to fit a gamma distribution to the \code{groundbeef} data set. Note that in this example various arguments are also passed from \code{fitdist} to \code{genoud} : \code{nvars}, \code{Domains}, \code{boundary.enforcement}, \code{print.level} and \code{hessian}. The code below compares all the parameter estimates ($\hat\alpha$, $\hat\lambda$) by the different algorithms: shape $\alpha$ and rate $\lambda$ parameters are relatively similar on this example, roughly 4.00 and 0.05, respectively. %%% R code <>= fgenoud <- mledist(groundbeef$serving, "gamma", custom.optim = mygenoud, nvars = 2, max.generations = 10, Domains = cbind(c(0,0), c(10,10)), boundary.enforcement = 1, hessian = TRUE, print.level = 0, P9 = 10) cbind(NM = fNM$estimate, BFGS = fBFGS$estimate, SANN = fSANN$estimate, CG = fCG$estimate, fgenoud = fgenoud$estimate) @ %\newpage \subsection[Other types of data]{Fitting distributions to other types of data} \label{otherdata} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \emph{This section was modified since the publication of this vignette in the Journal of Statistical Software in order to include new goodness-of-fit plots for censored and discrete data.} Analytical methods often lead to semi-quantitative results which are referred to as censored data. Observations only known to be under a limit of detection are left-censored data. Observations only known to be above a limit of quantification are right-censored data. Results known to lie between two bounds are interval-censored data. These two bounds may correspond to a limit of detection and a limit of quantification, or more generally to uncertainty bounds around the observation. Right-censored data are also commonly encountered with survival data \citep{kleinmoeschberger03}. A data set may thus contain right-, left-, or interval-censored data, or may be a mixture of these categories, possibly with different upper and lower bounds. Censored data are sometimes excluded from the data analysis or replaced by a fixed value, which in both cases may lead to biased results. A more recommended approach to correctly model such data is based upon maximum likelihood \citep{kleinmoeschberger03,helsel05}. Censored data may thus contain left-censored, right-censored and interval-censored values, with several lower and upper bounds. Before their use in package \pkg{fitdistrplus}, such data must be coded into a dataframe with two columns, respectively named \code{left} and \code{right}, describing each observed value as an interval. The \code{left} column contains either \code{NA} for left censored observations, the left bound of the interval for interval censored observations, or the observed value for non-censored observations. The \code{right} column contains either \code{NA} for right censored observations, the right bound of the interval for interval censored observations, or the observed value for non-censored observations. To illustrate the use of package \pkg{fitdistrplus} to fit distributions to censored continous data, we will use another data set from ecotoxicology, included in our package and named \code{salinity}. This data set contains acute salinity tolerance (LC50 values in electrical conductivity, $mS$.$cm^{-1}$) of riverine macro-invertebrates taxa from the southern Murray-Darling Basin in Central Victoria, Australia \citep{kefford07}. %%% R code <>= data("salinity") str(salinity) @ %\subsubsection{Graphical display of the observed distribution} %\label{censored:graph} %%%%%%%%%% Using censored data such as those coded in the \code{salinity} data set, the empirical distribution can be plotted using the \code{plotdistcens} function. In older versions of the package, by default this function used the Expectation-Maximization approach of \cite{Turnbull74} to compute the overall empirical cdf curve with optional confidence intervals, by calls to \code{survfit} and \code{plot.survfit} functions from the \pkg{survival} package. Even if this representation is always available (by fixing the argument \code{NPMLE.method} to \code{"Turnbull.middlepoints"}), now the default plot of the empirical cumulative distribution function (ECDF) explicitely represents the regions of non uniqueness of the NPMLE ECDF. The default computation of those regions of non uniqueness and their associated masses uses the non parametric maximum likelihood estimation (NPMLE) approach developped by Wang \citep{Wang2007, Wang2008, Wang2013, Wang2018}. Figure~\ref{cdfcompcens} shows on the top left the new plot of data together with two fitted distributions. Grey filled rectangles in such a plot represent the regions of non uniqueness of the NPMLE ECDF. A less rigorous but sometimes more illustrative plot can be obtained by fixing the argument \code{NPMLE} to \code{FALSE} in the call to \code{plotdistcens} (see Figure~\ref{plotdistcens} for an example and the help page of Function \code{plotdistcens} for details). This plot enables to see the real nature of censored data, as points and intervals, but the difficulty in building such a plot is to define a relevant ordering of observations. %%% R code %<>= %plotdistcens(salinity) %@ %%% R code <>= plotdistcens(salinity, NPMLE = FALSE) @ \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htb!] \centering %%% R code <>= plotdistcens(salinity, NPMLE = FALSE) @ \caption{Simple plot of censored raw data (72-hour acute salinity tolerance of riverine macro-invertebrates from the \code{salinity} data set) as ordered points and intervals.} \label{plotdistcens} \end{figure} %\subsubsection{Maximum likelihood estimation} %\label{censored:MLE} %%%%%%%%%% As for non censored data, one or more parametric distributions can be fitted to the censored data set, one at a time, but using in this case the \code{fitdistcens} function. This function estimates the vector of distribution parameters $\theta$ by maximizing the likelihood for censored data defined as: \begin{equation} \label{likelihoodC} \begin{array}{lll} L(\theta)&=&\prod_{i=1}^{N_{nonC}} f(x_{i}|\theta) \times \prod_{j=1}^{N_{leftC}} F(x^{upper}_{j}|\theta) \\ & & \times \prod_{k=1}^{N_{rightC}} (1- F(x^{lower}_{k}|\theta)) \times \prod_{m=1}^{N_{intC}} (F(x^{upper}_{m}|\theta)- F(x^{lower}_{j}|\theta)) \end{array} \end{equation} with $x_{i}$ the $N_{nonC}$ non-censored observations, $x^{upper}_{j}$ upper values defining the $N_{leftC}$ left-censored observations, $x^{lower}_{k}$ lower values defining the $N_{rightC}$ right-censored observations, $[x^{lower}_{m} ; x^{upper}_{m}]$ the intervals defining the $N_{intC}$ interval-censored observations, and F the cumulative distribution function of the parametric distribution \citep{kleinmoeschberger03,helsel05}. As \code{fitdist}, \code{fitdistcens} returns the results of the fit of any parametric distribution to a data set as an S3 class object that can be easily printed, summarized or plotted. For the \code{salinity} data set, a lognormal distribution or a loglogistic can be fitted as commonly done in ecotoxicology for such data. As with \code{fitdist}, for some distributions (see \cite{fitdistrplus} for details), it is necessary to specify initial values for the distribution parameters in the argument \code{start}. The \code{plotdistcens} function can help to find correct initial values for the distribution parameters in non trivial cases, by a manual iterative use if necessary. %%% R code <>= fsal.ln <- fitdistcens(salinity, "lnorm") fsal.ll <- fitdistcens(salinity, "llogis", start = list(shape = 5, scale = 40)) summary(fsal.ln) summary(fsal.ll) @ Computations of goodness-of-fit statistics have not yet been developed for fits using censored data but the quality of fit can be judged using Akaike and Schwarz's Bayesian information criteria (AIC and BIC) and the goodness-of-fit CDF plot, respectively provided when summarizing or plotting an object of class \code{"fitdistcens"}. Functions \code{cdfcompcens}, \code{qqcompcens} and \code{ppcompcens} can also be used to compare the fit of various distributions to the same censored data set. Their calls are similar to the ones of \code{cdfcomp}, \code{qqcomp} and \code{ppcomp}. Below are examples of use of those functions with the two fitted distributions to the \code{salinity} data set (see Figure~\ref{cdfcompcens}). When \code{qqcompcens} and \code{ppcompcens} are used with more than one fitted distribution, the non uniqueness rectangles are not filled and a small noise is added on the y-axis in order to help the visualization of various fits. But we rather recommend the use of the \code{plotstyle} \code{ggplot} of \code{qqcompcens} and \code{ppcompcens} to compare the fits of various distributions as it provides a clearer plot splitted in facets (see \code{?graphcompcens}). %%% R code <>= par(mfrow=c(2, 2)) cdfcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic ")) qqcompcens(fsal.ln, legendtext = "lognormal") ppcompcens(fsal.ln, legendtext = "lognormal") qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), main = "Q-Q plot with 2 dist.") @ \setkeys{Gin}{width=0.8\textwidth} %default \begin{figure}[htb!] \centering %%% R code <>= par(mfrow=c(2, 2)) cdfcompcens(list(fsal.ln, fsal.ll), legendtext=c("lognormal", "loglogistic ")) qqcompcens(fsal.ln, legendtext = "lognormal") ppcompcens(fsal.ln, legendtext = "lognormal") qqcompcens(list(fsal.ln, fsal.ll), legendtext = c("lognormal", "loglogistic "), main = "Q-Q plot with 2 dist.") @ \caption{Some goodness-of-fit plots for fits of a lognormal and a loglogistic distribution to censored data: LC50 values from the \code{salinity} data set.} \label{cdfcompcens} \end{figure} Function \code{bootdistcens} is the equivalent of \code{bootdist} for censored data, except that it only proposes nonparametric bootstrap. Indeed, it is not obvious to simulate censoring within a parametric bootstrap resampling procedure. The generic function \code{quantile} can also be applied to an object of class \code{"fitdistcens"} or \code{"bootdistcens"}, as for continuous non-censored data. In addition to the fit of distributions to censored or non censored continuous data, our package can also accomodate discrete variables, such as count numbers, using the functions developped for continuous non-censored data. These functions will provide somewhat different graphs and statistics, taking into account the discrete nature of the modeled variable. The discrete nature of the variable is automatically recognized when a classical distribution is fitted to data (binomial, negative binomial, geometric, hypergeometric and Poisson distributions) but must be indicated by fixing argument \code{discrete} to \code{TRUE} in the call to functions in other cases. The \code{toxocara} data set included in the package corresponds to the observation of such a discrete variable. Numbers of \emph{Toxocara cati} parasites present in digestive tract are reported from a random sampling of feral cats living on Kerguelen island \citep{Fromont01}. We will use it to illustrate the case of discrete data. %%% R code <>= data("toxocara") str(toxocara) @ The fit of a discrete distribution to discrete data by maximum likelihood estimation requires the same procedure as for continuous non-censored data. As an example, using the \code{toxocara} data set, Poisson and negative binomial distributions can be easily fitted. %%% R code <>= (ftoxo.P <- fitdist(toxocara$number, "pois")) (ftoxo.nb <- fitdist(toxocara$number, "nbinom")) @ For discrete distributions, the plot of an object of class \code{"fitdist"} simply provides two goodness-of-fit plots comparing empirical and theoretical distributions in density and in CDF. Functions \code{cdfcomp} and \code{denscomp} can also be used to compare several plots to the same data set, as follows for the previous fits (Figure~\ref{plotdiscfit}). <>= par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) @ \setkeys{Gin}{width=0.9\textwidth} %default \begin{figure}[htb] \centering <>= par(mfrow = c(1,2)) denscomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) cdfcomp(list(ftoxo.P, ftoxo.nb), legendtext = c("Poisson", "negative binomial"), fitlty = 1) @ \caption{Comparison of the fits of a negative binomial and a Poisson distribution to numbers of \emph{Toxocara cati} parasites from the \code{toxocara} data set.} \label{plotdiscfit} \end{figure} When fitting discrete distributions, the Chi-squared statistic is computed by the \code{gofstat} function using cells defined by the argument \code{chisqbreaks} or cells automatically defined from the data in order to reach roughly the same number of observations per cell. This number is roughly equal to the argument \code{meancount}, or sligthly greater if there are some ties. The choice to define cells from the empirical distribution (data), and not from the theoretical distribution, was done to enable the comparison of Chi-squared values obtained with different distributions fitted on a same data set. If arguments \code{chisqbreaks} and \code{meancount} are both omitted, \code{meancount} is fixed in order to obtain roughly $(4n)^{2/5}$ cells, with $n$ the length of the data set \citep{Vose10}. Using this default option the two previous fits are compared as follows, giving the preference to the negative binomial distribution, from both Chi-squared statistics and information criteria: %%% R code <>= gofstat(list(ftoxo.P, ftoxo.nb), fitnames = c("Poisson", "negative binomial")) @ \section{Conclusion} \label{ccl} %%%%%%%%%% The \proglang{R} package \pkg{fitdistrplus} allows to easily fit distributions. Our main objective while developing this package was to provide tools for helping \proglang{R} users to fit distributions to data. We have been encouraged to pursue our work by feedbacks from users of our package in various areas as food or environmental risk assessment, epidemiology, ecology, molecular biology, genomics, bioinformatics, hydraulics, mechanics, financial and actuarial mathematics or operations research. Indeed, this package is already used by a lot of practionners and academics for simple MLE fits \citep{jaloustreetal11,saketal11,kochetal12,marquetouxetal12, scholletal12,suuronenetal12,varoetal12,mandletal13,mala2013publi,nadarajahbakar2013,simoetal13, westphalfitch13,wayland13,vianaetal13,wu13,staggeetal13,fiorellietal13,tikoleetal13, voigtetal14}, for MLE fits and goodness-of-fit statistics \citep{tarnczi11,bagariaetal12,benavidesetal12,breitbach12,Pouillot10,vaninsky13}, for MLE fits and bootstrap \citep{croucheretal12,meheustetal12,orellanoetal12,telloetal12,hoelzeretal12, prosseretal13,Zhang2013,Rigaux2014}, for MLE fits, bootstrap and goodness-of-fit statistics \citep{larrasetal13}, for MME fit \citep{luangkesornetal12,callauetal13,satoetal13}, for censored MLE and bootstrap \citep{lehaetal11,poulliotetal12,jongenburgeretal12, commeauetal12,contrerasetal2013}, for graphic analysing in \citep{anandetal12}, for grouped-data fitting methods \citep{fusteinercostafreda12} or more generally \citep{busschaertetal10,eling12, sosaetal2013,srinivasanetal2013,meyeretal13,Guillier2013471,Daelmanetal13, eiketal13,Wu2:2013,drakeetal2014}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{fitdistrplus} package is complementary with the \pkg{distrMod} package \citep{distrModJSS}. \pkg{distrMod} provides an even more flexible way to estimate distribution parameters but its use requires a greater initial investment to learn how to manipulate the \texttt{S4} classes and methods developed in the \texttt{distr}-family packages. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Many extensions of the \pkg{fitdistrplus} package are planned in the future: we target to extend to censored data some methods for the moment only available for non-censored data, especially concerning goodness-of-fit evaluation and fitting methods. We will also enlarge the choice of fitting methods for non-censored data, by proposing new goodness-of-fit distances (e.g., distances based on quantiles) for maximum goodness-of-fit estimation and new types of moments (e.g., limited expected values) for moment matching estimation. At last, we will consider the case of multivariate distribution fitting. \section{Acknowledgments} \label{merci} %%%%%%%%%% The package would not have been at this stage without the stimulating contribution of R\'egis Pouillot and Jean-Baptiste Denis, especially for its conceptualization. We also want to thank R\'egis Pouillot for his very valuable comments on the first version of this paper. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The authors gratefully acknowledges the two anonymous referees and the Editor for useful and constructive comments. The remaining errors, of course, should be attributed to the authors alone. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \bibliographystyle{apalike} \bibliography{jssfitdistrplus} \end{document} fitdistrplus/inst/doc/Optimalgo.R0000644000176200001440000001422714124570213016613 0ustar liggesusers## ----setup, echo=FALSE, message=FALSE, warning=FALSE-------------------------- require(fitdistrplus) require(knitr) #for kable() function set.seed(12345) options(digits = 3) ## ---- echo=TRUE, eval=FALSE--------------------------------------------------- # fitbench <- function(data, distr, method, grad=NULL, control=list(trace=0, REPORT=1, maxit=1000), lower=-Inf, upper=+Inf, ...) ## ---- echo=FALSE-------------------------------------------------------------- fitbench <- fitdistrplus:::fitbench ## ----------------------------------------------------------------------------- lnL <- function(par, fix.arg, obs, ddistnam) fitdistrplus:::loglikelihood(par, fix.arg, obs, ddistnam) grlnlbeta <- fitdistrplus:::grlnlbeta ## ---- fig.height=4, fig.width=4----------------------------------------------- #(1) beta distribution n <- 200 x <- rbeta(n, 3, 3/4) grlnlbeta(c(3, 4), x) #test hist(x, prob=TRUE) lines(density(x), col="red") curve(dbeta(x, 3, 3/4), col="green", add=TRUE) legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ## ----------------------------------------------------------------------------- ctr <- list(trace=0, REPORT=1, maxit=1000) ## ----------------------------------------------------------------------------- unconstropt <- fitbench(x, "beta", "mle", grad=grlnlbeta, lower=0) ## ----------------------------------------------------------------------------- dbeta2 <- function(x, shape1, shape2, log) dbeta(x, exp(shape1), exp(shape2), log=log) #take the log of the starting values startarg <- lapply(fitdistrplus:::start.arg.default(x, "beta"), log) #redefine the gradient for the new parametrization grbetaexp <- function(par, obs, ...) grlnlbeta(exp(par), obs) * exp(par) expopt <- fitbench(x, distr="beta2", method="mle", grad=grbetaexp, start=startarg) #get back to original parametrization expopt[c("fitted shape1", "fitted shape2"), ] <- exp(expopt[c("fitted shape1", "fitted shape2"), ]) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(expopt[, grep("G-", colnames(expopt))], digits=3) ## ---- fig.width=4, fig.height=4----------------------------------------------- llsurface(min.arg=c(0.1, 0.1), max.arg=c(7, 3), plot.arg=c("shape1", "shape2"), nlev=25, plot.np=50, data=x, distr="beta", back.col = FALSE) points(unconstropt[1,"BFGS"], unconstropt[2,"BFGS"], pch="+", col="red") points(3, 3/4, pch="x", col="green") ## ---- fig.width=4, fig.height=4----------------------------------------------- b1 <- bootdist(fitdist(x, "beta", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=3, h=3/4, col="red", lwd=1.5) ## ----------------------------------------------------------------------------- grlnlNB <- function(x, obs, ...) { m <- x[1] p <- x[2] n <- length(obs) c(sum(psigamma(obs+m)) - n*psigamma(m) + n*log(p), m*n/p - sum(obs)/(1-p)) } ## ---- fig.height=4, fig.width=4----------------------------------------------- #(1) beta distribution n <- 200 trueval <- c("size"=10, "prob"=3/4, "mu"=10/3) x <- rnbinom(n, trueval["size"], trueval["prob"]) hist(x, prob=TRUE, ylim=c(0, .3)) lines(density(x), col="red") points(min(x):max(x), dnbinom(min(x):max(x), trueval["size"], trueval["prob"]), col="green") legend("topleft", lty=1, col=c("red","green"), leg=c("empirical", "theoretical")) ## ----------------------------------------------------------------------------- ctr <- list(trace=0, REPORT=1, maxit=1000) unconstropt <- fitbench(x, "nbinom", "mle", grad=grlnlNB, lower=0) unconstropt <- rbind(unconstropt, "fitted prob"=unconstropt["fitted mu",] / (1+unconstropt["fitted mu",])) ## ----------------------------------------------------------------------------- dnbinom2 <- function(x, size, prob, log) dnbinom(x, exp(size), 1/(1+exp(-prob)), log=log) #transform starting values startarg <- fitdistrplus:::start.arg.default(x, "nbinom") startarg$mu <- startarg$size / (startarg$size+startarg$mu) startarg <- list(size=log(startarg[[1]]), prob=log(startarg[[2]]/(1-startarg[[2]]))) #redefine the gradient for the new parametrization Trans <- function(x) c(exp(x[1]), plogis(x[2])) grNBexp <- function(par, obs, ...) grlnlNB(Trans(par), obs) * c(exp(par[1]), plogis(x[2])*(1-plogis(x[2]))) expopt <- fitbench(x, distr="nbinom2", method="mle", grad=grNBexp, start=startarg) #get back to original parametrization expopt[c("fitted size", "fitted prob"), ] <- apply(expopt[c("fitted size", "fitted prob"), ], 2, Trans) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(unconstropt[, grep("G-", colnames(unconstropt), invert=TRUE)], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(unconstropt[, grep("G-", colnames(unconstropt))], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(expopt[, grep("G-", colnames(expopt), invert=TRUE)], digits=3) ## ---- results='asis', echo=FALSE---------------------------------------------- kable(expopt[, grep("G-", colnames(expopt))], digits=3) ## ---- fig.width=4, fig.height=4----------------------------------------------- llsurface(min.arg=c(5, 0.3), max.arg=c(15, 1), plot.arg=c("size", "prob"), nlev=25, plot.np=50, data=x, distr="nbinom", back.col = FALSE) points(unconstropt["fitted size","BFGS"], unconstropt["fitted prob","BFGS"], pch="+", col="red") points(trueval["size"], trueval["prob"], pch="x", col="green") ## ---- fig.width=4, fig.height=4----------------------------------------------- b1 <- bootdist(fitdist(x, "nbinom", method="mle", optim.method="BFGS"), niter=100, parallel="snow", ncpus=2) summary(b1) plot(b1) abline(v=trueval["size"], h=trueval["mu"], col="red", lwd=1.5) fitdistrplus/inst/doc/Optimalgo.html0000644000176200001440000106552614124570213017367 0ustar liggesusers Which optimization algorithm to choose?

Which optimization algorithm to choose?

Marie Laure Delignette Muller, Christophe Dutang

2021-09-28

1 Quick overview of main optimization methods

We present very quickly the main optimization methods. Please refer to Numerical Optimization (Nocedal & Wright, 2006) or Numerical Optimization: theoretical and practical aspects (Bonnans, Gilbert, Lemarechal & Sagastizabal, 2006) for a good introduction. We consider the following problem \(\min_x f(x)\) for \(x\in\mathbb{R}^n\).

1.1 Derivative-free optimization methods

The Nelder-Mead method is one of the most well known derivative-free methods that use only values of \(f\) to search for the minimum. It consists in building a simplex of \(n+1\) points and moving/shrinking this simplex into the good direction.

  1. set initial points \(x_1, \dots, x_{n+1}\).
  2. order points such that \(f(x_1)\leq f(x_2)\leq\dots\leq f(x_{n+1})\).
  3. compute \(x_o\) as the centroid of \(x_1, \dots, x_{n}\).
  4. Reflection:
    • compute the reflected point \(x_r = x_o + \alpha(x_o-x_{n+1})\).
    • if \(f(x_1)\leq f(x_r)<f(x_n)\), then replace \(x_{n+1}\) by \(x_r\), go to step 2.
    • else go step 5.
  5. Expansion:
    • if \(f(x_r)<f(x_1)\), then compute the expansion point \(x_e= x_o+\gamma(x_o-x_{n+1})\).
    • if \(f(x_e) <f(x_r)\), then replace \(x_{n+1}\) by \(x_e\), go to step 2.
    • else \(x_{n+1}\) by \(x_r\), go to step 2.
    • else go to step 6.
  6. Contraction:
    • compute the contracted point \(x_c = x_o + \beta(x_o-x_{n+1})\).
    • if \(f(x_c)<f(x_{n+1})\), then replace \(x_{n+1}\) by \(x_c\), go to step 2.
    • else go step 7.
  7. Reduction:
    • for \(i=2,\dots, n+1\), compute \(x_i = x_1+\sigma(x_i-x_{1})\).

The Nelder-Mead method is available in optim. By default, in optim, \(\alpha=1\), \(\beta=1/2\), \(\gamma=2\) and \(\sigma=1/2\).

1.2 Hessian-free optimization methods

For smooth non-linear function, the following method is generally used: a local method combined with line search work on the scheme \(x_{k+1} =x_k + t_k d_{k}\), where the local method will specify the direction \(d_k\) and the line search will specify the step size \(t_k \in \mathbb{R}\).

1.2.1 Computing the direction \(d_k\)

A desirable property for \(d_k\) is that \(d_k\) ensures a descent \(f(x_{k+1}) < f(x_{k})\). Newton methods are such that \(d_k\) minimizes a local quadratic approximation of \(f\) based on a Taylor expansion, that is \(q_f(d) = f(x_k) + g(x_k)^Td +\frac{1}{2} d^T H(x_k) d\) where \(g\) denotes the gradient and \(H\) denotes the Hessian.

The consists in using the exact solution of local minimization problem \(d_k = - H(x_k)^{-1} g(x_k)\).
In practice, other methods are preferred (at least to ensure positive definiteness). The method approximates the Hessian by a matrix \(H_k\) as a function of \(H_{k-1}\), \(x_k\), \(f(x_k)\) and then \(d_k\) solves the system \(H_k d = - g(x_k)\). Some implementation may also directly approximate the inverse of the Hessian \(W_k\) in order to compute \(d_k = -W_k g(x_k)\). Using the Sherman-Morrison-Woodbury formula, we can switch between \(W_k\) and \(H_k\).

To determine \(W_k\), first it must verify the secant equation \(H_k y_k =s_k\) or \(y_k=W_k s_k\) where \(y_k = g_{k+1}-g_k\) and \(s_k=x_{k+1}-x_k\). To define the \(n(n-1)\) terms, we generally impose a symmetry and a minimum distance conditions. We say we have a rank 2 update if \(H_k = H_{k-1} + a u u^T + b v v^T\) and a rank 1 update if $H_k = H_{k-1} + a u u^T $. Rank \(n\) update is justified by the spectral decomposition theorem.

There are two rank-2 updates which are symmetric and preserve positive definiteness

  • DFP minimizes \(\min || H - H_k ||_F\) such that \(H=H^T\): \[ H_{k+1} = \left (I-\frac {y_k s_k^T} {y_k^T s_k} \right ) H_k \left (I-\frac {s_k y_k^T} {y_k^T s_k} \right )+\frac{y_k y_k^T} {y_k^T s_k} \Leftrightarrow W_{k+1} = W_k + \frac{s_k s_k^T}{y_k^{T} s_k} - \frac {W_k y_k y_k^T W_k^T} {y_k^T W_k y_k} . \]
  • BFGS minimizes \(\min || W - W_k ||_F\) such that \(W=W^T\): \[ H_{k+1} = H_k - \frac{ H_k y_k y_k^T H_k }{ y_k^T H_k y_k } + \frac{ s_k s_k^T }{ y_k^T s_k } \Leftrightarrow W_{k+1} = \left (I-\frac {y_k s_k^T} {y_k^T s_k} \right )^T W_k \left (I-\frac { y_k s_k^T} {y_k^T s_k} \right )+\frac{s_k s_k^T} {y_k^T s_k} . \]

In R, the so-called BFGS scheme is implemented in optim.

Another possible method (which is initially arised from quadratic problems) is the nonlinear conjugate gradients. This consists in computing directions \((d_0, \dots, d_k)\) that are conjugate with respect to a matrix close to the true Hessian \(H(x_k)\). Directions are computed iteratively by \(d_k = -g(x_k) + \beta_k d_{k-1}\) for \(k>1\), once initiated by \(d_1 = -g(x_1)\). \(\beta_k\) are updated according a scheme:

  • \(\beta_k = \frac{ g_k^T g_k}{g_{k-1}^T g_{k-1} }\): Fletcher-Reeves update,
  • \(\beta_k = \frac{ g_k^T (g_k-g_{k-1} )}{g_{k-1}^T g_{k-1}}\): Polak-Ribiere update.

There exists also three-term formula for computing direction \(d_k = -g(x_k) + \beta_k d_{k-1}+\gamma_{k} d_t\) for \(t<k\). A possible scheme is the Beale-Sorenson update defined as \(\beta_k = \frac{ g_k^T (g_k-g_{k-1} )}{d^T_{k-1}(g_{k}- g_{k-1})}\) and \(\gamma_k = \frac{ g_k^T (g_{t+1}-g_{t} )}{d^T_{t}(g_{t+1}- g_{t})}\) if \(k>t+1\) otherwise \(\gamma_k=0\) if \(k=t\). See Yuan (2006) for other well-known schemes such as Hestenses-Stiefel, Dixon or Conjugate-Descent. The three updates (Fletcher-Reeves, Polak-Ribiere, Beale-Sorenson) of the (non-linear) conjugate gradient are available in optim.

1.2.2 Computing the stepsize \(t_k\)

Let \(\phi_k(t) = f(x_k + t d_k)\) for a given direction/iterate \((d_k, x_k)\). We need to find conditions to find a satisfactory stepsize \(t_k\). In literature, we consider the descent condition: \(\phi_k'(0) < 0\) and the Armijo condition: \(\phi_k(t) \leq \phi_k(0) + t c_1 \phi_k'(0)\) ensures a decrease of \(f\). Nocedal & Wright (2006) presents a backtracking (or geometric) approach satisfying the Armijo condition and minimal condition, i.e. Goldstein and Price condition.

  • set \(t_{k,0}\) e.g. 1, \(0 < \alpha < 1\),
  • Repeat until Armijo satisfied,
    • \(t_{k,i+1} = \alpha \times t_{k,i}\).
  • end Repeat

This backtracking linesearch is available in optim.

1.3 Benchmark

To simplify the benchmark of optimization methods, we create a fitbench function that computes the desired estimation method for all optimization methods. This function is currently not exported in the package.

2 Numerical illustration with the beta distribution

2.1 Log-likelihood function and its gradient for beta distribution

2.1.1 Theoretical value

The density of the beta distribution is given by \[ f(x; \delta_1,\delta_2) = \frac{x^{\delta_1-1}(1-x)^{\delta_2-1}}{\beta(\delta_1,\delta_2)}, \] where \(\beta\) denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. We recall that \(\beta(a,b)=\Gamma(a)\Gamma(b)/\Gamma(a+b)\). There the log-likelihood for a set of observations \((x_1,\dots,x_n)\) is \[ \log L(\delta_1,\delta_2) = (\delta_1-1)\sum_{i=1}^n\log(x_i)+ (\delta_2-1)\sum_{i=1}^n\log(1-x_i)+ n \log(\beta(\delta_1,\delta_2)) \] The gradient with respect to \(a\) and \(b\) is \[ \nabla \log L(\delta_1,\delta_2) = \left(\begin{matrix} \sum\limits_{i=1}^n\ln(x_i) - n\psi(\delta_1)+n\psi( \delta_1+\delta_2) \\ \sum\limits_{i=1}^n\ln(1-x_i)- n\psi(\delta_2)+n\psi( \delta_1+\delta_2) \end{matrix}\right), \] where \(\psi(x)=\Gamma'(x)/\Gamma(x)\) is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/.

2.1.2 R implementation

As in the fitdistrplus package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in grlnL. Both the log-likelihood and its gradient are not exported.

2.3 Fit Beta distribution

Define control parameters.

Call mledist with the default optimization function (optim implemented in stats package) with and without the gradient for the different optimization methods.

##     BFGS       NM     CGFR     CGPR     CGBS L-BFGS-B     NM-B   G-BFGS 
##       13       13       13       13       13       13       13       13 
##   G-CGFR   G-CGPR   G-CGBS G-BFGS-B   G-NM-B G-CGFR-B G-CGPR-B G-CGBS-B 
##       13       13       13       13       13       13       13       13

In the case of constrained optimization, mledist permits the direct use of constrOptim function (still implemented in stats package) that allow linear inequality constraints by using a logarithmic barrier.

Use a exp/log transformation of the shape parameters \(\delta_1\) and \(\delta_2\) to ensure that the shape parameters are strictly positive.

##   BFGS     NM   CGFR   CGPR   CGBS G-BFGS G-CGFR G-CGPR G-CGBS 
##     13     13     13     13     13     13     13     13     13

Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one).

2.4 Results of the numerical investigation

Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (-B stands for bounded version), (2) the original parametrization with the (true) gradient (-B stands for bounded version and -G for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (-G stands for gradient).

BFGS NM CGFR CGPR CGBS L-BFGS-B NM-B
fitted shape1 2.665 2.664 2.665 2.665 2.665 2.665 2.665
fitted shape2 0.731 0.731 0.731 0.731 0.731 0.731 0.731
fitted loglik 114.165 114.165 114.165 114.165 114.165 114.165 114.165
func. eval. nb. 23.000 47.000 211.000 263.000 183.000 11.000 47.000
grad. eval. nb. 5.000 NA 53.000 69.000 47.000 11.000 NA
time (sec) 0.004 0.004 0.023 0.029 0.020 0.004 0.006
G-BFGS G-CGFR G-CGPR G-CGBS G-BFGS-B G-NM-B G-CGFR-B G-CGPR-B G-CGBS-B
fitted shape1 2.665 2.665 2.665 2.665 2.665 2.665 2.665 2.665 2.665
fitted shape2 0.731 0.731 0.731 0.731 0.731 0.731 0.731 0.731 0.731
fitted loglik 114.165 114.165 114.165 114.165 114.165 114.165 114.165 114.165 114.165
func. eval. nb. 20.000 249.000 225.000 138.000 25.000 47.000 263.000 188.000 176.000
grad. eval. nb. 5.000 71.000 69.000 43.000 5.000 NA 69.000 59.000 47.000
time (sec) 0.009 0.071 0.068 0.043 0.013 0.012 0.081 0.072 0.061
BFGS NM CGFR CGPR CGBS
fitted shape1 2.665 2.664 2.665 2.665 2.665
fitted shape2 0.731 0.731 0.731 0.731 0.731
fitted loglik 114.165 114.165 114.165 114.165 114.165
func. eval. nb. 18.000 41.000 131.000 116.000 134.000
grad. eval. nb. 5.000 NA 27.000 29.000 35.000
time (sec) 0.004 0.004 0.014 0.014 0.016
G-BFGS G-CGFR G-CGPR G-CGBS
fitted shape1 2.665 2.665 2.665 2.665
fitted shape2 0.731 0.731 0.731 0.731
fitted loglik 114.165 114.165 114.165 114.165
func. eval. nb. 20.000 175.000 125.000 112.000
grad. eval. nb. 5.000 39.000 41.000 35.000
time (sec) 0.010 0.042 0.041 0.037

Using llsurface, we plot the log-likehood surface around the true value (green) and the fitted parameters (red).

## Warning in plot.window(xlim, ylim, ...): "plot.np" n'est pas un paramètre
## graphique
## Warning in title(...): "plot.np" n'est pas un paramètre graphique
## Warning in axis(side = side, at = at, labels = labels, ...): "plot.np" n'est pas
## un paramètre graphique

## Warning in axis(side = side, at = at, labels = labels, ...): "plot.np" n'est pas
## un paramètre graphique
## Warning in box(...): "plot.np" n'est pas un paramètre graphique

We can simulate bootstrap replicates using the bootdist function.

## Parametric bootstrap medians and 95% percentile CI 
##        Median  2.5% 97.5%
## shape1   2.73 2.272 3.283
## shape2   0.75 0.652 0.888

3 Numerical illustration with the negative binomial distribution

3.1 Log-likelihood function and its gradient for negative binomial distribution

3.1.1 Theoretical value

The p.m.f. of the Negative binomial distribution is given by \[ f(x; m,p) = \frac{\Gamma(x+m)}{\Gamma(m)x!} p^m (1-p)^x, \] where \(\Gamma\) denotes the beta function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/. There exists an alternative representation where \(\mu=m (1-p)/p\) or equivalently \(p=m/(m+\mu)\). Thus, the log-likelihood for a set of observations \((x_1,\dots,x_n)\) is \[ \log L(m,p) = \sum_{i=1}^{n} \log\Gamma(x_i+m) -n\log\Gamma(m) -\sum_{i=1}^{n} \log(x_i!) + mn\log(p) +\sum_{i=1}^{n} {x_i}\log(1-p) \] The gradient with respect to \(m\) and \(p\) is \[ \nabla \log L(m,p) = \left(\begin{matrix} \sum_{i=1}^{n} \psi(x_i+m) -n \psi(m) + n\log(p) \\ mn/p -\sum_{i=1}^{n} {x_i}/(1-p) \end{matrix}\right), \] where \(\psi(x)=\Gamma'(x)/\Gamma(x)\) is the digamma function, see the NIST Handbook of mathematical functions https://dlmf.nist.gov/.

3.1.2 R implementation

As in the fitdistrplus package, we minimize the opposite of the log-likelihood: we implement the opposite of the gradient in grlnL.

3.3 Fit a negative binomial distribution

Define control parameters and make the benchmark.

##     BFGS       NM     CGFR     CGPR     CGBS L-BFGS-B     NM-B   G-BFGS 
##       13       13       13       13       13       13       13       13 
##   G-CGFR   G-CGPR   G-CGBS G-BFGS-B   G-NM-B G-CGFR-B G-CGPR-B G-CGBS-B 
##       13       13       13       13       13       13       13       13

In the case of constrained optimization, mledist permits the direct use of constrOptim function (still implemented in stats package) that allow linear inequality constraints by using a logarithmic barrier.

Use a exp/log transformation of the shape parameters \(\delta_1\) and \(\delta_2\) to ensure that the shape parameters are strictly positive.

##   BFGS     NM   CGFR   CGPR   CGBS G-BFGS G-CGFR G-CGPR G-CGBS 
##     13     13     13     13     13     13     13     13     13

Then we extract the values of the fitted parameters, the value of the corresponding log-likelihood and the number of counts to the function to minimize and its gradient (whether it is the theoretical gradient or the numerically approximated one).

3.4 Results of the numerical investigation

Results are displayed in the following tables: (1) the original parametrization without specifying the gradient (-B stands for bounded version), (2) the original parametrization with the (true) gradient (-B stands for bounded version and -G for gradient), (3) the log-transformed parametrization without specifying the gradient, (4) the log-transformed parametrization with the (true) gradient (-G stands for gradient).

BFGS NM CGFR CGPR CGBS L-BFGS-B NM-B
fitted size 61.944 68.138 61.969 62.475 62.878 61.944 67.397
fitted mu 3.425 3.425 3.425 3.425 3.425 3.425 3.425
fitted loglik -401.612 -401.611 -401.612 -401.612 -401.612 -401.612 -401.611
func. eval. nb. 2.000 37.000 2999.000 2663.000 2610.000 2.000 0.000
grad. eval. nb. 1.000 NA 1001.000 1001.000 1001.000 2.000 NA
time (sec) 0.001 0.002 0.220 0.223 0.219 0.001 0.002
fitted prob 0.774 0.774 0.774 0.774 0.774 0.774 0.774
G-BFGS G-CGFR G-CGPR G-CGBS G-BFGS-B G-NM-B G-CGFR-B G-CGPR-B G-CGBS-B
fitted size 61.944 61.944 61.944 61.944 61.944 67.397 61.944 61.944 61.944
fitted mu 3.425 3.425 3.425 3.425 3.425 3.425 3.425 3.425 3.425
fitted loglik -401.612 -401.612 -401.612 -401.612 -401.612 -401.611 -401.612 -401.612 -401.612
func. eval. nb. 26.000 233.000 174.000 233.000 0.000 0.000 0.000 0.000 0.000
grad. eval. nb. 1.000 15.000 11.000 15.000 NA NA NA NA NA
time (sec) 0.008 0.009 0.008 0.010 0.002 0.002 0.010 0.007 0.009
fitted prob 0.774 0.774 0.774 0.774 0.774 0.774 0.774 0.774 0.774
BFGS NM CGFR CGPR CGBS
fitted size 61.946 67.787 63.450 67.940 67.885
fitted prob 0.948 0.952 0.949 0.952 0.952
fitted loglik -401.612 -401.611 -401.612 -401.611 -401.611
func. eval. nb. 6.000 47.000 4001.000 3728.000 327.000
grad. eval. nb. 1.000 NA 1001.000 1001.000 87.000
time (sec) 0.003 0.002 0.276 0.211 0.020
G-BFGS G-CGFR G-CGPR G-CGBS
fitted size 61.944 61.944 61.944 61.944
fitted prob 0.948 0.948 0.948 0.948
fitted loglik -401.612 -401.612 -401.612 -401.612
func. eval. nb. 21.000 43.000 42.000 42.000
grad. eval. nb. 1.000 3.000 3.000 3.000
time (sec) 0.006 0.002 0.002 0.002

Using llsurface, we plot the log-likehood surface around the true value (green) and the fitted parameters (red).

## Warning in plot.window(xlim, ylim, ...): "plot.np" n'est pas un paramètre
## graphique
## Warning in title(...): "plot.np" n'est pas un paramètre graphique
## Warning in axis(side = side, at = at, labels = labels, ...): "plot.np" n'est pas
## un paramètre graphique

## Warning in axis(side = side, at = at, labels = labels, ...): "plot.np" n'est pas
## un paramètre graphique
## Warning in box(...): "plot.np" n'est pas un paramètre graphique

We can simulate bootstrap replicates using the bootdist function.

## Parametric bootstrap medians and 95% percentile CI 
##      Median  2.5%  97.5%
## size  61.95 11.05 118.32
## mu     3.43  3.17   3.72
## 
## The estimation method converged only for 76 among 100 iterations

4 Conclusion

Based on the two previous examples, we observe that all methods converge to the same point. This is rassuring.
However, the number of function evaluations (and the gradient evaluations) is very different from a method to another. Furthermore, specifying the true gradient of the log-likelihood does not help at all the fitting procedure and generally slows down the convergence. Generally, the best method is the standard BFGS method or the BFGS method with the exponential transformation of the parameters. Since the exponential function is differentiable, the asymptotic properties are still preserved (by the Delta method) but for finite-sample this may produce a small bias.

fitdistrplus/inst/CITATION0000644000176200001440000000162314124567536015137 0ustar liggesuserscitHeader("To cite fitdistrplus in publications use:") citEntry(entry = "Article", title = "{fitdistrplus}: An {R} Package for Fitting Distributions", author = personList(as.person("Marie Laure Delignette-Muller"), as.person("Christophe Dutang")), journal = "Journal of Statistical Software", year = "2015", volume = "64", number = "4", pages = "1--34", url = "https://www.jstatsoft.org/article/view/v064i04", textVersion = paste("Marie Laure Delignette-Muller, Christophe Dutang (2015).", "fitdistrplus: An R Package for Fitting Distributions.", "Journal of Statistical Software, 64(4), 1-34.", "URL https://www.jstatsoft.org/article/view/v064i04.") ) citFooter("Please cite both the package and R when using them for data analysis.", "See also", sQuote("citation()"), "for citing R.") fitdistrplus/inst/NEWS0000644000176200001440000003256614102202755014474 0ustar liggesusers==== fitdistrplus : Help to fit of a parametric distribution ==== Version 1.1-6 ============= NEW FEATURES - new function Surv2fitdistcens() to format data for use in fitdistcens() from a format used in the survival package - new dataset fremale in order to illustrate Surv2fitdistcens() - support the use of ggplot2 for CIcdfplot - add the taxon names to the endosulfan dataset - new argument name.points in cdfcomp and CIcdfplot to add labels next to points Version 1.1-4/5 ============= WARNING FIX - reduce testing times in test files Version 1.1-3 ============= NEW FEATURE - take into account fix.arg for uniform distribution BUG FIXES - add the loglikelihood value for uniform distribution (in mledist()) - correct usage of triple dots argument in llsurface() - fix an error in ppcomp() and qqcomp() raised for large dataset Version 1.1-1 ============= NEW FEATURES - add of internal functions to cope with problems of lack of maintenance of the package npsurv and remove the dependence to this package - remove of the deprecated argument Turnbull of plotdistcens() Version 1.0-14 ============= NEW FEATURES - add a new estimation method called maximum spacing estimation via msedist() Version 1.0-13 ============= BUG FIXES - fix issues coming from the noLD (--disable-long-double) configuration of R Version 1.0-12 ============= BUG FIXES - bug fixed in qmedist() and fitdistcens() which raised an error in checkparamlist(). - bug fixed in testdpqfun() which assumes the first argument of d,p,q,r functions are exactly the same as in base R. Version 1.0-11 ============= NEW FEATURES - update the FAQ with beta(a,a). - improve graphics for discrete distributions in denscomp(). - improve automatic naming of legends in xxxcomp(). - harmonize outputs in mledist(), qmedist(), mmedist(), mgedist(), fitdist() and fitdistcens(). - automatic test of d, p, q functions in fitdist() and raise warnings. - improve test for starting and fixed values. - add new default starting values for distributions in actuar. - change of the default CDF plot for censored data, using the Wang NPMLE algorithm provided in the package npsurv (in plotdistcens() and cdfcompcens()) - add of two new goodness-of-fit plots (QQ-plot and PP-plot) for censored data (cf. plotdistcens, qqcompcens and ppcompcens). - add of a part dedicated to censored datain the FAQ vignette. - homogeneization of xlim and ylim default definition in plotdistcens. - Removing of the name of the first argument in calls to dpq functions in order to make the package compatible with distributions defined with a non classical name for their first argument (resp. x, q, p for d, p, q functions). - add the possibility to change the title of the CDF plot in plotdistcens() using the argument main. - support the use of ggplot2 for cdfcompcens, qqcompcens, ppcompcens. BUG FIXES - bug fixed concerning the use of gofstat with a chi squared df <=0 (error message blocking the other functions) - bug fix in mledist() when bounds were set (so not NULL) for censored MLE - enable a correct use of non-equidistant breaks in denscomp for the histogram when plotstyle = "ggplot", and prohibit the use of non-equidistant breaks with probability = FALSE (adding a stop in this case). Version 1.0-9 ============= - update the FAQ with linear inequality constraints. Version 1.0-8 ============= NEW FEATURES - support the use of ggplot2 for cdfcomp, denscomp, qqcomp, ppcomp. BUG FIXES - correct legend for qqcomp and ppomp on large data. - correct weights in mmedist. - correct the name Akaike in gofstat. - correct the use of trueval in plot.bootdist. - correct the vignette on truncate (inflated) distributions. Version 1.0-7 ============= NEW FEATURES - keep the JSS vignette as a pdf. - start the FAQ vignette and add datasets (?dataFAQ) for it. - provide likelihood plot/surface/curve: llplot, llcurve, llsurface. - provide parallelization of bootstrap in bootdist and bootdistcens. - provide graphic of (e)cdf with bootstraped confidence interval/area: CIcdfplot. - allow the use of constrOptim() in mledist, mmedist, mgedist, qmedist functions. - add a possible pre-fitting procedure: prefit. BUG FIXES - add invisible() for all graphical functions. - bug fixed concerning the use of weights on censored data. Version 1.0-6 ============= BUG FIXES - automatic definition of starting values for distributions "llogis" and "invweibull" is now working. Version 1.0-5 ============= NEW FEATURES - update starting/fixing values in mledist, mmedist, mgedist, qmedist functions. - update graphics for bootstrap procedure. - add argument do.points in cdfcomp. - add argument weights in mledist, qmedist, mmedist, fitdist, fitdistcens. - add argument keepdata in fitdist, fitdistcens. - suppress warnings/errors in fitdist(cens), bootdist(cens). BUG FIXES - defensive programming in plotdist, cdfcomp,... - simplify plotting curves in cdfcomp where seq(xmin, xmax, by=1) was used. Version 1.0-4 ============= - release for the JSS publication. Version 1.0-3 ============= NEW FEATURES - new generic functions for fitdist(cens): loglik, vcov and coef. - vignette updated to the version of a paper accepted by the Journal of Statistical Software. - add of an argument discrete in fitdist in order to be able to take into account non classical discrete distributions while plotting the fit with plot.fitdist or cdfcomp and while calculating goodness-of-fit statistics with gofstat (add of an example : fit of a zero inflate Poisson distribution). - add of an S3 class for descdist and a print method. BUG FIXES - fitdist can handle non invertible Hessian matrices. Version 1.0-2 ============= NEW FEATURES - plotdist can plot empirical density as an histogram, a density plot or both superimposed. - a strong warning was added to the documentation of function descdist about the problematic high variance of skewness and kurtosis. BUG FIXES - bug fixed in bootdistcens : argument fix.arg is now correctly passed to mle. Version 1.0-1 ============= NEW FEATURES - gofstat can handle multiple 'fitdist' objects. - plotdist for discrete data is slightly enhanced. Version 1.0-0 ============= NEW FEATURES - update cdfcomp and add denscomp, ppcomp and qqcomp functions. - add of an argument Turnbull.confint to functions plotdistcens and cdfcompcens in order to draw confidence intervals on the empirical distribution only if requested. - ppoints now used in "fitdist" for QQ plot, PP plot and cdf plot for continuous data (was used only for QQ plot in previous versions) to enable Blom type plotting position (using by default Hazen plotting position than can be chanfge using arguments use.ppoints and a.ppoints) - many changes in the examples given in the reference manual. - the vignette was removed, to be transformed in a paper that we will soon submit to a journal. - add of four data sets : fluazinam, salinity, danishuni and danishmulti. - add of functions to calculate quantiles of the fitted distribution, with 95 percent CI calculated by bootstrap : quantile generic function is available both for "fitdist" and "bootdist" objects and quantile generic function is available both for "fitdistcens" and "bootdistcens" objects. BUG FIXES - correction the formula for the CvM test for Weibull distribution. - elimination of CvM and AD tests for normal, lognormal and logistic distributions : formulas previously used (given by Stephens 1986) do not use exactly MLE estimates and thus results were only approximates. - make arguments xlim and ylim functional in cdfcompcens. - bug fix in the closed formula in mmedist for lognormal distributions. Version 0.3-4 ============= NEW FEATURES - posibility to fix xlegend to a keyword (e.g. "bottomright") in "cdfcomp" and "cdfcompdens". - improvement of the new vignette. BUG FIXES - correction of the NAMESPACE file in order to enable the correct print of a summary of a fitdistcens object (with the correlation matrix, the loglikelihood and AIC and BIC statistics). Version 0.3-3 ============= NEW FEATURES - a new function ("cdfcompcens") to plot cumulative distributions corresponding to various fits using a same censored data set. - add an example with scaling problem in man pages. Version 0.3-2 ============= NEW FEATURES - new plot of the empirical cdf curve in plotdistcens, using the Turnbull algorithm by a call to function survfit{survival}. - new arguments to function "cdfcomp" : verticals, horizontals and xlim. Version 0.3-1 ============= NEW FEATURES - add of a draft of a new version of the vignette. Version 0.3-0 ============= NEW FEATURES - a new function ("cdfcomp") to plot cumulative distributions corresponding to various fits using a same non censored data set. - add of two data sets : "endosulfan" and "toxocara". Version 0.2-2 ============= BUG FIXES - elimination of NON-ASCII characters in the vignette. Version 0.2-1 ============= NEW FEATURES - a new fitting method was implemented for continuous distributions : the maximum goodness-of-fit estimation (function "mgedist") (for the moment only available for non censored data). Version 0.1-5 ============= NEW FEATURES - a new goodness-of-fit statistic was added in gofstat, with corresponding test : the Cramer-von Mises distance. - a new fitting method has been implemented : the quantile matching estimation (function "qmedist"). For the moment, only available for non censored data. - the moment matching estimation has been extended (in function mmedist) to enable numerical matching when closed formula are not available. BUG FIXES - correction of a bug inserted while adding the argument "fix.arg" which prevent the print of the results of goodness-of-fit tests. Version 0.1-4 ============= NEW FEATURES - a component named dots added to the list returned by fitdist and fitdistcens in order to pass optional arguments for the control of optimization in mledist to bootdist and bootdistcens. bootdist and bootdistcens changed to take into account these optional arguments if they are defined in the call to fitdist or fitdistcens. - an argument added to fitdist, fitdistcens and mledist, named fix.arg, and giving the possibility to fix some of the distribution parameters while maximizing the likelihood. Functions bootdist, bootdistcens and gofstat were also changed in order to take this new argument into account. - a new data file of bacterial contamination censored data extracted from Busschaert et al. 2000 and examples corresponding to analysis of this dataset. BUG FIXES - correction of a bug in the print and the plot of bootstraped samples using bootdist or bootdistcens when there was only one parameter estimated by maximum likelihood. Version 0.1-3 ============= NEW FEATURES - new data file "groundbeef" (groundbeef.rda and groundbeef.Rd) and new use of this dataset in some examples. - new function gofstat. Goodness-of-fit statistics are no more computed by fitdist but may computed and printed by the use of the function gofstat. In this new function, the whole results computed are not printed : results of tests are printed only if the argument print.test==TRUE and for continuous distributions only Anderson-Darling and Kolomogorov-Smirnov statistics are printed by default (but complete results are returned by gofstat). - modifications in descdist : three arguments were added in descdist 1/ method, to choose between unbiased estimations of standard deviation, skewness and kurtosis (default choice) and sample values. 2/ obs.col to choose the color used to plot the observed point on the graph. 3/ boot.col to choose the color used to plot the bootstrap sample of points on the graph. - modifications in plotfit : minor changes were performed in order to facilitate the use of the argument ... to personnalize the plots (see examples in plotdist.Rd) - modication of the vignette BUG FIXES - correction of a bug in plotdist due to the redefinition in the previous version of the parameter "ylim" for the plot of a histogram with theoretical density function (there was a problem with infinite values of theoretical density function). Version 0.1-2 ============= NEW FEATURES - deletion of mledistcens and modification of mledist in order to maximize likelihood for both censored and non censored data. - possibility to choose the optimization method used for maximum likelihood estimation (MLE) of distribution parameters using the new argument "optim.method" of mledist. - possibility to specify contraints on distribution parameters using the new arguments "lower" and "upper" of mledist. - possibility to use a custom optimization function for MLE using the new argument "custom.optim". - moment matching estimation is no longer done with argument method set to "mom" but set to "mme" in fitdist. - renaming of momdist in mmedist. - calculation of AIC and BIC criterion after maximum likelihood estimation of distribution parameters - change of the default number of iterations from 999 to 1001 for bootstrap in order to avoid interpolation using the quantile function - use of the argument "log" and (resp. "log.p") of density (resp. distribution) when available to compute the loglikelihood. BUG FIXES - omitting the name of the first argument in calls to the density function during maximization of the likelihood in order to enable the use of a density function defined with a first parameter (the vector of quantiles) with a name differing from "x" (classical name for density distributions defined in R), such as the density function dexGAUS from the package gamlss.dist. Version 0.1-1 ============= - Initial release.