sn/0000755000176200001440000000000013205415137010673 5ustar liggesuserssn/inst/0000755000176200001440000000000013205231511011640 5ustar liggesuserssn/inst/CITATION0000644000176200001440000000160313112344150012776 0ustar liggesuserscitHeader("To cite the 'sn' package in publications use:") if(!exists("meta") || is.null(meta)) meta <- packageDescription("sn") citEntry(entry="manual", title = paste("The {R} package \\texttt{sn}: ", "The Skew-Normal and Related Distributions such as the Skew-$t$ (version ", meta$Version, ").", sep=""), author = personList(as.person("A. Azzalini")), address = "Universit\\`a di Padova, Italia", year = substr(meta$Date, 1, 4), url = "http://azzalini.stat.unipd.it/SN", textVersion = paste("Azzalini, A. (", substr(meta$Date, 1, 4), "). ", "The R package 'sn': The Skew-Normal and Related Distributions such as the Skew-t", " (version ", meta$Version, "). ", "URL http://azzalini.stat.unipd.it/SN", sep="") ) sn/inst/doc/0000755000176200001440000000000013205231511012405 5ustar liggesuserssn/inst/doc/R.css0000644000176200001440000000244713053257662013347 0ustar liggesusersbody { background: white; color: black; } a:link { background: white; color: blue; } a:visited { background: white; color: rgb(50%, 0%, 50%); } h1 { background: white; color: rgb(55%, 55%, 55%); font-family: monospace; font-size: x-large; text-align: center; } h2 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-size: large; text-align: center; } h3 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-size: large; } h4 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-style: italic; font-size: large; } h5 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; } h6 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-style: italic; } img.toplogo { vertical-align: middle; } img.arrow { width: 30px; height: 30px; border: 0; } span.acronym { font-size: small; } span.env { font-family: monospace; } span.file { font-family: monospace; } span.option{ font-family: monospace; } span.pkg { font-weight: bold; } span.samp{ font-family: monospace; } div.vignettes a:hover { background: rgb(85%, 85%, 85%); } sn/inst/doc/pkg-overview.html0000644000176200001440000002017313053260711015730 0ustar liggesusersR: Package 'sn': overview of the structure and the main commands
R computing environmentR Documentation

Package sn: overview of the package structure and commands

Description

The package provides facilities to build and manipulate probability distributions of the skew-normal and some related families, notably the skew-t family, and makes available related statistical methods for data fitting and model diagnostics, in the univariate and the multivariate case.

The package comprises two main sides; one side provides facilities for the pertaining probability distributions, the other one makes available statistical methods dealing with these distributions.

Underlying formulation, parameterizations of distributions and terminology are in agreement with the monograph of Azzalini and Capitanio (2014).

The present document refers to version 1.5-0 of the package (2017-02-09).

Probability side

There are two layers of support for the probability distributions of interest. At the basic level, there exist functions which follow the classical R scheme for distributions. In addition, there exists facilities to build an object which incapsulates a probability distribution and then certain operations can be be performed on such an object. These two schemes are described next.

Classical R scheme

The following functions work similary to {d,p,q,r}norm and other R functions for probability distributions:

In addition to the usual specification of their parameters as a sequence of individual components, a parameter set can be specified as a single dp entity, namely a vector in the univariate case, a list in the multivariate case; dp stands for ‘Direct Parameters’ (DP).

Conversion from the dp parameter set to the corresponding Centered Parameters (CP) can be accomplished using the function dp2cp, while function cp2dp performs the inverse transformation.

In addition, one can introduce a user-specified density function using dSymmModulated and dmSymmModulated, in the univariate and the multivariate case, respectively. These densities are of the ‘symmetry-modulated’ type, also called ‘skew-symmetric’, where one can specify the base density and the modulation factor with high degree of flexibility. Random numbers can be sampled using the corresponding functions rSymmModulated and rmSymmModulated. In the bivariate case, a dedicated plotting function exists.

SEC distribution objects

Function makeSECdistr can be used to build a ‘SEC distribution’ object representing a member of a specified parametric family (among the types SN, ESN, ST, SC) with a given dp parameter set. This object can be used for various operations such as plotting or extraction of moments and other summary quantities. Another way of constructing a SEC distribution object is via extractSECdistr which extracts suitable components of an object produced by function selm to be described below.

Additional operations on these objects are possible in the multivariate case, namely marginalSECdistr for marginalization and marginalSECdistr for affine trasformations. For the multivariate SN family only, marginalSECdistr performs a conditioning on the values taken on by some components of the multivariate variable.

Statistics side

The main function for data fitting is represented by selm, which allows to specify a linear regression model for the location parameter, similarly to function lm, but assuming a skew-elliptical distribution; this explains the name selm=(se+lm). Allowed types of distributions are SN (but not ESN), ST and SC. The fitted distribution is univariate or multivariate, depending on the nature of the response variable of the posited regression model. The model fitting method is either maximum likelihood or maximum penalized likelihood; the latter option effectively allows the introduction of a prior distribution on the slant parameter of the error distribution, hence leading to a ‘maximum a posteriori’ estimate.

Once the fitting process has been accomplished, an object of class either selm (for univariate response) or mselm (for multivariate response) is produced. A number of ‘methods’ are available for these objects: show, plot, summary, coef, residuals, logLik and others. For univariate selm-class objects, univariate and bivariate profile log-likelihood functions can be obtained; a predict method also exists. These methods are built following the S4 protocol; however, the user must not be concerned with the choice of the adopted protocol (unless this is wished).

The actual fitting process invoked via selm is actually performed by a set of lower-level procedures. These are accessible for direct call, if so wished, typically for improved efficiency, at the expense of a little additional programming effort. Similarly, functions to compute the Fisher information matrix are available, in the expected and the observed form (with some restrictions depending on the selected distribution).

The extractSECdistr function extracts the fitted SEC distribution from selm-class and mselm-class objects, hence providing a bridge with the probability side of the package.

Author

Adelchi Azzalini. Please send comments, error reports et cetera to the author, whose web page is http://azzalini.stat.unipd.it/.

References

Azzalini, A. with the collaboration of Capitanio, A. (2014). The Skew-Normal and Related Families. Cambridge University Press, IMS Monographs series.

sn/inst/doc/selm-intervals.pdf0000644000176200001440000014672113203254013016060 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3183 /Filter /FlateDecode /N 54 /First 433 >> stream xZks6N ɌqvTy4#67T\Ѓv3;4e<(|SLL* LLx&`ZQDB2 Ib2 *3ߧhJ+Tx2%yDLzLǤ`Z"#%:DcS )C&1(!o 1h E&_Gk@xmuzb=(]]\k$C/, XT,Xl!)H~>Uo@l\*JlӖ5:W)bܶh5ɓ`NWbRfD!Wa!j8X>9"su Kl5iCہդa gMu(n}(. wx7++Mtc RGd\~|7){lwP~F}΀Vv4D;{."( f{t_A^cD {֔%tӍ<T+[llp|!=+%.ۦTܕoסh eH,*<&-' >"%E6$]4-s>'O$^nG% uxЉnzc}[2S 3O /5Z 'ǡC._.iM^UƳAO;{_)1ȝڔsGbLʳΊxD` I:D.On؝߶l\jMFa+>t"[@ӏz%-b[#-/^T=ș_Z~As_HoG"r#`FZ̭m;p>2HQ|ns ZJ#4V$7/mSG.__6 h>eb ?h~ؗ4p Ojk9m] kdD-,?(NXk(a۰h߫;yۜSJ*ք2PLGn/(ei?UM= ux7G=BO 5Z\k|4}뇡V Ues+Ȯͧqk7 ܄s'\gvE KBwT+×'[sL$■떫vdڜ @&.>$> :kjA{ .I|=YUBx{OБzL註H0 Q؁&i07*0"êƇ f#̅-O@ed|>I6xWt%j+ڏtLj]H$i5 pi"İ!9'JOƊ 'jytm EAk_}]TkAUW:u6wJSendstream endobj 56 0 obj << /Subtype /XML /Type /Metadata /Length 1329 >> stream 2017-11-16T10:19:06+01:00 2017-11-16T10:19:06+01:00 TeX Untitled endstream endobj 57 0 obj << /Filter /FlateDecode /Length 3499 >> stream xZKܶqŔ 7a'r*]X{RCCI_F7@[:F?~Plm 7ۜnSo/7 7l69SrswlSy9hsYvhu햗enLCZw<j_Ovx;ZʋBdLgրӄ7!ML 큛 ! &.1Q\=V\>fHd.~ۖss6[sU%vͱ\~o#|Xn D@0-ѨoU%lNl:INM'o/NEp\ʬ/^tr}gΫ/ITɍKT\leIT²o/%Q/< 7a/(1. ؂=rpM*2Uָ; 1̲h#p;7'g?I297"=xO ǯ^' k~{ w L0 4Ghl* <Hcc6uy:wm{)YG"DNu;/HУЄնBfpv T*Ej-c+Kz[ .5ɎrCc)ϸ7w7w9@M /ntf5C; fuԅmozÞZuOtq}I2<;\k.*gغWh}h|62>eRy)ؚ47Ɛ!׃Om:wH&& `OL޻3u֋RA#(IxԒТ R24ϭ(P*Ip'3<\튞=FV2of%x@}T41ǐa/ LEsO<91W8 5,AxmɬwSX;p 3V$MS+C9{v⊠ٲа̾9ěD.u2)}ΎdFpq+,\5:]Zgq#q2@  e%!W<^t>pBn 2 4%JX>ƨY>@;AA <*Mn(`(q] N "$1Z\Ku 0( ?O[#$JZ$FʹY/GN0C&:lҷ>^%<tGKH9ӻ)p0\2`.;2~e0qEKi8.]'AcU/wt%O/ rhuo-j&q@( IVH-ܥ׃0SEb]~RxNGFfQa˰$SZy":ۚ Rff(iHƩɸ}TOLNB`DS|۸e1IUJFW1@e>&~'l4 匃nN ipڈԳ+e7a`#!'DK m4|cTQ|m|ȬA:d|zA ,7#EW\Y 2h.dǭuEwɸOƇ$s=42~x)!/'`(wDv=_K t_e^^CJӭo3a ãeSݷ)>ív * ]Q`EsT@m9;v %!/hCb~lnvzeBbi.&Z~p-~ehm{8E_w9oHx¨1.XbN&22DHe˥?IPk7ٵ!vҰnh[jl|فD1Y}/E|~7>S)3.ڰp84J7{pPQ_͞Z+j)\5%2$s[zp핆6n&~bVQwԌ5 RO ^aDZ*%%hO~7}p~[H v ,PBGu"+_]XRI2MYB|M|_}y)iFiXxL`}4_zL%Uj$G{䀉#¬/ ZuL[o WܰgE0;A>UW%_{sr>دx"ol<\B4/ZOƌ8k\lz&ReQ\c-%'Mtv0ބfWx(n^%I+T-uGʧ a w[j tvw~.RFWb-ew˘jeAel)֎, C}Iª(*o#r^w)"9WyT/|tVBDWTDf,X޾އkaq 8fn n1b3L?T1sz]=qi2{TxPWl@~qOmK0y>BPkڋ!jt _a0/ _ẹ?n Aendstream endobj 58 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5705 >> stream xuXXWמu: ;bĮ J&Xb@Q:RDқ***-bL-*ƒrfs$ΜsDF?J$ ]lt+?g`ɏ##şcU{QԐeKF)D&$F4N[.'kAX?'9.?sC}@}g~r[V_@O7W>[Cy9(] p t j_ r5υ>o)ZTW 26ٱfkC\v5s3w^ckg7s9s}6¼E&NoxzCCSc) jeI 55ZOP)[j eGMeNmVP#A Lʘ2fSk9)5ZKͣQQf|JJɨaGiS:pJңFPHX?5SJJPK)-j5 AgxO|YCW+L]G*Br3j c?Nh8hAs%?8`Ϛ/l_m!+mP[gHAZ/_)Y;c0!.#ni,Iޓ: ɍu\d?ZZ>0mԑWzt3A]nq#7,ݯ4NR韐/D;bmIޚ&RY:/, +<>[VfUn>y2:´ 7q~F&߾M)S)}aUǍ9W kT8Ň*7 Fָs>~g({FP%Bsq6ϛ7G\a*'eFe8ܙaz }Qy t^δHC&5e$E("lA 'y0i+ j<,95^$ "~ (`Ok>:qH">ĉ6 `DZO6`=X\tS))q5Ҫrɖ4. @B5vs,]lg#^r:d<;F ;9CcYYFo= 9Z5rk7b^; I#TO-%{=?㰍Ueјw0%Ml^ey0_uGz#*EfXU)z : !Lƀa \ؼ)\j Uw'e//ʘzU 6ԳC#CN]AU7.]/'~wU}夅ApYE_Vʞϫ0cM^zXKIE쬢VX|6F] >OŅQ)1K9A RAWK`JV_eUɬ핤kB޾ R` K4ta' *]QOnV&YV6 %.{Iļ=D V3])IdY8S͑GE^#$`X+IbO!j5/S{/ΟPd0?D2+ v!!"B Yus@Ln}d}g$ ZQ-^H{!9Zt;Vq ݅Bs@} G^*]+*{ 8+7`|}P$8:M'k72+gQJi`|x (*:[T0Cջ   l&9ˎ/ #/dru;s7 SWlI"biFcnݦG%aD3SZAHZC뭴q-!U)ߛ mA Ei$g ?ԫ4#=|P0\ҔSU.p='P$HiNv<5i7LI@& 3RLJn"NS 5 R?@= ,>֖8wXF_20`x1+ Flrgj bz&bT oTȬUs?)'AKח;xG#Wp>"ǫ10xZ,H9d C(Aۿt!?:c!͟1B$uz8Р;%[іD(aDKYlbJk[Tao͂7F\P[v=_1,xĕ<l^tl$ұm}B>؏F.VA5Cd T!| |oJ`6#B$cxb"zUgaߚr-"b%ӌTLYVp]~khgf&|7f[iTZ%Z }ßkگjud`7l0hRhd| bWVpIZjLAzvuaJ.0$dMD=Jo,` PȶmX@fL!*kk@4?8܆Hd\kDo` [eeN L%+\;z:vn|߿$`=W8A^jwWUt%gCx^1"~|zZXpªw=0~X܄;ʂ }tth|OY !lNmEQ$9 W%lz7iM鋘.:2{֢vλ lU!ܽʫjmǡ^^j۩r =7Za"~у W\<.=_dY̝jviGARBvE=PN m rwE4۫ ~o~e)9g `y?b} ?в$1w~G: ;7_ZQ*n[ kgXVr~ᾝrZ.6cϺMmwvR us孧G]&"?1N &v< _W@wH|XbDvd/sߴ,TX ypN!XgSγ**bW^ͽmDncX:&oc\vpfEzXt.h_Ͽ.ue;aE%cgN_hӽsfBTƮh]n~[teq2ܲu.{;׬yKnys)y38)*$͸WKER'c{ITP4BN6ZRTҫD=ڪ^<OE8ox*,1)pѭD:MH\Hnr؊!pnzA,1. "8 yVJkm4zW8Wa# Q+P(V?'epmuyWU(7@A WӟnkտKDRA;!`q=!Ap*BA10^% I/X8O%|ҳyg 7ș#KֺУdrSɡt%Ӎ͗^_Ջ*{b(f$,0Pv>xIŹx0~ ޽Ph:>A=D mendstream endobj 59 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 677 >> stream x]HSqgRi,1>/C i:nsq7L%$dL/*%.#Т8AiI//<^ ðԲb3D'p98.%d4m[ҡD%w"I3'ԍ6&T]4* JFsZwPbP ]> $vTľ=鿷#I$JfQQlL"$7wT0)!>i>@9Im=ƸÃ{]~'#A`7{q_ ɫ=vvL9/]$䬵zIJbwfwu3> stream xUkTeef@d5-:i6x7mm7^؅,HDKXE{0D1&zNS4|i3߼3+&`"(mMΛ3gdVJr iQLlʪ>72$14!>#m8 gL(++b٬{efmb+UR俞`yR&WܭSO\iE(r0'D0vQ /KdKH ,8na/I(Ά(FӑF.PO^qZ•مs.q"iKGi:.M i>& ƪHo4GGx׾#w ? 0 M+ʲR:PIJh2@ql#…0p酫kA+~[~b0/_/%S5Rq֬`3ޤ\}\/`V{5(3햬0ϝTk~,C|_^UyXA1|:Z22ժ9| pGo97pqGrBTR+ZZdD$jm47i +~HfYE-˼z%$NYV|o6m')>ds*f Ĝiw2p/Y@P=a{In=#@'nO1*ѕ$,[HF" .nkn`+][(e''^=@Ȩ]]ΩY#ߧ-@uH_ć#\@LB%1L8.|K-ҍ.N69vk7;ۙDP 2gFn|r㛍+j @M*ÕյVBCs>I%2^.S(, o$Af]A #.,BRZy?#A_yYf[25~)h̪jDh;bA>:]'l ` :}en^<2} 7K`,@f(F3Q!I~q7x@{Ԃ¨jrbf$.v|"D&{<5q 0sf@u&<\fBC?e&8MB\0 ?zSpNCQg[P3h{ɷN&7#-߫\|ϙ2e]5n\ܾ'0򭹈 ^骤n2JBhljxU&4 >QB*yuAq!n66H;kKC^ ״x}0YUQEk[OqULFSڬv[fy`)LgV(CoA 4:FS<ުv4z(mRM~w}%yzG/ yq`tZPF:X\Z飯-9^gD(Aw^W/|G φUlLrZ8h>n끞T(p\U]ٛt[ L_!l3{aqrvR!a^nC ]ƍNthSٹwU F6Z[xq\PUJsǏ3`/:&WzQYTp`?v]K\m@ڭyynt׍i rJ[ #)/H6eG)MXvkV1\9'bIio8endstream endobj 61 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2532 >> stream xmVyTSgTCM|IZQt9T( 0"`Ć " [(H"HXD*j֊ 8Luz:q>:383'Kr݅$lm$]VD *׆H ZCw\In 7Ymvۑtj |i/4N ?HͿO4>:,)|1 @:aCa +tRr!qXG DL&BJ 6+ o‡%UjŸxXCL&PD4QCrfMo"O5([3eCi^R[Pr1W|0|J><,I$11s'1T4~@y)lF0/ᐙ Ln-lŲe[ #,kFL4kbr<* ;wj{;S餣jUiL#۰Z{vĉE+_,Phd=z2Dr pO0ǂxR '9UTJ#I!TQ ngtt7_ H秖S~!--HRV%G9n扨 ,vjtONE5NF}"Y5y3$ߕ"ʄ}Eix"~AIyge%#%cFJE^NUssw+3}lI5b2*_^ 7Bz#Lo tf? `Q,fY ,]&hqy#qu|w*(iV"wE.KoGU3ڨ8Ą&6t|u6DĹ.]td,,p!x: C!D<Y{"ŚEx&ā3tOOM횇'NX326nJ'ԕWp"p1؁·4 ,ɋ3 a h Oi='`51w:kp& wXt%KF}+۴LNE) -7ڻ!-TE-'<z~?pnZ3iz"▶ё s @y@Eynv“.][3U껃ݱrl< /^㻖}V/g::01O䜩J6V> dW{ ٦!9FXAA_Lى92/C| Lm#MXm T"M{0O()O|FpXyetg>q7*@!\ԃ[E(*$pZR-~Q#d !r(-XU}f|TaQt?l^CT|(rVUbyEo-YMq@I6(.GUOT~u};1JK/`d|3]NyS132!u{E( yOhlytX@@t}EwgI׆. :ZgꪐKyH&TBF}`]h֙{/\鱮7^8Bk.-%O g??uS|4uC ]*xcG 6c Q_Q9>+sJfO&^pIuwMaZgHc_.D1O݇.XVwGأ.k \* J~@tizb Wʧ;^ cؽM+`Y?C0ffxKVhDƑџE5(]cxёG,!BXH&n khU߄"QU[9Gu~y:ZM Wk_9mb_a±%<H} cOK B .FMSmlm4jcsϊoGLO14VQ)!G^^kd/o /uչѷH $,PA-Ou|@_L gc:v[ccMMQWs{R$ZD_#{endstream endobj 62 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1097 >> stream xSkL[e>24:!qıe'F#nK"pc-N[J{zz/^¸ d\8Mgbo%o}}'+rs0Hq ^|xyv8IVX{ |1ϝܙA1UJ Q,G$zMdQI4({4'0У<ưX#V걷1@bsr.ŹEa[ՕEY܆\wOBP#uMK_41ѺqD{A:$L<\OIeѻWnޅ̦.&RW5S] hƨ{_2L /ͤPQNwZkG,aThl1*ih׼r!h-EsV' YB=nx FrAh!SӰ6[URNxlYypCuS~c lmI+f^*sm&8cX:<Kא<+gw&90 @|ѽ4w[;O弄/KxKd`,G022*ek?k_݆pՌHGnsA&DY"7Z62 :}$QD#L ~HIcXeqB+9[`Q0^l- q agBT[eE0)[^I.T \ZvnJ:8 p:(sB>`~b};*>2I>r?kҨ{V>=No݊ 0FZ1w+4) i!zbhNYf SvZHƦ;TVhqY!N놵 _A*>@ ߄w"e,R-O2_tS `Z Z,yL݌J Qt0x/SD8J6 >1$endstream endobj 63 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2367 >> stream xeUyPTG~f C0:3Fl"rπ0xp@EQrR$Itj܉IG6%clmLf'1xXת[Kd4i:Mtn:c>]Cr<œlMpr+/1;kϰ2ٮ}G< 1{TKW^HTETɺHmlZu@oSERy&%&4*o]"ZV5~/Qe$j 5E*O.:V%FhUY 8 $Ԛh_XmRWmf+˸2ۘƟd<`fb60K7faɌ3ϸ0L4^-{d +c d4'jOϢQK?N7`[@>ű p'fLbYK[Xx!vEi\(uazֿ8l{zb`r'ѣ\wW+k%+fEd0={smd27@ZG0Ca wQw۲0 iiL.d_`g^_ՠL9kƺ ^x&^aS2< [̺wSG]|:A.}F]R[̧OA10mZ/lL`9:ېw T髴"F mھ ]' $_&)j O`6_gLmCgJLdVeE>,?R6輋wl%iX=_r. vL`%O ؼb=}Y_ŕYer>dNJѫMg#~ ڕ\{6;FQYYx9s<={L$]HMm>/RY*:?/ )J8s,doF;g4Hbt,[69AXj&d|3`4cJƚPjwWKdR+-!Ȓ 6p.y,溈_9Nx1:*z .$.)n+kgX/ >0Żf"+|LYM/OWaa1Sf&HXq__mⲭ@\>,zaB=Ke$+r ["wYnٛrЀu.L0+_+Ɏpԛ]Fda௥E\;m"Lc%u8wca0Lȝy3ٔ퍍nmJFEY_o0H%Id{5TSNYeT%(X{"g YA\?jPn(ИnF_ Ad.e";'eQWަNy\SH>0֘ 02^( sӥ"\:d!l{N D?5 [W7qR_. f`RcJLOu߫ovŊ곸AhiVx7;knPzjqo­_(kvPWj8؈j);_=$[6ʩ'T40Ѓ?330u:7z A_wPͣnb0/``F>Vi@2**p}xӮО}B!U]Υk#>mGRK]e _f!s.Ջ#TIdxs>Di)gX9Gƅoy9%T2rP$3(CFo Ng:*CҹqDjVD6" 8c-fOKџ5d/k%R!&tE03iC` eo'x3*k)?WT$DZdvB끇|brC{rLE %xkk!4,kZE\SeC Zh̤T3jra@_o_!.droϨF]{XjRP3SXGpA5k * ׷9TXOLZaƉ ߧ~K3ק)Ӎ"/[- +HJd?#CKñܯxXH>jC,?CCDx#<$鴩b|}&$UVl ‹q>O(--:ԓh* h|7+Xw(ڑԷ/ê01IvIG*&)֘z> stream xW tSU>maS(SQ{QQE<X>B$''4&i^My--BELk( 08 8q5w'}{׺Y{o} e+=+/,L2l2ӢY3UZÜ,3e#yr$DfFFSE%G6TW>Zm/a >Fܦ%lYVu嶢gL|g&D!@,'XIYlb-+b21xK#' "Eb "h"B #`I if-̺1hɠ? hm$2{PvuvrbhPUN~N`X' ͽ:b҈g&?m ԛXu:χ&C+F ΢iYfsn&kTismAS@1rov[>x׷Rw1%ЅDQ,dI.Cs&A>RG"DG<':'/_5cՔ p?o8wo]"٘8З|2p략!U W!k~&zH5oG.Y\bb4+׮܆ux~_ƒ |m>sR`AO1_&VU&|U={)<_%!ȯ_/ /eK> 6|bYYl"q[3g@j ^62kAO2d5+6$n!ab̆㷒G2%@-kh1*Hzw.xrd3.E$4Z@U5颡BBͅ)=,'7 64|>Ǒi9 BQ/J&"rR$QXIHf~7Iۉåv Ah1+igHS Z//AX8::N怵`g_ \pB9N':zI3T4w/l+uu%sh.ФDޗ O=k@꛿콍fgG=;i\VegA=b1m#իtYh]HՓUvHݎ4jiUVG%S(8y!,#-XIO fs}YlPѲlsms`yW>L{6b@nY.wFZw4雔 ?hW2AD?ص=}Hwx%# Gq|MexϯO\whvx\ &Snu ;k9H@^e8m`ޚd.X=ݸPQpV; s^6S(thiވ[4"R t`__rVפ LJj?ھ-T O$G{t6l~#d 4ZBѨ &{66Op z7tSq.$XɚCۇrj(0i͐`v%&AԈ۱@QsDJ$3DDԍbf"ib3k0taJoŞ{_=npB=UGzQ!_'>t{rjfhaY<8s: 魀!(~ D>*.u* \Vջp{rrWO_k}O'U3{PdV{YJVsi؞*k4Z%mcB+B++=GQ gs;|96m?1!Y]XCPXe`4V>''έiy~qɳRʰrE].t,%|GId#G^]!{˞=(k|8}#X$̚dD*U SJ9&kiu@'Ǘ~]Bc@- 565.TptA36\3< ɣ)A=oVfm+_<|i*ۮp+18gxE~HA3`MdF3o j?FkaVQ+6<3 SH@#*!:Z=mލũP{ ~(3('`7C0HE \%8---+{ DyF%.F߲Zz j}v h׀mzHUZw[ AZ#S6MU{B(}M6C#z.ZpMH1{U7s*l&%mix]?o]HwQ”h(/Q N3ZHXM;E,h(0_'U* H<:[jRxtA (tH$|/? 3U5(S7pD>1Nyj`յ1HB WDjZcVFu R/bZ  g{gАJ?Ӝ_9]ߦ;⋜o67o3gJh,PAɸn7dFz[˓Ϝ[ *ƨ9R;f׺~e",[WS:CUY?NՑ~>e?Yhht#r|(bs7RȪbi4!d Dv,OrY]5ñ =}^9=?a~ NbiʘI _R1oh*] )Θ+ثG<-Y2cǏ#eJAlfMinT췂dRWPHUrz%(H=?& 9$Z^0v H %Mml /6Rnp;) ,2%*Ϋian]6J+T?\QR.-@4TerB"רRA+!RZR~б^m(낭bTt9On CڸH5-8kX|άQ唄/t m5uNӾtuM.*V,PiQka'6G'xnlLJA6 H!#xa4[|0oocZ(TYTϞG)9hFcR9$ _.GHp AYnoljlV3;1ڢ@ 6q~A* o[P U~Mu?G_-MAD/Fx+o"/G೥ȃ7(Ft ה&PѤ XC0z<ǖeFcԶ֚.4,@ʬWc qnѨ|`c{`&NYuĤ(;]Fvr!BR 7S;D8ȁSu,<" 96}#' ojendstream endobj 65 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2750 >> stream xeVyTSWԦUJĥSZ:nEM$,I  %l @AE):VAm;]{3/ zfzΜ}}86q|KThB+`"Tf=܀p-l2CXk2.X 5.]] C\S#[nE2R<*GEq] "Q*œDI${rQX.NL;\db":T ,1 sH*W(&y{b%uN|0, aA,ۅƜ=zsÜ1¸R+l{:/۬IyqTq=ؼi]I1RQ37}6_ߚ vp#n^Áߛ,ċԄ7Q^B^O>{g5ps 2#&hT=|DVM-FfJ0cDa:b% W>՝q0եVWɄG|ea PZ*#vJN-tLJQS\f˻A8#hgvA÷GzX9ÁFxIm4C[ ]p}R }Y7yG| B.Zh ŀ%v>pJo|E,Χn8Ih_ I@C܅F- AX?')c3OL]WWf,VNK=aXNduF 1@x0pI EXOOtb7%syr`#"x=MM?~Dp6Vbz_t$%]p1ZU dIpWs뉣:A&Mn﫪,̫p+v??@wy!%di Ӫ;|/tkDc)0Ra<ÒNjN6GkUd$ٲ/掣ZAoV,fc @=e 516rSp">ܘqJ{捽 ׍YD{.j 98ȉuwR`;34~eT qPH7&W\թVk=rS h U6y}^ALJ1Cp--1Azk hᙊZ@m<$}=!&\\a Rq):AqB>0YŜbXna:MOYFeY,9~-\t6Qeٵ@#u)V&\B1 S\G+{a`{ozAqfY'#'QxC7yiXMA 8i`ifm{MqcIW-0yC~2>;A_N?QĜy0s:2Cdniq;,k[d\B2cE=2}zeA#9V 񩫀6($Eyht~~a }b6hw{vI7pNuEuŵCs$ j.F4 Pno 2^7 WFuoK:*o*OeS3%墮iTgs!e.R%Meza\.^BgLJN5j\76jî8}ι;ꪗ: MҬ 0x,WqEP1#,-%tU@J[g΍ ~v`Vo 5EE5V`YYH%¾K ]Çi Ɓ<\.*NZOdd&Ǭe R,&iچ$[hIZJxgv,}n{A@Gm NǜO'+#"+łJHAd |E2qSC,: 7h_w' jAPZm(.dM?>sn G2i|Z&rGLj EdUF1FlUCG -;sf6l>b4€f'akOs;ʯ6]gArZa+w;3nߣih: o"'+'=gRw(JY^cQeyA&?U>qu[-W:2O#Ee%ͧz\~7$\]ރU\$V|[,ka v6CVYP A4|:867~g24xҫvPKR߮(*o!6XǮI5LI;hFz&5]{s{. n-0 <'T57Y2:\pf ɋI';x}VJGP ; 5endstream endobj 66 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1863 >> stream xT}l>A>yҪ2eiM(+ m"B>!߱}>c;8@@!$ġ!l)£эU*l}-]%vIߤIDHj "ZRq?6$SkŀoIZ!֕ C 2RckqnzɄ*$E$IaSC5ggӡƜesN8?d665W;ٍA~EJR5ىBH&J`BdIYrQ/~?uWLiqGaNdқD<. Bj,"dԂ;-#2tqeONR! !Pob9-'y]qJFTR3?>cД|]mσp>/+H' =7xCѫW^K?pͥy6Wܙ7ߖ[p \Y=̔.هGY{cقm8\~."7n%/ ogKXV̈S]ðSjITLYQ .WPbXשh!LRz-cE X́Ϡ`/G|=^A[p 0G2dYΨyC ,Uq|YY(ם_s "7Uo?d/p\IAZ;^C.q~?uqQw.x>*w}55fT[ٰ$A5t8٬VSJLE{ɧrYU ̝d5g\>B |;vNѺhU VrPUus +X hyꜴMBΧ*D'SUdtn\P<+#S_}8/ŧ:y5Fr=^A!ڦi*=l8ԂAuq>q-?s)7Kcg%` 9- "B^.GyQNmX$׼Pl!CSo%PGfl_/J@>^*٭耖ڍu{eo<5 OuqQ22)<}̳lX;W> stream xZKR]f6)|ک̽ :i$.W9U}z{~bˊ.iݮZ:.#22/",&}oǛo}U?I]{ܥ:w,Ro~HL[r|==sS?xx)S)0৻,Iy%/"̈́Hvmw[ɤ݅N.9]yk~*=NN>%|+, `C& z˶.䏠WMÖcáB($&9P6x؄o`-csxtGS0Jao9L`r (Rg\v?}5T>wBfD6u*^$'.%e4pO䊜o7,*}>^x=ыM~f|/>GoݮR$rt4~H>nXٷ-(JiCoMSC+׽Zx #iaǦ U!'EW}pTNyXՆ^'L`m{/_ һD"D*Uybᛘl&4DA ]w_IX^=jPs8D{j[*g'4'P5-^5bnk3;Gch+_4i XX&\ܵ_j1\3akIU@ke`IHvSE:R]r-@Hbf52)A^BtZ8 UPzzѢ0](2ЈPUQN(<IVgp3|۪ ㏫09V; ʥL|&_G.pOCC{XAX\E=Wa!hҦ}tZ[0 N$ o�I-mBPm] YpȇKCpf5ju0Ehj;&xn=\[PRR\fl LCS3Y=K*E`7;yI&'_ʽЎ} >h/d0sY۫fZx<&,f,@4PCwW 5(A ()][];sLa@tQ#~JkrHU)THS)T/~`zpz{^޹L/mn7cd;-ϔ&(@!Ưi=(?6fpkrQ;ʪM7uXLL.=f#Ϛ!"3?XsҸy=7!zS A %x)z5)1cHˤsI]s(pӮ/N;y^8NB } *a>pĎȞ u ? ԏPXp/*Z|j44bW%@]C̾=mPdD)UAkcPʱ#$-{Q5k̷ cooOQ71G4①l%=Bmʮ)=vpdA lJn҇Vr ecfX\ۏ(qq,$r[դ!ᴟیܒ)㒜"$J4rlg3ꌩۉ,#̣y3 qzej;pާ`zxuj"B؉~ N?Lk3TH@5wc d܆4_7v7=7jP;"E$_0eIEGc}2qX89B‚&`{ Өaͳ#2R^n|qh]q,BаK%cE'iwa‰a"'[D>dn.xV}ľ-> 8tgcI!dy"L~Ƒ1@Ҳ+C^W{l(4j.Eq2)I$鈚d*tga9?"͍x[ fL 3A@pJ/͈xٺ`X vcI +9"%lyIMcW"Hby@X p\QsT?YHHj^JuL[aF| M fc04XN CownETy#%C*: "@#d/O7PՏ}I]ZP嗆u6kRx' ~(ϛM Nds5/l3%f% +U7$ly3i }7xKNL4@N-铯 H9k'da8d=T6ʂq*тY`hcvezV?(ǟùKx7!ɥ*tjOy ]~70&$_NSw=)&!IZozdnOݖk:-w"[J+pr_ VT"XH4:ɦwTC$vHȩSBKL^K I?v<8vu{6OM:Ụ}}8~B)v/>cI 7|,|dΓ*~i*/M_V5Yl)R=ߗ k4_k( ܲ @C\Tldrl:vш.:"ɗ#aggt(ӷ\6i/4eF*}ko)rSWFqt(f9{&-T텚ѭԚx)s CHh*@s0ެ|X OfϰUK'<A`f8^-]b,WK{*]V۞`xUЙ [z} !ydYtPIۏ*RO|~zƳg]s:}> 7Վ? iӽn|<|w# K57xP!1Yxl.LY-YoX<`˜n%3JZ2 ;aO/P#lyr0]u:׌%a,B~BLx7[$DZ0A [/U%Cht_Id&! QpL3y?̼`0z~ypM h~>- ܵy^\"zeiWTw-]NIJ~yqĴEǣDG. * @0c_Ҟ^ :k'LDH$nG9-|HbGٵdğGm-/\{Q{vEPӸ3?3jS杰"ZNAoͺzGw#YTd]8២d~( Wn#5n{7W"Ֆtf;?j!M/]JM!b7CѰ$Ro ?(0endstream endobj 68 0 obj << /Filter /FlateDecode /Length 233 >> stream x]=n!{N X%+K4NQ0 YEn"C7oV7;}h<Mt`sA%v3Nt\@B2k{ptiv&wxv( Tn0P90 Q~f*z*P(ic܁91g`# 򒤋PF!_z.Aqi6Sj?ڥ˲/ڲ|endstream endobj 69 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1811 >> stream x}{PWq+@"؊-ˆtuעHA$@$[HBMInB,w)v+u7lwwǞ:sf?;{`G0hfXI'R)_, ҄I'Fzّf-2ha3qC26.Ӂ=pqr vV ަ1r,}>BHsx{R~F"_(I 䥉DKOEaZfF*O$edgSxaJ:/G&I ER21o7v/hX%XX5V\)7hv4>?.Ю{aݱ։Ed,̻A1x,dO^&_FYXS~w[cVtbt6`-U&'`}DK5iZu휯ő)6fr7ؾvekȂcsm'@.N&P"wt9wG/a¼|` t`js,-@3Ud%|0FM~:y:W軘 \nMX&W맪}Loآ{|ޗ˘R_z:ٙq>@n+jj}Y2SD'r9F/g J.cm!uXWxSIMNT(ak#ﳟW# _CU fx.WQ:zT*Uj5N/h$ kʸlg7~qq ^ endstream endobj 70 0 obj << /Filter /FlateDecode /Length 211 >> stream x]0 > stream xmQ]HSa>ܬ,Jd*EFEJ`X 7Զ%+ss6f+ÿ2L*. hU]E}g%u~<~`0Ɩ>:e9Nm=.oO݉բHLƖiBu SL6ҹIS!ø~+=u +KϞw잮Y>즘گY]^z\Vi"oM*/^Cd1`iP.ڍ9t?svVKL!12ՠ$/ZO- EKl:iPmZҟn_?0辒VkY Oi~}ґr2_ Yp"QؚdX cP2()AHoӲ( 1A(،.9<{?5 GN8 BLL+IYH9<Œ!0X֖y. |*DoO3,pY}iC(s*8h{ILyXRS؄?cV0YWt3uBCL> stream x}TmL[k|ohj4i.-+hl!iEIBRUSc;18m G1,*qK4j$F.X"emm}%${&_9}= IAdAѤl558'd£  X{LH.y~NHGs«)BaRYd>huuV.I.(G\#Y8^g͜3u:o浜լ tNTtU-ƠU5Fլ-b}hЊ^W,|.Wg?h՘yz;itz=L86dP޷Өpu9{ W!{`g;AJ엎|6meWcxˮWtoG's/<;r~ 'sջp)2Xi!A xh!8ႜ]XU+7=wqJ1f]ưۊv6@EN$Xo'îeJӻ4w[oնkQGx#ܽtv6 }ΡP|q>~BkOfU1_ }*=TV}Z9><y2ǿb˶)*veWō}~2+s/\'hs[_lW Yr3;k %v%DWf嗁 2<Je4ο: )Vx(CAR:roJŘmmy7! ֊qˍR>Ŋzӈl0"`2-/"㾦x$82Q5bZax$ GFç$y*#3IRa܀p8(uAWf~DxF>c{04R^iSL|#H)Sa[H SƨJx+uo_]Z@ѥg{rnʎUȱVF&Jfʣɳe4Mgʄ~[G3oʡ6VX&ŵM\x9sP0Sʿ l\ L8;'P!F p<΂"(, E^͠c\ .ZLg?hmk)l= R2 I = {ͷ1&4$M4/`ؙeM2t)ga_4U*eo+{7 Ž/FHCI~ ?endstream endobj 73 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1506 >> stream x}S{PTe6qVegeo({g4FE&X|3p2T0a ܻܻKp-ʒ2C Ʋ2JcCK,sJG]uo9`8+̜ɠ[o LsĹ2;FfnV20=2.X\?K\:C?;k9S1oћ酙Б/F/HzuЉłx6M33YKF# t#0|?Pmh`3IXTS2@ef. Q;y>Gc\޽nOh{[[Fr%HMԇD8LEo]-{ zKM_ET9(pɕ\ =ltw†/5dˊ֘3rGӾBf_ʾSTvdqE; b@#Ò\g A)56W+{ vg[[UsXu;7!,=d\\sʼuj:2{ﶳʠ"? à5YU0jrVT(t4)c@}>YxS]O[ǁBpɕå5ۡAn1fw>I#pK&n^S4Rp%Βp&ثC0> stream xcd`ab`ddp/-L-M,uILvO,Jf!COOVY~'ټ ?zxyyX&}_ ]I+o^ο~?'5ۏ1 ;wm"Y丘p20mendstream endobj 75 0 obj << /Filter /FlateDecode /Length 4557 >> stream x[ێqq/f]4Ffzax!W޶0c*N7w5dU!C ]K&5Y`d^"##Ήz{*f^dWw/޾{%DꌑWo^pʝ*tJ /^%_NUPWes*9?Vrw؏S4SVA_[UfZZ8i7<َج7A *~%EqilKJ8LU{*C} N6eWu7p46y&)[a h>݇*)aꮭn0f[톞}5sɛ #WބAUzI6Uhkn^%{lQX͡`m]wՍWUL3kRHMX!׷Mn\*s{d+. z4c[NU%s K}R tRp^*lrzl }7 StRץTt/I,"ՙɻ"ͳ°tlrwA&|;1*Oj5nA&uEs;cm^D7sS 21ƶ1؀& b+B_'ܐ+m%)`pErVtpڴAfEgӹ37?8BɉxajB[Mmdf-\BDEָIc0hƤb<ŭVN*?Eh5+N^veGbfMo^H !\hWɶ:4'0?9d&y6`)zM}C [ø/pٖN`Io ,u;>k;p (v,0>͛s?%;<> pp4S ץʾJ.1\}&kY.{/b{OIsE mݝz}>|gP ]<Kv$&ծٔWz ;pDA'㝩y[m> )58\4k!\9ɺ~HIxa98TzScG A͵y< <9wA»ct J~Y L* W$e4.ȧ /Wn(ѠlشЂ&6-\Ҷzvџ{ȳkDq.JaASkx[hؼʖ>F;+prվa u-%L7.|]utUatPopȻ~*pVζ[T HMP OZf4ߧ[aDpG2 }nHVܯiD_28~n9ɍG*Ltf~0 #j co lX{ŢZEcrRk]ANc5 {jנ.ó}(.$Љ.c 7=ɫ0 ;u'k:s j&Ԟ hxjx|0HyF#Um+y5,nݨX,{q>l=i` ӭ7q&ܤWZѴTé`ϨIֱ'S'6zE٬;l:<=JM3Q9Kݯg=QCC{bS %rQYF ۧ4 ^FmL(~^4&[V^E8-sZaeDuLT^!ِ|64|v~p"OsbT~571TRa4'Z,:9Uv0ө0 vղ>L?>%M̈́3SHpؒݗ9:p`ë  MZ"-~rn$sz`̌sx[+a S0&wX{ +s f+o<]] RY -a$ "VTv8UFE X"~g4Y*pNgR&l&s!4h(ZQZR SH ["=sx~Od ndPf}y1wp93s+zCPfɐfzىߝgfujp_'泯k_~>\?v.Syyu YBE3!yf{TۿV`S[yN@A/q^A{#9 hONM`z.H">O1Z`scF? #,@h0'[.}"1e.rOl) E;Ŕ_P  FvW[˅C6#]=\-Z-Z_jKg3'JMkRIc7Q@8'eu ϊ >C+:%YdK<~FL% fĚs429yNh-Y 5+a5#m~9ܮ 4h`3>QW>W-g&TO8&-W, UH<ǘz |VI84?A#Ǹ85vam Ryl}RݯX l6UH+JC$S` @ 47  :$ t}8_BBRg`ON_. \h FE)%_ D#2 BզN*xfZRi]S\zA$ZI 1(:b5dˮ]Ug}]\|LOd)}p&&8tfJ_0eőnYe}‘+K؅s"B%?Έ-zJ3C&2gz)}1Қģ!5`|eCR KLw5W遤uͧwd7s:U]zQ%{"*h^A i} .j6vT֡ kТޚfbdE& mX=Wy†vV5#a! }(^xDzAu 7m區C\C\^ʕ5Ib5TsXu'8e`yO`LrM.?2.CUݯs{4v((<kBy-(rlA{ŀF9upA1TSnNC֡| 0Gu=(qFIIG^> ,\wǀG uQٹ^~,SJCہ|{fCNH$3fϒ'ɷd>T&BZ#B|]z&;p^1Wq@jO}Vds(ʼnܹ04뇚J-p5SX-2`8\:.Snq\ " q%t:M]jpAN|xj9Fe3x 9yTr",iMt/bv"^cU_Xa.bwPvƵ\A\.b{%XR`FL3%AHlbWGgHӣ@ׯRca Ͳi CaɸLK@Za)*Z$ ~*X;|j(ʁB> stream xcd`ab`ddw/-L-M,u(I+If!C[wYed7aaaw{VXE̝55 uCCRRұSXWQ䤦 L20v2v10328CBwo ˆrW%=dvw~7v^{]r(Yn3!{ockb9Le~W}OL+gNԂendstream endobj 77 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 390 >> stream xcd`ab`ddt/-L-M,uN f!C4VY~'ټ zxyyX`.%]#s~AeQfzF{hHj^RjQ:% Z m,?~MwW -}әO7 'vYk:g'N7{jw焮~.6y:[[ۻ:~[{.SmR]ߝ7FYo<uOi>cцً-̉KrTqwWU}V{g&456uyoݛ\гlkl=7oYywq-2m5Zn9.xεyxendstream endobj 78 0 obj << /Filter /FlateDecode /Length 3477 >> stream xZ͎rܧp aw9+eww 9"9Z? @yO79\q Z]쮮[dXd/]>{eY={w&hpv/A 92E:KURuKimZ8T=WХY&/_Jङ2'uy \%<%¦&9 pB &rTj<LQp b)Tkp*y]-m PaE!~M!Wfv7Be.dοIiLoɏE4sN OlV`9K}t +e9M3Mshouewa&xSޓz{#¸Pi@@5;,h7RiZ!!?[TF˂b):͕*@Q /2PKOϛХF1'Utn\P҉/gB$_z@X]ٯ6U}p!'@NHA?(%Dh/[68u ɵ]g<-Iފ$>q.9w0ɢ[ԥyg8ha%%״GrK!z !9i|=fzL\B`K@s./o J|Ao}ȐN'7:vGB !~7i%Sx+?o1"G v=oYsIun]b8 8qŴ{[n>N8'8$Evv6m|S1jǒ`OނY[X9Vl`4ľ9'®HfX?o~SbMjr3a'P(7!Ngζҋ|jl,ٛd;B|ŊbI¢M=MX' $&d+nZ#fL{!Ur04xLXHU -y_ɤouX)ʒ>DXjJ`-b!TIsݗUMzҺ:~AZӮ2=UpwXUT , aN2H^__M|dSq؈D`2!0N6gL3X|*1L+.:.Y1ev}ٖ;S%&Jpv`c& V݆,ixشp[Yش4oܕնGP?!Ĕq}0媩|ۇ9i\ 7`^or{Q45T~C]Z;J+|N=77\!S %:(8E6!aonhSXBv/X<ъ~h[OVIqaH* &}fjz`wJM*p-Ej5 =>vZm=5 r&)ǟ|',T$sScҸL:O6Y7q 8Y %h;J+*3d2S$[1Fh~z7~I 2M +1.qnڵS-{82D؉f+KaIoar(%X1>un3a5!EEde Q<ke؆&knA;ĥQ8Gtx{}0l 1ud4zxW~((p@!jА q @@3PP"і0t J [-!!FnϲqIy,nQ 4&۾;_m"T3{2ݙn7&,"kQ [C&q[\ 㞌hj,D]"dܚK:>D Μ!VndևIK W릍'RsS~f1έ徂 ~Xc"hc@3| Se"Y$t(MCQܫs8f\;f?D xaR-FcYQ_&|Xannr!~\gokFmW㗮o+KEƁH1z/ϗQ LMsT(bKlpp} 9^R^fxokIG6>L($`(r4gx$*]+U:9&D5AA$^gYlPu9::w/ Bq_\rKc&>%f5 a#G~"vdjPO94`ȱZOC?wg tendstream endobj 79 0 obj << /Type /XRef /Length 111 /Filter /FlateDecode /DecodeParms << /Columns 4 /Predictor 12 >> /W [ 1 2 1 ] /Info 3 0 R /Root 2 0 R /Size 80 /ID [<2a8f5d4af41bdddcbd572acc5c904dc9>] >> stream xcb&F~ c%'ؚAH-F e$XAb\3AJ& n HZ FC7Ē H, HXM@>Ȕ{ g endstream endobj startxref 52306 %%EOF sn/inst/doc/pkg_sn-intro.pdf0000644000176200001440000151025613203254012015523 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3588 /Filter /FlateDecode /N 89 /First 739 >> stream x[ks6ߚLo;8qqv|`l:fkK^Os(QtvEA^<,gf^f2˄9$d 9+HgR(dZd)̈́b L r)%)P1eG %SK 2UJ%ӜkWKR3-e -å4`Jf )ԣ2KҸy{LiQa{ PJ1GZdɬA#Q$b֣io-W;fgSd%/ t T)DžEei P A-Msta"Bsj .teAi!Y@ R^Rq@d0$C}(@\PJ4MI:D," d%4 YrhA<Ģ@wD!v ="ExHDɺ=$ {$ź@M!l!]9oeœb?gxvٞ5z^ޭ^g3F^oxD=ve}DΊ9+CV Y:dMΚ9kC Y>d˜-#H"2ANtD':""D1(ESD*"R!ʤù#R!ʈTvHeD*;2"RH_O:*0E͊ l])u\6l iaqΚa{m 7]ULU[;4p1fJn+ο娊~5)_WU>JS:hFF΄8a1'A@[:nofl cPK3,حpM/*/^+:}4y;(˳3)ЉVYɘ'NA%.rHwi"IBi;A90ϗ:M;溊Hp_*ƕrV/*y_UZRU֪*vLꀤ?YS*R/)Ų =Md;M6ӔzM%(w|GnyBQ +J򁢤+J%EIDQ"yMh1Y!5 }% cQ}Bm"pO龯V݈SAٍS;2#CTbTfuD}!bjfGFS`Mar1Q˸0Ie?rS`•#%܎0y|R4LXG4y5r|>hbShJo*b J۸=9q#raݹ9A.Q;^q_PџvAbNȑ50tq`5i!ΐ/6Gt;LrSz^$2c'U;m[52D>ZɆQAլv8ug_pPQh[Y3BՔ]otNK CL'{,$<"*V9nOI;*Oж Mꏱ MnLm|+!JD]'jKc;*l͎9#h ys,oAj!gu+x]E]"I.Ni=.~/΋q3I1ﴘ-̚ sӢ-i]INc ܓ띳͌V.GO}xx P_;Yy>4 G[7!Х?>N~NxTыC7%h6e_%nD!Dd-f;]PvVj%PT!KTTtuT$x)XŢ NG} zt)31 :Ջ=EF}Ӯ4iB8?r:cZc$Pn7f";gSj!7u*zQ]:טS>t5$Hˋ@I;Ҵ-fOg8Sfk5udï+~(GЃujq "!H2rA֭/W.ּ5w/,Z09T)͆5A\X\%&ʉ§$%iϪ|/"Zm pqAN%mzċT֗J|*jio9qO@٘шnLvr9z6ehxwCհk#9de_œi 1>b:lBD{~^pz|L "QAzm-\oS2؁_8m0փCuǑS")M$.V%Bٽ_Wq2}iv;Wȷ y76޳}xzA4`z'ܓnq=nraS>Nއ%( Gv9n/QQu<$y Zҷ`Q$^ewhtY|HjC[PrhЯך-ZHf Vho>nn ٓv{|qdt1f]^ym.~MتΞX-C6I[CkݥA.]!wcD"O)}}igj`.D:aC\t;܅w®҅{raZdá!04MeGGK,&K9ΫC(Ȅ309U\DMlɩp|@FȘ]ҹn a0iA VޯH׏p7> stream GPL Ghostscript 9.21 2017-11-16T10:19:05+01:00 2017-11-16T10:19:05+01:00 LaTeX with Beamer class An introduction to the R package snAdelchi Azzalini, Universit� di Padova, Italia endstream endobj 92 0 obj << /Type /ObjStm /Length 3000 /Filter /FlateDecode /N 89 /First 800 >> stream x[Yo8~_]ś8N@n֦Hę_Unmg0/:>e'HL$38MU"Y"5#%,aqL4q1#qsb 2؏GƅBLH4t13`miQ&I™L%a`@µ-Gc"7 ‰*F%^`^R;DZ ,pCT`fAD   N f$H I]hd sZ" T--B;xIFLV aF,Pj( JClËXpPPA2ŠYp`4.BU@A)P,qpStS4btz(IoBbq%D~Q[PH+ueڡz`ݯ=!T K Fzƫ`4ZxTfP)pXq E/=#.C>@.lDE棱hrq:%SȯA݇rb _,_}b]G= }h氜/u2MEl=ez)Btr̲Ebxً̳xyxe7R С!Ŷ̙{B-ɷb=M47ۦӌ#,ǁA',eMG @GP cp]H?= 63A@"$#W,Lr`#-2F.}Ge6B<2]̠W)̋ 6p2B8c2۬Alb?v ;=1[v!n%p{ES?*l)"ĬlWK 9><]@HX,EVl&v0decp(,8JI-%,d;rGL%wzEyp`Pbg2ݏ:I tX" aխz?Yy 2$/c.=@[az?MSVm))HP.C `$Be 8ۑ3ǰWa~% Ѩnxǫֽb q]\BHQ|$tBN{WW є~^חf3+KzM<]OeUʑ:Nl9_VK ߒӂUV/imIW+FoUl>}='/QBLF(?UQ6OaDPh:M[42gӽKS|[CKasZ6P:U2t\1g_ʢ/6=O"[tEvƎz*`U9|W -Iq>2OӮgѿ|qbowT`ʸJ= o",=ͻ&1bVQlcPR2\=oώOOL~s-j(ub^p@5kkZgmԊ nž_1I4K5'zʘ z54?;yc-=Y@x@עj Z)m{/ГpG#~7#h"52b)XI>9PwD6kw%.e w/ٛ޿GCC4zцBۅX6MoX8Vؑδ@u6Jz5ލE|uw7x4ZqϪ03dSYLUלWP?kʟH5폥gSu)Uihhɜyu>s0ec6kDd,uOQ@[,ϲ!M#C"SDa* - ?ȗh#`Ѭ7PFȋt%QiZ<-ROӂCxG<)OʤLZ4ׂ!_NњCT2)͍(R"]YO|.M5otH?,囷`ָ^|)4a4t,rL*5$[| vXV _`12 u18 q#5kVDƲ&`?ӨRsژ>x6'{U"5 \2L޼{w8Ml<=M| hr1aRMRz9KQLÃjD<+8?Vh)qkaCi=:-"$Huyx忯%|SO'6xX% ~ NTT)*!S1/VjMUXu LztO R!r`m}T+UXioLU vTg#)xh @ӿ @3&ˀI ˚B ,@SGo$n5]@H@k$?O@ٛt9LX?4gп J- *}k ?yaD".D9"DE!|Y f6$(Sԍbֵx; 4~EZWցAY:t8CTCۂ SoegOAgPv ?Ϡ<&(pRa^{Tal>;aThϓhpC|zӗPu.w^Ҥ [+~PlmBd9>}J!(`xo[b )z?(kN2&;endstream endobj 182 0 obj << /Type /ObjStm /Length 2500 /Filter /FlateDecode /N 89 /First 811 >> stream xZYs8~_J njj9g\R6@˴͍,y(:<Öo'K@Fw!"B&"ͤ0+EQ1!CLĄ?9Fs'/FdhJ1)CAVYdžI# 29嘌F&BFQTe2%Cc`%%e$24B xfJ)jlㄖ)zRUt( j0ͤEdځ!$iCAK-, FXƎiRD̄YaZˌR0- @2cPJŌs50jl5v̆4e!at C 4Z^J2A3=FW)RGFd"ѩ9-(3gC"Rb.6ҒEbZHBRki̛4LËE;YCUqc23Y4i$20i#|[Kjl!C" 5%K47PɴBKv"!{XX4S TcM= oD9O%K2Qa`sFF7Ɵ%h,' |u-/OIn^U]fiӿn 4a+?Z$krBϞa2aYԧ([X>}z\",/)Zl콤hBEz-˖jvVMt?O=|"]|Il<}H3.Ǫ|+k5V]7X4z |H6TEk aI9j^9?)$ۜg0k+Zߤy:9_M2Oy뱢o[ǬHԣF(iRiXd=nӧ^cKtTMF1q?0̮b.n#h.tzq ǁ@FTqOh97ڷw04t5J+\=iC_h{n<1.׳I"&|?%:98%b%rJډmGI~Ӵ m6=&/?8G0Α3a{\ RvnoCG)rHG.{vXxM(!BY/\LY>vk%va 98>>-7rmˆFbxC`Z{ؙ`7'35+> stream xZYF~_я0/ `=q6c 9k'h =CFR(ǿWMJ3f}bL0 3 eZ{PzDedbxLJaH3bҊ@3`嘌JBZcLcUEO;5 tKI.\WUYLGfZibDb'bZۚF<0iL65tUSh6ԋl@|vSC+Onj~n{}^lzʺ^$&Ped7+-߰I:1bhผ@?Dh$y2m~$J~T+ddE52vߎ80㈔NL 7rZ~;ʤJrnE%-葧KHCI3kGhS2m,VelgыrlieQ׋.fW"]-MUsvSPnulu2iE7HŠl#d[jnRcZI0zMR_@#B["jok]yGkjtmK͏H65ݮO-o7{5%aY|QV7 ;?/%mx?Ō%V/t|ߴPMhyW|E:7K|?#d䱂gf,c_JLj)KX'My/]a}c;3ܱc EN{GT6Rgl>&b-h%7Ok[aqCZ䚶JՕ!lȣ=0C!x5_41ɐ ɐmCo{jt^'ej+Γ=;Pܖ+MW#0>WY2 e>WևvJ;P]}uO :Ó>r>-zTgnYQ;"+KH{Gdh_NܡA? kwЍ5eN齾$J\)ՂH9A>.3qǫ@N8͆b^rٔW5r}o)/{ƺu kߕ+$=sF<.X)e=c30VJIg|O/sؘozv:G6vZ#9@Sm{f1muc&7Wm~om!e0(6'?ɘhӷ; =Q 9:ˋGWC!8r}*v6aobvվзe;RV7Rs]85YZ%_PIg ?Hͽ@JdwԈad$GInB|{ Bg vi'lkG!RW$uZ[vDۅtJx2}'wu\9I t?9I''$}9b3\{>޿/k IӁŽ8*並W6RYrЂ߉f KJQ,Ů> իendstream endobj 362 0 obj << /Type /ObjStm /Length 1356 /Filter /FlateDecode /N 89 /First 788 >> stream xn7}yg ;6AH!ˀ\Kko XaZ\ ( O@""HIflD Q9qD*Qf%fbtZL:Br&3@6}AIr$F6<| & IhT+CPl x—RZTKrr)Pv\{k.>I?SnL(nm[q1u$1A3r̕xl:$ kջ#I L3&`޹pQw=8{'zL7v>јy8p 9l yٯ"ֺz?#;OwGJ?TNp&L)ϝl?toƼcΑ7iyS^11/fvI/Qendstream endobj 452 0 obj << /Type /ObjStm /Length 1627 /Filter /FlateDecode /N 86 /First 764 >> stream xYmo6_-|;E$]m9ڭmʐ=GINd9kA R<=HώP‘Z$6xzau*y~D^4 `P+ o֊E#= meְL@#%4N'4.(Ic蚂E^+tt @Nơ*G#'g!D0 cAsQ cy3r 㳌CTD uѲ (9a%%Rh0d`>I CNX kٔ &L>a% 4A #@.) ,y +C (Ċ!L@cޤ`IcUhi؈G3!oxg!iK!/^,<<nl2yc*'+8R݇v;Щhl!fQ:ID?{]sg;eBa9C ޱv[O$ IK/ZZưg؈7d&dVچ4v~|k{|k{sa=v;mW5Q$HIwYߝ96 icBC׋R.6G3i!{;@[zYƙ] )ʡ#]pU[ rw[{srmպM^?һ [P\l v=ˈ]r-\Pz!W'q_Y\0 Cje<dj5sbۮ|~r덌i^/r|S׊e yu|>֙%\!XBgSok B|r\p08z~uբsKO{-UF&HK^H!\d2V/|{?k*l2ϧiՋòZgJsÊLWnj<VHØWĘ5ߔ';.1.&Eyzu1YvKouӪXfq^c`tJsm,y Kի⎵OtZ@v\,p9ǟ^õ5m34]ƈLQ? endstream endobj 539 0 obj << /Filter /FlateDecode /Length 559 >> stream xTMo0 W>kaNb`uMRK|,ǖPĀͧGxր7w'z2Dِ }ܨ:zAΰ_;NY%Sz'"}\=kŋ&tU%'lC0nYwϛfվ/Y%O&23֪ǷǛiuخYO*z0ѱ(O9<4*9H)yGH !N#h {`cF0`c@)"L+ !ɾEsYkƔɝ#9#]eE#=LIʳ^fɻȴ8Y~\SpEaIs`6h'vM9\>@+ R{rT&8{TbW#0  As$k8FlJWU)NkNS0r`řCX8!"B\83&g "]*G.`WT\V6B+Ս\{.Ck,/aU󆐩U>~r%dʍPBݫsq=}endstream endobj 540 0 obj << /Filter /FlateDecode /Length 575 >> stream xMo0 :ڇ:`(Ӻaau "qQcuz_ m~n}ޫ,a24$p>mNT;ʲ_.cXw˕DSipToG{ПEᔢnvji2"; 1nooۺyV2  ;?MՑ5b1_덳H?:wK@IxPCP8fN"38֧Gi( 0+Ѧ@tc }.V!zo&(- e!SbWrdKtCW(_A&C/Ƌ卧06X zwzPendstream endobj 541 0 obj << /Filter /FlateDecode /Length 571 >> stream xTMo0 WhJ>;V7,-YnCH>3BN$IУ[qdZFtH0|mܿ,rPrйkedN^" 6J8)o1H{!ݲ˰n9x99t1 $eJêĀ%m;ؕFÈO=rNv,W(k1dˋoN{ ǯ9օh, NUBʲouB"T7 $Yd|4MV6^<]On~i1+%1 jVssߖy Jֆ~&#w ^롑8n80L AQ~endstream endobj 542 0 obj << /Filter /FlateDecode /Length 568 >> stream xTMo0 W';Z/P,-[S |$i0k8Fv'S(j pܨ: 2 E-;NԽ\ ;e< GOm&15ݪ5@!htڽw7j&|=>O_{y>R?ZBĺjs~> stream xTMk@ ϯ{d$P=5 Ռ8v [OOOHF0A~!Y!US&ک 1^$9e+$8*,axtJ,p:ݩ4@kڃ>ݜ/?{pq9oV@+%:_ͦ}%$SJz)&8Y#KQGÄx2!ͅAgv8hD~ "T˧v9C֬qEDc. &^;ǥKˏmQ5![̫Lgِth]KXGu'=2V~-s&A)fyZƌZD#W>j(x]lr1ooW0 0 AsӨq:ΆaDv)?唺qI<1YU@DlE@/2E@pLo|18Af+6m26C4&ļ|\̂<_d%i-涼6w,6?endstream endobj 544 0 obj << /Filter /FlateDecode /Length 1002 >> stream x}Ur6zLbG7'ɴ&hSdD4Ow t"eib.g?_ I̛IMD! C&%4Z.#}"?9V3~.L#!NG'+9!ۻ,f2ͥ"a4O5fVѷp:u\_TN͟=XqHiyuFf%uRz1 pdτL̊[ô"z00EV+dW9qt>H>#i=zdA:S ƒY%v(l%E {;R=usׂz<#¥)rn̜S5f791T ;$"W%Xˀ /+ugJB+Z2=+%ĉE릫v-9zu/oCn`og (Ⱊ{VcBo5㱝Af9Kkdo75*)zq.oSB[ڵe ЊsuD7I?FMy}!ۂ]poŬ˩%ѯO`I#b{XO`p _=u-~:n臘iș\/zHC_ejlJe?3wZv]q3߈Hbm;N ҿq7\<94eqq*v!2ǮܜBR,:RSoeu9۵U9v}kfwGendstream endobj 545 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2731 >> stream x}VyTGfn =Ũ#F **^HԈ1p+00#7DE" D(FayuW]}$LM$-sg4v>M8'b3?"3D_5icZ84FƘ:YϬe<tt]#6!>B%B,sGH A1а-~m;fhsG"XL,!2bC6H0;-aG8baM8JH1miO M=L51{ljOͦJhzs-Nf~7 d}K6 a63" x!!-XD%8d'vrRE ֢\ܵ{_tvQ={6d+1`HO`)G?igp<^ Zw1w@ !VH(@utw9_7NhauJ]vڿp 1 ks%ʳ2Q<RCP?se{h>d-g$ I$ `qӋEϰQ1i~]vg.<Mf o{%$)Z}M. g3P[ŗ|^[v!HP@θ1o4.)ӔHJgSH# u8RWID(.0)iJVhZ<ӖVY1Q@^]NRWU~d֜/̓wO n`+͛azyHKȣP9$fPJ\Sʸjl=+ktփH$5JꍺuʥǍג$9FxPO~(JEa($.~!z\1? 8 X2>9/#́^lͦ`6RQMrN]aRUhK֖˨uFe<A-M@ FV35 , C {@g¶p 9I)ZOs:DahPYƒ!ZD@ *h'JB4nwSLSʐAeH?~o Q%ΟGd'p-`1XeZ-7DzsF=A/ OK#i͵!s6+Cw;@TtMrS`fni"vI -U=3 δ~#ZN͟n+XN'57L6Xqk<*,(c[,8ԒOd(Xtހx)3o?!`Sxh\)t\{he[L)KY_DߦfM(*r@xxRmMZJnS=]x V5 T:KMK3j ˵s |2<%8]Lr`)hqNTh$'uoKs?& u}<P> _!52;sE* "<֚% ~zHGjqNSuNl>* -ZF[{O緑 ;(pު gpѴir#yI)lzVV5)0x͡GιC#"=c*E1Z>]Q[dt{Y>` a_|nZ|}T"J.XƁӴLI%E]N+(@o+#|>*C ]oɉea;="e$ʬ8Y lebyoO(OasP!5B0 zCnnNGRªꔊVخRoSU'C+6gDDX5F++Tgtȳ}5ܶGqt"C(K,L㿹r5Ʊ_jnRkbz ί"4 58Q,O[Ec,?a Kendstream endobj 546 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 496 >> stream xcd`ab`dd v 100qtH3a]cOoVY~'٨Y|<<, }]QZ9?$H7?%(O! ((&\c&a9>0wOep?N c/(UT#ۢSϯQ& E5r YkvsRoBv_^ﺢ]w_}z_$vgנ@7 [&՟^uu -y\+wVf[oFZ;s朅eSjʫ ];ߙ/M:}b53:::V)_P.}Mq ـt6vvWloݿ~+zշwWvWO6{Ss߹]JweroZS=RZBgGW4_N;Ne]6=^n9.i< Eendstream endobj 547 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4047 >> stream xWiTSW>!#*"i 8$^k:۪UQ,( #9f2H@G(  CsFlVI7~]󮝵vﻟ}wsk+ r1{tTX+8:}%7dM +m.a]9~=|9ڎp~* ! =4rWP1C,%Ȩ1\6s/v{޻~_ό &kObE|@x XB'&b)1p#tb1XN f+*b s {OC%hF!H–.l:kgGyn5ժƪ;X[[ &jʉZI?uam&$>ax#F>2tdжGݲbjB+(]T[ xPLvax^7g^Կ@$= H|g}ffCl5qa+ZۿJOǎ#J1( %jQ5&qum\Ui"?Z7ʏfc6B }޺ Ys3(_}84S-5efcEءej翵@ L)VQ3N, ф"0o//"(11q!d-S'.s!-T’s- vw+XS=b O2i{ 'OCh0B_ *fIf{q[jj)%Dðvc "Pe>/׋`2jt4M9m=  a&@ٺB*TJҋJ@ wcDzy-]ł] Fym BȚ&NUqkh^Hr"M{*_q['^G&܅Һcԣ´Byv_3n轹b3wv_ͭl7Υ6bNE0)D9/T DMXvLVH6#\036%M]pOe)%jYY(bCߠqQ11Ԇ=Ko0eAvtsPUeV~W^|Bϩ{xj28v:~4GY܆Vw]'3eϲď0!:Z휴#1@@kHuu|*ߪ4LE4L67ӨRCQX3DžR!e|}]79`{^ U*nBty|h>9jטڮ: 5u:VkLR$)ӧG8sd=5,LTb;T?6^ҩsZ=;5q%KBjBqTf l}e22WUV*(.,/YqR)&WP.t2'xtqZ2a38`+2(Pd ,h gΈ`?y,Xd9SV\.mH eٶ_ q5 B܎'\. :EzVR╉q(E#;jԇy-T0f{'ʘղ_*+Rt ~j,N6Sqlj᜾5{%KOv#mpǾU"Ҡ0BZ< YGc+b`8:NeW-r4d3P*Ph s.4-.K9 @&Jk!u~rф_H Fr}<~08}qvIz-hL%: B$6sݟI812?N0݀ߊGUKC"/e+/3!=+􃦧/N5ݝ))&۟E;΢ʰc?ͬMA1YH :ZgyO,.ߒ$X{FXRFN] +ހoDsJׁ0*lBÜ{ FFPxRi`6CΌM&Ƨaf 3T`ck,!R}syC|ga34^{7`A{c Å$34*)u eܣ({\]UY ʁ]"7ޒ] ֍V Q;_3quuB,ɿ#}{*SΪeY\/D pQjBjڕ+x)&Bh8=0 8XR }V:ƸF\Ób˙k.KVPh|qtNy*FE6{P1.3ǽV m_ !ԵoGod h Q!%Ŕݛ 7@>hehֺd |.#ld;ߐ04#QTV>?q?vܯf짻Ihq%'RgMPY쀱A 9*=`DId8{7&gyÉR&> stream x}P8]Dd{ qf5ԗVhMH$"wǽww"Qt4jETLXkM]3;;/>Oa"(q9tXz\1Ҙ ӰəKkkd1$wh>)XHeeEU"E60lJypsѻ4sgz VbVcX%ec9FI3X[4Ot(.+/l;\L!ɣuسW{F#mɉh5ƒ%6vaWF/YIj5\??gu:"`1% Ypz'OqӼn==ߩ3|Myri!o^AwDMgҨ/ќd &]E0؃wPb5% ol>ё᳿?>w,6 +t+bW<s^Pgjgm:Y~X+K |qGĉ;>h 4L<ٝorY9˳^˿~Rby,9TGKsjmpBEA v JUy1Ə.^AVzpw97w 448mcCmmv;M6xgz}ά}\H.BEKQGOw[7z^ĹٙϝroPJ7ɥ;1W p؝$9zz+W.r /HQ 3F`Px@[3Vo=)Cc4Ҫ0m ] `+Q͎-,` Jy1_=xKPy /})ธZRӫhݤ.\S{mwC+"3 xXV*:EH[t ѕ87ndHYPKzmR*)`a ɋoq(h{sdH٤+ZUVL_ۼ-ɧd:3{%81)Y7H!׆pA:ܕ62+ j``՛ sOA4-"$^g&#HA_ɮM g^ɌxM=79tq[99:*c lv in>(>9t6\}Y(G":z;9(9mAo֤P{taNo ׶( T}?vV*!Aka݁Viacj i G@A"]H`wq!>+:˅Qۙj 8yqc6SOƭE*RǬZ=)[VkR\]ŃW; /u]&5 Tpsye]3o1FbkMR5& ,W UZ1ԍ^~tbj>C$![i ZA@ d~9wTMnW7A2~B-uzbط5T eU>/G(P Q[uQ,EmBnMp&v=7vM]Zmha SN=u*2|n(GWxEk}d%vvp\2f?wOP"m.} +s(@(Oc^HU]_ZmBިZo=NŢ>$/՛F%^c`߹ G#c}@L6b[PBa{'Q~J&uKbN,klρp> stream xmPTǟܑxf& RԠJXPvA .XX& Ƭ-j" kBR& u2zWd2χ;FA3Gak zi(Ryps0A7BX @ @" b>C&yK)c$"64\Z_V۝yA11@+Bbk|~fJV4<5ۭ=nc ^^^,e9."噠a9QsO[.[ n4kqfq0Nyȗy 6|SPW\Ჸ07yk擝4M+ul}$ {Z֔D̅r] sۓ R>ў裛v E7OԯyIPzr_{煢n 8@$We&OJq<)Auendstream endobj 550 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4664 >> stream xWiTS>1wj,6uzUu"2̂ $@3MF[D,( C"hE2]Vvx=A;[:Ynp=zx̙={{Va \wlmހ1z|-G\4&ucah8"E3qCdȮ=N'?BWFZ&&@ܺxI`B48dצP[x ضkyfzDb*Al%*—XM! bp"\7b=Ll o!qp$Z '}Hb1C  %:9QÜ {}m6څ5VΐoRʎet=a㇟7Ȉ#GV;at1ԏiWU~} @<6;U¿kU'v0u Ow^'JpEH-~I.Dc{x:jOŲGIK7iy/ Z8GB]'RA +[ i̽GXd&atFσQ'brP2z]4}n>)"[rs~a$Ť&j_@ ` 8oŜUFIS%txcz;>x^75ʹf%7'`@9Q\WN /*0:iZ nɸ x-BĠ2A P'm9;gtJ[:7EC?|LW y .VX*Im jm(=s~˲ O\'c B[ }?.րCw tba̳uv `nA;-1e!劜bڀN]B_95`MD(iH[-A*{fs2]n }~:FT,L/R_n?3 ˜"-i ">!@n풀%l*=<[_6@'^\Lm-XzlS'_IbRBxbmPM`,ܷ u3)KAho򘲘jy5.wXݗO%#OV&-ӀU5mHRl%BԬ䜔O N;>='QVkd/>QV^a9ǜe4Sk{ /rV'u2y0\HK7ȣzAw^'*Ϯ (rh:Ix[I.ĕ }uEj/ x93e3_2 ic4ii{^ZGjO늽}_ـ"/f . ~a,&st3c=[*\meLOū`b} 5:B0H>/}&UҐ$;AҦa\͛ʿ:겫dVlb++& _P&nN(N,Jn"هQp4"4","4Q"MIhA@&7w Ďxhk2fszzJmo]a/=hfG̋l@(;( 2>KQ{\ 3溦gf,S!N%bC++ +0qcUJRkUZMz0)(~M0BQ\nMdT[)Ep2᱾ޚlќUvM _oQT-ERMbr3]OBI6MyʩZgHӥp.nDgN>tjx ELȤ6*M}in*&=#D ʀ~< FsMJUeęOZL© :M0[YAViӑio_}tegb΁P V~#ʡ=hTVDxfo輠rdZ`y{sk+ыW=H{&ӀDlOX*J\3败Ki| 3-7Q;jp7"+V~.<dքIxha_V$mxG d )[rmJXLh̋c1*Iޟr^^hu%b`sl4CB Olp=tX֌y%.>YqCtH{P^/Re["mtP _&}/.mBYC..<:y'IDǷ3޳68 K^.]aQ{i8~tQa( S (a!#FʐḙK,OEö>M aZN+H*J@i؜XD `Y-Qb:[THdb }-uG2ݸ٥,BCgU9J:"@9LA+w6D ;nS޻'V|7P#,r&JA.+Fy ޺:-R1Q^aq52uQHp(Z\+ElJ8ݷC2XulݥM<_P9>>x3Bu<sYY55Šʊ b.@̳&ڊXI_f9d ])-{gv{#{ ֨%zֆS~'G[P1m~=+_?:B\1[ڃwuڠѭ<3[X.;w_.TSB W˷)BOvbe"Q+] T)Cm![gvk YG3Vnu uyz jke5eOf%rgbyݾ#GkŦT2kNaqXU]/!maUoh.'g\yPgdxY^$Z sAǪ01DA N9t2$Um:)'Ǝ--ͶRV+׼oM{܇ c =hcݡ-JB⶧ ZIfh5n=ʱrV~1[\:h8*&&&:zRBQtzuM ;tW5պ>Lv~&iZF+,U^) u^ ,h|{ BLfy')e! 2U*KjȌ9[̟嶥^LKD($/b[OO[ l*/ (+lp.V|٥&x@#&Kn(^<gs[kwDc/L¼u"=1l]&KD{fveh3tVsr^~M6sq ,2JϷhb.0RrdޫCU='=',bm;rĶ~ûD տZ$'',u?DEᱼFsh%pBo2Ņ>l`R-2se ‡>@|oX, MJPBd xD0^0PLC16Ŧ$)gu@Q(wq"A$tYV"2 YUƲ*x_ϚjTe/aGP^\$juZCi7,Ax Ϲ'W]~šU6!IuXӶշ4^}z%=>E NwU*F"%0(gaipjf^GΈ ά/ԚQn0WdIO=s8=\_6ž =endstream endobj 551 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4175 >> stream xX TSW!ޫ"*1bֶj El) B@rBf ,FTCWj[vxG _޺+Jpop(g'  :eLǗN1Xӛ{kȅ\ki7s;rp<&aq1m=(<.:/#E͘'v8I[-Zug۶O L<5@mjDVROjj &S|jzP "j15fPKRjN (j R LRC89JA'7$JkNv6^n3yc^^K1L(,˦hxkAi.]\.\5UwwȺ!-C' vhЇ9KfPϝTeRUl]TEyPRSソ`~jl y=s9u){˪%IEO=g"6bEa1 G{ (D$+͔|DRحfHwa֖=> 0BY,ֈ=x6Lk !z%!z=Q t=83Xda.((箏 d2ͯ0 ]AC0`ݳbp<5d7{/]]ɓ"v--A 4}Ǥ-jhT(+8ceߚ8G[!gYZk+*6y_;QQd;c~z𺬄<'SHlH E K#O24 u:ľ mT\jJW<],T 9aRPBܷGDmLMJ%Ѻx]MZeJEe$^Vzc_Mfs;g0>t|f]VuTzwؾbD7&% A7?m!pY $JOGl؊GD䖚J *jjS([#w(ݔj/J>]7z9C.'Uq%,ηηvrUZ%fLn&"pg~"j9ը_< Ӭ02(Z,bZҖdlx/dtBcQZb8E](Qh9DIaۦ|oxZ\ Ȭ}\86n۸3O_ٝSÂFY6ضy971<w C'ѩy}HYR(x t:ڳ,ӝuk3l= pPʛx1^s'T])%ٺJxkE8 p9aԡ2}Y<8oEUM:u `L8MȤ69{Mi"~vp4agpQ>P-/2~(}]{i_z'!;1T['[(&G06]veb$-iP V r%[k> vFPϠKQGWTl2mNiD win@W'uW>?kCl>Q\#EuȄjFz=mm(rU_E yɴ1"@2'#CLW%Hb bٖ(tG-rDI#6Pjr=5{tK5kD4tq쩓'], v@l_;H.vn)/9V+w21ϓ ZaS+Sfy,ԕ Pä3c=)U@~,5H0M#'@K lF4RK1v{NH~$ l uw3oH{F T$4 q3e6f7"ܭ0iETZ)BgNH( EWI^ȴ: CSȉd n_C!S` ^W@\\fJ)u$#=$cKnr#fCtlgb9^JɊG6^J݉#u_U M{PH^ܩ&!I,3ng3I/f1VVAn|Xm/rM|^hoӘ(;ΰډb>ѡ{ \cu0ZQbiٚGc7b~ Z='{joQ ={4ruAxE6^.T*T[O%V\57ds6^(9) 1JfU!ݒZ**-k = JO7;__o3l_ϨeBuNNR9 YuLI9p[ 0cO:J$}1f}1Y9J$emł+^1pί( +i`OAɓ]]ldO%cw1qx  ff L7yܲH $w:ƅ.dK3Mu+|` vP0d,-1$-# =Fؽ [/7ۂ=ۛ-(3J$^1"-'`'!LIzF=EW KM_r[>7 a.|O3V8Mv+q}/Ol&&'D`!?Jdl!ưPS l.O'fgk\%Fm!*d˕bcq)2 e;셩t=jun{^6ۄs'2YTG鳶LB-v{)V=pO_RtV5q!4B&/rvϝ|^5\Xx/aOr-4a=C> stream xXMWV0j$%8 ]P,"9!Ki䌡EիWU0~5+WKYqI#:Vp*LrWGOۄ8ORa&XIU 0Gqݤde-fIh5vG5'ʕNg2_o^}=F5zIvbj-~4nL:?wܷi۬=XBsjnE>#:Pk X9{͓>9 fX]TF,fe- e)72fd: 2;1lj4U嫵m7-y(0QRBIMjwb7{fY8}ohrKNAp^+ ;{TU.x /deOtƫg YG'v<^kPSƐS<kpO)Fxj,,EgzVAZ(Ngb~ 'A7'A5$J<8,f`9${jTCvH&P3!%8 !3&lT *kj# كh1\]Ѵ){3!A6 '^`DQ~#(u.jiON~U{1z)E8俴4kēB-Pԗ'jHksVűSQt]+?=Uz B,m~_TVMg5 F_u%gܠ[)]aKUΏBy@OwuLUf,D!DPŒy5yq+aq0-j2oEXM vS9XlxK>1tas\ٍCɧ\9XXIcunP6yqlWm?ExPGGL.-flr*h2$eui%ǘ1mmp OOh6w*|^'>rI@9!?wW~n=L}]P* ׀KUyL!o@9j[Ҥ@UnPJZNWţ&iVy+G[ '8^PM{Bdd3XplWk-/6OѮ CS/l 9>ENA_ۼ<ʕ,Hu+'Dܕx[,!J-%Xmx ΋ȰPendstream endobj 553 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2706 >> stream xV TSWgf Z;U[jV[-@AkA .@=D [A : UQ+V-bu)`Ŏ:jmc.K69g}{{w s@E9- 5mÁM/%91hycB삝i/AW;ԏ]Sf,!UL3'+Z%ibScrN^j'/R2 SAٍ-\pdU:U5k,\,R`9NNI٨v)@TW-2y"s9njcNk8*]mfH7 .Qj}٤b~diŒ Nێex=)ݜC7`_̯{1!|8y=CB]?e7^_Su:)ӳr6GeGav·RJ8_ܑ+2nZϦ.k;(:1e]-+DH Z6-%fem.{Khkb0>j; 6^vX!|'+l8=]ݟa%g0-F3TW߷w_7$%/qn)KtggNǒB!ijjpkϡ]8m.L\qֶE^/O, Y6dmXVVA ~~sw}߁8q,`y*SsԆeU%[Ao0G >:^eBe~R46YpJ|S>sV|D7;3f3>aVȀwhzK{釷IJZ&-fpbހ?.!Fa_[2DRn{iG ƴƿ0OחKJ`a ǥl >0:D|! &{ V@xg1cg"Gc:&ȻhQrT9B6M@K#`a_€(}&Ŏk+bX!2^ jۙ_kykHy bt5a!YGNIh#BIqendstream endobj 554 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 9237 >> stream xzx.B :*6PU [h!d{-{MHHHdCbAlѫrs; =;=]<_~?uu?xЈA-}<~YqO,Vz<~saQaH>u+znb `-Ϭ򒵼-}kżڂa[ޜPhbIySSBxdLY^7gyoZP_QV :l;⩑G~ٱ[ ^\Ar F`OasX?l.*=ǞgBMl-&a/aK@l 6Mcӱ! l(6†cc1{ [qXOXWñ'0 #nX>~l 6{===-cv0or^]oz J NK6wm}Or?} <H#-{ӕSۍch =l+ K{|QADžO~Bה&h>'_~`_߯_?3=Y<5`}ύy?xR|# e똗361M*yp0yg1;7mpNGO7pTCbj4.y&FsfojTѥh8Oɨ:$¿ٔKok:4#HZ7W+?dtzFLQDžJPiHhM@Jkq)PV'6xjsMԐ6t8mжNod OBfH\$ a]v3ޓaIOD3.TUʽH5]GMY6y6Ld5QM:R H.([0 DēJ)np+2L/;cᕞ߾n& HTi÷:klzo/M _3/PQ] + v%Y(3p' [U7K6in2e`{&ȇ .U5f%L؝{{ǯ 'pW_WK y<.efP ۹l)rY]E 5n(%iNCBSp+瓖o]؜^@zDWx0"LN ̼++un<hN )FYԈ*pkTcZFRU@~'DLdv]Ͼn[]a#8Pf,ӟy#f|Â_Y!s^j| XTcm<2xwx^blǦ1 m5 iuP\kήWQ٠,⺈m* `#d4oPs/s)mn@;x?YFe- 3kp(@q|Au[ѓbإ:`*ިWx { Hh;OY[D-K [P΄ " ĿO|ML1LT5tSanax)>͑ªWDh#,"8Ұ 8N3pT'5gO/aO߁˙}Ddv^GL|B, ,M낹 wbQ)5Q}yt n1ʃڟhi(|>\3]\bksgY~}wf"ݯXj/mnћL'9bLT)ۍ*8y" \7BO:(U E>!#%bњm2H$maYH1Gׄ9!Q R N+46Qh`11D`͋2Ero@nQ SCXBljo0mCTJ4`vx 0"\g9ƱTEBJ%"'ptwôe˖ ,ay?u(l?"!1_X=h?"YDW(^nLp"|>;=rz3=9d#rn/ o_`f}FYuk)vAERHD\TuUZL̫ꗀ!TQ!SV5GʊJB !ʒ@8: 2y;gD"InĆ!Tre~Z\odLJ>ÛWJ%+-EUwӐa'Bd! 2X$וY"l}ˊo][l["ú}`7^k4?GJ}M҇6Q#qT.)Rflaui}AD}.g:vmdQatQpqdQE x CovO'$:NO6P,S ?cQ\~:J x?L?xO!gysPGMEsam G7cT:xۘ'm=`/GG%8XX5Ղv^'O *.GYBŗ0{nmk/]VFCzznb]$&cI <ĩM=!1mH=zrvqYmq@,G383UW!kfWsc#JdLQ5Ŀӈ]BdjHII@$JiܦP azq@HoU繀ՄxbTY" f"BD'Ջڳ]ۥC8q̶[u. Ђ*sŤ,T,H#x4^ʗXwv$W'-))sJb/^E9& ij|:EVn}['liMش F5f?j~I X.AG e.ԝxȄ%EVra|ԳEæv\?R{mtCѱ5JEC'/*O.xƾV#BQ?2"# (߱xL!VlUPսBoƧML{+@+sGOߍ. e8:Xg ܄}:(g+X6P0M4U<լ1iinPl / m9 HjRؑIׇQ"DrEGO=A$Tͤ/Obś}hHcۚ[gN=~:Al:` e\էB9ePjmY7E$ }/cgϞŷo5/>ͱORӋ^qLBр&.# eN8ɫ'>r͇bh*\hKƎófӾ:yzrKgZ5O%S3h` Ns6hlbb%;<}xň"x#KD1M~DzT<;؎ %M*Í*p ]MfsكrOP&;z8 e χ=<.܏ͿY۔F6K&꾷q*w78 N8OطڛcT.[3 xaI gҹ 9, KlСnh0>bM8%iH< @\-Duq'mxed倘j9p)jJ8bJ[6Pt+)wսEqv'W,MnV#:vkRrl(|V ΍9۠VIo 2|5s&M2x%W!7>&VP+mZis2Y4#> G>TrLOMO{%ka5oGyazEPc*`UҀs~u cw&}# 񛴇0oե3AlB&tki|6| BS A͌8ǯ,2r W9 ʉ /ifu5TxA!g\t;{>~'0c'44:~x!{5Kj(pŊEK:`gvNi|FR,;µ7:$1 q[DR_R\.+pџ5 mw[ÒKc #WǛ$9 oQJ@r wҟ=FN[޿>އb&|RVfJQ j-iNyR&b`L Bؖ,N `-:1jXUDixrU+Y/j"OMP̋91.+Q_Q-7@@ b S7b.#.Çsn:9 ȟ?}%g50v!Or3"Zxm&k!O' K`l+}yQba=U" _gwr(C(  Vn;Y/bE"ln\\&t1'/ ŌBXɋhߌR\8[]|Rb<|p.%2|.k|R1U@H S[ mc(џJyp"'"O IوwA,Wg7{۳a;@dp d8OҔ%Li{ANo Zv)%%@M.ݳqfG8AM$u< w6$j. QDggp2Vyv3 j5] kY$"A;xy>ATp}' 0D"t_B@Wv{->41q *zsHU$A4"$U#g` Vx*hGցH"ˑtwe$v$ԋRѿW Bx+q['m^)L>]BgGk@mB F̉3k;vXA eT|fae~~UBaî +fj0 "ݔHfmRu2w8w3 S!.~MB%RPLs>ndψHZ-M{EH#o2 " x"%dvGqJ}cdrQ mDT!A€*m4d+D `dcIr9iuA\/ 𩗲F|G)obPeYlYxa!@ܒ6ZH6TR' ~&cSb}5?g SJoq!6w^8x7 J Xgtq@s.\W׹FbܘeSVkL!bGA!D0+UU(3o%H[|ivOvnᓙn*CT=)TdV 4ijhay!f' hmкmkr/[M% h9:3у.=>2qt> GsM'xj$7X O(}Bz/Is='u&|0d.`tj(H)9jLQ.,0w'v8OȽ6`. Wn@#&VdH; tV]_lH3iBluamw+M:n 0"5^ְԊ x3[M%_eU5uf 8,w]͇w\+)1:x Qm]"ɘlʈ3l]oZ֑L 8sב2J/oJW'H^;|i'{mUVRv8NTXj$'̈́*%j^r`(%Lw.Ԥp |\$i8X-_<(ă4ht44{s<== N@0~Ћq;M&AX)S2Sg2.ځ=tUIArB+;QFXٯ~NND2\Y/5H1 F3cb OWUj%QD;nyNoe0H"H]Tq1VhKuHyvD 4 tet5.16t wJaw}9~>e(z} haܟ!O܃" K*\]kych7T:j¶刨^z~ՅWk҉GHRR虻m~u緧粯pVӱBH$:)< rF3!uZE, YżUh%jqD]D“iC2}70woAk._arOVsKgYgbRq9QYNrEEu 4xly:(ZcˢjMkf?@@']q5`0^ Űqw< DF~ ,Ȟ=;PO4<0+:+U 8MP͙P[b|抒y`$أ(kwiWVp̷lFY't0SuEUTk@ ~I'.`8>yVa@KTFa/H?@ |5C@SȂ"΅j3;Eq(sPŖPy<(2iZdԩjU &MIf̠Sяzp}!֘րQPm LXH4(%.t\H |^`KF=U-qymT6t/2ԪtrHXчlK]d2$Љ%#X,^{eߋ@-8 97\Th.s5c{Ft/M l!]HnS`q˰ eH4XH8[eF F/p(VRdV█2*E9o&ȇMvj_"SdU򨅼xk7]y֚I+sKW~?QܬS Kc/Fx4io_MSJ)KO]*4VkWxl9|hzPO!ʼnf|8g^gw:1!;Kfk}& t$!~s;Tk5u6'WG~CJҤ~c@D9nhI%2a7"N[na#}./A<8mbQOaGE++W )4(T2 'E qNJ#?_ÅE7ODD!㝻rٓ}H=2sɀyI/h|v'*8}tEpԜ%9.M(d*bG n$c_7v)yۙ3g^gF*X UTG,] qvpP8;!CHf 1%rJ.Yw,tMT"0e_=KBHp_dH805ZCZ_vItߡ}caJ;endstream endobj 555 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 349 >> stream xcd`ab`dddw 1~H3a!cO/VY~'٨zxyyXV~?#=[{TfFʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=土[PZZZDz3ߟ?}zZޕ*lqPol5ky}Yﱅ~mlJJ _{;oY̘#WG .d4 }n9.<&00 ~endstream endobj 556 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 329 >> stream xcd`ab`ddds ~H3a!/,lT|=<<<,ko!={3#c^qs~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWvt-(-I-ROI-c```e`c`bddqswm߭13#љ,,󍭦l~ ~ZؽpAEwlue g.0{¹ ~'Mg?u[|>籉<> stream xVyTSWԖ X{ngjq_ւubQAYMwQDn0(.Zֶig]N՛333_3$'77[/%$$ϟ[{ [bKQXo &F<7bj͔)SǧJGbul1bXMw_ /iq4jj `e*Fi.VSGhZHH++W{RdRa@ /_p# VK6Qwc 'ϣ I_,RUsa6-\(R]nۄGISFBXB|tOzuP|g_L[!\u MsZ.f7xcSld逩2>5/Gc_]ݐ@n#, RY\vY I=4t욼@ zhXzʛSD5诂w6FL#{խ4iŦrPdk=0MYmFkZ/֎uM*O >hlk2ˊ=oJ.++(G)h|c( )S٥1>^wK:.kYm7H;- }JSMH%s/+a6݀/z^S}%zPgB-!(P~_'bh &\@yLL[J IEB⣫h"RHi E]R@ļ-hn]jHڊ_D7wMFVEjxȽ+Jƣj>!3$J4":_[P+jd݊koXoQK4"YSb JknF{!0Vw'ʴ-~c3ahQԵchFݾN@Dj =xGO\/zXy|X 7U)EWS qV!+D>MDΡ}E^ )i.[PzzlK&&`M2~zlD͸YD90hc؈ŠHmK[0j nQ.7Y"Nv6Khq/Nky'$)KGbapZ&I OG+Ev9F{V<LCQyD_3ꡞZi3xKF.dJ1xgȤnVE1sz+dZ9:E]%61[+BQC?GQj7sl[F_3$ 4wDk-8 :Q%T*X<Ƌz9zAȜb:{hnx|xgB҅x"l04U zt퍞[yrpa.3$FЀE42.MU7ezFTۦlM |="0^s{J72 V `fT{m.(Y7 pm]l xl{c4+$oI5)Vsз x2|WELMW f҇^PINِ$>aI Ib*[kP3V\_%յTKPD(E~aSY&!Sy'2}(qzN ('NAwzrqu`pXdhR( hByn7ڲ); ΨR" Ce] f7|VD߿\) PGsL#ApSgqh7:H*)ܧ )Ӥ s0%|x~~ 6Bqq'fRQC/< zDGy'P+|o/O3VFyeBkȷd:g1$V#b.|Q!:dr [M0o 12,sܡ|<"xmM9K52X&M)bVkIhE/UUj՛ Jd~qLJ+-7%ՕeN=mvh3Mh;>ۉfGIF&g`?ERendstream endobj 558 0 obj << /Filter /FlateDecode /Length 5006 >> stream xKoIrW aM1`0{D,[ YWRL9 ynV>#"#[|?y8͉R,m1/|=pBO(/i_WoOnxv<ݒ^kYn~8ҶbK(e)/7oOW?޾/7>{\n{\}s[e;?]]{[Z?||Ϳ0RҖ::y}Z?X_\sѝ^74l|_}{}1-}[A7mo-zfm>a2։ ~}7oO?Fw7֧,"Eiy|w0ȏ10Mջ0#y~Ջc6؃٠0|a^Ϗ?  V[_|e+qipc8Qz GRS')^7J 6|QA~jLEU  B\)QRҎe U[Pm AD1%oXtb|{ . G6e [1V4OvDjK=Kֺ4\,ee\6;m  "Jp􈑫ZYFgWLQt3yd7Ng4a8܂غ"aB 2߂3:n C3nT[󌊞A@JF#B-~pξmFpNDUFb"R:Fo 档y_`*D`ū]x])ΉZԶK39c!Sqjt0*5qX8Zt΢ԲG¬>^XL עx4g /MÖvz(M{VhP.؄++=X_xX7* 9*&#JZ^:@ SETph^Zadk8*ZBp0ѬyŠ`q*t8p! (a(51EѫK ٰ9lMfƮ.R< Hn œƓZu'`nUNrPa^[x=31̝Qx vYKs3>y$dm569'lg:jmPe*pUɌuӮt.*"bJr$PHi3p*MEl$6 -g wQeh>jDOTb6i0Sƺ((8HzX]dC$+)l c]@ĶpZTY49 1K@tkXDnz!'kAZHwQ?6..0l_Q kgQyx^Tp= Y𽄡`&f@38L.eѦ"iRLExµuDhN=< 3`9S$+FGT^ǝG ,t8s1)PpPM0)BCSRI3J¤ k?  nN`)C! 73̋BOr:v{шm~LPU2+B jӋEiZhS(!3- C1+B٫E$E@ E6U"}h -*⛷a$&CɌu-~A(i bQdkU|J5A`j3'n >f:ĿN{HX T}[Gthm7CvB6L%@ !ff NPA7XQaxmaBT0.i.0Shm8œY T.^AI 1Q(!*HCv;.CVSlH bNvR~ܡL``ԱPt.0BĴK= 2=0 pޫdc#MdHca#h2G%9K'@`6NCI-`d)bc[A:CQ2j3wpѪ2 JSR"l{f]%UQd!P Ę Q<2'价&JeQt"S,B%lpCa>ŜH+QL(N._(f>F4En*zυy0M\"'/iW! |jW$*i3ԩPVOO2`jdfiC[}iVWX2*sF@UaJGx̘k;ju50! M-}M h8xv_i•zV \G#6ũP.Z!FZr*16)JZrJ=5:v;<5OUY!/28gI'\\=I?2oY 2K?c_W)na€Ϸ#:tuLS&N2tʗJaV4_*YLk'?IRs5R:MS5%NAp{ɊWWujfҩ`UPbO!]iֺ-1PLNN;-vX\.Zδ7d^Rf H@H6nGZ ~fʒʍ)xUX*iigHɽZ2 `M(~#\2*0IG*JYbQXUUƧDjDKifYƩ(p(/DR`D41̬VQ&g~(6o؀2&4ErPi(@9>Ui@9bVg%KN5r\  (W/rM) 0V>}l%öSUL;O fqډ6ȆiE,^2|b64E_͚Ck1me5Qa|Y% MQˆ4wŊ@V1>)]C) &Ѻ3'uSص*zyklQbu5 akg&Į(1l5?0k_9n8b-DĦXcm:wĦxݦ I"S &CT?)T(LĨqBm =!nRC|x 6a_. `qd|7lKj~"5i*Ԁ,)1ɗ7 ~6;d UOA(}2bOf dd}g gCag&7OoI's&l[V1ɗiioMhm쳳d }vX{'+dX';AF *d~ $*ZO0S>OOXy7oK40biu5gɧ}*Vp^gz'beOL)τMw'p3e  cOmaD'lޑ3JO_'=mb32 m }rTe"쓠_LKاg$$]L#t* \Kqt(Cv̈ IB }ff**T~gJ>Ov>C{,. lB6> >7g!WAg i@@Cl 8}0>ŻT rA>ٍfO'3'_J UՖvw4;tqsf: [Qg֫\G7g.;QgwgV'Nq?}5'+VY?g$4g3?U?* ;`R'5Qr8ا9 Vg ;u~h6|9?Ǫd ҡ7ڍO\[,c;_d43 Ozsv'_9aUV+' Yc#ǖյe=0kh{ߞ H"endstream endobj 559 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3621 >> stream xmVyPfQ`Lhe&N>T ("2 HX" "( @E'dGql:31h%ަ1z0/_ի?߽{1}= =ҢRb#dEO+NEIl̻=%fCA~GJև< Y(h3s2ERfrltLR+kL?ߘE팍N4Y?E%(G%`fؘ枼fgJj<#;3go6耘 ۭYfdEfo0?l%cf-c @, 6`FLY`fcK5fybKf-Ǽ13hl36cL fa116b36  Vha>d&v{GPEk_ˈD9 "Qb~& ‡SNiJN͛z@dmנp!6#=#K#op2#DT51J*PS2tV $;rs)VGܷDJ[G$ymcESWo$2C *$lDo6>3 +%)ڣa(@wAFH#DT=bVGdBW8iD-j.3*^@2$zVKb 4Jvw*mU9LHF_!URoJd,mc+:F/-wt?:J}84si ?7ZO;5b%Ix:池w%;+_d_b?)G1`Fm gysYdI qPF!Ch]t+|swԡ I6&D33mQsWwTWn7:qćך%E<|pzT܀N3"/tI2ћ~:k8$*5f8ONP|2IRѡx |﷡ 6kuk"l%:hz))TtH]-tj7M*~:3)e) T4KLkH=nTX{J4<d>/ ;JBKSh}?%0h\= Tt)L0fxeE.1 jofdvVbv;Wʻw@2Ur_Yzqѡ‚Å{~ 3 W{ % sSϐ]t!OOI5_-9!+d𯌏L\7/~:96ExkA8[jRn?E)E'2} ^ %gӥ;yu@ lJ-=J./y/F8ōLyh)Z{i3rSs2s{`$+ݬu3"(ddF` :rx/y\-$A#2bx>LyKYwr@k}24uM^]t9K`BD"(}Vqo DPsdHmGw" mkZ9 h b*%&26;ɷϕ԰.Dp/1뮝8Sri%TpZ{{8No1"jMI?t^)oa%v sy"Vn { B#!YdxmfW? e^bML:} d\,q^rYLO#Mya劘{3 x4,nf"3VR`KPT&;n6_Zv-IU[,t! NkB﫷#ԷEDXqZ ړ+[˥%;Nq0` kwȔx}VVnjh)C*j7#WJsAҷ"8)3Tz'),XB_U@v'3ɔɩ& PS"~7=60 :zdjCtN®lvFƮXY^vyhcPyvcYݗ*T +t^ &HD~f/ffkBpc:B ^ dy"ENTogcP%FlE4ګl-<1(gٛBQNB L“qR`%6]{-?>z!J_גɯN=9*kYe-||}ylH JF>*|@~򠤧SwYd[C,*q(̨m0? j(B*>U7ACȗea@f^8r/85j͵JoXx.NgOs>t,tp}m{"?`H NaE#Эw ^ d 8kɻUV=1Wf;()THLW<{ī#GyvW-+8bv.Z \[b{?xsM.ߚqZW#[= GPO8*{ qz0l^Mad;¬ňg0mm~VeyNHLޞ(Om#]o~m_I% _7p. @oMAGy%m;6bbLG*+k:J)A)rad"s$ z? .xGI_ K1rOY !&|/ĭZ)46poZ\YQ"=jBt3Rr?\=L?.[fɷ$׭ՐǗ 4]#^bM&dx/_h.-B _C K?A=d3g7: 3z.5_M&gW8%m,n^\Y.m $Cc]ȅwI ;4< IT>2 UEFlendstream endobj 560 0 obj << /Filter /FlateDecode /Length 3943 >> stream xZMsWlɇ,Szz']JXL`E )= ,$TR2=3=ݯz?Iߋ|W2\azzG>A*-VK#iXx=~.ΰ6!M<]j2)d9Op]/mWߜaW_lar=}{s*MArm7? 5wg.~KSlr5?O彘ASz- $.$CnKpR޻]2f)YtSONbMΕz{o_c.Rƛ) 7A-|LPΏKh_riMH9'/xq/_&WVx\wǝnzFʾ<:{XnֲA1Gyd4F^>>AɏD̞v19`﮹KH֯}oOxqwcs/|xZ -:?YPypLݫQrvo6<ۼˇ~eNpe:yg%/pܵYL:zV^䖧ۻ6Pu?uZřz6O]0 ؁y=i2!:lWknV#rE9QRjFRYTe)5#KRoTpTZJB* 3: _tf2!!M%'o3&tF)ގ1E|X18?!;pKː+z:A_+lNOHŪR&*R31{ȑTH#GR!!R#GRt$Ց#9TGuR {}Q(W߃{C\#~ɗ?z揞g!kvsx1<ӗ 1(uρW3_|6}<"},Up; S@LKKw,RB0c.B7z^;P }zZ&YEZ:F>~S'o4#&x^}^f?qmAD6ov॔yBG : $YeB%2YkBBGϩy++b1cr_Cы2xȉ]4Hj3g=rT@Ъe HL@A_рļ9w}%'!O|m|fKUBRiSIVJ&`NCA(T?+a:X6%BDʈVDVI{PĶIuqEgҩ57F cjSJ̢d{0l@cԖ~M Ti 6)D0Mz;b>xaZYU|';BVF)H* 6!Z%Ҹ\R "t9P2[6pye<#i#mGJ#Gܪۀ$e" &A(2L@͋rK]? NpyHh@I1L#'LؼDsLH ! r}o$TM_&q .諺NwGro0Қ`@ k 0'4 䳠jNՀHoRi<0d_SG}U(h2ί*Y'K-'>n8(ØERφMd1"W| e`ߖA˶dPԅJ5r1 ]=(J.F\|kr1V]*c("gClBD xJp7&S5\*kn&WM3v%4,Zyz$&=rTD%f yd)*(٤17g hH%1:s;8(,;'`8(Y ” JH l3a 0%*K-0*Q%sR6M@*X ِ|D)aoh{E %NvCC ݲV}p5Y猡!f NLuhEŽF[vPQ8ͳwF?ZF(p6JAC$ `UXє:W1VrL9Ej4[oZRG2}ZSF?=7Yd!Qa~Yg4xّ9}"ifZa+0*QZ?[^s|mphdl$;4Hմqƈ.'*\2YSɅJ 9ZBS LݥDgF[Cc( Ko<tβBO xF {Yd`6lv(w%q5xٰyt$z wXfame73RidMNG2" d*& mo+=%p>B-$VC* .4t O nv8p9 5#ߛX2-+|v^^"93prJ s s`Zj}4']n?ǭr4nʡ)MDk,*imV7CFljG0;t@"[ JF!vDNfdPKZ /& @f}, q#}=r[f[(P])߳ry\ Z6te6:z%> f 8ׇ&Tqwy#kKV ·;L$ u)KmQ ͐H0H`WkB+"fbaM~MB2Āl'a#gHQu;@k={=R=&|Ihmo4[e6Z-j tb*\Mu 2fשdS$7{6Xq!`q1{;L0"yBě;WC,v=gy;E!-%C :Z dяh\k7 I$آ[bf,0b*f7O|$OJl` &줔lQG"t:Iк C fQwՎv7aeG ]"߂2u3oJcGLTD;D9E!͐L}cx\ΒH`,s FId"c6qv8g{j&^Tnm^ kg,;4aS'A,>?7~?gIendstream endobj 561 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1150 >> stream xLSWkN혙:D)N"C,Pm_uAIAy L*,#((lN\e%I g1qvHOWXkXvE,EЭe +w欌^$.Vb׮3V͘m%Nԩ*K QXYn,phnjQW4:ț$!QA8?$@MLn1 x)ʺ3%i`IXV@M^| T[*~w-8i{x0>@&KMo'*N쪝gKBje~8Wwq")s8JǍ!7_ƒ`sV;;GFἉ={/:Gj&!nsp2`|s˶Y-vni4೓?N f_3,X>A8|Z8sO=/<?DZPt!`&x3a ̌SSz d DOH t_4;:^V] <T0g,|yhRik| ^}Qt}@U7#\l#|eNfb34Îwweڪ,6^>u'`?eF(~qk1yYkc}(s7<7vBG?>vd~Jajzs;?^*I[~nxE 8oncET}o FAP'޺Yu#G#W;J)3w_S^j,)YXcqSFu\m[85/YI7I> stream xZ]o\}_qM7Ï"~h@MV (l'Glu_sfxwW4E:wH̐),27|ט^oےt5jjI-FK=&,nĖ?7N16I^kN_m\5ڢ!ub)dNo67W7W6?ŬKi 9~CWiaIR}}v'!T wܰU(}zGǔevq)Ɔy3ܛK|g9, ;v KYL5|ߊ7]oie ^wj÷[U1<-~Hye.GBbQWBnx-% /9$Ҷia(пVĒyy If@hk <[w Wg%-N#mi~W{ۻϯmzolVsy@ }:R_Sz{`!2"ۻ۳ǓUVo.1)Q8n Οg!R3W6 R[Z2~Ccv%Kjb,yu<:w% q}uͳkkEck†9||bú/>aGzr~=}v{:?u|xi)!qb,:VG"|.tg[gñҙ{>u~ճϮ?lA#PnRHKm2վG%#O!oPVVe@zNכT҂ %AHRR2$k2D1a7_Mf6OEq!S#n)A1D@G ^!KŐ49/3h($ib"ҐDtq b5 %2Mmd2ej%!}MRm-M2>wzDjօ\ Y3v3„rkH_5C-xH ,VRc"1Mm@- ~$=@:Z!0]vDa(p#\HεTdQ9&7Vn 6_@p "Ѓ3#sƾAWp sb5Y-;%o9!Ph9BQn1g$蒓_tqqY"X#p#tdm2H!Ajܣ)Ԇ,@H.(PV)6rHjkv+j^/J`k]Hf dPy[,t JëSq)-n@-l{ U jiQLSOGK5c [~>]6ԍ(|;'׀DVC>]"n}2?֣endstream endobj 563 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 384 >> stream xcd`ab`ddp 44H3a!,lTLnn? }=U9(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUSJ;)槤1000002Ţ^ǒ?~g~㧗)o^?f646閌bx 3^> stream xm]HQuu ̝ʆVifH+(AN,jAAvJP܍(! \԰)z" z3܂ _{:LYB|Lχ,T0Z`=^p6>b6cn"!; r)@PEN*w+̍j$Q Ԡ( VF>rVU5r4RohH 3b􋝨^QQ h{gɶxd)ҧ ʝ0ɁjA:L4plӯzkD8Es`!On:X$ii+{j+ͥ- V " $VUwpIx G.-' ?ߊbCpJծ&p-ߚKKAwTem~zSlX[d(,sWyf.Eppuu܋1VY2F ΐbӸnfQ&i`2F%M&p 0c860x}Iy%I3&r2Vmj.l[endstream endobj 565 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2020 >> stream xUTkPY&twTQɐZ aK#B  8 Y(Xp}AbXΌjY|M][S3UV|sp q|bFM2ty~7qZ)\,2yL ubȝAA:ufϓΕFCF?E2Q,L%/i:MVaem|1mfcvaX,)*,K$,[ɱ, VbX`b&a xl"χ ?q!??qv tq{'X#hpoq$pb2"^:rCD&3pn2܋FOm#f&;iTJTb_Z9ivlN23 PZ0>’ V,g/!iHp]!ybpnXR9QQ"[Uyq7adVb/UIՆCzar5]pk/5GECQ)￵5]nUIE]b3/^&KdaTD5URZ_][YefJ[QqoIv%n{t>7Ë3Yxm<^nk5r3)݉l%2?2ȝ[A,#oL8HXʙ RTq?)FcjjmRjv,g$QyϿN)PVs/JeouKϭ[i~GkʍRIfRϣ͈LB'-Еv' JG11-7.>>C"GBrR1?Z䋎ɷz&^Q8aQ)@u/ƶ\ҳ6pXNwj bY yf<'eس6pXRR<$,9aL(-1M-)Q^ ^\USR5{ClۋS0\;vJ 9*iNpxn_ MڧØWzaj=N~RI/ U -A_jK yjF McD> -DamI6DEe~nTq=ݺ/A(\6C&.#{u419,}HUwTJ4i!lDHмQYƟh&>.6ީm.+^@g=gI6Q;q%)znɽK}D } 䳪9-tbV9 p)wP"c_Ǹ$D5'/?X;Klq~~Aj)Qid!>FdM׷]7o}rY^w7+ ʸx԰$mOP~s=A p0uLدHggj3[BKׅ!?N9nn21<3y oe7ZGnI47mgPa xm~Iu4uX.<|8X\c K%Q )97A(;982{At\7]NtK\"-x[PV_~\Pk"\z5OX0_"*Xx9 }O?,=%yfn'~e|q$9bvM$:7QSSyn6 ŨX9{VAdkǭb=> stream xSkLW>;0Vͧ8nnf[F₷Eq-Y+7A B U))BorL,Q@)D\ GԸ[6uz>rXW~,{9>RP(['-(wyш('N*kVO(<` ^sf`8QTkӤ.ޕ@^ KLWjVvZ|pWZj[A,9: 6-@,)9uzws* ϩ:ЖvSc^똰#Mb 3^Ξ_rPC2L6d${cUIZŅ?Y{9 g, *]ނo|O fpw>$7Ɓ$.CJfhFB@ͱ G.]kn-+2|H>>0~j3a D5r(<>Mu b }z*2"!܇K>|0ձ.M>nws*̡op$& "G^-)A1pG:>#޲+0ՙ}}>taz=x;ev" @.~TKY̍2{&2ľۖn]]Qc@XŠRPҁU)Hr4u:q5ïo2lɫBLrX0ܲ \澤ˍ_j^lpRɒLYEvőKwPL]YV車!&uF9ZÑ|Sj;o8m@yT7cTx~B{D?ųdb]4B( Qwi7֛Q=VZVH}̵f F]JtT ~"X}~Go*RPنUl̕+>/\(^ x)\hlqDzI'Ax7vnz} :&̑M@*gqE6 J=S۷@1y (.MXgj;(?^ƕņ=endstream endobj 567 0 obj << /Filter /FlateDecode /Length 1054 >> stream xV]o6}ׯ2:bð@bqYqTX#+M_KQ A`ܣs>ciL[埌Ǜ}DMdbsQTܕmt[Lªݍ_qc=0hBLj` #:ǟYB/'&T5k, 74fJa*d#(ʺL_ߖJ-HN0ڛt߯=J5pp{%I)ZEEa!XZ#tBsq3FzOFݩ1F88P0jθ`X*o;5 +_WsYF:|j`"Tm>qi$hUD$4S SLaVPJѨ *PW_޶ertxDbSRkGfFT~PP1p,Fk¬|ܕ3Ct*ٖKeXJ&CZO^M1C{Q`y6dBL3)I%šR{,AR'*J(&TsV%"1;vpHUB2W5Z_WfܣCq:dx6 Џ.j? '&0%CSU۬u.~}e+]! zjB; dbCEn ձwq'3ԋC]vrBO㠧jnH.7|h2nm}U68Oz4,CDue@bwtup͋b3ύRȐOHo "^SwJ;n?۶}_5cX6cpٔGCx@.3q k}޵3 dH)G Yz۴]o/ߺ!ѳ}ahgv>1 κ\`wEpN[5$$H9<"kqJ(LܵUÓ]@E4'?fx$\l;~2iPOۯL>g87X+c3J'O'Х b8c `u`endstream endobj 568 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 337 >> stream xcd`ab`dddw441~H3a!ܝbVY~'٨?zxyyXV~?(=[{TfFʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=土[PZZZh go3 ySz&vO9r{%&vtvsԷ46On*c?77utJ6Oj3q_قSM^wT\gXp.bzSendstream endobj 569 0 obj << /Filter /FlateDecode /Length 170929 >> stream xM6r6߿b&fĀa@ <=K=R$$ZUAzn~y|ٿǿ}Ϳ|Ͽ:YZj?kbg@/?|}_l> ^l;>Cu)r^zW}?M-ϧ}ר__Y8Z_?ۯ??ӟ\jϯ_?~CȢ7_^u΋xyjy>~]=>{yWl==~z8ϫ_τ\G_S/?{o}=r"yYmo3l(\N~o>i}v{SumN0~z >v:)l`Nxum Uίз~xf{bF/dbuϿ@̾_D<"y래:0qYuϧZg"\S=3S愬G1o"丿C<.,s̱AQ*ub̹S'g=_goD#$ϊց)_C1G̡i);Pod<;x垃3,kX'%͉R9f[\Z#Z#K sM>ntsw wW|ZacD_m~i<_sjk~Ow1|97%]Sc溺}iۆufAH:UTڰ'5؅KO`c4lJ3ݓeqlŠȣuzW Ɯfk='f/:q{=gD\|ʼncpJ8nO[ԔJ皑zzb F0'9^9b*1\Y=5n6/llsDYs~5|k"s ['\9O"Wt TósAm%Ms|mik饷96^ߜo/Sed2s=̊+2X> )h1 9mQ:紝c|bNsc&ΝZcr.3[,Æv,xy\26;~RпXmMmmqy5 ShS=\TbopXlhyNO:Yz1U3]@Zw;]3i{NZ=l–]5lp\mT%t0?&‰?5]gZǜҢyNJMo?8|1 NcXmO>0Cϑ0w*. D%oJU+d)\%9b{sY9>Cٛ{=!2Թ;goNJ>`JK3F8?):.a؋{λs"-}`U怊اTol}.h|&bߢQq7'bzȩ9gixs$9騿j5h\1Soϵijkksu(|;4sqـIulw`'U(WcSPys5WiSjн:T19>̹+*Bf~>Mfj2-?1)D^7n}s6tثKv_FōnΏ>co塢%}k*S-|5;co~ 'r98p3v8B}:ds;b/]c\M\N|@m~NoZ/4\f|!绅N>1!'߹\ጋz ӱ]w{f 3#nnЫ`bC`$g VvneN7|vN.N".ιU$:׬ Xz.fLN Ce:OS4\0֤49:M&McQ_+wمӈ$!4Sǜku%gsD͂=f3,сu=Z1s-m^|cuJ m>P7`xkM:4F& kSqx=g6qp{|JʀMxǟS<+0.ش?.Մ:v/>4䳾(ilԩzq_Inu`~y^[9/K bƳ-xiZ/Hםe;1!OM]&.I񞘎SR'F]lPCnKe&ȳ:M7q'x[hR21M;0'>F3Tpv*~pE ̋q8+8m]PNaB?+NN6ƠOI!mB01_h:5<sٗyoIfol–p ;iwҳwvb4a cyT: JM&"a: Òelbԣkf.[k9S?N v7= j1 S4$ 7IeØ*TJk}%+fjw8ɶ\:jZ8^Ô,{ufadǥx {J6dǽ`˭MfC|=_<8L'ٍ :naײ6;UԹ2 qBjW繦B ˪z<*T'Y],`[6uWivL?橎Sѧ>chTR}`Q{CsR( C #q C^ǒ_?pFҰ c݅'v?3 S nǑ vi".opCO'HөgN)wnCvzhեS̯8kS] &8ٗTS/䰐;c숨Ҧ S!"hQ;ǪU‘F(.56""Υ>Ubfwiw;Tk:y~7ϵZXj1Hŝ]n_#ՠ `H`w%\GS#vHE, K l"Z(k[wɎoQzJ&;tlK:J6_QU( ,(&N:nbƓ|qZ=c"s.niV8qτ<=pÀ>_J:ay0֤ʺ΄qvþ.?~v})ĬS)"R^_RfMy>a 0#`>_DW ׇv/h|sH$X!·DW |p c:uֱѕian9Dxݔo]8Ӯ!j%DYHX{XHMCk ^GB(r9z4wשMF'uYUGuj<ay/|j0@\-|F%Ѹǀ:$M<Y-!O8nQ1)͒Nlu;JB˧~Ɏ΄~ ؏u#{Y}N uBrFo9ZA?Luω3co٧yЎI逃EmaALc|4t[?z:b#-̍154Oߎ3P: ib-慪X jm.Vlb#!Vrwk61=kռhQB#F6s2RDU81-0'J13Rcn)̜zFvV9u+r" 1yfna-2(,b\D3<^ĊN3uZnvpUirW8ŵ[)11Vz@*m+qYiQ,{\qjEvũ9vxv4*+$6rp\QMf#["tCH3a)^)"ZaPBܲu)]#n[Ku͖8ȫ8lξX+4Nt|aLu)2tnpf0-Z&a i=&? Wﳅi 8\EH@8)'ҁ曑)n yN[E'e{J5eSmРp-[8U0dd[/79[aKҹnٲ5baMAo\ʶ*j)Sma.)K2Nt;sIu8:;L߼c[ӓLE%-Vzm ~{ ́qmAUxyY04 ɰa M::%eExIn:6G4 C-kL#ḡCl}~v<2s|r)[{GΘՋ< Za&LDx6P[%}½ks7po'\6۩6[Z?gxd=G*_;ΨnUzT]R{tD1̓D½%Q5z\9Ǝ~HeQ0J{`ǑJo:@ȵ@u2H_r6i ʼn6N~}pǑ >;Ω迩_&ObX:jk8fƐ[gfxNges{*3yhu| tb>~974"<gԛme4V͖ FBF m;w8Y>9iÇ[ 7g;1-SAb9"0wg{U O=4sb_9Q+0 }-4CfF6߳@JZ7ڼXʶyͱy9>˕^FwY7]Hr?8 ՜F((R3)yݫXqT2$5i0,:au }ơql.jv9QLGuY{#фuky)s-Sbwz7L(#{q 9[i|rp4ugc{Eqz='|l^l<~y6Y5je^rbu {rb#KrY3!WJ#orbc-٧]YϻCڝ\ȾPr[{wfϜћ9t[`m_Mv[DSU 6\d##YU!v-v62kwO #ɵ#2aikQi|=tZHzwQ5 E cؒ(Wu(?g,}!g-/,B,kZ jEN'$jKZY79ywQ!=^?uY"NG(m.*PגKV'9PUA)9Pa:]ܥ.lEgH\S$s}Zoe-g^5k, ڝ*T Q5>3Gw(w`S8f7g}=. OϾR& 0Ҷ7__Wml"yZPRDrNn)'ӤSp&7,}<-ujsT5Y l78.)V&G`$IDK36?{V` *Ɏ`5``@A1oֻR7[kz.?7 gx%[abTTJ-p6poll+2 4ss: oANHu).Y֯8R15Gqd ;%NQe߾ц{GUq֮yTz)<#| p~犿!MK{ Q4n8R1p)q:FpvQI{)4Y<grn%Bƾ|_?p1%XmEw(T%7TMK߻xDpF7r!#UќGwXٰ8b.Ȭ#ǀ~C (nP9V^ٳ/%Jy,ز3]nR%<7Ť̓ӢE`˹2 J fՓ-gg;]Ǒ=yohg4t uNp>x ?s2w Lmr\eRz,f<ˍntp%%{zW.VvI 6#9oǬGWU.Ed,-PyȤ nj"K2 i(]OJf#t :l246X&5{tYa8wmmP FHS+)2eTx)9m#6ȏP[:.w^ӖvWFnl4jf;^'֭,,wC;Se :8iBJ""kDtu,tIzoAND0뜒<0X&x%f[ِv~!ҞB-Ǎvw@k$7[` >(鼛ծ1qbJV+dc>{5nd&!R;Is2!^]㈁t$&lnFHu{#U gT}3Q%QGXD Ea6DZz 8gnpj_{K4&i$~Hefߎ#գ YnU;Tp} grD7@nל{;ӥ++Wh{n @f0=0t) }D[}d~*hT#-Q~[G0ֵG5O蹪匣 ˓Ԋ?h'H>dגl-rx7vynv`{31bo8KoF7.KμbXIƝ׎3o˾g˂qCgTOU gT %3XjjkᬏW( 1_ǀӳU1ǎ7OpF*̫Z!CxL ?..v4zܫP][~UmZ3B- ewp$F+C[gKm(Ҩ^#0Oppg|B8?͎s GՌ\YZp&#r%c(,1ѣjZuZx>3n1 yt/LmLrW4ΚΗߎl8m Of~a]ܧd7-pGoRm0sh*=+co{J7⚯O OU,}iSүZ7rWƆ"¼}McGȰǸ{sqc:OJ>GFXtn[RVU禩"Svze%4oa6u0~&w&i'H1x{:;3҆쾔O 3J-3+9 ؂m.spOL򁚐VbA-ݑ\rG /=1?=]+Ho86GJ1IOhCbU*f >5* }OBtFp1 qpG*ULJŽ{Ba0eQ͔[m͉G*Gw3^0fG*]ȕ 6[ O_~јxyׯ83<;LǗKwB/' pW}53[Nbp۪G*7CL8>V e_jxEz|-M rҖjR0Q)yKO۫^Rm%Γ(RٴxU97k ŲmIztG ͚Mn:4m@GݬMmm@:4%!GԢUXD d]&܊]vۀ<vƹYT͛1֪4Kf* {&u+I6 ,],u9KnB(`گ Pq#for#P&>%{xݝqѲ7+<MnSx4$[pZӽF 縖+w/#P 6)sMejfr^V6eQM%4 .wGR%Bu^L1ab<߫GfQ#ST&_ʱ^Tn.^4xr  +/{)D;XE06ˡ۔dD,!^pͽZrXu -r"ë͋,_I0z3ơ̇̄ oѰjjzZjϑˊEDžbsxhel{шeE$t:l|8ģYz&m6]x[f4) ]HPn|el{1I?ܷ[D`1˹s]'KMom|l6[2NX_Dm[ s<ŋdxMTM ,nu̥odlI. `z6XxyER"m#7-)"spk _Pޕ}H%;)-~XqfUݧ }\D eQn}El8]N1{D-!T<\gJxr™on3*|eq"׬ dvI{\sgo}qeh<[ȳ  {#eYU1Px: ms0dcL&4[L&fZ&o),sl~0.)=q=БBV#]]i.b5%}ĬU2G̊&uAӲxl-&nHb6he #lyT{+35'=+qǑ*d&Ǝ{k&[}P-]vǑJXIBqF=xeYć(up5qA8R5U.nQdQ(nT4po{ξE(;T],g׎{AT~j3 U=oTT~I5:\;Ω<'h,f5QJV^RA3{TeÑ!֎{k[\x4ŎRaG8G7qV#S‘Yaㆲwp8.z 1+3+XA.a]>'(TWΥ8)TjeY{4֕8R]+eqvn  dY?dvkǽ4>V3*7m,rܫ3I9}Ǚ15k2f$QƟv}ctٗt‘J -R;Ψx9ښ_;Z?V G*KH.}peI!QZfǙG#?/Ĥr,F/Ψn[ 4&Zdc<;ΤQrT>n~Np?u}/0A*93J?QM j~ŕ ALd:"rD"Ph3ɝϿy?>տ/ W~ 'GSojzo<1\8X?|~;O@<TiBC0&ԳGIDVTVkf-g"Qg뻘( /4}p=`RPڢPa4Xncu'a4!ONB:/L6TX`_x XfHW'á+mg/c;EgxA},bq^ L'0,Kn<<<)2邉cX+/@S&08.RjV_Kp!֋[Gde70(c|Eݲ[ n $w9YO+0%5ANB&xZ&&A h+$-886^ ÓeӍ6 "(\nCñphwưC[h&l?1VzU=蠠Ƽ7 >( 4-K'puY`Bt0Pl4Y8y[C0)TV_K0)킕Y}9aQ/2lO8kƤ6 )\JCHDZ,ʒzE7]gK+( ^ˬ1C5QAl0E`{gnB00!d [/ nWa P;6 ~}Ar;2NJOsn曹0;PV9nQEa'AqQ^fi I($epuVtCf<,u1s .&a'SƠ㘐pMPDaB:kGU,j s1}߀?aPB4 >m]k܃2#W9?] Q,)[?F7ݫb% kUŒ7̀Pg|L`0x}$ m%Sz~Zaac@MȖ2h0Iqfa`q&AOFRYc5!0Rò2Z~ P9u̢ d |1.*z_I V"Ed5J/\duY;a*o\ >V=PFY!3H4%D5l|Yו  <}L ZZX"I >Jew :95@ KE9R(/kbp03q`>@jI YBAh ^ؔQ­{Ƒ~W^٢Pa's⠼a>REHi~n7u"XG`PҬ_lV6o(RqN sy0``ijBc &cpzr==+0 4^0.*omd ] v\ŀERzp 9lPeG:{}QE}:"Oshk މjOfXEW` lä 9l`pɃ@A^ p!@&?v!ȹ$uz},  /cxZpO@D`" R (s~'LeŶ 3h5.Baj~vS瀈ùE I($CG.kLA`-YTp#b*p'\pg fF$fZ b p5A0R ^hVHft;cp9yWKR+8$(}%>]ZHE]@{|=Qq} pWA7!HkbMV ``gq&!\jg],+v<0YLK;j xOT=D%GbచR:Uɚz?VJQϨDL9t*40yۭ`h^fqpm,038XRm~oCH0SZd`[q/i-V}J!|, LASt{0`Kj ) .szu0+",tŎOƢUu%âP1aHG)\Hc U " 7*pdX`8aH,Նǒ"(\JC4 J*I 2tM`ztCƢT9ܿ47q``h"l!QacAJXx  u__sD@q'*_ZsIO~I]gawT /Ա=Yg+Xg xJ V|BHssYl,^nm'$EPa|-T3;0 Wyck<sdh"a5'ssL[M.`E !+Ĉ:f.ޗZv"C%E`Xx<Ԇ`;Q0)iҥX ӯEFsBUkĦC%9h )¤ [?=2kE_yTNn;P0۰Ccg38JjGH($lʵ=n #kToe4gZ<~68< 0{_K p MqaosaTWCq98$ n2JAh ` 9Iā֬&⁐ \FcB'9 턉u*cnI} d |0\& )\FBA1>] H`SXĦt{TyN#vz`5 s)h#XWI-~},D ['l/A/L]NXQvs(N,Ç,j s! 28l'T[{"XfLף.7xՆ`7!=@zn[elFB%w;Kޝ=SO zUy>BEaB Ӄ[̫Ee~ d /)T ~鲙;,%8&agγ , ^gtJ3YF*Iѹ<RN7i\_O\0oN4 od?p&VF ȿT,Xhrp%iլ/ ׸?}\&^A)K~hA,?-Zq/<&zޠ0+w(*p`&h4hB ^n;Xd?|m2w`_aW< [:Mv_Ν)4{OFңhX,3. {ąo'F' osYOS< _.EP[?LV *waT &*+J*kQ-N#4X\m~},)¤ [?H]$, cߺ^0c }(NEw X`íhGH&ep!EI I. ̥\t :N f  BZM-e4{/LcTyv+ϰ0JmQT,hxeNqzp[,¨ kjK p)?=*BE //V 0zt+k/V¬&0dAT0\-`aT$}-~},e4{/,VYᥓ` ֣jeK}J [<,r#a0Tv8'z%ǷH8v[9 *?.DoPO *ٹ8|K14;  A2:Aw:G(/ qRF3rQ`5aDܼ&{w (F-k(f(D Ka]0ø(4o0'LWsPՆ`>aRK~XYL y%~4=_= c$w um?U ; j gz:I~Wh:y.MW掀6nU(7M_j{sPh05m.1{aV]ᐘutz畈wawXtQbi dsbW U$S`&38. "Ys'Qagn(\ >R0>q( +]m&`"=|1a@o^ n&ph\~]=dX?pJ ф`` 0H 5ք|?&,  ݕJ"g/+V22Ea-C ,TTK'0,}L(F =1-ӟAj6l3LQ- Rk }bel%NK5VSy%yͪP/a8D`5'AqwnjvF ^",o} BD`Taa ҄iqΧM^ui05]VvvpE$,8uKR8Ki~؎uiY5FAuVt!r“|9 7;<- =S _Ip 3}޺j-aXfyLv:znz5b`]Mنa`08A8#k߅ l.M_ _%[-vbp75~aTgqM4;-et[/^^?ZYYzcP _Q@_әibݵ02BW )\Fg"*8ޯˊ-d~O=޿*,MaVX;bH VVa9VS 28l]UW{t`N- w2\F[Et>7`' SXfq@3!ONR:k,;"Q5Y:qMS1.w,9+%=ZBB8E){/,Q/TNr=PJqVy!Y|qpXm 4>4܆)I~=,TJt%Q~0+?;W/; /}Pi5]mTK^R8K~Qc1`XDiq1#Z'Lp ՕDFÔ(N+*[Q,KQynKiq0Xm \C"'L [e%7F80yD KB EaࠛVI.saNqJ:7fK"`faܠhqpMXmT!:&bp^Zʽ ,`BKm^Au@NVP!*R|=2i<10,`;bs ~}Aa"fan]r JY=S/4p颠=qlm "ptMYsw::jW$V /-f2RjA/YӊAu,=n[ß:'HrkwM~Kfd^a9Vwl\KY7:3)?R0pk sM n:|^K#X"o}x-]JV40M{CUlt\ ݮvQi/gp9uEф@6a2 ^hB;4^{jP0;[/3x݉Wps0/`vgm8p)I~\PW]JR`Ŗ A _8,= 808i8/si"PS}#PQpݹJX#!( o ֟l &3,,ٻcrŊ0 6f͖gE|A' s+W Q[Dd 콰LSE2_ɻ0RWv*BW,c*2L9ՄLՆ`!!d [/Lw*:cPURz {BrڴޮܙpL}@Ρ3~!I!qa^3] 9I*cqʉƫӡupF;yA]+'h@c.3}bT ӢPkJ˘ |X.(Bep R VRKi~o*Qslttnc<<,9eKC$88|t0M.8TWUuBKJqW>cVatK"['9.pKPxQtxWj3խr8&& &DPa)h L׷Ʒ_g,)m(}t×`- nI xjZ \D{~냅iV`NƧZ58_kxsXPJecՆǒ"(LCڔ) [5$qYQ6w.+LZ,ԅ9T9t6j)"4{?" jP<ŠYbŁ,p[PXp"¤ [?BcS9-a/v@' \@.u!84x#0P.1`F{V >BEA ҃#jv¨;O+x>]Zi0UK a*!fV)B6+p 9l0w7(Wp*gpY%ǪW߸aOXKhjI.sa#l*;au&ofiGwOt.ìNj72<90ftlF K!%~on!?9(hVou,NEa`-ha*׋C4m"L`Gn(]7' UN|l ϫ2B׃AeB!Q`vf&|ۮo.L55PDqLAp0osÙm&Sa֑*}9#M,Ef5x.C5ӰeXqoC0p)¥4{?B簇jU%x؝*|7lZ?#RBQڋfw+՝k5a) ":t2wQOh sNYtΩ rO*/7i S8QEQ6tR8Ki~΁j5Lskԋ~8E?ï^ƀ @˧Z`NMPUN&ڨ^p& 28l8b7U ~M^ Š2x' MS-0]9Ԗ'Lp)pUKva0pYtmM%*[bP`'s QP1Ն4*6"6{?, }F~!Sa=\Oq̦xeSvqԥȵ{e(#S(vqp)M3a Cƙ HR8K~X]jn_SƊX%RMu)9340&t~63iեp 80_{oc~a(Wz`5`"an ΂?A[ lOoPZ.P8DtsS3Ee`- OYϟ'Lp)Cy/QK`p%P9{nvi}Rd KAqrVo6 ~}¤ [?!)%0X0^6-݉+8\Xs8aMapet{/$'$#<4M">%` Ud83- mz>䱶Ԅ` mAB;{0Uh Ti>}FkQ \=S[Ncn:[ k`s)$C .))+W=viFA1K~gßCe &&3ȂVaGtgҒx-9ן[/s-7ubnpg/L=5x6:'\q}qmKK ~ G I(\n;0i`N7?Y'=L+{.Q2i[jC00)v[?=[o1NETb {NEin)i c+8fIjYJڒ)\JC^['=@Vy2Ap0j~Q4a' `T h^ ! 콰Uց1g3Gh$?-3ť`poHCi#ц`>aR8Em~XJ0U!Dof jꖷ2i\TdaRप J=Z'<ǮB LUeNJ84uT χAč`HʡBjCPpmgu0Cʘ }7U!cǩ \U[Mpp%xa8F3K)\Jv뛢UEuGW +Ϭ6pX@YԦ̬ WHPā7%]g MHrv`(0dpp3uFFAFՆ׿]REHi~h8X5d3 Ù9.Tp JfWb`ʅ1|8y $b ;yT45/`~HDCX^v'0]EsN,RQӯ I(\JòsXPkLf~+v N] xj~.3}055q`Yy9W!#88 94ЭMjG.1{a1n:t5{a bTN'/}PV ~)UR-Sg` ;v& ~}¥v[/, Uy3눇{>n̍Y(1G3Ǘ(}Da^%BP !fPҎM=6*<88-L%IaHi6,AR:@F(a00?yh|ŏ T6ZܥAp̡;ܴ*X I(LÊ^f# c bz/au^zQXnz0EASnqX")\J2~nUF8riHZ/+}g ^~aF`R؃Sp 9lбzj Pdn(K+0#+OMsPe&'@ Cza`\ yY #\ 0ktR2=ކKA*-s}=p'2{~J|-@n.ޤ:]JiRy`&tk Y=S9\b0bzCvY!n 8u2Nфi:6D Q>YZ0?|A1?ȝ9\ug¨Op6AR_\]I *rXu%x~ H5^[ BX硂S!o֨7K"&[KY 1[(+/,pinvBOH aM6(cH E< 5[Js}l$\SgEȴ`^C!|KiHTO1\(l(΃\GnXq< TB,v,cp\kxpXuvs;+v>:#A5zDd^>h5tq^?RE[2}`5N&cE-u~1BngJ~[O^;5-(6}.}BLOi)9>Lri(΃6x2ix8}2HvaE'Xm. ߵDHyQLip+?!~}QLE!Re wQ*[߸7~S/9'zfͩ)QG)KbS kpQ(b,42%8,) y|p8 AmJ>5iF|\4g/lzgKÖyVӰ15qDb݉\'prĹ:F i$$V5{*ijɊ)VevZƩ,w|,+;0T`lEZ8J#,1!+;R6̭}dh7Mb%WFi{ۑ\rFx]`Q,0pҜCIY - +f}- cN-G6EF)u|l<C4&  sQc/ۭƪ,,'myjP;L-(l(C+|WHo֠'ȹx.6&2.ӖE HQ[hCcZnМ=|BFNܓ OUi|`Ltb8S~Yx0,wfNP;YP,̓8Xjؖ&Rn6z =e9EөZ:К'0pU>28F,wAi}*:DH,HlcYRE{6B?[6XJ*hf BA&< U muBPBAoD'Ydֳ9[n!XuBPc#vtBPQQa'\U-A'3Q}q2Nrϡ3|[t$U-9YbuK< Ac42 @ KM+ l]h2FkA#EZ(DX -$k}S`>ޟ(I)"A|PE2yS?zŅ5;{c)z*6ɣuM/~.)Z]!| |!Y,e",֍⮃'ͅ7f4*:ME}ZS`[>P8gO7OsN]|D_\CqMxkbsY4VU&+ȶtAYkF,X _]98 Hد=H17N rWbi6$&B'1@1c42 e8 .!Q9tJKnM2-E-v&BʷRs;,wIEZ8J!5rׯdq5-ȥ9=1E|XՈx/ٱ1EY yB,Oi(MȔZdeaXnNHr䙰5{]hGJnd - 5PNJv BY0BX&K[s=m@IT:b'1SܤvR2V@_.b*Ne 0з\P,:ty5$K xt fci@?R>ԟ4B,M-yh8P/XkT %ϔ_i]AGoqw>(ϭ|Q-/+%-72DiH@77hE/7&E5iAbB\9A_A=D[L=R#E\mLw$`r0 ֑5px7k~g%@*$+  [!X։iNgyci_Fa GieZ0-zSAA9@d)|K8QuSAAT&{'J4(Ǩ|QEa Gie;=z gRӔA;i̤ۖXӢn"e{UiIDVH E<- !#VjSڵlAsɛ P`/pZ ]b7Bo5}43 [8J#,OM:nqY^=z;-K# ĉ0x>Fsi(a|X3${9g2рi[lts=LjϝQ9/-#9~~\6 \Ju9/XRw^n?y)%5x 5 vO1yK r^lDW# GT%Qd R42 n6Ұ"1Ҳ`13HwI!8K]X. % 2FQ\KgqO"!{<6UQ~9}i!.#N,2 tCSiL3g>O='c&q4[6[F? ݚ i>HZ3 =DZ(ʃdwCt4?z0ٱ)Q$gsҋptDavf+eFl;;n-&;nzAB{kL7<'IZUķN{Yk|1/EQydòx|E~aYh kvlKj;ch&ͩh^~0Ӂ'(le 6A6̥3Ns<;ZP2Gr' +,NJEFQmv!#DY(Dg!hӮC\`I\]ڹ$Ǐ^|] @HJ!6H?!.P` G(e"qHNo҈X>^7w'Y1~5\2?%7,["ߟ;`^>8߬9PtmHs%<Æd?|dTLcR nC32.8>8(̓s#h5AT`#7YY8,FH 'ȶ(!.'3VC~=|U)SOUuŻ!8bɜbd>,KM!\o,tJH:8&5h8r ݍ$,}c\JÆԷrѕRA1a5ʆ/_)NL:"8Z@I:ÁlͣĆ)D|i 2:-ϑK@ n;E,FX "u qwIt Z,١:Ua '@](aul",qC8F, ;O0x*Eq4x<<4-: DqlЦ-~TMQǞTgjISm<~[Nŭd3u`Leb&ot`+ۓ>.2Y8>_OR;MuߤH*5Q~: ;4/YvZH R԰:5D64ʇ'( FY<:QÈC ٱYwb$⎆͍-l̖ Z 3U-]t'epFgcgYs6B!{R],l8Y&)W5kvN2 [8J!:ҠLi3e 5 m(uFaWlp/ ,DqAMҜC9&,k-j5OOFVjHTnI)X<3I%t=*[8D#,H,y9A+dEG͒so O:@:P) [8J#,PIȄ7kƙ.*j@wm . !_IsC}PFH G)uza+z6Ҭ~xpL }$e"Ҧ KlKspo}'\ZW 6BE8i--f7Kv+*{'9:e(͆c ?#!?^gpFХIK|B-8/[; /,"JkQSUn!l !11l;1B{dҰ-2Tzj3x)c*$- sEJKK:^88@,SPO {oFH+LԷ_k8xQ)_N OqFOER$cH muHfOuSV\x_1_GK8).D/]K l 0Be(`jֈ7FT nWyᾭ,.Ԣ$tVs%@Bh1 B1a.΀7m K4zކ*\\JOʸ"s[r1J#,S+da47o )>=ŗ-ν HjL)ӅF}8Az\P Ő1YŠo|SWU;.?xb A%o:pBk FI({~rƯn#qdi$At.@˂8`Yߣ).J*[dBfFJ3""܎A<'+W:c WXxYR.xmOiNacISQ<Ɏ*/)cSHIDg7hI"Su e7[( 04m+ͦ٠ߩ,'hj9r)iBCe<@F[&r:<חwqё2Y gdBL! 9@2([8Hf.!4ۀN Dn\Q5kPR>}LicEF)uWG /\R7D7F`:Y`:!H")v!DY0Xf< f`Q{lPџ^ l\I'cO!kIr3ciVEa Gies4njCFp*|op:d,3ei"8;4`1(BQa,x-~;SROfKsWX<,p- K9]l4Q>܊H Gie]}Ҋ}"w;3[t|(l(΃+aB%2&MP9WV8bmwP)Z|&ɇ9S+ bHŘ,DdգXGfKV |l_js,uQ]Nxx.ʩ R,IpRO _dZX~37rWgk4gbSc؏w\HQY(HllP5{E&.&'& OEyxJENoĺx˅d`iᨍBhz#wk.u,}x(n&&#|*M4;sa]>(l(΃(& )Es-Gba\v 2`k++{{2(P?M@go;N$'BvR5^-)+S])T|NFr`3ϏG'vމql "!?| v2Jƫ˜`B& ( dA`Rz9xHn7Y6K-@1!Hz1 "-Yyq4X"ֱd5-f}MEJ5iX\N>|1SQQ a nb,pN @NѝXJC>byG[yFk"pk*ٝ΍;z iG6Ѳ-1>&pTtq}g4M{3'm[t.{ң=pe)7B u!C,eb "'UR&pR"ІSZ-PSI3R`|4 (l(yӓ﷿IPCd0ᤁ _}|]4\P:i* rǯ.['yԞQ[`4tk=-SHbiXbeQHhɜQ,x>GiiX3qBHI2RIY MOuSSD qy$l~kYY,$sӕB8?(♇?3zl;8#`zj<*NB*@zmbI5M?6mnb5Ώ!C2Á8Xe:BGy%Bt_NQqR=2&tf#W.$bc(Ř,TjbYXj2:[fM]g 0N s䂲~"k GmeNaLD4ly0|wt4I]=r{[0],FXӹH&ME,2J![ { IsoEUMݕʒ[ (~D~tާ$_nP[4.d\\nP1 :J$Y "άč'?O\ZV,Z\MC$htM|ђQLeF'\A\AUt9?}X=bәtix}V{g~Ñf2^ٜ><<p&"r0DNU! a;z[^$jj.4uKKe;!OYQ4ex& p&}j]\Q":4O_ée-T7hl{NÉrsy5=TA$2|xa` E(M$PCLf !Ғ_Q_{P'BS4SGJcEF)ubJT-ސ t8>?Y@bX1TVCE(uzIS*2=4'Zt&U8n:Y%볃Ed2`Mx(iPH]#*8B,s2kMeiT2ۇw+>Qf=]il@!5{ 9a Q,D{??Ɖd^DOG-nFHYl8X+1s?]kA4< qK]%(㠴OIܯ~Gj}~Ŀ4ߟ|UtR@?t ~;k|PE2y;&5)xїܕ$ }P֖UpFX! 4jI$R<<,~jqS8ڣ( 1}<#a9f=~su(Dʩ?WH;G,2fm#hlѝ3D63wsSS#eӷ>wh#_hYj _| WbJ qd%B] x$\h0a )eL$z64XO?DNW|M?%G;?`YI4Bh,KMoBy(e/qT *bvW{?+&7* 7:Câ•,=z. K_rMyާ)q,r$) $3i.3liQ":ۅn$GEOp.)֡,'i)IKH ]P~*pFXf׵ Ԑ: y]I~2rWMi6z'xiߟy)N }tY~>T28-T}t,g4qH E<8X_߬a?LD (ŗ=s70O?l|*wmwO i? 4!$5[10H{3`%ǯ{QSAX=$<>(cH me)@c}4\ri&od2=TCH huM7ڝY&*a]$Hg .0bwi!\o+ Df>(?EZ(3!~ekC7&uY_"i! 2NХvWDŽ >0BBQeȳ̌"-e",;h͚d`l{ MѾ?(9fSDlo\P ,rWWTߤA-{G}|޸;,}OE,ڤ5vV>̇VQQaG^mƿYN xC݃KI+آ)7LƥDڇ'(#߂"ˇ;[>qDs y K bx }xH+!"6x0V<炰s\TEJsƿ'W 21oB| ?i:o(&]-yqO;r7kԍ"Z5:NSA8{e&`n{2.$&Ř,2#q(T9ԘYq4$.$d_!sJпLNep_QQ a$kN*b 'r/&ZSDEĞ0G뎴4drl]nmH" _WV&t=Cy9`zF%zRVepqAoP4m tcAy"-y1g7TT46׸ jt(cq*)̑/˧XB+٩.e,2H!,Pm#F2Sٸ/J?XZɨ={Y,9̤9[Y`+خ*pFX摙,xQ^5^^mSAėu*/ "=]i*tqǢ1`3B8=JFٱոTspAf%䗵`yGiQܠxE!R<.Q3b]NQ^# ]N8D{=[\rCU+~< SA2 , R0'o0+CdA[x.pi`#/u:* s$cDz}r + 塣2cB|l:(l(Cdtm' ju?oTb)ǟ4zi>Ea)oJaMO磲@T FQ2yZ:6xjGӅ㙽N(-Xa5 ¾  & 8!,P.9!o40ˀ{0qJx&ߟ`tBjHQX/H+ [8J#,Б/K'߬=cdl"a븖{`[" a f僲-2J!'\㾾3"5Z} Z}z3K\1H^AdOdigBl_(l(΃Oq*ck"bkI"~xh˻{f&XN%项#Hhu 7e"2ؒ,5jGĩCT: [LѴ8oU!]{ԿwaDSQQaGa.5jL;lhnr^jU&:ۊ'|V:E{D $԰A"\h#Y>.(qaZڞFuxjOFw;'g?:G{ &ܑyNwHQ%0Eued li,_Nl"l>v7(l(̃{wݟsݡ gp/6Qr4' dN#34}PE2y$GA8 2G50š+^pb5\>(cH meWC{ j_TqgA7ppb5/=?Lk1d3PtįB " _gbll7ke",xդ( ``W7߾Ys Ӭ].(1bLez!)*8&^MB+ jg0 L)B"02P B({E5;<2R{tˉeMbZq' =,wKM#CF c,Ҫ22lLM+ [8J!sAu\"twƃq>n$QZg2rY\d5BCOҀ{Bx>6]kU(΃y"e$꒷MRKh\)r?؀Lr rgƤ,o}&%j#H!#EZ(DX!:5,-@TB`ۧD le5RAV9Zeԉ p,|m?/.B& 8yjkxD?l1Hx)_Ipj O=Yqmߟ"-yA s1|^Hm﬍%~>MdA|`4^6`N#EY(n#bطr#qR=X̓=XE,HӹMXY B1a/pal:$掍BlY l3G/s,-PtQ%FHsC`m{:]Y Txca`H?I=Τջ:eєg2NUY|K\P,D^mGbh{^ɿ?Np[N5$S[K'ߟ"-e",܎AiH_l 6E,ߝմrb2ÙO\LS!! a.YQReXhv T2XZlP/^XH _3YdXgT}<&M^><׌8}.G>E4\hjb* <4CH $;B6p'pjh֙٤HY9[R>ݬ+5-. aBydsELjg*yat6@4R jjv1ܴ4c42 HMt߬52NEjp&rȤոzt̜)dXg{Piw/Gl "/W9ZZM)HH+gy,t",-ڮ,RPwt|ֆ/ye}FHYJd4&w R,!F7Ն_)l>2)v l.qSw4zP~ZK=sρnjahip3'\3ĝ|g:y6[ DD"?W|9|؆AlV EoVE Y}K k!|Qht]q"?  "-Y}pQ<9 r>dr3ȅ"=cL(cBH E5$y 2?B/j[?Ȍ`>s p|PE<8P?߬QF_('[CJ>,8iv&3eTlU;l`˫ Bc3\ah Cq!y^>m-yhn׏uOg U"V-~,.˧ϧfgD씗>gpFXm8EGTضm8=qGnRtE\/j%h 8!X!6vM1Q":L#6o-)fL -k2{FYdxJo"l9ˇdkP#70 ' g1+VsS~9ERihr|K]wإ~q8'pMKhk.QLD8 ,c §=@jD:xJד+.(k(X~-kYt15g$Oohj]~GWlWoؙɘdo)\`1|HFQְ\P~*[dBXfAƎ|K:[Tֳ)j~[S)oiP>!l,  YhKƶQx=ϚCl$ K;"e>i?Jӓ-wuOOh3dBX!Fv D [tt{z<~}zeO9 ~bCD!XdM\)q de( av6RbRJIaTsk?N/2EMXRDr#YۺC'~jONlH )ce A2}`50&A6q3wF<۞F/06h\~Nr$ln5#|4{!.ugcH G)u7'Fi*F!UwtW"IAۄwBv\őCO90š뷆v@i !-h֘9t$Lis,^b'~G@w A2}h3ͷ(F?H E< AyUx_qኢH O/>Yġ1!H%/As!3;b!(BqaZM5nE4 Z;}]nfntl/ >?L; [8J!࿛Z*FPSC[mAgr4)Ɵ483@f(F-#4tC8F`;H >uQ(y#_7cr,ZFHy{iM,#8>m2PFX5HYb;ʠ~i\@)Ú2`1RXV)I콚.+8F,P&F#¶G@^$ɖ>=bUEchv+)}5|[8Gߓ#\p/,)d A2}`4oČZB(Qa^wr4'#h(M~$CXRA]=nR& ]&O>(cH E<dXf_nc:ȳp!;3HĎ]OjDl9{rGC {U~uSr.38R@ӂij`Nia';ePi(̃_{q߬9KxHN'}RnϔJh3>94 \W"BԊv7K~"A͇6.9o4Do=9va ˢnlߓfi2|{8QݺgE,gO2qOO| OQQ aѐѳo!(ڹE(_n b[H^$FHio!t&>(l(#wX'N" Hq)` ا,<*`޴s3Y۬l 0A|Y3iH)ԥ_tp>g4=Y.R}ƛ}L³ʘH(uCfqq\Am;C5\2`5 Cv0:c2ݴoiH^x$}t Z[p6 ,:!H&ژn^70]ܗs?W9|.(Pq7k@?|&yhJviW O˂ n@ n!m3R0wc: /tyBX.S{X~]"E 0}S~9D߶8r{#NU\ [sA(qan >xjLMGE?P_NBJԍ{dЅ'c(X,x2c#m)PKeft8qf9NPMq7Yi !0/SP.-I;=MV~2)fj(_䔑טq|\dkXePiḍCĹ14G9L7%"RWF8ve+ [dBX3F/eu, s9 a | vv6pXfo9I츱8 :yv&7JiS.W,8.EIuϻ \OAOhs rC%?/lYcBHIkiyk'QQQa'6j`mxŨ?X]qɱ;e~Ã)\Be,"OY#ňN_8k(ók = ՠZhdɩ'A,6[tvH#ɬi'3;/+ [8J#,%cT;ҘzSLAuTl$ds }›).O͉z\N 1 aɲڣ(SBκ rM{X8Y B!4MB8] ePi(̃j) ?`@rMmwJvt$@ˇ E+ [8J#,,myV +p&t^M+2ΔN˂ @2=蜋b%Kd2ȘiNAdS 5:H _vG(-P>!XSi:IsWBWDEZ(DX!8_+ƬF:Ÿn);ɠ)ozfcV"I⹵w~(cH ENMD˧2i$RN@JMZ"؏.]l~f 6pXg!SqⶇgVEl1MZGPۖ`FlX n"D^2OD8jN\p͚X4fKt";(Ch>0B$FȘOFQ2yhq T0lxD.JnԜ,XX4(?Nd6]\ A2 `w[dTRRzd{(i1XkeJzڳ O,t;;'qMK e'qnz8'`t/-~(ei"x a?$h1QNeCgPhQxZa3U &Ad @2]`4$"+( 0G/SVD9C7fm]VDO-Q)M.Bdc4:ў[ퟮ|\XRA;%ZEK`"P)Um'/]45 Aa!~i,q=XHr;Mg$X)T!V(ʂQ2ܯ`{<'rOsecB><&d[ eEjixgN:l΀{xFߤ8TNҠ$KR%'NDL!MJ!l7OEZ(DX['Jf͒[5f$e1+˗JCD8wCePi(CVopg6cZțcRm ;=\`,>;IJ͖Qψv`wD)ngdq,FHa`؎!9F(pFXA侳D2K"57/T|볎^F,X0 2}k؄'/ePi,VK6(eҐ4$d}hߣ4EѰ pRwյf/gi Q,T5y,5(#SBQ:9r΋(̚25tDnd ew,#DS1c42aofgϸ,@-JT9EgUdUĔʂM2}?w0ب-}P֕E;&[FLF^>$c( ŝ0B?p'|P~* [8J#7mꚧoވlƔ8m:) ;V9eAfB̬lWԅx 5sb42KT&tܔ!7 S?-Mi#|3mҜJ8}PVODR2 [8J#,&mWIAoiFo>'e'Kق`ydk: a?}lQlcfub"駆[=ܩn2N-˂}!e<F|@FaEF)ukD'ߤ9I2 x㰈[A`C s)t!?ݟ;\_oT͚{2MdO)ͅQ!LP A;D_'9vYyRs< . 2_2Wb'XX R/y!,Kߟ " Y(M#\ix~q5KsKU`ji`,_9W.EF)us na~؍vd|//Vǘ-UtW_L><' Giu:epd\  S y%,獻H MέWi͍2[(D,SPm|3,}}o4PX̭5NeqqX"X >&8Dé|HVR{DQ2y,AD\ėkuZ>{d[~Upu-f#9"Ur! BA`OI)䍴^y`({ʼnj"X rpȨBpXǑ y?TAǷb8F:ҢG԰z"DJȇd`e(a:<\&tv}^ƨysL~҂7`Ě#t~QLeÁDۢ*/lܓg홓241Y,WML1>J[D,!LQ;-~KÃlOitZ#Xlq\Rpix[X~L>zWpFXƛ͖"bKj:10\KozqClqre7Af<\9}P<~~Bæ`Ip-ȡX2ix\NZA"-?硟DRFs֌8l"btF%:)lLoCNhxj竣\H|Q ,tIu{(*#d$lEYj*]kv'~߲]P*H )ujc9n3Ԧy}ϫW9=ΟtXMPG\O`Q,T h %V*2xN-xVbSJ؝1]lbߨ hQAaJ6䵡<+xGe(l e ZXT*Ngg9ؕ^!"C4. ְ^bi$܀T-%dd1>RgҰ^>6MQQaE-4-":vrMIHxl#f:S'X; a)?VNAe XN6 47.VMq.URFX &B|+5\bc+42nb"aO'M0bʊz=z<#eIx^܋x9iɖ5aC×)+HjPzs }Ʊ-.r9-rr k -yFnG˗Xjrq 诲B~҂BLa X=$b8Ay W><+f͍ 4Ǜ˼}2@&L"|g4 0=}ʦ42=A-)/`J3spq%=Rcɳi r'5F8PFP>(HheKBA,gN(%6ǺGUž2P,ŔPK a 7]PR : xC 4{:57)Kb(o^,>cFL!ZD}A?4E<67kxze:!*1R;v~d;!S$Dh>COQbe¹?.p\5f` ֏::(kx\+']JFq=&ߟ,y9r5Rsst@ѹ|BV#Gudq=lg˻.& `? oBA2 pU&;SC޼"M)؈n .Ł`"l79gQ(lQ a6X[Guy3gS43 Psu%Y*pcIu%x~ 5 .^[ T}`¦}1eZp]+P.a,8X/JzUnŞq bM313CWHh㺚&~~ʹ42X1bW*mJ&K<>.3O+}4;{aU-fd4-篑Prx-|Zi||+@:2YJJw/rp\yXߑ{Zc#FFH)xSd'Fug~p׎"dш!kSI*-,OP:\gKrcOփ2NJobAnIpxX VJi?PKg- zDMk-;e/nb ~Y $-}qdCƐ+&6p;zd`뺵xDF\6%ٿX]p[1X1wbSv1m9/LH9\jj~,Kݰs4rD j}(8A8K.t1YQ8'n7WaI\\cH iYu"r *1H9pE%K1e 1\9[%1C2"Kh|HV4k0 ǿonH?OoRo;JrV ٫q?BEÍO5- .H!H#C$X8ړqJ޽LA\n1fOqG* r1 L I DԹx Ő1 |fwohlquU3ht6HY2 N-sKK`rI5-|fdEriH9w;Z#%hyOeebe}JEa G |Rxv<`9O<7`ATxȗNKBΦ|tm}* kc?ɝ\<{J ߕgG#&qVDADz`ܔfI)TZv! "5 |gU"CI"O خdÇ$\)S7/K[[ts+W2jB kؔAb߈opB% 8zY +Ib /ǔ > vW2V`M7Ttڎ؛!ti!tZH}]짅wOEaRzq;fɻ8B [qGp&5.Bbx~Jr9QF,( E) (ϣOT-݂Dd ].np[Ϭ$Dw%҇QIpȴJQME ypyEx&J~-6oPA ~`I0R[%zqE+;rJKAEp PS"q##%Yj@FOut`1  t!-t!}tӖe(g*a~ro -E5չx J>@bP%SRp%<]>?2F΂8tսABc&Js# !VU[qz'}StppOHi7~M %XG$цvh`0$Z.`>wDBXN9 idydl֝"K8xi7OD!+E6Sc?Qڕ?K;ߐxX R!2eqWg$+ @`z~b,jG d,]N_4^,KC}$((m3Ďx==NL/FeTR[{cX$.ߴ_x؇0F0Pi3#U7 Rp3wfY$3cb pe!YST {g(=>?>W9|ЌZ^d՘){ `s̎‰HHܔ`I<#@hB91@1bLYp_Nc|\,H*iQ'Yw%!q 'H90EH` g $ (Fy J$V.j#UUX+q\ni!q{sQY*JU"5-|GůPn!Y-q4&+ J ZcG+408ic`;;/f"l?UI@O:{?̌p[^wbZd͋cJ2( Tcj^QL y袖}#svE%'lbf2CJ;TE,W0>oYteZ,U.++8FB)~6%u.S@y=jla@(xj b$6SAcB|v-vw=CdP\#Ǎ'z˂1}`$љ"5-|!Ñ/e%]m0 bBX>HÅ, ||AEf ֟k8d$qʌm v: 4`^ْ97io8}% RA1,GEXd$$Wxm_= <?XDSj &<ç)a㱲b1İPQXQg|5pꅿ:Dsg#yC7np%͆F#$! Wv! "5 |g⌞D y&AK>AaAW#0S~@,gL H§P6[$$@#4fj(rjE-gpkP)}PFEI ׈ ٹ_$mNeLUBn_GTi4kӂq{֡,s\|cH Gi yhp$9/ jx8;pqFJWe EnIzl[ xJ =e; 84ψkU[ª..=va{{Q e!@__c"4!5 |]H#/HVN|C<kOW4NQ[BƔgYh-͙5-|桚+xI{8Љ~m3Mv7/3ix8%)i!-Ŋ Qly.8S`6'niLB&S2d -裩FF) yLݧd_6Lԓ؍N0 a.V~)$N ݍES "5dZXg}4QDKwp{yc(堂ƸT! #,!C-d|c(JQwG;qn6Xdɺ"J(=!Y_ FHF(-Kp=S1bLY(xcLCk޿EќۆK 1n+A o-LڸPLleHx.k[]\--OT~jP=y#. 8uƧ ⨈4P8-![v=$v ?sЉ" H&E=1Ak_t˂ Kɭs壙)SMVpiizJxF_6f]((m3enk`K&b{eOCWă4-ÅJyd ƀ{i7~> 4\ Z5λG]%Z4Fi) gnAJ7Hzޮd =3|Gu|GS"FuoO! EՏwVҋ>SȷicXP&uH+uZc>&-$v ̰.B>((m3>7nr{ڔ"*qtm9?$>=Nj02-$[JN´1(QwG}yLXlXS */'/Pi8XY,y3}gmaՃ}y9(JCq65(QwJ.'Zr*B&Qd?9%S?)Ccx~J_!-1|(Pi3\7d SdJwy#k|y8i@.0Q̳r@C*8hAf /#rhI4>+ &z-ӂ|6kT(e;m%.wHDvT$1j+.ؑS]#$Q2,D8F0ECQw+TErۉXvTb3z24vž,8/`)}K42JY΃-$><hevȎ='vA}'}S7W<ʁ0 R`|9~_T,3~>.آx*m8D3%~؍O`yY$S !4eZ̃+aF^)y={XFiKT2mǪ`d704x3TP"Xs犋$K9>D U>76Gqy-$<[$(^,i1L9QXQgu7+Ȟ7<}1pg?B _6^lE.XAyNߏ)`'؞616?˜([YBQds?Z@J4:X"5-jcGU pdAC! :wH=Qe=v\[nN * `;F??__spGܟdr6vTJ};< @RX 7 R\<㹩RC!w‰HD~b*-k`"Ñː50 _PZ<7!s)N#fQI}'\x)j,OdWoV[?a>?ٻݐtY}??Ej8n[̃Ȏ˞BZpL / X ץch u |قI4 RCAu|G.'.Jf8gVR? bnՂ1}`$A  RCAw*Xa#JشH1O^7|цgc]nd9+ qcw- "ɚqmF>Od7G$~(XCoU{d[snjE{JB'B> ߟ;`7QFKb JZ<;@/?'C7 $Ք;fȘi;U#a9@c2I̒P)ݟp0y9ߎOvcIjyw; *XߋL. 4z;!.B~=3ֹoR’Ձ'_xFbWUcܪVp"%*,+ |WIj^?W&}1Ev,_W3kأa Ru[W8\a`(m;mȐ5nj̢JEtl+bp7f kpQ#FX8^B೐cm"4eZ#<гiuust{݉Q5bNb!IpLmF/'; :SPnrjy+H =tXÖu׹|C50Mq)k.el$O%.q/Dßcw< ) !'燌Ʈsͻ,EM<%a htH'_) ƍ%oV ?W93 mtピ)Rn"3N6~ {)칗t mXe!z}oP.㭥J1f_ƞEHHFK<qA|O^{2ơNA'fFOs?U0.:XӜ{b\ M dsᮄ"c0-df2>L߾ Q@q=%76e/n:Q$8Iq"4N\cI@d|  4 |gL? ْ釒&rD*4< V1yk۔q+F͹:[-g+Rx*ijQ^2Y,SOYhLIͿƌ"5eZC*l_5J[%kr֢H WďH#Uco, .`PZ`tZQXQg:B Zd&P0X('~xvJhdK %J4-t]/G G>P V$DqĖb&~{Ԉ[BbDkYl>vj5,|.m$$( >"\q؞8޵,r__mlhAS]o~_c#H>StD/-D/w\3ee$W. x-,"{)Ɛ 1 |gf3(/+V$)@\1}A YfEa- $>O {ze; %wDm팼=v iq""hF q% Z՝9$i,۟3F|\2qQ/ї((i?#]x%c( Ei yhnX3+pgipJGN(댸Fu8h)s[Sca̍QĝDa Gi yVdvXIz׉ugnKH`^>ay[Dt*[^ʿ?w_8h2q(h,d:#7 3OfxG n͛1:!:%xs66h}2VI$|dbTXGA˂TwI Pݞ>|YQQXQgyqL]4HUoJ2\cFIY$_Řz[0=ۻkI^4|ת2Q!Fqb2/dr=(3ݻ$wѽL}OxsxszYfCn0 `:X HY^ zDZj~ | %0Д|cH E> B@RrO˒ځw{7d%_,Ç(Hl qjTJ&$K$KINGbSo,{15ʀ|ŋ8 !-7ν E2-|X-y)#%FRăiM~2@Aaqj[#,a.oZ8b ! kdܲ94uq>>ȶmɉݟF y=R&utxJ- 8>( 8(I*?W93 ղl,+Z'_%o~Q(}fF/^t6鉮AX&;ˉ2:vW˝!RMeXA, hj,|gFcGړIs~cTo)j(`S²56V@B.m8X<!s)N }*vw C(rMjxx!:H&&[?Ti+/6Z$̘M }1F( k8HLB̂72 y$RLZoh.ؕOO /ErrkuA "5 |f! +1#Ppnc$֘:c6bBF( Tsa>TaTs%՘p|E: ʂPQI^,苜>QXQg,olLW zX$b2@Է7>|~c*?gm8Pl2ѱ'Yo\w}4Íy&˶dqZz1dtZx&FE!RҰkQCE"5 ŲD{TYo| 'O~6ep8/"`S8֧-*t+ 4`ܝI21(PNA/拌X\)drl4[߃l8 EA7ix3%ȯM+LCj(4z\Xش}W|fGYPwA5b`sGM ƻ:P,>Da Gi yswo#wt;ذ3weVe>0 jDj8g(w;u($wߴX΀{Cm(xղ`lL3G\믇槩 mae$Q"h\ڽ_g0{x ,[P-O*[6С b P e3 mI tNdDnG'ǪAޯ` OIbY((m;v8/䬋$ۖ`\J{qMF~o.޺N AP:b)ɶ4=&O2l~Lu8p6𙂞\J:¼^lbTr%Yub/f`^c`@JQŨq޿g*E[ oj \_Sy)H_qZK ;VdPQ ix4(c$Вhl"&{%GRjE9O ' u"6D攼qx3:vy`76ƩӋlfI =41F(Pi3?vlHjWѸ9hj4d[YXVp)A bsU>75-|!v0nQw)8.:BEgLTGX!y@㺳,$Ɍ[S" Hhbƭ maO:PGJp4vK 8Vt(e?PbzZ<&tcq .t-f6g%˼,:}L;\G8-/hEՓH,R>Pށق)H$Ab@c40gƀ`$)-dMz5 pnvd(My`:;5ІǍ@̢e )t& ꎛ>H Gi y`{ Ur8"xn'ǝ6U_i͵,OK=}.rp(Ig-:Ɗ2&% > T ҈ՂfK"fbQH MMC>Ei0ʲGbӆU%j-?nHfsiDMX([JK wgdU _^M%v{L^\cH Řp^:J$`CeɅH. (RQg:9v9%-$>Μ$"Zn,^ !ϚÓW>96 +K;u~:~q n3$byY8#@u(wLgFvA! |f!Mk &NN =B#~0U .p{T`$Y,;4abbs~rGYۑ!8qr-{paC|i7H҂ᖱ)Y\ 1|(Pi33خ+~},|E: & 9p_5&i!ZIĝ^}l:2(Q.s?DB3KOĴhDSOc&FSY0>T5TeǮF5-|摕l}$7swA%cE+"$lײ`|Y AɁUZ8y">Ng(m3j0g\Ԓ?vp Ca?7,<dש-tzGsQGS (%B_ZaˎG݋KˎRT* EE! 4eZC M%9 dɤk)٨^Xtתp( 여'_Y!X#cT7BKr"8o ck8t(vE,nY]2UAH!c,tt6t XwBw߸ [n*8?jn;v&(Mk YmWNwx-8idJ/$N-%bl W<[?vt_d] jfdqMbWxߤ~- \/#$Q l8NO 3nr"\8ʢǽ!GGjM0r Y,FHt4p8]c( iY$n^.H>GG\5ТCٗy5>ʊltNÿZ6`f@JoE[ H/Q iL Vcw) i!r&WZ kd^`;pߔ/ 3X/[#r}V O{*Ɂ0x<>p2ppaX %t`5 3^Ə~k |S&u@ZnwiVRlDS;,i|"-W{҈Ղ1}бFVYW HB :I"9RC#jBL BcCh.( m`{'^uGO>ܫ`H\]0^ l˂qAŁ$=cc]%3 j-i;o nOH({H][|' DNhZ"4!4eYCGV'DXsRžqx:º8kј/I7mSQ<6oo[rP4 e ȧ$A) FXIiaL.1@1X!,<) $zูdvqO9w: b+ 36B#a]>?C*8FBI},0\Mmaj2y1cLRwY GY0>M\&_=_G>3pܶ𙇾;)yvNԍ?ϱhtecx~ Ǥ`bPm3VD),@[Fp|ۢo'316亥T4|0,D>D*(D_;PG[,.f,qwQ;?5`|˟jvK;n/AXA: N,'ko>S:~>A(;wmJc,FH Dq p e; R8Ί$%N~;zĺ!6^"*mȢ/`L!ID-4:(RCQwjK 9Zd`W_G2-|}$ާ g>c҄HDR&d1 $%N bHŘ>ףu%7룱L$~Ŀp[,ON?-Y>1QL ytqkbd) +;KGs3q0ܑD(`S0s"@; !5V VɎڳEC`]0n%k}lk((m3mj|'?yʐ,ꁕA)p^Ƥ`G.O|C?CB(9$i @anJIv2E{!=ϵM׸%S[}B"ÿ?4fDt!Hv5蕎얖@7[Q&?DƽR[$iۉ+-Z}Z\:wW_$,rv9,I^)+F"K w,lm>#TQXQgx-mkSNEΫ78Ƒ1QSX C D6f a`gW`"࿚%(A?Pf׾(DYNvBX$[^ tlCW~{`Gh9(Tz58jI.&[n)l"27N" [Y0n*dF¸aǵj0ʲ𙇊p67(bw7˾;/‡d H 2`9~d {s5=rɏ*,FH.[\Fa KKB+6_ufd"g&NFp*(4J\˻SUʹ$N~X厺,oY-y[ΓZvAT m3 > iY0@4EVP!6Ű (.q]FT7ܨQٯW)h$OF0-|5*E}~ةVEzS:(RRue>b0 ~~* k8J[Cܼ"Z+wBQ͜aӕ}s^Å#,a;b@UJg۩ ͒$H /x_l,;`|.%캕6秢H Gi y H`1'3m_M"zŵBjDA2^RE~9|0(`h /ǯL8 gXJN2YĻ2?$=突ł0}pipW{Iph8)M95-|f1%ם7W8bmJ4z"5t&l M- lB>u(qw:?xIxMQ|Aqċ:kp>7ϱ~[O-5Kc`l^2k8D[LBUr"9D7:+!QW[5:RʂpIBSzh٣QL yp%>NGö 6@ξ)g_qQÍ/7-T<|aP|Zu\CɦD(:scp$UBl%E#2'rBj8hYNB-iP۾]%Qv/-@6cZ8VIITzM -ā8IC=iEj(ʴ𝇎>.&¼ٕ1%{;xkԃqKXBJ&>.L:)  DNzɃ!BL INʸX ʾ'/NpI(ED#nFixSq_JP,X@GכƝwAnE DjHn]wiD~Ƒtl9[Y7i 2V1@AÖ,X,.ɍCMC8\JeW$zBIgOE>`$j:O6Y[$ArW'ݼ\GelǪOY$3eN(RQgYz֧ Æ%^Şz((Kt`{[At AޏE1wyr0N̂@mzmyRQP!Xث ӃBnήr@d=p^'s=NY$7ZFcgiV#i\W1 +6WhIPYa1Q<~6lRr aGkK?UTeKJXbM1 Zÿ`@4vM٦)+".jאK:n2F,GV §MS񧦅CR|cX4eZ#%({޳C n{㢸?ꚽˆb@.0 1g/Ӊ,T-{P |f [3_|J\fKL:X*5v.BfZ| l(e;>uޏM'%8獔8cq* gj1'[JvfGœX$EF7|hygziOܕ6ZM"2 wiw<F yN̂`G*x ?j (ȘRܯ7fF0R5~,$?MR5{zMq;/En{[Hld%-*ZT(e;]\^^([%("lA΃# }qᧆ>},7{@fC}nj>YB9xY,* 75LɎ#Ѩ|GP$c݆EXčܳ}ᅩ?35\ n:T bX;Vǽ*02go7 t70=a^sܑۯXrf|4V.QXQgڏ\3055NrLamƵhDjj 1<`3fT-!}좦 =~Bb[1@= w<2}3mbdI,j-)L["[ˇvEi(ʴGyn$cwZYL,P s1Mv*2Kr`vҪ|\-qf. "yX$Lj( $/ٯ((m3~Kԋ6)adTM65`31Hz_4@ oSl񫓁^.fm; |4dg(e+F(m3}{c!_cBz8T&.(a+ @ ,N2 |f_^q P7牟,ؿ'qW;zaI/q|}RP-ҍPێg*ȤՋ]^y1{X0dZ$X'X,86-?{Ѱa(.  U Bg]ۧ!?W93 &psk|^7Lpjdv7xv+ ^ěn/Ssbc]秢H Ei yD#;-7ONVE!NNHy7qj'_>Ǥb ĦxuA~R>%_G?iYr@7 uwܫKBbЦ ڔ#}jQ!]8FkmB%6.VO7#Np z%ֽޝҘ|aJزsa`pypsr֪qmJwvS =@Ҫoq:%&_5>adsYܕm-CHEsPa#Yhђ?ز{~M!QʞƥyH|$GVKdAde; =q<d٘p٘(*ǣHZ5~.t,b'(VIQ#1ߞak_vqڀ&OB\ m;>{{5kbW^=ʮk`sn<<]us4VƗxBnlɛݦZxnx^(3FVD@bA>0B8-}bPpW-[8!ܘ)K*za,q7 fpׂ<648b8?5W dgAJ R:l &zfaIZj,M7)yr-vp𝇖Ⱥf'MAgw/<]7\cԈXH` M! YP#]iyOd\"x%>$2Gc2q<:4J,Sođ`Zhh5P>d(m;- Ȏbؼ!Vٴ"WK~Y FHrws!ûG=QH$X w>h2J(iArTJPBbq+(JCQ<wt_Ig "F,;oǯ6;W t(],$;lx!sGџ)(IdErnF0Q+VtMl`<2Tnˇ* k8J[C,H= %`oo^T!}Xr R,<=OˁVe; bw~eyIF3[giXc,a`(m3Ugb1,CJ P{>U(2I o- nXvZ, $+I QXQg۰UK xE.}qaTԅʫꊵH6éU52DYN"[AbsbIhxomD2g*gT: :O1L2;r{ )1m3BPěb|q!}WbS\SeSI&lD EW>h3Ɇ2{JŽ_L ff&BNݺt+0i q-YJT}KdMAHhYP"a)Iǯ, g #5A)Nł{$6FtAXAg:a'- ycAWU> lblmҶ,?,N 5Xuڽ3e\X((֖(RiD(%ۧf\ kFƸ}k"1HlM8ﱳVp&,󎢧n|V3of<>R?p$OFP0-Sx_o*l)S6"1]/Uq41p)YL- ]-%Z|cH Gi yшc^M`)MkiHutƮ[H aɆZKx4*pNdi'{r-\ʫ轴1Cϊj ],g'PK";zi8>cH E0fơtK˲7欶CfP:mJ6ؽJqPHH.o+)d2wxND($ d)vc>0!Ti aKNd~]+q\o#烏X}SrsIуW}n,S,7%^/ONx ك00Pi3:/FIg;O,̹러U'-<ѻݒyώ D?WiŴ P 3p&}tgZ˟ M^hx[H7U>1BQ㶅7Aہ0Bi(D́ ZuL;bJuP5"^,$] 2h>ӝ2 k8J[C)q< VC2IWf@z2znyȭÍ@)ttk94CH >бwSAF"8T'oOIܨ0 ;OɆ]XLIBBF(9d bp"tJ&Ә7'hD|E!W@atf=Ƥ9 :cc,AmljIlŒ{hκyno/E#P V0xn$tR8"w%lre5Hd#U up:EϬw^pc8KK=e `nYE)I?eg_alHBK[Ȓ9-,OQ*p(FKn5Iuxa3pP2`|*%gc Ř>ÃDMVIBD 3R j,oJVIY0} -3Pi3bGl⤓5\"i o sJƧ% J\]^㾑gG|o|;r87^Ql-1RI;.҂OWhvn@ RA:)s,v' ܙ4y{7D"zMsX]G)~ྚ4,w idhWZA^&s{G] Q@0X4p LOItI&(˅A,T I_cH+ړ8ILbhV\/7[a ` w:(ڿUґk M mĺOojt]˂qbȒ㴰>@C(gJ F94..>.0^expU~4뫇ퟙ sQTWlq/ b7N#q'6<Җ`]ia}mayBmd(m3zIV0Mdw" pLT1ԓwl)afMZ(RQgz<$-. Rr# 3NAyau[QN yhr7 oFUxG{/1W 0?dq^B#Di0Ʋ;A҇[tfWy?;yJ7F_bO|gA6̴p-3}g '#%GX{؉h|c5n:Wa/S4p(RCQ<]/ ,ɎBPkAAal'm!JӴ`% idJlU5-,Ȋ78!80oK~OfgXn'$ޭIQsƗu@=v eoho_{hMo/ x"^3=jE:envH(4DA4d`02] _f8l]t$o*%9YD ud#G{X+HN3nL!I<߲o3}s:<||,:OI!ݩyqC]5@)d]cxJі,u(O`h,UI'ʿ~'1=js%FSY0L$=r& :x^9Ea Gi _WRRn znChekV@NBtNhY>%CEUl=˄5-[tUp1g$c8ŦmЏ:/.sB qaU`EZ 7ޔ֘\i`э XZYlt%`DY0>LdTrL^((ma/ł0{6E-I S% *+ǵUДY˂1}`$߃TQ>cH Gi Rxpmv!gA;D_&q$Wā6yq|O56^x੎)ef9EAXAyr<}Ŷ*Xz~9D ָh%^;M!F` ?xJߟ }OTgTi#ߑ׀,i-U&veA>0B1 >bP(2O:&xR 1Hj0v&kdk+z[#L h1(kd2B$ '{o\S$>X- "Z8[bm0YtQX}dXW>1pWi:" <كFBHIQ~c0Yd`"\cH i,S;aI@agWSmԿ +57JK0bxJrd#-D. *ÇQN Ej8J[Xl;RN-0:ڑkc$O7}JaG-AwlȶMvAK+s<<ػEo&cirdXX E1* LKTGjOEyfX';]8y=[8Hٷ|@c0_aW¼q a`2 ΘϸZ\0z/'g-m*NmCj(4B{ˋApѸ+sU;6./@ ui4H,FH?,|cH EyrG>5x5>{C<𘞨E%5l as.%Biɦ\4d2 ^; F^CfKp)},rIW"!G>- 9: ڳȻ?wF/Ƴ*ЕeIB84,#f3dsć3%:L342DYX'6 m_O, `SÍ0O܅iA]{ۿ?v|@EF{Y&{zz;!Rh>q  mߘdPl=Ǯ O"$1$*ȅDC'+ GӹNEa Gi ޟIʹP8Z>O(Rq:'=:?7^DNu&:8߻2w LG|˂0]`N6}  RQ2 U4# $6 ',YQhؐ 44Yy9!dmaҾP~EK]i_<ޕr]K1pYS`L!I#K[Zx$>6SUg(maثUL$rycv#kh"Fh|~Y{i@.ޟIry@ ש|\vm`W"́h撀Ml<'x,˄ܫRc0>ݴ+%;.iapbC ,2@{o{>|.^wK2'  ) iY8AQ>1BQX#ujZr,XJ 4qQekcZ& OIc |_& a`2 })oSox iǍgBώ4`{ <;>sh\ 8"NIp!Gǟ!HNN|U[B0’gil(RQ2>6M z4hBjı؆u4. ܳ]li QB7 Eyy^`Q0<%5}F;NZ;4Fhl~& zwNG5-,w=fNdD`Ʒ`4x )a 2c!XI>iXB ˷%8Ȍ o$ĭەX3;ڬ3&-ӇgqQjZꥁD0L4daoؓm&r 9_{BIjU>-$>y?IpW7Y((m(Q:>;Ȓ7I5xFt~tAnmF*,'{DJ]"GGd(ma6д*9W,+cc%Nq U-'L#$]A WʅuXfQaaOl{p<ܸivx L7PJ:9ǦB,󨤾+)T@tYPD6SK\,%Rɀ0]8$̲HN;gŘY_.Grڍgԇq;ɂk'wiA(kUQXCA< @pd9|P')¸cflJAu!10Txd$IOyb^`rѽw"YиN25-,S˹go֔d5%qPCۥo dG=4nP[,?o-}씒o4*JAe Pr0˩=?P'5q1DO iR=cf E`d- K]2k8D[\2JUW/1v*|ӂ0]`%) L>1BQyܬdŏHf%%chCr[[$M xCeȔd۵ -=bB#u|f泣c,a.޻$O/;ne>0^ƮbDj8HXfR#a-nqk+]((maG ϡ_WI =o%!^Rij8ƬdQ/Sp̃(9i %]@AN EwbcA,4ip@,!nlϳa`25a8KLf?34i31]3IԥvEj8J[XSn䆿"45U9+@7i4Dc'+`*oZ|J((maxqSkGQ\` ~7 c?{ޤɀfb\K"M` ?f5z.qz{t)9I#36 X1IפJYMAռ[.ɭ>wNB$8%(`猋X:~~Y\eA$$,M A7 Ea[yp[y# lb"qk Lڃi9˂bS|:O\Lڇ0F<5eYX3+/fWYBOp,Y34P?Y[4pS.uzAe*R (H3L^|S}A`}CY0f$hln7yŭ "5-̳ױwMB_YBXs 2 bwI_ "7v$o&ȊfQ:=|vI$Cy'$BT)' TLM#$ِX@<C1bebyǝ"3HV|}?܄_5X$YOŖ & 5-,ҘIKPy?%؃ݸxzY&@&ƥO|q'4K X& /E3Od@C<ᒐ+5Z s黵5+0ռ oN^x6 pkƐ1 ,{ bܪKI,swe[X8)Ӏе$AUlYV-^.1@1e"Ra$ݐ+A8:,2:z{MEEoOa]99)dDԤ)A>^QNQ@Os> 8=IvG`5c`;RiaUe,nd:pJE5$~wc|Y0g. b< 52lXg7Ɩ5qcķd<?w>" r& +Rȟn 8"5$-sĩa s>3)/.F㮅'9揃C M ǁd6-sj(LΣiC(d$h0* `jq :]Yl L:ꠄViy}Q㶅e[\;onb0Fs}R@KJrK.-L+]e Vp6̢c;r:9pŻצq|FO(㗤1q0[0$]iۍ>ߟ"5eZX! Hm劷$=%}±NYBg74#SJ.ѯhu1@!"L>KX PIPՃT؛uMlV5شcJv>i{OEI E2-,`T'f RɛؒGq` 6l.e hK2C)+8D_ j` _BJxw_T;֟(vB49Y0޵( ϊyd6"J)枸8e.8؛?A54Pw .dCd=6- p\4-̑+/w?Oj0RFJT:i/ʀ@462+8D砪@6 ߻ \mca\ʒl >z8Σt}X2>៍.%(~.AE9)\ v%adZ< bB(,@&)w,i$Not# 6G|ω [҂Ttv I z|y(RCQuG*HĈ#A<}&Ƒe檨X3umVViUQXQ2$Jݤb~GF*UϘ56֧]bJQhT>.+ k8J[XȜL J x;pC=Y)`O_ ` TBB(TMطfD>(-AN26F@@s)neM]L1Bu|Ix[E-.%\8q&wi!K³>6ՌWpC /$^6H'8nLG<& IHYҧڇQuOzV"~?Y' .rJlp!<2os"QgUBbI.tUM qE!VKB;?E'ʱavڃ`$Fo!6"}Nq?[0{UŖ8-}3 "5-Ȧxo1q~uu)=˦M @BOZ.Cg3@ _ j?7ɴeRpf\9ح>FFzN{Ihlg-ۙ8)d2)#e9>ldZbܸ\;oGɥ QQY0:. ek((maW}u-Aq؉]y[CO缩т4}K`Ҕ> ߟ;^_;HTc[J[ ~q$|}fҀ1]`%<L q| B2jXg-f |ϳ}zߐxƓ{zٍJIci-P21;5ϑgu= N6"x;bdW*5:|eb(e,\4]Wp0ς㘤q;rwA 5)6Hmب@4P< 9fj#[lc T &?0|ΤvAF*ll[ ww9阼4/I]ZrŽRX[s??bl쩞42Omuz×OId뇫}|2Tp6΂\F";/,V<+p=867 Ɓꊲ@,! [ qӇ0F0pܶĊY]U0qTqdA>8 .@7ܦje=4 5- TW5z"XW$I\ţcvgq9;( #n´}I"(^)Bd5 SP)؃-;K,"8mѠq xlQ@EUZVyySi )!z0OقͼIp sGy}4ŋ %'~}*0?/G7 j TDMaLV׻TbIl}x3%N- }?Ej(ʴCR;h[oMd̃tc(:}jÍ$\㦁%pz BH m $ e2%!ӣbH4F|k4㦁LFIGX ߘ͒68+8@j,9$=/ f?Q8 v7HF7f O uЭ5,_˓0QN{X04HUO9d%-7>WQXQ2}ѥ9%ZPфiHcsc}W1kc~ <%TiaCE؜QL < :8Riˏ))@kԃp @. h1`CP*m.bDJ.Ci.C*8jXfW'(zB߃]>>I$dB5-t^A o3Ђ`{/K:1biuBNW|cщY-XEXyRAe "j4@ +bINpF!׎f! " e,bE, AZ$SHt 5-,-қ 'tSӋǠW_olq-#'4؀->໚s^F.1B5ma:\_Ez<>W8&~Ef 62K ǿ,ӣ7H]_AH#e\S{%ػnpL629օq  $ܔ"ͣ4MH##u |؟Xw'9JzQJ# xlT3-$$!>n(RQ:Y%g}J@9VV#}@\&jhl[ >Lࣟ?A*8dX &OcOCζ\V;Nс7ۃ| ?yܻ|ۧX:At@T<ޜ ֆ۔6^`$qr!5_y@]%!tY|\ah,tM~`&dE7OJ(56OCxN}M{n>ߟ;:_Jl+;FawƷl95n,t#5h] 1jzkWs|b|.Q/>za zcGjv)^4. :$m!C#Ei8J[X׃l N%]F_Ar4`*I2Ü52FYXg! %s O,9\ WJeXeUe-i|8D:_Qeٻr좤+ eQǵ's 4Ǭ1rK ]t%i듁a]?Dj8HXfؔ:.yk*ftl>12/dIfڴ`LEd-]2C8F(pCC ,%&bMwX Co 7Rc/'XJDe z&(P(eaׇAG < 8GDOڇ ֈL{b DV:"/]s((ead3wvJð?UxHe,L tΛ,_eab+P60Opو}Vld"?ٖÍ7Ր$xPƿ}3qk|r/} &hcDuy0=Z")8|DEy(C\yIv%x}w$F RcC؝KH;h g}l}9G0h_ftvHy'zvD6-ȝd2 y' MOs}ϥ,$LM3xd`3ٱ%h?|.V&^!A'wBSXWwk+(0iNgz2-%|)goH8EIz& )w,D}AT(e?/vۙ-:Iȵ'o qvy. ƻi;Rґ\XU.Y;2k8HXfⶍZ%goGjWb$럪9v˂0}`%e)  52nYX!8c%yQJj͇w\Gi>Y@ܝam KGj2t\HiVPȃKty"kq߳&t]Hl j!cXfYEq *$2!wfE9{\RHaI|i hFX}r@" 1-,Rߣ;ٔ:dKT% =|s SYg{M>1BQX#㖅u|.βM}K:h Jhs6P]rQZ00%Ap"}>(JQuZ`rUOW$^Å"fYIPy eI#-;;Z5k(ʴC9tXi`JPsm60F{4`K$Ӏߒ 4dO1X12 D.ڕ=IԶQ6 p_ '~96˂rK,lhV>1BQXQ:,hȰ͐vQr3eAgo SoJةB48!#F!IEI /on;$R׊u_2)[F) S&%Vi墹8ce^9u`Ƭt#9$VC @(u~3?ͬY%r$m˞4xC_N9cSYd$b$!, %vGU KWrY0֢rN ۞c۳AH Gi <9|fqSË!鿰Y:5^Oc4}PX2]>اY܆7yoN#Hr-. ex'%q=~­3! 0G/S# %jl n/9dM Di@.0’ bi:ٹO.A m`ZO$< 7e GZo IeƩq`ɓ, N3' [>T(eab$<{RΨ;#5bR#X&цznXOȓnjͣyXN7f%f3I8T8[Τo^0nk+X<>:=G9P hRͫإ$73Yf].&|G?ݺScW{+[0v_If,1ԦFF) iN&3N<@bI70l"}B(>"_{%!._u5 w{&4N5BC{%NcQQH#uG:<%Ajr{vY!'̽W5SlA>ޟt֤F E2-,Pc&iףEX H{< F^.IIoaZ-EgU@u#ڿYr ?rWj%dO#y;ff cKS]m"=4T p6"ToRS ST< 4|IO),M?Z;. ^ ^:_:%rqs)[3.-а29>f VDJ ;)Y"5-,1Qvz}xm&s+H{c5.ĝ]1'IcD`~(&Gyh;K& rckaci $f$ `ȋ.T!P1X!<1,=k&Zy|;ɇu@gIcPC5\j- '8USQ㶅e*վX xo`nn6=#nnSEG-Ze& —Kre5,jATmaY .m>FR†ޏ _%wEm, )Ɏle_>zR: k8J[XA{#7":AMkg@emAI1R1NP!?wL=Np-~E),9T#*o8f y1Y[:a`(2A;/E5~H gJ -dvKI8ߴ0H>F9Piaf/u:7Kȫ3+zՓ@ia)0 PiOb1cceB?. ]$2xy4=zbؔ<5*7-$jRvO `س;H Gi < Җ_00U[ ԉNT4oDYP!MR}{둠==ʬpij(H_bV*[0GaVJp&/hDkWYx# IcGgY674.ӛT`li`]mUNy*81!5HPkxY[$ڟ?mf1˔Ⰷ%XW2٭*rqVXLv, Ʒ.EJr"C,-l(z-b+ kd\qqGI.qVZ·4ߟ3N[o9NA& lr$~^aז_ȥkHI=a^lrt=Z}ƍexF䴰|l(RCQ::`\%  :bGC(A#5"p2`J ,9bOT=~_;pG[O[J.vGGH֌QP[t ʀ\@{NOP : ,e zhEe >%'v݊RhQh&'pƈdA>0B8VY`mOݝ3PiaWBB'k$(Yz\q+2֥&-wږ]҂Hd-"5-,)[8!nfXR֠##'b>m )oY0nfɁrp >u(RCQeZv+\MX5\ߝgbnYĥ\0 $v}$ryb-852sN`C@Ʀ2vn6OLQ4̃AȀ6L w;G5G2EU]-ߢg.If'\ RY`)R^Rb$óSϤii!f^I}ZBxЇH2-gtũ/30 fם}ܣC8ϣ ]@f8՘MCSAy9'Tg0:3=2K2@8ܵM@Et0OAgOұxmY!X㘇qQab$7x_%*l2=b餱` ƧS^{?-e8J;#( v)hI,BͧO>B3I;-9bI 5OczuI {о<]<8ѱqv&ƦVXǬd@XRILv1wE!C,T *I[Ɨjr^e1foOZ0ܜ!% ,p\>1QXQ25 2*7f \]_X,$5Ov-yr1`@1ٞR蠒 z-y_ T6$z'p`u񵏼^tFch<ƅfZ?4U|?Ej8n[XllqҼ,P}wAy!%_-ݩqቘ$R_cuLMnW40f⥠3epo(`<_}S qd oJL Lc,H̕pt  RCAez5cC )ܨir=xIq,gl2&ݸ⛖WM=/?W|9zf:!Y %!GT"7"򢵪X-ȯH i!񥒆 g;wQH#u:'D 3BsGP>8ޜ:-A4x2Q 考*,8yw5$y6 v 5cnCdjtcE1%zI 7+SQ㶅e+;e8q7Kq9{_ښq7H$'9 dVp3mF%,!C=W_la<kW0 ƛC)Y.6-K(RCQejۃE:푀'5n.@9O)XJ ]>s ,Z@<aT%=~{\Vǿ/zL Cʂ1}`%`?. tx8F8 kdܲC@9ū u~4U$N-$L o88p4΂%~ks\&OND\UwH{vSˀqIHD!>vSx:Tp6̂;/(wK@ŅG힅4÷4] 90Ϧ.穡`m`]l O~1(A;ϛ c歨5(J0x;Az`k~Mƿɜ= %Azě&pv.#߱X4^J MdS$M@*30ME!Ry <\B>}=7RHE{;a2o‰AH锐(:礐1: =/W)ѡC,t' ?Th˥-A[5 |*Tp6B3) NKp!87z%Ggc37>>g:g; PLA$B!sx6QSptBdSeAX>0BXߴp0I>ߟ4-PYVw}fzSՇ+B{ll ݓXV]e|s |9䔀 r84Zk c$i |#cE×%DvD+ yZlFo~X}upm ,OEyw`y.`b݇t7 w$~1HɗCEH{B5"5eZXELyR?-rGZbL`+$ L&i!b㻭15|2e\<ޛvvF.ΦkJ*w`V 6%wxi`$w!!5cXfYQ|K,ON`HB`P't v@CQf=~{<\HG-(&Ɂa~zށLfnO<$,lWM]pʿ?v|@yۗtt|`FIt|nK{4`P$^/,*. ma'(A4];;w}c1I Lii ӳ :)*"9Oeߗ4GOo|ʛT^[^q\~Ӈ{\Nc}ƛHY[ m>&|[ñyy91"4gf8R@|5~_4CI*'[LRP. .+'V.~N:pg* ;cCFa G) ռQeht{dx~$#aar=rم'pƹ4.$ŕĝ&i!zC8F(pC5Hp/Z`p  lY#c2Px%,+ )k3f w %b׏=q% 2Ʊh55)j2 | %6uCj(4"\EgskHΆ-h~.@/\5k Hr⦉Ept!d2 L1.e[vBĻLtN.LP -cM։.r2jwW$ Bcbܕ>x/l!a'IW;[h$ NUu|~CDz' |vVsg4vBu)avYdMݼ5,qr]oJT~pGu)]~OF_αOIow.A8F(PNBԚ̇˛) &c\ހȷ̝ 8_mEV!B_yFk\2F%܌lPVvc?r#;B"Dj\5$y|}O;:_Wh9)ٓJ>Y^l!qwhJ3<6;ؠ)8 \OKEcJ`*j8T'r߉_ޚ>kp]^3s+%dw|O>ߟ4-,Zś=Xd3I4cjӵqqs%("Jv4Px*zWda9]lN1PbBe]{*6}ȫp,tJSd UOVB/JjAX!c,bcv}N(,Id8[X:H YgVtAm H ), $X "~w#dH@2?n\,Ɏ\cKyeۑxo, MɃ;i1kĸ,Y/Bax&ɩ^YSQCW,6@pvlf#ि.K&p6 >CI Q,?75WX" <)6%}ͬG1Vط4XWѦD}8MU+5-,A╧D)a<m`,.ZI[/Վ'N8N0, pbdjAuz78ޒD'c}V@u0L|g v~/ udU@d]5eE#Fi <āhTŁjE6S^$Ǿ8=BSA%auY p((ma.|KJQT}z'VNRS7ex%%zp+yuܡ%\%F1yĬBCEE%l:nG7%lFa-YZt(*G犔DDŽ7:!6_PkƆS ,!ţ[8k!C~=|fh9c$3"LKXɆW<&#ˀ1]?%i|ॅ9m`ldH5*3~yAR͑XxKߴ Ei(ʴ̃/!D_tQwQc[A r)쑈2 ALur }P 1/sX˒mևQWd"eȶNR-FXr!:3m1 (Dj8lXg,ahgA>|I^ԈC%iU&|l:@((maʹYg s5bӅpg_T$p?r. NU *<ՇȒx1=,|@%136,{:b5Tߒm[+S!BL $t8 K/dE:E5E!Rypn7(>)h::'dIɂ0]`%$L Q rN> f Em$jЏOO`~zaxt[8ޜ42ʂpw┈aB!4eZX(=K}3># `tS:6睕9<_$a:tep2L!fU]5K@ hJSR}e[zYH| 4eDŝ}Dj8HYXf4 i}|'7`?]oask%a^/i?+omV4%%Ò"_}oA1kWlf%{C9 =mم0F0`ea:5%.E#f;xSbݹ. *t WRQ2 7n[ d~Ae˴Ͳ|&D q-7=d7b!]ccHT$PXf pYXm8e@Ԉ2p\Tp싆by Hv?L nqʬ|v;Wix$wI 飉h~w]<<8oo=& k8w$zgtd0"גn0IRA1eZ؟㉪UU {ƹVTjaoVB-AdQƷRr2ej2#gy[M(0OѾMJn\< _wF J5^f|{v06-3Tp6LA 8>1%lGs'͏Ec9Z0iT#e ,#D4d'KICZ1HҦ$MQkYlɩܺH*-]4DgnMZ %Yߟ 5 ,S^ #qyۍmW_rb =YcC`|yÒrbD}H Gi 1QL <6p s <'ɍs> Q{tg'8ISr "G6Y'vn N9%, i9'-iӈǎ +qmL)`1e$4[.1F(Pia;lz/Ij0b8Ȍ;K'1/4Аf`|MJXY/|򳢰e#+o用B\D ڴ_2OjtcIM> |\ RY(3I{$rb z9$hJ -$>MܗCz0ȥ>~((ea!/=궗{Eԧ/YW\o LaɅ'FZ^}ATmaG&7bpJ.E8VJ+O:fuPZ>MW&>(Rq2 q $) 9E+~ՑG%A3(a85T$) ['k((ea$7@`ؗ`6;qݼh${Q@dX0@2<cc( Ɯ)Fq7%y>DY5\_DYi}/ 2x%q{gI$i\!̌_j4wЋ*4,o1In.'laë|ljtSQ㶅e>jW~F&>50O o7[IQe<*g(eaGsGHY-%o9̃#K^@ 1&KIr IAsRG`^?r4fh:L]\@9}7j|5k4t@sĤOV7KH4^:#IKe.ޟI*9dtp`` 9]7%A.ph&P*A0u!Q~) l.++8FXf!&էd| F5KVx٤Ɓ2`ݬ>%Rvt(& Ei ě ,鼋H w>Ej(ʴ̃Ktkx}Q;Hi\p,F5k4P|B' =6ubXGgԺ5z jg],̍ېjMk#(M ,uEID+g#: k8J[X!Nh)[/77$c]5vdcxJ_n@ǝg4eZX桲nֿDr%ac<^M _2C{f0G'>ʒ 9TgeS *Wo ͪשw{Xl 5-E4XdE{xãn.gKə$:+x:HZrd#=Bݷ)\+ƖC}r((ea!=yU:oHhC5iV5H& IIp!sSdyXc74 uqZ$ʡ77< b242T&x˂1}`%QE',:! FQ2-IPO˒ηKc˃{K) -seNY/|4 eVp6BU096G3X7Q n3pK`kx'IvT'( FYyIV'yV"O8DHr'hB)"+d`Q7$4;, ^fFQp1ihKXiXKcmCӸ(oc_C|`$^iY@sz6#Чc0wPJH_7ݣ]yxhq;0}7d_k8(ʁ,*k8DYX'.a9ɂ(\_rj4nǦ@/3`"?)ywDEӠH <$) ^|~rTi{JlQwLAI9V"e |n&zn3$lOɚBZ45ܴɂq){Jv&^;y(;nztD42|}XOI ŴH<( -=C>3k8FXg ..u#с"jO"kcm,YaxA~ DJIۙlޭ<>#Waolc yِW~Y :FOiڒFlέ<"K K=AےĞb0 f\wVi;һKcS'-v$Î?59~y-Z+_욐XtΫvs ]!K1+g-^jS4:BH GhhRI!֟_ue#q,:%&ǂ5^05+H\ƺ^.11"LL#,itqdCJ~qc?4- wMv>y(CQ[#%yhq}pG} JD\jന ޙ)j'Z9 IaGN\$z ǎ)i7"~jFHrXv%Ǟi,gzƟXīQP)yx;j"a>73pˇP)9xub7볆eX"RnaZf l@2 xz_b}EgE@"}g^JvJc|NXkY$_lZHђn!z85)H EyyNHZߒ%=::~c_( 5ʀ}Kj4p#&=*e ڗl~5 N8.4#~Ip-5Vex2%e5C T(Q:.=.Ԟ`D$9Mx$v!Q!n ?-,ƃ!,\Jfm`bcvJ0;827vWkFCiJY0a bZVbP(2nD[y$dw<jN|$KdA>0B'޲Ӈ1F pC%gAFzb<:$E3~Uf <& %^e`gUb RCA2 aӸ%uJ'_j-~7/ ”T4^p87̂FzD(#H)跓29=ۛ`@(U-NU 6TkJ /HL$𕅓)"5, Q\%٣B \ŕVAmCqb#$[BgX^1pܶCOfa%G >%wԘFɂ)An OA"D2-,]aoJxYHHeRx`h[\i<<B!L Q9J)avqՂ{& i]@sI^ÍH8I6# eI%~]4?,x$,,v`៲4҂& K5tظe*¶qKIrVV7) 0̓6^e@IJȶl%]cH ŘY6/i}InU<Qg:16ǍmRcGbGY0VKIr6,}P) k8J[X桋-x,Vq#'$DoDit, ˂0}XRȇ0F0PiaʊXg.*I#o[ep̃|U|$aBa/ s۟/vry RC1ezA9:Q<< mH@Π1^*46Vx&.l ;Q>r >+0?ǯX#y~̒'7Th1|$5?'-$%K K&mDpyFxn6?5g % A{ Yeult2 7y[#Ucx&-wYh]sma8_=;lwjuuK}VXÅ-@N Vmҿ5ы U^ \,+psDp>}i81?%'K09V}DP 9-Sлxg۱'$ wjED[2F5sm3t;t@6}<| _6$@H8T<[9Rj<=n$SOV#$(! ZهQ㶅u #J/p-6u_vU@d\ H |a`2q L&'J ]d,fvKtN >ʂp79QIH-:- "5-, PtmJJnݮ}KiڎECU0 ْG3GN efύ~<:J ڣwvg#M<LǬe@.0’6* B P VȨe`nWxI 83pd'B;f |H7w "5-̳`vgZL*$M3qkέLĮXBj4T( BR)GsfFa Gi jǥHѕ%}`Uyñx&a-%8W^L잍^3jm`{z  1-,P0of\>I+h-~׹{d꤁|`$jd%(OFQ;-,P6NԮG/gZQ8 1}AxG*0FrMK'czIM@ q}ad0PLo[IҐTwNdF?t{xl}Uy9p7%ZJ `#C*(4A߳_ц XqMV`=NjeBI2lOIzzw[k[?^FmAYz$v+(JCqejF n*+IǕ~*5ԮVSee%Ņ{mH Gi < xokڳ'c nƂf!FoIP~ /fT)) &ﱑFW Ըo@)WJ My[ m`i䉩%7x[4[+?anlp\/lA>05…f EyZM/\x% ;g 7Ycf@*\7mm qR},e,题> ,&go|K7{Hu m׌ nJc lY$lʰ F>amaGBfV0/$%(yȒϠl|/;1kw( 3I@3b.6^ qd`Z$줜"%'9"é-c /gs-ji8ӿ53_,{,{~< I|;~$۹X,( `Ւ ЊU-Q0ƈ ;$IrK'gK~:pq37c17>kĢ,qvn9Ǯy;JKgÏV1?Z0AX?+e2 L!Ne :OJA!z2u%+iaT>} 1XeJYt-lP*9~/KI!=Ӏ3t,bo5BH Fh :L0'-я$utJ7ԕR)$C6U& _0ePg4t [+掍R ;V/PJ`L9& OFL#Ej(ʴC9'#=91љmj beɶsؘĐ7d<8J DX"5eZXU^,&e@I }P9A0 =rxְ5 e_域gxƟ[$7 %#D*7~h0Y>@$i`SRE+.0ҷO5~r9֙X4 sgΈӿamo3o?b/c0Q^2 H I0m<@#Dj(ƴBM6_NN۟#hHO7Ʊ׬1%Z/'ć2Tݵ 'H h ,tsk5%eJ\ |XYi'_іr:>HyR)z]`>Z?IJbw|F"+!#_f3IaㅊX6iQdz BH,} eσ+Q&rť~=u0;9+k2@,jy @\oGyP<0'oyBS:{0v).PƬqٚOv$[tbbce*jts0?E+Ҝ6iۘg$ia#w ~*PC=.?ndDm$G7 ,bäd89RWT>ߟ"5-,eM Jpgo7P0mK 4KIՇymaRٖ: yQPgV wW>{b\7viwvY0nڪ`M 4rF bP ma,X ݆䖄-n/\;XX%! I!-$vܒps*aPl$5A=%;;ĸ9R*ޫ $}c` 2bxP 2 p`! XX 뗪nEX<؜'r{blh3i8Y @_ZSC(JCqe #L^ aof}fiL6.0Cg(2v1{1H#cu\z<{W!]Kߟ{'v±veTp̃sCJhB2t?"0[[F1 qPoīn}Si|4gƉc#( E)GP&IqM- %Q bNTa'IeAX>${FQ;-,P-T0s'MGJ@ +̌`t`kˀ1\?er) bceI@ tŸ$H}q>v>OURR-!7lR w3d_jYpD21bu:,=6Z­-.ba7E3ڬex'qIEq+ 'OE2-,ܮ} b\ 13Ih>hch }]Hj b td)r;bKh>;L;nwi{dX>0Bp8mJ(Rq:zEq_`zȦȉMV6`~.%ްi7'R12 p?bCCI:拿?D\yMj0Cߒ`7-X  &LVJ|]j E,SQRi0Sr tNO,,"S1d/* /[h Id~c)bJe!dIenE禬b×Iwwì& ny [KM-/{ZHlBP@N;33` h 5]_2X)V,GyA3:ƱZM40w|O y҆,:Mo;u૆ǬVeȸ$G,.6m`7SA,&Ivч;30Z ^[nFB c( ƗɄI *:o:IRt3m i’ zJ E pW Vp6"`vD HD!P$oz]4o,,$xX>KĦ((maGjy<<'X,N˔XHL Ӛ,aOOInY+RO>G1i(̃[#$wT!6vy=\N޳\e@X.ޟ\O (ߛ|#Au!CE=ݐY"8[ 踭31vgө,on_j0B_|?Ej(ʴ̃uܼNjhcwJ *=@X27^QgAb`B%Acx喋J)k8HXf54 |bCͮca#96Se!qY -w A P*<Ăa%CW'xn⟍=_J♕|y_IvrE>}3)d2΂;%if#1Ni4c'6-o~MI`,\.3Pia$:v2B&i A11[#Bb_ sNrq2` ( ,%3SJ>yyy%1} F6gv MMB JAeqxt!׏oyкlw틸{gOkDs {t BC&b7DҒ |n wvk?& i!qW#ϒmZ6y 31&5`Z0>X=8I+ӂةGSy%*S|";aыKjtBI Uc7, & ;#5-,PэY͒}ςUH`b$F:K` Q*J2d6Dj8HXfkosk$$Ia]pC%b: $>Ē ?br1V1X!r:q"6(з3.~}۷Nt$:`S ylG5Y-7 Lc96{FVSm1NL1ޛ$XCi%%9Ij ? Eyْ̡5ƍ@ e>+`<~],S,s4|Ӆ@` h+rHS҉ص=q4X _7ᤤrbPpC$F>ϖSvh '/[}eKY0Mt!d(:])jiv)Z}@^q&3i -cP=$d`xL*Aev>XǙaދ7y$ƛ@,[hoX˓kAsg EydZX# OJŠQd,Tb=f&0- FBJ12 ;evGq9("H446NcNKȜ\QbCy,hqshA׶-23q444d/mr'R23 Jr7Ҡ([P w>GF4\$2" {c&R!:@BnJF@q6 vWOˀ1\(oPy&;1|t4DTcgF%%;熣4!) Žt(@c>vmaM䁳Yq6&*LH&_6~5Pio|cNcV`l9~ <eh')W{"4{x4N;tY^1j@P؃#sb %|sGk䬼<) HdI ~CMj,FXrǂ7 D1(kd4B\`,C䦄Au.Њ%q]lh rSDpk c7@Fa G) 6Wp̃OE5%8F Ϋ{~Ɣh*<%C*dr3f9h=$aSHùE|t G…^q3 $jV'nebÑoFSP)e|%9XNlyN=2@XH *c)9,.((ma_hMZ撴l 1X 0x)iqSǓeNIGBY7K>Ej(ʴ̃fu[T#_#±K>kȥ,w,Kea!~؜QXQ29B&Fp]L}Hn> ^xDq ‘!Su@dA>0BxY= E2-,P9z$ ׸IVE=;N&4R|C @BLgpRE3qYhO$2S$}|$}iF,s5x(K$N,(+YX2{ʹ)a{}q`|KX?~'ްi!qsaJ6FB\>ߟ,P6yۆ7@Sѥ l0]`̅zB CɈv0TS!X!B@|doQ;QgXy|cP=i!!V{1hLQH#ulTKƮ;-O /}eC9nʜ Y#52nYXl7P5QO1Зɻea Ǿ| qWP60O:QtkV K0ˎxKdʀ~%_Y8I(?vLAP/׍_Ĕ o5TB;Ъ"zQʑ,/ G)Ad5-,TA>P"` QfqF(%gjd0L5}NEy !l޵ANp<` Xn``䴐$M ;}]5,PV؆7b_p<ǩϣ/TܘlWd( Ʀ+Iï,2}$eF!Rym 'C"o\ƉL\d\ d4P5Y>S\֕NrCAeI|&ץ-BlZy}2`LOI♯gBG3}+ 1S3$^Cl ZHNvByG9iDql!q)8qʟ"jL.BAy<":/Jrǽm1/ޡ]9lWtA4`xb$,LJnhYu&о?#[`eWF\➑$yg\ydRrf}×e%p[Yh{xGg$\ L[Qj˂Kp;W:飛?FF) ^.42JYXD y#Y%mD J@`sYb \ͤ "5 ,RdA҂>"ncG4M *!̦zN6^*M!X!<c JX]kIũ4az ܐ9cKNleEfq/H Gi <y] Yph=\ q/2|\8V;g& ֲaKXQ4 *(Rq2X/76$."Qâp;w68N8FD76Y. %<ˇ0F0`eaX}_Y|xKK^\X{V#iS'1"e Zr9V-MI}/zD5Ic90~YXwU5E6dCj8FXf_3|:h& ;"51 $hXǿ&|l RA1e<72ΙY2л%CP)cR| L!NB4hP@ʅ00P6̂Φ0{ [.$ګ诱 Lj+Ka!q.S>6UWTp΃G':c- (†¤#AǩI8Rvс&N &6 Yݱ~} aɅk W—whbr|sKC2F须9^`GhxCoUIrpr1_o,45Xy Ycw^.Cǎ×hq֌C )JQ]]rgW0BS/Y@C#g m < NյMDdn-B>1"M. maXKYZ‘Hh)Jaq"=5XQOv@)$4墛7F) ,ak4b& |l>w(maX"NG`lEo"OEF10 ESa=Mg)Q926+H sQoMt ;G09FzKmc8ƷGJr9 D;}}}4z_lno7KxvuuJV¯eݳF}0V_I2[q\>vEgVpUis.Ǧ/zԲs=xϓM, C|&>&[&V-9 ceydL>F1=yeSo 6FضH 3"JrdZ#]ÅH Gm ,؛E l>^\>.E8hjjn{iA>0’;i|cH m |lJ(Qy%f8nQb> 7zeӇ4|ړBK<%9Z>Ej8J[X|N%T͒;>*.#F.Se!39Kiޓ$UN.YAXA: >G :63IAǍN{tk)OF'-_,`cʒ {B#Di8H[g# P}$l%ՂO`Dw%2J0L 2J4$}@ !5 ,⍔UP|;%og jhz8nL$iA\ KBGnCM(RCQeY†KYBzD5)\/WsywgdҰ,P|l((maH=qr7Kpx * E.45]sfAě;CXXXLI(׉dǾ)Ɖ}InX +)ԸpLoӕfZ8.15-`8I!xlJj)Nipksx GfAK]fi$)>qI>1BQL <8C߽'QՂ/Rb*H~`i!_J*Y79 "5,{;+XpB1Vjqຕ=W[Wm]Y8.%m RQ< -!VL7K:^i;@܁O$I{N M%!XZn41H Gi u((maWUEGA-:Y2{Ha&X<* 2`|a< EPzŐYh:Hgㅒp':iP" W;"A5/­^*h BI:!-erA! ,PmȦF}4dS1'6Jឨq,8P4"c2@HЧ߸߿S&m`A>OGJ$ /1mº wmpH.@bP2 ɮ$&~$,yEV GnWJYAiX' _ʃI*k8FXf!g(6%g?+?Hy$ڟv\ې`B:@>Y)(jXgclnL`R7-Upҫ4" H(ƱH Gm ,]nql2J.F؉LKw9kOEd(7-߶ʶ(Q:%K%y~c0n-O0ϙ: /A4sGKE0m,% (Ow`tN/ e8r1i4R)ٰK ۃ[ Ey5#1&YkJh j@lp@bPiDbl>'vlSkFQ2-,~ ɨ?}#aL"RvLYi!5 Dy-z aT$0pBtMFq 7K"n'DⱩ4AZ-oʏMIp"!#5-`tEd?ncH m ˵2Pia6DMKGm"hdApUJ=BZD.)b?W9|D2!wt .> Qlun8kjk <؅_%Sm?x#̚~S!i.0mm]\ Q2 50ġĵ=!qB mYO lv@dx]JnC+pkE!kzM܀W(YLpv`nm+{߳F4fG oGʁ~Y9dCW3ZUG^V_ ?C Oct_&d螠{ª׾Q~]QqcM3=ׄ)+x,kJ|^k(<ݦ4NhQȺnHH6/ҡ> }0 UԦ LT0F( ,t}@7KÉ3]$ N#q hkDBb5N- eaż#۝<"5eZX!JÔ|kEqSb8<fǗQrr'cm>048F8 k8J[XQQs;Y8ϙ3XÍsaI=YDk Ly9_rq1cBFͣ]%6ǩ[eK pQ'#쇛;S’6m{b?1k z LʉdGv[5CX Ei(ʴC $L(I 4G$lD.HISbψ 1BQL <]ŲeIbbo'KnkG Pj4<˂0}h7O iwB>1BQ㶅e:9`D,ldl1euCH9/Qg դc@Κ%K }HQ㶅eY=?/@=6$jzU$_`7ij LOJKh !d(2ݘ'nUpjɱ!7\q{{:;1y"[*_cK.B`]} ƝF- <]74o$;6vOH57bAz>7Fd n}V.0 H ŘYdF6&XrNnl?%aca=񂴯'\V`I%z5jn@$qr4eh;ԙ7 aIx9hvNߟ 5Ư2U=^@Y#3 _R?ɂ0}?%h XPD2-,кWeJ:uڵXܙDݙ)xc Ej8J[X}3%$<7k?*pE6*J!&#$_ha% x]BP׼C)(F,T70=ڕwZ3EFǯ챪mFEY0EP~L>1BQeIpT_ E#qbM|b8x& EK. D(RQ27$!HL +jiFG8~MASc,$lecW-wEa G) iDdޟ(jr!  4cZXf_ȱ:(Ƀ8YƎu-!8#Xt^o}EZfL.CR12 R#M:_ ߲ccapE7Zc<ȭN Y9Ij9Y`/n5-,Y[]-\& tFڎ{'ˮO4B3w-9x\g'B-\ i`Ӧ໏%%!H'_EP>+f $%#ia`ё.1@1X1:\ 殡)aJ#Œ3 V/~ɩ?"ěZrU]=AX=Ej(ʴ̃'%{r~c8͍_YR~-هQL }0sq$3l]_0۳ߝ;(F_Xѭe!qW$H,8(3 k8J[XSǁn|F䭲JD=C$ZjR )z %Aabx B P Vp6B?=,`j%'7^,΋ޞ8L'?aIn>magү]uqa1jؔiuApJ7,,RV wLI~=P]C*(4B=Pu 5Ç!`пA= Ÿ#t$n!AWE__fس^ܞ5ۧHYq!wÜ;kYCI i!OIiagJ{$nRypixj{ڕ=ge z8\T.q% ]W2I.^+SʅkW*pԶB-~:@ItGΎXҶ .+HMf U$'شq`&}?Ei(n[X! +HaHB&ƸdIWijY0LΚ4]lL뛂y|~M%7`>N#sƒx#`lt1L1QeI3V1!%#ȧ"Er;4~4e@xxUeagFL؝3 =~B!#oXhMuu*j'rx.ܒdor1-3) qyWF!"\0SB@I Ipˇ=(Q:Zh -RJn!s=:I.+ˢMTZ#v}ԥPIB򴢰uZWYTđ$ Wm! ʮRo>$8У{|)02DW3ZT7_͖ۀfNRxWb6q8i࿓e)9Q՗ځA5-,;F{0x4Dot 2 J7c҈ɀ!=?%ِMwėB;QYޡ3 .%h :o"\)UCipU_̇$jA#2FXg!>E6RܞÕ)ahQ@aTP~Τmxn1%_W-yE)9`PR{|B 9SIw^Ź3: _w/2(`K3 >J4ڏJ@9҈΄(RQ2Ð8).xq.Jg .˂}JB>@єVQXQ2}!rE,LщΑ7q'~Yo5vBƥ$da0}a5-,hFv%ypzy7_b˶Y0. V[KrW̲m(RQ2T`!Q[w@<x,(.e.0BBw[ s D Id3%Dtf;sME+ғƓs҂zђ O,5 Ey(Cs۔mPڸG> ۅCr٘`RCQeLQ9x7K0ً>FGS?NG)JccO`sZD7bP(2ٰ_)kϒKvnC)#M{i%gdX,($6$O.:Vp2B -y$8o3KENǤ10b u3=Idœ]OQXQ:L}pLY&( 9\O$+?&$X9QϫB#eC8$8ቼFy`5FPAz>0 IYܤ{A>)8FXg 2%ÎF-NI2lQPw0n܁Od:=4fg m`Nȴ0\9IIč>9b:¯.YCUix`JxXoY>\YQeJxp W(A>D\¸?T.C`@$lNt+(RQ2q, -$weGVr:v@mֶ>}]OIrW' _t9P? g|΀{UJ7f)ȨV9~DqEy:i-$-Vk) i8HX&J|;  +۞|qq^É="'*jrNipg ͣU vll$O)~,8b{!O2X9/ C Si`*] ?Te`7A RҴ5#n~|YCTix,-daT*e"5eZXG*8"=5Inz6m|0#4pך ;=[kr CH QI QL,`@s(qӠa!#PiahbaXR]BnϬ`|ZreH i ,Ҩe32j|"Sͭ6ӵG7JRTYH|+i$lqo Jiax]"Ry(m+/MI2F "6.V{bME"5"-MӇ(eZ,K݅uEj8nZ<9L_L0J)Bہ @8~,=4PوR\@Nsu%rϒܮ-3р􏪂Dʹ@P>3 idC X}kX da0Vs,/ 0xBZ"9`q}: F ALq 5a|M,@dƧF\+NO[Z1E$iȳ>WU"?/zVHm` l o/;>D4Xơ/I,*W#!2/^ 7 ,=I%$A]%YBGW Wa 9r!uXfl7_Ap .a5?'4\fMy ֋V<JCy Ju{ gu >OLDˌ8۴4$ʂ^v%Eb ;ݭ3 k8J[Xö}Z2i%i"? >41:A2`|ٜ(NmN.:Ͻ*+8Dg%$y6j17/{x-BiNs Laɥ#_YYH>1BQ}s eXz]cS{ 'D[$\C=CH9h9R8kq%'^bJMlel07 88=jCu D\41<`&}ߎޠsH,:'7e>0BagһPaZD(maGZu 'qB]UcE{>.HܕXrX)Tuު:eV\)Fg9FZ0>+7`Ea Gi n4.69H OCJBѲ0Np1"u`&Sq$AF:=hV~$2H' TRO{־bE |(CI/H -,tn+~糠'`uGe}VfGxB)k.m5:MX_Pt쌴ZS;8w: u(3'פ1@o8p%[a:)d2?SгѶ|)dNr4RBEqX?Ÿr)gDA4 ʁHle`SL7Iߡr[D_(!ĤBzx)8q)c?2 ތh! WWk8@j]#(QvŞE4 >U=XՒDfH7 ۅRrS3S3m``gckv2JQ0]'LTVqi,)2DXdD>GO0)äػ#!9p9>k uF- % >_YThﯢH EypE6r>W/Ʌ&-繨53Ɩhq&-,$L q: ,K 8 ;hu IϷ01o #w6t)=ӿ ?[ֽCN K䪅>H.ԧ# u  1Q3Z'Oزcx)\M%a!rbkª(RCQu" 7Wn_$X 촀ǭ4wL w.Ic:HZ@ɇ:NQXQCyĐS7I[dD:ZԪ2ĦȒJi>O돲!|"5Joy(mC"$4:ÕdzpGl& 4Hƒ>1Qu:Uc=*=,9->xF~x ˂1}K3.BG?A "5eZX摗,+$2;]:A.XyڸJ NE.3IX?UY>-?Ea Gi / Kae~ ' \1 maꀂ픜bm' vyL|\_Ii-Ś-I,|$,#bQ4wPQ:n;Y8p)!; gzǞ7*ڬ ΅KB"pR Ey0II'l=PYqx&ȣ@50ޘ]H?/1 !5/s"Jf6Qdz+ATz͋YcZ +]8#_ a`2 >Gڡ<+ }C.L. 5L&Ϥ@қ2`l,`rA! ,Y=H̶qDI %>'![g=_rC4I) L,rEy$V|EU)ESdMt\~Iu=Nmʀ%dj֚kHm`e/O-9Isq0" 7+qݲmii`Lq;mm3G6]tgf1ܞY03x_7$G_m~L8r%72fiRAI/61MPWwBfԓ6%@CWC#笁=bY0ݓ6%eBS;Th+Up΃bdy$- `[Q،$oTi$Jj X</S`G;TX XGGz^GJYi)9x6$=݉c( ŘYDt[HN}c+QgmXle3ӂ1}8\U&WQX#㖅u<;{^h7Itz26;X*l0{h}SO ) |taTQY(D SIiOvZFCbʁk+5XMVHAe1^QXQ29B$jAnW"L ^|R.ә$7[Qd#s55NkBK-;JIle@eU i`֋(/Rr|7-1r?/;`) d[n>Ej(ʴ#9hҒ"ݼģ#ei\7m!q7IJ, ;18Ej(HX& 8|س*%M}\j &\5:ax4TCQL 0BS)"pk(JCQe:HwWCNv^vkS5/פ O( IdE ĵB#QJP1:J䡾p%9ad?E :ް8⍻O:[Y,1 E2-,`>ؗ{5cI %uQm9P\we!qg$i$I |1+ k8JYXU#.zhs'kP^ǡ=|tb55p1Y0FIgi`g/tA& 2-̳,R?2k.G ڱcDʃ8@6-Icp?E!Ry4pI1iO& r8R2_IvB,}cu[4ŝt7Q&۷EWҋ="Ic1mY0nv5vZy>1BQXQ:l6]nD [FVƻ!-Re PZ#(Sg 7Ldz!- WQL ߟ;:_g=ȕbvYOIW5+_иDHgXAC/2.0B bYGXz:\tqI 4IY`$ԚgUc$;DBn\|` ŇGDvoJQqȺ#7n$4lPOAq'c@i040 tEcd]pVE~y_Nzd6$-e2 ":dIR( N!Qǂ8^]CEdcdH Ei <5wvR qLugޓFF) nIBb&Iʫ,whj\QXQ:lnE @ EAhO@pn-$Oḩbs RYpAfY-q _?j[O*5H d4,||:GQH#X5ͅvu:9:ī$>g ×c^)IC^"A*Pia<8퍭f K@~uGX獬98QՍe`k%fSdĮ3;#dg_ KRCmto(9ژq` h9x>˽?vϧFozùyID!fxI245H6snAKLgMgZ9W `h,T/|Rf@IP1C~:X-гEv }I{xS`;h]!㳅e|6 W[<՘8Vm& [q&",ld1N[&+pܶCδ;Ne`JNf sg 7^I6J -P :O YῚ%H~{0IՏG+i7h =-DUea_eGYQfM謫ǯEM`xD=k ؀_ Nm`C>K Ɛ 9 N¿Yk %d@m`MgN]drI;8Y }K] *+8FXfF)!+1 e#3Jо8RBt {Zؐ~W>6e(ea"3%; ,A0պqM#n(,ג$Ӆw2}=| QWWm@>ah$_wdexӂqAAIgm|HOkﯢFF) myPC2҂2e_! 5bc"=BBHal,zO ʣZ@t]+EAy@@R}`.)0z)Sie[nIpP3 EynCF,Vޒ ΋?F \mlHrݳ'ttN4 &\$=l2]@X! Ro<XKµl>\/ܑy@!r1Knr`l]-/qg ~|f#/؟_l2IVP~=̀p e`EGwtR@IU\`#/N$~Yk4<˂1}`%߮p}k|4eZX硹m<:6PNμƴ< 45Zʰ`'H`rA*k8H[Xf$;~w7 >%af엚[t>yv'q` wr*rjxS7 ;hm` oBg7r nrCj*Z9ZP["FX}񰔅A|( I(.{hR:⏄;`?N}ֈl!-%`@ܖ}KRYj0{kU,A|>Sۥ`  +kw^?nj$4G0bp΃'L~>rxMvNzʭKWZ5^gcq }pa @<~_ŷmvL~T#Qo8vц{>=-!i po~xڿ>wtį# }%RD ،*N;e& |Ake[~TbP(21XW[ I H,9l%op Ɔfi@P0@8IP  JCQ: >K&Q 'b_2[H!%!JZ8ت1}\@Qu?ĉ[̔A0ʈ ( qDCZ't4.i!J'JA1e|?o9G+ߍL)9xAOf=Xj`' ;&%]o{AB,0FNvHﯢH m s')tѮ$^*:m9{};y= ]$13V0-SPGFؠ+dDJ+D0F: HYX 'ybm ?$I1z܋N))d2BT7 6^-)A uiطE͎/y5I 6*ƇK[Rب| YTr+j;.A&r#N̞&`o2i| LN Aeqe>2-,:=3aIIYQ 3q[`h'wi9hVk1`$ xi Vm@#5-uV 40hnъ8V,ɂqK"Ib1Yȇ(JC J[X硊F J_·K9RGGM3?$9P7JmRK,йo$r ^ ? 2"KtezI?YWXEa Gi <=kHb)yZԗ;'_KGFpQY0u34InPd!HC1g,xN͒{`@?C:Dqv]5* Ɨ*SBܴpq9>_EyqccdJ{bֻ7tx^`%HSvn9OpW)Ai[69 E eTT}9:\R`8GF.a,7} Fh\٥ăd#--l|䤏M d* k8JYXg_n=&I|ort`HNI' tfH.ϧ}c( ŝy)m" s)r_&~,np*%Zb^+m;S\O}~⤦'f{H θ3@  !5-,N:xiYw`{:nw86QYf 4pb֕7AOR62<]Bq ̊'ҝF5sӂ%:Ia[pRX>1BQ㶅eӝKl-!ێʻPDs) ިa;` |!Pۅp]L )3Xfq;Ou;wS5z^yõU 7nn%x6;6y I(9׋;(~;Lzy#|PjܤI dCnFZГ0}+FpC8I>%4V}Q, <4l$zfi$5tq$-@5OjC- 'WU(eaף+O<6f9[`PE}{q5^jQ XX7^?gxEՎ6\N"EGCˇ+b𿟫v#;0vL 1F( kdܲC,%Ŏl<$J QlU'-$VS B5B((maļ*[J# pu``|*[$9= 'C 42JYXl#.V$Dy"2hg6p7EdJ:Wi.ZrD*+8BXBaeo8xH>g ce|cBej2ع?"%N-/vok$֕?ReA>0’K[ c Ey(c#)VIɏ_4god#QE#-$m[PV<yp03>¦}7. ^g)94vn5-,Px"Iy)A󫋍>x?y#t\RWyƥkbnx(=/qо?ԎkV A@*# $>_t;,dB"y*da>' @XW\w9],r%F0B;YfG(RQ:s鉶j^e 5֞Cש#]\;Gj_[fH4o"M*Q,,PINm#$!7E:*v8^щ7׍JTLy/  4`XI#fJJ:+QS*ƅc%Gi4 6Y(q$((itbi)ŨRG"#RKO-/55[0>0%;;ѝQL X֜>ge`o$TvX-#l¯=FgSZ0W H]g ةmp0B;K $9x"7NkqY<< !$i en}J*A\s*6aa4<^,WƓ=Pernt\IЕ18vmlP(eaSTOZ]ˆՅ5k ZEd_-4.GS Y ',~gx Eu$ө6Oi2dJDO |1 EaRyPɖ)ѱv߸ߔ|Ȫ&Vil<8Mm{'QXQV5PVZG)Y_ XČ1o!a?&c 7Ib(?.YQq$ y^.98~f ?`ܘmAѭTrr! 4dYgXotng+,UcQ۫J#hg ǖ%fea }E[\2-,3}a&yxśbt#]56raK. G>1BQ㶅ewv%%'nChz,{lJQ$>C ~3<\b ckYk+Khټ)]߃dtAڂo'L\dSϒ,0a| UpCZl$Ar\#lÏtxFC4`V8@9c r 0 ,3?X<* ut>i:,#iQng OxJ#Ej8J[X桹mA7I3Qq] 8 g8><)ѫA{'l`_Իrv pEڧܤu|!)25Zz`TU@=1F( kdΣ1D[Rr&^06ǤB\)ZJ)0) tRA1etMIt,]+GAÖe,;"An2:`,;{!z7I'A5Z,' iRU'N* k8J[XX,]l#d _EUhrf;4A+8՘6wB懭 DEA7 aXy( %K) ++`` RNδxP>N3 id΃h8YBbzIE[N C9+jQ& t,Xs Hqx fM4ɿt4y&~8&v񆙈l?F&:P6΁}Y\tG~ gg2a<;}>ޘ7ga[KGVdߟ+<^WOe|xx0#hı\EF4-$Vw ].+l`GFMAe*j+JD/YrfVP10CLn4hW= ~Ej8J[XgQNqNJd{8}F4* teI)8qmWFQ2-,D3hɂ^>N,,:ޏÎn2`%v)}lVVP?OA}d%5y j\=1~SąIZH H GI 3cy*IUDՆ[6Dq;:v6[U+46aIưKtxvq%a( -,Dށ=4*%7).+)qa7i`M0So3=[uȇ0F RPi`>lڸO>nTc$mLZL rQ]%ԲDcA*p[^yf7gd^b֕黟p]>5w6ܲł isyaj8>X&؎,sSȢpd|8ΐbmцq|J#2g nU¥4=Ч.cH i ,dN_EaRy(ffff\Q:D2՞}D޴&F^|ce*P `$wg??4|_c`ع$ x[/~쌩 /eAGKI]1njcy#7Z >CFgMZ0>* & L>T2Ea Gi k0 +ɷh'._Q:-,ЕXܫ(j ` Ƕ%]zS ǿ>ܵMLinq_,ߏ .q"EtA(߱48ɍSb[`t1m`Er#;C6%C)Qf Ҏ tYN- [ۧ>1BQ㶅e "EϡԿopF u,w/6klj,FH2:J AxM>1BQL hsgnSd!pDJsˇ+ k8J[X;?ӅRQ: }j=BQ7KP@7ָ,p5:bipٔ0 t.CC×)d3e Dc j+g n@/ɂ9/KKz]t}VP?O?vfϒ/oI/3+ p,瑩KITvќ-4QC1F(Piax_lJ$$k/YG5Y;- $,"* *H75-,eW[-v;z5Ě&YQ^bFm41Z@Xc iu<$aa`Z"LQ㖅uAU|$I\ߠlgɂ~YQlqwLY0Wx=j),z,^C8F(PC#NR#Nz 0 Q9p˩:)"KЯ.R!: }ſr(I+AP9J5gU`%~o<%`.UFd4 ,륅۸*;,ZxIgZ2^AN:s:tJL,i`Z<C( I({Xq߄ěSX6k-\EU:[ꋦX-No'1.q' F 79K@P_đE+K Kz};ymאKӑA3JSXgƈodAxws|t07Z5 V6>f EypqhSrD&ɂja4vdݔ3-9;!-k}O3 k8J[X!nAgK8<_&c<0eA}e|;کN {<&¹HI,B4hǃ\bcHh,T|Y4%73 E&z[['; {qsSK!"d١TcH)hSɭw17z'_2aw3,Ӏ2KF+MEs Ypf:RIn%9Sc}^@ ޾lS9z+EY+E.vac:aK cjt֡S{%y1xQ>0e|w^XOGRWNr NUFH` 7/&-ٙ6vvHxs+P΃۔ljYrr)/.!MŃFY06SIXmʇj(((manS)yĵ A8VLj]c7 $10T4OC#__fPIndmG清7H/c[caJlb币.l!_fJ:&G/3y"hȓ~,LAbE">Es214Hz'j-S s08i8BXfS0oe͉vw$t?H'D3XD~L5K;I:')k8F[Xf 㪅TS%}G`VF"x`xoʂ),{K |FF) (a`E{:?J/3:wpx lzB#cGKbaBq"\j>M&b# 5C\dA_z55-,PԎHjSWT KҨuz/^ZC],vL 1/;K((mao΍[*' Bhȱ6[mQ<-jp,p) idC'u77=n6Bo*1g 6+ {Zo#Ej8n[X4;5B=dK[Ś!K_fFtO(b DGЅ0F RPi`*.Q[TI6q"m;Fc`uW]}cH Gi i  b\)P2"Ym:JIONnk:YAl 毮%/'† BӷsRp6Bܤrm^4 Z\=)(fRdz0~xmv @  L2v]8@-*kQy^8ʱHACF g^@9heBK,*)@rQW.nUU eaE@fi=J}T9PyY&[i>J XbP(ma`cB[[J:?T0|?qN4.> otJT Y0n($g,BÉO ,`p,nzmW}x XލQTjt*D$(V,`c?P) k8J[Xm'^и66DEqm KEb5GIP]Kꓲ)]lCey b#-;خmU#80-$TT( MeќQXQ2wUux$7n& ?p5Y8in \%RBѴp'}cH m S!d 񡩕LƓ M1X12 \XJ8{$oxh_oPrc/ice+!RQP;ؘ0a h ,Iq[ͳ=_ Dj`Y0:+ɆB%}4T(maG^ <$K24ɻt2t*K2(o˂d$+0%yI,y6Ԙ_l)9 D9χ{x1~`7i·gƻ+R-lF- }cH Gi <2mUKzr@D;`qw055pQ[ @ 3HJoB,Mv2cw|/ނO7-{`|%SJ2# Yfxi) Gi w|@I7*}tXu='Ϥ31ё +|G ̂76.d$vOȰf9^b3ΡR{Ҹ<( ƇɀRe4-tU(RCQ:O=` .Vo;x,u1r欀iW ;[fBj(4A%/O=%_֚D.d04$?Nd=]X~Iw" Gbq#e@8)\pV۔TP60πMa#<\|[P*0Zk6I 4[# X6C'yjK}& #$ae!8F8PCʼMr8_-[v;q8 Bb>m[,$>H & <-5,Ȟ%lqV6Y)N`|,%̼( (Ä-5-,Љ-ZJt aؑ 8ޛ4҂qޣK]Bv>4 fj0ʲCY(|nQҥx·b"J]\F7,$;Pc* Ey-Z-Ҩ$0eCH_ųG2im@,!ɅwZhˇ0F0Piaf;Qb)yXצy !%O><g<@·?9:r&ۀ 'r=f~TdM Iw.U$8+5,$+g,$p!}y_tLMYO9ܘ_I6Vsz4C( h $S'Ŕbu]$F I;Nv55R"10F)QDpD{>4cXf=Rԣ6:&I'?\0xO.Xq#)tU}HV*LX+䧥 1c,,4H8BߡQS=(,O ޯB Nt҂/Pt 8duWS9zv]F7K.IG[IdFH\UmRC [H|ή$;s*ˇ,+ id΃OŧVe`i\~7,qW{8P]~)b5\7!btfVp|į"m$ơVJ!Z@_K'txDۤSY0Wx+ % ҧw2ATY9^/I$xbP 22Gɟ1InTVcQ};)i5li)e`05] f i`huJ`Spb~+nƇ`iZnJ%pCe(2eAqJsx0@uYL/Ygw^g҂p3[$wC[EaŤ(' <)3hh;kIvã9ZRcéq<5ko L! ym@#1(k8HXg`GHJ'W<2FYSe>TW8TsͧEi0ʴCN)S6m'x#rkO fVI|cH Gi tIpُB~##@>_Fy$ϖ$x=$~IYM]cFF- ,t}t5 LANjn2iõ1O2QZÍ-ظȂE> ԃSy:^Qc[ zGyjyWǚA佴' XI`bvA*kdBy}03ISB莌|ᣂy◙BCJ0:!- (s8=dnq` h,t y=ۿ/V~yWxY|*ṯ&/( -,eږͿw)IEaTFjd,+x;Kf(`*-"bIn8?}c( ŝy(kK2;' i7 ` t~j#4I)W)[<|_,LC$^:Az/UU/[u L%A#hmI@<7cwJ@疿I~EèS9ql.l&gip4! tRån RYnyMAڒ ]=\o`AXs^OÉ$Mi`DEsE×߉,{ʳt)*AA~'~grC[0nͶ,%#Ej(ʴCt[Uۖ8{?yh֏q<\5ۂ1} `AN(RCQe:~z]lslVÁ+w/ύ5}iqS^Jfa.\y?WqbK3Oݔ7%!ݭz^@ϋl‘v]N ,وu^7I35ld&er/D3Y>lPC̲7Mu%an^;EO1ǫ4xA\Z$gC}"5eZX_Eyp>%j܈n;/[oAo^HfNۅ0F RPDXH=_I؍8nJV(8ǺA]iDl@X.՗Ʀ0-Qa@2 Y"Xd.<'JIYiM`$7?Y>UVp#sQu|9N՘R iqYt'TJ |Ia{ļ#/.K6e r@*Tp60AI73efUJ-#Ү]i$n/Ĵ`L$Ȧ)SAe&}#Hr_'.] ‘p};4:ʢʂ.bߒVP85-,P)iǥf۩MuKS/qU &jJ8`grq4!QYTG AC t0q%V{X6Nk1Q㶅uqoƔ&koV2 :㱲`P&% ia#Cb E2-,>/l&Y>M~2ƒ߷aX#U7f MwJBe_dEa Gi RYG?ee;gKI4$mr7p_|\}qWΛͦe;ԦPdia]_熋Ə;/1&ֺq&~ULq:0F϶Ol6k(@W g7,M`.Yti5e\Iu\?KB# _ tvAZ/lɈ$ixODK62L KR>F(U0#ʡ3Ix;`։aCy >5Z1v72!N`50F?}!gɮ.IAayu&~Wzɂuęx\GissaR~C^gi!'!m >l +PJq}H4VRč%axέXۀ|e:, 36$m56@Ғ0m dlNH|cSzofcI#5zEhK콅5Vx+%C^tB% /,ҽt,<[Hciʦ%"u/+߬dOW,Pf gJ <=%(+UsOun>t2b1(vN \Q» %Q>- z"5KZ1z-/xfZTw8ox$G1Sn-)hm`Q5BNNFn }`%Q} ۚHF٤_s m:)"C27p1NXA>sbׅ엖,ؑah6-%:1Iy ]pJu߿ k2X7^b;)^r;d[ag+Zye5ꁷcHc <&JKT8:0QԖ d s{YH'U%+la}$)/a/eo` .'(ca:%o2 d x3S&0oc=P옽Ɔ 呋0XFl7[0n|}$-`V4eYx `cd %+٭#U} x'S٣H\8ޔ.dZ# ɂ1IK<qA֐4cJ2[e/~F%xB`nL x- ghm  k0S9wOm;֮I#&'ā+tIE4p(G;RrX yt;9zOÅ9bnqb#n5bn( ( ?_f Ӡ%+sfF/zv,Sd*`Dzx|0>LTs4^:՜;SxRK#*vI4R ci`Kw_-?͡]Eji<"m$:$.̓5:ϨsQsN㗽i҈4&fen1\q,> )Dy0Hc"hil#N lAs`Ēcצ%XhzX{a3KdmOFٙߗ%8mw|% *^gpOk( Ym!MS_4Xv`LدG( 8I <=^0; "GG]2'~k?7QTRdt|`s{Ǔў[k 9bDJ"ۿl.y^:n<4Ew$C2/YAq$n}'- *>#cRqVҲ[BE]2K;iZY9߯eZxC+k$-ZC)wGl2 $>p23 h i,<0FRH] Bdeh$r3rP_2kldċb%1 l,[pى԰4\ߜD/Ya0k9o_K6wH _gvxAgY.PW0 axbg B |FA[PŋN˒8N#e q'9u 5a}\y zs5d/YB2`>/V`#J>+4@Z/ {@^ ڷޚ}IdlImI q`6 7ExgI,3͡_Ejix9fKVnO'Ju -ꉈ6z㡓Dw@S^No'a'i Qw"Rێ,A(8yYŠ?$;/5V̎b HYm}St=N iGYxǘQ'kcl $ 5`R]A, wLinɸH<!+Ax,FhH I ut$^yUWNj,JN JEh* kKYEI|Jàg 47[ ˟󕷆 skpk%l." MĒlhC">C `#5ةJm,t!9:)'/a/e9{ƒqD(4|ZD j]-${cIpk+ih)HtRP0ЭтK5'\14[nXwD@ r쿒xN]E%Lyڪ VCaeHܓ1>0g Vxhi %8t]\<+3RVSE*qz zN>Km cӤOɭ!4|v=V㾤뿯޾?| I?:5 /#x_?;K_~[ﯿ' endstream endobj 570 0 obj << /Filter /FlateDecode /Length 1074 >> stream xVMs6WVpF9$CziSk&3)ڢcQI e@b[厼[D3o!, cKD@ie_evU.Uo?e7 8$i._ߥ]酱r;/.l>bc-9[o2zW)t^@BT>!?2xƅTis`ϡ_Ť2b4ř7isa>W_&_qƕ2,W8/6FѺ߆DH*z]roaQ(#qͰx2_Z<*^iEe]6еZ+e? SE$^%H.Rt0Wf L:cfL۞<'y`X )spB1q#p 7UJ@TCʀB'm1/hT"7U`GꙆ|g %MT"j״*M]8Mž1w3̻8Q{pǗjէyd| :Qäӧ9|v\h(b*%I2v1=pERអ~endstream endobj 571 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 686 >> stream x}]HSq휦YBKt)S%~aLQW)Snva62܎>I3K´0+>.,XZPxa,h]}aL_n4fg3'KO x2%v *\ !wbwxD sz벵X21 YYyd1Ml;Ynama4:m%S dYVcXZ+YM)W;DwBSvO;h\drxD @D?RP|@!h(*Al%CA%" 2Gωb=I`p aB֖4x1=KA x "9$X@g|at%.`ѥ5 ߀f 8(\9 }FljyGu. 6PLur=Œ*`B6P~ #G[]E qy4|&rSt\׉k>FԢ}s' PPBq aףV(Ƅ/aQ߄weaz*?XrOgG`4yܷ?%HMb+0TwM넜 ;bíḍ8inP",endstream endobj 572 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 495 >> stream xcd`ab`dddw441H3a!ܝVY~'٨ڙ|<<,+D }/=C19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUSB9)槤%d$2000q303v1032>snʂk3 i&O=yBÄ?ϔ4uf{qmK[kwdÔi}ݓfnXCw!㖫wcQA߲%~+V;nE'[C'tttWFwwvst\wt߹|Q&We jlgא៻VuuۦuV.璉<< }Zendstream endobj 573 0 obj << /Filter /FlateDecode /Length 1275 >> stream xWMo6W9Q@^ 4 PP6AD[N$9)ɦv%A#3$߼7?!J?*yIO7Q]$ >q+bOh뽭Cy |;1?&(X)aay? _A"C(*C\k¤B*o*J-v-^:߮,%x.KE}6P3{fmヂ|!Y ~UnmzXQ&wh^iRuB08pyJ%"KƕF4hӤū0GJ.eӽ)_ں?㗶mY0f [;`;}JS0"جBa OGUBC:C'l.AS>ʆk(ˈԇl\=009rjkH0q^O`0<غ'6aaB tJC 2}"o":VKMd]ƛ1 \wZIA'v>5)K>BeBw[gy{s}*xFfa9dF!lSlXPӬUmjWlTM4 [dwʜ%(1Ԭg/WGqtB8}]i 1y rNj\DcY:#=% b A}$$02cH }|tOc EO2~[>4eP9).0<fYӔbG$X9z u tTO" S#6<(J}Y.(E7m_nĨdĨ%@=[Uf^YTCW귞;g/{ۓB,CwkAB &J(i#Z;}Q%q]>2DJ;b=9@1[03~e\} W{2yq͈o .>h nl>]@' ۬*[䁚=%7~ydn]i -m3stvZv֬If:- bp}Se)uYd$v7}W~"|ZF֍MsLK'VwaP⹨_ڇr{R K@jThCO4<1O"/ӄrs{\cendstream endobj 574 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6461 >> stream xY tURU mTtFGED!==wN=YBXD A *(8踍:3:3j̼y:9']u  Z21&S8 3*I3ΜqJe`H.2q]w  a؀<[Y^%mw~M5Upð'YlsjjEb N~a6/RuɶҲ'ƍW?zSM_~tccbX6[=-~-2%l96[==Ğ`DZ yl.6{-6-1vbXvFa46 ݎMbwbPh0;3')rr,c#'\@An[9x`fHѐwr̽3_YP)w+BE#๑N)(fԗ{.ۀ߶T:3+MHJ-eF\Pr[݅@0F v'>Fs7g@#`$#Ђ*6JQnU ⪀HFiK3Eg,{MaK1TpʸaP#&_0>g+y֛}饽Ȝ~ |2/M CM:F$hG帠UY&XHdL`p~vߙO(ޭwmIN)ĵGpiyr{mۖf"))!oGk_Ci*^Q\'U lkj6x|ҩQR9|xwTcWKPq}J`"ք%m~啻kH]B̑%3|ecO6 -yBnl#@C?~Bg ơozԓ e/8sqSh#>ͽCk[Kg|霽3 22 8Pt)7@zzleb#^rY ǃ[vvv  @:1>JR1RWg^x:lGE. j|uJ 6{į` nURڸfL6?o ֑m$ 0@pB5D)iqB/p`<8@sЪu&iN?(Fq9j4\ OȂJ Fϧh#YfFq;"DJȤj̀6@'LV꒱hh@˰2}%s kqQh\W B'$aJ2@^!Ze#M!xvsR`%YhKG,K4]&ZͲAU96g!,F_#pa{khAP C0q:Iax{w[Ѵ+npΆ$|(~#Q8Uag!@~g3{>nX;VEGa#?%R4~ rX͘J3U x )+JO:kȲx>(Œ]Ai8Ɂcso2 j Äq+Ν"'e.VTQzbE](X҅v*wɤr}Y)'>s6C9@ {eyh%b]Vc<u7$>)&Su j.~e>ʭǁ*V-·k D6TMMƥ:%ÈJ29_Zup 3tR˥KzOv !_"DJ"ݎswv<BD5jT%nц1K6lX15C=hY>Mm~-L A2)),UBq5M./wg p$@ C{}͹J\&g%ϞXQpjq_=۵Ep؂a@6ј6d @<1CQŒjz8IT*~g|H"XE8-:aowLpZ#MY_0D Z ,(.mHă٧ꋨ8Mxp8ˁTϛC)\!$r40ŖnUnOg,NRߦ1y=eo8{:{T)QجnO"W mږaemű%ުlmJx[ ζKmA_1&\B2DЋ+#6iL&-8&?sZ/] E8HQyN"5\7l #;Ug?n"Qֲ))̻r\}繁l|UZFHPxؗ@]LD_M=jVLHVr?ZG'.^:]XmU 6ZgBV=Pu!u6ڕUZPƄ5IT޳ 髬QBGvr|qqWUҍ:c:j%x3`,.fq*QћwdZ7(x۾+Xɵ0l/vj@) \+׸BM(L;R!<7o}%;V=y2%2[XVCIJ7!MsN*>&mo ?`ߺBVgג7٨~@REgT\tY0m \%#*UBÝx%UװPYR/a=.JMnd"J돼gdJ,HCKVyܪcWuatJB'" . `߼sWt !8U RYg"ƾUyB[׬U''N'L~ F{NQ'J(d >iv-S^ ^&9)=9,LhasU֦O>=vvnGq k[J*d1VҊkR8I_5.uH '&:y6H5(:q#!ݷ.02EJ(4,>ڵq+7,{i7 7OB<}jL3|`7aeL>CqV(= {ZSA7&/v8 ւr_LC4l-SmnJ%hGLc5lldOݧrmKV> }se /:E6]S",vG,JDC]2WJ "+)o%GFԩd a2Rc2vދ2Jj,b$d%[6i*{Qm4,0nϔ=̝;"Mʚ۟Wȩ'{{r]"}sܐ)WO*(8K64n@%L]M<}ťtyuEMyuJSdUP~JDN"iVI*zo̐]?+}<88M4P2 x_b_,tEyql(X+y|Uӟ}xR!2 <?rLL USp(%Sr-L-lE2~7g%@ɢCݔ ?,;ȃgw҂EX^%_iDpf7 fVӵٌ&t?}eL(1X !5Ӿ~F_Ѧ(!rl7Jpl gf,#ń`Y(՚vñtqoc?K quե.8Se B5q)76T2YH5b&#1/ b$Oo4<楑 Ģ K/ݝ.wmZ#J|q5ˬ, <ʄIh=o33mp *T`#YR rA'sW߶@r9Xb}P"l7]Tx,.+Re& In Ƴ)!?L:Sdu~g 84Wx4OPu~Azo$Dt0 6 NRc);l 'Ayܾ~T2JJ(qkk\Yh=#UW6#\:vq¢9ɆUq'rYN rx<%YQyM V=*Tj"i<BN_ 7y- iX#^S-V6 URTF'@}zbţt=/ګ*|tr#jڇ\3ɺۘޜ|rȠ. 8_r9"4ʳ. TZj hK)>dh& M8B @R|]p~bb:%xc7_hW($~a ZFmZe @ .UL&X^P{gk HnP~B X[ގPAvMXGw;U>il9 ePvNۿߑR=/ K?s2MVdbSD 8 Ro-4n*^eX @ULj9A|cuFNDnziʅm~CUmLeQ!E _kQM92*5 5^Ankrui{Ӻeu.A)Bi֪%q}o :Nƒ hs]@W ׺> stream xUK6WV8|,(HE4dYjWwHIwh)r曙o>O@1pA]%"<sM;>'IbfA.O_BsUV]f7Zj`I:΅җF56%WBj~iVMa`b&͗,fRfs42JM+%JУ[Ve>eyN4oS'oԣ)Z\TOOni&2M*V3K #KJ Z>q"F`OK(w0O +ֻ+>P /F{tVEy[uZwm/quǯ%"j>߼CiJ 7L'K1=A_n"cr؞ |8P1mt[SYk*iWO˼,c_d[¸e9&`CS&2?Ks2z T?o؀[ͳ S.`P->oooNYLJژcT@y*ow3՝*mϡ8=dJZ6!oCͩ?/uYi=-`åKwQ*]ʓx/QhԡK˦K(*AǦ늭OMrM]C}z)E8FG}wx/Ba)A;o/yQv 9UM_wy|P[O.šN{< gcxO~/g㞕D{+͗R\8$í(]:f~J QE{ endstream endobj 576 0 obj << /Filter /FlateDecode /Length 3165 >> stream xK\5Ψy?$R@b? wE޷oŖ2])?Kaͱwe߾g_>Я}ZT9:=?>?]vStFk^5.mr/\ZqM5>6tXCLJMXCiq=1hYp5\+^oSC?KTe`2 '޾Eᵶ㜬Six}y{"َ|`Lϩq/B%ܻ}Mc.S!瘫o?DXA)3D!5 rwxQDOQgd?־uFzkOQgd?jα+nTJaُv]bgnTDǖG* *$PV(OXg:cG<DZqx8w-T !\̟*yQ6.~G q'q8hgdUDF`j+ t)9+e ~|Rs|Wp q3}돆0yRYw ;oT/Tٛǯ4^ݾ/4o͒kbcəkĘBǰ7&ߣΏ1oP$V@!^mL]ʨk ̌>ӧm,(@r@ɱvC '19^;d0;}V6;b&FwD3N"'3C U%xAQAУ!΍3cleiBj#//tQxFp#T χ`H4YԘT΄/574rnhLTǁ[#pC1)>6 ʊ/Hg *{Tu"$aCʐ +x>9ÕNE$4GS!y-h+(NBы#ILpVRQjEk)9̋9]4RTRyn3E; r+آc@EJ!:J]x$X Ի{~tu )6Gqvc;KQNۦbgHj3Ϋȍt+)Tڕ S*6f_ZM^n i[kKJxdZՅ+AW jHjx`g-H]jP웒Lwe9Yo:bbCsDt/ٍ F}P]Sj",LT2׌)ŤZo-y0#WRBe #Q:76*$ kHGg[.N![jXJɖR0Mwg2ˏ^–^-Uԣ<2TI.a\BNmQKVMq> X?Iኊ)] 8WoקLrIakIG7ώ3w~ڿ=ۖ@EcXmPmKR5{z#f*5^ϰEt+.$+[2>gg_i m:ד y :t&8boK;z= OS.IqG%TF؞4&*gLy=tS˭;j6GUGo>ĝU>W r*~~ 7"@w˗ 2VzF-E׳oWo_)C9|u?_K}~MćxYOx?PTX\1nB*/1`aendstream endobj 577 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2065 >> stream xUyPWn'UgF~]}igfo3w<%%7-1YkƐ}Y`"7Yq&KJr9#,1ِ0kF(i~߷EQfKJZPzFCnlX\.QoZ%ϙGQ)N)OjDRZj+Z@Q)/j- j<5)5Xj*b O?M ȃd42?)W|8xf߲΋[ Y*BVi(Aer`' vDeC d5_l6p{@%, A1f@%􃒮'xPʡT$bbLAS VAEX)~czu|ǯo8gªmVKFY&kMlcXs׈EA6o PXO NR gϊѭ3z ]3ǃo(n@ٿ7U2xpş#t v=2Y}Ѐen ,.r"Z+C B~-- ,N.yIs ʍ(E%o3Q/>^< :r#NJ78>d+@X舭i{*xL_sx?ػ諆n~'A6,bB` ̆!ڊk51gCt۾Iyk@i*.gܣ:-koaosfIcʷBb(}bVū3媫NTU䓛ef3̳L(X6h oY5bJ`#>@c>!=Ԩ~ v{z:ҔMs c0*άאfQ,,j۷vm?*DypJPjCueֺS5'.~CѠ XJNBX4,z{06HuՂmfB:]|wUsdd#$/$xT"Yt\΃ YnťfǢPd9,@?[[*l*{ɦy|eum5IIJPi7wEmGJż ]ř_#C=ij{h%$I (F W!4^kbWN079n@ArkR.>rHdBr}R ~פws~x3~|lj<Ҷ<+jq~$c*PGxqJ퍧ȖM}՝;qzM6uۓ.<,T s5G~ I$*"?}n@|O7<<1) KK؊;>@ĵ.ÃXzC~*m{~L \TIaRHH/5[PdLn1fϖTD3 72'ɷtgZ/ݟ cZ)*~sM%il!]^Bbܣ_`L#&epYJJ)`h)B0#ybFH YǮe8FUpB@[OƂU7ө+k錗]ēfe0ȍ+<1&>ka?C>{}{湵 ;Oݑe-x{>` Q9&mw9-5Ti%p[\T1endstream endobj 578 0 obj << /Filter /FlateDecode /Length 1008 >> stream xUr6+0`+x?:tN6'mbuꂖh6H9oedϴsϹ% Qtumm? - q&x%_EoTn!9ZWơj]J$xXuu~[zqh Zj Yp q - _o< +z^՛YJ,-ly}-ZkC 5Gu\Wcu¾&+ԭ*uBy:sN14h8shC|g 0Ԕ$Bj~4IӝiFsJtLXh.)iAcq 3j'I}̄fi9@X]ʘi}ہpO ԙ;s/nAD9kL80Q{(4psC{x4u!d N Gh=ExSIa)es?VRW)b25N0+| Y7uy?1U4GTȓmIMoW$߻u <ɾY5!«.):gIu ~VF& 󓉫>|;dr6(?zi/ld?duH+_W 4vДi~ '_Uz-巕hǛXݡGy3@8k/N7I\gA"XppݐƟVp9 XI9z>U#7 D ߀a7>||\4q1ާqdoO^! `Vd#(C= 첲n62[Ce$gq">SO,-hY!ӋfVĵ݂:ɪmDL۶NJJ9'"oͨMU-O$<%Rc̨N|F> stream xMvq6wAz~Dy5>}ЮŏYC#K?7*ק+zZ__xM:~gc~WЧ#ZY}v86g0)dgl1n4˚KKtJʌy̟˯r~j5co_mTZ:++Z_Ͽ!529鐡?śY5Ѽ9zA(sM/*)/?r-ZַǏ so{Y*kVUpU:l~5aO3d ̌ǖ?gs=A6?bQ?D~QOgJ3G#^ֿ%FoU~Wۇ6XKE^=r*6:#%: fjAln Rp8-d3]ݜ%KGzؠhp]l8]?rhaD_#aƞ%ٱ7GIz;8ν9LMEA8HN-V 났9t)ӆeY2y 5Yc})@R0ǫ<stVO !k1A[k)kT2rk7]{(d}rl\/0֌$Y2;O}I jy)3$!t"YLZQ{D^SхMQYmP+[أMHktB$CwnT *zT|}J'5=a;iV[o@i涖WqG-GQa VET6T}GXѩYۖu5J~5i`r\߿tZ'Uo}Z Qe:[f{TPOal%阻ՁLGlvcqqcbY7H{1u VCZ=P {J%Sۭ̞UT z^z>/M?{.LZ%b9Iwq[$RG0iUu^W"=Fl=DB7n[ct98i'9a.RNr*fxph-M_ 鲈ROxff1;5ċG1#yY'mٳMD<.-gуwKTN9IQy9N~j[3`1DdMϜd& Y08scکny\BNo3> 0x] @ބCy - Y haKs-; lBKu#Wl";Z11⋓jy G l{rQ]-4;+XrhW-aMV؂\L\[S聠ObB'슅DwK|` sAsJYgjy%-]"&ؼt9 8袚||W(Vi7Gvj] —?"n6F f^e?SV9NYesŇ0edݍxhfDx.I+9IG]-QP޻0Zr ;G2ycl5j8VV*m_YYxaf1٭_xap ,fأFtV:|a*X \m*=ΦB$ۡ]u2X_ZfiZka#VFaml {TPR3I+T7^[U2F:D{Uu'Gʣ 9:0{V67&8T=|abBV[K;YQG)dz6fԙxaϷUu Tƍ=P~ݘ*1k׳|냶 LAt={йmc].w*qZN|fc/Q%q[]أ^@Q07&yahJ¤URkCPGZLM4ސY0o VY/٨7&t |GR61lw${ܥ* ˧FVGJ\Z%ԨKݨ$ŶQ"(E$_(@ɿզ6$^7]!қ~Co>//8rd4Í .pgq#v NqZZj:}u}ߍHfQ؋.)5eؾg:9,cC0, C !C(/]GOw%  Аf)R.BR>EN X@Sg8N1-N/"T>02eҌi rq\cB4,4aB(vi,Af<$-"_U9]en37N[ahu Q>篶y%]I;n'mH 쾨&nf=D@hdW/w\̞^³{ٻ0αd%V:TMس @ؚ WQV"vk\OT9y\p i#B9(أ`/ 5"qexVram01kbÍ 샺T齿G=!0lI+=i鹱_u:!w^ WQ~QzXG&̻_|罀QSG .uo>n[ͮk7;^*z |o¨/¤UF;ɯأ=ʯJ@-׍I"7tVF'(k._[RT$1]f-!oﺞ_0Ώ'qE_Z 7=ȟ\7EAբN@z!0ipH)r=䏤H0 [LYϸ%lԧVIuD~\>/LZ)͇yH Vu1 Jܙ}ݘ@biQ?7V/dΐv*V8x;/Q׉)7 {~U ǃÁ<s6Wp{aC7&>z|/LZU,X3iְ֥K&_|KHAHdNdiVRpj#4Q&Fxy)%uhfi%LMr˯ < _qMo8&3WgJڨPEwB |%Bjr&4C?Ro*._^5[vU>m7vdڃ+o]9GqD;)qq@v97pT'qH|RPl2(2LY˯J⺙IM(\s5PRX MIƱW=Rw޾p6ɬՉE-5TeٴB .8*JU^9o I}ȓ}Izu}!ϵ^K67^LsfvpA۫RE{2M ^5R Ivʡrepw"kZP c W\HO޲i=셂)O ̌ȉẆxNtQVw 2Ig=M᜚a|>@fΆ& e5F{bFmP&jJ1$яL 4K"ϩYu/vSC ".L` (PLńw3ϚW[ή3pyqbp Z^v彷l4 r@,ȵeHhwA~.Ö&W$bd;:KM|6Ul%=s{xLٵ;fN\z!3Cfl>Sx$|XƉ|@DD~.n?00;4v5Y; `M> pDI0; >2zP- )w/{&^r=0&JHČRAtD sd:QtY AJO.=nӬIXA;Ml5[B(,v/*\C3=huvV9/m A9{t) } :IQFS1$m45M{tIB@ޘR ~ =:b̲~cgQspK x *|sV#dJ1i5QlvmI=S)z{2H%q1i%z~N 8WLZu9?:Cސz}2t ){ʍI+jH.QSg[j7T{t._xaϷգxETAvL5ČAmYI.I!ưomպ^ ф2r!cɸdG-_`=|cZ̢NOƤ0!xch-Em$nLZU=&azI+7p~[iJhn7&&c=i}~0iENoأZ"dKlYܘ*\oX7VrNmr1!_{$B4d$i(͖ٙxيxU!ݙѿ&Nuځ BaiFU-'AX3X6M jTJWn$Y[G`yy;\V`ӰyZYk5lӪFHYH|9Y6Tnc^찴+ Q#ҮU{XPGgf" ?iV<0>`eTai RH sU8s/%!g 2_@B>䎍FKș9IH]& -ۗmmQ{e)wC%Oe@c@DI}pnU41lwoB)ZT`H/S`nW|6&]0eg?6&7iUB֠ `($o FVA*|hv#!^,7gƌ9Ѻ1r"®}}äӶ!uab2Mt_y&7FF:&h[Bndrzc~cDٲLGU[9 {!g_ 3ũէ2YBod \ ,XO`3USMhTxc&KY vzTw M %t' t ёy&[H]W `hHCb@ƩT\L/F64Lݝ24iAMqG hKEa NWYDܡj`Laf.^65uBnaFwH'Dۙ;̾2/ݺL[0/@-R?fj gB"}q۽^ald4?%ʑBq _@ףG|R!o 7R⢌BŇdeG&1 7Lf2DPd!c8'@;XfztZ=H.\3sO.EƀYF5fwQ7OdgɳEqɯ=IOABo˺J־t&0dv?6QmY]=HEq򰀫4J+勐A͚LLu%RKHc-!#f,n.k%ڙ-!9_Kt7 Ү4XQ~tv8y"kpQ 7dS}=g%*;'\m)lw} DU5YM @o"h:@[Ƃ7Z rj=a@Yi]a"@9vہ"/qGܡ!qRWM-BDh"i!_$|-^=7 a\WހX%.E6N|Ι56Dw >Iyx0zsI;/swѤ^WiUuҝ&5N ̎55,%Ņ4Ij s'ՠ9a16Y Aw1{3ϖr3&WL S=N@z;s.Fyi><ďHX ;$n3Oa)/\)reع)%T _ճm+9#7( =eGjA$60HBI9QuY̻IH_^Mo~: t1_+Vp_EzTV/ kלn5uņVE'Us[N~.\喷Nw̹W5rIPS΃kVrNr,3Q-,YVnXsmasU()ɷ]gc7$|%Q}L l0nwU$3rj@f0u!bFr8gHXrj(gZM;/i#Ғ4JZܣHG_<GF/2ڎ[[ `$(u%PiLMC-ODӻ ,DJ}i\Fa=z Ðv&أ娊xhIISD1oLZMM%wycBdѝV#9 ۹|c "BxIZ[1ip1BdG'5VeNAm:ZR$¾f{CָXy#I䤏B0MmpCnX4/LZH6 cuF٭*"A&D/|CQR raՒQGc>k<(ͯoأ`u 6’ ]Q&&N^I+ecS6|[Aڦ0EvUe\У\!yc0Ʈ?Kžo=V\*QMh,h**}ahUΨ}}bǞucJ ٩vd0i%f00 q ¬$}<5 em /QRΦ?}oIܽ{`bM6 s4:.cnљWY8kG>F⺊MWh{]w _BHqwi{oNq-$JL뒴@T :V6¤Uf"~ƤU~S\B^*bj$1-7;IJwnmpBGyuarEss 2C&If;qD{LZ~Dؑ'/DU c3=GDv:#wLpd\N(53wiN ~ }7rd7z=|H(d59sG!_W'HVưsG@6MVr3OkUJx,ي Etb:9F_a-l\ϒAJ*g1pDl!nT[r_Nþ]͙j1X9tV_`YE[wGTjaU{PwFq5w\VD uw1)~P]6ƒ@xdh(^T b2 b""tA3F/y[fCRS&$Q0=QfJLQl]k@\Yv2]tD˃DOX&whD$c4[h?8F%bL1I9&=̦b|fkkG:;шhyzĭ<6ސ6>{9"nN"K$_+0GW\ޛ(\1kg;R{$>ל ($1`q0:_0ZM^esWo0̹K=I|h4[\R#EÔAGC-e+%R~-cTDѤԥ"mA6%,UlNW{ҳ (qP :D^ࣼ[GY-~-&<ĵu<92b[wDHKz7MJrꦾL@>鵫Cz-TİpCvEWE$[&DAK1e!Fpqig xzUTN(b:J؁TMIԂ@8mv"ef ۄ(nO$]V)6~"%&'(UXvʚ ~jJ7&5Sy$&Z٧K狼vLN $؃'EftcTG\n0X ʢs ^dH8s-}ާT@L}^5:5T^!0*O+H:IGAWi^ rRэIzecI+$( fNm|K͆F1'An/LFJ-l..=l!,/qCV8i 05Ѓ$=`b1KN=q -2w&/b,oyCҦh#_߰GxYgI Isw`*u׽ =jd9!i)n^=zĐcP{֍Yg5@^K"+DJyauO<t_(z'8*cA;GTYlNm0"<MXEB/ JWR%dKFmх4UyajA#ucҪSP//NQ7IJ{&sm,dsUԁ=թz V$[7zd|}äUS|]0fWxal%]9|# 7U/M37*2h^ U&R5ẏ*w.U*vEOՈR>t)%YO=_}DzM|Z~2i|4kfv ADv1o)X4`is ů=ae&2DfHjRB9Rѭpk{biƩ\J;d8LQi3 dGXr4N[MP*-h,inLu 1Be#l^ (׳#edQg*2'hrzšTS Eb%Z͢UO5;%BhA؞4[?im!VNPG@k.PK3ڟ;,֖s@'Nڳ^3@k Y"S~zu{YDNL:7#c&΁I_UGaAU+/\X/$21K(nc*g%7-b뜳˰M$>>rU9 `w>GU-sF5IckV\Hʍ(RI$A9OϬuU^72GݸFL"$G^(M=_ܹ"/MU03 S&?b7?QvuO!kU?:q9 Í} ɦ`bڷLd(N/3tDI  لu$ \/-Nܘb>WjPuӫ7AQ rw"nB_&H1 HcM\',<==TwY&zf΁2=^NBfy f60udRU·ΕeJ H*rU-/ڣ|CNcŵ*!ڴM=vjM] VOcr=1֡`M̬PMM-hkmhDg`sq9= tcJk(zaBDtTGiHǸxcl U{alUT27U|cA9V]RDo>TQSgy_أ5E7&sB;5R,A.YQ/{`bdh0nk5Ykվ;8\̅I+{U hbhkoQEp_عI+.y/6\:0^a)ڦ?dYCޯoVv/LZw =V3_# α\سX[cGɚ|dLK"s+B3VV|N[M̓j$I/2 iwe4F'$mړ+ ߐы(tjj+ʟ0ieDOž9K487V:zցI+-~a&{_أ:=-}g/Q5_0`g57&/saZ z{%M $ Fz5 ffҁmd~.Mj\m4dNEJ=i(#;2Ku>2Fj60RrEab3 qv IrجoF6P 3#6Dڌr4@Z`|d`(1m.֋bx#%K8Y΃0n ǝnNA0!KPGWFN$䧑9s3alr=tAJ>+N|FBTN3&U&HSbǦa@z#&lUq 9tzkVe5և@Q (77bru^ZJ+4p1/RsE9Iѡ.;x62d`.VP†jXܗZY9&.H9vVr+:*Ѹ8J9M(N@)YdfpAè8*#$`!T/9Z\WXEFhie$,lXYfPW$YclӱJ΋2|1X\IJU0:Ǻ0l9CƂ);yL ;`c5T$-|r$(`&F !HH&uCyViջkwp{6opu<%Z<I'xP@,<(wCf@j{ʱe -9ʹrg %AFT{w\2{"Ãl˨Qʛ/,k$[hAj % T= 0r&2tUxE2_Ejl%"F0b$IT8i9Dñ6E,CѫMʢ D,:G (NY; "rTQW)};ePNqsDZ%q0 PT#W=QwyF3b$fF1 M<#)skN 6yq&X"5EЯ_[(TAd+T.׈-S ]Β܊ k?Vm5wd5b{-Xqs;T5=@R.b4 RhpA0?Pkۇe{ZBrh1I dԃbZcD< (c9L11rDzF^@ArA 'p0G?IU.?2.7؜NrXNN$@s,Aap\yGvA?|$8Ň8pI^Py Ƶy|`Em Ut F7.@ԩ )G<%2\yS$}3g$b|;I. ؘO :dD/gs|ZmZ?1SMpq{M;`gE3TΉYXBUN} wɀ)n>ؕ)`fb <ٻݨ aLԵR0d.EƥSJ2ZCKԭ-*qq˥AYyEeK]윟SK݇^] `s &{N7h۔Ho@^n1[q /H,JN@W9-yT ,cB)8i&EMGzsnFZM!ZP)rF+ꨉZ<5Tw8G 1(e1iUw"oQOIZX I!`,X.HLs9!.{7ƷC;0i`B8cJhz"=rw~]87b7(OLbeG6oGNʻGdfg<E,t> |JjZ7RT-VQQF'6B=tتʻцP2,{ VЦJGʔy~=L `c~CFf̹^*{ۚ/:{m_oOpO:quX{T7vtLm049)ŕf7:GEΗ=g*Vݍ=ޯ ɫx,1 6Ʒ{ {4St~=}Y,I+^wnQSH" VJw0mŝV|J=أQB)Ս=oq'q2>^أ# M9Gg=&;e{?^"̔7U%mF{c\UB8ZIJG5Һ/s(gH̖oA@Ι^jn=7&4=8Y7&:X$Z]Ryyaj)ЪEaZ =Bl#&ƤC6"o=JVxv67&Ѕ6RҍI+}P:]O9->29yşi=YW #4Mm?|9dJҟh%)=#g+n<ȟwE̛3|y+IZ /Xd{IE&)&\Ywުa GqfZf+kտ9!=D?_~Qzm?Grz 4`4imhip5/8Iwy0"9ψ$~APvkz\3o?-*A.N,g 'Ku#OZ!3]N^CP^>X@ %pgC5~K=fV9.Kd.2,ɀ!K5dyiI8)D 0 w-Wu Mz>Z[ecl^㋄+!_!Yg8*}%sz  \r&ۣYZܶ3miH,wޭt0X^l 3픭 hmKZE`Es9C}lx,lpZk_ܔb ;Lo?[V+NtnwkZ`ńpcϥ(Ŧ5!BJnX6K +'ӫXגV8^s]oNaq$)fwIK"Aydp7EF$>^ 9΃̔Z<`E8(74}TGg܇\mVLE봟NV ӵjvhMPڒϫ3EWVVDH>عc:sI~ 125>61R97= <:4I&^'=ZL u"^ o0mmՁIFDo^yI,2oأ-sB5a9G31_I|0K23 8 Qb"U /&.UGjأrO|V [n'ʢ0 {(i+"ouaX|ޘ41josr /HdӍ=z&iE ^%׬kVQ-ο͖ٟ>Z|[IڪGVczcNJa V ]{cϷ>h+ ƏM MxXKāY-nTu4q%$vEԗ۩rC~m$$/LZennmt]-n ?,nBׁYG4 rcj*1{_F7ɪۋ97m4xS_$Į1$ތt]( re*>Kt^F*>FјV3p26[T>VfV>)!X(mƪn+qIzdmFE|+|NdmFf2f% IJn&{Z,JXCVRiHjLwۤf`U@dinj1 }>Qu ڲ䝲+ ?1[Ӵ۽Wz"zXj1Om^.XnV+FpA%Lr;{Xא.4a#.chxo+1k׹ h|oQd VfO029^8*%D?BabD?*2s 3x3~}hKh|֬r*^ uCl#ߜh˝j\u3h^^أ#cpjߣu`bG[ 8{]&$C썱Ug72`znuaW`wdܒm3 à+&Յ=;KUՆoLZ )^\%)[=oсMYqB7bWgtt26()9} \Lܴ@g r3BJ6R9}0qr9+,<x#t5 7'J)\ё{d9]Ir29󯤗n\`7GH1Fm4rnIGӒR"mBrԓyj"zL>c0Ǎ*g(^ ΜCT).gٜBɍ56$N:D "a=ĝ/ָ>KgLkMQ~q!Gk8Se.ֳ&Ql]HZ!=ڈ:>?mƐi(mޘ0 cY`/6Y.h__=$+xKmP=p&L"7^X)O.$+=J-)zN+ޓ0-G[Nu aXu5NuMA QzQ|""S,:Ԉfh]n>]EYA ϬmfI4̨6wYI;t=$"$s:($=r+xHsnRm>3y.սba7Jc+s;-(wJ )R'e .OAm$ل :MK 7H pJyRW╀LGqmX2GUs y# 5.=&][Jh E6|&y @k>.=#?ȵ3 "k_{ 7!1u6'׽0z/4U|'oLƚyctf> F/1rah$d[ Bp@Bq_W2ň̌e͗z) سuۅ=묟va{iٔj+h\cyAJDb+I+-/߹ƞo=P5D &/HxГO VQyAI+2=Gmn;IʜAŶ Ie<$18V}(<I+[j_s}=jP!iS[l9g깹W#ϷU'WJWGiya\O*LZe&1yokEYRG{C]DvVQ+ŽV#ex2w 6<$䆤MS'!_b5 C+D*`w"Ң~ZR=Ba}=JK_5y޸(G)#IfѯoRVKvI {otD u2U zkvwرg#"~ 8ٯv,Αꏵ*k-RskYϭ~0X;ZvÊ$\0lRRD ʈF'Q|)sXRp1#1EI(L B)+S%@.IBpťk K2nrdcmžI/jL{փR VauxR-GdZ/a"R$t@Ɵ)܅H4{AjL%G3Y|qNeN^V)ܶ:h^z LlxLD$aV@#OdN \̥ jG# g>{,Rx3Z* v(:`E%4ZBR&ǹ&&ekYICR%bZ_<jOSgw8?Պ;H9xOYx!kuF])bB6Ll)Eh +ԭU!5UXV@WN^ He&6AY](sCrE^%P=IsqEnx'I1dD}q)Hc(>P8.ZA3L1Rbs]PI KEI~/%5,Y`/nqu#R=@y(cDoKcO^MCAbքـ/Y%ioçAX= \( fmp!S$F2qLR@p3w,9Rt+R!p.#C>Zi4bskqx [yV,눕]8Sv e;V:v.VK6)xJזUnY$ᔥ2xxb-\T#Ċ~o Z'+h͛Cx xs9EaJr X5JFe#HQư0d ك+T70(xH=*;@0U#B'qDIZ؁z bLD]Rb=#W<"өhrS'{T:R( 3Cs @_ jX<6P&Ӊ 呬Յ=v֚2& V4ߘⱪ/ 4Gl{tG.% 05$7lyIQeWaҪ\nЯo0Y&P-n)Zu}b& U]!LT/,A3+j_ձz!i#lسscLueX6(@P)c.LZuxZ][ Bڍ6dO1<gss^.~Ujc%lK/cm0iUGžo=VH7d8C87^QuEG0puأV5j67QmVI"~7öXd1煱U]dɅHj5ӍI+~?y}VK{rqŪzG 7ssaR48϶|" l { UK)V8iE)uz01h-7t*zeWg"q۶c]@d H2sEFW6rM-` :o*[‚?IZ XHN%Ю#B7OD-ndSUg\zjq#_NK@͂w=-iXRR"VhbV6w*kz3 g,CNjB+Rd\(P HoP2'S/Ӕ^%OxJI'I EDȨ-ږ,nRmI!*tP /yAF \d_R=lHH@\PDƁq&lEap:^0NG.j$18zK(A ה |K:$L&h5 D-IJ)N'o҉~>I|I\j]p8IRxUeע?T5=7Ջ$M#mP#k%g T d%[BztS=GO0DNqnƤf7&^^q[- {3Momz.qDk^] W I7ͨ QB7$m$Y0肤AmVKTR#jZI7 0EZflMha V#r*hvɳDzc>)/LZ ըتF؄Džڟ Ԅ؜.-vwaH?\2Ξܘ_% ˠ풇1c<8l&3.9د{nO29{%Q`$|zxJ.)mv¤?nƞo}VʎcB_R5ZPi"jduwڪK"-$ lND[$q6U[o8=R|fIN\S~7Y~@"3 xLvɒq?x˞ŴEJc8+1 + d;bv|*H $ns0X^ ^ d02Isl&uQzZjPJ(#QY1.RQ>hH/T:A֡ Mne1h;N*vBÌ8Vu.#@H夨7jY[Gi4q(bGDZ#QcSQWD2=[E3<3CL6B/LuX,{ \`0&0!D%Hٴ1{a T"i+3YleY;ϛ+r\r[)ӐX@sߢɁZCEAܚJ~#WnP ,Xuҋ"nbxȽ3` a(ܟh3y1ƎYwԵmJ`EuGzY;n~mWs"- T;rI[ҒFn=A%PT@9YC5ӫS f'a@9*T֘~t^R/SWC ~SmYN_cT3 odx*zӅJd`\t\әEmJČd*C] 5MKIRՔѾTo #EG򒵏vhV?&1aInS~EP+CԢtT^cA19Y 6 adsFQvEmOp‚n4L![ .O7sBOz/f("|w`CMX 1Sѷu!70\9 _Ƶ7PdEЏTNE7K-KQ^oQ|uCNj ߳NI2CO=7 '|&vՅO=J^R%&o G{&ViCمfb4o[gĭ.Js*,E}3 gnrM۫FC,sf MO ~j̠a##YeŠ@o#6 (xc +E؅ǁ-RR(KHq6GGàht fBZ(jD#ŋ]2cFl'D#Ex桄hs@ !)Df*Q~x</"UŸ*5!6) I~6is6EOҩ4eZtӾi;I7cA3Ⱦڦ>&wpfPB늆 3g ;BQ~B|a[~l+0x̀=w`Ez w876D7PhÆiTI6L5ЕtX;B/Qσ7[k732'+%bn2hƵQL9 |݃BN&ar0 {,'OyqKĎ>[0occ {,}E7>a>gφ}Pgt37>;y%!@0 #4=cwvKC϶6`;1{̉nqoci o؜8R^IWWZ0ՆiAp4l2-ˇ%J (Dq%BR*ܾF0l+ІqU3p#j{d")(rp8=cz*8GɆ˵m+Q4ˇVcN3D|Qԑ2?;wc<^q)J{?-+>4} m_}#>C+s^Fepv$B`ar$Q?Ose&՟D :P]~c?!'zl<}uV#qTGHE08GV6 5G;ʯk9[ʵ#a窖ZB-rxmqr,E!@<-Zf,/e >7(u\6׍"qˁHvݦSRK@#$CHe f7C }Ij7Hhnlm@@.w'yv7DNMJtm-kBJG<ذ**)UL,D 2GЩ[^djYv2,&H*"jH:r(D1&],Yc:7X,/>r^J%85V'Ҍ$^6]G|]xeİEZD9LZitf_EYRA5&keN|^:SEFD&} VUkѤZ:Y7;-@[K\Z ^S@L_KbLV_Ҷw ufЧJU{(]i)iwa v)kqC[U3USW31Wۆ-=SݤBbCgDKӅ 1|x /{1ŭ_ bKp )l w_ٴeWS=v>yueG5Er'/낖64n+yN`ʹzsuW3rEH&l~ 9THDm2h Tn16s`@{ !g@Zzq7<g`ћ|aH#y8 ASb)8h@C@T6L!?rW{8C'njćnwTpd( 6:D^$N X"79$DwrHa i+,)Ö́oȚ^;bݤi]r|hЉG;6s9m&Ng̈́)Y89爗ѧ=\XoiaJC`-V+/&v[7t6ps1d7a"5 ZV>r(y2ܭ4q%ד23]17̂%; 3@)QgĜ9nVe,}x(0bϴ>_FeH:0+QZE0jx͇Zg<ԙ< 9nwx;|ڰ M՟/ _5ʺ7L,|ayH,w}aa(og 81xyz {e{+-?_cbw{y_XlPfkH ?[%;!TǥLI? ('aL>̱zQu{&Zu@m#:ArbZE@wn|}raW /fD\,f-Nn7UWqo.f-̓f _+[9zJZ:^/KVs^Oi1_;=ν[+K&+k26L^.-h22#ͬ؅$GCl[#)ٶ\@^)Y+aͥqXM9p/mv~ JZEd5A@4{ᅝA%vu`u!q;U68 uPVc0@R[rBF/pJ&Iɵfʡ.hV7C!A]=˟D+RZhܔ&? cnRT%R[I ^up5ʒbm0لwFO >\c6f *nN8Qv |& :9WM;]ru?ASRs`vŕEMů뀴:3c١Dd:T h6 ^cc2ӢdX=UaتuN-˄‚f2l֮尣/F-D -x6 Lw ~Ty]_ÅX02)N>Ăɳi&uy`j8*\O@Q, q + 526Lɰ#auRyhQ,isyw+&66L~g11j۔nJi WMk%!#%mvL k6ct@38Ԩn\6#Q쬋6,3jouU$n?>|a|B(3t@: c)b`"QaTyQ|Al44a7_\!)T۰k}+#Me3쉰aE/{[0"V ;+uSj9]ɺa>iW {._k885Vc2 8n1?_GADwAz쉓I ( e FlHqT3!sp614voG:Ebo4V`ɭ[B5eѠiPr"b{>T5e*o)ς<b<TѥIEJ E7gK;P@x 2dV k5@>(h,ec^W7ߋd΋2P\Oz32%|+/; UF+hZ~ Ɨq[P*{DF Jƒ"h:`a ذ2bc\FC4["CD|bRfܠngl~уU?]ˉ8'%ɝQffE㩖!aq:fg*8xZgͿff`H8 A$G@}K!(4l*˙ƙc*8Q^@4 %! 僭Es-]F},Ѣo}2 9$gb?$w)H]ʙ ^ɳ3t^XH6PS"  ĆFOXWj&IZ6(C'O@M8jTbMVom q]}F]Oڬ-Q!lCց[㰍nd6;+G4HV~oGbL)z:x*||0vȃay;&j dbd^"3vg2 D&}L@PEHq1[n",DPVrDŽA .!\F٢ 9iL9bk/!< á:c % Bȩ"|NbHhGjr>Sч܉Q1eCjJ|(G'ux.%V B;A\H5)}IoE"Muj|~8I@F v ( (c{$p4 ;߃ ,_+Q96Z#n эwbZ]4rʕ ||Ԁԟz,$jXQpϛiEaF"Y k> w9l&j8ej/Lׂv1/0jLC[A?7_dumGgb†=h@;V?_Gѯ& i `u5 l:w[1!#nD jb*t8yXDصVL:5ӱV=uRo?=y_OE$Gj7uRpQ*ToK #a~aԟrrA ͫR E*S_9xR3o+<0nT+[$lw"[!u" z H-M|?1J1`}B|}|7Wd)#endstream endobj 580 0 obj << /Filter /FlateDecode /Length 1400 >> stream xXKoFz(mE.E[4Hz%ʡ!6E'5HvN.w~3oSFy_'>^^%aHԩSa*O-F۔0[Z9ׇ>aT ˧z ,[k6i>j&=O1+.GrltQc^[:pǨA} cev{Qc|;~MBn?OYtC ZO0uh^KE UJr^y aG6PF★o`F+RW%~w,תϥH ;Eϋ&G-If !T:cgSU$-ٕ-4d(   b¥!+L^l!X2؜2nW_V\pR:Z)@iD<,3Gq"ƜzO3 `(*f* `lg"YrzϑDvl@8Gd_Jp;437.fpjdWz*}kd^ϠCH%ΖE떕$z߀u!INUR@& .77"sЧTr:e&Lx)I_n'QE&kE3]Z[d701ƌFf7mmhTSP/Zha%C(t )хlZP?.F^=Xh̦\ۃe8dxKj ~Ϋ9.s H5@;ԂXS`JPq%ӈNu_5ȑ)J2kuL]+s+Gsf2!N?i`qX \;G$gbDbL{5no*Q+.@A{z~BgtՉa-=!:ht\]5)s3hieMr;NZR^]ծ ]BC!g7h.ZRA~䇺?0V~4ZFU\^]#:AMCrlTYRY(˙9(9B8{W-ߣ\P`2I6uG6Ii)> stream x%=O@@h)+7BDF h))-&L8 N,8?Jazm> JVmBo+8Za7ѣإ:</ήטexpjJS&(YO|\LB.WF*֕BUX> stream x]O0  ]Z?eB%:t8K结ϲnr _XցV$h, x> stream xcd`ab`ddds ~H3a!}ُì NQ3zxyyX~!=O{6 FƼvʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=0霟[PZZZWPh- ~g\yfOʱ&wa~rCFmo?]M;vm=i_ ~Mgɵ{\ e`q@endstream endobj 584 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 572 >> stream xcd`ab`dddw 441H3a!3G=,lT|<<,+${+#c~iK4ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UP=土[PZZZZXYZX$(Y&V?:~Ν|?ʙH~_%;{tnƦi c~ↆɆMS'N.='vMj-9}iz7ĄfL=cZ97!?u:3{*?/٪*wϖ⏄蜹@ sr9?^~ M.y;ai.lR%׮-j[~3d7O;ӵ'OuNؓ/vnǾ3=+^~!oi웹6sqpnļ RFendstream endobj 585 0 obj << /Filter /FlateDecode /Length 2142 >> stream xYMso@:xTP$U%)dUV.H^R Pl X XF*Rݯ3Fy_2n<^)iRg Njlxqg[|VMgj;`TCgϪ~o%4֚jU㙣I3a JgGr)2_r&"oeӮ㳎ϻ˟\srJRl*E?-Q̦R)ꘙly6<N{}0d]o_޶a]oMgդǽUgevw.nGs;jjbX}s.l fSݶժ<=%Ÿ Q){2ɫ8r9dSs .fK.)bofUbMgFhIl5쮫Us:LX;uHg!'Ǒ>|/NdA OahȦږEg>&Tf P;w_8ۇH *bF#Xr[+%Ⱦ˶<8Q`1F ֑*9~;W(lCFlr,wQjAL1p -8lٔ>*@8ibE|9}<[%J$e<&&V&-Kz9Ηɸ q6%d>?9q89gHwC!әPDE`2 ӑϓ(f*FHQ" =7p3PaCBL _ୋv_:$rΜ9y?8Ƙo8p綎 4xj^YGQe/[d4yOy,rSHz"1E)P$ytIxWi.T?wbrD܎[Kғ`nQ**Ʋ]WI \؜88>{B OS| w38 eQ4%O+SҔTYtI+_b|څBAsv~q6' ) 0Q` M?f(g.$3DX:bËmqܼG:RXgLLk1uTʾWpN=0(4@=_nKu։*y@k|/Csjs._PeX\ׅKYS~>S.|HfB:9HpmTzmpg_/qj{\%w%!5C\ 5P(̵ w."ǸDql{'g%7Tzu$x t5Xޔm;Lrˇ+7(RZ߫i::0o'n MIjz~-6*C?S&ͦw%4CS?njcTV6]y )Wճx]|5 Vܭn]=OjΣ:en8tF)-_?qB(j\Hu5Uz$W ')/'yUdjy2_3w(n@=^n'nl =+!OþY&K)M MH,Ptώ> stream xUMhAg]뚪zpK!&h5EӃ"*m6)Mvf1 cjbB(Q"H݋ ބ0 b@i~!!䢱S¡~yql?}`Ĵby9H>q/};J_QykTՊzf>Q 9‘ȡIt YE$8deky5Qp1OMDf9%%N9f䬂AYbjJssT8T3\pCv`hkFf@ h`B;953Z4Nwr.oo؅qf\b5&J%N nԥtJi4Z-RҗشtqpT5_ oήVoJ߂P67I,؁' |[ǖK5.E]X6nYacL:ۤRhjSQQ"+6Hw4. AnZ@endstream endobj 587 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 865 >> stream x]olumMv6k3v+%I#COBPl?:Zv熣6v^׮s5 Y9pRK{0DDC|_`xG*!zLphsE::::b<uD-X`Y^̈́_Avgk?4D Mr",9ib/mј4Պ]􂮗JQ]za^ __F䛡Sd+Nݘ= cvsރx25? ;ka+>޶asyp_v.,EW0 oK >!ϊxlh ki _qm8pK:.˳]f.r<}*_실i 5I\2&_L,SK|~|rUᎡThBxjJI6+Jz-jWcv=IR Ƨ}+O5TˍN5zgS9̖gs%E '[g9e?CK)%飹ݞSG|}ӷxTbz> stream xXr6.LȲi6Ě邖%"4~|RSىcu^|WG. Sl_ ۂX㴒X_8n¨ c*~dZS/'I5^8Pt1_MZUg)v2=9efR2K%g]ٵu#Jcfta4!,xN#{xǗ{5/^p_lB*A˽@RqŨ7=7Ut(SXnf:yEv:Q)Vm`('e<(VR_,WiʬN儴Ug\Z*i9\: e$բ;8P$F¹## Č}18e8M+G^hʶFa^!pFRdQjRe&[Z;xփvAb4LAׁeXsʘHfO (( j{}YpGMv#!{Gv_peɶ.**2SqIrnAXlmm$I?"P&#grOX)X:vZG\Ð9\ydFKoME羰hNJ.Ery\Ӫ>jy2=J#O8U\痞EL(R]Ϲ@t@S;8{u>푮Nl ǘfle>ã#L|Wmpa{jM!e՛uxW=?Als٤|5Tǽs OOw9,ͳ9xrJwb j~bs~F{,t=ٟ"[K"_ݶ\tgo^/۞α4CȪvwsUUc3%On6ayq[܏.ʋ}C~ T*oɀҖZU.^^4Uz]yMjNS쀆 h$v*p)T*Y.KSÝLmd["U˄}4M~%q(E/CQO':ϯvhm(k]K#,Y ~0U>zyϽhich_$>@џ;'(H=O1#}xDws8endstream endobj 589 0 obj << /Filter /FlateDecode /Length 901 >> stream xVKs0Wh !B \-4$ipᷳxkr:Xʼna9K"-M WAi-ڐ8gzQNW^ӷrR?wޫ/*c;\g~I)9TireN$~WeԸ);/%!֮37,5:=| Ō 94RsdOnQ~SB+T[1‚}JNZ3W2]m DY *=>AY+U>ȉ2dۛ=T=^=>xL'm L}ԁWQLQM AH[y> stream x}K^>>_Mczv0vJmRUI9D7Kv=Ѝƌ [ɓA2/ 2Hn>=?1CTcr-{={*-t·qs O,f>=}Aq/oFt}Vo_T ~/Gk\n_??WOzp߼?~W?=ר7Zcmvǯ>"JB){?WPkJB"%ܶ11x/u}0⽢e{=mqտ{:~?R{q?z=W}L굒#\W|γ~ c|Ίʵu ޼l>~p5=iO{(µ?;2r_}K,[o7`ȱC:½p+Gn?^nz/|rfn5{Fz~_}Aj!:P hO&KzӥƉR/ڤБo ͑˥Ձʶjxd}V[zDrPPptO] H(~!M` ϽMh")/}xe ֭56@8H'$L8?Q`3ԟ9Y<~~TDAsJ4ܠ|ӻ^t}ǿ Rx|7Mo^JeKHl h0+Lmw'|ݷ/ L$~7&uu{LHf__=TRKJVO&t4U,2D+ez>٬iA9s<[A9q1ΡOߥ^_FCr=@Kp}Sae,0iLjÇ()J#ZH=%z"Bz4"Р!=f!3 "G=t!3` !^L_!Y%х] fY*@# !H-q FHɐd2! -v"5E`ݒEUQ鞬瑪ULV-&Y_en$S":LĐo:ȍ:8,|BS ic)4P8` F-#4ar]#IɐxZuh1 [& @uжz'k0J25 <mE #Ϭ}H;z%Wz Eɨ$ f lphF$u2l׎K0#Lb<|miێxcG6 =mN@*\i jֿQ- )L"¾w<>MBsZx0@LQG8pb8DF(ʰtY#vcǒG)r9ˁ>rv8y Ѫ5V@[ePurle,XRa%jg1 ־ F[+›ou @ANHw6`i'9#f _d-I[4tj3/4LHyC?4̆!Aژ,ugyUwbsHL```iֱ3:-?1,Iؿ;/cuIȘַ%:b2kšWϜ\ HDG!iKy/t5ıp3D(-[\ѪK$(Fl2Ay׹i.!2Go4 QsWɹU6_#˙3~4lߕ`΂V g;Vr:/> lId(x\ L\wS "c uhP 9 S3KQuJs QAc>r#36_}XG|Q"A#:,}v#L(fv eU> GZpW 16mrUv tT ׎10d0w[A o՝M${/o\H AOg6GkYˎ1eCd̂_0i!f~FWz[_%t_j [j7*h$mQʠɕ7Wpy²XՃZ\k|ڢf#|ˁ҇ q4ۓ C@3s{dV1zG+qגNCbW2yV]UP\@G#yt2 5u#FdhpB\H 6kLpWNN 6tARm+jcsp\p(smHL^O1P4 F07;h/F2lIheJN}+?<,1嘶`@gx d;74!,p"@|*\uE({W,av\2>h6.|-.wiy)ӂ ƚ:̩`ht!qh1` uUQCQ"c2Jd؎.pȁc^+ |;OB4v ZSt;T!qKU\ ꌕјTQ]!۹ \NKXTSig!m ك k}Kv-Nѩ쁻0gmt,7syE}Ti3\ϸs`Lo6poYLY0xƅC6%L}k>}n  sRwWLN!Ř(g@3z8O p_O|oqNBgԟ^Us?fpn]Y5Ɂ(@n+rU)Q%9۾P+RM!+"^\ [ʭ> 8DՒ^Bg+1ĩ]"a vb.{; [qy)E,.TO3~א}ؙf1S^%|Ϊ-rSidQ1/ Ek ~% qN"#gdpx wΒmQ4 c(f8KBU&4N=!]2` Toy0G׭j; un>Ec7}oGϒ1q&~tV@3 SaacДtnHU{#54wzךJ҃HTBȂm)x+gZr虂g :^q0MC7DeFtxK($ZS  y2cgpcgt9:+tGCQ 3 V y4 eѽ]dTU VY1f+tI֧p5U3Rq!83ȸ1vFvV;c%p5 )FkC!H'30xp&vTlX7`qNv@fA!3΀ \*g9(/*zc/t;H1zx@B=1"ŤQ+Y'8 х^\G)ꌿݢ7R)5_!5[ۥ٥8..ӹ-]ERP.o.5ʝRO°(Ipa) ]ʑ]C}-Kmrʠr6ل&K7(\&1. ㋱0)#9g h#RQg'r.R\<*IMWH%Ew)G.R~wr"nW)G~yƑ(%>ߞWs|&rAORٟ9! gmvB<ʑW lvOf gPC!X%Τ*KZ |駇)a*z /88/W&cruQ&Zg[Uxap ^K+(䥨F^1jxyreȩZ[;-SaI+祃ɕfT5x'ϒSn}.Լ3mu7&]PupUaɧ_I81F8u ]'}1XdB[ vs9KB* w{Z%0*,Iya5/ TKXE %SMdݚؕտr ceall:BvQϴpJ͖ߓV sO fZ)0\)8r"y^ʫ`%EHuUiەK"Y)ZdxK4sKµ\H/h255f3/KYSkcfO7 zp! wx5w"ЁG7Wɾp̴݅j0_+43 Kb8 p0ZMGIolD#SWmJ?u@OZ ~w/c]YU$+ 'k4Gc)6hy r#VUש_^%̴Pxce~Viʻ h/ J<ҕvRgwRM/\h,^&JY]eVrT_)^6; ,RM{elPg ?}IWʲTy'e*,0pRza'Ti©2_qvu>Ӌe?U 6R)*:HWH-U l:=ϝhp6 R}WTaJ,Hg^ɱk"*pt״*֞VI8b,^r8bgV =ux9\%1%\y75_9rrzaiܹ{۸u]?YzJ85:vnŒz<o 7Gf|IpSӅ k6Oo&Nŭ)ֳ+ c7 E+Rȣ#xEmHYw=:NÞQ׃VTް l姻`Z V Ra #7*C @,dz<yqDxZϝ, MO[ 3mUDUU)$LǙBX@ Fk"Ţ/(<~t'kޟ_Yϔ%̴jagJmgVŒp-W WƍSpԬK nH:>9rjf%[7bI+ut6?UܚZnu<}rsJ85:6nŒp-W WƍO^Mdj;p ZppL95kWn^͵8%ەJfk'cinD4ꍇN, Ó׳:N$(*!ObILg W-*A&)o.dxhfA+S"k,O{Hs7d7+Vfpg W-'{$J }cV(x& K"*Pz0q#vVrUõX*øUذSs`UtԻ oOfzY KoccZ, Srp!ajlbzr"/̪Y%QJfdȩ:6f)aZ<;Lx1o3rk@q>9Vu8LUx,*r : iɞoH KH{ ԳC(f%۫DK"՘UL[1CLCuX9Sb%\y; {a?.@PD^A JVt8vWf gZU(#Kp; /*,p*SG`۳ZH_X76 .VJO^ qfS|*.LO%+ 1w+:N-yڏm,LNx &Uee|%NS;|q}ʋ<-B P&DM/&1gUl$˗Od= pV=L'>7R|% םc`>m%ӚTk0՞UK•\%\XX/JZå73DzLaF\}IM0VrLDe%ءسK3bIL+rKķe殙IO$=dQJơ7>y09U–VHg QOruXbJHE~Q_|!j#G7ˣ[eHL>>G&Quf_IU 4!= q[fa +'+2ϭ>N I-d'1q%]^Z.Es.?/5Ndzhst ,n ?rz]CkA?šw}"9yD~֟r'bӻ?q9[VO8UƷ9+j~ſO7=k1Au՜5t{_1(6e:v<=n}?<~B{{Z>7>lj+5%=(U+E8u oK@)_ gP8b"|a_ݒ}\ߍ )oc{?Ɏendstream endobj 591 0 obj << /Filter /FlateDecode /Length 878 >> stream xUɎF+:!d݃0򁢨.x.IbفoR]KH4fU!Cp-iR N!mlG4 JOR5:Ƒ.D<|HO! JF4uqlH 8T38P4I gÈ3iܵ:͸Y &/˿601Y|?"JQE9舰#pZ_s999w f;A ܿBʈ(F)$C1ʔRA!{ R@ JB[ic+)0U)PFB\*aAϹC7R uUL[hN Q_CɸEӦn =ߊMp4OņlY3Ň|C),PvM7""鸢F3џRQsw;7zo'qƜ]Y`?P0aOY_)Mendstream endobj 592 0 obj << /Filter /FlateDecode /Length 87236 >> stream xˮmn%__'VY`@-K;7Tjd $_*AAF)R!8cq2sƓd0~>GL(4>sH=>w{~B׏8?i=]xȀ?<7uG?񧿬gs=Z5?Rkԏ_^?~O?ǐG?ǿ]Aǟ?/g,*7R>Gh'7"^\g|9gmǿȇMƙ>[/X>si7M /? x_?>C)~!1~֟9R[ϖ_o;מ{QNH?~_?OMN\Kʟsx?R~DQ2y}i,Û~ <7~?z12{\|OW9L^7Dly5P>E9jq}-Y̟!"&y? 0<[U]zCIyC}k"\Т{QT.y["kT@+䩘!be: S&QuiFӢ=0~Q 멣LyqA/Ͻ*,@yQKHIIPD b)jG}77ef2[-$s.^z'ik8Lh9 e/MD?X\5aEz="-]Ch)2zxZLBw4j[umm5oeoRa@< m F=gl}E ԭrzZP[u@JYlybsn-wAY[Iig'P!]xyvqv[z?;_O> 6N^FOd^FM6W]վgdV4{2kҧl2k]٬ه|6[1fKՈ٬,^]5cMp lI>w|k[5u:5;[-ԵFtUj>m^PysM)j! s.ضjdGR'AXŚؒZɽ6fMZ. a5, t^H qd$AU=wYM_sBNK.8ɯߓ|ž\|סr|J祬{_qT LjrL|1M8 (yOb 8gl~2ᘡ)4^~ cݞa9$ٻtKaeSlkdYLUxkW:^}eT#Km^*Ͻz Х )R1//ѩ5eWܫ4$QxV/EXD.\[J2uܹԥ;ړL7҉!kSDKB t *h._xzљN \mJK\\_߰.fOٿaмyb-`!qZIomziކgΨO zu,dWВޜhW_/brRT5T?lZiX O5tJ:7 \m\m ByM㕿aµʏ0!` '}taʕF5 SQL'd<r960J$ Dn\[mjup`c5N=w {9}Vo <8b {}\)T (06e&dC\F᫧u`/NHxBw{a9 d:!)h2XS1r>IV|ssqt7ߍ guo$PZql xƯS3{cE? 'KlSkcżԙ.fδ0?Qk=aRkG#$:+ Ё8nė =|j҃lQ˲b įjq. ׻h]`V|c+)kehlò݅-x)E4,NF^tmu)0|#/SK k/반3µ_=+7ɋܝ^^L^-rR:zs3ylаl+wm{79sNj64vu;w75ifKqذV_ާˆ=Iu1[: XaQ#3oKvF% fhe!M8,fhj!$n*g5LFlEXM&!S|4D 1)Bnhx\V3&(Z#/Є KTWK;i{@abѬby<_,L7а0E!a} n~_|Bl:p領ּ~^-r[FQ0?h )PPO_dDՎDs\o_v fi%jAR_EQh. E-E^iZKtj5f1NPއ@cbLΘGk,hͻ՝?[7u= Aq jEqOX 1{B< A1c[}p];PCˉ?uFrO\ȔuX}Q7[}6dqGDnoHiAWu1 C1ӷG'n:C>đ6#vo}TJ%G{-6B#tш)ut ۢka *oѲƣT3wz.m =U;ind݆^w[)zW;PJ6siK|E-+n U _RiE%mn6k|PZhŀB.VD:kps+CցYLuW^WF.MvV-]8uYN5F *ռ{vJP8DΠ#c/]ް,"Q ׍1K߱:te)0K#b\'.A/D:Cޡfj s{mN"axSͅo^3k {wͺZV{[21f,V>ڙ ը{pR,07pZ  W滉 oF`G͹N %zvܯoKlf{߯GV⍽tu.u'ғY'oLC\%p Of6 n%KL'&\bɬ7vڃW 1Yo[;2k(,-JPΣPZ4j#-BD3)7V:0ojQ.B ۣww=G\d^fgRL+mJ xNHKC+^0Tnἠlw]ru,b#WW#ȥ~aF\3~Fuzh`|B/t _0|(&ECۘcձeֿ&գT%(Es\H$zK#ٸkCEt#ҧ\Lq Al::Cn:51dBN˭ X+e <=,2A*s5B[*e96]h1U4]JWgٌك`ABY. ;=eJGB֛I2j>Eq˥C~&t ɴ-2>hh[.h [.)v~ )SvjIJp)]QhgkK[22 b޴ᐰ0[pruRU~;͖R -,Qw% |.i|W0fi1+[y;C97TV8n]kagSnTC[ ; jFsGHj[c 'dx`Y=Wcܱz$01hM "Ef}ЀE7zH1ZtGȿ_՗Nl#']q?_FޑkW_Tdg&]5m=4tZϼc DOYVM 2ςg8iXnqWx0uǗahuŠJ~In܂T,؀VwX* K Ym=,}piկu[Jҡن8#+.~t=="@V +GU-V͝MYu.ۡC$o vxۏNۊ 4"_6QE{-]ߗi ih34[2ik$4T% 4&QYDa2Efru6]F n}~{%"n@2,NIuBĐb|!Yc@(Fb>Fy-}: )h$qP+"( Z-BCB'MʭV6$/+K.E$AlhgW>j짣fM7j' 31T5%y %N,ηGeП:WYu/J#Z4$OJI0MnU$IaLxQ$ؾ$'_w.I1jgORLuwI~9#)ꨠޑ gB~-w&@ޯ$a? ]4w$1/_Ț+0gHJɬKǔa*ΐn=!z;CQUHRdޑ._ um cs+[1u2TSwWю]ݑsAҴ籧o׏m3EdH3ږlӣݮ kb20LHw{؇dsb߉1f#{_nU;fV4Lal/c G*Y.A8IrئFĺdQ1C&u Bg!椷ZF*&r!G~uD~l}MpDTQQKsk vĆ* Ez $* *-\QDj 2@e5#fje }c9[j8ߪKja? nMF>:/7j{wFލRlOmS4irv1iTw>nȰ/jS6Nu>|$RX5|z79f[^J {.kh΍ -2K6O߉/бHc?vY('8J-<^j]QhZ5|5;Bub :0pŪ7[_0zbv~7ĉ᭪WOo๞:O-7  VǁhBy_8a0"WI0%!\A-\9zLUҔ %gZycaa _6U:1<5Ł|h~,}n^>sZ +o.ќ_&zOJ /O刧#Ԗf%F48xٌHdYPCai-"dn]cka%%y.l3 8jI)iOj4HޞwZKx>D.@|>OmY^mGCCy|58;=H> KO춥 |w O_?ZW=msӠ{^uAόCeiK➟ ovגzS^r(ps<`4/`HW3Kh}e23&œєzGƌ;.ЫȖ0J>f %ӛ|z<.kCQKuLh=#j`FԸ-Oݺq7%N@(K(` t|udp [ ;aDz[()Qp*%8MQGR2.JSo *4$qNoGÉ"YlMJ/|\҆^[$|G9ԋZ6ek^ѣٔM`fN-MdERȘF1XbU|yB8~zbgp)“!@Hf=&9'źt=ԍ>W簫o ZRSP¦瑼B}[GvqVez׉d[#,j=$:.S0bNr$`e"u j1N$q*=$^ĀH'M#lk!nXdUBgmEH9`:Z<J $:5I:6JjLD26e`ID3o Գ ~U Ԓz\DH\dQ GZw!!ism$"VP^yֶp-)ᮇoN ;vn4Ԛ8Y\TKxZ9LKJVmTrWሜb!XzuE$cXMbFǁttHP*mZݭKwK\!Lk#GApajk86xqS q.@P"%ܕG j'f#j#`x7IKX6ZmP~h$?WwY~U>?פ~iwz:9Lc*dzFa|h9O{d\S{ȗiwyYN!Q!vodasF=q

 U!)3#O䛙LχS#{|^R5a9R@S<Qں{:9x$]?o Ev[ p)ᮇ5:dal#)M7aF7. pzЁMpdP@\.בZx ߁hWlel Am^̜k.93ؼm3-gZ UqI.u$5I"z^>u쩈p$ ۼPZ0-JO;[β; a╷1u"I?qI>9䆐yp:} Q#\M|J6ckv<=ۥN:54(V f4iQh g>9LKFˌhYT/v6gl234 fOr5KYD,YhjqΔpig%Љ=7eH6s6:Gty&_#0Lk\=h; eLif߈^%-e ` 5ܵ0*ē "Rt4Ⱥ_n8^nuc$8݈[gwZB[=_gul~VN:$MT=l2@o#zm5Ш#i 4 UyN̝e%~H ő#MB#O$X]Eo%ÔhB G.8\Nii+́[#%[BHv-J܌۱d|+zLH:MK5q h%F! }0OP 0MU?Ũ-T21F QS4$' i42yrqCMxFj\tjMWn=@aKÏOs`[(߷#X641fПnڈLRҦW(揞3 .bfƙzec}qr4`Ct. vJ9\KJa0/}&̒z[Hoimbѳ$ o Q3ȷ0$\%y&Ψ 05-_ó]pyU~s*EOMiOTvC7ͰunZeH!}h6MD[n.Ck86efiizSʓT`c# J4h T,'tp cKp,q N22L 0-MUԭt_1|l&G\duRʔ;gigIZO1);)~!3_?| VoYG OqwCit7r}[qJC( 7hs!{ɀT-(=Yt%yo$zC rVtpu7)Cy[)o~vqn-fKG*PBL_2@ӿ.ӲztG7`I/Wy\`ABM?yQS994w FG )V9(F=/L[ 砖.jaՅ;ވ^h,'9N N3 FΫOPBALZBj$C!8QA}#pHNqOc 0!AΖg.[ 0-MU?<FS_91F$34?.M9{RO1K:8ZdmaJ!O.qyg,ipJꦟC rpC>R>?|}/?5K~ȱ/V5D5 _^c?>,e'GG$72 aX~k۟e&n鿿~k#v<Oe9b,g6#2`1XުpV,X궊=G}X~~9i41zOXa"%5~a 4(ʮF,zG' bQ$5k)PW5~uԑDr)?%d*Փ5`V)!BMq_aY%^&}e4GX#eֈ7wՈʏ奩yz bol[ 9rj ˍZ \mZaT7}e1)V+o)2TkO"OCaO5=yԼj6X; _J;jՒr r.bz|PYrAZa0x.$74pYn}bgWz#DЍgwES.Him)Q*Ϯ*6I|/~Ŋ~i} k0l ِ f0U]sjMH/&gXlrTk RH: =]L$DAuͲSuuyvf2ND7gE9(`P"/7Cb)$1aW]8ɧ)&|P؉cbd&N R[& :6=&0"Ah&j|L .y-8lP]HI}`SF  Z'ՎHtN Y>1p \<ˬ9J3]xj˄ii+}UɊ}P&L]'\)_/ٮUCmlN,l:oٮjv얘Q5x6j#CmЇʜs[K6,L".L yKg,a .$1:膥cro7lgEh(7`!qB,6ތvsMvWZo 28Lh12~ Jƀdn壋 |j$,>hElv6"Jjڴ9L-HαX͵sw%3Aae_g3}ԏ 1w3Zh,nHD ڟP@r72o0%Jm1z\9ԽEG7< 0t`/LyNZQza:ؤw}׾!aq.o/_^(R$z2Ñ+1j6=CƔymM/|z6wS0;13W* #CȥK67셅<7L&%nu܏qa% `.Hy?ᾣ SaiuacUE8ׁɠw\>u7 za!yQco˃ef7\j5f ;w{}\ !t:AVm~7\C9ܘrUd:*~ǔƔ woU V.$nZWtyK PusppuS.d ү\Fk7LJ |\ͤ;iX~}ȥ=*wVaű,O0|o]+hjb\ CX;s^"/1oqg}/z{/zy\;yZ^Kme%u/NyؼnEVLlW R S6m푥m#fkZk].m?uC99J,2[u1ĸGnyݶ½el%A3TwK+žXrE,:6֌Z!ᚓp'm&͚%(|YdssHl?ͽǤ0d7dTѤj͜%ڤ)QnK;S8d<4E}I{s48MbkΑNK^jDݠ&|E)+f,,teV^)nӟ(5NN F?;iWۂGA T@ z5ٛ-tC$5wS0m3 Ķޫ|%;A^h n۞~y-Vex{_uJ>!ׅ⦡7LLXhr&7ua4Yp:7\c2F.!1ꥇC;.L"[}&pcMj7^:T57/pEnVx[]&p&d Yͭi1v&QC`Nqc/fn9_0j<@-ƔEm`1nƼ1ꥆ鐷^X܁ua/!bh}DZ~7VQHX,}hmF.$w0r%P7*+0voh:'-`q մ UhL0~}^tpFHe0 G#-v7o=Fk؋gYĊ9n+مA6K[g1Zɴsc0 ]1v S%Y}[o\6岹\:뇼G{qϳFgߺooAWظo=t=0N6h:/+5]#a+r)hW lI(}}Šr.O~#IW - p@F&(nHk$.}S%VvnW^MpmI$iɆũWC^3GܗcϚ'Infօ?[Γ{\B7m焹 "~kjّP1FynqQ12zj#P/aC~ˆA a LM$"qېJ*xjD-2n* C6zi0hMDN0X`)T2!d1ZWv A4 HC7E>rmvuߔΝI& fhsoё=d dnpe9[D!kuMϘNĐB5 ڀIzhLңd˽ze{(ݭZ"܂"=zT 4@O&Q3_G-KՃƫN `դ|Chchd\QfLzF >z_n4@ 2ae,Ђ-΢C"B`.ZZl,niAeOp|[vQԏY25QI1/ZCC<6 yܨ6Jh&v1m&޲\7db0jImއ̞(l?iKn%"@hCHG9#4ٺde"=H]:CQ!uAHHDh+8ӷGRDǥhs5/^8N@@hAؐiEBFoQd U z,tBIGGg hvo+!8<(e_H2dy^ZF<ۏڹN8Bʍ..GGѰP^LzS;QrW/uVGҌcq&G 8p$F|cVF:y^, r;8ʵ蔋^ c3WrxR}WH ZEwc-ЪnmBf4Ʒ\аnD'yzǭ'OQ.8lDr۸"gd)2ukx`i#n)W^at tqvzC# n;™cyE`NR,+ -io=<I t5 |lBE_WCtrT9J4 KL\02DK@R<4+Z#A6[HWC;Ay,AZ>\+.o$ ~yt$HwlI\6._Kh' VхWl|B_U ^Ņp`C.;];EZu(7R~~hVȶ,n~H;MSim"߯9\CPo0A`&ߏx&Ppmţ0'pJcLUڶUZ,m+7b0#x~w#|=lm/Gn"m89{YLIȢG2Ȗp1batLfLjP=YD_DT~GFS8r.֐i1M[Ԁs'T0tZv<$|AǑ auǧ G_'nEGJܨ[M"}\GpMIK֘ pגzhĔN- ZI-`A޴9a'qEHpٍ$fzns-\Jb1e\#g4΂'&|ޘ4O;Y>1 8+vݔO[AdF&Hš1@x"ar'dSO_npK&!05!r% 2@9LKpif\[L(tk4ʙ6̇;Kht#ety=}<*21$!951acpbR_7ۋw}VcI*%ay`NXș틼GZguχgq:;'HcsL2H뒐[`0-)G u")iЬzj¦_gt H&ěY68" A(p$\ ݙ]hRCUDnZDul-z`eWfL~)`>T,V:sʻ =li)D!1(CnCV$$X j%\d[GR`pYdBxrrdX\(C0I9Xhy´pWpiHG8yHHzGd )$AtTl՟fn%{(' e'sLONʠ:Zْp+VjrSc]љwmm Vǡq&€%NHGa'O|عK@8G%hVHA,KH2/ZõLY:;B`3@N>|9jI6Z/pBO5ɺnn|RÌBL,#DfNkLZi!&zB3ݑx |n ҩF׉~/;)Xqh9۲%]v\0/pjz<60w!-rHnv4UZGEqT\Zw+@'pJ^hVaZOg$4 Ddzm1;%82Gp!門{Ov-s-ô4 W=н*nnH:O~e6rFiHKӯv+q0gK0:ؑOIN +p$\U}J<" +LXzKtT4H{A8d]I:#:-{gmW9LiJ+FR(V;aXtjaIP:. q0$$2.?0$\@lv7L5#.c& :PFjԦpt~/8iO^1A:4ctL]/wWJ zKɡ%%~ 7!ƃ4Tχjxi m#mdbD={sЃ .h-l 8 (2@ӖaZ!d=9tn2gss ?_zL:h|Z3QΡ+R1E/E3!ҧ37:h7F:8l>$],`#i)Ӽ#_f wکvd@Cp=q n9Lgpց 6 D?'mlz8Z؞.8AϮ+uG9p7$ɠ&<2HyŁmK =쾑Q 0כzp@dxh##Zc: .^4 F'78QB2"p$\@)Z+nEO'j?9q`t;G?m IHm-ô4 W=yX:{ՎxMK<=f^tiݑ8V3.#ٵ0Ӓz< :|fP ጝz_ɽlٴ W1٠顏oݟ6 45]G \0O 8#B 9$!Dtç\ FnYq ]C'4n0ixI}MZD"FʾP$\xBZ׉ 4d#Ꮞ:8"i `tdG,&A62gqpC&Nܒl6sZ89:t z+KQN (}#4 ջuia%%x^GsC!f$l+V6ҦijVKqHT`9$8Hշ%d(" ZR]kX~EΑ3M ~CЪis88j$8cHX06hgpIxX|ੲqFBNV[Ш 2h֛8C,UZ:sPg~Uv3a f)q6qΜh>;hx&ރx}z^>>ToUW<8Й Th@=M2+d4DnS7{q9Y pG5Zd{\Ey"qq Ŗ@e<mrZ8<^oxhU!89M2GxQDq('p Fk4a" ʈr-ZR]9cx){"u-޹6UHژy!c ~\o[Tvo?S;O}If׉Ez&7'H!ݳsi #/IްPvov?1!'o6ӵy1$r'13%8]&6pkK~?VqhAגzD 5OG%*&InM;"i'E:&)7'|"A5ߋ]{tHbGDl " #N= dvhKgty02$D3e֍'pӒzp"ncbGX!5g"ьctaqgt1׾# M2ش0ӒzpfGp]Ξ5n`;uCpy9Jp:#`%eַA-ô4 w=0|$ƛ;};WDz'Rcby8WY2[8LKJAhr3@ nS(Fk9`u N[y%Dp!Wqw6ѡGl7cH$epmh[BƧ2'L 0-MU:pPF"r#dP9E`-i!)(ˍІVFr ia%%`W SmR&m i)WvXZ+MZq wwZZiI w=&l3y#d՚Ne977b8vr Fw2oy\B֋vmxq&psLնiI{4+ʴy#=28N_|; +Hw0h?OB\ٱ?VtXb~Fǁte~>1!aI4S98<=BQ-S8 23uHbOxyi̧ Rvg6*H4׀~)$з#tQ󦟏C 0-MUw*`&;HInQbKt"]%$#ᘄA㵕Z8iizKQ 62pzL:80(Һ c8 nr N7h8Rp%dll> 8LKpՃIVqx\3kdgNd:# ..!pu0hϟUp뷞~;#x~2Rl|J$hZQs N7[8d&㌍pqvUXQHA~Ip1/:uHH%eµpjiz*Dn:jX)/M<8dQ p9/4W!⠖V=yG`#O/3QI~↪Os끮Al$dT2Ziiznab:K:U1V~⒬YNɵDbFΆ(5VKn̋8[lK4&8DtqПwV\[u50v>_:|_9ݗ_#d-?)k!M¿G*/ĵYBO/xMC21-63$D_ߙ^j8b,oϲVW^zr^SbZ]~O? kY'9R~˟Ӯ0df.&pay\L;Lnfgq.&L.&MW@̈́L7~?ˇYs v[Q|8 ,&1,N|1EPx}1 k"= ?j)}b^D-2FF lrvS%l5½JrʊΖ|AOe؊^%*yxi=xWxc,ZmgKj,hJ6NNLږ".$S;NL|b9X }7`˛:B 2tW DzG 74c6\Kh6NIA;qk%+XYHw#`%˕O4GGŨzsd= 4ݩ5AZ;XԧXc P#TqwױGz2Jɼȓ%H1.$ #lc$BFH~YcřH֯@a"/n0@rSx@|2Amo c6ŒcO/^9q]ZevaT]B 6Vow|UkPy+z7ƍ{~MTHb ⫪eS|k]eqDW7^ p+?ZTLigW5}U[?C8 XږmX;h |%]ih.R({R)iیN|Ģ{w. oi%P bWZƳƒG؃Xno" wK}/4\%7]*L}[4wԜ$ S%Z x̢7ͅ'_9 \< Ak20M0 S&N9)$,'ࣀ_ǐv{^WRXQk^lD?܌m,U>AUs<Ɠ xF.&2ވr;3 =,E YwuS*b"-dwSBpNeS}#\ROsukn=UX;L%(6Պ-˒u't:-{StIe3[7,Q*ŬrH|'6?0a@BO TU c_1=sYIR4RW[,٪GVl[R (mR!?4-V%>`x^6h‡ݦ?7c7tz~LTYt>kR͘z݃gLc{{sλur g@uQ_?-bn+U~>0QQ^CjO Tة@<7ew&ZG[jQ*Z&k@uN$ު5R!!m=ᝑ @BoҜ#ߩ&NZ(@2>FBiW#VCJ_ߴ.)&s;sdhyr鮟G.Wgq?gLO5G3czʇ銪H42jn~&S+~(-볩SӦ#{ݑFԸ暅%(IElиqиq/md炝*id1J"5а&:4a6[TbSSO4iig]9[BDSRւ}cBҸaîTP$8׬N$zԃ:kj w3t**`XjT-@N]D2n!V0X!.U铜[7}H!gJݻ(e>bZ v#^mI7?ఏTєWQs^wzmR+-ut"OjW@6)ϩV5 zNĔ+տ =+QJcHӷ㉗ʅ,.qH(G-Z6D9ZUw/9%#4M8[ :mT)d>}|tuWf]>i,U+ ת0"pop}]ÔX:B e;{3;|e7Ӧq\cvL&f<lɴ5o|a)̆4bQΆuޫ6 v ȫi3߲Lm ÄtoRB)j %RB:6'U{{xSRb #3>ik݆"|?`LOo0X5V;?7.n8wkX TMY=>7ʻ7I1VV4ξ! 4L-fLT-zM5zdU9MD+r4{TDO+k+EWm{{,U!7iX} Yք]"OKa Lŝsd ^V&\;\ְ>dޟ_$c=f̼k<.C_$:{kAUvݸ[3n-ZȒ{s)-<ɞs%;p:FBS){1͘le?H֗*qG9pI4Af@d u{Z :8u8GH]ƾ{꣓i56{(_=ʅoy=7e*Hmx`ob:"UaQ؛2g0XI؛szO)?0QɀjA5cr1=qYw_g,S1Ԍ~t) u\ D.hӗo67sX#9ΩG6:Dh{AqhF DPqi M׍TǣЍ6 wPDFIm664lmЇYJh_" 4eGL|FldcLt !,E >-O.rX kZ<  "p-Ajqk&[7"MXnXX8NzeWx] Og"giy{y7e˅wpE CU>X"?.1<)W~ m!ሱa Rag4ޗ'F=  ڶ\au O줱k1ӶW@m6F+ 8(iuklu,ʾjhM9ڧOz0qq:ּ,TtqAӚػ ^Ŵ߬=Fli8o{ dw;6sngȻ~&,kvыZsC58]eͺCun|8~4Cao&C< =y%]i?hGxZmǡBC!|M2ؖqJbV[@9gK 5aHXqp|CƋ5G-߬4aT+k3S|p)s+1Q?A~0ilJJ4|s9+wR.8ǠKEw[  6di~0.Sdɕ+͟s5ֻ֍P<51mX6eߥ:F_o@`38X㸁@,'Y6} E[fnȳNOl0|;H 57!ݑ^Ny/fܶ<JP-d{8{GMxE0=: %Gشs#HΜ(s?/UKE. 8d 4>=b]}0?Кv:AăȐzΏ$-%d8ȇ ߓumW_U6W.xJ$B޻KϻL-MF!%^`ȖK S=O]VƀXAo\zYRo]㓯AC7Owʧ0OLT8[L=cG?7Sp'Kl!ʝqb޴QO災i=@ȢZ! H4^$kg?1RM֘yݪgLbL޿F8\>z@+fM =s$¬%Ν4Mb/Mˣ䗞)Zoa@G$z\1Pr1ܟnOM*8V&*miԣdӣZ4r3GLw&uϼ I H9cz6V#$n"Oxgecٓjԣd?8CgLNxfwK@ {buD gH# {<9һ0^j{3^DT^z/g+[6'%עQ/Ї#zl؛z,?O4ÛzLLT+̝恉{ϑ{_-iޅ^3*ԲqWLOG(rtfLOн#96$݈eL +2k9eFOq:PugCcnCGV":[RI Si'nZ__cA4e/z:+@䢎7rhL(xo4_cQ ݃AkBXmp@ԩ 5__c A,8WEh4$Z- z(<]$|BgtN}#}AY# 9JAD3 #9ڹG8x#ڟ <4J0ڛo+ G"(ba}\BWTE]tDR2]L|  O_M>djdz}MCZH9[lQ~1I~&GrvW iCO[N}TBFa,{T]u p + qB`?bB}0f(h8+SUy!b Q˧d.\ 8kZaD$2SDE 5e ,I186ѧ>~} Lco ҁ</`v?"s_J\zA#zVF+C0āS.g7c |j0ۇ @EF=ǥqK#]whg :T~ꭲjQ%RD_ Y6g V 9i YGj"Gm,^v6${k<U拾2"Dxf0M P;99F3XgA#sDwUFc EIgu,\W ɿSl :\h@vPo!$418ZP8!t}Uݲʇ9*dGmt[tfRb0ڧޔ a`2@*cACP`6ȟ"@يS_Lj[0JEhw~rānSU? D0(YpfXKQނ GQH{l,t 3mv-12gP]6xcb𘅖*w$?3?6J=>Q0-D֐(aQbR=pe Iচjy-8l3>}O=>Joчگ1 S `L]jMQ#X ǑmX)P\6`"curPCmTs"!e Us\6z;qJ(Ss(eiKBч2hA4~}QEyHseNj';kߛ{sy'U'/C됵_E>CU^/H#RjO&θ.ۛ Be.g;)b`~x |J:k !I9l[UmSp]SU {pSu>~!u!3y.{&xڒnk bka=.y3d+bA#4u q, x>e6G0*+c=\IݴL'ç>IG!1JqxC a7bexM|.yN"AمA/Ubp@ԩ 5__c Ac4uzb}sѺ37K;}4ϛltH]=.xqÙō =HtB"s &Q-r <K΀`8`mv+aՉ.6=Lc4uY} 68ƎvY@O:NO%;*qhv @t̽|]t`>WES 2Ք|ܸFJ"_SKd23@m52CY'3B|~ v3ELR62at:܃he p07"Fiy}ZvG9Z u(߻➀kw=`gԩ7)hrˈԆ" = rq`l&lQR'Y{MWO#b 7:JaHDMqKxB Fh م2h Ac,–+g"n Ni,(6' 6A D̃SL}TcQ:uVvGz 9mbVJP)w"ip阪tGmIY{9JsX]9u5iWNݎ>1_4,*FSNލwԇrl2R1ʻCy[Z@}kw.|t*lw9tyT3ȶx}M.|}1AZ S:D >qd u`F׾чگ1Qu M92+Ȕx$Ǫ2Dn4'a%.^_"Yop`]]e)bfLByqSo"j>SWܻjeC x*dPD.uB't,SU4 S(aN%@nJ%@#S2P*XJ,wR)S ێb89*2Pʃc0XgcS*4j%Tq5_LPMWn?8OWԚRP-HeכWK4ꔣ!QQJZdQ@d~sxq]Ab֮P#"C*}YE~}Ӊb/sl0m츝3%o<{F{ A82h6 ==> 29Jqx\1kа"; [Yأb&\Mqhl$Xu '{W%_N 7&G {F*N1<6=< 6u'li  a=h!(b`ER90iAVhLw ] 2)+)xCLR [1P[v"(rC1MqP(Dq keoHU0MT`0ڇ(+-(Yc0EQ 33\%`|J|1rY[bTQ"p1 Q1Ljh,83`j5,eRD~TEn l2Nc>”8"i 1: [jNyEDp`z}<4gȱ ϳRz\sȶPK>bJч/8nVKAud>aPчگ1 Sqc&1U=ڄTz@lUɾJmfrQ_|R쮷>f4nSjK(L1-yH:4څPUTs!ȳAq(F{hҁ\4A&Mp1 !9f^@6bg7I݅QCق$qD\?J@vh3eU4#8/~x~7=3B_Q"xgn,:v m7Ɂ '(2_M]c0A ;ό\s^tmg*i%\͡ +ā#HQ"Gi<" ]KCSN0@-8KIjr?QhA~}-a_}vc״&V]+q:SUyE)*Ud]NH墙 CѴ1"h,໲ Zh7G սR)z0)6W ٶN"(wPK 6m\Q$Gy],CI$: Un[̆WI,ԝPwWqh_ȡ > сZ{5"¹DEM đ . SD/* AA! F;jj 5q`䩏*1`M+p/K3 p_Z{϶pA }2s{_0T0sj(L1-y5S2RBufYJ0QYXr2RiF3՘@@0>,HQrџo(Ge9oO}`,[h?ͬ~N9eV|//8ҲVp_8cyzcJc]GUXO|; pʒ &tEMF"'9]Yg1zP7CBld$d$"uH!Ab,FΗH/H67c̟oY8ǽQC#,\n$.uHJfLa"M70RVWa jw(ARnd@!D.N<&Q6QV7Lh`t̵̡1@Ƿ]|K׬pv9^$goe5Oq!e,W%A{P|X!.n=GHu&|?,FK>>GO]@kTP Oyk +u'hs!"D" JZL)hd&l#I4y1(ʡO晅J#OTiSv-3?^7WzbuمV2Mu2hDJaq&Z0߅9W/{b#G\؛^<65Tݵn5ʭ_YN͙Q+f* A5aoq슙f@Ӡh]퉽J\)?▮>+`^ FOrړׂhLgDQ)lxOS9銑kb V3DMi޿#ϐU8.^_C{K #9 11w@_hCitu\QYvJ+݇VZ1,CQ묐YiC䈯jz.^gMzX' dK>_;OS_뵦F+H~hg*3DԺ2ZPzOU{ a`@ZpA9+[79g~i:^܅7LC``ƣBPW]}*u.]ǛP2n4%=T,<5ys^V{ja'|-/8ۄ!{A s W%Վ}^MUHǢUr͵8·maq3ЮU}޴=]B2TfTT i U ʫ-O*^3d匂iŬQ.cyBʰFXP:j`VO{:C1by8?G Qu|?svh1a~6nKxa;C8n"I#x4̬V`P;Y /uwảFhZix6^"͡UhM6+$-$1n Ld,@?&>$ՂYVR&KĊ̹m+f*WD[Xk^DncMZPۓh޿[~7/EADdߴSH[wGi6M+ջn>0۾xV-QyJ&{ms4G0+'Ci!Z @ {K oq;WTMT ;+f{, +T7sTc'FBٔ }YǓ0R2.T 糋yn qV3 TQHg}UO}Xg}80Q#,!.]lêJ{n9ǗUdʎYJr*15iKcZq:*nsĻaދP{-g2!R%ޱ0JH"TӖ E^!"fq/6Nߓ2} =Eo ɒQv PyԟP£)nVBi zհ)Y ڙ'uvhpᴻkN6) 0p~ 7OM\4o(6l!h* fήɦ&UYFŧ) tW4!W%yk6)6Gl`IlFwaQa~IݴlP8sіnk-Ly"W"[1Qf,lA`:?N w]9o`Y!E骯/&&ؿo32F{ęqZ=/ˊ{LsP ؏yq;Tz[Mg>-yieMm֌%Z:e=]ilXKxig f f%"ڜ2R##! ~V@L/惰ԛ%vL[I.i6Ic Re駽b+^5:=fˋ`+U,h,!%p/fj/8\P+tPٵZJDp߶lʰ3芈bᦚD$mWwx6Pnm)̚nc'8 F{1{Mܮ6"/@lw d_^fDt7r-ul1{f%Lb޻\ }܊%yykM yS.磉ћ)\z[-S୰\= <W`Y pHJ0ܖhiTfm/n;mg!Yp,%cS,5lvϫu.\|1V3~ Δ^֍>v {8Reٞmɭ- LFw?0U!H`;;pLٖ2WGCbbTuPM{<C^1h5Jv h~~aKlN.A+fN}z~f!i.OAtP`٪1c~wf"(fɪbuQE"Ƈ!d\1S94#=N(89_ފyLR"}v9 {kیb{ Wqj{oފ|2Oˊ簕J~&Z }wU+f*N#P+WiNƟ_[bf%2{k C=„QI~^jL=ey\R{K`1vb[Ʀ^0?Rí끑PN%fVw끑j^ -TsqH0ћ@h? $Ou JҤ>5. }͊{o^26ClOp&ˇũ6H-vu{sfܮ^s%6"{JC";@>+#nǤݷ)nkIm@ }Оgiy4dR6pn<0/ ;vj灝Mvz򱗪U48QɷU@: #Ը'Z8Rk6jpXL>@"mJ(]-/4pj:!Xa5 AkF='+UqV2`V<ٶ+2 c4 pYavn; ]V.Z8\<җj5gLʪpemJXϥ!dIYniC w©I]݂|oAsɡ8m&b:Cd`B-)mBZݶTn=;~o9Dm,v}>'{ ,HϰNJo0pp.Z۩h-mղV$x[zEPU6d@*M}L %[XMdYa]Z " aq^釡AmMz3rscST% >=M?_з&{q3l&i2f xFQIjא6:ڑݨq %bCB +eDgISCs56P0T; V[PO6C @efDlv&#e#%VW/]^)tpƭzVpq?u/ƃ8΢hkCB*z:C6KpXnԶ}~K-rX-Uۻ8>${ؘ0?,d>m "B)awG^*>\?M >ƪ*lDμ y*0̍Vrsk0꣗y>f5ӏy8y˷hcAQuJ-_r.{Z@(䆊>6 V d_w LR@,I}?xYtr|) 2)y,:kg2Һxs8[>8$)y,wR-gYŃuAه~B]"nvRT?#/y3\ ĩ8+eutzL|^, T|Dݗ>dUgE:Z#NKkh?zbnˑ"`]Ziy+,v"'s7yę_+qUG~-9*?qH\xsYl#F?Q/|3\Cpw|X{&vܓB\&6UBNb+$iO8f1Y] fy4]H] KaMLHe Ynv$)rBWIFڎ;]%GZ  q<:-S0;@bWw‡g=E"gR(c8~|=,[/#~yL]$+,]A4Cynl%]hL+ 1p咡7ͫwW 2LXPiWkܛL}1Smijnc wRdXyxnfzxmjHŌ,|%o~8/yg2ˠ.x42nAt⼵dl7 Ѧ;8 hYepXIHzY dM<4:yc C]^y eGs1(2 Q;Y>p"m&P1)j/]i!E{Rʎ>XrA <478 x9'V'\&,|J׺銏P$y_iyDft,-/\ю%G˕iko7 (bf0O31yOSH6V~*dEv9$GUiA <9ہȧmr;7MoX"6JU__cI <4e1YQ&t),0ݝn)-y r6N*gj")batVO%B42nFh |]^ɘ A^a!XSFnd+UILQn;0h;~":KE"QQ\t")bam=`y **}35MVdؤ>a@M&MF=ǥqHsGs HBl:o+lE̿u\f rA^-KUrV8z=zn׏g(̅iw8ڼė!)@&" Pe]>RQE28,~em {8RlHwю"r&EN98D} #EsLgLyGerXʳ[fDim#4}p-@BRCg5чگ1(2WU'xqt"_3HG.ŹՖ5I|!UU5'dZi9>~}QEỳz)n MR|H(zg3皯VSpDAﺺ28I#J n\  ܪa;arl e_rOK^RTN.eQ.|}1b^LK׊қ KoѴwضmo#7E/8d1.18][5sQep{#C"'QЊtRGg)8wH%F}!t;WlC$8*:Bc_Hyĕg_%c_i|s6 nLrp5CmmQ:JHX)}q:<̦,-2]blBĵ:K% sqŵ5Gd{FnܐʻV4?X8 >CN 8(裺ER(2R[53ҨvG}:J?6ۇ}"O&P}xI Ł 3Ώ>~}Q$Gy дK+ Rine7.%^fA?-'EՐgj$E )cX(R)JzZnZz-CCهͥDp< y Ye<\D93("[WM&2n4yuup/q1|0N,BMv?왍Da[\B۸$>u`+{1r+yB2 ʃlzW:r0l] D:|^Um;vg 0,Ss!LDv䔮Գ4@f>F; Ŧw!-{Qeʦ>6ҞF1Æg@D펈GaؼL9C@|!tk")ba Y]t v9XuSEq{$ݹ΃CK)$}CaM4ui!QQd%RϪJ)!Æ!r袏F"(ba88%}*[nש:̴(eMƓAO[""a=m*3}<4EmH5l͆g#m(:kSCk#dBmwvhL4uy-T|*䈳o}5olsPQVj%d(1._=;w(ol_qUmsY0ۛmT,yjw3 [R0|n$IĪbl(s/=ȾPL^f*(V^SLl|1Gkױ"vQ~ψ#N;h?zxgWِq0]w#mXh믇*Vb ypvK F 1bm^epXQͶCT Ajg_rLekB:VCQCER(2<)gisUCph|cmk~>gG <ˑL~}$h^”wXtuaŢw;%/&<@W+W`YM0#̐E6~Clv?X//F`\xA^ [ӡŵGb]=kl/MAZզI !yMۓ )bfLCց m=^($$CO Dɡ*#P5F9JsXGqYShI(بmȍGٝ1~Jg:[:tR8yKri @Y$5m^Q epXaǙ-"| M^R:usؑ Fr8w6/  )dVoײfJxi+͡jlMhbQye4mXO`㊗WofztyLq Ey؊ہ=#K>)T?/m>³c"(bM>("b a9v[YܝMKu=$ҞF\Zjd&̺a{*ǁnz:oz"(bC5yd+ y #6ܒK84Q\Yˍl;d sjS("}:?7fuyDv@7gTJ>t^"#3{x:'uvND0Xb-Sejzȁ68q̻gTe(BٓCهy>~}MepXṹ9<7=-k\=a- ?=HT%PD0i0vpDt`Pؕ=p1SHn7Y|#]}Tc> Ãu ]>Զ{[(bC溊GO䔐z"9Pwmn IQ>xE & BRĠ R QӘ( fxr{`]hoV,Uϩ-£4V>k?pzm?? pg) w] _BJt^D畕m*XXVq&2i2јݿ$z$L e (LQʚo߶ϟ@D:?}G⭟;ìtj'Pʎ7pt؞ӌw‘xdk]>և3,pN}"'+ # UPWX| / O獕}fgXY09Yn@`0h| ٻ>ޅ1 $g v#\4}^ ~",x 5yj8X@ .#þWłvč 1mz2@99\LŸ6 6_?- Ā13c_7>t'וFDAaZy^omŨ,8$#ӣBN^9%fwm~-:K,}a g!Lo(ʟL5<^}劘H/[;}e1NOmv՚d=o2hP*jVq?鵾6׍\NJAsij >}lڎ6ޡUDɊC֦Ju__Ϭo%Ј ]`fF?D13(wƌv=/ߏDmr&gXyomN,/grB:5=]_Ҹ=6ܟOoe1X&6pTEY=H]z;E̯7 ˏ яCQF?Ål̏lr@JScY}q9Y?YkZ XTޏ: +_Z Q ^8B:U}X DΝp"젧gK= y#878~_m+4^I [>0c\ xJ?VZc+LDl((B%oBiǼGl$V Z-/ st@!26i mA#ͷ*vBb{O:}qܽvSzOk (7l9Mo    :Zw߬RxOeao>[ok]aM2SGCQnhICEcYԼ&8>pmO}cr^"{GcIZ*eYkfV#B{kqs(!>?  7V8G<l9+[El&9x0E;el`Zx1~}~N.I!DUyS糮Z&Xdsuʕ4l>=o 5ˣd_eclrO{'eI׼a75w,'§=k|=9y3]MxTŲq _ccx;*ǽRJ^B%p=,BN.>TEK@o2vzL TU_2 U:|j=0Pu1&VE Sw ҈-l9{h4F\6ŷ>TnBO TM x؛ZH4)evm\j4*ȜKQ͘g}pHD9pj/B/LT\#7d35RUx#6ֿbT| TsP-8*7;8g|`[ V+ښ%[j{h]q9c,3N%J{eLTx]74&Hɧ[UʘL!Heܫ}pcp]U~!TS`[\/jde,fu[]kKh9)Tf:H^Kǚj3 j{2mT;2i#jγIFj:GTݶ""D/Z5N9+]vYX2o L4sYFv*s}! |j?z,*2N4ߴbV2Ƴg(Լ *Ke_z8.NGK̎k{;l4@&%gAFԽH[I=XM4E*mlg"27a?乳(@i tOsߨ~zl;%Yʼ –2J\'jaxOSZaez`hK=qo,<`N>xU{vڶ]o͔s@7 Ҁӫ/GmK f A4d>Ҫ>#\kc@MzM{eD-ƑZ |H=h]_l ,޲Urpn86i{L[x5o.4+;\8:ʎ] _]SWvqթ+7QRԺCUh6o?]S4&聊d`ו/t O_%ٹl?Po~=kkWzDue7$/Sb tݖKJƮf7.R}]9|/NȱN?=a"d)Yvӹ[-x?/e\2"1hi*N`v:O1ІbmTA"2q([a,(Ywg[ Xϴ1Kڠ.#͍|xɒIZCNY5iǥqf q&Āk~ Lﳻq!@aY/ad4s6 _Ȯm+10sڐj iv;lvi6eȪsh a/r){"I|8~zI~\c|N G+r^|p&U8e(uµfC;@БUC5[mBYN v ^٢w.unhWεS|4Q_b &7oJυ%kYE,s$zݒi>pХ)OTigL6m傟lv۷xmKgF#kɷm׃7=xcaA;sj]vվfs뀟E\zùpo*{A_N(=XM7kӯ;_w*2BTr[poF~Kp_ׁ*fܛ1S,(7nh f ԫ3Έ ݾT&ȗ/^-e#ܐƀg0PxK@YbB/yOZ`AI uI.҅v>rrs88yg!k6váiSwq˛ϕ!A3aun4lX8`x ghre;|褝<C– MB/ndGڸY\ u=iSX1G`XP39Ds4T>]ye7P%E+F S)ӤBвȥ#i}IqXyA('/TQ{㯅K$}v#nm{?C1+ RzM(0!"" w&;;1Ѡq !Z M, Efxhbϭm#Ft#;:- ^ypf]aps7H]}iI]g3|ԍs 9\׺)N`"Pk{^k\ nP$ehɯ-HqkaM $MRz9.(#.ާ q+bdlr6\ 5!Km2H^m.2;b(?xg 0Ą Am +ӜdbË9d ,vmvd[tlL".>L=aÂp X3G\( Xh0Z#cZaFa>/]^,,;"fUmav~aIƞ`-IzD-a#V+EΎ]]v8oűFkm@cE?H/j+>Fv'~uTNo$Ǹ̨\ s0S < q(jζa))Lǖ'qY߱N<0j5q#RaG04o.āM&پ9i%N*'N%0ԷBaԊBS-ć= \P e@mƺNz܉5,u=`CQȟ'.4 LNO `_1}GH0c,Õ4uR\(P!X 亂D`oUWF՟sC|2#>mt2vXpOy:>mvymc uukwL+np`Gki89D4# |:PFty'k<8e?Ĩr DG^8mψ=Jr''*~{ͺf%b8WvMW$!G^^@X^̰ϼa/ܦtZj|>Ƀ2cfCH%+0<PߚO Q|1xWUF(b儘6)4c=KxS>C 19Yqww31$5+1:ӓ uT%υߴ;k saKi-1W~ .K%a\iqqaੂvL _tu»sΐ/\x1+'ksCʾ [}ڸ"bAhQk&n z @-Ƹ+_ sx#]lN /* ^m/_@^Xa-JamDaNelӆqWL!7F;gnXYdYg07$blIK01"0 'aB<@ UŨ¶#46um˰a3[#z38(u2`p`)1mYC򩟘z_^ }OIx#:i`8N?7kfp%%(V'5kvrvWJ2<&q3eSh-~iA0ߥW´%ތAXx=* =9t! ~ 6YpfL4_شt>q|򐮕I(-9!Wa~061 K2<&y!Le|P9ͅQ}̖暀oaFIGqHXc|HL㥧84J!)sk JwptVHMICIu =0hATKWʐ1MjէwV՜1߯"BF1gz( 1m өX“P('sf7|+L)2$WbvMѨYy+H f٢2j+ | ئ.UAUj~|b r\! n[XVrF ѵ8(8X#Ԣ(: @ MT`!kOAac "!*E$I QtHL+7_@ MVǮ1߯BR+˥"pp\"N*>V2u*SI22jp&$^eJ %AP1&EqYSȃ}R@,6lY TXǑ#S `NGQ9 ."9_\8i~k. 1= kYO ~%bת19"EHhuJҥhU}cVm%EW5Ƹ_i++f9`i%ERbW2W2XCܯ2_\=FxB$eL_W|;1<cePޠ.Hm FͰ8A!~H)kBv I̩O,krK4%f+Ab6HɁ9tV ")!H 7etv^WuOܵO kC_RDv_=am!)Bh3x́B.FWDHbN}UՋL/Sozȶu"h* x 0* P8x+eH1%fc. )"4y'Uw!b0%C8t V*U0Jp,]9UR"4$d@@*"*z5W[$XHq9 ޤ q)V%%5J Ko5aU~A1LAR&\VaPPq GAV,13NCCNBaT%9J$1 $CP5s|xNkKP 7pWO ` q HKf aPHʐ!c0xv8r=aQfv@@{Ҩ"wW0P#ܯ(vYgDCx9ZNE3g\tfU)da.*>q=h&CCaH#@a~IR<eujbvښi?TϐKH[ BeC&KwbqP%C~̒"(BG sЌԥn%v˽7jX0*My  ܖ TF|JscڙR0/ƣS' I!`qWA~z+! _%)R׷OaerVDb[j ?qߤpN*Bkip #`yuN28<>2P;LX; 'sC]-h !d2°? !dpxBTn5̌8,bʙBcn a 0nz~C_)BRXB?LT%d ˖= uuA5HPS  zY9T6P`~I2"ȃyOT( Fq32zȶnqe<$4M@j18ja()|Mv s:=aFu"<[^U5my'>$Ks 6!0P`ݚSV%Cgĉ&t\^Cܷ"4,BKL+_.p 9^ FT)J3K69|~a:JTqnam(.;9?3⳷( 0:&GB1@Bׂ4fc_Y=)v'5*'0,'4{ 1NbpT1NdoD9, jOO3B24W!a0xv"H[3?lX5Zb>,= wbZe^Ŷ1D ee$ j\U 6DB= :GoV]u:I2@gkx"$EL9pZ̛>$Dtߡn-P!72 6Nf1AT#,L "JTb5!XfλU:͠zNbP|=%P~@ a!T[KLh߳Ѧ]W U": ~eE3eS$18&a_hSӌjIq8.FM buhD:Ui9 ֕K )k i:qZqeاIa)s,>Fc C'xVXI x~C!2YSN۔9*E?n} |R(w?9$D@`a #9!WbF`TaXc bGPankrl_vtGb`bN5=K_ia~Ia)s*.WH ~.aV+6t9UQx10!Wa[͡oaX&K!u0xBdTPCocP dO i߬jIb`C)#^urȏ40|GG@Ԯ5T/?NTlXC jj nUe>B5@܏ (B@sMs"*"bhH#$NrHx*1 H)RyPtQl%Bmt[Ɩ-4`Wd0G_M^1Bsm!BD3x!iq@%IooɆuL3ߘВC41@hrh=1뜖ARmO`5x),h"$E sP&EO RWwUd3J0Z9$1&L$&9`%)"4yHP-]]`Csac? ]Ca]VREH۞x41r,|Fl ˈMCnR8,"8$8?1]uѓCWJ)" _7eJF`gRAOIpi05hspðtnJ)p%C_k>j7qa̘ FTc.R ~9ї {\lǎ0%=-OU ,h\>iT~aths 0})bEӂT´0׆27N:VI(:9)ͻac_)ER9C5@ ' sB^*p beʿL"N)̨̦`>p9@w)C?3 =aN2̜ؑ%ʌb 0\fW90,9Fʀ> d Yh_H0t5 2sGf_O&pP'3p?1ʴ%4Qh0',DPkfX5ĸ"X0O *@(@Cg׌C0>ZH!e>v4B{O./BЎW:jnn11O60vvp$|z{.~tk]=\;3K񑁁΂ABEaN2>@ l! BӵB0t-`ps8|&50fq'జYc_!DXdE Ө"aXT+ai<)]CC{)1ԎXf1 ߯"),erxs[~x?׿oc\Zyɿ&_;w̯Y$_﯎rQ68e/?;J:Z COwÿ^QprBd ^gbf*:?1Qf E5Ͻ_d}T._ۿ%cg)~6 O+;R~[{mU\}QXT'UbT٥ 3S}Z*0U,3QOYR%fBe敘{ӛM}ԱeOiZZugk+6}@ϟ:C?ݳ+^X_🭪bku2ٱXZP]u-}UN 4zb(LFO`؉4(~gY.[^CV腫NIƐ`0%^,0&ס\jzQJZ`EN`A<= j tUwRz٨::\Xj5:ǘ^JA?Kɽ Ft R X؂-X}Dg<\-l:́5ۂR-&y?!F)>WcVZx}w8lO}z *O4`隖ikZ81-.rnsO[δX) vۧi{SUx[{bp?N?7@ jO:./ ˴7G:ŧ&YnR5kW Ǒ PEz׉Z^XVWΚpFN[5";AQ"hDhg7a8*Ncgh,wݻ:ҏ<ܧuN/]Λu2NX݆zcqc˽s.%Z?HX&6rό׼Nʬo˽>f<. `Xv]ߧwWcp2`O{^?ܘvvԛ־>Nr .oCKk'>ޱ št9t3< 0'=鮽c]n0$(s+éw%\*ERAMT jM`Xl>%8S;{ӎ"Cm;N{<ϴ`W||(w=EY=g|< >v< akX6CNGz0̍pC8:ڶn}Kl;y-\涼y}vXK꤃+"o}0s3Y+"jQ?&~0:.&yJ/ݚhJ8נ!5>fg i ηv9}rC #we"8 I1fL\C8~9 ަ7X*OR'Z팈QOf#ST[Ε֢xZ{7TM}_Z͛q1ʜXȞ8S-2=q+*''8Hu"bo{{ep}Ď[v\T5 {Xzn[DВaWg'{kl*=w @ua*!g*D.VRM8Sm|/K2UW{kwϗĽ^@u-ӻp!#0G|YO[~mL 3#,9TT\=~,WW i)ׄ㛸A!o{XG9Fo0znW!kH}ČDDkbx*c8Rm|.^mμJ*Fox;7B'-=K+QAg@ P zkƻPfF-:ZęӥIVTJF\;8e7-sUBd)>qTS}Tή^3e9E*TcĀ7˫Me:0Ez |:ߗC>DĴ5KʄuyuԺ.qe4yܤ9uJ2]75x)|C #|?*`Ӧ 6^ư3Hޏmʘn00Ww}oVn҇!vy)Gpt?dp?glTOOcA>-N~law(<,WN}zdTA߼OhT5I8vM蝗5Zo6OWi >fþaۦ?C\5 {w N/?>x,ao!^ҭ(B1.v5tn{*L71am1V€ٴBٴINuzlkwGwJ`>l|'ml-(l VUmkfk]?oIdXГhW8G/ 9"jޛ֗NJڡm滨TY_U.yc>oENoʣn\ͶF>h]iz^K֧=VvE}&T<>l9[a=1bA/w!}k=۷c֬φФeC2f9tLa*3 Y4h; SVļtV~74e~0uѶ7XzQt1%D޲%-rZÌ;֏ ,W_v*Ġ4_zGæۼw#%>&ZuǵOG`rtHʶ]т8m Ol Մj00}~*LYaYf c:YY|0A,U Wyj`D@;97Z74+3U=sd1w- ׾N60M] d,mvx.BV/,Z&:_R E–Andf}Vt޹Fi-]bTZxA#  h!kO[?NhKg Boiد7?pK/F ,vՄ3iܨĉ*!q9öғ; , Bi4Ttҗ9M]& >2TCg`W/%&+3~]@&+_?hO!PhJ+_&wж(2΅>ۂ.& # t R1fH0*ZH0:fk~i_ 9k_a+ n'35Zn}03[FFCW8P 6f|?g?geut~t4|0(4/+lXq:Үi)0dq7\ԏu)lD `⹺sWg qǰխXvQl9cs%f̻F?[N(wf-[2Pa&o }>B8yNn E9;Qb G,&&ָenb?(x(!~ώeo1X=)jRN~[>Gb"YfK4{_F}\W7~WHK>;dk<̍Gyc3GzfW0#ٽ1y_}* H=%Rjs0,6uŲS~Asov\$=vlkU6_EčlAٲ~`aJ@]3խ~6Z} ; $[qL;M#݈ Zn_Gft>PG$:m29_Q <6- żm*\֦R\UʯڔKqBP}+g *6=RϓMvhKE&{z'k" 2=Po]6#oTcD?pڴ̻T#w*G8Kk[t2F-0>|_8!-_8eXW3O]16):NkayBM2g.TTҊg[J=aȀ)%O@ďK1gN\d[_8P /P~j(:f# TG,'TGDT˺wqYzVI.jvVP:JrKSUG*:6qMJaVV Tx'_rZ}""%f%?a\UG9oSCj 10y"H恢vpU2f'?9.|Eox.F9oְX ap 3x 0 bay+%H9HĶ5(F+jCa~$|˪s3U!`'(cnr1 ߯")B𜇾I9!9+񺆵VX_%)CQŻ0M<cq"(B𜇾S-0osuPJ_iW·|5Q(g3~Ї?01(DHbEJkQ5 RwXZA.S6|#oD1,8~\bp0¬I2c 1)c \ KVs`-m :!%3C==%no~q@MAevcif Z`s˲`#-EV n\$L; Iac<{r7-ĮFpJ3#'*ۇ`PpBKQmVJ࿧~9Njg%\kS+s0\T n։`ͬ0zqb `ĉ ߯!),sMVt 3ҏ~Ta$|}r—jsKao[uj&"),epxC:ȖVmb`C1<ǪXJ%r:CC,avzޒ`c!~ 1N;`ӁB[b 26@ZE=0-/WEHh){mZ-/N`  T_~n ߌ6)P<Ca #&kփ"6yD'\KИGH_¯vL\U !aqC# oM!/}CD`XCܯB>oG!)Bh3x!4b| sҭȨġpX! *aY?(F\7.Ϋur@$j rRt)s+^8¬zfﶻl,kXC~fYar :](EP5yVWW6J^-O{߷lD@> `09<5] 2v#ЋF71|>VX㧢ł@QJ/0+ ˰0ab1n랰!~pw,\nɡGfaXv.J!9|#~b٣uaT=RZfzRyuqxzb9-; {/=)|MAbSSbIK:0_x4*bf'n] >%f}gm5A!RF3fSCzg ƨϩ}pa"vͤ8\<8$1tFYA^j ̒"(BGr'I-}#y,&p 3tA51bExrp%pxR&˚y/x^#}˷$0Pq=}%`n9'H`ͯ%x+E/ɛ_P- _9jBmESEFP\*Ld /L:.k >a"w9vOc̥QP9XzX *^yB$,fl. 9VrFsò-1<`SҔ< @iF@F.Pd`Ү3ǃCnbv.`-Cv:SfEnDg4};]PDI=@ NcsrNOZW aC8;)$s2Yi-0y?tFN *OE|&a2X/!߯AP ytW}nBы܁a H`R0s(•0Q2֙R6>줷mNc(zrL*H\快#\=_qdXʤF,D18<'ͣښF(h0)ht O6]Œ?F5<3$nC`ٙ^*1 ΆE+{dmN0ŶQV]=-Zu+h]|HbBQyqT\j;Vg Ddmh%0f? éic2 ༼؀ ݻ0țb`2K|+q}P4(=*A胑12-t>'֕v|U?FLMWo՛}^.U$,mS#tgIqF=sxLBBAIVEe({Ͳ",\,f :6&Ecu@8Ɯk8Ac|BBR'y`@MXdooOԥRsPk`UhQ0e`Xc cdN]C"),d0x"3< s90uڔ^ ;qf}~zOJant/ XrX&9N-<@ZwOO;W `Y{PgAAyqg} o6;!4'CE18<' %Ww\]Sel,D9 Dʔ7 .M֦UR$LyBMiQT"0,ɽUg0$]T(Xb`Xc a``faH1 -DZGHt LgDhvs,J ]DCK4<,y ae^pu6W8ђǠ`!Kepp;0ǐEacwpU Q=1&8۟}~\7xzB Ct_)/(-3> ވrAqO+-=LS9b!ARX t%+F!k]vNhlN6LU7┞է1 sE!)<2AWk|OFRfN=Mλf $!N'6x-+2Ia!< ke9e`E6<0 '5KĬa6o!),erxCi=6 Ei'f+iRI֚,a 'Ob y MM9˲d0Ah_A4U-GEH4kTO.]mR TM~^` `՜Ӗ>o,͜  sA)f;5B I;), 6 wOCÌ *K2AR<7^BmO`J2h!ZƗmW5OWQ(4{PŒ;[,8OH͎WEƸ_qMrhf!X/BR|28(V`$= YAî$0IR41Ē1!DRX밬v#{ՅXeQA0Ҁ v.)P2jb„fc0(,cpx¾?{dM _C ޽U)l&%%[gj / yx7ϙybOD뿼8Vl(YJ| 4?+ ?r}gO|U'j#u*1ޏ1DՉ*cfMsȻ >>{;c%ol`7{]{}EQA ~}"sE __o>Dߋ1F:>|掴M"5?%p#e|?2%bU\XYM{牍] U]a XihI|0Eac: icCx*ux~0zA]zԌY]IH(J)"yxn m.Gj;;%N\`Fc>n8nfgn24#E"$Eط e(1[cFi ~[$LI) "'=_1Prf0&)r<4$¶0'=| eW͵&ۙ <&_ޜUYT61 ߯")Bƺijf zwĞ~9?rNn|s j0]#! B`!Zm޻;J谊ugݖW 'M48|迿C~v0Iac C&u++̠{ø~VZ~s ^b%prx01hud$1 sb($erxs;vտ0G|gaJJGAQx.Z(qT~ p$fP19<'wa?)lSm᱋ ݠl}0p7#3R2So ߯!)B'"{02;2[(Vʲ cKqQ=KmOqM8QC")BgsK2]'lb&ܛ> kfC=pX 5/9'٧m|ӛdɌ:ʾ,0e<%vF_ht2n9aK"E Ixb+rQu)f>ok,%H9/N=& %hT4ANL"E9h^BI *y"lHB0k䢫 Dq0S8QXrl&C!BIxb9 [f%U^n·ǎ9,юC{$fsr@7s1 K29<©{¨:Ow x\ jk.!؉~}WasIa)sہLl"udm OnkIqC!wmr Ü( N)d -D9ҙ];NRĎ R{Xe *a0E"8HI#E@$;"wԴi滃b3>&N(NN0"u5a "6Yxf+IzONs1ջ|wږj]m]lZ_*Lq O&˾n~A;ME)w/k·I3E081b8ا]Psɼ\5aNMREm_G:bW մ1y3 {zK^sҾ=7bN28/I~k #ޅ`)Y[ %{1xZFE].Q+)k2ﱨ9hZp|O5x-B]om4c/ 6o!a]Y֪SrBB$LYxbW? Đa,)zɏ%xk9Ι@O2ZEdոb+EH sChn.2 zȷw}}M^s+!8lbЭ/Х/ 9R$E <q016a{dT&hQ&( mYhfhj34`c]39Ts뻎VX4,(ʃ$-=V0!(C~9 yf1{EsP$f1Yz<2G&0Ia s P+N{(OɠZ~N+!`WH0HM^s +H KN-{œԕ;ⓔ/Ak;_ {3EW_2xs{a$`9aNM:2,43%szaWV&Y{H؋^I^m^(49tuq1zyL)" yxnB1%hB3*+cVژjx-'f 9kbb2U#_)BRX'KF{>V'aRy'φ"웟%峆ߝ^X_ PQޣqM+,,Y[p/@2y051$+\=xkH;<\pmvh͒cWbZ|I̸ 7i]<c"5"põd'ߐlKt9evDfj֞;?b cCIm!E Lk *[yTHtCloQ1zI5<;ĩ>Zڛ1CYFu6i4]n\sZ'')RCkCSEQH0~2PREqmI&m Y?uIAGpxs!Y8ș[04c8VʊwRF!%\N6BQ nhw6dXZeuB)FhpaDRCR@Blv{H\LPAıdb]y,B# pm ?UďE`đ&FiMcZʂ6/ʔYRN–B>q~ېNx}ߊ m =k0bk8Ŷ +J(5C2rH:\pe@\?⇤ti@NA{笁I cǠ%꥙0 Xa gwxb'}l IcYA4:R6'Gp`4Ė{8td-Oah8ppBێИmrPd!{rkbbo<1i-͒SB<<7.l2|j?\)5˿%^c{h1aR# TV#QיЊ,oǛRI)S;'rɁatK0_9W" ҽ#0Vર,,MSԂ1Ih~q2O\( 4\b_H=\q=N!5bzv 9=\6IN}%* ]04R62*?2hDNs<%E(3"R#R "\) !k.,O#6F݇􁺧}Sð ` g04\KPY*ꈩ!qnuNhqYo̰ݧRjr KG6ǸrGcP Ik. kGlRtKIKECbƠEHp4:m e1iDpC*CRc1$ Wvp{Jbp%6kP!a:A=\`aJ}Q!߭̕~Q\T/ Z?>t ܟ0(!5ӿ0 "pRŠXΧ^FCԐc}KԆ8I&̇`Fcm: B ͯa,Ҁ/A7WUV#ʇNJ!1c0ѐ,x K\4ƌ,R#kmC!FAԖV`zCB=3N+ vpemDd`4ՠ0O77RR۰"KL'D%(J;<Vmܫa#ʈ! "42o{֡0ʼw|^FtOV|^ 3,ʆnCbA0{8 BDjDpBS#$8fyvI#Z롫0'<$fZC\U)Q!&zl=pV91qIc*0;S ڔw]43RH*F"~%d "Uw;cb6'^✴_Nah(p-U. .]CrU.l{1[F~}(5Kq !)i&S!a$Bc(Pew)eqC/$ل/p[6xH9d臀%9@Bhdp-BmX!M}oݡ:h悷 l߲ om<1 $bH^1FaXD )õ˃AOc7tx_+>#.zeC`ŠEHPz/%PR#nž )ET+OhH ΡQϓ4!^p aF R TR̦~'G3JV~,YØ&R%!bnr8)pJpx5EJ~0B!r *Xَ?eNP7W}3᭾&0"+%a`EH|M!oCyYX)|N_}YTCrOab#fI7PrͰK\6?$ i/ С5y ݷf 'L`Npcrvqabx3-B9CTCEhdp ^M6IhcqF{9ѧàeˉc|`EHPL},\Z<6Iϑa:=,>0IC`ŀEJ0:l|Z!6$$B#Ӗk>g0nNoqr?BJw:).m8(h+KM_+k-VR0+Sj㐫B0+-iV E) )߹>`5dXr[knw`AݸRTlliS8fLGQo$qGFwQo?~o_^Ͽ*xYv/|^c]_f۬ljQoN^~#+}|jX]f3 C/xT~EĖ_~ϟ~駯/~S6z7;~;,4tBG 3+/8~}@,8M'$x` Ys}^Obt~_Fd=෽c"n'endstream endobj 593 0 obj << /Filter /FlateDecode /Length 1209 >> stream xVrFr@1 RxE]r)cKA"A @Pd/t6x fׯ,1/~/ /Y2{ܵY$.俔".JQI%Y&cЎa;ⴾ@#'v={y|a56VH%6c{@I ڨTF\bԛ7&Pƙ%~y$TrGm2ʔ2[%%WWwS1E`*Vߗ|2/ǣ:6@{U*!w2m":ys˽=)Bk(H9P|Ƭpq0Kc07hX;3f*CK |kw69REG=m&80=pՂ`k87(nc U= qn@0uPg~LR-t /Mޏ&yV G}vyݯX:Z5:fuUT8{I|_Mh<j/n"lK!U?u NP?> stream x}Kmm2 =a**AjIv?*,$}n˒mYgo߯Mʏo~[\L7~T ſ>?ѷk쏯c㧯A}J/C??__}7G}}x֐g|ׇ֞{\|Co?os?~A[S}_/(>\s×o_~ (3 u+ɩ~㜳Ƈ͙|Mgm{xLF9%̥ώM tlԞ!=?~q3zoo& ܏=C(o_h=[O1~_ӏ߻?ɇ:xO?sNoN~8luRÓtcw {=dӭl9O)fg,rkz|Ll(Ҙ|k O81iP[/uf2 4՟^C{wKd=.-;iqZan7_kby~_WAHCA%Qf}1`MOpI CGRP&w*ik}5`&LBgnBLHB'E e<(^HDZύ-Rr?XGh#GhX%R3Z*i_#t Ė4stGj5Z }HSC-҇f?#Fa H0ighYiVH38XI&Z"/Qg'sr"ىԄndpB#dƎ|$RW'T]iԈFIo$YߒeEI.^Z̄ZHĐ؁ξ vFJȓ\~u]_E4WWX,{}$>??ߦBF$TZwc:~/Omึy!x-> wh,J@+.WW( ."ͷ_I(,N4"( -LW{tƟ_GR!4HsZ V{ZfJd!'^RVN2g2-Z.K\"0LaF:`Q,2P9)$dHiPGLbUvHJ $Cc / L]hD$/!&Җ6xvHBΓe:1D@-qF"V|by2Bܐ91REFaY{u'FBZ˲'HqJ \y{DvSݎ&"ϡMXRW@XH!~aMV@<:Oۏ)_۾&3ۿ|CQc(˓M/ ҄Jt 1Dg/Ԁ.OiT CTF`,E hH~XFL'9[Xj`5%d!Ȑ~&Ea._B1">I[ҷej#11mwA81b֎0,[r Y4St1^,G[Mpc#V.Hw:2JMyz^ڠR{RtC)v.k:RS)KjbwLp=q58`0FR<`\ɣ}a:#gySc쒵%nrJ2HL0c[Ŗ2 yZ _0Ɖ({UZ0hݟDqc,ձTƤajX821xOga6R3JKa,Uກ䱥R|JxXÒ},2^} sicVC?2J%Vʍ m9vy24%0Xh԰n@"2d2־>-yX {I5xLZcKDHH _ }8c7:p]S)UMHLsa'ac,7RV=v ˘pXa)DvwT  Da*%38Rc*ô.Y6l3$HO2K ul^ZӢą7<#FHDa4U.NnHsn,Ye`=Ǥ9 ժtW 96'C 2 GFՄ#:\82=L8E$Ŏ~]`^-B28;z:G+\X Jaͳ!X+-8](r IJ?r:3Kfq\X еc)fܶT >[HL߈ yY\;Ҕ 'jQfd6Z7K N@`9RQmj ;λ>MH̉ lG|p)q37;g ۜ )˪|p)"tp6 ` 9yHd#m@Z Htӏ&6sKA;ͱ8hDXӲ8"7EQ!ɲI<ш VC E-qS a1̈́؊!r3..]2g}ف d!kH=5TN)"e559mK2{چꈜX` #3DN @-K+dG{@]P!N CGi"Aی晐M [ՙ>(iuU|:0Y#.I($P5SDZC>p!&"BAxl0l5)nk%gG,~̕J56_fwDiLzW47:إIi6Vv^-bKf.b:cIhX\w.8P U_y@P*fFnԗ.Y XN7z!}SZheBP"#t 鉵ݓR[=^Z RxЖnTZ޵b7 R8yVy1w%nK5^4 dٝR(v;a*1V [Rc*Vi'7gG07LpYtZ~@:CfAZŭ7z_cQ2*1euLێ E 7Ldl S̓h`j]aܠt+74 ӹPX&+L(=q*Aev0J}'\໐LKHl= |Q9\&LdĹuji>Er02vko]%v>UJi_b#ŕST(Ww>8f8; -:H&ƻ"0y`%vA/tA!2$b^Tb* \JX2[FR`?Q MK&l2c׃Ѱ'2x0hX iHV\\φFZ5n+.N+ѻIwֳHozلIi9rnF <_WT %~I\if"Qyȅ 6х MS*8'mˢi$T3bU+W` ƭr6v;%5rn6r d~5Bce0j0(q.̺>Q;6Ɲ' %脲jS$#i ʜ)M9PߴRT[fe%\"vU8yZ9vm6e#dSf<MXH;*[&,XY+i2]eqڣ ;[8j$Aq$|L/2qI Rdx%q6I>dW]Z:ebe48N7v;O0$1,:sV LwlCS!)V:W֍*J.a+B2*RMq^k)}$Dw+=Q*A*MHtFb$>^cs 9&Qt9 a -nR/AnĀ1Fh\cHJ࿺rmHС{XKYp&1TMyܦKb—~`vh@C}솱a"U9+2$7L Mt #ݰ.\PL`1cIz8O0b\g݇=2,/&Y09tֳh Yv1ҍ==3߰Œv 8 -A/%+!iyX ĝܨl[Q,<\ްJlmgfx ]+1_0z@掺=R|r}}pCR/\8Lzgd$02w1t^Ot a$q0S)Qa:E{W0M҂{7z_>2`HCڪ<&wAڿ1m*Jn<6/`:#32F>l0ʲx@77&o?1M眦[)]BXwLY&Ӕhh.uy8y5\>89K&F+}դЌ.օ(k.| /5JISВTq2K /A>\lWϹ`2q>;˨K,uA,Eˍ  DTtRH R@a8Hв1m;=7.H^7 $7yKM8sˉ2BK:Lh#e0@?z0k^lH|HI..̌SS)ZyI.yz*{ziM0ԗ*8V;L 4onKfdyiĊ} I܆L`,5S}_%ؖNqT I|Z9Rvް3xo;hTbuz0MRA6uJy.{8Gc^,XMjl[FtnnJtb+Fj1]ck $=36KB,"zBp)SLVpWw}4pnl/Y*Dc/!,sjj˸V 6i:ٮQʲ,.[c8w ym4r6xZjX/׶43llXOݔB8m@ I"톭-#DMKC~YK59w%vQ&8NF ӺFqo禖`FEkep.uW;u) O;`K"*VB\%c5t.D^ ⾤A Zk2pS.3UºqG>*AODsR'S@UkD>w5AXzׄtkոnUV uNP=Zssmz_\uϔvPqBg0XvDSIqed -<'ى3` Gw B䂁1gj^9@H񻱄V2!_EHB1gvĜq:1B\"fBdzǦ 1!L&N|H71ّ0#8@#-#ay [ێ;rw 0pW[g_`z}A*2]r8ź].M\Rc)y0[Q /a,5h]+ZSyXJ{}TfJoF`*{ؾa*.6E7쒲*q?c}5.!s î+V L 4a,5l0Bgyvݛ $6K$ЁTJ|u>B~.W6 a*O0J ۼad)&.ڹú ű{ Rm/1=7Lێ1U\<7R87:ef0;P|~:~b-vIP ( LsWǖ4cPTYS]\)1&ƾ,Vʕ{?2JKq%aa,?en}s.}s cٍXϊuN.%܂N0bb7LV %ekwHePNyHۍ|\?6J {%5lps #Qo0z_>dK"$7=,tGunZ(.{Lm/'ߗ{Lu!ET3ϯ?_9ᏜdsʫFΏ%o'6bP0mi4sj##g]rr_0Wao$@ BI"~&)xO??%̿ O-/4ԟGYyk#'xTHXHHH(HiXfvV#eZ>~Kc߷ZpHiQ$svyjXNFMa_=ڽzA7 IY؟s4|5㪦>ʬӇf$:3f ;3ߋY3)>sg"6#'G)'T?~qT~%3,endstream endobj 595 0 obj << /Filter /FlateDecode /Length 1343 >> stream xWɎ6b:R @r$!ΡG͞eFmS6#y}h*Rェ"RiJoϫ]BOq 2eQTں<+&aֿMi ޒ4|vya%,а|:U|9I%ZxI`I)S S!cwrفnmn]ܼ>tu׮ʔƚxU?]v|7|SFP.6D>Eo90pRnl nėZk%MQXRR˰0K Q`.Flouv !EXt4Q5SZQ_ߍ>JS\AmÔRԻ"YXh4--SxJP9>MkJ&ńH-Q2?rwёKtr}lVEa90Ŝ[n%֔B9std+$G|sJ>k.c &-AU+JpE2Wa,6;Wq|zxEsxm;<@;PPQɀHty_}1-38pLU5#s De0@X:;A1c|n(CO?M0 <kJф M9\{(WN+511 (ֻXY-c|YE?PrZs"k" Qw}9 U'5`2F 2GA8_Ġh$CͶA+ܥk2v3QdXؓkv=C ;g령Sdg^}G i T9:S&/^䓽&B4CS+_~*Kw~'8B59~.6u4x.HqOTCJXŌW1}$i`-x0ÄE2&_l`O}Tr;A^%vsNI13lh!Rw6\T W2hgEM zj ,hvGc3\.q†ׁM>c`z*2\41QtR˚ uMZ .3f?9[ms۞j,& 7YՀH~K5R7ͮ34R1dz[׊<`U-o}Spe.qe3q[YsH bd@p4s8)(RnBNb%γOE)l%FYN3IBf \ LMFpef~ϡ[`cD/70D,:X@endstream endobj 596 0 obj << /Filter /FlateDecode /Length 275 >> stream x}Pn0 ! IY@NM#CӡqG);-2Gt&|nn EpR263iv7:4OB.¶C}Yx(BmES4í-<%Qh";ZQlm U_a<̽;ߎ_P~= LUB]YR30jKFr@4#-JDt,&i`F' )EXO eQ? }v,endstream endobj 597 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 493 >> stream xcd`ab`dd v 1207qtH3a]7,lTL)nn?J ~.(土[PZZZRYZ^ Aa```.d`bd0c/½߭~\hہ  pUwg${uCSuyfM6sVj,jlf~-'iUoVߌ.fvԚ .&={ݓ<+al{Z!~e?3~9hCgumcoVJݿ]rj3M6jr$yAyv;;ˣ)wO4eolkn6ye]sw-k]]S]Q?uDݳfL(o5ӫfVtwtwwtq< sbff?endstream endobj 598 0 obj << /Type /XRef /Length 307 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 599 /ID [<922e20445894ade890aa2651551d95d5>] >> stream xcb&F~0 $8JP?_ };(M!$z Q6Q=mhkF(67UicDOܠq4ml?Cj ;@$S f[,& ,"@$,ɾD OK`oAJ؜`r1Xl bo7lV[`vM ɸH2 Lv,]6',b"'lsk0{&شi`+ K!rd0/P~ R 6-L3 > endstream endobj startxref 429672 %%EOF sn/inst/doc/how_to_sample.pdf0000644000176200001440000010704113203254011015741 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 2132 /Filter /FlateDecode /N 37 /First 279 >> stream xY[s۶~?oM't2K'cWrd:y-XITD:u- J(Lꇎ `K0Ŵ`!q4f$f ÄL*` ZcX Gɤ401Lm2#Y(B|OXDX)LL D%ēi#5!֓(3bF࣌Q bԄF02('>b `&d& SdILЎX¶2e !>k\~[Ə?GK7xa2g'iiٳd "!H</. ~D,>6bo-x^,nټd )~]1JȆ $f!Mz@[=mJ;+M?RfQbE'EtaݒntثAd/E~;%(ر%H|YbbN?8c`V׫USºi8]vqtyϧ Sf0HlQ4IbCޥ07[x+~lX 6ZaPt7"qO(HN͠ c V0d6 D+Z#xL1 >bc`& aVy 3z"Ļ"Ѕ9F0 7@а;K n5Tdpb9wP4핻4[w6K8M#~Ox7-?9}>}:M[s;Řۙ{ _-Yx'|g|,y'o Gf_mA /yi0-x ;joZ ZDZ` % @?'i }o a*% |'@SrS-i <%(y: ѿ(( Q ֏iS/d%~@pPC  ԀvidxK5 NlWCK^A7-eŝ24WT]om^n3wq}matRC {.vV3]Fʍ>ظ#ʨ '|bc$-υ'.@^:ݴpBZGŏ-Ň?Oka( E3?P3z|buucYDZZ!S IԠBB?K-g)ACBkE(7G@=X'X"~ L]cɚADK"ԛN;DLJ[|]{,-l v(uJtgުn4NS=l\?8壔CP[R[+Rf6E|Jv^==Te8 2h%8IgU>3Z:XUo1%2KBcF8%$tk(3T z6,ǁN/PjU-$f·Qvf.U%M|F4 J܈D&*[o'8o*x4źT?bJC:\{r }PTsFv}0$Ot0XuCck> stream 2017-11-16T10:19:05+01:00 2017-11-16T10:19:05+01:00 TeX Untitled endstream endobj 40 0 obj << /Filter /FlateDecode /Length 2736 >> stream xYnheD XLva&jڭZH&/!%%$EŪbZeXeZǫluJǕWW?n`Y2W+^(V֤U+mu%OkYe2]$c?.Er7{4ˊd'O16-& UmihnSw6cTZL UZTJ[6[Ps"Dr ژ29Ut^o|r;unz=h?,qlA^HmQbB4ϋ4TE!Xwb>ڦkHZڬB67,^giKc2wڸSǝ]iNz&| 4.ž ^Oqukg'M_7Ep-6Zjh)p+YZip׉<0y"̴ _0-;DqӀ7r$L哐ܿ\Fakw;17(_/άhL:7+sK>8 MwLF %)JR6O~\[﫦]q U;b6q L@[j$E'w}'P뵂+:,ɶ_6)V&C5O F@j .# )QLῃ R<;GVR}"~W"-F0S7 y}F\a0A aC5T{7C#VC::ٹW*a@7wLsݱ 7#7Mȫu JGfJS@А1!7~y[U<]*lonڪv|)OvɖC&5 7;7LAAu Gdu?Dk#cRD0T! ! Xo<X vJU\eroCUυfP r! 媾Gb{ͮJowa\?';v[7|zd[ܞ(rmBl[br:7Tm&1m3=.Ƚum$Qf* $1ICJ|&2 $&W&+ܳX'~x60Su\w{jdJ)[D$Oo8y7 )`LDmYJo 1;6X6_>XL S a7=/72 T$ LK+c#2> 9)Mja* /G&WhNE 6i/w6?,'o]76S̵LQCJre:a)Ũ:/13靄0:89UҐ#z%ϠAuMO(RiuUi~XvgdzoqT_`aj3`TUA;b_Ĩr ,dUqzö"uԻ0KmZ-xm5löi }q7sf Ѽ/bI&.-m o ĚqmU[bҜ Jf{-Ш$T p?q0\al j?Dx~w27)_NRA)BD3/.NH5/fB=6H]?30In:%c~_/{t-_d낄hošegREfÍ,ۈļBF^{/ZWfO-'UNHتK4"7ѹ pI@ۇqɶ,s&fe٬er޹>$!ۥ}4@ׂjUХDj52Chl~=5I?T|)>jG/8,6_ 'r,"1k EK> stream xuWXT׶>p d:(Bb7 J&X0HiPQi"ETTDDM[g1Iᄐo)k_BDQ݂C=WncPƉCP#ZMOV.cjjb4B19A_2`(jH*pgDwŋBaa}B=vo_op7_ﯯ/D?##xCU OP70-EQV(Vڹ:(xmHYunGoaaimc!q^& ?Zxig,9d4mF5&SʆJRvtj#eOͤY#e@9Q+)gjZMR.j.2>Qf95ZG-LBjeI-$!JJxJҥPc)=j5b)JSèj$IRZ JZMJAi[ϊLD rJ%7ii(43i:~eN"։-gΕ:|Kæ G#Gf|iYA+KS(Q-~ѶЮ~!tIYFktXS(TJQ-x6yx41T)x;&N캔}w]l!ײV8AΓq 0mT)HK;%ozWWZ_KJd6 غ2?Rs(Dڋ\ګ/`r`S+ƜIO57 G׺_˕ywzUE'}_Y;$z0de;n'~7t.ԝYi MXQ #KnJ{!B!Pc_zd9[0xk\U%y_7` <5K2G ƒ)/oĠF?i_4%x1mf ܔ:a2;8+ C7rxO?,ldZ{*YZOxCY}c @EJHe%I+&_ɬQU6U|ŕ=av۝8iUÆ Hcl%-CR e2Nk*c4/L݄Z n֑j8+G"9⽛ab5J*Q-}^# 1Ӟ`SML S_♉n ̧JIrfl=FxGr:JT/Lhy'p୫ ѽh~0~ HgQL\^ej Zcat@;/\ՀX53o8bہDl-|Fl 5lnxdm :#YW_#tF]Ec?J9ٴLŸ 4 q7I/]5>gNW'Hxl H$J7{>ѕftվC&&+=Cb7 /ysd̓P„Vq+5$YA{6)arso#{7r#_ "l-U]0^T> m=Ý7%d90Ii8:΁XfMxz sv^ 1qs񵫷UuI"ڏIāQ-BW0D7AlyCXD~*0o xC?]l[N'@m%&9*b 4Xs:rMO"zUT2T 7b=}[p.j̩Y'I̯h3p^r@dѴ߭ax&x_Q;r4Oa467rxEKkD\A:0+`ٸZR 8= +զZp ceZh)GA(*9H '}Xw }]X".˯CUc)k5泴RQ N:y!_9|z^WXC&|b/Vl{W=5 mr%/Ec7](# c;kQ&*mRg@xZ=a.P8lWU@CՐYJD9npBPu Q!*w=Te/=zDgW}7eu*zBHnz /muc xjBzXfJ'/(TpY٩S~8,AKJ4LJf "-a?$q%xazYWZ|#oK^v!JQ,\oO 23Á&"Lmf-kAT 4$fϐ< 1 ߗ^\ޣW6aα)x5$zK5:l=Gc-y0+uhVqfY"ecGߣ%S{@祒4w\%xM/?AR9R/3:Ă3XtG&waT_ bq7`#ϥ ⃆zbnuLlA1_ Q:] ,.//$ cGEB&fL%7c8-R'"Kn)8`¼3@6xvTJlDg;y{<5n3Q=kRDyZ+} !VHH8M5쬔㙲ْ%d7#"x|=+Ma&b*½K}/tK}|҅G`m3sc~8Xz.9.wsKS~|QQvMޗ)`Hx!nC}XJV<-L"@ J,W8ia! #.5XPQf/[\|uٜ0}>!a.ݛE?"[r|n,8C{LeXۅ0¥SWe[1;k>6\i8^~\Rq<ށ^^gv37a)1iی䐱sNS1 Ykl## =޲կ]Զ8|—X=zͻ&Nd\3[d҃ݷZ/g&yZޙ յQߝk>}-cD8Wsw'x6Vzg"vm۷vBcM,Z[*IK8)*%,[ewկ+$/69xM6Lʜv  p^%H"Hh#mIrgd0Bq0E}P˃Vˍ.ml7?tDVϛm2i-49W\ZvTiYP?RQ !mx4 ZIʑÕyc2^[@»j|YS/b}w|qzf*J O4׍eQf +YA3>)Qt/k1щKT30LJUuT ӾL_L%j0q# AᤆpRT=!a P2B6]Wcɢi2d̡Tt[sj^5jb(UͨsA8Ka2L'As@']5^\7MSuz fT62Xغa)endstream endobj 42 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1675 >> stream x}P8xvQt]iS3m h+LRAyix~{rw=~w'!i2jRj$I6Ny2mPigg?g7|~ "?P(vl޲iST'UB#wVJE]W)Zb *[,FDBQ]-mZ#j5\ڤm N _Qm>Q(AOwF{nbx@2AFECysjCW -4 ? D7f%Iit`z*Vӽ@gLϔeguNE@&֣*_ 1HMXדr.fd8eZe`,ڒE7f֨<q2գ;>yO3=vOq5*9fd}e9v?oYv<$;B&zdmVG]&ͦC`?6?Z90`Xw'Y{Ys:'!pǑX\5qS SEO/J4$l /v lj!Je>g&@=HE҂-fbo {#0Lelf'h74t{51R ]Fl4rhTD|Oԅ[\k#vZ{ Oi9-uf^ &sI~G!eW z0*~Ps+T8&.!~E6Ru߱56U'xI8~z<<Bj VZcR|K)}]MiE>%gm޺}:G\-pK,3܉c&};T͈}A+4L.jY~f@ ۾};[|9dd$sd3nm^3xw.V731xOu!l&?dKfKB9ߥ+4~Tk.$&b\ftT:)U?!M|c$]1 Xbq#AO#YZ<29D.m|罤lD_*P1:H%[fE0?݈V׃#l;q6ElU'`嵮y;IG_-ÝyX}1NӲvgQ3G=VYr-ƨyYFUG-,scM%.}╤>f}n ux XXtVc_@$av9hCӥ g38~1C.]OrȒɤq1cS`H" %58 Xn^'UySO9PJ$%r ؼ ˆt`ZTt;GP]<@rT1551p( TjPhm@%ZVm|2&Icڔxߒ}'{X[<=~fIiT ^U|>ZR5b˫/ Uq(l ]qy%B\UHf/endstream endobj 43 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 444 >> stream x}P=SAɗ YWQV4re3hȮ6Hb7ɻI_ބybb6bEk[JK,l.=J2)B)-6svuC=Cٔ->l,_-{s@M!m 7v總dWc$X]7h%t5.Bzzj|D*=aKȾL_ z"RPGr^ ]@b;Dd>| B sF<,%PK+c0*,D=$B["C` (Djݯy:e!;݋f_s@IQyG能6qgڮڭ8?ڻtٓl-o4]7ߛ_ͧD/1v_d}{7k&ܛ#s [QB20endstream endobj 44 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5523 >> stream xX tն*fIVI@9(D 2d$zܝ3f@KA s@>mW# ZuJu:s>tֳ{FMgd2Gt+J}דӟ2yg~b=NǰiiY/*)*6 _Xxx.SIX]`6dViY9/X/l\h混/ٺ4cƎ?鉓L}_9 rgR,[-V`3U,l56^bװX66[a EXc\l6ccObFc>Xl6Ώ&1G P?//Z{e}}WOܿo f>p@c;?hŠdӛcc܃CnhPi_=zb?M ؙX֑/Kr.ד*FRpD%1s%ifd FSUp, !W)(7ުoIVH*c4Wܑ`%;x7]A~>~ x5~Ϧ[\xKA Oa?HyXtd.mJ~5ʄ_?>~e'z|OQ%Dځ ܭVWH5>ʾX:҉Y+69 zZt{;й_no>|Z9m^C`/1Oē o jԖrӹ[!\Wxxco› $$o4c.$؁k׈ hhbf.>s]nW0-)Ƿ˼qFNMERPG'#(HM}NS Un}=h6o军u7oZ=VC6q;Vxh?.)E*unYbbF:0ip8MˈљUVE5ԸTQufѾE*- /3avܞGD31Ns|:IBxqʏOv^><bbjPihVcf aYLop6w+67l3¨W*z1LƠScE*O0vўah[5CDڭJ e}U#FTojQ/0x\\T1a*كR0VHN%scZfbA JdBE.PaF 8Y&_q<41E gpNTMlHu0mcq֫" >F6X6nK>RBS( (]9_(ݥT#-&w {'H^o UI=O)su**ГwvN=!^6 }`/ܑ)گ| JEH}48.#xuU!ӹ߹&>e hK]^_ɈQRM&ysвYmR#~;l+0ɸhL@dJ!b[휄.jSrHWUpw7^QC_U+Jh6h3Va_V4ޱoo@G4nTt땢5|#1seɑ{*xOE/o?_|G+MF%un#[Ʌ/wJZQj;$~$\w&h8)L}'r5R@[/_',,G\ {N9 H}&Rwő=09RW/nPP`j:.' AgyťTEeEHq5`RYig(k<@jP\W#l5hf'Q#[v0ĎT suh("8z9oR7._r?2x⑙o$8.;Yy0'ٌ,< 7yp; l*v>}yrd8* $>7p;pu<) -&kα9rɨ/8AY03# __tmNnڽ#?pedR{ ڈ:PkQ ֡2eL|1cnlaTUhBU7v24šxCh +2KrP$jiȁ:.)GkkbsZXѫ`ztj= N}r8NFzyM=<}zO6-%@6ZBA *P"Qy;TBf,ʥU_ NiT5D05I=EG7Ab}:K}2.8$FX "()g5#$pbyqPq{%.kKU{Mj*a$DjT 4јUNdPQ%v%2 Gn|,F|n=cwRP#d(N@^=`温Kmk(v8> %&{\NݸQ)=c:DcW`i^os_pCFF%]kbKWٌv9|b waܥ<\ qOgϷR*buuȨ atVPo;້gww9q੟fܭ ]ϰ'b^FsTL˅fGQj|ٷ `^D.'jyʵ#gϝ4Gio3n+rsN̕^޲ {jҜ]4wpw3ޘyGqob\A$8͋9E2mA3q9=F Nh09\D(ECѐR[%T^Qx4uM$sj-HuQOmMO"'i.eR#F5<#Akepp| -9l+X+B-?/ql&E TXr2":>΀ά.Hʑrġءu pCs&.n!~T( &2{C\P x>͙ W^_qcWUA篊R9{7Ld7rr%mhQ~O(ʠa%eHٗRV$\Xº&ʁ >QZ_@=Paf킻S1B\vd ;mes>q\::3,8/\iߖ67sX_ag!] p3}kq:,3ػ0ʟ\փgӞ1@)\;MPy3]pgv>R}=ư_Xendstream endobj 45 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2650 >> stream xeViTTW~\Q\[A N (jVdo6DmZ@\YD c*$h$3$grΜέU_}0CDbf:Ne6IC l6QAncd¹`ãm6dX$pNWuⶤd f*6+) )qc"UTuFe6KlȰx媄GҸ8feRȤ-*G:!*V??Us?+0ԉIWlI p߮5ɑa</ƛYͬa|g\Wf27f3qb>d1cX3KfŊ`ӒI4Cf )u`O,XTq<;6.ЯA*3Hph6|m)ߠ3E' ajMRBڴ.v7#B%6sF2@d9[E\'?ӫ9T.Nn4 g(Ȭɓ#qxa/` 8M}F+rd7[&m0d7n*wDK:@<H!ƏWE2Z>O+`:S`ޫ0O&K Ru-ye>CTw Z=dS=d as֟@m3,?V~8|tŕIB_ 򔢔l g OV[7{r *~fTVgtv] ` o0VTjuaX|5+jc&Xu$;R~0K<3܇}qX\>qJmٽ WTb"S`h;KøH$F6.5BزuNԭ+pǑFS#k8Cѣ4ZoDfxu9#@&]#jjj5Q+Ow>X,gWX}GY ͼȩ ۪ʭ׀w3Zk櫸"Iw1s:;iۦwp>+-l5 dʆ9+yX"ur-'i O @sQqkgn;z>a8` ^0^t2BمZ'D$=O4 Ɲ GƶKX o䒬؇7A|F$cz$eȗ)BoFWE<"%`_vtT7ZR7fnBUS";0lMTcY՟*#SsߔޏKܵUK >d}Z΢ߖZtT_ =(Px23p^}(1QRYQ,קb&Jߍ}(&G=_[{;adӻ0Jy}BaxU V1H5ix A3825f }eY**^] &38) Dwp5H]'f.qDE϶؈y>#ҝrQʵ (5tbړy<)'E.vBc!hۯy(0no"&*\b{`zb5xO:5!ۘE5<ˬxV01 a4+Hw6?,Lq(ӣx\ qv jg7L'?7*CNlHFV{6^4ads(#n-Lh,U-J k"cMg]Z]t3Gpp>;JT*x`M*Օj:M #ߴk}Hۡ;蹗n~dO e]٠=;j (BzWV?-ֆ>^OPsYKtngH>{8&2C>G?m Z0?L@7 %]j=YYxАSNhn?WJՌwp&ji3Zm-28w6)e[l`eWu%Z _1@w%v3;W**  Uȧg$8+[msdqJ{Acq5't{E̱.|Wx:ؒsVF&,?P&4CX|_8/Sj+J`ɷ\>X?I4}tlޤZu׋nK~}:?Zi"I YYhLLpH}yçC! L^yƨ}H3!xendstream endobj 46 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 652 >> stream x}_LRa" RpV[\Y.Ѷc$HȖLAB+) D1Ey8+Vj7{"?uf4kmAi`M#l˚jyT9!@,Ui}Et%0BrC%?Q) wPZM++p jZqS'9c}H[,)`b="Dw)~owQ@-g'PǀZr+ (qvtq= <:Rqе^ 6{Z{3׶"5a T%ilkZA e*0auJ lRϽHEV 9wb /n]&,endstream endobj 47 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2751 >> stream xeVyTSWԦUJĥSZZъ"&REk$YH DSkq+Πi;ޛyqf^3s;|ñy6\B]0䀣6hg{2];[.X 5.]] C\S#[nE2R<*GEq] "Q*œDK${rQX.NL;\db":T ,1 sX*W(&y{b%uN|0, aA,ۅƜ=zsÜya\ul)6z_mVۤekkho;g`Fo7[ykjB (_? ?/'=3QKDB9~\4>E&}E3K %|1D"0ce1CN¿v+8R+d#g0a}A;Pf:&ި)m.3e?3c;N x @#J}dC6o~ Ȅ.GܾZ)P> Zͬ#F뿄c!Zrb@; P&aaS7k /$uziest B#\ƖW` ٙ'+3EL+%}ԞL0,'r: `ܘqJ{捽 ׍YD{.j98ȉuwR`S;34~eT qPH7&W\թVk=rS h U6y}^ALJ1Cp--1Azk hᙊZ@m<$}=!&\\a Rq):AqB>0YŜbXna:MOYFeY,9-\t6Qeٵ@#u)V&\B1 S\G+{a`{ozAqfY'#'QxC7yOhXMA 8i`ifm{MqcIW0yC~1>;AO?QĜy0s:2Cdniq{,k[d\B2cE=2}zeA#9V 񩫀6($Eyht~~a }b6hw{vI7pNuEuŵCs$ j.F4 Pno 2^7 WFuoK:*o*OeS3%墮iTgs!e.R%Meza\.^BgGN5j\W6jî8}ι;ꪗ: MҬ 0x,WIEP1#,-%tUAJ[g΍/~v`Vo 5EE5W`YYH%¾K ]Çi Ɓ<\.*NZOdd&Ǭe R,&iچ$[hIZJxgv,p~{A@Gm NǜO+#"+łJHAd |E2qSC,: 7h_w' jAPZm(.dm?>sn G2i|Z&rGLj EdUF1FlUCG -;sf6l>b4€f'akOs;ʯ6]gArZa+w;3nߣih: o"'+'=gRw(JY^cQeyA&?U>qu[-W:2O#Ee%ͧz\~7$\]ރU\$V|[,ka v6CVYP A4|:867~g24xҫvPKR߮(*o!6XǮI5LI;hFz&5]{s{. n-0 <էT57Y2:\pf ɋI';x}VJGP ; Gendstream endobj 48 0 obj << /Filter /FlateDecode /Length 2891 >> stream xZݎz9OaM5Z$QM@hbfŦ@d(%$E_燔(P̅)9[%X%~'_}7n5Ou\: UV\'ruwyk(v˘MEu$QQy:uajHڛd;muy)Mto^3JUy"gʥUhc]DTm' $qcGki0.r }y)uylH*=糂3qjt!ҥuhIZe<*c9T5:6-UoYG xУfw|E-J>8t}^ҳqy\~n/p]4l2I,F(D۶n.<C]JM"8}ׂVjڔG{xr< AiC /E*T۪.,EdHU0,^z3g}I )kGr- x gdv~Ю ẀV-vwڏdS^Le8@;T=s&y&-cInCnOߵ4229_O&=b|i%ka<+`&Z<ɗ=D#e}нpٱ;G2 7V"!_sf s_%kkD{05VeaE=*࠲xFʹ_S8nω ÁS2 \. "/R`ݔIF=ddLr~#?+7[7NpJËSnoE@~ls} gҋS}O1!=to4T[j]c!946EQcz_3u.sw+ VOO:/ /Z,]ҟ@Z &u [~wY?)~ 1Oo"X{?J DiF>mPq` "R1$9i)ViN.vr!x9m6ri_ZSLy]]&;dx՜_`9xv`:H+ٿ4"`!*xJendstream endobj 49 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1154 >> stream x}SlSU+h0se(B1ӘT[nm_y[) nls0c`R(ApNDPI8 Ay% 29r^amex/TpzCHAӌ4M!* ͖6.JEڅ\$J:Uљz/i}]{;tv #7K)[BTEh:[m[ 9ꎞUr0Y ؖ+q°W?HN??nW7KïYBʈp|Kgua!{rtuP)qL:s+-!,6ϡytK%V 31/ϯk m^oZowֽELG{G{JA\OslڢrlQ\a@ "c҄y+hrVb2x%n:_=naaqp65utaR1'=}a_׸z93G[}Z%@ PA-S\Eh>SYV|}S)sC.ҎAM<ļteg$cBi51Jendstream endobj 50 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 236 >> stream xcd`ab`ddu/-L-M, M)If!COᬲ Nb6|<<,˾ }]^Q9(3=DXH(%c)8C,,3##~|V(wgʚ_=bw=+W؏rb66<:u-/EWuendstream endobj 51 0 obj << /Filter /FlateDecode /Length 3477 >> stream xZ_ܶxbV[ܪHQR]pmi]:-oOVZKOՏؙ!)R{Ҥ@qGIpf8~3O(dpվVO>̿&0o2ZکEHYiĥ@+23<)qJC Hka=>XSx]irRKÉwĔqC /bFG۰$\$jIx3f28 ,7>hwRb׏5PVE_]61B@bdȣY\ [>2fS Ɖ-Lޟl3@q4kUPpʡ*2:&} SN m1GhЀcA3eB݌Ol .9 {@#`* صew+|ڟ:{̞RfN)Nr:_|JV>?.ꪩ"s~XR]uO"82edj֏Ɖ')(uaq&9M*2"tת!rYnv؉9k^v>="GƠyb@cNy*WÈ~*_(}DH;aս8ڽ?Ƌ篸|vC1~_mrޝ#aPMpj)@`Ќ.#rZ0."(Ej[QŨ' _3b12շv4~& n4˪ n`6%@Ab2}g= OsVKnγ a3aXafRAQ<-wmɧqFWǡoYڲW/0i{D:Be{8ŚTJFIfyR 7q3X<3# 1ѩv/d˝qف:X{G֜;5%_ 9#dS+d Hɠn{ӛB{k9Cgc\'0LeXcD1^8gS?B{d{pWl;KsLn<@6#&䏛qMИp}G;E}!M"E*97tnp`vh">  RvqY fRa':eQ+CƏ8Txʵ/' --,QlVmvFwr;!Yѳ^7T}wj@T;AR9\w4'?u;H5eqOu1hhN)%^ĉ0Q5>jx#K&;"pj,MϢC[;i*iôCI v.mǐ.Kc@̙J9Ѐ}BT&pwH3$4*\UUo,@_Ÿ9+"~OK77@Ryvw "3^K > ].xa MKJRװU,3`r8Oֻ}Bֽ; U1xot9Ѿ*=Dg1HMYf接Z\98h5䋯^ uf_hI|{m$V^t{BA hbs|6by?k0h_2Oo OCec`W@, ,'c" endstream endobj 52 0 obj << /Filter /FlateDecode /Length 1676 >> stream xW͎6)\J6+ahnd{\,9AEml |g8~S|f|38#|+w+P0 /$L<)W{dֺMZUo0LjLQA?պ G^TPMg:,c=C ڄ#/[lvt[zx5gmև7 eUѰ;][I g\h8傳3h**g>U!ZrI5Е؃YWXJy](y`Mg2u׏uKhGL֡AڍZkݍGw+=>ǁbBJhR&N@Y&g8a_eٞ3D֩l3wXZ>>e˂ן?+` !~!Tv0ɂμ7VGN(ʟ qa"|ѽ{ 4SB\ia$wz޺пojK஀4}_ %C{ma2Txp ^ 7+1wɃ׵焆~)c`׀LPdmѳQKFr_T r٘J=T@VD;j{เ,9gYNv,D8f1!{L#{[!"wo?4@"7N7Mc`.> /W [ 1 2 1 ] /Info 3 0 R /Root 2 0 R /Size 54 /ID [<29d900200cb96545e36789ca8e14db01>] >> stream xcb&F~ cjwؚ $DkS $ $ނ$ f$$X { W^ endstream endobj startxref 36035 %%EOF sn/NAMESPACE0000644000176200001440000000462613047124523012122 0ustar liggesusers importFrom("stats", ".getXlevels", "as.formula", "contrasts", "cov2cor", "dcauchy", "dchisq", "dnorm", "dt", "integrate", "is.empty.model", "lm.wfit", "model.matrix", "model.offset", "model.response", "model.weights", "optimize", "pf", "pnorm", "printCoefmat", "pt", "qchisq", "qf", "qnorm", "qt", "quantile", "rchisq", "resid", "rnorm", "runif", "uniroot", "var", "residuals", "fitted", "weights", "optim", "nlminb", "splinefun", "delete.response", "model.frame", "na.pass", "terms", "dbeta", "dlogis", "dunif", "pbeta", "pcauchy", "plogis", "punif", "rbeta", "rcauchy", "rlogis", "rt") importFrom("graphics", "plot", "Axis", "abline", "axis", "box", "boxplot", "contour", "hist", "lines", "mtext", "panel.smooth", "par", "points", "rug", "strheight", "text", "title") importFrom("grDevices", "dev.interactive", "devAskNewPage", "extendrange", "contourLines") importFrom("utils", "packageDescription") importFrom("mnormt", dmnorm, pmnorm, rmnorm, dmt, pmt, rmt, pd.solve) importFrom("numDeriv", grad, hessian) import("methods") import("stats4") S3method(weights, selm) S3method(weights, mselm) S3method(coef, selm) S3method(coef, mselm) S3method(plot, selm) S3method(plot, mselm) S3method(fitted, selm) S3method(fitted, mselm) S3method(residuals, selm) S3method(residuals, mselm) S3method(profile, selm) S3method(confint, selm) S3method(predict, selm) S3method(sd, default) export( T.Owen, zeta, sn.cumulants, st.cumulants, dsn, psn, qsn, rsn, dst, pst, qst, rst, dsc, psc, qsc, rsc, dmsn, pmsn, rmsn, dmst, pmst, rmst, dmsc, pmsc, rmsc, makeSECdistr, modeSECdistr, marginalSECdistr, affineTransSECdistr, conditionalSECdistr, dp2cp, cp2dp, dp2op, op2dp, sn.infoUv, sn.infoMv, st.infoUv, st.infoMv, selm, MPpenalty, Qpenalty, extractSECdistr, selm.fit, sn.mple, st.mple, msn.mle, msn.mple, mst.mple, vech, vech2mat, duplicationMatrix, coef.selm, plot.selm, residuals.selm, fitted.selm, coef.mselm, plot.mselm, residuals.mselm, fitted.mselm, profile.selm, confint.selm, predict.selm, sd.default, sd, dSymmModulated, rSymmModulated, dmSymmModulated, rmSymmModulated, plot2D.SymmModulated ) exportMethods("show", "plot", "summary", "coef", "logLik", "residuals", "fitted", "mean", "vcov", "sd", "profile", "confint", "predict") exportClasses("SECdistrUv", "SECdistrMv", "summary.SECdistrUv", "summary.SECdistrMv", "selm", "mselm", "summary.selm", "summary.mselm") sn/NEWS0000644000176200001440000001270613205231441011372 0ustar liggesusersR package 'sn' - NEWS (ChangeLog) file -------------------------------------- Version 1.5-1 (2017-11-22) More extensive documentation: (a) addition of 'overview' entry in standard documentation, (2) in directory 'doc', inclusion of a PDF file providing a tutorial introduction to the package, (3) additions and improvements at various places in Rd files. Fix a minor bug in sn.infoUv causing crash when the DP information matrix is not invertible. Improved numerical inversion of st.cp2dp in extreme situations. Version 1.5-0 (2017-02-09) New functions for symmetry-modulated (AKA skew-symmetric) distributions are introduced: {d,r}[m]SymmModulated and its bivariate density plotting. Fix a bug in dsn affecting the cases (a) x=Inf, alpha=0, and (b) omega<=0. Version 1.4-0 (2016-06-30) Introduce methods confint and predict for selm-class objects. Fix bug in rmst causing some dependence among subsequent samples; fix bug of modeSECdistrMv affecting certain ST cases; plot.SECdistrBv allows to overlap plots; improved naming of output; profile.selm can now be called with vector(s) param.values of length 1. Version 1.3-0 (2015-11-11) Method profile.selm is introduced. The object returned by plot.SECdistrMv now includes the coordinates of the contour curves. Fixes a bug affecting rmsn when called using dp= and dp[[1]] is named beta instead of xi. Version 1.2-5 (2015-09-25) Not released Version 1.2-4 (2015-08-25) Output of plot.SECdistr is better structured and documented. In pmst, handling of case nu=Inf required a fix. Corrected a bug of internal function msn.dp2dp when called with aux=TRUE and d=1; this affected rmsn and rmst if d=1. Version 1.2-3 (2015-07-14) Fixed a bug in evaluation of the feasible CP parameter space of univariate ST. Fixed a bug which crashed pmst when called with fractional degrees of freedom. Functions dmsn, pmsn and dmst now expand a single value supplied as 'xi' into a vector or matrix of suitable dimension. Version 1.2-2 (2015-06-05) Fixed a bug in extractSECdistr from mselm-class objects. Fixed a bug that prevented calling low level fitting functions with non-null 'penalty' argument. Improved documentation of selm.fit and related functions. Version 1.2-1 (2015-04-28) Optimization parameters are now passed from selm to sn.mple and st.mple as indicated in the documentation. Plotting of selm-class and mselm-class objects avoids clash of par('cex') parameters. Computation of sn.infoMv now takes into account whether method="MPLE" was used at the estimation stage. Version 1.2-0 (2015-03-24) Created new functions extractSECdistr and modeSECdistr; new methods mean and sd for class SECdistrUv and new methods mean and vcov for class SECdistrMv. Computation of qst switches to qsn if nu>1e4, instead of nu=Inf as before. Fixed a bug in st.pdev.hessian (correction in args sequence). Improved detection of singular distributions in selm output. Improved handling of component names of SECdistr. Version 1.1-2 (2014-11-30) Fixed a bug affecting plotting of mselm-class objects under certain circumstances. Fixed a bug affecting function selm when the weights argument contained some 0's. Improved coding in some functions. More functions are exported and their documentation added. Version 1.1-1 (2014-10-30) Function qsn has an additional argument 'solver'. Functions pmsn and pmst can now be called with argument 'xi' of matrix type. More functions are now exported in NAMESPACE. Fixed a bug about selm.control argument of selm.fit. Improved documentation of various functions. Version 1.1-0 (2014-08-06) Main few feature is the possibility to set the constraint alpha=0 in function selm and in lower level fitting functions. Other additions or changes are: introduction of OP parameterization; fix a bug in qst; more efficient coding of dmsn and dmst; pmsn can now be called with argument 'x' of matrix type; in pst and qst, new argument method allows to select the algorithm employed. More detailed documentation of pst and other functions and methods. Version 1.0-0 (2014-01-06) This is a major upgrade of the package, with much of the code completely new or largely re-written, leading to changes in the syntax and the user interface. The key new functions are selm and makeSECdistr, with various related functions and methods. S4 methods are adopted. Many existing functions are updated, a few are dropped; see help(SN) for more information. (Development of "version 1" is started in June 2007.) ------------------------------------------------------------------------------ Version 0.4-1 to 0.4-18 (2007-2013) Various minor adjustments, many of them to fulfill CRAN programming standards Version 0.4-0 (2006-04-11) Several changes and additions are included: - many routines allow use of composite parameter 'dp' - multivariate normal and t probabilities are now computed by 'mnormt' - use of NAMESPACE introduced - some more routines introduced, eg. st.cumulants.inversion - various fixes/improvements in documentation Version 0.3x (2003--2005) Added some new functions (these include msn.affine, sn.mmle, sn.Einfo, sn.mle.grouped), fix various errors, and other improvements (eg. improved pst) Version 0.30 (2002-06-15) The main change is the addition of routines for (multivariate) skew-t distribution; also some other routines, e.g. mle for grouped data Version 0.22.2 (2002-01-05) Fix error in sn.dev.gh, improved qsn Version 0.22.1 (2001-05-17) Version 0.20 (Oct.1998): This is the first public release and distribution via WWW sn/data/0000755000176200001440000000000013205231511011574 5ustar liggesuserssn/data/frontier.rda0000644000176200001440000000072013205231511014113 0ustar liggesusers r0b```b`fff`b2Y# 'H++L-~[o.'߷e?{ƁYTՍ{km^_WBs.N{yׁ#mLg}뾲[,#vNYgjb`5 OhʷmU_cUH>FJ}U<_~]k/ K%wI){/Wy;*Rxʔ8.7C~T>: GT*[vA+Θo^H+ e`oƟz} y+JgR&)eUķNtz~*_>C/؝u%a\)~\w:7ەG>5Jyn{֩ߜ%Okuvq }Ntg  rO]+Lͳ~W/9f>~WV|w߅^=c$r}:]TUNC{C9K=~R~hGSs/L}R[V NWtB,FMT]DKMw㙨x_p!7kj'i}\1VkRkW)/Z(UmO6=.x]S=:0ѓ(H T^(%ߴ%NkRMtX-p̗5U?W{lr}&](}5/$N.M$-|_=!z$Pc{\| kysAO\xχ}حEr,]GxS/ȃx ʷ w ~ m?=vZ>[$Byl~Rg/U~Ԇ}N[T=.,Ţ<=PziUj?d/ULU/Znbʋޢ7k7FEg1UMjZmg7 6-%oSQBg}Yv]=lsN@W%z9yIs?PN!Rtg蝼R I ua rj}Od)}E {AtgGxO,&dǠvQЕ_J(GBEj#%> yz?Jrz 2%ɛ%rKgG~ɾ]ğ4D?7iKj KKM}N/{_4 ?V%Tpv)T3W{ZzFtPM <'׼aP#էo?}~wA?˯?Е}1J==?H(>(8؇~cuّu|# 9N:{N~`I"9{/(_zwiǾG>a W<>BAp1_9G0=as^z@~֣ce|_ΨoW؃vzRlOsg%?~^A3n݄qy( zξSay+7a>eoտgA=ƙ"E5n|8Q0i|b< x48=\އո+-P^pw*W$>&_A=It?Bӗy ;@N.|/cwgy Oyĭ#_+\SFzO"RyW!~C/?=xo;$,@~A_o3vE*'K~ G#'Cphw#_ hz>vJ~T=9/_8]-P}ث<#ܡ_f=ca-Ot~ ic?G 5ɫ0ϖ/r#9YO8 ai_k'b,~az~{j>w; Bw-}h'~@vڧ.SWhANx{^.|9]N: y!r7#߲??r~_~8?8\<.*Λ~}|ݲSr\Z-OiH4y8_|?]p ~SZ6(}x:8/v9/i/wI;Q\i9Gtk}Svt\[WK'nN'4;Y:<[uj]^Nw>2'3FZ˯?oDˡ5;$X'zz/<{W:W!9\g3,6?pXtk)U^:-'GE_r8fqsۧ{U@wYSypzj5Nwޞ,}/}9fEF~wd{R<{E|W*ShVy{(aSkS?9Peht~{ ^ >i~)~~I㷇G?_Ǝfs߷t:?Xz^kǜ]Z7~6< ʍv+m>C'˜mR9Ϋ|oTG>A`ᚣ}JpY)L.62csUdǛ?8 [sn.O6_/sܜ"'g_,]h߭q9qsG] PtsBן/vz[EG-rYքf^*-U~/>جV=ߦKj36OF뱭ZϽz[g oˠgϫyEڬ盵>zAJ*>(' gln[;ox}4ZnR~1>::i m +&/F?c3*שrd ?'~R[>#n^~;twfNoOwA;}(cɵCe쫱8'=;Xptg:1mξ7ߟ5Nw8:?FrR>8F~<{\8wy;/yoy:qߓe*As-3yp\"9W9ϝ;E&爠}|wùy*{/ tދ{'}fw.|Ƚ{ww}稸ߩ|/{,~|5>47ypLarΖ>·rϝ  9<:70w{g\|\cA]_</{w.:.4D3w_\9SurO4c.8ā F> ]| {/ay+ UvL9mECwpN=sWQC|-29I9(9/9SG>5ǝn7K}o=?r]ʸP{:/ҹCΟAxGʯƽ5sOAE/9J|U+p.x%j1q[.~B}sܨ78_3e|@{ɝG9{݂K˸"~1z)W9~{t^HOs?'ʽD!p!{|~ 3/qWe _I+.%'r#'@_ƣ!yJyXLzg8IB ڵΟK )=Ay_ys@=W}Q'p^^(/πS~J?G9`GG/xыBСxХ?wWByʃ_.I]`W?vKzDoG;xOH/E=N􉞼_8'ܽό;!qkv7 * qXO!tYHp >̏O-lo x?ge^=lBܰs~X/a|7B'A<'Tv_ů 8Yp{?:{r3c^zl@ g]|8!Δ򬷉WD\"ظfܱ%Α;ykLq=x̟C<-?/\-A Ar..;B~8&`~HyyguG^8[~Ixu?x]g_tqi.>_Sy;uvO|UJXLPJT{C_SqtR0:S`?&>w*+\W'N!IoćC?E|nWqGׁh8~.=/<ş_ea_Ir>5zNw`߅YB98$9ܳv8~9.~brϷ}Z%/ ŋs*1aQyT~88Zx TصW ڻڻovߑ~~C*B{uTl{p-$w?E;Ԟ|E[aOVȯtN 4=NO"aS?x3Ǎowg¾8M]|4Ÿs5r?/r*웹?>ş$qɘ/igH _BOp T'_翅utG+qψӥsO?gE<8ڋ98?*]g_I߹z6}M=K\4g>r=}đ'.cO}4| ؒ\|\@G W/> ѓwSCACpJ0_cR6.v/1/% ωJ!S))wI|([3E|.+7#.lLqC\7N8Xȇ8Zsq 1F/_?qǺ1 5/K|'`?A qw~FO9ZgGa<~|c^ ]\7d9B EBax@s&b~^a"]}O#]65~B g# q\lʾc q~gݹ }ƛr;~/s^ʇ|\=·P4t۸!av:(dWcn.pߡCO{W쾏$4Dc7E?H9֥C0΀8*G8Rύ/qoi7k⧻?ą$~@{&$>(~~śdqG1~?"rПd]♲w!q[7NOpނq}ARby>~"GsYC]ƈ˫7O)vrc?Wvf^ݺ=Wx mpe\9q¹4?+*%}2{{[*zTn$gON}7?ߵ&0߲=2';EqڦT7u7Ĝ{Iw4O~`[rN~V)*?n?Ʀg=S&ߙ >.t'NI*>r?>z rh}l& ط+Qc?{V~죍|%g na_'˾՞/TDov;J5c*&H% NDk5كv1Q'7#W՟O¾E?A& }MR:A&dh/:ijǓſDx}ڭO<ûs7|O)~δs'}y d7~w tS~v]Nt8tD5ᜮ?CWL^S}mW<񣈓F+lR=ݷO6NO|Y"wthugq!nݽk-{jo}Sv v[>v/7Z/v~>)ۓ?ܧpMXv+vFrcm;]VGl]r;wL{;-wvgOvCxi艹;}]GBGܳOjq{~]ǡTY9g,ޝ؅zN{7qޱ^񏏬/e|lHʎNU߫AMTC<֞_]jqhf+73cpJٷS]+"`」Wvijzu3N8]z{#zϨ?<ıS^?`GdlĦ~6c%n9 O|o"鈋;pڅ:E 8ģ A?K*{u+.ޱ*Z8V%~HKxyܦk|lŁRO8X|-G5mdl| ߵV}@l[Wx,G'1WYI| {FӪ{@\WKrvvųV+i_?W/LWFv_z"[x?9{Ayٸ) [یǚ/74~q5753!}c-&nc|ya-Go)c8J=[ċ}!7oXS?~ˎևYl?|VLdql+0$mdUe"x{xW y@xN#,m6qeY9qG_v_Nvlt9;Ѿڝ_/p퉸vy]1`5orWyB_$ne<{~7N>Y ~s"sDNp(Xjī=ٴ{ѵ V]ve w v%eutLކꝫewwꟅC:AopuOw}aogOogz[*H۹_٢5];{֮/=ѽg喎<[ճedwnK=j 5-+Wuذ{IA}=OJ_7G;u9;lF[~O{*93ycfS6ٙ6[g&Y*iQ%-EUҢJZTIjH9)UN*'eIY夬rRV9)UN*'eIY夬rRV9)U΍jjHWiU*muJ[]VWiU*muJ[]VWiU*d4=26ٴlδ:ZY #ia$-0FHZI ¨0-j ¨0-eRQ2JYF)(eMYySFH[i #ma-0ƍ٤ɤEUҢJZTZ5V+o[c孱Xyk5FQkaZFQkaZFU{U{U{>r5[m)MlLzMZTdf6[%-zKޒ,:KΒrrrrnd-EUҢJZTI*iQ%-jڢ-jڢ-j*k+}2--Zձ5}CӡC)+sn/data/ais.rda0000644000176200001440000001350713205231511013046 0ustar liggesusersy]]'vjYx˼Iٷ73oc'NbӴ#"Ħ MUQE@ J Ql*)9a)G-{~ܳLmd)eiK[[ۦ͛7mڼxvw7۵tFw~NM};RCk6ZJ5ݽwϕk7̈́5ܼ[䰼[[M}u!=? ;/HIƖ_kQ[4. -_A7vqmE/?}OfkןЭ?wU[Kg}U6~zJnRN_aa^gJ–GR'.}*uVjon+uhKOP?+?`oW9{T~Wо {T.GG;+^7h킧.떿QQjoh^أ~w?F料[M>=W\Ozt]z%54nO*ȏW<ţAq.~9ۃ]j'yOq7#Y\'C[+v7; "~8zxѫy@(񀇃N'*}ߍ7~^ tC? NCs #ϻ#}G֜WW?D?+ vP/=K:=Wh?^aOC9L!펤W7a װ!> x}'<o.!GvS?*^qWz_\^zJOqF1F#z "{{DrE2~1{ {a4nF1'_n'ȏ߸HG_ƹ7T.J_ŷS܍ &ě驪 pgKWS#T\S9t _$$rY|'h1pJ?U īRk=3 x1E~LW~/D_xoW|Cx^`O_ N!d첼e?t~i3. .C=.poӴ?#;?;/^~xa~S[3aq%1S /܀gL7JZz"=dogqۖg>T:^2K*i^ysGZ:Hݵt^ҳZyKASg#/S~b- ZwQ[Z8п_{VKr'KOΓC"/{t৕4kNzq9~xki]mrKq.9ҹgvӔ~W.4Ͷt9Ow[i?+oΊp+ͯ e-7;Wg//;_Jy(7 _ +/~E_tŃ?ҳإxiibZCxH*yW8K}\iY=+.^ڟW"_qU/<1Y?qq6189w}? 'uEyC+w>W~>9b/pZȻvw9v"/ɿ9rg/iǞ2w}y'?"pMNetv `OE ξ4uze7ܯF{6'^.܇ o~웋rA>Mc^sOPOAN"s)*7!3C씓En}3 ќk? !;7p!GsO:~:"ʼnc<tПrح^@qYxؑ<8/#=D}oy']Wnagwoy},Cig 'Ân͇ Dqp>ßxCW_[#=[]xM4!v+<q#=`g/:+Z<%9BTc~\ ]k_ANk_89x]b>XwrKz_ }n u)^@ 5ҋZG{'8OR\.AM\538/:31x־YQ]pyO~Z>ޙ'D߳o}?Ap1j Oj^O{DYw3_<{=ݻ磺O-;F;7h~$uoKq?RoyCu,x5i~}T>x"os_CN_t 3'sco:}е{uEf~ý7ZҮܬC'cW{8-dXӾX_k>@ Y/Eu~E9m=ĺ_}֭2 >4,| ^\7Ye3@ n8&z<yo֕}grNer=轟~Gh ;Yg<zduQe0Cs"k]vg=!w7't?:vbnJv~7%}7lߵo7e>1zj~gon^^pv >2̃ÎҾWA .9 _A򊏣!棣đP_{a}=>eS3o3qizb:^gyMK=ef.u1Os'ouhuES,e=6~yW>'?rSuB ;ަ#$2aQ/e޷LN?._szOu2>Q?{q~|'&a#Ύ vrkg]vr9Ǿ)Û8 .?7q淩_wN2^eΟw3N|MrNL/5]?/y]y;ɷcAږϒ&Ng(|Ӛrs)kXZr`Fɞ&}zCqT 糔svأvs6_ A\NJRWss|W W ؿWHJ\\Ij9woW&zޖ8hɿWWC*v5浚ځ_%n*[g_T#WzmB|ԉ:a2J אWeT5dG^OM?x~ICc'xZըyjU9' փ ~vT,~DȟRܼ>k'=fuxGv3ȭ*OGy4]uG1Z ku " {) sEl߁-/aG\'d'zH+RXnчyxiVl@ǜgx>v_Ǘ^k;b޴Fz\u??G?b5 Vg݆ZK Z@x>dǾOu_ľ1K]_~ ,9?m {}sW8Ža3}?`=y[:߿8#=&Lbu1L/msjN+k3TmU5ny `~$9>z01COq%t1=<~:?EГuEҿ{=w_ȿL~?VU$jZ8^ռ|!¹-5 g:H~q>AK#rH͟+)SGUks* n綊7B꽌-Ȼ 9wžR/=w^H aa%kDqC' j_tק ٯ9++Bb:0}k_~!I6`xݧ8 l5 X_!=[Ƴ #}C[?L&CsOɋqoarQ6fav3꾊A8pG5z4z{X{_i3lW~y?;Ԍ~M<#?hd5yG]duԦћY@S:9?/8<⤋wأu|8uL: xu&GG5~ kV?5W]|C^U8D4u{/r>ZCN۷>oҟOgׁ>ny1o[J yLSgmiK%jG&{@'sn/R/0000755000176200001440000000000013205231511011064 5ustar liggesuserssn/R/sn-funct.R0000644000176200001440000062516113203122700012754 0ustar liggesusers# file sn/R/sn-funct.R (various functions) # This file is a component of the package 'sn' for R # copyright (C) 1997-2016 Adelchi Azzalini # # 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 or 3 of the License # (at your option). # # 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. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ #--------- dsn <- function(x, xi=0, omega=1, alpha=0, tau=0, dp=NULL, log=FALSE) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] tau <- if(length(dp)>3) dp[4] else 0 } z <- (x-xi)/omega logN <- (-log(sqrt(2*pi)) -logb(omega) -z^2/2) if(abs(alpha) < Inf) logS <- pnorm(tau * sqrt(1+alpha^2) + alpha*z, log.p=TRUE) else logS <- log(as.numeric(sign(alpha)*z + tau > 0)) logPDF <- as.numeric(logN + logS - pnorm(tau, log.p=TRUE)) logPDF <- replace(logPDF, abs(x) == Inf, -Inf) logPDF <- replace(logPDF, omega <= 0, NaN) if(log) logPDF else exp(logPDF) } psn <- function(x, xi=0, omega=1, alpha=0, tau=0, dp=NULL, engine, ...) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] tau <- if(length(dp)>3) dp[4] else 0L } z <- as.numeric((x-xi)/omega) nz <- length(z) na <- length(alpha) if(missing(engine)) engine <- if(na == 1 & nz > 3 & all(alpha*z > -5) & (tau == 0L)) "T.Owen" else "biv.nt.prob" if(engine == "T.Owen") { if(tau != 0 | na > 1) stop("engine='T.Owen' not compatible with other arguments") p <- pnorm(z) - 2 * T.Owen(z, alpha, ...) } else{ # engine="biv.nt.prob" p <- numeric(nz) alpha <- cbind(z, alpha)[,2] delta <- delta.etc(alpha) p.tau <- pnorm(tau) for(k in seq_len(nz)) { if(abs(alpha[k]) == Inf){ p[k] <- if(alpha[k] > 0) (pnorm(pmax(z[k],-tau)) - pnorm(-tau))/p.tau else 1- (pnorm(tau) - pnorm(pmin(z[k], tau)))/p.tau } else { # SNbook: formula (2.48), p.40 R <- matrix(c(1, -delta[k], -delta[k], 1), 2, 2) p[k]<- mnormt::biv.nt.prob(0, rep(-Inf,2), c(z[k], tau), c(0, 0), R)/p.tau } }} p <- pmin(1, pmax(0, as.numeric(p))) replace(p, omega <= 0, NaN) } # qsn <- function(p, xi = 0, omega = 1, alpha = 0, tau=0, dp=NULL, tol = 1e-08, solver="NR", ...) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] tau <- if(length(dp) > 3) dp[4] else 0 } max.q <- sqrt(qchisq(p,1)) + tau min.q <- -sqrt(qchisq(1-p,1)) + tau if(tau == 0) { if(alpha == Inf) return(as.numeric(xi + omega * max.q)) if(alpha == -Inf) return(as.numeric(xi + omega * min.q)) } na <- is.na(p) | (p < 0) | (p > 1) zero <- (p == 0) one <- (p == 1) p <- replace(p, (na | zero | one), 0.5) dp0 <- c(0, 1, alpha, tau) if(solver == "NR") { dp0 <- c(0, 1, alpha, tau) cum <- sn.cumulants(dp=dp0, n=4) g1 <- cum[3]/cum[2]^(3/2) g2 <- cum[4]/cum[2]^2 x <- qnorm(p) x <- (x + (x^2 - 1) * g1/6 + x * (x^2 - 3) * g2/24 - x * (2 * x^2 - 5) * g1^2/36) x <- cum[1] + sqrt(cum[2]) * x px <- psn(x, dp=dp0, ...) max.err <- 1 while (max.err > tol) { # cat("qsn:", x, "\n") # cat('x, px:', format(c(x,px)),"\n") x1 <- x - (px - p)/dsn(x, dp=dp0) # x1 <- pmin(x1,max.q) # x1 <- pmax(x1,min.q) x <- x1 px <- psn(x, dp=dp0, ...) max.err <- max(abs(px-p)) if(is.na(max.err)) stop('failed convergence, try with solver="RFB"') } x <- replace(x, na, NA) x <- replace(x, zero, -Inf) x <- replace(x, one, Inf) q <- as.numeric(xi + omega * x) } else { if(solver == "RFB") { abs.alpha <- abs(alpha) if(alpha < 0) p <- (1-p) x <- xa <- xb <- xc <- fa <- fb <- fc <- rep(NA, length(p)) nc <- rep(TRUE, length(p)) # not converged (yet) nc[(na| zero| one)] <- FALSE fc[!nc] <- 0 xa[nc] <- qnorm(p[nc]) xb[nc] <- sqrt(qchisq(p[nc], 1)) + abs(tau) fa[nc] <- psn(xa[nc], 0, 1, abs.alpha, tau, ...) - p[nc] fb[nc] <- psn(xb[nc], 0, 1, abs.alpha, tau, ...) - p[nc] regula.falsi <- FALSE while (sum(nc) > 0) { # alternate regula falsi/bisection xc[nc] <- if(regula.falsi) xb[nc] - fb[nc] * (xb[nc] - xa[nc])/(fb[nc] - fa[nc]) else (xb[nc] + xa[nc])/2 fc[nc] <- psn(xc[nc], 0, 1, abs.alpha, tau, ...) - p[nc] pos <- (fc[nc] > 0) xa[nc][!pos] <- xc[nc][!pos] fa[nc][!pos] <- fc[nc][!pos] xb[nc][pos] <- xc[nc][pos] fb[nc][pos] <- fc[nc][pos] x[nc] <- xc[nc] nc[(abs(fc) < tol)] <- FALSE regula.falsi <- !regula.falsi } # x <- replace(x, na, NA) x <- replace(x, zero, -Inf) x <- replace(x, one, Inf) Sign <- function(x) sign(x) + as.numeric(x==0) q <- as.numeric(xi + omega * Sign(alpha)* x) } else stop("unknown solver")} names(q) <- names(p) return(q) } # rsn <- function(n=1, xi=0, omega=1, alpha=0, tau=0, dp=NULL) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] tau <- if(length(dp)>3) dp[4] else 0 } if(tau == 0) { u1 <- rnorm(n) u2 <- rnorm(n) id <- (u2 > alpha*u1) u1[id] <- (-u1[id]) z <- u1 } else { # for ESN use transformation method delta <- alpha/sqrt(1+alpha^2) truncN <- qnorm(runif(n, min=pnorm(-tau), max=1)) z <- delta * truncN + sqrt(1-delta^2) * rnorm(n) } y <- xi+omega*z attr(y, "family") <- "SN" attr(y, "parameters") <- c(xi,omega,alpha,tau) return(y) } dmsn <- function(x, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL, log=FALSE) { if(!(missing(alpha) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and dp") if(!is.null(dp)){ if(length(dp) < 3) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] alpha <- dp[[3]] tau <- if(length(dp) == 4) dp[[4]] else 0 } if(any(abs(alpha) == Inf)) stop("Inf's in alpha are not allowed") d <- length(alpha) Omega <- matrix(Omega,d,d) invOmega <- pd.solve(Omega, silent=TRUE, log.det=TRUE) if (is.null(invOmega)) stop("Omega matrix is not positive definite") logDet <- attr(invOmega, "log.det") x <- if(is.vector(x)) matrix(x, 1, d) else data.matrix(x) if (is.vector(xi)) xi <- outer(rep(1, nrow(x)), as.vector(matrix(xi,1,d))) if(tau == 0){ log.const <- logb(2) alpha0 <- 0 } else { log.const <- -pnorm(tau, log.p=TRUE) O.alpha <- cov2cor(Omega) %*% alpha alpha0 <- tau*sqrt(1+sum(alpha* O.alpha)) } X <- t(x - xi) # Q <- apply((invOmega %*% X) * X, 2, sum) Q <- colSums((invOmega %*% X) * X) L <- alpha0 + as.vector(t(X/sqrt(diag(Omega))) %*% as.matrix(alpha)) logPDF <- (log.const - 0.5 * Q + pnorm(L, log.p = TRUE) - 0.5 * (d * logb(2 * pi) + logDet)) if (log) logPDF else exp(logPDF) } pmsn <- function(x, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL, ...) { if(!(missing(alpha) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and dp") if(!is.null(dp)){ xi <- dp$xi Omega <- dp$Omega alpha <- dp$alpha tau <- if(is.null(dp$tau)) 0 else dp$tau } if(any(abs(alpha) == Inf)) stop("Inf's in alpha are not allowed") d <- length(alpha) Omega <- matrix(Omega, d, d) omega <- sqrt(diag(Omega)) delta_etc <- delta.etc(alpha, Omega) delta <- delta_etc$delta Ocor <- delta_etc$Omega.cor Obig <- matrix(rbind(c(1,-delta), cbind(-delta,Ocor)), d+1, d+1) x <- if (is.vector(x)) matrix(x, 1, d) else data.matrix(x) if (is.vector(xi)) xi <- outer(rep(1, nrow(x)), as.vector(matrix(xi,1,d))) z0 <- cbind(tau, t(t(x - xi))/omega) mnormt::pmnorm(z0, mean=rep(0,d+1), varcov=Obig, ...)/pnorm(tau) } rmsn <- function(n=1, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL) {# generates SN_d(..) variates using the additive (=transformation) method # if(!(missing(alpha) & missing(Omega) & !is.null(dp))) # stop("You cannot set both component parameters and dp") if(!is.null(dp)) { dp0 <- dp dp0$nu <- NULL if(is.null(dp0$tau)) dp0$tau <- 0 if(names(dp)[1] == "beta") { dp0[[1]] <- as.vector(dp[[1]]) names(dp0)[1] <- "xi" } } else dp0 <- list(xi=xi, Omega=Omega, alpha=alpha, tau=tau) if(any(abs(dp0$alpha) == Inf)) stop("Inf's in alpha are not allowed") lot <- dp2cpMv(dp=dp0, family="SN", aux=TRUE) d <- length(dp0$alpha) y <- matrix(rnorm(n*d), n, d) %*% chol(lot$aux$Psi) # each row is N_d(0,Psi) if(dp0$tau == 0) truncN <- abs(rnorm(n)) else truncN <- qnorm(runif(n, min=pnorm(-dp0$tau), max=1)) truncN <- matrix(rep(truncN, d), ncol=d) delta <- lot$aux$delta z <- delta * t(truncN) + sqrt(1-delta^2) * t(y) y <- t(dp0$xi + lot$aux$omega * z) attr(y, "family") <- "SN" attr(y, "parameters") <- dp0 return(y) } # dst <- function (x, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, log=FALSE) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } if (nu == Inf) return(dsn(x, xi, omega, alpha, log=log)) if (nu == 1) return(dsc(x, xi, omega, alpha, log=log)) z <- (x - xi)/omega pdf <- dt(z, df=nu, log=log) cdf <- pt(alpha*z*sqrt((nu+1)/(z^2+nu)), df=nu+1, log.p=log) if(log) logb(2) + pdf + cdf -logb(omega) else 2 * pdf * cdf / omega } rst <- function (n=1, xi = 0, omega = 1, alpha = 0, nu=Inf, dp=NULL) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } z <- rsn(n, 0, omega, alpha) if(nu < Inf) { v <- rchisq(n,nu)/nu y <- z/sqrt(v) + xi } else y <- z+xi attr(y, "family") <- "ST" attr(y, "parameters") <- c(xi,omega,alpha,nu) return(y) } pst <- function (x, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, method=0, ...) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } if(length(alpha) > 1) stop("'alpha' must be a single value") if(length(nu) > 1) stop("'nu' must be a single value") if (nu <= 0) stop("nu must be non-negative") if (nu == Inf) return(psn(x, xi, omega, alpha)) if (nu == 1) return(psc(x, xi, omega, alpha)) int.nu <- (round(nu) == nu) if((method == 1 | method ==4) & !int.nu) stop("selected method does not work for non-integer nu") ok <- !(is.na(x) | (x==Inf) | (x==-Inf)) z <- ((x-xi)/omega)[ok] if(abs(alpha) == Inf) { z0 <- replace(z, alpha*z < 0, 0) p <- pf(z0^2, 1, nu) return(if(alpha>0) p else (1-p)) } fp <- function(v, alpha, nu, t.value) psn(sqrt(v) * t.value, 0, 1, alpha) * dchisq(v * nu, nu) * nu if(method == 4 || (method ==0 && int.nu && (nu < (8.2 + 3.55* log(log(length(z)+1)))))) p <- pst_int(z, 0, 1, alpha, nu) # "method 4" else { p <- numeric(length(z)) for (i in seq_len(length(z))) { if(abs(z[i]) == Inf) p[i] <- (1+sign(z[i]))/2 else { if(method==1 | method == 0) p[i] <- pmst(z[i], 0, matrix(1,1,1), alpha, nu, ...) # method 1 else { # upper <- if(absalpha> 1) 5/absalpha + 25/(absalpha*nu) else 5+25/nu upper <- 10 + 50/nu if(method==2 || (method==0 & (z[i] < upper) )) p[i] <- integrate(dst, -Inf, z[i], dp=c(0,1,alpha, nu), ...)$value # method 2 else p[i] <- integrate(fp, 0, Inf, alpha, nu, z[i], ...)$value # method 3 }} }} pr <- rep(NA, length(x)) pr[x==Inf] <- 1 pr[x==-Inf] <- 0 pr[ok] <- p return(pmax(0,pmin(1,pr))) } pst_int <- function (x, xi=0, omega=1, alpha=0, nu=Inf) {# Jamalizadeh, A. and Khosravi, M. and Balakrishnan, N. (2009) if(nu != round(nu) | nu < 1) stop("nu not integer or not positive") z <- (x-xi)/omega if(nu == 1) atan(z)/pi + acos(alpha/sqrt((1+alpha^2)*(1+z^2)))/pi else { if(nu==2) 0.5 - atan(alpha)/pi + (0.5 + atan(z*alpha/sqrt(2+z^2))/pi)*z/sqrt(2+z^2) else (pst_int(sqrt((nu-2)/nu)*z, 0, 1, alpha, nu-2) + pst_int(sqrt(nu-1)*alpha*z/sqrt(nu+z^2), 0, 1, 0, nu-1) * z * exp(lgamma((nu-1)/2) +(nu/2-1)*log(nu)-0.5*log(pi)-lgamma(nu/2) -0.5*(nu-1)*log(nu+z^2))) } } qst <- function (p, xi = 0, omega = 1, alpha = 0, nu=Inf, tol = 1e-8, dp = NULL, method=0, ...) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } if(length(alpha) > 1) stop("'alpha' must be a single value") if(length(nu) > 1) stop("'nu' must be a single value") if (nu <= 0) stop("nu must be non-negative") if (nu > 1e4) return(qsn(p, xi, omega, alpha)) if (nu == 1) return(qsc(p, xi, omega, alpha)) if (alpha == Inf) return(xi + omega * sqrt(qf(p, 1, nu))) if (alpha == -Inf) return(xi - omega * sqrt(qf(1 - p, 1, nu))) na <- is.na(p) | (p < 0) | (p > 1) abs.alpha <- abs(alpha) if(alpha < 0) p <- (1-p) zero <- (p == 0) one <- (p == 1) x <- xa <- xb <- xc <- fa <- fb <- fc <- rep(NA, length(p)) nc <- rep(TRUE, length(p)) # not converged (yet) nc[(na| zero| one)] <- FALSE fc[!nc] <- 0 xa[nc] <- qt(p[nc], nu) xb[nc] <- sqrt(qf(p[nc], 1, nu)) fa[nc] <- pst(xa[nc], 0, 1, abs.alpha, nu, method=method, ...) - p[nc] fb[nc] <- pst(xb[nc], 0, 1, abs.alpha, nu, method=method, ...) - p[nc] regula.falsi <- FALSE while (sum(nc) > 0) { # alternate regula falsi/bisection xc[nc] <- if(regula.falsi) xb[nc] - fb[nc] * (xb[nc] - xa[nc])/(fb[nc] - fa[nc]) else (xb[nc] + xa[nc])/2 fc[nc] <- pst(xc[nc], 0, 1, abs.alpha, nu, method=method, ...) - p[nc] pos <- (fc[nc] > 0) xa[nc][!pos] <- xc[nc][!pos] fa[nc][!pos] <- fc[nc][!pos] xb[nc][pos] <- xc[nc][pos] fb[nc][pos] <- fc[nc][pos] x[nc] <- xc[nc] nc[(abs(fc) < tol)] <- FALSE regula.falsi <- !regula.falsi } # x <- replace(x, na, NA) x <- replace(x, zero, -Inf) x <- replace(x, one, Inf) Sign <- function(x) sign(x) + as.numeric(x==0) q <- as.numeric(xi + omega * Sign(alpha)* x) names(q) <- names(p) return(q) } dmst <- function(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL, log = FALSE) { if(!(missing(alpha) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and dp") if(!is.null(dp)) { if(length(dp) != 4) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] alpha <- dp[[3]] nu <- dp[[4]] } if(any(abs(alpha) == Inf)) stop("Inf's in alpha are not allowed") if (nu == Inf) return(dmsn(x, xi, Omega, alpha, log = log)) d <- length(alpha) Omega <- matrix(Omega, d, d) if(!all(Omega - t(Omega) == 0)) return(NA) # stop("Omega not a symmetric matrix") invOmega <- pd.solve(Omega, silent=TRUE, log.det=TRUE) if(is.null(invOmega)) return(NA) # stop("Omega matrix is not positive definite") logDet <- attr(invOmega, "log.det") x <- if(is.vector(x)) matrix(x, 1, d) else data.matrix(x) if (is.vector(xi)) xi <- outer(rep(1, nrow(x)), as.vector(matrix(xi,1,d))) X <- t(x - xi) # Q <- apply((invOmega %*% X) * X, 2, sum) Q <- colSums((invOmega %*% X) * X) L <- as.vector(t(X/sqrt(diag(Omega))) %*% as.matrix(alpha)) if(nu < 1e4) { log.const <- lgamma((nu + d)/2)- lgamma(nu/2)-0.5*d*logb(nu) log1Q <- logb(1+Q/nu) } else { log.const <- (-0.5*d*logb(2)+ log1p((d/2)*(d/2-1)/nu)) log1Q <- log1p(Q/nu) } log.dmt <- log.const - 0.5*(d * logb(pi) + logDet + (nu + d)* log1Q) log.pt <- pt(L * sqrt((nu + d)/(Q + nu)), df = nu + d, log.p = TRUE) logPDF <- logb(2) + log.dmt + log.pt if (log) logPDF else exp(logPDF) } rmst <- function(n=1, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL) { if(!(missing(alpha) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and dp") if(!is.null(dp)){ if(!is.null(dp$xi)) xi <- dp$xi else if(!is.null(dp$beta)) xi <- as.vector(dp$beta) Omega <- dp$Omega alpha <- dp$alpha nu <- dp$nu } if(any(abs(alpha) == Inf)) stop("Inf's in alpha are not allowed") d <- length(alpha) x <- if(nu==Inf) 1 else rchisq(n,nu)/nu z <- rmsn(n, rep(0,d), Omega, alpha) y <- t(xi+ t(z/sqrt(x))) attr(y, "family") <- "ST" attr(y, "parameters") <- list(xi=xi, Omega=Omega, alpha=alpha, nu=nu) return(y) } pmst <- function(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL, ...) { if(!(missing(alpha) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and dp") if(!is.null(dp)){ if(!is.null(dp$xi)) xi <- dp$xi else if(!is.null(dp$beta)) xi <- as.vector(dp$beta) Omega <- dp$Omega alpha <- dp$alpha nu <- dp$nu } if(!is.vector(x)) stop("x must be a vector") if(any(abs(alpha) == Inf)) stop("Inf's in alpha are not allowed") if(nu == Inf) return(pmsn(x, xi, Omega, alpha)) d <- length(alpha) Omega<- matrix(Omega,d,d) omega<- sqrt(diag(Omega)) Ocor <- cov2cor(Omega) O.alpha <- as.vector(Ocor %*% alpha) delta <- O.alpha/sqrt(1 + sum(alpha*O.alpha)) Obig <- matrix(rbind(c(1, -delta), cbind(-delta, Ocor)), d+1, d+1) if(nu == as.integer(nu)) { z0 <- c(0,(x-xi)/omega) if(nu < .Machine$integer.max) p <- 2 * mnormt::pmt(z0, mean=rep(0,d+1), S=Obig, df=nu, ...) else p <- 2 * mnormt::pmnorm(z0, mean=rep(0,d+1), varcov=Obig, ...) } else {# for fractional nu, use formula in Azzalini & Capitanio (2003), # full-length paper, last paragraph of Section 4.2[Distr.function]) z <- (x-xi)/omega fp <- function(v, Ocor, alpha, nu, t.value) { pv <- numeric(length(v)) for(k in seq_len(length(v))) pv[k] <- (dchisq(v[k] * nu, nu) * nu * pmsn(sqrt(v[k]) * t.value, rep(0,d), Ocor, alpha) ) pv} p <- integrate(fp, 0, Inf, Ocor, alpha, nu, z, ...)$value } p } dmsc <- function(x, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL, log = FALSE) { if(is.null(dp)) dp <- list(xi=xi, Omega=Omega, alpha=alpha, nu=1) else dp$nu <- 1 dmst(x, dp=dp, log = log) } pmsc <- function(x, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL, ...) { if(is.null(dp)) dp <- list(xi=xi, Omega=Omega, alpha=alpha, nu=1) else dp$nu <- 1 pmst(x, dp=dp, ...) } rmsc <- function(n=1, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL) { if(is.null(dp)) dp <- list(xi=xi, Omega=Omega, alpha=alpha, nu=1) else dp$nu <- 1 y <- rmst(n, dp=dp) attr(y, "family") <- "SC" attr(y, "parameters") <- dp[-4] return(y) } dsc <- function(x, xi=0, omega=1, alpha=0, dp=NULL, log = FALSE) { # log.pt2 <- function(x) log1p(x/sqrt(2+x^2)) - log(2) if(!is.null(dp)){ if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] } z <- (x-xi)/omega logPDF <- (dcauchy(x, xi, omega, log=TRUE) + log1p(alpha*z/sqrt(1+z^2*(1+alpha^2)))) if(log) logPDF else exp(logPDF) } psc <- function(x, xi=0, omega=1, alpha=0, dp=NULL) {# Behboodian et al. / Stat. & Prob. Letters 76 (2006) p.1490, line 2 if(!is.null(dp)){ if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] } z <- (x-xi)/omega delta <- if(abs(alpha)==Inf) sign(alpha) else alpha/sqrt(1+alpha^2) atan(z)/pi + acos(delta/sqrt(1+z^2))/pi } qsc <- function(p, xi=0, omega=1, alpha=0, dp=NULL) {# Behboodian et al. / Stat. & Prob. Letters 76 (2006) p.1490, formula (4) if(!is.null(dp)){ if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi<- dp[1] omega <- dp[2] alpha <- dp[3] } na <- is.na(p) | (p < 0) | (p > 1) zero <- (p == 0) one <- (p == 1) p <- replace(p, (na | zero | one), 0.5) u <- (p - 0.5) * pi delta <- if(abs(alpha) == Inf) sign(alpha) else alpha/sqrt(1+alpha^2) z <- delta/cos(u) + tan(u) z <- replace(z, na, NA) z <- replace(z, zero, -Inf) z <- replace(z, one, Inf) q <- (xi + omega*z) names(q) <- names(p) return(q) } rsc <- function(n=1, xi=0, omega=1, alpha=0, dp=NULL) { if(!is.null(dp)){ if(!missing(alpha)) stop("You cannot set both 'dp' and component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] } y <- xi + rsn(n, 0, omega, alpha)/abs(rnorm(n)) attr(y, "family") <- "SC" attr(y, "parameters") <- c(xi, omega, alpha) return(y) } sn.cumulants <- function(xi = 0, omega = 1, alpha = 0, tau=0, dp=NULL, n=4) { cumulants.half.norm <- function(n=4){ n <- max(n,2) n <- as.integer(2*ceiling(n/2)) half.n <- as.integer(n/2) m <- 0:(half.n-1) a <- sqrt(2/pi)/(gamma(m+1)*2^m*(2*m+1)) signs <- rep(c(1, -1), half.n)[seq_len(half.n)] a <- as.vector(rbind(signs*a, rep(0,half.n))) coeff <- rep(a[1],n) for (k in 2:n) { ind <- seq_len(k-1) coeff[k] <- a[k] - sum(ind*coeff[ind]*a[rev(ind)]/k) } kappa <- coeff*gamma(seq_len(n)+1) kappa[2] <- 1 + kappa[2] return(kappa) } if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") dp <- c(dp,0)[1:4] dp <- matrix(dp, 1, ncol=length(dp)) } else dp <- cbind(xi,omega,alpha,tau) delta <- ifelse(abs(dp[,3])n) kv <- kv[-(n+1)] kv[2] <- kv[2] - 1 kappa <- outer(delta,1:n,"^") * matrix(rep(kv,nrow(dp)),ncol=n,byrow=TRUE) } else{ # ESN if(n>4){ warning("n>4 not allowed with ESN distribution") n <- min(n, 4) } kappa <- matrix(0, nrow=length(delta), ncol=0) for (k in 1:n) kappa <- cbind(kappa, zeta(k,tau)*delta^k) } kappa[,2] <- kappa[,2] + 1 kappa <- kappa * outer(dp[,2],(1:n),"^") kappa[,1] <- kappa[,1] + dp[,1] kappa[,,drop=TRUE] } zeta <- function(k, x) { # k integer in (0,5) if(k<0 | k>5 | k != round(k)) return(NULL) na <- is.na(x) x <- replace(x,na,0) x2 <- x^2 z <- switch(k+1, pnorm(x, log.p=TRUE) + log(2), ifelse(x>(-50), exp(dnorm(x, log=TRUE) - pnorm(x, log.p=TRUE)), -x/(1 -1/(x2+2) +1/((x2+2)*(x2+4)) -5/((x2+2)*(x2+4)*(x2+6)) +9/((x2+2)*(x2+4)*(x2+6)*(x2+8)) -129/((x2+2)*(x2+4)*(x2+6)*(x2+8)*(x2+10)) )), (-zeta(1,x)*(x+zeta(1,x))), (-zeta(2,x)*(x+zeta(1,x)) - zeta(1,x)*(1+zeta(2,x))), (-zeta(3,x)*(x+2*zeta(1,x)) - 2*zeta(2,x)*(1+zeta(2,x))), (-zeta(4,x)*(x+2*zeta(1,x)) -zeta(3,x)*(3+4*zeta(2,x)) -2*zeta(2,x)*zeta(3,x)), NULL) neg.inf <- (x == -Inf) if(any(neg.inf)) z <- switch(k+1, z, replace(z, neg.inf, Inf), replace(z, neg.inf, -1), replace(z, neg.inf, 0), replace(z, neg.inf, 0), replace(z, neg.inf, 0), NULL) if(k>1) z<- replace(z, x==Inf, 0) replace(z, na, NA) } st.cumulants <- function(xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, n=4) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both component parameters and dp") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } if(nu == Inf) return(sn.cumulants(xi, omega, alpha, n=n)) n <- min(as.integer(n),4) # if(nu <= n) stop("need nu>n") par <- cbind(xi,omega,alpha) delta <- par[,3]/sqrt(1+par[,3]^2) cum<- matrix(NA, nrow=nrow(par), ncol=n) cum[,1]<- mu <- b(nu)*delta # if(n>1) cum[,2] <- nu/(nu-2) - mu^2 # if(n>2) cum[,3] <- mu*(nu*(3-delta^2)/(nu-3) - 3*nu/(nu-2)+2*mu^2) # if(n>3) cum[,4] <- (3*nu^2/((nu-2)*(nu-4)) - 4*mu^2*nu*(3-delta^2)/(nu-3) # + 6*mu^2*nu/(nu-2)-3*mu^4)- 3*cum[,2]^2 r <- function(nu, k1, k2) 1/(1-k2/nu) - k1/(nu-k2) # (nu-k1)/(nu-k2) if(n>1 & nu>2) cum[,2] <- r(nu,0,2) - mu^2 if(n>2 & nu>3) cum[,3] <- mu*((3-delta^2)*r(nu,0,3) - 3*r(nu,0,2) + 2*mu^2) if(n>3 & nu>4) cum[,4] <- (3*r(nu,0,2)*r(nu,0,4) - 4*mu^2*(3-delta^2)*r(nu,0,3) + 6*mu^2*r(nu,0,2)-3*mu^4) - 3*cum[,2]^2 cum <- cum*outer(par[,2],1:n,"^") cum[,1] <- cum[,1]+par[,1] cum[,,drop=TRUE] } T.Owen <- function(h, a, jmax=50, cut.point=8) { T.int <-function(h, a, jmax, cut.point) { fui <- function(h,i) (h^(2*i))/((2^i)*gamma(i+1)) seriesL <- seriesH <- NULL i <- 0:jmax low<- (h <= cut.point) hL <- h[low] hH <- h[!low] L <- length(hL) if (L > 0) { b <- outer(hL, i, fui) cumb <- apply(b, 1, cumsum) b1 <- exp(-0.5*hL^2) * t(cumb) matr <- matrix(1, jmax+1, L) - t(b1) jk <- rep(c(1,-1), jmax)[1:(jmax+1)]/(2*i+1) matr <- t(matr*jk) %*% a^(2*i+1) seriesL <- (atan(a) - as.vector(matr))/(2*pi) } if (length(hH) > 0) seriesH <- atan(a)*exp(-0.5*(hH^2)*a/atan(a)) * (1+0.00868*(hH*a)^4)/(2*pi) series <- c(seriesL, seriesH) id <- c((1:length(h))[low],(1:length(h))[!low]) series[id] <- series # re-sets in original order series } if(!is.vector(a) | length(a)>1) stop("'a' must be a vector of length 1") if(!is.vector(h)) stop("'h' must be a vector") aa <- abs(a) ah <- abs(h) if(is.na(aa)) stop("parameter 'a' is NA") if(aa==Inf) return(sign(a)*0.5*pnorm(-ah)) # sign(a): 16.07.2007 if(aa==0) return(rep(0,length(h))) na <- is.na(h) inf <- (ah == Inf) ah <- replace(ah,(na|inf),0) if(aa <= 1) owen <- T.int(ah,aa,jmax,cut.point) else owen<- (0.5*pnorm(ah) + pnorm(aa*ah)*(0.5-pnorm(ah)) - T.int(aa*ah,(1/aa),jmax,cut.point)) owen <- replace(owen,na,NA) owen <- replace(owen,inf,0) return(owen*sign(a)) } #========================================================================= makeSECdistr <- function(dp, family, name, compNames) { ndp <- switch(tolower(family), "sn" = 3, "esn" = 4, "st" = 4, "sc" = 3, NULL) if(is.null(ndp)) stop(gettextf("unknown family '%s'", family)) family <- toupper(family) if(length(dp) != ndp) stop(gettextf("wrong number of dp components for family '%s'", family)) if(family == "ST") { nu <- as.numeric(dp[4]) if(nu <= 0) stop("'nu' for ST family must be positive") if(nu == Inf) { warning("ST family with 'nu==Inf' is changed to SN family") family <- "SN" dp <- dp[-4] }} if(is.numeric(dp)){ # univariate distribution if(dp[2] <= 0) stop("omega parameter must be positive") fourth <- switch(family, "SN"=NULL, "ESN"="tau", "SC"=NULL, "ST"="nu") names(dp) <- c("xi","omega","alpha",fourth) name <- if(!missing(name)) as.character(name)[1] else paste("Unnamed-", toupper(family), sep="") obj <- new("SECdistrUv", dp=dp, family=family, name=name) } else {if(is.list(dp)) {# multivariate distribution names(dp) <- rep(NULL,ndp) d <- length(dp[[3]]) if(any(abs(dp[[3]]) == Inf)) stop("Inf in alpha not allowed") if(length(dp[[1]]) != d) stop("mismatch of parameters size") Omega <- matrix(dp[[2]],d,d) if(any(Omega != t(Omega))) stop("Omega matrix must be symmetric") if(min(eigen(Omega, symmetric=TRUE, only.values=TRUE)$values) <= 0) stop("Omega matrix must be positive definite") dp0 <- list(xi=as.vector(dp[[1]]), Omega=Omega, alpha=dp[[3]]) name <- if(!missing(name)) as.character(name)[1] else paste("Unnamed-", toupper(family), "[d=", as.character(d), "]", sep="") if(family=="ST") dp0$nu <- nu if(family=="ESN") dp0$tau <- dp[[4]] if(d == 1) warning(paste( "A multivariate distribution with dimension=1 is a near-oxymoron.", "\nConsider using a 'dp' vector to define a univariate distribution.", "\nHowever, I still build a multivariate distribution for you.")) if(missing(compNames)) { compNames <- if(length(names(dp[[1]])) == d) names(dp[[1]]) else as.vector(outer("V",as.character(1:d),paste,sep="")) } else { if(length(compNames) != d) stop("Wrong length of 'compNames'") compNames <- as.character(as.vector(compNames)) } names(dp0$alpha) <- names(dp0$xi) <- compNames dimnames(dp0$Omega) <- list(compNames, compNames) obj <- new("SECdistrMv", dp=dp0, family=family, name=name, compNames=compNames) } else stop("'dp' must be either a numeric vector or a list")} obj } summary.SECdistrUv <- function(object, cp.type="auto", probs) { cp.type <- match.arg(tolower(cp.type), c("proper", "pseudo", "auto")) family <- slot(object,"family") lc.family <- tolower(family) name <- slot(object,"name") dp <- slot(object,"dp") # op <- dp2op(dp, family) if(family=="ST" || family=="SC") { if(cp.type=="auto") cp.type <- if(family == "SC" | dp[4] <= 4) "pseudo" else "proper" } if(family=="SN" || family=="ESN") cp.type <- "proper" cp <- dp2cpUv(dp, family, cp.type) if(is.null(cp)) stop('Stop. Consider using cp.type=="pseudo"') if(missing(probs)) probs <- c(0.05, 0.25, 0.50, 0.75, 0.95) if(lc.family == "esn") lc.family <- "sn" q.fn <- get(paste("q",lc.family, sep=""), inherits = TRUE) q <- q.fn(probs, dp=dp) names(q) <- format(probs) cum <- switch(lc.family, "sn" = sn.cumulants(dp=dp, n=4), "st" = st.cumulants(dp=dp, n=4), rep(NA,4) ) std.cum <- c(gamma1=cum[3]/cum[2]^1.5, gamma2=cum[4]/cum[2]^2) oct <- q.fn(p=(1:7)/8, dp=dp) mode <- modeSECdistrUv(dp, family) alpha<- as.numeric(dp[3]) delta <- delta.etc(alpha) q.measures <- c(bowley=(oct[6]-2*oct[4]+oct[2])/(oct[6]-oct[2]), moors=(oct[7]-oct[5]+oct[3]-oct[1])/(oct[6]-oct[2])) aux <- list(delta=delta, mode=mode, quantiles=q, std.cum=std.cum, q.measures=q.measures) new("summary.SECdistrUv", dp=dp, family=family, name=name, cp=cp, cp.type=cp.type, aux=aux) } modeSECdistr <- function(dp, family, object=NULL) { if(!is.null(object)) { if(!missing(dp)) stop("you cannot set both arguments dp and obj") obj.class <- class(object) if(!(obj.class %in% c("SECdistrUv", "SECdistrMv"))) stop(gettextf("wrong object class: '%s'", obj.class), domain = NA) family <- slot(object, "family") dp <- slot(object, "dp") } else { if(missing(family)) stop("family required") family <- toupper(family) if(!(family %in% c("SN", "ESN", "ST","SC"))) stop(gettextf("family '%s' is not supported", family), domain = NA) } if(is.list(dp)) modeSECdistrMv(dp, family) else modeSECdistrUv(dp, family) } modeSECdistrUv <- function(dp, family) { if(abs(dp[3]) < .Machine$double.eps) return(as.numeric(dp[1])) cp <- dp2cpUv(dp, family, cp.type="auto", upto=1) lc.family <- tolower(family) if(lc.family == "esn") lc.family <- "sn" d.fn <- get(paste("d", lc.family, sep=""), inherits = TRUE) int <- c(dp[1], cp[1]) if(abs(diff(int)) < .Machine$double.eps) return(mean(int)) opt <- optimize(d.fn, lower=min(int), upper=max(int), maximum=TRUE, dp=dp) as.numeric(opt$maximum) } modeSECdistrMv <- function(dp, family) { Omega <- dp[[2]] alpha <- dp[[3]] delta_etc <- delta.etc(alpha, Omega) if(delta_etc$alpha.star < .Machine$double.eps) return(dp[[1]]) lc.family <- tolower(family) if(lc.family == "esn") lc.family <- "sn" direct <- sqrt(diag(Omega)) * (delta_etc$delta/delta_etc$delta.star) if(lc.family == "sn") {# case SN: book (5.49); # the same result is used also for ESN, see handwritten Problem 5.18 dp1 <- c(xi=0, omega=1, alpha=delta_etc$alpha.star, dp$tau) mode.canon <- modeSECdistrUv(dp1, family) mode <- as.numeric(dp[[1]] + mode.canon * direct) } else {# case ST, SC: book Proposition 6.2, p.178, # but maximizes along canonical direction, instead of solving equation d.fn <- get(paste("dm", lc.family, sep=""), inherits = TRUE) f <- function(u, dp, direct) -d.fn(dp[[1]]+ u*direct, dp=dp, log=TRUE) maxM <- max(abs(dp2cpMv(dp, family, "auto", upto=1)[[1]] - dp[[1]]/direct)) opt <- optimize(f, lower=0, upper=maxM, dp=dp, direct=direct) mode <- as.numeric(dp[[1]]+ opt$minimum * direct) } return(mode) } summary.SECdistrMv <- function(object, cp.type="auto") { cp.type <- match.arg(tolower(cp.type), c("proper", "pseudo", "auto")) family <- slot(object,"family") name <- slot(object,"name") dp <- slot(object,"dp") # op <- dp2op(dp, family) if(family == "SN" || family == "ESN") cp.type <- "proper" if(family=="ST" || family=="SC") { if(cp.type=="auto") cp.type <- if(family == "SC" || dp$nu <= 4) "pseudo" else "proper"} cp <- dp2cpMv(dp, family, cp.type, aux=TRUE) aux <- cp$aux if(family=="SN" | family=="SC") cp <- cp[1:3] cp[["aux"]] <- NULL mode <- modeSECdistrMv(dp, family) aux0 <- list(mode=mode, delta=aux$delta, alpha.star=aux$alpha.star, delta.star=aux$delta.star, mardia=aux$mardia) new("summary.SECdistrMv", dp=dp, family=family, name=object@name, compNames=object@compNames, cp=cp, cp.type=cp.type, aux=aux0) } dp2cp <- function(dp, family, object=NULL, cp.type="proper", upto=NULL) { if(!is.null(object)){ if(!missing(dp)) stop("you cannot set both arguments dp and object") obj.class <- class(object) if(!(obj.class %in% c("SECdistrUv", "SECdistrMv"))) stop(gettextf("wrong object class: '%s'", obj.class), domain = NA) family <- slot(object, "family") dp <- slot(object,"dp") multiv <- (obj.class == "SECdistrMv") } else{ if(missing(family)) stop("family required") family <- toupper(family) if(!(family %in% c("SN", "ESN", "ST","SC"))) stop(gettextf("family '%s' is not supported", family), domain = NA) multiv <- is.list(dp) } if(!is.null(upto)) if(upto<0 | upto>4 | upto != round(upto)) { warning("unsuitable value of argument 'upto', reset to NULL") upto <- NULL} if(multiv) dp2cpMv(dp, family, cp.type, upto=upto) else dp2cpUv(dp, family, cp.type, upto=upto) } dp2cpUv <- function(dp, family, cp.type="proper", upto=NULL) { # internal function; works also with regression parameters included cp.type <- match.arg(tolower(cp.type), c("proper", "pseudo", "auto")) family <- toupper(family) if(!(family %in% c("SN", "ESN", "ST", "SC"))) stop(gettextf("family = '%s' is not supported", family), domain = NA) if(family %in% c("SN","ESN")){ if(cp.type == "pseudo") warning("'cp.type=pseudo' makes no sense for SN and ESN families") p <- length(dp)-2-as.numeric(family=="ESN") omega <- dp[p+1] if(omega <= 0) stop("scale parameter 'omega' must be positive") alpha <- dp[p+2] tau <- if(family=="ESN") as.numeric(dp[p+3]) else 0 delta <- if(abs(alpha) < Inf) alpha/sqrt(1+alpha^2) else sign(alpha) mu.Z <- zeta(1,tau)*delta s.Z <- sqrt(1+zeta(2,tau)*delta^2) gamma1 <- zeta(3,tau)*(delta/s.Z)^3 sigma <- omega*s.Z mu <- dp[1:p] mu[1] <- dp[1]+sigma*mu.Z/s.Z beta1 <- if(p>1) mu[2:p] else NULL cp <- c(mu, sigma, gamma1, if(family=="ESN") tau else NULL) names(cp) <- param.names("CP", family, p, x.names=names(beta1)) if(!is.null(upto)) cp <- cp[1:(upto+p-1)] } if(family=="ST" || family=="SC") { if(cp.type=="auto") cp.type <- if(family == "SC" || dp[4] <= 4) "pseudo" else "proper" } if(family %in% c("SC", "ST")) { fixed.nu <- if(family=="SC") 1 else NULL cp <- st.dp2cp(dp, cp.type, fixed.nu, jacobian=FALSE, upto=upto) if(is.null(cp)) {warning("no CP could be found"); return(invisible())} # param.type <- switch(cp.type, proper="CP", pseudo="pseudo-CP") # names(cp) <- param.names(param.type, family) } return(cp) } dp2cpMv <- function(dp, family, cp.type="proper", fixed.nu=NULL, aux=FALSE, upto=NULL) {# internal. NB: name of cp[1] must change according to dp[1] cp.type <- match.arg(cp.type, c("proper", "pseudo", "auto")) family <- toupper(family) if(!(family %in% c("SN", "ESN", "ST","SC"))) stop(gettextf("family '%s' is not supported", family), domain = NA) if(family %in% c("SN","ESN")){ if(cp.type == "pseudo") warning("'cp.type=pseudo' makes no sense for SN and ESN families") cp <- msn.dp2cp(dp, aux=aux) if(!is.null(upto)) cp <- cp[1:upto] } if(family %in% c("SC","ST")){ if(cp.type=="auto") cp.type <- if(family == "SC" || dp$nu <= 4) "pseudo" else "proper" if(family == "SC") fixed.nu <- 1 cp <- mst.dp2cp(dp, cp.type=cp.type, fixed.nu=fixed.nu, aux=aux, upto=upto) if(is.null(cp)) {warning("no CP could be found"); return(invisible())} } return(cp) } msn.dp2cp <- function(dp, aux=FALSE) {# dp2cp for multivariate SN and ESN alpha <- dp$alpha d <- length(alpha) Omega <- matrix(dp$Omega, d, d) omega <- sqrt(diag(Omega)) lot <- delta.etc(alpha, Omega) delta <- lot$delta delta.star <- lot$delta.star alpha.star <- lot$alpha.star names(delta) <- names(dp$alpha) tau <- if(is.null(dp$tau)) 0 else dp$tau mu.z <- zeta(1, tau) * delta sd.z <- sqrt(1 + zeta(2, tau) * delta^2) Sigma <- Omega + zeta(2,tau) * outer(omega*delta, omega*delta) gamma1 <- zeta(3, tau) * (delta/sd.z)^3 if(is.vector(dp[[1]])) { cp <- list(mean=dp[[1]] + mu.z*omega, var.cov=Sigma, gamma1=gamma1) } else { beta <- dp[[1]] beta[1,] <- beta[1,] + mu.z*omega cp <- list(beta=beta, var.cov=Sigma, gamma1=gamma1) } if(!is.null(dp$tau)) cp$tau <- tau if(aux){ lambda <- delta/sqrt(1-delta^2) D <- diag(sqrt(1+lambda^2), d, d) Ocor <- lot$Omega.cor Psi <- D %*% (Ocor-outer(delta,delta)) %*% D Psi <- (Psi + t(Psi))/2 O.inv <- pd.solve(Omega) O.pcor <- -cov2cor(O.inv) O.pcor[cbind(1:d, 1:d)] <- 1 R <- force.symmetry(Ocor + zeta(2,tau)*outer(delta,delta)) ratio2 <- delta.star^2/(1+zeta(2,tau)*delta.star^2) mardia <- c(gamma1M=zeta(3,tau)^2*ratio2^3, gamma2M=zeta(4,tau)*ratio2^2) # book: (5.74), (5.75) on p.153 cp$aux <- list(omega=omega, cor=R, Omega.inv=O.inv, Omega.cor=Ocor, Omega.pcor=O.pcor, lambda=lambda, Psi=Psi, delta=delta, lambda=lambda, delta.star=delta.star, alpha.star=alpha.star, mardia=mardia) } return(cp) } mst.dp2cp <- function(dp, cp.type="proper", fixed.nu=NULL, symmetr=FALSE, aux=FALSE, upto=NULL) {# dp2cp for multivariate ST, returns NULL if CP not found (implicitly silent) nu <- if(is.null(fixed.nu)) dp$nu else fixed.nu if(is.null(upto)) upto <- 4L if((round(upto) != upto)||(upto < 1)) stop("'upto' must be positive integer") if(nu <= upto && (cp.type =="proper")) return(NULL) if(cp.type == "proper") { if(nu <= upto) # stop(gettextf("d.f. '%s' too small, CP is undefined", nu), domain = NA) return(NULL) a <- rep(0, upto) tilde <- NULL } else { a <- (1:upto) tilde <- rep("~", upto) } Omega <- dp$Omega d <- ncol(Omega) comp.names <- colnames(dp$Omega) alpha <- if(symmetr) rep(0, d) else dp$alpha omega <- sqrt(diag(Omega)) lot <- delta.etc(alpha, Omega) delta <- lot$delta delta.star <- lot$delta.star alpha.star <- lot$alpha.star comp.names <- colnames(dp$Omega) names(delta) <- comp.names mu0 <- b(nu+a[1]) * delta * omega names(mu0) <- comp.names mu.2 <- b(nu+a[2]) * delta * omega if(is.vector(dp[[1]])) cp <- list(mean=dp[[1]] + mu0) else { beta <- dp[[1]] beta[1,] <- beta[1,] + mu0 cp <- list(beta=beta) } if(upto > 1) { Sigma <- Omega * (nu+a[2])/(nu+a[2]-2) - outer(mu.2, mu.2) dimnames(Sigma) <- list(comp.names, comp.names) cp$var.cov <- Sigma } cp$gamma1 <- if(upto > 2 & !symmetr) st.gamma1(delta, nu+a[3]) else NULL cp$gamma2M <- if(upto > 3 & is.null(fixed.nu)) mst.gamma2M(delta.star^2, nu+a[4], d) else NULL names(cp) <- paste(names(cp), tilde[1:length(cp)], sep="") # cp <- cp[1:length(dp1)] if(aux){ mardia <- mst.mardia(delta.star^2, nu, d) cp$aux <- list(fixed.nu=fixed.nu, omega=omega, Omega.cor=lot$Omega.cor, delta=delta, delta.star=delta.star, alpha.star=alpha.star, mardia=mardia) } return(cp) } mst.gamma2M <- function(delta.sq, nu, d) { # Mardia's index of kurtosis gamma_2 for ST-d if(delta.sq < 0 | delta.sq >1 ) stop("delta.sq not in (0,1)") ifelse(nu>4, {R <- b(nu)^2 * delta.sq * (nu-2)/nu R1R <- R/(1-R) (2*d*(d+2)/(nu-4) + (R/(1-R)^2)*8/((nu-3)*(nu-4)) +2*R1R^2*(-(nu^2-4*nu+1)/((nu-3)*(nu-4))+2*(nu/((nu-3)*b(nu)^2)-1)) +4*d*R1R/((nu-3)*(nu-4))) }, Inf) } mst.mardia <- function(delta.sq, nu, d) {# Mardia's gamma1 and gamam2 for MST; book: (6.31), (6.32), p.178 if(delta.sq < 0 | delta.sq > 1) stop("delta.sq not in (0,1)") if(d < 1) stop("d < 1") cum <- st.cumulants(0, 1, sqrt(delta.sq/(1-delta.sq)), nu) mu <- cum[1] sigma <- sqrt(cum[2]) gamma1 <- cum[3]/sigma^3 gamma2 <- cum[4]/sigma^4 gamma1M <- if(nu > 3) (gamma1^2 + 3*(d-1)*mu^2/((nu-3)*sigma^2)) else Inf r <- function(nu, k1, k2) 1/(1 - k2/nu) - k1/(nu - k2) # (nu-k1)/(nu-k2) gamma2M <- if(nu > 4) (gamma2 + 3 +(d^2-1)*r(nu,2,4) +2*(d-1)*(r(nu,0,4) -mu^2*r(nu,1,3))/sigma^2 - d*(d+2)) else Inf return(c(gamma1M=gamma1M, gamma2M=gamma2M)) } cp2dp <- function(cp, family){ family <- toupper(family) if(!(family %in% c("SN", "ESN", "ST","SC"))) stop(gettextf("family '%s' is not supported", family), domain = NA) dp <- if(is.list(cp)) cp2dpMv(cp, family) else cp2dpUv(cp, family) if(anyNA(dp)) dp <- NULL return(dp) } cp2dpUv <- function(cp, family, silent=FALSE, tol=1e-8) { # internal function; works also with regression parameters included family <- toupper(family) if(family=="ESN") stop("cp2dp for ESN not yet implemented") if(family == "SN") { p <- length(cp)-2-as.numeric(family=="ESN") beta1 <- if (p>1) cp[2:p] else NULL b <- sqrt(2/pi) sigma <- cp[p+1] excess <- max(0, -sigma) gamma1 <- cp[p+2] tau <- if(family=="ESN") as.numeric(cp[p+3]) else 0 max.gamma1 <- 0.5*(4-pi)*(2/(pi-2))^1.5 if (abs(gamma1) >= max.gamma1) { if (silent) excess <- excess + (abs(gamma1) - max.gamma1) else {message("gamma1 outside admissible range"); return(invisible())}} if(excess > 0) { out <- NA attr(out, "excess") <- excess return(out) } r <- sign(gamma1)*(2*abs(gamma1)/(4-pi))^(1/3) delta <- r/(b*sqrt(1+r^2)) alpha <- delta/sqrt(1-delta^2) mu.z <- b*delta sd.z <- sqrt(1-mu.z^2) beta <- cp[1:p] omega <- cp[p+1]/sd.z beta[1] <- cp[1] - omega*mu.z dp <- as.numeric(c(beta, omega, alpha)) names(dp) <- param.names("DP", family, p, x.names=names(beta1)) return(dp) } if(family == "ST") return(st.cp2dp(cp, silent=silent, tol=tol)) if(family == "SC") stop("this makes no sense for SC family") warning(gettextf("family = '%s' is not supported", family), domain = NA) invisible(NULL) } cp2dpMv <- function(cp, family, silent=FALSE, tol=1e-8) { # internal function if(family == "SN") dp <- msn.cp2dp(cp, silent) else if(family == "ESN") stop("cp2dp for ESN not yet implemented") else if(family == "ST") dp <- mst.cp2dp(cp, silent, tol=tol) else if(family == "SC") stop("this makes no sense for SC family") else warning(gettextf("family = '%s' is not supported", family), domain = NA) return(dp) } msn.cp2dp <- function(cp, silent=FALSE) { beta <- cp[[1]] Sigma <- cp[[2]] gamma1 <- cp[[3]] d <- length(gamma1) b <- sqrt(2/pi) max.gamma1 <- 0.5*(4-pi)*(2/(pi-2))^1.5 if(any(abs(gamma1) >= max.gamma1)) {if(silent) return(NULL) else stop("non-admissible CP")} R <- sign(gamma1)*(2*abs(gamma1)/(4-pi))^(1/3) delta <- R/(b*sqrt(1+R^2)) mu.z <- b*delta omega <- sqrt(diag(Sigma)/(1-mu.z^2)) Omega <- Sigma + outer(mu.z*omega, mu.z*omega) Omega.bar <- cov2cor(Omega) Obar.inv <- pd.solve(Omega.bar, silent=silent) if(is.null(Obar.inv)) {if(silent) return(NULL) else stop("non-admissible CP")} Obar.inv.delta <- as.vector(Obar.inv %*% delta) delta.sq <- sum(delta * Obar.inv.delta) if(delta.sq >= 1) {if(silent) return(NULL) else stop("non-admissible CP")} alpha <- Obar.inv.delta/sqrt(1-delta.sq) if(is.vector(beta)) { beta <- beta - omega*mu.z dp <- list(beta=beta, Omega=Omega, alpha=alpha) } else { beta[1,] <- beta[1,] - omega*mu.z dp <- list(beta=beta, Omega=Omega, alpha=alpha) } attr(dp, "delta.star") <- sqrt(delta.sq) return(dp) } st.dp2cp <- function(dp, cp.type="proper", fixed.nu=NULL, jacobian=FALSE, upto=NULL) { if(any(is.na(dp))) stop("NA's in argument 'dp'") if(!(cp.type %in% c("proper", "pseudo"))) stop("invalid cp.type") nu <- if(is.null(fixed.nu)) dp[length(dp)] else fixed.nu if(is.null(upto)) upto <- 4L if((round(upto) != upto)||(upto < 1)) stop("'upto' must be positive integer") if(nu <= upto && (cp.type =="proper")) return(NULL) p <- length(dp) - 2 - is.null(fixed.nu) beta1 <- if(p>1) dp[2:p] else NULL dp <- c(dp[1], dp[p+1], dp[p+2], nu) a <- if(cp.type == "proper") rep(0,upto) else (1:upto) omega <- dp[2] alpha <- dp[3] delta <- delta.etc(alpha) mu.z <- function(delta, nu) delta*b(nu) mu <- dp[1] + dp[2]* mu.z(delta, nu+a[1]) cp <- c(mu, beta1) if(upto > 1) { kappa2 <- function(delta,nu) nu/(nu-2) - mu.z(delta,nu)^2 sigma <- omega * sqrt(kappa2(delta, nu+a[2])) cp <- c(cp, sigma) } if(upto > 2) { g1 <- st.gamma1(delta, nu+a[3]) cp <- c(cp, g1) } if(upto > 3) { g2 <- st.gamma2(delta, nu+a[4]) cp <- c(cp, g2)} rv.comp <- c(rep(TRUE,upto-1), rep(FALSE, 4-upto)) param.type <- switch(cp.type, proper="CP", pseudo="pseudo-CP") names(cp) <- param.names(param.type, "ST", p, x.names=names(beta1), rv.comp) if(!is.null(fixed.nu) && upto==4) cp <- cp[-length(cp)] if(jacobian && (nu+a[3] > 3)) { u <- function(nu) 0.5*(1/nu + digamma((nu-1)/2) - digamma(nu/2)) Ddelta <- 1/(1+alpha^2)^1.5 Dkappa2.nu <- function(delta,nu) (-2)*(1/(nu-2)^2 + mu.z(delta,nu)^2 * u(nu)) Dg1.delta <- function(delta,nu) { # derivative di gamma1 wrt delta k2 <- kappa2(delta,nu) tmp <- nu/(nu-2)-delta^2*(nu-2*b(nu)^2*(nu-2)) (3*b(nu) *nu *tmp)/(k2^2.5 * (nu-2)*(nu-3)) } Dg1.nu <- function(delta,nu) {# derivative di gamma1 wrt nu k1 <- mu.z(delta,nu) k2 <- kappa2(delta,nu) Dk2.nu <- Dkappa2.nu(delta,nu) (g1*u(nu) + k1/k2^1.5*(-3*(3-delta^2)/(nu-3)^2 + 6/(nu-2)^2 + 4*k1^2*u(nu)) -3*g1*Dk2.nu/(2*k2)) } Dg2.delta <- function(delta,nu) {# derivative di gamma2 wrt delta k1 <- mu.z(delta, nu) k2 <- kappa2(delta,nu) 4*b(nu)^2*delta/k2 * (g2 + 3 -(2*(3-2*delta^2)*nu/(nu-3) -3*nu/(nu-2)+3*k1^2)/k2) } Dg2.nu <- function (delta, nu) {# derivative di gamma2 wrt nu k1 <- mu.z(delta, nu) k2 <- kappa2(delta,nu) b. <- b(nu) u. <- u(nu) k4 <- (3 * nu^2/((nu - 2) * (nu - 4)) -6*(delta*b.)^2 * nu*(nu-1)/((nu-2)*(nu-3)) + delta^4 * b.^2* (4*nu/(nu-3)-3*b.^2)) Dk4.nu <- (-6*nu*(3*nu-8)/((nu-2)*(nu-4))^2 -4*k1^2*(3-delta^2)*((2*u.*nu+1)*(nu-3)-nu)/(nu-3)^2 +6*k1^2*((2*u(nu)*nu+1)*(nu-2)-nu)/(nu-2)^2 -12*k1^4*u.) Dk2.nu <- Dkappa2.nu(delta,nu) Dk4.nu/k2^2 - 2*k4*Dk2.nu/k2^3 } Dcp.dp <- if(is.null(fixed.nu)) diag(1, p+3) else diag(1, p+2) Dcp.dp[1, p+1] <- mu.z(delta, nu+a[1]) Dcp.dp[1, p+2] <- omega * Ddelta * b(nu+a[1]) sigma.z <- sqrt(kappa2(delta, nu+a[2])) Dcp.dp[p+1,p+1] <- sigma.z Dcp.dp[p+1,p+2] <- -omega *delta *b(nu+a[2])^2 *Ddelta/sigma.z Dcp.dp[p+2,p+2] <- Dg1.delta(delta, nu+a[3]) * Ddelta if(is.null(fixed.nu) && (nu+a[4] > 4)) { Dcp.dp[1, p+3] <- omega * mu.z(delta, nu+a[1]) * u(nu+a[1]) Dcp.dp[p+1,p+3] <- omega * Dkappa2.nu(delta, nu+a[2])/(2 * sigma.z) Dcp.dp[p+2,p+3] <- Dg1.nu(delta, nu+a[3]) Dcp.dp[p+3,p+2] <- Dg2.delta(delta, nu+a[4]) * Ddelta Dcp.dp[p+3,p+3] <- Dg2.nu(delta, nu+a[4]) } attr(cp, "jacobian") <- Dcp.dp } return(cp) } # b <- function (nu) ifelse(nu>1, ifelse(nu < 1e8, # sqrt(nu/pi)*exp(lgamma((nu-1)/2)-lgamma(nu/2)), sqrt(2/pi)), NA) b <- function(nu){ out <- rep(NA, length(nu)) big.nu <- 1e4 big <- (nu > big.nu) ok <- ((nu > 1) & (!big) & (!is.na(nu))) out[big] <- sqrt(2/pi) * (1 + 0.75/nu[big] + 0.78125/nu[big]^2) out[ok] <- sqrt(nu[ok]/pi) * exp(lgamma((nu[ok]-1)/2) - lgamma(nu[ok]/2)) out} # st.gamma1 <- function(delta, nu) {# this function is vectorized for delta, works with a single value of nu if(nu > 1e6) { mu <- delta*sqrt(2/pi) return(0.5*(4-pi)*mu^3/(1-mu^2)^1.5) } if(nu > 3) { mu <- delta*b(nu) k2 <- nu/(nu-2)- mu^2 k3 <- mu * (nu * (3 - delta^2)/(nu-3) -3 * nu/(nu - 2) + 2 * mu^2) gamma1 <- k3/sqrt(k2)^3 } else gamma1<- Inf*sign(delta) gamma1 } # st.gamma2 <- function(delta, nu) {# this function is vectorized for delta, works a single value of nu # if(nu > 1e6) { mu <- delta*sqrt(2/pi) return(2*(pi-3)*mu^4/(1-mu^2)^2) } if(nu > 4) { mu <- delta*b(nu) k2 <- nu/(nu-2)- mu^2 k4 <- (3 * nu^2/((nu - 2) * (nu - 4)) - 4 * mu^2 * nu * (3 - delta^2)/(nu - 3) + 6 * mu^2 * nu/(nu - 2) -3*mu^4) gamma2 <- k4/k2^2 - 3 } else gamma2 <- Inf gamma2 } # st.cp2dp <- function(cp, cp.type="proper", start=NULL, silent=FALSE, tol=1e-8, trace=FALSE) { if(any(is.na(cp))) stop("NA's in argument 'cp'") if(!(cp.type %in% c("proper", "pseudo"))) stop("invalid cp.type") a <- if(cp.type == "proper") rep(0,4) else (1:4) p <- length(cp)-3 x.names <- if(p>1) names(cp[2:p]) else NULL gamma1 <- cp[p+2] abs.g1 <- abs(gamma1) gamma2 <- cp[p+3] tiny <- sqrt(.Machine$double.eps) fn0 <- function(log.nu, g1, a) st.gamma1(1, exp(log.nu) + a[3]) - g1 if(abs.g1 <= 0.5*(4-pi)*(2/(pi-2))^1.5) { sn.gamma2 <- 2*(pi-3)*(2*abs.g1/(4-pi))^(4/3) # SN book: (2.29)+(3.20) margin <- (gamma2 - sn.gamma2) if(abs(margin) < tiny) return(c(cp2dpUv(cp[-length(cp)], "SN"), nu=Inf)) feasible <- (margin > 0) excess <- max(0, sn.gamma2 - gamma2) } else { if(abs.g1 >= 4 & cp.type=="proper") { feasible <- FALSE; excess <- Inf } else { r0 <- uniroot(fn0, c(log(4-a[4]+tiny), 1000), tol=tol, g1=abs.g1, a) nu0 <- exp(r0$root) + a[3] feasible <- (gamma2 >= st.gamma2(1, nu0+a[4])) excess <- max(0, st.gamma2(1, nu0+a[4]) - gamma2) } } if(!feasible) { if(silent) { out <- NA attr(out, "excess") <- excess return(out)} else stop("CP outside feasible region")} if(is.null(start)){ delta <- 0.75 * sign(gamma1) old <- c(delta, Inf) } else { delta <- start[p+2]/sqrt(1+start[p+2]^2) old <- c(delta, start[p+3]) } step <- Inf fn1 <- function(delta, g1, nu, a) st.gamma1(delta, nu+a[3]) - g1 fn2 <- function(log.nu, g2, delta, a) st.gamma2(delta, exp(log.nu)+a[4]) - g2 out <- NULL while(step > tol){ fn21 <- fn2(log(4 - a[4]+ tiny), gamma2, delta, a) fn22 <- fn2(log(1e9), gamma2, delta, a) if(any(is.na(c(fn21, fn22)))) stop("parameter inversion failed") if(fn21 * fn22 > 0) { out <- NA attr(out, "excess") <- fn21*fn22 break} r2 <- uniroot(fn2, interval=c(log(4-a[4] +sqrt(.Machine$double.eps)), 100), tol=tol, g2=gamma2, delta=delta, a=a) nu <- exp(r2$root) if(fn1(-1, gamma1, nu, a) * fn1(1, gamma1, nu, a)> 0) { out <- NA attr(out, "excess") <- fn1(-1, gamma1, nu, a) * fn1(1, gamma1, nu, a) break} r1 <- uniroot(fn1, interval=c(-1,1), tol=tol, g1=gamma1, nu=nu, a=a) delta <- r1$root new <- c(delta, nu) step <- abs(old-new)[1] + abs(log(old[2])- log(new[2])) if(trace) cat("delta, nu, log(step):", format(c(delta, nu, log(step))),"\n") old <- new } if(anyNA(out)) return(out) mu.z <- function(delta, nu) delta*b(nu) kappa2 <- function(delta,nu) nu/(nu-2) - mu.z(delta,nu)^2 omega <- cp[p+1]/sqrt(kappa2(delta, nu+a[2])) xi <- cp[1] - omega*mu.z(delta, nu+a[1]) if(omega < 0) { if(silent) { out <- NA attr(out, "excess") <- abs(omega) return(out)} else stop("CP outside feasible region")} alpha <- delta/sqrt(1-delta^2) dp <- c(xi, if(p>1) cp[2:p] else NULL, omega, alpha, nu) names(dp) <- param.names("DP", "ST", p, x.names=x.names) return(dp) } mst.cp2dp <- function(cp, silent=FALSE, tol=1e-8, trace=FALSE) { mu <- drop(cp[[1]]) Sigma <- cp[[2]] gamma1 <- cp[[3]] gamma2M <- cp[[4]] d <- length(gamma1) # fn1 <- function(delta, g1, nu) st.gamma1(delta, nu) - g1 # fn2 <- function(log.nu, g2, delta.sq, d) # mst.gamma2M(delta.sq, exp(log.nu), d) - g2 if(any(abs(gamma1) >= 4)) {if(silent) return(NULL) else stop("cp$gamma1 not admissible")} dp.marg <- matrix(NA, d, 4) for(j in 1:d) { dp <- st.cp2dp(c(0,1,gamma1[j], gamma2M), silent=silent) if(is.null(dp)) {if(silent) return(NULL) else stop("no CP could be found")} dp.marg[j,] <- dp } if(trace) {cat("starting dp:\n"); print(dp.marg)} fn <- function(par, Sigma, gamma1, gamma2M, trace=FALSE){ if(trace) cat("[mst.cp2dp[fn]] par:", format(par), "\n") nu <- exp(par[1])+4 delta <- par[-1]/sqrt(1+par[-1]^2) d <- length(delta) mu.z <- delta*b(nu) omega <- sqrt(diag(Sigma)/(nu/(nu-2)-mu.z^2)) Omega.bar <- (diag(1/omega, d, d) %*% Sigma %*% diag(1/omega, d, d) + outer(mu.z, mu.z)) * (nu-2)/nu Obar.inv <- pd.solve(force.symmetry(Omega.bar)) delta.sq <- sum(delta * as.vector(Obar.inv %*% delta)) if(delta.sq >= 1) return(delta.sq*10^10) L1 <- sum((st.gamma1(delta, nu) - gamma1)^2) L2 <- (mst.gamma2M(delta.sq, nu, d) - gamma2M)^2 # if(trace){ ecat(c(nu,delta,L1,L2))} # ; readline("")} L1 + L2 } nu <- min(dp.marg[,4]) par <- c(log(nu-4), dp.marg[,3]) if(trace) cat("[mst.cp2dp] par:", format(par), "\n") opt <- nlminb(par, fn, Sigma=Sigma, gamma1=gamma1, gamma2M=gamma2M, trace=trace) if(trace) cat("[mst.cp2dp]\nopt$convergence:", opt$convergence, "\nopt$message", opt$message, "\n") if(opt$convergence != 0) { if(silent) return(NULL) else stop ("no CP could be found") } par <- opt$par nu <- exp(par[1])+4 delta <- par[-1]/sqrt(1+par[-1]^2) if(trace) { cat("[mst.cp2dp]min opt$fn:", format(opt$obj),"\n") print(c(nu,delta)) } mu.z <- delta*b(nu) omega<- sqrt(diag(Sigma)/(nu/(nu-2)-mu.z^2)) Omega.bar <- (diag(1/omega, d, d) %*% Sigma %*% diag(1/omega, d, d) + outer(mu.z,mu.z)) * (nu-2)/nu Obar.inv <- pd.solve(Omega.bar) delta.sq <- sum(delta * as.vector(Obar.inv %*% delta)) alpha <- as.vector(Obar.inv %*% delta)/sqrt(1-delta.sq) if(is.matrix(mu)) { xi <- mu xi[1,] <- mu[1,] - omega*mu.z } else xi <- mu - omega*mu.z Omega <- diag(omega) %*% Omega.bar %*% diag(omega) return(list(xi=xi, Omega=Omega, alpha=alpha, nu=nu)) } affineTransSECdistr <- function(object, a, A, name, compNames, drop=TRUE) {# object is of class SECdistrMv # computes distribution of affine transformation of SEC variable T=a+t(A)Y if(class(object) != "SECdistrMv") stop("wrong object class") dp <- slot(object, "dp") alpha <- dp$alpha d <- length(alpha) if(!is.matrix(A) || nrow(A) != d) stop("A is not a matrix or wrong nrow(A)") h <- ncol(A) if(length(a) != h) stop("size mismatch of arguments 'a' and 'A'") if(missing(name)) name<- paste(deparse(substitute(a)), " + t(", deparse(substitute(A)), ") %*% (", deparse(substitute(object)),")", sep="") else name <- as.character(name)[1] compNames <- if(missing(compNames)) as.vector(outer("V",as.character(1:h),paste,sep="")) else as.character(as.vector(compNames)[1:h]) family <- object@family xi.X <- as.vector(a + t(A) %*% matrix(dp$xi, ncol=1)) Omega <- dp$Omega omega <- sqrt(diag(Omega)) Omega.X <- as.matrix(t(A) %*% Omega %*% A) invOmega.X <- pd.solve(Omega.X, silent=TRUE) if (is.null(invOmega.X)) stop("not full-rank transformation") omega.X <- sqrt(diag(Omega.X)) omega.delta <- omega * delta.etc(alpha, Omega)$delta m <- as.vector(invOmega.X %*% t(A) %*% matrix(omega.delta, ncol=1)) u <- sum(omega.delta * as.vector(A %*% matrix(m, ncol=1))) alpha.X <- (omega.X * m)/sqrt(1 - u) dp.X <- list(xi=xi.X, Omega=Omega.X, alpha=alpha.X) if(family == "ESN") dp.X$tau <- dp$tau if(family == "ST") dp.X$nu <- dp$nu if(h==1 & drop) { dp1 <- unlist(dp.X) dp1[2] <- sqrt(dp1[2]) names(dp1) <- names(dp.X) names(dp1)[2] <- tolower(names(dp)[2]) # new.obj <- new("SECdistrUv", dp=dp1, family=family, name=name) #?? new.obj <- makeSECdistr(dp=dp1, family=family, name=name) } else new.obj <- makeSECdistr(dp.X, family, name, compNames) # new.obj <- new("SECdistrMv", dp.X, family, name, compNames) #?? return(new.obj) } marginalSECdistr <- function(object, comp, name, drop=TRUE) {# marginals of SECdistrMv obj; 2nd version, computing marginal delta's family <- slot(object,"family") if(missing(name)) { basename <- if(object@name != "") object@name else deparse(substitute(object)) name<- paste(basename, ".components=(", paste(as.character(comp),collapse=","), ")", sep="") } else name <- as.character(name)[1] dp <- slot(object,"dp") xi <- dp$xi Omega <- dp$Omega alpha <- dp$alpha compNames <- slot(object,"compNames") d <- length(alpha) comp <- as.integer(comp) Omega11 <- Omega[comp,comp,drop=FALSE] if(length(comp) < d){ if(any(comp>d | comp<1)) stop("comp makes no sense") delta_etc <- delta.etc(alpha, Omega) delta1 <- delta_etc$delta[comp] R11 <- delta_etc$Omega.cor[comp, comp, drop=FALSE] iR11.delta1 <- as.vector(pd.solve(R11, silent=TRUE) %*% delta1) diRd <- sum(delta1*iR11.delta1) alpha1_2 <- if(diRd < 1) iR11.delta1/sqrt(1 - diRd) else sign(delta1)*Inf dp0 <- list(xi=xi[comp], Omega=Omega11, alpha=alpha1_2) } else { if(any(sort(comp) != (1:d))) stop("comp makes no sense") dp0 <- list(xi=xi[comp], Omega=Omega11, alpha=alpha[comp]) } if(family=="ESN") dp0$tau <- dp$tau if(family=="ST") dp0$nu <- dp$nu new.obj <- new("SECdistrMv", dp=dp0, family=family, name=name, compNames=compNames[comp]) if(length(comp)==1 & drop) {# new.obj <- as(new.obj, "SECdistrUv") # non va.. dp <- unlist(dp0) names(dp) <- names(dp0) dp[2] <- sqrt(dp[2]) names(dp)[2] <- "omega" new.obj <- new("SECdistrUv", dp=dp, family=family, name=compNames[comp]) } new.obj } conditionalSECdistr <- function(object, fixed.comp, fixed.values, name, drop=TRUE) { # conditional distribution of SN/ESN object family <- slot(object,"family") if(!(family %in% c("SN", "ESN"))) stop("family must be either SN or ESN") dp <- slot(object,"dp") xi <- dp$xi Omega <- dp$Omega alpha <- dp$alpha tau <- if(family=="SN") 0 else dp$tau d <- length(alpha) fix <- fixed.comp h <- length(fix) if(any(fix != round(fix)) | !all(fix %in% 1:d) | h == d) stop("fixed.comp makes no sense") if(length(fixed.values) != h) stop("length(fixed.comp) != lenght(fixed.values)") compNames <- slot(object,"compNames") if(missing(name)) { basename <- if(object@name != "") object@name else deparse(substitute(object)) name<- paste(basename,"|(", paste(compNames[fix],collapse=","), ")=(", paste(format(fixed.values),collapse=","), ")", sep="") } else name <- as.character(name)[1] # free.fix <- setdiff(1:d, fix) omega <- sqrt(diag(Omega)) omega1 <- omega[fix] omega2 <- omega[-fix] R <- cov2cor(Omega) R11 <- R[fix,fix, drop=FALSE] R12 <- R[fix,-fix, drop=FALSE] R21 <- R[-fix,fix, drop=FALSE] R22 <- R[-fix,-fix, drop=FALSE] alpha1 <- matrix(alpha[fix], ncol=1) alpha2 <- matrix(alpha[-fix], ncol=1) iR11 <- pd.solve(R11) R22.1 <- R22 - R21 %*% iR11 %*% R12 a.sum <- as.vector(t(alpha2) %*% R22.1 %*% alpha2) alpha1_2 <- as.vector(alpha1 + iR11 %*% R12 %*% alpha2)/sqrt(1+a.sum) tau2.1 <- (tau * sqrt(1 + sum(alpha1_2 * as.vector(iR11 %*% alpha1_2))) + sum(alpha1_2 * (fixed.values-xi[fix])/omega1)) O11 <- Omega[fix,fix, drop=FALSE] O12 <- Omega[fix,-fix, drop=FALSE] O21 <- Omega[-fix,fix, drop=FALSE] O22 <- Omega[-fix,-fix, drop=FALSE] iO11<- (1/omega1) * iR11 * rep(1/omega1, each=h) # solve(O11) reg <- O21 %*% iO11 xi2.1 <- as.vector(xi[-fix]+ reg %*% (fixed.values - xi[fix])) O22.1 <- O22 - reg %*% O12 omega22.1 <- sqrt(diag(O22.1)) alpha2.1 <- as.vector((omega22.1/omega2)*alpha2) dp2.1 <- list(xi=xi2.1, Omega=O22.1, alpha=alpha2.1, tau=tau2.1) obj <- if((d-h)==1 & drop) { dp2.1 <- unlist(dp2.1) dp2.1[2] <- sqrt(dp2.1[2]) names(dp2.1) <- c("xi","omega","alpha","tau") new("SECdistrUv", dp=dp2.1, family="ESN", name=name) } else new("SECdistrMv", dp=dp2.1, family="ESN", name=name, compNames=compNames[-fix]) return(obj) } delta.etc <- function(alpha, Omega=NULL) { inf <- which(abs(alpha) == Inf) if(is.null(Omega)){ # case d=1 delta <- alpha/sqrt(1+alpha^2) delta[inf] <- sign(alpha[inf]) return(delta) } else { # d>1 if(any(dim(Omega) != rep(length(alpha),2))) stop("dimension mismatch") Ocor <- cov2cor(Omega) if(length(inf) == 0) { # d>1, standard case Ocor.alpha <- as.vector(Ocor %*% alpha) alpha.sq <- sum(alpha * Ocor.alpha) delta <- Ocor.alpha/sqrt(1+alpha.sq) alpha. <- sqrt(alpha.sq) delta. <- sqrt(alpha.sq/(1+alpha.sq)) } else { # d>1, case with some abs(alpha)=Inf if(length(inf) > 1) warning("Several abs(alpha)==Inf, I handle them as 'equal-rate Inf'") k <- rep(0,length(alpha)) k[inf] <- sign(alpha[inf]) Ocor.k <- as.vector(Ocor %*% k) delta <- Ocor.k/sqrt(sum(k * Ocor.k)) delta. <- 1 alpha. <- Inf } return( list(delta=delta, alpha.star=alpha., delta.star=delta., Omega.cor=Ocor)) } } selm <- function (formula, family="SN", data, weights, subset, na.action, start=NULL, fixed.param=list(), method="MLE", penalty=NULL, offset, model=TRUE, x = FALSE, y = FALSE, ...) { ret.x <- x ret.y <- y cl <- match.call() formula <- as.formula(formula) if (length(formula) < 3) stop("formula must be a two-sided formula") mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") mf <- eval(mf, parent.frame()) method <- toupper(method) if(!(method %in% c("MLE", "MPLE"))) { warning(gettextf("method = '%s' is not supported, replaced by 'MLE'", method), domain = NA) method <- "MLE"} penalty.name <- if(method == "MPLE") { if(is.null(penalty)) "Qpenalty" else penalty } else NULL contr <- list(penalty=penalty.name, trace=FALSE, info.type="observed", opt.method="nlminb", opt.control=list()) control <- list(...) contr[(namc <- names(control))] <- control if (length(noNms <- namc[!namc %in% names(contr)])) warning( "unknown names in control: ", paste(noNms, collapse = ", ")) mt <- attr(mf, "terms") y <- model.response(mf, "numeric") w <- as.vector(model.weights(mf)) if(is.null(w)) w <- rep(1, NROW(y)) if(any(w != round(w)) | all(w == 0)) stop("weights must be non-negative integers (=frequencies), not all 0") offset <- as.vector(model.offset(mf)) if (!is.null(offset)) { if (length(offset) == 1) offset <- rep(offset, NROW(y)) else if (length(offset) != NROW(y)) stop(gettextf( "number of offsets is %d, should equal %d (number of observations)", length(offset), NROW(y)), domain = NA) } if(length(fixed.param) > 0) { if(!all(names(fixed.param) %in% c("nu", "alpha"))) stop("Not admissible component of 'fixed.param'") if(!is.null(fixed.param$alpha)) { if(fixed.param$alpha != 0) stop("'alpha' can only be fixed at 0") if(method == "MPLE") stop('method MPLE not allowed when alpha=0') } } if (is.empty.model(mt)) stop("empty model") else { x <- model.matrix(mt, mf, contrasts) xt <- pd.solve(t(x) %*% (w*x), silent=TRUE) if(is.null(xt)) stop("design matrix appears to be of non-full rank") z <- selm.fit(x, y, family=family, start, w=w, fixed.param=fixed.param, offset=offset, selm.control=contr) } class(z) <- c(if (is.matrix(y)) "mselm", "selm") z$na.action <- attr(mf, "na.action") z$offset <- offset z$contrasts <- attr(x, "contrasts") z$xlevels <- .getXlevels(mt, mf) z$call <- cl z$terms <- mt input <- list() if (model) input$model <- mf if (ret.x) input$x <- x if (ret.y) input$y <- y # input$weights <- as.vector(model.weights(mf)) # input$offset <- as.vector(model.offset(mf)) # cl.obj <- if(is.matrix(y)) "mselm" else "selm" obj <- new(class(z), call=cl, family=toupper(family), logL=z$logL, method=c(method, contr$penalty), param=z$param, param.var=z$param.var, size=z$size, residuals.dp=z$resid.dp, fitted.values.dp=z$fitted.dp, control=control, input=input, opt.method=z$opt.method) return(obj) } # #selm.control <- function(method="MLE", info.type="observed", # trace=FALSE, algorithm="nlminb", opt.control=list()) #{ # if(algorithm !="nlminb") stop("only algorithm='nlminb' handled so far") # if(info.type !="observed") stop("only info.type='observed' handled so far") # list(method=method, info.type=info.type, trace=trace, # algorithm=algorithm, opt.control=opt.control) #} #------------------------------------------------------ selm.fit <- function (x, y, family="SN", start=NULL, w, fixed.param=list(), offset = NULL, selm.control) { if (!(toupper(family) %in% c("SN", "ST", "SC"))) stop(gettextf("I do not know family '%s'", family), domain = NA) family <- toupper(family) if (is.null(n <- nrow(x))) stop("'x' must be a matrix") if (n == 0L) stop("0 (non-NA) cases") if(NROW(y) != n) stop("'x' and 'y' have non-compatible dimensions") p <- ncol(x) if ((p == 0L) || !(all(data.matrix(x)[,1] == 1))) stop("first column of model matrix is not all 1's") y <- drop(y) d <- NCOL(y) if(d>1 && is.null(colnames(y))) colnames(y) <- paste("V", 1:d, sep="") if(is.null(colnames(x))) colnames(x) <- paste("x", 0L:(p-1), sep=".") if (!is.null(offset)) y <- (y - offset) if (NROW(y) != n) stop("incompatible dimensions") if (missing(w) || is.null(w)) w <- rep(1, n) nw <- sum(w) n.obs <- NROW(y) contr <- list(method="MLE", penalty=NULL, trace=FALSE, info.type="observed", opt.method="nlminb", opt.control=list()) control <- selm.control contr[(namc <- names(control))] <- control symmetr <- FALSE if(length(fixed.param) > 0) { if(!all(names(fixed.param) %in% c("nu", "alpha"))) stop("Not admissible component of 'fixed.param'") if(!is.null(fixed.param$alpha)) { if( fixed.param$alpha != 0 ) stop("'alpha' can only be fixed at 0") else symmetr <- TRUE } } zero.weights <- any(w == 0) if(zero.weights) { save.r <- y save.f <- y save.w <- w ok <- (w != 0) nok <- !ok w <- w[ok] x0 <- x[!ok, , drop = FALSE] x <- x[ok, , drop = FALSE] n <- nrow(x) y0 <- if (d > 1L) y[!ok, , drop = FALSE] else y[!ok] y <- if (d > 1L) y[ok, , drop = FALSE] else y[ok] } storage.mode(x) <- "double" storage.mode(y) <- "double" info.type <- contr$info.type # so far, only "observed" yInfo <- if(contr$info.type == "observed") y else NULL penalty <- contr$penalty # either NULL or a char string penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) trace <- contr$trace if(d == 1) { y <- as.vector(y) if(family == "SN") { npar <- p + 2 - as.numeric(symmetr) if(symmetr) { # SN with alpha=0 is Gaussian case ls <- lm.wfit(x, y, w) # note: offset already subtracted if any res <- residuals(ls) s2 <- sum(w*res^2)/nw param <- c(coef(ls), sqrt(s2)) j <- rbind(cbind(t(x) %*% (w*x)/s2, 0), c(rep(0,p), 2*nw/s2)) j.inv <- solve(j) se <- sqrt(diag(j.inv)) info <- list(dp=param, cp=param, info.dp=j, info.cp=j, asyvar.dp=j.inv, asyvar.cp=j.inv, se.dp=se, se.cp=se, aux=NULL) logL <- (-0.5*nw)*(log(2*pi*s2) +1) fit <- list(cp=param, dp=param, dp.complete=c(param,0), opt.method=list(ls$qr), logL=logL) boundary <- FALSE fit$opt.method <- list(method="least_squares", called.by= "lm.wfit") mu0 <- 0 } else { # proper SN case cp <- if(is.null(start)) NULL else dp2cpUv(start, "SN") fit <- sn.mple(x, y, cp, w, penalty, trace, contr$opt.method, contr$control) fit$dp <- cp2dpUv(cp=fit$cp, family="SN") boundary <- fit$boundary mu0 <- fit$cp[1] - fit$dp[1] info <- if(boundary) NULL else sn.infoUv(dp=fit$dp, x=x, y=yInfo, w=w, penalty=penalty) }} if(family == "ST") { fixed.nu <- fixed.param$nu npar <- p + 2 + as.numeric(is.null(fixed.nu)) - as.numeric(symmetr) fit <- st.mple(x, y, dp=start, w, fixed.nu, symmetr, penalty, trace, contr$opt.method, contr$control) dp <- fit$dp cp <- st.dp2cp(dp, cp.type="proper", fixed.nu=fixed.nu, upto=4-as.numeric(!is.null(fixed.nu))) p_cp<- st.dp2cp(dp, cp.type="pseudo", fixed.nu=fixed.nu, jacobian=TRUE) fit$cp <- cp[1:npar] fit$p_cp <- p_cp[1:npar] Dpseudocp.dp <- attr(p_cp, "jacobian")[1:npar, 1:npar] attr(p_cp, "jacobian") <- NULL boundary <- fit$boundary nu <- if(is.null(fixed.nu)) dp[npar] else fixed.nu mu0 <- if(nu <= 1) NA else st.dp2cp(dp, fixed.nu=fixed.nu, upto=1)[1] - dp[1] info <- if(boundary) NULL else st.infoUv(dp=fit$dp, NULL, x, yInfo, w, fixed.nu, symmetr, penalty) } if(family == "SC") { npar <- p + 2 - as.numeric(symmetr) fit <- st.mple(x, y, dp=start, w, fixed.nu=1, symmetr, penalty, trace, contr$opt.method, contr$control) fit$cp <- NULL p_cp0 <- st.dp2cp(fit$dp, cp.type="pseudo", fixed.nu=1, jacobian=TRUE) fit$p_cp <- p_cp0[1:npar] Dpseudocp.dp <- attr(p_cp0, "jacobian")[1:npar, 1:npar] attr(p_cp0, "jacobian") <- NULL boundary <- fit$boundary mu0 <- NA info <- if(boundary) NULL else st.infoUv(dp=fit$dp, x=x, y=yInfo, w=w, fixed.nu=1, symmetr=symmetr) } if(!boundary && family %in% c("ST","SC")) info$asyvar.p_cp <- Dpseudocp.dp %*% info$asyvar.dp %*% t(Dpseudocp.dp) beta.dp <- fit$dp[1:p] dp <- fit$dp cp <- fit$cp } else { # d>1 npar0 <- p*d + d*(d+1)/2 if(family == "SN") { if(symmetr) { # SN with alpha=0 is Gaussian case npar <- npar0 ls <- lm.wfit(x, y, w) # note: offset already subtracted if any beta <- coef(ls) res <- residuals(ls) s2 <- t(res) %*% (w*res)/nw dp <- dp. <- list(beta=beta, Omega=s2) dp.$alpha <- rep(0,d) param <- c(beta, vech(s2)) conc <- solve(s2) betaBlock <- conc %x% (t(x) %*% (w*x)) D <- duplicationMatrix(d) varBlock <- (n/2) * t(D) %*% (conc %x% conc) %*% D m0 <- matrix(0, p*d, d*(d+1)/2) j <- rbind(cbind(betaBlock, m0), cbind(t(m0), varBlock)) # use (10) in section 15.8 of Magnus & Neudecker (1988/1999, p.321) j.inv <- rbind(cbind(solve(betaBlock), m0), cbind(t(m0), solve(varBlock))) diags.dp <- sqrt(diag(j.inv)) se.beta <- matrix(diags.dp[1:(p*d)], p, d) se.diagOmega <- diags.dp[p*d + d*(d+1)/2 +1 -rev(cumsum(1:d))] se <- list(beta=se.beta, diagOmega=se.diagOmega) info <- list(dp=param, cp=param, info.dp=j, info.cp=j, asyvar.dp=j.inv, asyvar.cp=j.inv, se.dp=se, se.cp=se, aux=NULL) logL <- (-0.5*nw)*(determinant(2*pi*s2, logarithm=TRUE)$modulus + d) # see (6.2.7) of Mardia, Kent & Bibby (1979) fit <- list(dp=dp, cp=dp, dp.complete=dp., logL=logL) fit$opt.method <- list(method="lm.wfit") boundary <- FALSE mu0 <- rep(0, d) } else { # proper SN case npar <- npar0 + d if(is.null(penalty)) { # MLE fit <- msn.mle(x, y, start, w, trace=trace, opt.method=contr$opt.method, control=contr$opt.control) boundary <- ((1 - fit$aux$delta.star) < .Machine$double.eps^(1/4)) if(!boundary) info <- sn.infoMv(fit$dp, x=x, y=yInfo, w=w) } else { # MPLE fit <- msn.mple(x, y, start, w, penalty, trace=trace, opt.method=contr$opt.method, control=contr$opt.control) boundary <- FALSE info <- sn.infoMv(fit$dp, x=x, y=y, w=w, penalty=penalty) } fit$cp <- msn.dp2cp(fit$dp) mu0 <- as.vector(fit$cp[[1]][1,] - fit$dp[[1]][1,]) }} if(family == "ST"){ fixed.nu <- fixed.param$nu npar <- npar0 + d*as.numeric(!symmetr) + as.numeric(is.null(fixed.nu)) fit <- mst.mple(x, y, start, w, fixed.nu=fixed.nu, symmetr=symmetr, penalty=penalty, trace=trace, opt.method=contr$opt.method, control=contr$opt.control) fit$opt.method$called.by <- "mst.mple" boundary <- fit$boundary dp <- fit$dp nu <- if(is.null(fixed.nu)) dp$nu else fixed.nu mu0 <- if(nu <= 1) NA else as.vector(mst.dp2cp(dp, fixed.nu=fixed.nu, symmetr=symmetr, upto=1)[[1]][1,] - dp[[1]][1,]) fit$cp <- mst.dp2cp(dp, cp.type="proper", fixed.nu, symmetr) fit$p_cp <- mst.dp2cp(dp, cp.type="pseudo", fixed.nu, symmetr) if(!boundary) info <- st.infoMv(dp, x=x, y=yInfo, w, fixed.nu, symmetr, penalty) } if(family == "SC") { npar <- npar0 + d*as.numeric(!symmetr) if(is.null(start)) { fit.sn <- msn.mle(x, y, NULL, w, control=list(rel.tol=1e-4)) start <- fit.sn$dp } fit <- mst.mple(x, y, start, w, fixed.nu=1, symmetr=symmetr, penalty=penalty, trace=trace, opt.method=contr$opt.method, control=contr$opt.control) fit$opt.method$called.by <- "mst.mple" npar <- p*d + d*(d+1)/2 + d*as.numeric(!symmetr) boundary <- fit$boundary mu0 <- NA fit$cp <- NULL fit$p_cp <- mst.dp2cp(fit$dp, "pseudo", fixed.nu=1) if(!boundary) info <- st.infoMv(fit$dp, x=x, y=yInfo, w, fixed.nu=1, symmetr, penalty) } beta.dp <- fit$dp[[1]] } param <- list(dp=fit$dp, cp=fit$cp, "pseudo-cp"=fit$p_cp, boundary=boundary, mu0=mu0) if(!boundary && !is.null(info)) { asyvar.dp <- info$asyvar.dp[1:npar, 1:npar] asyvar.cp <- info$asyvar.cp[1:npar, 1:npar] asyvar.p_cp <- info$asyvar.p_cp[1:npar, 1:npar] param.var <- list(info.type=info.type, dp=asyvar.dp, cp=asyvar.cp, "pseudo-cp"=asyvar.p_cp) } else param.var <- list() dn <- colnames(x) fv <- drop(x %*% beta.dp) if(is.matrix(fv)) colnames(fv) <- colnames(y) size <- c(d=d, p=p, n.param=npar, n.obs=n.obs, nw.obs=sum(w)) z <- list(call=match.call(), logL=fit$logL, param=param, param.var=param.var, fitted.dp=fv, resid.dp=y-fv, size=size, selm.control=contr, opt.method=fit$opt.method) r1 <- y - z$resid.dp z$weights <- w if (zero.weights) { # coef[is.na(coef)] <- 0 f0 <- x0 %*% beta.dp if (d > 1) { save.r[ok, ] <- z$resid.dp save.r[nok, ] <- y0 - f0 save.f[ok, ] <- z$fitted.dp save.f[nok, ] <- f0 } else { save.r[ok] <- z$resid.dp save.r[nok] <- y0 - f0 save.f[ok] <- z$fitted.dp save.f[nok] <- f0 } z$resid.dp <- save.r z$fitted.dp <- save.f z$weights <- save.w } if(!is.null(offset)) { z$fitted.dp <- z$fitted.dp + offset r1 <- r1 + offset } # z$fitted.dp <- r1 if(length(fixed.param) > 0) { z$param$fixed <- fixed.param z$param$dp.complete <- fit$dp.complete } else z$param$fixed <- z$param$dp.complete<- list() return(z) } #--------------------------------------------------- summary.selm <- function(object, param.type="CP", cov=FALSE, cor=FALSE) { fixed <- slot(object, "param")$fixed if(length(fixed$alpha==0)>0 && fixed$alpha==0) { param.type <- "DP" note <- "param.type=DP has been set because of constraint alpha=0" } else note <- "" lc.param.type <- tolower(param.type) if(!(lc.param.type %in% c("cp", "op", "dp", "pseudo-cp"))) stop(gettextf("unknown param.type '%s'", param.type), domain = NA) param.type <- switch(lc.param.type, "dp"="DP", "op"="OP", "cp"="CP", "pseudo-cp"="pseudo-CP") family <- slot(object,"family") if(param.type=="pseudo-CP" && !(family %in% c("ST", "SC"))) stop("pseudo-CP makes sense only for ST and SC families") if (!(family %in% c("SN","ST","SC"))) stop(gettextf("family '%s' not (yet) handled", family), domain = NA) param <- slot(object, "param")[[lc.param.type]] if(param.type=="CP" && is.null(param)) { if(family %in% c("ST", "SC")) { {message("CP does not exist. Consider param.type='DP' or 'pseudo-CP'") return(invisible())}}} param.var <- slot(object, "param.var")[[lc.param.type]] if(is.null(param.var)) param.var <- diag(NA, length(param)) se <- sqrt(diag(param.var)) z <- param/se param.table <- cbind(param, se, z, 2*pnorm(-abs(z))) dimnames(param.table) <- list(names(param), c("estimate","std.err","z-ratio", "Pr{>|z|}")) resid <- residuals(object, lc.param.type) aux <- list() aux$param.cov <- if(cov) param.var else NULL aux$param.cor <- if(cor) cov2cor(param.var) else NULL out <- new("summary.selm", call=slot(object,"call"), family = slot(object, "family"), logL = slot(object, "logL"), method=slot(object, "method"), resid = resid, param.type = param.type, param.table = param.table, param.fixed = fixed, control = slot(object, "control"), aux = aux, boundary=slot(object, "param")$boundary, size=object@size, note=note) out } residuals.selm <- function(object, param.type="CP", ...){ param.type <- tolower(param.type) if(!(param.type %in% c("cp", "dp", "pseudo-cp"))) stop("param.type must be either 'CP' or 'DP' or 'pseudo-CP'") # param <- slot(object, "param")[[param.type]] p <- object@size["p"] n <- object@size["n.obs"] r <- slot(object, "residuals.dp") dp <- slot(object, "param")$dp pseudo.mu0 <- (slot(object, "param")$"pseudo-cp"[1] - dp[1]) resid <- switch(param.type, 'dp' = r, 'cp' = r - rep(slot(object,"param")$mu0, n), 'pseudo-cp' = r - rep(pseudo.mu0, n)) # resid <- resid/param[p+1] # AA: standardize resid? w <- slot(object,"input")$weights if(!is.null(w)) attr(resid,"weights") <- w return(resid) } fitted.selm <- function(object, param.type="CP", ...) { param.type <- tolower(param.type) if(!(param.type %in% c("cp", "dp", "pseudo-cp"))) stop("param.type must be either 'CP' or 'DP' or 'pseudo-CP'") # param <- slot(object, "param")[[param.type]] n <- object@size["n.obs"] dp <- slot(object, "param")$dp fit.dp <- slot(object,"fitted.values.dp") pseudo.mu0 <- (slot(object, "param")$"pseudo-cp"[1] - dp[1]) fitted <- switch(param.type, 'dp' = fit.dp, 'cp' = fit.dp + rep(slot(object,"param")$mu0, n), 'pseudo-cp' = fit.dp + rep(pseudo.mu0, n)) w <- slot(object, "input")$weights if(!is.null(w)) attr(fitted,"weights") <- w return(fitted) } weights.selm <- function(object, ...) slot(object, "input")$weights summary.mselm <- function(object, param.type="CP", cov=FALSE, cor=FALSE) { fixed <- slot(object, "param")$fixed if(length(fixed$alpha==0)>0 && fixed$alpha==0) { param.type <- "DP" note <- "param.type=DP has been set because of constraint alpha=0" } else note <- "" lc.param.type <- tolower(param.type) if(!(lc.param.type %in% c("dp", "op", "cp", "pseudo-cp"))) stop(gettextf("unknown param.type '%s'", param.type), domain = NA) param.type <- switch(lc.param.type, "dp"="DP", "op"="DP", "cp"="CP", "pseudo-cp"="pseudo-CP") # OP not yet implemented, so far re-directed to DP family <- slot(object, "family") method <- slot(object, "method") if(param.type=="pseudo-CP" & !(family %in% c("ST","SC"))) stop("pseudo-CP makes sense only for ST and SC families") p <- object@size["p"] d <- object@size["d"] npar <- object@size["n.param"] param <- object@param[[lc.param.type]] if(is.null(param) && family %in% c("ST", "SC")) { message("CP does not exist. Consider param.type='DP' or 'pseudo-CP'") return(invisible())} beta <- param[[1]] param.var <- slot(object, "param.var")[[lc.param.type]] if(object@param$boundary | is.null(param.var)) param.var <- matrix(NA, npar, npar) coef.tables <- list() par.names <- param.names(param.type, family, p, x.names=rownames(beta)[-1]) for(j in 1:d) { beta.j <- beta[,j] var.j <- param.var[((j-1)*p+1):(j*p), ((j-1)*p+1):(j*p), drop=FALSE] se.j <- sqrt(diag(var.j)) z <- beta.j/se.j coef.table <- cbind(beta.j, se.j, z, 2*pnorm(-abs(z))) dimnames(coef.table) <- list(par.names[1:p], c("estimate","std.err","z-ratio", "Pr{>|z|}")) coef.tables[[j]] <- coef.table } scatter <- list(matrix=param[[2]], name=names(param)[2]) resid <- residuals.mselm(object, param.type) # resid <- t(t(resid)/sqrt(diag(scatter$matrix))) # for normalized/std resid if(is.null(fixed$alpha)) { se.slant <- sqrt(diag(param.var)[(p*d+d*(d+1)/2+1):(p*d+d*(d+1)/2+d)]) slant <- list(param=param[[3]], se=se.slant, name=names(param)[3])} else { if(fixed$alpha == 0) slant <- list() else stop('cannot have fixed alpha at non-zero value, please report')} tail <- if(family== "ST" & is.null(fixed$nu) ) list(param=param[[length(param)]], se=sqrt(diag(param.var)[npar]), name=names(param)[length(param)]) else list() aux <- list() aux$param.cov <- if(cov) param.var else NULL aux$param.cor <- if(cor) cov2cor(param.var) else NULL out <- new("summary.mselm", call=slot(object,"call"), family = family, logL = slot(object, "logL"), method=slot(object, "method"), resid = resid, param.type=param.type, coef.tables = coef.tables, param.fixed = fixed, scatter = scatter, slant = slant, tail = tail, control = slot(object, "control"), aux = aux, boundary=slot(object, "param")$boundary, size=slot(object, "size")) out } residuals.mselm <- function(object, param.type="CP", ...){ param.type <- tolower(param.type) if(!(param.type %in% c("cp", "dp", "pseudo-cp"))) stop("param.type must be either 'CP' or 'DP' or 'pseudo-CP'") # param <- slot(object, "param")[[param.type]] # beta <- param[[1]] n <- object@size["n.obs"] r <- slot(object,"residuals.dp") param <- slot(object, "param") pseudo.mu0 <- as.vector(param$"pseudo-cp"[[1]][1,] - param$dp[[1]][1, ]) resid <- switch(param.type, 'dp' = r, 'cp' = r - outer(rep(1,n), param$mu0), 'pseudo-cp' = r - outer(rep(1,n), pseudo.mu0)) w <- slot(object, "input")$weights if(!is.null(w)) attr(resid,"weights") <- w return(resid) } fitted.mselm <- function(object, param.type="CP", ...) { param.type <- tolower(param.type) if(!(param.type %in% c("cp", "dp", "pseudo-cp"))) stop("param.type must be either 'CP' or 'DP' or 'pseudo-CP'") n <- object@size["n.obs"] fit.dp <- slot(object, "fitted.values.dp") param <- slot(object, "param") pseudo.mu0 <- as.vector(param$"pseudo-cp"[[1]][1,] - param$dp[[1]][1, ]) fitted <- switch(param.type, 'dp' = fit.dp, 'cp' = fit.dp + outer(rep(1,n), param$mu0), 'pseudo-cp' = fit.dp + outer(rep(1,n), pseudo.mu0)) w <- slot(object, "input")$weights if(!is.null(w)) attr(fitted,"weights") <- w return(fitted) } weights.mselm <- function(object, ...) slot(object, "input")$weights #------------------------------------------------------------ # # sn.info<- function(dp=NULL, cp=NULL, x=NULL, y=NULL, w, penalty=NULL, # type="observed", norm2.tol=1e-6) { # if(any(is.list(dp), is.list(cp))) { # if(is.null(dp)) stop("in the multivariate case, 'dp' must be non-NULL") # info <- sn.infoMv(dp=dp, x=x, y=y, w=w, type=type, norm2.tol=norm2.tol) # } else { # if(any(is.numeric(dp), is.numeric(cp))) # info <- sn.infoUv(dp=dp, cp=cp, x=x, y=y, w=w, penalty=penalty, # type=type, norm2.tol = norm2.tol) # else stop("invalid input") # } # return(info) # } sn.infoUv <- function(dp=NULL, cp=NULL, x=NULL, y, w, penalty=NULL, norm2.tol=1e-6) {# computes observed/expected Fisher information for univariate SN variates if(missing(y)) {y <- NULL; type <- "expected"} else type <- "observed" if(type == "observed") {if(!is.numeric(y)) stop("y is non-numeric")} if(is.null(dp) & is.null(cp)) stop("either dp or cp must be set") if(!is.null(dp) & !is.null(cp)) stop("cannot set both dp and cp") if(missing(w)) w <- rep(1, max(NROW(cbind(x,y)),1)) if(any(w != round(w)) | any(w<0)) stop("weights must be non-negative integers") n <- length(w) nw <- sum(w) if(is.null(x)) { p <- 1 wx <- w xx <- sum.x <- nw x <- matrix(1, nrow=n, ncol=1) } else { p <- NCOL(x) # x <- matrix(x, n, p) wx <- w*x xx <- t(x) %*% (wx) sum.x <- matrix(colSums(wx)) } x.names <- if(length(colnames(x)) == p) colnames(x)[2:p] else { if(p==1) NULL else paste("x", 1L:(p-1), sep=".")} if(is.null(cp)) { if(length(dp) != (p+2)) stop("length(dp) must be equal to ncol(x)+2") if(is.null(names(dp))) names(dp) <- param.names("DP", "SN", p, x.names) cp <- dp2cpUv(dp, "SN") } if(is.null(dp)) { if(length(cp) != (p+2)) stop("length(cp) must be equal to ncol(x)+2") if(is.null(names(cp))) names(cp) <- param.names("CP", "SN", p, x.names) dp <- cp2dpUv(cp, "SN") } penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) omega <- dp[p+1] alpha <- dp[p+2] mu.z <- sqrt(2/pi)*alpha/sqrt(1+alpha^2) sd.z <- sqrt(1-mu.z^2) sigma <- cp[p+1] gamma1 <- cp[p+2] R <- mu.z/sd.z T <- sqrt(2/pi-(1-2/pi)*R^2) Da.Dg <- 2*(T/(T*R)^2+(1-2/pi)/T^3)/(3*(4-pi)) Dmu.z <- sqrt(2/pi)/(1+alpha^2)^1.5 Dsd.z <- (-mu.z/sd.z)*Dmu.z Ddp.cp <- diag(p+2) Ddp.cp[1,p+1] <- (-R) Ddp.cp[1,p+2] <- (-sigma*R)/(3*gamma1) Ddp.cp[p+1,p+1] <- 1/sd.z Ddp.cp[p+1,p+2] <- (-sigma)* Dsd.z* Da.Dg/sd.z^2 Ddp.cp[p+2,p+2] <- Da.Dg I.dp <- I.cp <- matrix(NA,p+2,p+2) if(type == "observed"){ score <- sn.pdev.gh(cp, x, y, w, penalty.fn, trace=FALSE, hessian=TRUE)/(-2) I.cp <- attr(score, "hessian")/2 attr(score,"hessian") <- NULL dimnames(I.cp) <- list(names(cp), names(cp)) Dcp.dp <- solve(Ddp.cp) I.dp <- force.symmetry(t(Dcp.dp) %*% I.cp %*% Dcp.dp) dimnames(I.dp) <- list(names(dp), names(dp)) a.coef <- NULL asyvar.cp <- pd.solve(I.cp, silent=TRUE) if(is.null(asyvar.cp)) { asyvar.dp <- NULL not.mle <- TRUE} else { not.mle <- (abs(sum(score * as.vector(asyvar.cp %*% score))) > norm2.tol) asyvar.dp <- pd.solve(I.dp, silent=TRUE) } if(not.mle) warning("something peculiar, parameters do not seem at MLE") #--Iinfo.dp 2nd form I2 <- matrix(NA,p+2,p+2) z <- (y - as.vector(x%*% dp[1:p]))/omega z1 <- zeta(1, alpha*z) z2 <- zeta(2, alpha*z) I2[1:p,1:p] <- t(wx) %*% ((1 - alpha^2*z2)*x)/omega^2 I2[1:p,p+1] <- t(wx) %*% (2*z - alpha*z1 - alpha^2*z2*z)/omega^2 I2[p+1,1:p] <- t(I2[1:p,p+1]) I2[1:p,p+2] <- t(wx) %*% (z1 + alpha*z2*z)/omega I2[p+2,1:p] <- t(I2[1:p,p+2]) I2[p+1,p+1] <- (-nw + 3*sum(w*z^2) -2*alpha*sum(w*z1*z) -alpha^2*sum(w*z2*z^2))/omega^2 I2[p+1,p+2] <- I2[p+2,p+1] <- (sum(w*z*z1) + alpha*sum(w*z2*z^2))/omega I2[p+2,p+2] <- sum(-w*z2*z^2) } else { # type == "expected" I2 <- NULL if(abs(alpha) < 200) { f.a <- function(x, alpha, k) x^k * dsn(x,0,1,alpha) * zeta(1,alpha*x)^2 err <- .Machine$double.eps^0.5 a0 <- integrate(f.a, -Inf, Inf, alpha=alpha, k=0, rel.tol=err)$value a1 <- integrate(f.a, -Inf, Inf, alpha=alpha, k=1, rel.tol=err)$value a2 <- integrate(f.a, -Inf, Inf, alpha=alpha, k=2, rel.tol=err)$value } else {# approx of Bayes & Branco (2007) with multiplicative adjustment u <- 1 + 8*(alpha/pi)^2 b <- sqrt(2/pi) a0 <- 1.019149098 * b^2/sqrt(u) a1 <- 1.020466516 * (-alpha * b^3/sqrt(u^3*(1+alpha^2/u))) a2 <- 1.009258704 * b^2/sqrt(u)^3 } a.coef <- c(a0, a1, a2) I.dp[1:p,1:p] <- xx * (1+alpha^2*a0)/omega^2 I.dp[p+1,p+1] <- nw * (2+alpha^2*a2)/omega^2 I.dp[p+2,p+2] <- nw * a2 I.dp[1:p,p+1] <- sum.x * (mu.z*(1+mu.z^2*pi/2)+alpha^2*a1)/omega^2 I.dp[p+1,1:p] <- t(I.dp[1:p,p+1]) I.dp[1:p,p+2] <- sum.x * (sqrt(2/pi)/(1+alpha^2)^1.5-alpha*a1)/omega I.dp[p+2,1:p] <- t(I.dp[1:p,p+2]) I.dp[p+1,p+2] <- I.dp[p+2,p+1] <- nw*(-alpha*a2)/omega eps <- 0.005 if(abs(alpha) > eps) I.cp <- force.symmetry(t(Ddp.cp) %*% I.dp %*% Ddp.cp) else{ if(alpha == 0) I.cp <- diag(c(1/omega^2, 2/omega^2, 1/6)) else { add <- c(rep(0,p+1), 3*eps) i1 <- sn.infoUv(dp=dp+add, x=x, w=w) i2 <- sn.infoUv(dp=dp-add, x=x, w=w) I.cp <- (i1$info.cp + i2$info.cp)/2 } } score <- NULL asyvar.dp <- pd.solve(I.dp, silent=TRUE) asyvar.cp <- pd.solve(I.cp, silent=TRUE) } dimnames(I.dp) <- list(names(dp), names(dp)) if(!is.null(asyvar.dp)) dimnames(asyvar.dp) <- list(names(dp), names(dp)) if(!is.null(I.cp)) dimnames(I.cp) <- list(names(cp), names(cp)) if(!is.null(asyvar.cp)) dimnames(asyvar.cp) <- list(names(cp), names(cp)) aux <- list(Ddp.cp=Ddp.cp, a.coef=a.coef, score.cp=score) list(dp=dp, cp=cp, type=type, info.dp=I.dp, info.cp=I.cp, asyvar.dp=asyvar.dp, asyvar.cp=asyvar.cp, aux=aux) } sn.infoMv <- function(dp, x=NULL, y, w, penalty=NULL, norm2.tol=1e-6) {# computes observed/expected Fisher information matrix for multiv.SN variates # using results in Arellano-Valle & Azzalini (JMVA, 2008+erratum) type <- if(missing(y)) "expected" else "observed" if(type == "observed") {if(!is.matrix(y)) stop("y is not a matrix")} cp <- dp2cpMv(dp, "SN") d <- length(dp$alpha) d2 <- d*(d+1)/2 if(missing(w)) w <- rep(1, max(NROW(cbind(x,y)),1)) if(any(w != round(w)) | any(w<0)) stop("weights must be non-negative integers") n <- length(w) nw <- sum(w) if(is.null(x)) { p <- 1 xx <- sum.x <- nw x <- matrix(1, nrow=n, ncol=1) } else { p <- NCOL(x) # x <- matrix(x, n, p) xx <- drop(t(x) %*% (w*x)) sum.x <- drop(matrix(colSums(w*x))) } beta <- as.matrix(dp[[1]],p,d) Omega <- dp$Omega omega <- sqrt(diag(Omega)) alpha <- dp$alpha eta <- alpha/omega # vOmega <- Omega[lower.tri(Omega,TRUE)] Obar <- cov2cor(Omega) Obar.alpha <- as.vector(Obar %*% alpha) alpha.star <- sqrt(sum(alpha * Obar.alpha)) if(alpha.star < 1e-4) { warning("information matrix of multivariate SN not computed near alpha=0") return(NULL) } # delta.star <- alpha.star/sqrt(1+alpha.star^2) c1 <- sqrt(2/pi)/sqrt(1+alpha.star^2) c2 <- 1/(pi*sqrt(1+2*alpha.star^2)) # theta <- c(beta,vOmega,eta) D <- duplicationMatrix(d) i1 <- 1:prod(dim(beta)) i2 <- max(i1) + 1:(d*(d+1)/2) i3 <- max(i2) + 1:d # ind <- list(i1=i1, i2=i2, i3=i3) O.inv <- pd.solve(Omega, silent=TRUE) if(type == "observed"){ y0 <- y - x %*% beta S0 <- t(y0) %*% (w*y0) / nw y0.eta <- as.vector(y0 %*% eta) z1 <- zeta(1, y0.eta) * w z2 <- (-zeta(2, y0.eta) * w) # Z2 <- diag(z2, n) S1 <- (O.inv %x% t(x)) %*% as.vector(w*y0)- (eta %x% t(x)) %*% z1 S2 <- (nw/2) * t(D) %*% ((O.inv %x% O.inv) %*% as.vector(S0-Omega)) S3 <- t(y0) %*% z1 score <- c(S1,S2,S3) u <- t(x) %*% z1 U <- t(x) %*% (z2 * y0) V <- O.inv %*% (2*S0-Omega) %*% O.inv # terms as given in the last but one matrix of p.16 j11 <- O.inv %x% xx + outer(eta,eta) %x% (t(x) %*% (z2 *x) ) j12 <- (O.inv %x% (t(x) %*% (w*y0) %*% O.inv)) %*% D j13 <- diag(d) %x% u - eta %x% U j22 <- (nw/2) * t(D) %*% (O.inv %x% V) %*% D j23 <- matrix(0, d*(d+1)/2, d) j33 <- t(y0) %*% (z2 * y0) uaA.coef <- NULL } else { # expected information Omega.eta <- omega * Obar.alpha mu.c <- Omega.eta/alpha.star^2 Omega.c <- Omega - outer(Omega.eta, Omega.eta)/alpha.star^2 alpha.bar <- alpha.star/sqrt(1+2*alpha.star^2) ginvMills <- function(x, m=0, s=1) # generalized inverse Mills ratio: \phi(x; m, s^2)/\Phi(x) exp(-0.5*((x-m)^2/s^2-x^2)+log(zeta(1,x))-log(s)) fn.u <- function(x, sd, k) x^k * ginvMills(x,0,sd) if(alpha.bar > 0) { err<- .Machine$double.eps^0.5 u0 <- integrate(fn.u, -Inf, Inf, sd=alpha.bar, k=0, rel.tol=err)$value u1 <- integrate(fn.u, -Inf, Inf, sd=alpha.bar, k=1, rel.tol=err)$value u2 <- integrate(fn.u, -Inf, Inf, sd=alpha.bar, k=2, rel.tol=err)$value } else {u0 <- 2; u1<- u2 <- 0} a0 <- u0 a1 <- u1 * mu.c A2 <- u2 * outer(mu.c, mu.c) + u0 * Omega.c # cfr (19) A1 <- (c1*(diag(d)-outer(eta,eta) %*% Omega/(1+alpha.star^2)) - c2*outer(eta, a1)) # cfr line after (12) # terms as given in the last matrix of p.16 j11 <- (O.inv + c2*a0*outer(eta,eta)) %x% xx j12 <- c1*(O.inv %x% outer(sum.x, eta)) %*% D j13 <- A1 %x% sum.x j22 <- 0.5*nw *t(D) %*% (O.inv %x% O.inv) %*% D j23 <- matrix(0, d*(d+1)/2, d) j33 <- nw *c2 * A2 uaA.coef <- list(u0=u0, u1=u1, u2=u2, a1=a1, A1=A1, A2=A2) score <- NULL } I.theta <-rbind(cbind( j11, j12, j13), cbind(t(j12), j22, j23), cbind(t(j13), t(j23), j33)) if(!is.null(penalty)) { # penalization depends on blocks (2,3) of the parameter set only penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) penalty.theta <- function(theta23, penalty, d) { vOmega <- theta23[1:(d*(d+1)/2)] eta <- theta23[(d*(d+1)/2) + (1:d)] Omega <- vech2mat(vOmega) alpha <- eta *sqrt(diag(Omega)) penalty(list(alpha=alpha, Omega=Omega)) } i23 <- c(i2,i3) theta23 <- c(Omega[lower.tri(Omega,TRUE)], eta) # beta does not enter here score[i23] <- (score[i23] - numDeriv::grad(penalty.theta, theta23, penalty=penalty.fn, d=d)) jQ <- numDeriv::hessian(penalty.theta, theta23, penalty=penalty.fn, d=d) I.theta[i23, i23] <- I.theta[i23, i23] + jQ } I.theta <- force.symmetry(I.theta, tol=1e3) inv_I.theta <- pd.solve(I.theta, silent=TRUE) if(is.null(inv_I.theta)) { warning("numerically unstable information matrix") return(NULL) } if(type == "observed" ) { score.norm2 <- sum(score * as.vector(inv_I.theta %*% score)) if(score.norm2/d > norm2.tol) stop("'dp' does not seem to be at MLE") } D32 <- matrix(0,d, d2) tmp32 <- matrix(0,d^2,d^2) for(i in 1:d){ Eii <- matrix(0,d,d) Eii[i,i] <- 1 tmp32 <- tmp32 + Eii %x% Eii } D32 <- (-0.5)* (t(eta) %x% diag(1/omega^2, d,d)) %*% tmp32 %*% D # here we use the expression given in the notes, not in the paper Dlow <- cbind(matrix(0,d,d*p), D32, diag(1/omega,d,d)) Dtheta.dp <- rbind(cbind(diag(d*p+d2), matrix(0,d*p+d2,d)), Dlow) I.dp <- t(Dtheta.dp) %*% I.theta %*% Dtheta.dp # cfr (14) I.dp <- force.symmetry(I.dp, tol=1e3) # # psi<- c(mu, vSigma, mu0) Sigma <- cp$var.cov sigma <- sqrt(diag(Sigma)) Sigma.inv <- pd.solve(Sigma) mu0 <- c1* omega * Obar.alpha beta0.sq <- as.vector(t(mu0) %*% Sigma.inv %*% mu0) beta0 <- sqrt(beta0.sq) q1 <- 1/(c1*(1+beta0.sq)) q2 <- 0.5*q1*(2*c1-q1) Dplus <- pd.solve(t(D) %*% D) %*% t(D) D23 <- Dplus %*% (diag(d) %x% mu0 + mu0 %x% diag(d)) a <- as.vector(Sigma.inv %*% mu0) D32 <- t(-a) %x% (q1 * Sigma.inv - q1*q2*outer(a,a)) %*% D D33 <- q1 * Sigma.inv - 2*q1*q2*outer(a,a) one00 <- c(1,rep(0,p-1)) Dtheta.psi <- rbind( cbind(diag(p*d), matrix(0,p*d,d2), -diag(d) %x% one00), cbind(matrix(0,d2,p*d), diag(d2), D23), cbind(matrix(0,d,p*d), D32, D33)) # cfr (22a) mu0. <- mu0/(sigma*beta0) # \bar{\mu}_0 D32. <- matrix(0, d, d2) # \tilde{D}_{32} for(i in 1:d) { Eii <- matrix(0,d,d) Eii[i,i] <- 1 D32. <- D32. + (1/sigma[i])*((t(mu0.) %*% Eii) %x% Eii) %*% D } D32. <- 0.5* beta0 * D32. D33. <- (2/(4-pi)) * diag(sigma/mu0.^2, d, d)/(3*beta0.sq) Dpsi.cp <- rbind(cbind(diag(p*d+d2), matrix(0,p*d+d2,d)), cbind(matrix(0,d,p*d), D32., D33.)) # cfr (22b) jacob <- Dtheta.psi %*% Dpsi.cp I.cp <- t(jacob) %*% I.theta %*% jacob # cfr (17) I.cp <- if(any(is.na(I.cp))) NULL else force.symmetry(I.cp) asyvar.dp <- pd.solve(I.dp, silent=TRUE) if(is.null(asyvar.dp)) se.dp <- list(NULL) else { diags.dp <- sqrt(diag(asyvar.dp)) se.beta <- matrix(diags.dp[1:(p*d)], p, d) se.diagOmega <- diags.dp[p*d + d2 +1 -rev(cumsum(1:d))] # se.omega <- se.Omega/(2*omega) se.alpha <- diags.dp[p*d +d2 +(1:d)] se.dp <- list(beta=se.beta, diagOmega=se.diagOmega, alpha=se.alpha) } asyvar.cp <- pd.solve(I.cp, silent=TRUE) if(is.null(asyvar.cp)) se.cp <- list(NULL) else { diags.cp <- sqrt(diag(asyvar.cp)) se.beta <- matrix(diags.cp[1:(p*d)], p, d) se.diagSigma <- diags.cp[p*d + d2 +1 -rev(cumsum(1:d))] # se.sigma <- se.Sigma/(2*sigma) se.gamma1 <- diags.cp[p*d + d2 +(1:d)] se.cp <- list(beta=se.beta, var=se.diagSigma, gamma1=se.gamma1) } aux <- list(info.theta=I.theta, score.theta=score, Dtheta.dp=Dtheta.dp, Dpsi.cp=Dpsi.cp, Dtheta.psi=Dtheta.psi, uaA.coef=uaA.coef) list(dp=dp, cp=cp, type=type, info.dp=I.dp, info.cp=I.cp, asyvar.dp=asyvar.dp, asyvar.cp=asyvar.cp, se.dp=se.dp, se.cp=se.cp, aux=aux) } msn.mle <- function(x, y, start=NULL, w, trace=FALSE, opt.method=c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control=list() ) { y <- data.matrix(y) if(missing(x)) x <- rep(1,nrow(y)) else {if(!is.numeric(x)) stop("x must be numeric")} if(missing(w)) w <- rep(1,nrow(y)) opt.method <- match.arg(opt.method) x <- data.matrix(x) d <- ncol(y) n <- sum(w) p <- ncol(x) y.names <- dimnames(y)[[2]] x.names <- dimnames(x)[[2]] if(is.null(start)) { fit0 <- lm.wfit(x, y, w, method="qr") beta <- as.matrix(coef(fit0)) res <- resid(fit0) a <- msn.moment.fit(res) Omega <- a$Omega omega <- a$omega alpha <- a$alpha if(!a$admissible) alpha<-alpha/(1+max(abs(alpha))) beta[1,] <- beta[1,]-omega*a$delta*sqrt(2/pi) } else{ beta <- start[[1]] # start$beta Omega <- start$Omega alpha <- start$alpha omega <- sqrt(diag(Omega)) } eta <-alpha/omega if(trace){ cat("Initial parameters:\n") print(cbind(t(beta),eta,Omega)) } param <- c(beta,eta) dev <- msn.dev(param, x, y, w) if(opt.method == "nlminb") { opt <- nlminb(param, msn.dev, msn.dev.grad, control=control, x=x, y=y, w=w, trace=trace) opt$value <- opt$objective } else opt <- optim(param, fn=msn.dev, gr=msn.dev.grad, method=opt.method, control=control, x=x, y=y, w=w, trace=trace) if(trace) { cat("Message from function", opt.method, ":", opt$message,"\n") cat("Output parameters " , format(opt$par), "\n") } logL <- opt$value/(-2) beta <- matrix(opt$par[1:(p*d)],p,d) dimnames(beta)[2] <- list(y.names) dimnames(beta)[1] <- list(x.names) eta <- opt$par[(p*d+1):(p*d+d)] xi <- x %*% beta Omega <- t(y-xi) %*% (w*(y-xi))/n omega <- sqrt(diag(Omega)) alpha <- eta*omega # param <- cbind(omega,alpha) dimnames(Omega) <- list(y.names,y.names) names(alpha) <- y.names alpha2 <- sum(eta * as.vector(Omega %*% eta)) delta.star <- sqrt(alpha2/(1+alpha2)) # dimnames(param)[1] <- list(y.names) dp <- list(beta=beta, Omega=Omega, alpha=alpha) opt$method <- opt.method opt$called.by <- "msn.mle" aux <- list(alpha.star=sqrt(alpha2), delta.star=delta.star) list(call=match.call(), dp=dp, logL=logL, aux=aux, opt.method=opt) } msn.dev <- function(param, x, y, w, trace=FALSE) { d <- ncol(y) if(missing(w)) w <- rep(1,nrow(y)) n <- sum(w) p <- ncol(x) beta <- matrix(param[1:(p*d)],p,d) eta <- param[(p*d+1):(p*d+d)] y0 <- y-x %*% beta Omega <- (t(y0) %*% (y0*w))/n D <- diag(qr(2*pi*Omega)[[1]]) logDet <- sum(log(abs(D))) dev <- n*logDet - 2*sum(zeta(0, y0 %*% eta) * w) + n*d if(trace) { cat("\nmsn.dev:",dev,"\n","parameters:"); print(rbind(beta,eta)) } dev } msn.dev.grad <- function(param, x, y, w, trace=FALSE) { d <- ncol(y) if(missing(w)) w <- rep(1,nrow(y)) n <- sum(w) p <- ncol(x) beta <- matrix(param[1:(p*d)],p,d) eta <- param[(p*d+1):(p*d+d)] y0 <- y-x %*% beta Omega <- (t(y0) %*% (w*y0))/n p1 <- zeta(1,as.vector(y0 %*% eta)) * w Omega.inv <- pd.solve(Omega, silent=TRUE) if(is.null(Omega.inv)) return(rep(NA, p*d+d)) Dbeta <- (t(x) %*% (y0*w) %*% Omega.inv - outer(as.vector(t(x) %*% p1), eta)) Deta <- as.vector(t(y0) %*% p1) if(trace){ cat("gradient:\n") print(rbind(Dbeta,Deta))} -2*c(Dbeta,Deta) } msn.moment.fit <- function(y) {# 31-12-1997: simple fit of MSN distribution usign moments y <- as.matrix(y) k <- ncol(y) m.y <- apply(y, 2, mean) var.y <- var(y) y0 <- (t(y) - m.y)/sqrt(diag(var.y)) gamma1<- apply(y0^3, 1, mean) out <- (abs(gamma1) > 0.99527) gamma1[out] <- sign(gamma1[out])*0.995 a <- sign(gamma1)*(2*abs(gamma1)/(4-pi))^0.33333 delta <- sqrt(pi/2)*a/sqrt(1+a^2) m.z <- delta * sqrt(2/pi) omega <- sqrt(diag(var.y)/(1-m.z^2)) Omega <- var.y + outer(omega*m.z, omega*m.z) xi <- m.y-omega*m.z O.cor <- cov2cor(Omega) O.inv <- pd.solve(O.cor) tmp <- as.vector(1 - t(delta) %*% O.inv %*% delta) if(tmp<=0) {tmp <- 0.0001; admissible <- FALSE} else admissible <- TRUE alpha <- as.vector(O.inv %*% delta)/sqrt(tmp) list(xi=xi, Omega=Omega, alpha=alpha, Omega.cor=O.cor, omega=omega, delta=delta, skewness=gamma1, admissible=admissible) } st.mple <- function(x, y, dp=NULL, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, trace=FALSE, opt.method=c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control=list()) { # MLE of DP for univariate ST distribution, allowing case symmetr[ic]=TRUE if(missing(y)) stop("required argument y is missing") if(!is.vector(y) | !is.numeric(y)) stop("argument y must be a numeric vector") x <- if(missing(x)) matrix(rep(1, length(y)), ncol = 1) else data.matrix(x) if(!is.matrix(x)) stop("argument x must be a matrix") y.name <- deparse(substitute(y)) x.name <- deparse(substitute(x)) if(any(x[,1] != 1)) stop("first column of x must have all 1's") if(symmetr && !is.null(penalty)) stop("Penalized log-likelihood not allowed with constraint alpha=0") n <- length(y) p <- ncol(x) if(missing(w)) w <- rep(1,n) nw <- sum(w) if(is.null(dp)) { ls <- lm.wfit(x, y, w) res <- ls$residuals s <- sqrt(sum(w*res^2)/nw) gamma1 <- sum(w*res^3)/(nw*s^3) gamma2 <- sum(res^4)/(nw*s^4) - 3 cp <- c(ls$coef, s, gamma1, gamma2) dp <- st.cp2dp(cp, silent=TRUE) if(is.null(dp)) dp <- rep(NA,length(cp)) if(any(is.na(dp))) dp <- c(cp[1:(p+1)], 0, 10) if(!is.null(fixed.nu)) dp <- dp[-length(dp)] if(symmetr) dp <- dp[-length(dp)] } else{ if(length(dp) != (p+2-as.numeric(symmetr)+as.numeric(is.null(fixed.nu)))) stop("arg 'dp' has wrong length")} if(trace) cat("dp (starting values) =", format(dp), "\n") tiny <- (.Machine$double.eps)^(0.25) low.dp <- c(rep(-Inf, p), tiny, if(symmetr) NULL else -Inf, if(is.null(fixed.nu)) tiny) high.dp <- c(rep(Inf, length(dp))) opt.method <- match.arg(opt.method) penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) if(opt.method == "nlminb") { opt <- nlminb(dp, objective=st.pdev, gradient=st.pdev.gh, # do NOT set: hessian=st.dev.hessian, lower=low.dp, upper=high.dp, control=control, x=x, y=y, w=w, fixed.nu=fixed.nu, symmetr=symmetr, penalty=penalty.fn, trace=trace) opt$value <- opt$objective } else { opt <- optim(dp, fn=st.pdev, gr=st.pdev.gh, method = opt.method, # arguments lower & upper not used to allow all opt.method control = control, x=x, y=y, w=w, fixed.nu=fixed.nu, symmetr=symmetr, penalty=penalty.fn, trace=trace) } dp <- opt$par opt$method <- opt.method opt$called.by <- "st.mple" dp. <- if(is.null(fixed.nu)) dp else c(dp, fixed.nu) if(symmetr) dp. <- c(dp.[1:(p+1)], 0, dp.[length(dp.)]) rv.comp <- c(TRUE, !symmetr, is.null(fixed.nu)) names(dp) <- param.names("DP", "ST", p=p, x.names=colnames(x)[-1], rv.comp) names(dp.) <- param.names("DP", "ST", p=p, x.names=colnames(x)[-1]) logL <- (-opt$value)/2 boundary <- FALSE if(!symmetr) boundary <- as.logical(abs(dp[p+2]) > 1000) if(is.null(fixed.nu)) boundary <- (boundary | dp[length(dp)] > 1e3) # AA, must improve this rule if(trace) { cat("Message from function", opt.method, ": ", opt$message, "\n") cat("estimates (dp):", dp, "\n") cat("log-likelihood:", logL, "\n") } list(call=match.call(), dp=dp, fixed.nu=fixed.nu, logL=logL, dp.complete=dp., boundary=boundary, opt.method=opt) } st.pdev <- function(dp, x, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, trace=FALSE) { # computes "penalized deviance"=-2*(logL-Q) for ST p <- ncol(x) xi <- as.vector(x %*% matrix(dp[1:p],p,1)) alpha <- if(symmetr) 0 else dp[p+2] nu <- if(is.null(fixed.nu)) dp[p+3-as.numeric(symmetr)] else fixed.nu if(dp[p+1] <= 0 | nu <= 0) return(NA) logL <- sum(w * dst(y, xi, dp[p+1], alpha, nu, log=TRUE)) Q <- if(is.null(penalty)) 0 else penalty(dp[p+2], nu, der=0) if(trace) cat("st.pdev: (dp,pdev) =", format(c(dp, -2*(logL-Q))),"\n") return(-2 * (logL - Q)) } st.pdev.gh <- function(dp, x, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, trace=FALSE, hessian=FALSE) { # computes gradient and hessian of (penalized) deviance for ST p <- ncol(x) n <- nrow(x) beta <- dp[1:p] omega <- dp[p+1] alpha <- if(symmetr) 0 else dp[p+2] j.nu <- p + 2 + as.numeric(!symmetr) nu <- if(is.null(fixed.nu)) dp[j.nu] else fixed.nu npar <- p + 1 + as.numeric(!symmetr) + as.numeric(is.null(fixed.nu)) score <- numeric(npar) xi <- as.vector(x %*% beta) z <- (y - xi)/omega nuz2 <- (nu + z^2) loro.tau <- sqrt((nu+1)/nuz2) zt <- z * loro.tau log.pdf <- dt(alpha*zt, nu+1, log=TRUE) log.cdf <- pt(alpha*zt, nu+1, log.p=TRUE) cdf <- exp(log.cdf) loro.w <- exp(log.pdf - log.cdf) tw <- loro.tau * loro.w zwz2 <- z*(z^2-1)*loro.w/loro.tau wi.beta <- z*loro.tau^2 - nu*alpha*tw/(nu+z^2) score[1:p] <- colSums(w*x*wi.beta)/omega score[p+1] <- sum(w * (-1 + zt^2 -alpha*nu*z*tw/(nu+z^2)))/omega if(!symmetr) score[p+2] <- sum(w*z*tw) if(is.null(fixed.nu)){ fun.g <- function(x, nu1) dt(x,nu1) * (((nu1+1)*x^2)/(nu1*(nu1+x^2)) - log1p(x^2/nu1)) int.g <- numeric(n) for (i in 1:n) int.g[i] <- integrate(fun.g, -Inf, alpha*zt[i], nu1=nu+1)$value score[j.nu] <- 0.5 * sum(w * (digamma(1+nu/2) -digamma(nu/2) - (2*nu+1)/(nu*(nu+1)) -log1p(z^2/nu) + zt^2/nu + alpha*zwz2/(nu+z^2)^2 + int.g/cdf)) } if(is.null(penalty)) { Q <- 0 attr(Q, "der1") <- rep(0,2) attr(Q, "der2") <- matrix(rep(0,4), 2, 2) } else { if(symmetr) stop("Penalized logL not allowed with constraint alpha=0") Q <- penalty(alpha, nu, der=1+as.numeric(hessian)) } score[(p+2):(p+3)] <- score[(p+2):(p+3)] - attr(Q, "der1") score <- score[1:npar] gradient <- (-2)*score if(hessian){ info <- matrix(NA, npar, npar) w.z <- (-nu*(nu+2)*alpha^2*z*loro.w/((nu+z^2*(1+alpha^2))*nuz2) -nu*alpha*loro.tau*loro.w^2/nuz2) w.alpha <- (-(nu+2)* alpha*z^2*loro.w/(nu+z^2*(1+alpha^2)) -zt*loro.w^2) S.z <- (-z*loro.tau^2 + alpha*nu*tw/nuz2) S.zz <- (2*zt^2/nuz2 - loro.tau^2 -3*alpha*nu*z*tw/nuz2^2 +alpha*nu*loro.tau*w.z/nuz2) info[1:p,1:p] <- t(-S.zz *x) %*% (w*x)/omega^2 info[1:p,p+1] <- info[p+1,1:p] <- colSums(-w*(S.zz*z + S.z)*x)/omega^2 info[p+1,p+1] <- -sum(w*(1 + z^2*S.zz + 2*z*S.z))/omega^2 S.za <- nu*loro.tau*(loro.w +alpha*w.alpha)/nuz2 if(!symmetr) { info[1:p,p+2] <- info[p+2,1:p] <- colSums(w*S.za*x)/omega info[p+1,p+2] <- info[p+2,p+1] <- sum(w*z*S.za)/omega info[p+2,p+2] <- sum(-w*zt*w.alpha) + attr(Q,"der2")[1,1] } if(is.null(fixed.nu)) { w.nu <- (0.5*loro.w*((nu+2)*(alpha*z)^2/((nu+z^2*(1+alpha^2))*nuz2) - log1p((alpha*z)^2/nuz2) - int.g/cdf) - 0.5*alpha*zwz2*loro.w/nuz2^2) S.znu <- (z*(1-z^2)/nuz2^2 + alpha*nu*loro.tau*w.nu/nuz2 + alpha*(nu*(3*z^2-1)+2*z^2)*loro.w/(2*loro.tau*nuz2^3)) info[1:p,j.nu] <- info[j.nu,1:p] <- colSums(w* S.znu*x)/omega info[p+1,j.nu] <- info[j.nu,p+1] <- sum(w*z*S.znu)/omega fun.b <- function(x, nu1) dt(x,nu1) * (((nu1+1)*x^2)/(nu1*(nu1+x^2)) - log1p(x^2/nu1))^2 fun.d <- function(x, nu1) dt(x,nu1) * x^2*((nu1-1)*x^2-2*nu1)/(nu1^2*(nu1+x^2)^2) int.b <- int.d <- numeric(n) for (i in 1:n) { int.b[i] <- integrate(fun.b, -Inf, alpha*zt[i], nu1=nu+1)$value int.d[i] <- integrate(fun.d, -Inf, alpha*zt[i], nu1=nu+1)$value } info[j.nu,j.nu] <- -sum(w*( (trigamma(nu/2+1) - trigamma(nu/2))/4 + (2*nu^2+2*nu+1)/(2*(nu*(nu+1))^2) + z^2/(2*nu*nuz2) - z^2*(nu^2+2*nu+z^2)/(2*nu^2*nuz2^2) - alpha*zwz2*(z^2+4*nu+3)/(4*(nu+1)*nuz2^3) + alpha*z*(1-loro.tau^2)*w.nu/(2*loro.tau*nuz2) - (int.g/(2*cdf))^2 - alpha*zwz2*int.g/(4*cdf*nuz2^2) + (2*int.d + int.b)/(4*cdf) + (alpha*zwz2/(4*nuz2^2))* ((nu+2)*alpha^2*z^2/((nu+1)*(nu+z^2*(1+alpha^2))) - log1p((alpha*z)^2/nuz2)) )) info[j.nu,j.nu] <- info[j.nu,j.nu] + attr(Q,"der2")[2,2] if(!symmetr) { info[p+2,p+3] <- info[p+3,p+2] <- -sum(w*(0.5*zwz2/nuz2^2 + zt*w.nu)) info[p+2,p+3] <- info[p+2,p+3] + attr(Q,"der2")[1,2] info[p+3,p+2] <- info[p+3,p+2] + attr(Q,"der2")[2,1] } } attr(gradient,"hessian") <- force.symmetry(2*info) if(trace) cat("Hessian matrix has been computed\n") } if(trace) cat("st.pdev.gh: gradient = ", format(gradient),"\n") return(gradient) } st.pdev.hessian <- function(dp, x, y, w, fixed.nu=NULL, symmetr=FALSE, penalty = NULL, trace=FALSE) attr(st.pdev.gh(dp, x, y, w, fixed.nu, symmetr, penalty, trace, hessian=TRUE), "hessian") st.infoUv <- function(dp=NULL, cp=NULL, x=NULL, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, norm2.tol=1e-06) {# computes observed Fisher information matrix for univariate ST variates if(missing(y)) stop("y is missing") if(!is.numeric(y)) stop("y is non-numeric") type <- "observed" if(is.null(dp) & is.null(cp)) stop("either dp or cp must be set") if(!is.null(dp) & !is.null(cp)) stop("cannot set both dp and cp") # if(is.null(cp)) cp <- st.dp2cp(c(dp, fixed.nu)) # completa DP se necessario if(is.null(dp)) dp <- st.cp2dp(cp) # AA, CP deve essere comunque completo if(missing(w)) w <- rep(1, max(nrow(cbind(x, y)), 1)) if(any(w != round(w)) | any(w<0)) stop("weights must be non-negative integers") npar <- length(dp) n <- length(w) nw <- sum(w) nu <- if(is.null(fixed.nu)) dp[npar] else fixed.nu if(is.null(x)) { n <- if(is.null(y)) 1 else NROW(y) p <- 1 xx <- sum.x <- nw x <- matrix(1, nrow=n, ncol=1) } else { p <- NCOL(x) # x <- matrix(x, n, p) xx <- t(x) %*% (w * x) sum.x <- matrix(colSums(x)) } penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) score <- st.pdev.gh(dp, x, y, w, fixed.nu, symmetr, penalty.fn, trace=FALSE, hessian=TRUE) I.dp <- attr(score, "hessian")/2 if((d2 <- sum(score * as.vector(solve(I.dp) %*% score))) > norm2.tol*npar) { warning("'dp' does not seem to be at MLE; score not quite 0") cat("score(dp): ", score, "\n") cat("norm(score)^2:", d2,"\n") } attr(score, "hessian") <- NULL dimnames(I.dp) <- list(names(dp), names(dp)) asyvar.dp <- pd.solve(I.dp, silent=TRUE) aux <- list(score.dp=score) if(nu > 4) { dp0 <- c(dp[1:(p+1)], if(symmetr) 0 else dp[p+2], if(is.null(fixed.nu)) nu) cp <- st.dp2cp(dp=dp0, cp.type="proper", fixed.nu=fixed.nu, upto=if(is.null(fixed.nu)) 4 else 3, jacobian=TRUE) Dcp.dp <- attr(cp, "jacobian") attr(cp, "jacobian") <- NULL ind <- c(1:(p+1), if(symmetr) NULL else (p+2), if(is.null(fixed.nu)) p+3) Dcp.dp <- Dcp.dp[ind, ind] cp <- cp[ind] Ddp.cp <- solve(Dcp.dp) I.cp <- force.symmetry(t(Ddp.cp) %*% I.dp %*% Ddp.cp) dimnames(I.cp) <- list(names(cp), names(cp)) asyvar.cp <- pd.solve(I.cp) aux$Dcp.dp <- Dcp.dp aux$Ddp.cp <- Ddp.cp } else { I.cp <- NULL asyvar.cp <- NULL aux <- NULL } list(dp=dp, cp=cp, type=type, info.dp=I.dp, info.cp=I.cp, asyvar.dp=asyvar.dp, asyvar.cp=asyvar.cp, aux=aux) } param.names <- function(param.type, family="SN", p=1, x.names=NULL, rv.comp) {# NB: x.names= names of covariates except intercept, having length (p-1); # rv.comp=random variable components (those not part of the linear predictor) if(!(param.type %in% c("DP","CP","pseudo-CP"))) stop("invalid param.type") if(!(family %in% c("SN", "ESN", "ST", "SC"))) stop("unknown family") if(p > 1 && (length(x.names) < (p-1))) x.names <- outer("x", as.character(1L:(p-1)), paste, sep=".") if(param.type == "DP"){ name0 <- if(p > 1) "(Intercept.DP)" else "xi" par.names <- c(name0, x.names, "omega", "alpha") if(family == "ESN") par.names <- c(par.names, "tau") if(family == "ST") par.names <- c(par.names, "nu") } if(param.type == "CP"){ name0 <- if(p > 1) "(Intercept.CP)" else "mean" par.names <- c(name0, x.names, "s.d.", "gamma1") if(family == "ESN") par.names <- c(par.names, "tau") if(family == "ST") par.names <- c(par.names, "gamma2") } if(param.type == "pseudo-CP"){ if(!(family %in% c("ST", "SC"))) stop("pseudo-CP makes sense only for ST and SC families") name0 <- if(p > 1) "(Intercept.CP~)" else "mean~" par.names <- c(name0, x.names, "s.d.~", "gamma1~") if(family == "ST") par.names <- c(par.names, "gamma2~") } if(missing(rv.comp)) rv.comp <- rep(TRUE, length(par.names)-p) par.names[c(rep(TRUE,p), rv.comp)] } mst.mple <- function (x, y, start=NULL, w, fixed.nu = NULL, symmetr=FALSE, penalty=NULL, trace = FALSE, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) { opt.method <- match.arg(opt.method) if(missing(y)) stop("required argument y is missing") if(!is.matrix(y) | !is.numeric(y)) stop("argument y must be a numeric matrix") y.name <- deparse(substitute(y)) y.names <- dimnames(y)[[2]] n <- nrow(y) x <- if (missing(x)) matrix(rep(1, n), ncol = 1) else data.matrix(x) if (missing(w)) w <- rep(1, n) nw <- sum(w) x.names <- dimnames(x)[[2]] d <- ncol(y) p <- ncol(x) if (is.null(start)) { ls <- lm.wfit(x, y, w, singular.ok=FALSE) beta <- coef(ls) Omega <- var(resid(ls)) omega <- sqrt(diag(Omega)) alpha <- rep(0, d) nu <- if(is.null(fixed.nu)) 8 else fixed.nu if (trace) cat("mst.mple: starting dp = (", c(beta, Omega[!upper.tri(Omega)], alpha, nu), ")\n") } else { if (!is.null(fixed.nu)) start$nu <- fixed.nu if (all(names(start)[2:4] == c("Omega", "alpha", "nu"))) { beta <- start[[1]] # was start$beta Omega <- start$Omega alpha <- start$alpha nu <- start$nu } else stop("argument 'start' is not in the form that I expected") } if(symmetr) alpha <- rep(0,d) param <- dplist2optpar(list(beta=beta, Omega=Omega, alpha=alpha)) if(symmetr) param <- param[-(p*d + d*(d+1)/2 + (1:d))] if(is.null(fixed.nu)) param <- c(param, log(nu)) if(!is.null(penalty)) penalty <- get(penalty, inherits=TRUE) opt.method <- match.arg(opt.method) if(opt.method == "nlminb") { opt <- nlminb(param, objective = mst.pdev, gradient = mst.pdev.grad, control = control, x = x, y = y, w = w, fixed.nu = fixed.nu, symmetr=symmetr, penalty=penalty, trace = trace) # info <- num.deriv2(opt$par, FUN="mst.dev.grad", X=X, y=y, # w=w, fixed.nu = fixed.nu)/2 opt$value <- opt$objective } else { opt <- optim(param, fn = mst.pdev, gr = mst.pdev.grad, method = opt.method, control = control, hessian = TRUE, x = x, y = y, w = w, fixed.nu = fixed.nu, symmetr=symmetr, penalty=penalty, trace = trace) # info <- opt$hessian/2 } dev <- opt$value param <- opt$par opt$method <- opt.method opt$called.by <- "mst.mple" if (trace) { cat("Message from optimization routine:", opt$message, "\n") cat("(penalized) deviance:", dev, "\n") } par <- opt$par npar0 <- (p*d + d*(d+1)/2) vp <- par[1:npar0] dp.comp <- (1:2) if(symmetr) vp <- c(vp, rep(0,d)) else { vp <- c(vp, par[npar0 + (1:d)]); dp.comp <- (1:3)} if(is.null(fixed.nu)) { vp <- c(vp, par[length(par)]) dp.comp <- c(dp.comp,4)} dp.list <- optpar2dplist(vp, d, p, x.names, y.names) dp <- dp.complete <- dp.list$dp if(symmetr) dp.complete$alpha <- rep(0, d) if(!is.null(fixed.nu)) dp.complete$nu <- fixed.nu alpha2 <- sum(dp$alpha * as.vector(cov2cor(dp$Omega) %*% dp$alpha)) delta.star <- sqrt(alpha2/(1+alpha2)) dp <- dp[dp.comp] aux <- list(fixed.nu=fixed.nu, symmetr=symmetr, alpha.star=sqrt(alpha2), delta.star=delta.star) boundary <- ((1 - delta.star) < .Machine$double.eps^(1/4)) if(is.null(fixed.nu)) boundary <- (boundary | dp$nu > 1e3) list(call=match.call(), dp=dp, dp.complete=dp.complete, logL=dev/(-2), boundary=boundary, aux=aux, opt.method = opt) } mst.pdev <- function(param, x, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, trace=FALSE) { if(missing(w)) w <- rep(1,nrow(y)) d <- ncol(y) p <- ncol(x) npar0 <- (p*d + d*(d+1)/2) param1 <- c(param[1:npar0], if(symmetr) rep(0, d) else param[npar0+(1:d)], if(is.null(fixed.nu)) param[length(param)]) dp.list <- optpar2dplist(param1, d, p) dp <- dp.list$dp nu <- if(is.null(fixed.nu)) dp$nu else fixed.nu logL <- sum(w * dmst(y, x %*% dp$beta, dp$Omega, dp$alpha, nu, log=TRUE)) Q <- if(is.null(penalty)) 0 else penalty(list(alpha=dp$alpha, Omega.bar=cov2cor(dp$Omega)), nu, der=0) pdev <- (-2) * (logL - Q) if(trace) cat("mst.pdev: ", pdev, "\nparam:", format(param), "\n") pdev } mst.pdev.grad <- function(param, x, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, trace=FALSE) { # based on Appendix B of Azzalini & Capitanio (2003, arXiv-0911.2342) # except for a few quite patent typos (transposed matrices, etc) d <- ncol(y) p <- ncol(x) beta<- matrix(param[1:(p*d)],p,d) D <- exp(-2*param[(p*d+1):(p*d+d)]) A <- diag(d) i0 <- p*d + d*(d+1)/2 if(d>1) A[!lower.tri(A,diag=TRUE)] <- param[(p*d+d+1):i0] eta <- if(symmetr) rep(0,d) else param[(i0+1):(i0+d)] nu <- if(is.null(fixed.nu)) exp(param[length(param)]) else fixed.nu Oinv <- t(A) %*% diag(D,d,d) %*% A u <- y - x %*% beta u.w <- u * w Q <- as.vector(rowSums((u %*% Oinv) * u.w)) L <- as.vector(u.w %*% eta) sf <- if(nu < 1e4) sqrt((nu+d)/(nu+Q)) else sqrt((1+d/nu)/(1+Q/nu)) t. <- L*sf # t(L,Q,nu) in \S 5.1 # dlogft<- (-0.5)*(1+d/nu)/(1+Q/nu) # \tilde{g}_Q dlogft <- (-0.5)*sf^2 # \tilde{g}_Q, again dt.dL <- sf # \dot{t}_L dt.dQ <- (-0.5)*L*sf/(Q+nu) # \dot{t}_Q logT. <- pt(t., nu+d, log.p=TRUE) dlogT.<- exp(dt(t., nu+d, log=TRUE) - logT.) # \tilde{T}_1 Dbeta <- (-2* t(x) %*% (u.w*dlogft) %*% Oinv - outer(as.vector(t(x) %*% (dlogT. * dt.dL* w)), eta) - 2* t(x) %*% (dlogT.* dt.dQ * u.w) %*% Oinv ) Deta <- colSums(dlogT.*sf*u.w) if(d>1) { M <- 2*( diag(D,d,d) %*% A %*% t(u * dlogft + u * dlogT. * dt.dQ) %*% u.w) DA <- M[!lower.tri(M,diag=TRUE)] } else DA<- NULL M <- (A %*% t(u*dlogft + u*dlogT.*dt.dQ) %*% u.w %*% t(A)) if(d>1) DD <- diag(M) + 0.5*sum(w)/D else DD <- as.vector(M + 0.5*sum(w)/D) grad <- (-2) * c(Dbeta, DD*(-2*D), DA, if(!symmetr) Deta) if(is.null(fixed.nu)) { df0 <- min(nu, 1e8) if(df0 < 10000){ diff.digamma <- digamma((df0+d)/2) - digamma(df0/2) log1Q<- log(1+Q/df0) } else { diff.digamma <- log1p(d/df0) log1Q <- log1p(Q/df0) } dlogft.ddf <- 0.5 * (diff.digamma - d/df0 + (1+d/df0)*Q/((1+Q/df0)*df0) - log1Q) eps <- 1.0e-4 df1 <- df0 + eps sf1 <- if(df0 < 1e4) sqrt((df1+d)/(Q+df1)) else sqrt((1+d/df1)/(1+Q/df1)) logT.eps <- pt(L*sf1, df1+d, log.p=TRUE) dlogT.ddf <- (logT.eps-logT.)/eps Ddf <- sum((dlogft.ddf + dlogT.ddf)*w) grad <- c(grad, -2*Ddf*df0) } if(!is.null(penalty)) { if(symmetr) stop("penalized log-likelihood not allowed when alpha=0") Ainv <- backsolve(A, diag(d)) Omega <- Ainv %*% diag(1/D,d,d) %*% t(Ainv) omega <- diag(Omega) alpha <- eta*omega Q <- Qpenalty(list(alpha, cov2cor(Omega)), nu, der=1) comp <- 1:(length(alpha)+is.null(fixed.nu)) Qder <- attr(Q, "der1") * c(1/omega, 1)[comp] # gradient for transformed variable (alpha --> eta) grad <- grad + 2*c(rep(0, p*d + d*(d+1)/2), Qder) } if(trace) cat("mst.pdev.grad: norm is ", format(sqrt(sum(grad^2))), "\n") return(grad) } mst.theta.jacobian <- function(theta, p, d, cp.type="proper") { # jacobian matrices associated to transformations from # theta=c(beta, vech(Omega), eta, nu) to DP, CP and other parameterizations cp.type <- match.arg(cp.type, c("proper", "pseudo")) k1 <- p * d k2 <- k1 + d*(d+1)/2 k3 <- k2 + d k4 <- k3 + 1 if(length(theta) != k4) stop("mismatch in the arguments") block1 <- 1:k1 block2 <- (k1+1):k2 block3 <- (k2+1):k3 block4 <- k4 beta <- matrix(theta[block1], p, d) Omega <- vech2mat(theta[block2]) Omega.inv <- pd.solve(Omega) eta <- theta[block3] nu <- theta[block4] a.incr <- if(cp.type=="proper") rep(0,4) else 1:4 omega <- sqrt(diag(Omega)) alpha <- eta*omega # delta <- delta.etc(alpha, Omega)$delta D <- duplicationMatrix(d) P <- matrix(0, d^2, d^2) for (i in 1:d) { Eii <- matrix(0,d,d) Eii[i,i] <- 1 P <- P + Eii %x% Eii } omega <- sqrt(diag(Omega)) d <- length(omega) delta.plus <- delta.etc(alpha, Omega) delta <- delta.plus$delta delta.sq <- (delta.plus$delta.star)^2 alpha.sq <- (delta.plus$alpha.star)^2 a <- function(nu) nu/(nu-2) u <- function(nu) 0.5*(1/nu + digamma((nu-1)/2) - digamma(nu/2)) c1 <- function(nu) b(nu)/sqrt(1 + alpha.sq) q1 <- function(nu) a(nu)/(c1(nu)*(1 + beta0.sq(nu))) q2 <- function(nu) q1(nu)*(2*c1(nu) - q1(nu))/(2*a(nu)) beta0.sq <- function(nu) # beta0.sq = sum(mu0 * Sigma.inv_mu0) = b(nu)^2 * alpha.sq/(a(nu)+(a(nu)-b(nu)^2)*alpha.sq) #-- Dtheta.dp = D_{DP}\theta Dtheta.dp <- diag(k4) diag(Dtheta.dp)[block3] <- 1/omega Deta.vOmega <- (-0.5)* (t(eta) %x% diag(1/omega^2, d, d)) %*% P %*% D Dtheta.dp[block3, block2] <- Deta.vOmega # mu0 <- function(nu) omega * b(nu) * delta Sigma.etc <- function(nu) { mu0. <- mu0(nu) Omega.inv_mu0 <- as.vector(Omega.inv %*% mu0.) Sigma <- a(nu)*Omega - outer(mu0., mu0.) sigma <- sqrt(diag(Sigma)) tmp <- a(nu) - sum(mu0. *Omega.inv_mu0) Sigma.inv_mu0 <- Omega.inv_mu0/tmp Sigma.inv <- (Omega.inv + outer(Omega.inv_mu0, Omega.inv_mu0)/tmp)/a(nu) list(Sigma=Sigma, Sigma.inv=Sigma.inv, Sigma.inv_mu0=Sigma.inv_mu0, sigma=sigma) } Dq1.nu <- function(nu){ beta0_sq <- beta0.sq(nu) (-2/(nu-2)^2 -a(nu)*(b(nu)^2*u(nu)+beta0_sq/((nu-2)^2*(1+beta0_sq))) /c1(nu)^2)/(c1(nu)*(1+beta0_sq)) } # blocks for D_{\Psi}\theta Dplus <- solve(t(D)%*% D) %*% t(D) DvOmega.vSigma <- function(nu) diag(d*(d+1)/2)/a(nu) DvOmega.mu0 <- function(nu) Dplus %*% (diag(d) %x% mu0(nu) + mu0(nu) %x% diag(d))/a(nu) DvOmega.nu <- function(nu){ s <- Sigma.etc(nu) 2*vech(s$Sigma + outer(mu0(nu), mu0(nu)))/nu^2 } Deta.vSigma <- function(nu) { S <- Sigma.etc(nu) t(-S$Sigma.inv_mu0) %x% (q1(nu)* S$Sigma.inv - q1(nu) * q2(nu) *outer(S$Sigma.inv_mu0, S$Sigma.inv_mu0)) %*% D } Deta.mu0 <- function(nu) { S <- Sigma.etc(nu) q1(nu) * (S$Sigma.inv - 2*q2(nu)*outer(S$Sigma.inv_mu0, S$Sigma.inv_mu0)) } Deta.nu <- function(nu) Dq1.nu(nu) * Sigma.etc(nu)$Sigma.inv_mu0 #-- Dtheta.phi(phi)= D_{\Psi}\theta one00 <- c(1,rep(0,p-1)) Dtheta.phi <- diag(k4) Dtheta.phi[block1, block3] <- -diag(d) %x% one00 Dtheta.phi[block2, block2] <- DvOmega.vSigma(nu+a.incr[2]) Dtheta.phi[block2, block3] <- DvOmega.mu0(nu+a.incr[2]) Dtheta.phi[block2, block4] <- DvOmega.nu(nu+a.incr[2]) Dtheta.phi[block3, block2] <- Deta.vSigma(nu+a.incr[2]) Dtheta.phi[block3, block3] <- Deta.mu0(nu+a.incr[2]) Dtheta.phi[block3, block4] <- Deta.nu(nu +a.incr[2]) # # blocks for D_{\Psi}CP Dgamma2M.misc <- function(nu){ beta0_sq <- beta0.sq(nu) s <- Sigma.etc(nu) nu.34 <- (nu-3)*(nu-4) tmp2 <- ( (d+2)/nu.34 + beta0_sq * (2*nu/((nu-3)*b(nu)^2) - (3*(nu-3)^2-6)/nu.34 )) Dgamma2M.mu0 <- as.vector(8 * tmp2 * t(s$Sigma.inv_mu0)) Dgamma2M.vSigma <- (-4 * tmp2) * as.vector(( t(s$Sigma.inv_mu0) %x% t(s$Sigma.inv_mu0)) %*% D) R <- b(nu)^2*delta.sq*(nu-2)/nu R1R <- R/(1-R) PDgamma2.nu <- (-2*d*(d+2)/(nu-4)^2 -4*((2*nu-7)/nu.34^2) *R1R*(2/(1-R)+d) +2*(2*((nu-3)-nu*(1+2*(nu-3)*u(nu)))/((nu-3)*b(nu))^2 +(3*nu^2-22*nu+41)/nu.34^2)*R1R^2) #\ref{f:partial_gamma2.nu} list(Dgamma2M.vSigma=Dgamma2M.vSigma, Dgamma2M.mu0=Dgamma2M.mu0, PDgamma2.nu=PDgamma2.nu) } Dgamma1.misc <- function(nu) { sigma <- Sigma.etc(nu)$sigma lambda <- mu0(nu)/sigma g.nu <- 3/(nu-3) h.nu <- 1 + nu*(1-1/b(nu)^2)/(nu-3) Q <- g.nu*diag(d) + 3*h.nu*diag(lambda^2) Dgamma1.vOmega <- (t(-lambda/2) %x% (Q %*% diag(1/sigma^2,d))) %*% P %*% D Dgamma1.mu0 <- Q %*% diag(1/sigma,d) # K_{33} Dgamma1.nu <- (-3*lambda/(nu-3)^2 + (-3*(1-1/b(nu)^2)/(nu-3)^2 + 2*nu*u(nu)/((nu-3)*b(nu)^2))*lambda^3) # K_{34} list(Dgamma1.vOmega=Dgamma1.vOmega, Dgamma1.mu0=Dgamma1.mu0, Dgamma1.nu=Dgamma1.nu) } # #-- # Dcp.phi(phi) = D_{\Psi}(CP) [in the notes] = D_{\phi}\bar\rho [paper] # Dcp.phi <- diag(k4) K3 <- Dgamma1.misc(nu+a.incr[3]) K4 <- Dgamma2M.misc(nu+a.incr[4]) Dcp.phi[block3,block2] <- K3$Dgamma1.vOmega Dcp.phi[block3,block3] <- K3$Dgamma1.mu0 Dcp.phi[block3,block4] <- K3$Dgamma1.nu Dcp.phi[block4,block2] <- K4$Dgamma2M.vSigma Dcp.phi[block4,block3] <- K4$Dgamma2M.mu0 Dcp.phi[block4,block4] <- K4$PDgamma2.nu # # Dtheta.cp <- Dtheta.phi %*% solve(Dcp.phi) list(Dtheta.dp=Dtheta.dp, Dtheta.cp= Dtheta.phi %*% solve(Dcp.phi), Dtheta.phi=Dtheta.phi, Dcp.phi=Dcp.phi) } # mst.vdp2vcp <- function(vdp, p, d, cp.type="proper") { # vdp = c(betaDP, vech(Omega), alpha, nu), # vcp=(betaCP, vech(Sigma), gamma1, gamma2M) # d=ncol(y), p=ncol(x) beta <- matrix(vdp[1:(p*d)], p, d) vOmega <- vdp[(p*d+1):(p*d+d*(d+1)/2)] Omega <- vech2mat(vOmega) # omega <- sqrt(diag(Omega)) alpha <- vdp[(p*d+d*(d+1)/2+1):(p*d+d*(d+1)/2+d)] nu <- vdp[p*d+d*(d+1)/2+d+1] dp <- list(beta=beta, Omega=Omega, alpha=alpha, nu=nu) cp <- mst.dp2cp(dp, cp.type=cp.type) c(cp[[1]], vech(cp[[2]]), cp[[3]], cp[[4]]) } # mst.logL <- function(vdp, X, y, dp=TRUE, penalty=NULL) { # calcola logL rispetto a DP (se dp=TRUE) oppure a theta (se dp=FALSE), # con eventuale inclusione del termine 'penalty' se presente; # funziona non solo per ST, ma anche per SN ponendo dp$nu=Inf n <- nrow(y) d <- ncol(y) if(missing(X)) X <- matrix(1,n,1) p <- ncol(X) beta <- matrix(vdp[1:(p*d)], p, d) vOmega <- vdp[(p*d+1):(p*d+d*(d+1)/2)] Omega <- vech2mat(vOmega) # if(any(eigen(Omega)$values <= 0)) return(NA) if(any(diag(Omega) <= 0)) return(-Inf) omega <- sqrt(diag(Omega)) tmp <- vdp[(p*d+d*(d+1)/2+1):(p*d+d*(d+1)/2+d)] alpha <- if(dp) tmp else tmp*omega nu <- vdp[p*d+d*(d+1)/2+d+1] if(nu <= 0) return(-Inf) Q <- if(is.null(penalty)) 0 else penalty(list(alpha, cov2cor(Omega)), nu) sum(dmst(y, X %*% beta, Omega, alpha, nu, log=TRUE)) - Q } st.infoMv <- function(dp, x=NULL, y, w, fixed.nu=NULL, symmetr=FALSE, penalty=NULL, norm2.tol=1e-06) {# Computes observed Fisher information matrices for multiv.ST distribution # using expressions of score function of Arellano-Valle (2010, Metron), # followed by numerical differentiation. Expected info matrix not implemented. # Info matrices are computed for DP, CP and pseudo-CP if(missing(y)) stop("missing y") if(!is.matrix(y)) stop("y is not matrix") type <- "observed" d <- ncol(dp$Omega) d2 <- d*(d+1)/2 if(missing(w)) w <- rep(1, nrow(cbind(x,y))) if(any(w != round(w)) || any(w<0)) stop("weights must be non-negative integers") n <- length(w) nw <- sum(w) if(is.null(x)) { p <- 1 xx <- sum.x <- nw x <- matrix(1, nrow=n, ncol=1) } else { p <- NCOL(x) # x <- matrix(x, n, p) xx <- drop(t(x) %*% (w*x)) sum.x <- drop(matrix(colSums(w*x))) } beta <- as.matrix(dp[[1]], p, d) Omega <- dp[[2]] omega <- sqrt(diag(Omega)) alpha <- if(symmetr) rep(0,d) else dp$alpha eta <- alpha/omega nu <- if(is.null(fixed.nu)) dp$nu else fixed.nu dp1 <- list(beta=beta, Omega=Omega, alpha=alpha, nu=nu) Obar <- cov2cor(Omega) Obar.alpha <- as.vector(Obar %*% alpha) alpha.star <- sqrt(sum(alpha * Obar.alpha)) # =\sqrt{\eta\T\Omega\eta} theta <- as.numeric(c(beta, vech(Omega), eta, nu)) vdp <- as.numeric(c(beta, vech(Omega), alpha, nu)) penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) H <- numDeriv::hessian(mst.logL, vdp, X=x, y=y, dp=TRUE, penalty=penalty.fn) J <- mst.theta.jacobian(theta, p=NCOL(x), d=NCOL(y)) s <- 1:(length(theta) - as.numeric(!is.null(fixed.nu))) I.dp <- force.symmetry(-H[s,s]) J1 <- solve(J$Dtheta.dp[s,s]) I.theta <- force.symmetry(t(J1) %*% I.dp %*% J1) asyvar.dp <- pd.solve(I.dp, silent=TRUE) if(is.null(asyvar.dp)) { warning("Condition 'information_matrix > 0' fails, DP seems not at MLE") se.dp <- list(NULL) } else { diags.dp <- sqrt(diag(asyvar.dp)) se.beta <- matrix(diags.dp[1:(p*d)], p, d) se.diagOmega <- diags.dp[p*d + d2 +1 - rev(cumsum(1:d))] se.alpha <- diags.dp[p*d +d2 +(1:d)] se.dp <- list(beta=se.beta, diagOmega=se.diagOmega, alpha=se.alpha) if(is.null(fixed.nu)) se.dp$nu<- diags.dp[p*d +d2 + d +1] } if(nu>4) { cp <- mst.dp2cp(dp, cp.type="proper", fixed.nu=fixed.nu, symmetr=symmetr) I.cp <- force.symmetry(t(J$Dtheta.cp[s,s]) %*% I.theta %*% J$Dtheta.cp[s,s]) asyvar.cp <- pd.solve(I.cp, silent=TRUE) if(is.null(asyvar.cp)) { se.cp <- list(NULL) } else { diags.cp <- sqrt(diag(asyvar.cp)) se.beta <- matrix(diags.cp[1:(p*d)], p, d) se.diagSigma <- diags.cp[p*d + d2 +1 - rev(cumsum(1:d))] # se.sigma <- se.Sigma/(2*sigma) se.gamma1 <- if(!symmetr) diags.cp[p*d + d2 +(1:d)] else NULL se.cp <- list(beta=se.beta, var=se.diagSigma, gamma1=se.gamma1) if(is.null(fixed.nu)) se.cp$gamma2 <- diags.cp[p*d +d2 + d +1] }} else I.cp <- asyvar.cp <- se.cp <- cp <- NULL if(is.null(asyvar.dp)) { asyvar.pcp <- NULL se.pcp <- list(NULL) Jp <- NULL } else { vdp1 <- as.numeric(c(dp1[[1]], vech(dp1[[2]]), dp1[[3]], dp1[[4]])) Jp <- numDeriv::jacobian(mst.vdp2vcp, vdp1, p=ncol(x), d=ncol(y), cp.type="pseudo") asyvar.pcp <- (Jp[s,s]) %*% asyvar.dp %*% t(Jp[s,s]) diags.pcp <- sqrt(diag(asyvar.pcp)) se.beta <- matrix(diags.pcp[1:(p*d)], p, d) se.diagSigma <- diags.pcp[p*d + d2 +1 - rev(cumsum(1:d))] # se.sigma <- se.Sigma/(2*sigma) se.gamma1 <- if(!symmetr) diags.pcp[p*d + d2 +(1:d)] else NULL se.pcp <- list(beta=se.beta, var=se.diagSigma, gamma1=se.gamma1) if(is.null(fixed.nu)) se.pcp$gamma2 <- diags.pcp[p*d +d2 + d +1] } aux <- list(Dpseudocp.dp=Jp[s,s]) list(dp=dp, cp=cp, type=type, info.dp=I.dp, info.cp=I.cp, asyvar.dp=asyvar.dp, asyvar.cp=asyvar.cp, asyvar.p_cp=asyvar.pcp, se.dp=se.dp, se.cp=se.cp, se.p_cp=se.pcp, aux=aux) } sn.mple <- function(x, y, cp=NULL, w, penalty=NULL, trace=FALSE, opt.method=c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control=list()) {# MPLE for CP of univariate SN (not intendend for ESN) y <- drop(y) n <- length(y) if (missing(x)) x <- matrix(rep(1,n), nrow=n, ncol=1) else if (is.null(n <- nrow(x))) stop("'x' must be a matrix") if (n == 0) stop("0-row design matrix cases") if (missing(w)) w <- rep(1,n) if(length(w) != n) stop("incompatible dimensions") y.name <- deparse(substitute(y)) x.name <- deparse(substitute(x)) p <- ncol(x) max.gamma1 <- 0.5*(4-pi)*(2/(pi-2))^1.5 - (.Machine$double.eps)^(1/4) if(is.null(cp)) { qr.x <- qr(x) s <- sqrt(sum(qr.resid(qr.x, y)^2)/n) gamma1 <- sum(qr.resid(qr.x, y)^3)/(n*s^3) if(abs(gamma1) > max.gamma1) gamma1 <- sign(gamma1)*0.9*max.gamma1 cp <- as.numeric(c(qr.coef(qr.x, y), s, gamma1)) } else{ if(length(cp)!= (p+2)) stop("ncol(x)+2 != length(cp)")} penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) opt.method <- match.arg(opt.method) if(opt.method == "nlminb") { opt <- nlminb(cp, objective=sn.pdev, gradient=sn.pdev.gh, hessian=sn.pdev.hessian, lower=c(-rep(Inf,p), sqrt(.Machine$double.eps), -max.gamma1), upper=c(rep(Inf,p), Inf, max.gamma1), control=control, x=x, y=y, w=w, penalty=penalty.fn, trace=trace) opt$value <- opt$objective } else { opt <- optim(cp, fn=sn.pdev, gr=sn.pdev.gh, method = opt.method, control = control, # lower & upper not used to allow all opt.method x=x, y=y, w=w, penalty=penalty.fn, trace=trace) } cp <- opt$par names(cp) <- param.names("CP", "SN", p, colnames(x)[-1]) logL <- (-opt$value)/2 boundary <- as.logical(abs(cp[p+2]) >= max.gamma1) if(trace) { cat("Message from function", opt.method, ": ", opt$message, "\n") cat("estimates (cp):", cp, "\n") cat("(penalized) log-likelihood:", logL, "\n") } opt$method <- opt.method opt$called.by <- "sn.mple" list(call=match.call(), cp=cp, logL=logL, boundary=boundary, opt.method=opt) } sn.pdev <- function(cp, x, y, w, penalty=NULL, trace=FALSE) { # "penalized deviance"=-2*(logL-Q) for centred parameters of SN distribution p <- ncol(x) if(abs(cp[p+2])> 0.9952717) return(Inf) if(missing(w)) w <- rep(1, length(y)) if(any(w < 0)) stop("weights must be non-negative") dp <- cp2dpUv(cp, "SN") xi <- as.vector(x %*% as.matrix(dp[1:p])) if(dp[p+1] <= 0) return(NA) logL <- sum(w * dsn(y, xi, dp[p+1], dp[p+2], log=TRUE)) Q <- if(is.null(penalty)) 0 else penalty(dp[p+2], der=0) if(trace) cat("sn.pdev: (cp,pdev) =", format(c(cp, -2*(logL-Q))),"\n") return(-2 * (logL - Q)) } sn.pdev.gh <- function(cp, x, y, w, penalty=NULL, trace=FALSE, hessian=FALSE) { # computes gradient and hessian of pdev=-2*(logL-Q) for centred parameters p <- ncol(x) n <- nrow(x) if(abs(cp[p+2]) > 0.9952717) return(rep(NA,p+2)) if(missing(w)) w <- rep(1,n) if(any(w < 0)) stop("weights must be non-negative") score <- rep(NA,p+2) info <- matrix(NA,p+2,p+2) beta <- cp[1:p] sigma <- cp[p+1] gamma1 <- cp[p+2] nw <- sum(w) dp <- cp2dpUv(cp, "SN") lambda <- dp[p+2] mu <- as.vector(x %*% as.matrix(beta)) d <- y-mu r <- d/sigma mu.z<- lambda*sqrt(2/(pi*(1+lambda^2))) sd.z<- sqrt(1-mu.z^2) z <- mu.z+sd.z*r p1 <- as.vector(zeta(1,lambda*z)) p2 <- as.vector(zeta(2,lambda*z)) omega<- sigma/sd.z af <- lambda*p1-mu.z Dmu.z <- sqrt(2/pi)/(1+lambda^2)^1.5 Dsd.z <- (-mu.z/sd.z)*Dmu.z Dz <- Dmu.z + r*Dsd.z DDmu.z<- (-3)*mu.z/(1+lambda^2)^2 DDsd.z<- -((Dmu.z*sd.z-mu.z*Dsd.z)*Dmu.z/sd.z^2+mu.z*DDmu.z/sd.z) DDz <- DDmu.z + r*DDsd.z score[1:p] <- omega^(-2) * t(x) %*% as.matrix(w*(y-mu-omega*af)) score[p+1] <- (-nw)/sigma + sd.z*sum(w*d*(z-p1*lambda))/sigma^2 score.l <- nw*Dsd.z/sd.z - sum(w*z*Dz) + sum(w*p1*(z+lambda*Dz)) if(!is.null(penalty)) { Q <- penalty(lambda, der=2) score.l <- (score.l - attr(Q, "der1")) } Dg.Dl <- 1.5*(4-pi)*mu.z^2 * (Dmu.z*sd.z - mu.z*Dsd.z)/sd.z^4 R <- mu.z/sd.z T <- sqrt(2/pi-(1-2/pi)*R^2) Dl.Dg <- 2*(T/(T*R)^2+(1-2/pi)/T^3)/(3*(4-pi)) R. <- 2/(3*R^2 * (4-pi)) T. <- (-R)*R.*(1-2/pi)/T DDl.Dg <- (-2/(3*(4-pi))) * (T./(R*T)^2+2*R./(T*R^3)+3*(1-2/pi)*T./T^4) score[p+2] <- score.l/Dg.Dl # convert deriv wrt lamda to gamma1 gradient <- (-2)*score if(hessian){ # info = -(second deriv of logL) info[1:p,1:p] <- omega^(-2) * t(x) %*% (w*(1-lambda^2*p2)*x) info[1:p,p+1] <- info[p+1,1:p] <- sd.z* t(x) %*% as.matrix(w*(z-lambda*p1)+ w*d*(1-lambda^2*p2)* sd.z/sigma)/sigma^2 info[p+1,p+1] <- (-nw)/sigma^2 + 2*sd.z*sum(w*d*(z-lambda*p1))/sigma^3 + sd.z^2*sum(w*d*(1-lambda^2*p2)*d)/sigma^4 info[1:p,p+2] <- info[p+2,1:p] <- t(x) %*% (w* (-2*Dsd.z*d/omega+Dsd.z*af+sd.z*(p1+lambda*p2*(z+lambda*Dz) -Dmu.z)))/sigma info[p+1,p+2] <- info[p+2,p+1] <- -sum(w*d*(Dsd.z*(z-lambda*p1)+sd.z*(Dz-p1-p2*lambda*(z+lambda*Dz)) ))/sigma^2 info[p+2,p+2] <- (nw*(-DDsd.z*sd.z+Dsd.z^2)/sd.z^2+sum(w*(Dz^2+z*DDz)) - sum(w*p2*(z+lambda*Dz)^2)- sum(w*p1*(2*Dz+lambda*DDz))) if(!is.null(penalty)) info[p+2,p+2] <- info[p+2,p+2] + attr(Q, "der2") info[p+2,] <- info[p+2,]/Dg.Dl # convert info wrt lambda to gamma1 info[,p+2] <- info[,p+2]*Dl.Dg # an equivalent form of the above info[p+2,p+2] <- info[p+2,p+2] - score.l*DDl.Dg attr(gradient,"hessian") <- force.symmetry(2*info) } if(trace) cat("sn.pdev.gh: gradient = ", format(gradient),"\n") return(gradient) } sn.pdev.hessian <- function(cp, x, y, w, penalty=NULL, trace=FALSE) { gh <- sn.pdev.gh(cp, x, y, w, penalty=penalty, trace=trace, hessian=TRUE) attr(gh, "hessian") } Qpenalty <- function(alpha_etc, nu=NULL, der=0) {# 'standard' penalty function of logL, possibly with derivatives e1 <- e1. <- 1/3 e2 <- e2. <- 0.2854166 if(!is.null(nu)) if(nu 0) attr(penalty,"der1") <- numDeriv::grad(MPpenalty, alpha) if(der > 1) attr(penalty,"der2") <- numDeriv::hessian(MPpenalty, alpha) return(penalty) } msn.mple <- function(x, y, start=NULL, w, trace=FALSE, penalty=NULL, opt.method=c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control=list() ) { y <- data.matrix(y) if(missing(x)) x <- rep(1,nrow(y)) else {if(!is.numeric(x)) stop("x must be numeric")} if(missing(w)) w <- rep(1,nrow(y)) opt.method <- match.arg(opt.method) x <- data.matrix(x) d <- ncol(y) n <- sum(w) p <- ncol(x) y.names <- dimnames(y)[[2]] x.names <- dimnames(x)[[2]] if(is.null(start)) start <- msn.mle(x, y, NULL, w)$dp if(trace){ cat("msn.mple initial parameters:\n") print(cbind(t(start[[1]]), start$Omega, start$alpha)) } param <- dplist2optpar(start) if(!is.null(penalty)) penalty <- get(penalty, inherits=TRUE) opt.method <- match.arg(opt.method) if(opt.method == "nlminb"){ opt <- nlminb(param, msn.pdev, # msn.pdev.grad, control=control, x=x, y=y, w=w, penalty=penalty, trace=trace) opt$value<- opt$objective } else{ opt <- optim(param, fn=msn.pdev, method=opt.method, control=control, x=x, y=y, w=w, penalty=penalty, trace=trace) } if(trace) cat(paste("Message from optimization routine:", opt$message,"\n")) logL <- opt$value/(-2) dp.list <- optpar2dplist(opt$par, d, p) beta <- dp.list$beta dimnames(beta)[2] <- list(y.names) dimnames(beta)[1] <- list(x.names) Omega <- dp.list$Omega alpha <- dp.list$alpha dimnames(Omega) <- list(y.names,y.names) names(alpha) <- y.names alpha2 <- sum(alpha * as.vector(cov2cor(Omega) %*% alpha)) delta.star <- sqrt(alpha2/(1+alpha2)) dp <- list(beta=beta, Omega=Omega, alpha=alpha) opt$method <- opt.method opt$called.by <- "msn.mple" aux <- list(penalty=penalty, alpha.star=sqrt(alpha2), delta.star=delta.star) list(call=match.call(), dp=dp, logL=logL, aux=aux, opt.method=opt) } msn.pdev <- function(param, x, y, w, penalty=NULL, trace=FALSE) { # -2*(profile.logL - Q) d <- ncol(y) if(missing(w)) w <- rep(1, nrow(y)) n <- sum(w) p <- ncol(x) dp. <- optpar2dplist(param, d=ncol(y), p=ncol(x)) logL <- sum(w * dmsn(y, x %*% dp.$beta, dp.$Omega, dp.$alpha, log=TRUE)) Q <- if(is.null(penalty)) 0 else penalty(list(dp.$alpha,dp.$Omega), der=0) pdev <- (-2)*(logL-Q) if(trace) cat("opt param:", format(param), "\nmsn.pdev:", format(pdev),"\n") return(pdev) } optpar2dplist <- function(param, d, p, x.names=NULL, y.names=NULL) {# convert vector form of optimization parameters to DP list; # output includes inverse(Omega) and its log determinant beta <- matrix(param[1:(p * d)], p, d) D <- exp(-2 * param[(p * d + 1):(p * d + d)]) A <- diag(d) i0 <- p*d + d*(d+1)/2 if(d>1) A[!lower.tri(A,diag=TRUE)] <- param[(p*d+d+1):i0] eta <- param[(i0 + 1):(i0 + d)] nu <- if(length(param) == (i0 + d + 1)) exp(param[i0 + d + 1]) else NULL Oinv <- t(A) %*% diag(D,d,d) %*% A # Omega <- pd.solve(Oinv) Ainv <- backsolve(A, diag(d)) Omega <- Ainv %*% diag(1/D,d,d) %*% t(Ainv) Omega <- (Omega + t(Omega))/2 omega <- sqrt(diag(Omega)) alpha <- eta * omega dimnames(beta) <- list(x.names, y.names) dimnames(Omega) <- list(y.names, y.names) if (length(y.names) > 0) names(alpha) <- y.names dp <- list(beta=beta, Omega=Omega, alpha=alpha) if(!is.null(nu)) dp$nu <- nu list(dp=dp, beta=beta, Omega=Omega, alpha=alpha, nu=nu, Omega.inv=Oinv, log.det=sum(log(D))) } dplist2optpar <- function(dp, Omega.inv=NULL) {# convert DP list to vector form of optimization parameters beta <- dp[[1]] Omega <- dp[[2]] alpha <- dp[[3]] d <- length(alpha) nu <- if(is.null(dp$nu)) NULL else dp$null eta <- alpha/sqrt(diag(Omega)) Oinv <- if(is.null(Omega.inv)) pd.solve(Omega) else Omega.inv if(is.null(Oinv)) stop("matrix Omega not symmetric positive definite") upper <- chol(Oinv) D <- diag(upper) A <- upper/D D <- D^2 param <- if(d > 1) c(beta, -log(D)/2, A[!lower.tri(A, diag = TRUE)], eta) else c(beta, -log(D)/2, eta) if(!is.null(dp$nu)) param <- c(param, log(dp$nu)) param <- as.numeric(param) attr(param, 'ind') <- cumsum(c(length(beta), d, d*(d-1)/2, d, length(dp$nu))) return(param) } force.symmetry <- function(x, tol=10*sqrt(.Machine$double.eps)) { if(!is.matrix(x)) stop("x must be a matrix") # err <- abs(x-t(x)) err <- abs(x-t(x))/(1+abs(x)) max.err <- max(err/(1+err)) if(max.err > tol) warning("matrix seems not symmetric") if(max.err > 100*tol) stop("this matrix really seems not symmetric") return((x + t(x))/2) } duplicationMatrix <- duplication_matrix <- function (n=1) {# translated by AA from Octave code written by if ( (n<1) | (round (n) != n) ) stop ("n must be a positive integer") d <- matrix (0, n * n, n * (n + 1) / 2) ## KH: It is clearly possible to make this a LOT faster! count = 0 for (j in 1 : n){ d [(j - 1) * n + j, count + j] = 1 if(j= 1)) stop("probs must be within (0,1)") if(sum(probs > 0 && probs < 1) == 0) stop("invalid probs") if(missing(npt)) npt <- rep(101, d) if(missing(main)) { main <- if(d==2) paste("Density function of", slot(obj, "name")) else paste("Bivariate densities of", slot(obj, "name")) } if(missing(comp)) comp <- seq(1,d) if(missing(compLabs)) compLabs <- compNames if(length(compLabs) != d) stop("wrong length of 'compLabs' or 'comp' vector") family <- toupper(obj@family) lc.family <- tolower(family) if(lc.family == "esn") lc.family <- "sn" dp <- slot(obj, "dp") if(missing(range)) { range <- matrix(NA,2,d) q.fn <- get(paste("q", lc.family, sep=""), inherits=TRUE) for(j in 1:d) { marg <- marginalSECdistr(obj, comp=j, drop=TRUE) q <- q.fn(c(0.05, 0.25, 0.75, 0.95), dp=marg@dp) dq <- diff(q) range[,j] <- c(q[1] - 1.5*dq[1], q[length(q)] + 1.5*dq[length(dq)]) if(!is.null(data)) { range[1,j] <- min(range[1,j], min(data[,j])) range[2,j] <- max(range[2,j], max(data[,j])) }} } dots <- list(...) nmdots <- names(dots) if(d == 1) { message("Since dimension=1, plot as a univariate distribution") objUv <- marginalSECdistr(obj, comp=1, drop=TRUE) out <- plot(objUv, data=data, ...) } if(d == 2) out <- list(object=obj, plot=plot.SECdistrBv(x, range, probs, npt, compNames, compLabs, landmarks, data, data.par, main, ...)) if(d > 2) { textPanel <- function(x = 0.5, y = 0.5, txt, cex, font) text(x, y, txt, cex = cex, font = font) localAxis <- function(side, x, y, xpd, bg, main, oma, ...) { if (side%%2 == 1) Axis(x, side = side, xpd = NA, ...) else Axis(y, side = side, xpd = NA, ...) } localPlot <- function(..., oma, font.main, cex.main) plot.SECdistrBv(...) text.diag.panel <- compLabs oma <- if ("oma" %in% nmdots) dots$oma else NULL if (is.null(oma)) { oma <- c(4, 4, 4, 4) if (!is.null(main)) oma[3L] <- 6 } opar <- par(mfrow = c(length(comp), length(comp)), mar = rep(c(gap,gap/2), each=2), oma=oma) on.exit(par(opar)) out <- list(object=obj) count <- 1 for (i in comp) for (j in comp) { count <- count + 1 if(i == j) { plot(1, type="n", xlab="", ylab="", axes=FALSE) text(1, 1, text.diag.panel[i], cex=2) box() out[[count]] <- list() names(out)[count] <- paste("diagonal component", compNames[i]) } else { ji <- c(j,i) marg <- marginalSECdistr(obj, comp=ji) out[[count]] <- localPlot(x=marg, range=range[,ji], probs=probs, npt=npt[ji], compNames= compNames[ji], compLabs=compLabs[ji], landmarks=landmarks, data=data[,ji], data.par=data.par, main="", yaxt="n", xaxt="n", ...) names(out)[count] <- paste("plot of components (", j, ",", i, ")") # if(i==comp[1]) {axis(3); if(j==length(comp)) axis(4)} # if(j==comp[1]) {axis(2); if(i==length(comp)) axis(1)} if(i==comp[1]) axis(3) ; if(j==length(comp)) axis(4) if(j==comp[1]) axis(2) ; if(i==length(comp)) axis(1) box() } } par(new = FALSE) if (!is.null(main)) { font.main <- if ("font.main" %in% nmdots) dots$font.main else par("font.main") cex.main <- if ("cex.main" %in% nmdots) dots$cex.main else par("cex.main") mtext(main, side=3, TRUE, line=5, outer = TRUE, at=NA, cex=cex.main, font=font.main, adj=0.5) }} invisible(out) } plot.SECdistrBv <- function(x, range, probs, npt=rep(101,2), compNames, compLabs, landmarks, data=NULL, data.par, main, ...) {# plot BiVariate SEC distribution obj <- x dp <- slot(obj, "dp") family <- slot(obj, "family") lc.family <- tolower(family) if(lc.family == "esn") lc.family <- "sn" d.fn <- get(paste("dm", lc.family, sep=""), inherits=TRUE) # density funct n1 <- npt[1] n2 <- npt[2] x1 <- seq(min(range[,1]), max(range[,1]), length=n1) x2 <- seq(min(range[,2]), max(range[,2]), length=n2) x1.x2 <- cbind(rep(x1, n2), as.vector(matrix(x2, n1, n2, byrow=TRUE))) X <- matrix(x1.x2, n1 * n2, 2, byrow = FALSE) pdf <- matrix(d.fn(X, dp=dp), n1, n2) Omega <- dp[[2]] Omega.bar <- cov2cor(Omega) alpha <- dp[[3]] alpha.star <- sqrt(sum(alpha * as.vector(Omega.bar %*% alpha))) omega <- sqrt(diag(Omega)) if(lc.family == "sn") { k.tau <- if (length(dp) == 4) (zeta(2,dp[[4]])*pi)^2/4 else 1 log.levels <- (log(1-probs) - log(2*pi)- 0.5*log(1-Omega.bar[1,2]^2) + k.tau * log(1+exp(-1.544/alpha.star))) - sum(log(omega)) } if(lc.family == "st" | lc.family == "sc") { nu <- if(lc.family == "st") obj@dp[[4]] else 1 l.nu <- (-1.3/nu - 4.93) if(alpha.star > 0) { h <- 100 * log(exp(((1.005*alpha.star-0.045)* l.nu -1.5)/alpha.star)+1) K <- h *(1.005*alpha.star-0.1)*(1+nu)/(alpha.star * nu) } else K <- 0 qF <- qf(probs, 2, nu) log.levels <- (lgamma(nu/2+1) -lgamma(nu/2) - log(pi*nu) -0.5*log(1-Omega.bar[1,2]^2) - (nu/2+1)*log(2*qF/nu + 1) + K -sum(log(omega))) } oo <- options() options(warn=-1) d.levels <- exp(log.levels) names(d.levels) <- as.character(probs) contour(x1, x2, pdf, levels=d.levels, labels=paste("p=", as.character(probs), sep=""), main=main, xlab=compLabs[1], ylab=compLabs[2], ...) if(!is.null(data)) { col <- if(!is.null(data.par$col)) data.par$col else par()$col pch <- if(!is.null(data.par$pch)) data.par$pch else par()$pch cex <- if(!is.null(data.par$cex)) data.par$cex else par()$cex points(data, col=col, pch=pch, cex=cex) if(!is.null(id.i <- data.par$id.i)) text(data[id.i,1], data[id.i,2], id.i, cex=cex/1.5, pos=1) } if(landmarks != "") { if(landmarks == "auto") { mean.type <- "proper" if(lc.family == "sc") mean.type <- "pseudo" if(lc.family == "st") { if(dp[[4]] <= 1) mean.type <- "pseudo"} } else mean.type <- landmarks landmarks.label <- c("origin", "mode", if(mean.type == "proper") "mean" else "mean~") cp <- dp2cpMv(dp, family, cp.type=mean.type, upto=1) mode <- modeSECdistrMv(dp, family) x.pts <- c(dp$xi[1], mode[1], cp[[1]][1]) y.pts <- c(dp$xi[2], mode[2], cp[[1]][2]) points(x.pts, y.pts, ...) col <- if(!is.null(list(...)$col)) list(...)$col else par()$col text(x.pts, y.pts, landmarks.label, pos=2, offset=0.3, col=col) lines(x.pts, y.pts, lty=2, col=col) } options(oo) cL <- contourLines(x1, x2, pdf, levels=d.levels) for(j in 1:length(probs)) cL[[j]]$prob <- probs[j] return(list(x=x1, y=x2, names=compNames, density=pdf, contourLines=cL)) } plot.selm <- function(x, param.type="CP", which = c(1:4), caption, panel = if (add.smooth) panel.smooth else points, main = "", # sub.caption = NULL, ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(x@residuals.dp), cex.id = 0.75, identline = TRUE, add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) { if(class(x) != "selm") stop("object not of class 'selm'") show <- rep(FALSE, 4) show[which] <- TRUE dots <- list(...) nmdots <- names(dots) p <- slot(x, "size")["p"] if(missing(caption)) { caption <- if(p> 1) c("Residuals vs Fitted Values", "Residual values and fitted error distribution", "Q-Q plot of (scaled DP residuals)^2", "P-P plot of (scaled DP residuals)^2") else c("Boxplot of observed values", "Empirical values and fitted distribution", "Q-Q plot of (scaled DP residuals)^2", "P-P plot of (scaled DP residuals)^2")} all.par <- slot(x, "param") param.type <- tolower(param.type) param <- all.par[[param.type]] if(is.null(param)) { message(paste( "Requested param.type='", param.type, "' evaluates to NULL.", sep="")) if(param.type == "pseudo-cp" & x@family== "SN") message("Pseudo-CP makes no sense for SN family") if(param.type == "cp" & x@family== "SC") message("CP makes no sense for SC family") if(param.type == "cp" & x@family== "ST") message("CP of ST family requires nu>4") stop("Consider another choice of param.type (DP or pseudo-CP)") } r <- residuals(x, param.type) r.lab <- paste(toupper(param.type), "residuals") dp <- if(length(all.par$fixed) > 0) all.par$dp.complete else all.par$dp nu. <- switch(x@family, ST = dp[p+3], SN = Inf, SC=1) rs <- slot(x,"residuals.dp")/dp[p+1] rs2 <- rs^2 n <- slot(x, "size")["n.obs"] yh <- fitted(x, param.type) w <- weights(x) if (!is.null(w)) { wind <- (w != 0) r <- r[wind] yh <- yh[wind] w <- w[wind] labels.id <- labels.id[wind] } else w <- rep(1,n) rw <- n*w/slot(x,"size")["nw.obs"] cex.pts <- rw * if("cex" %in% nmdots) dots$cex else par("cex") if (is.null(id.n)) id.n <- 0 else { id.n <- as.integer(id.n) if (id.n < 0 || id.n > n) stop(gettextf("'id.n' must be in {1,..,%d}", n), domain = NA) } if (id.n > 0) { if (is.null(labels.id)) labels.id <- paste(1:n) iid <- 1:id.n # show.r <- sort.list(abs(r), decreasing = TRUE)[iid] show.rs <- sort.list(rs2, decreasing = TRUE)[iid] # rs2.lab <- paste("(scaled DP residuals)^2") text.id <- function(x, y, ind, adj.x = TRUE) { labpos <- if (adj.x) label.pos[1 + as.numeric(x > mean(range(x)))] else 3 text(x, y, labels.id[ind], cex = cex.id, xpd = TRUE, pos = labpos, offset = 0.25) } } one.fig <- prod(par("mfcol")) == 1 if (ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } if (show[1]) { if(all(is.na(r)) & p>1) message(paste("CP residuals not available;", "consider param.type='DP' or 'pseudo-CP'")) else { if(p == 1){ y <- (x@residuals.dp + x@fitted.values.dp) boxplot(y, plot=TRUE, col="gray85", border="gray60") } else { # p>1 # if (id.n > 0) # ylim <- extendrange(r = ylim, f = 0.08) ylim <- range(r, na.rm = TRUE) plot(yh, r, xlab = "Fitted values", ylab = r.lab, main = main, ylim = ylim, type = "n") panel(yh, r, ...) # previously it included 'cex=cex.pts' # if (one.fig) title(sub = sub.caption, ...) if (id.n > 0) { y.id <- r[show.rs] y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 text.id(yh[show.rs], y.id, show.rs) } abline(h = 0, lty = 2, col = "gray") } } mtext(caption[1], 3, 0.5, cex = cex.caption) } if (show[2]) { if(all(is.na(r)) & p>1) message( "CP residuals not available; consider param.type='DP' or 'pseudo-CP'") else { if (p == 1){ y <- (x@residuals.dp + x@fitted.values.dp) dp0 <- dp xlab="observed variable"} else { y <- r dp0 <- as.numeric(c(dp[1]-param[1], dp[-(1:p)])) xlab=r.lab } h <- hist(rep(y, w), plot=FALSE) extr <- extendrange(x=h$breaks) x.pts <- seq(max(extr), min(extr), length=501) d.fn <- get(paste("d", tolower(x@family), sep=""), inherits = TRUE) pdf <- d.fn(x.pts, dp=dp0) plot(c(h$mids, x.pts), c(h$density, pdf), type="n", main=main, xlab=xlab, ylab="probability density") hist(rep(y, w), col="gray95", border="gray60", probability=TRUE, freq=FALSE, add=TRUE) lines(x.pts, pdf, ...) rug(y, ticksize=0.02, ...) # if (id.n > 0) { rug(y, ticksize=0.015, ...) # text(y[show.rs], 0, labels.id[show.rs], srt=90, cex=0.5, pos=1, # offset=0.2) } mtext(caption[2], 3, 0.25, cex = cex.caption) }} if (show[3]) { ylim <- c(0, max(pretty(rs2))) q <- qf((1:n)/(n+1), 1, nu.) plot(q, sort(rs2), xlab="Theoretical values", ylab="Empirical values", ylim=ylim, type="p", main=main, ...) # cex=cex.pts if(identline) abline(0, 1, lty = 2, col = "gray50") # if (one.fig) title(sub = sub.caption, ...) mtext(caption[3], 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(q[n+1-iid], rs2[show.rs], show.rs) } if (show[4]) { p <- (1:n)/(n+1) pr <- pf(sort(rs2), 1, nu.) plot(p, pr, xlab="Theoretical values", ylab="Empirical values", xlim=c(0,1), ylim=c(0,1), main=main, ...) # cex=cex.pts, if(identline) abline(0, 1, lty = 2, col = "gray50") # if (one.fig) title(sub = sub.caption, ...) mtext(caption[4], 3, 0.25, cex = cex.caption) if(identline) abline(0, 1, lty = 2, col = "gray50") if (id.n > 0) text.id(p[n+1-iid], pr[n+1-iid], show.rs) } # if (!one.fig && par("oma")[3] >= 1) # mtext(sub.caption, outer = TRUE, cex = 1.25) invisible() } print.summary.selm <- function(object) { obj <- object digits = max(3, getOption("digits") - 3) cat("Call: ") print(slot(obj, "call")) n <- obj@size["n.obs"] cat("Number of observations:", n, "\n") if(!is.null(slot(obj,"aux")$weights)) cat("Weighted number of observations:", obj@size["nw.obs"], "\n") show.family <- slot(obj,"family") cat("Family:", show.family,"\n") fixed <- slot(obj, "param.fixed") if(length(fixed) > 0) { fixed.char <- paste(names(fixed), format(fixed), sep=" = ", collapse=", ") cat("Fixed parameters:", fixed.char, "\n") } method <- slot(obj, "method") u <- if(length(method)==1) NULL else paste(", penalty function:", method[2]) cat("Estimation method: ", method[1], u, "\n", sep="") logL.name <- paste(if(method[1] == "MLE") "Log" else "Penalized log", "likelihood:", sep="-") cat(logL.name, format(slot(obj,"logL"), nsmall=2), "\n") param.type <- slot(obj, "param.type") cat("Parameter type:", param.type,"\n") if((note <- slot(object,"note")) != "") cat(paste("Note:", note, "\n")) if(obj@boundary) cat("Estimates on/near the boundary of the parameter space\n") resid <- slot(obj, "resid") if(n > 5) { nam <- c("Min", "1Q", "Median", "3Q", "Max") rq <- if (length(dim(resid)) == 2) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else structure(quantile(resid), names = nam) cat("\n", param.type, " residuals:\n", sep="") print(rq, digits = digits) } param <- slot(obj,"param.table") p <- obj@size["p"] cat("\nRegression coefficients\n") printCoefmat(param[1:p, ,drop=FALSE], digits = digits, signif.stars = getOption("show.signif.stars"), na.print = "NA") cat("\nParameters of the SEC random component\n") printCoefmat(param[(p+1):nrow(param), 1:2, drop=FALSE], digits = digits, signif.stars = FALSE, na.print = "NA") if(!is.null(obj@aux$param.cor)) { cat("\nCorrelations of parameter estimates:\n") print(obj@aux$param.cor) } if(!is.null(obj@aux$param.cov)) { cat("\nCovariances of parameter estimates:\n") print(obj@aux$param.cov) } invisible(object) } plot.mselm <- function (x, param.type="CP", which, caption, panel = if (add.smooth) panel.smooth else points, main = "", # sub.caption = NULL, ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(x@residuals.dp), cex.id = 0.75, identline = TRUE, add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) { p <- slot(x,"size")["p"] if(missing(which)) which <- if(p == 1) c(1,3,4) else 2:4 show <- rep(FALSE, 4) show[which] <- TRUE if(!show[2]) param.type <- "DP" # CP-residuals only used for show[2] lc.param.type <- tolower(param.type) param.type <- switch(lc.param.type, "dp"="DP", "op"="OP", "cp"="CP", "pseudo-cp"="pseudo-CP") if(param.type == "OP") stop("this method does not support OP option") if(missing(caption)) caption <- c("Observed values and fitted distribution", paste("Distribution of", param.type, "residual values"), "Q-Q plot of Mahalanobis distances", "P-P plot of Mahalanobis distances") all.par <- slot(x, "param") param <- all.par[[lc.param.type]] dots <- list(...) if(is.null(param)) { message(paste( "Requested param.type='", param.type, "' evaluates to NULL.", sep="")) if(param.type == "pseudo-cp" & x@family== "SN") message("Pseudo-CP makes no sense for SN family") if(param.type == "cp" & x@family== "SC") message("CP makes no sense for SC family") if(param.type == "cp" & x@family== "ST") message("CP of ST family requires nu>4") stop("Consider another choice of param.type, e.g. param.type='DP'") } r <- residuals(x, lc.param.type) r.lab <- paste(param.type, "residuals") # family <- x@family dp <- if(length(all.par$fixed) > 0) all.par$dp.complete else all.par$dp cp <- dp2cpMv(dp, family=x@family, cp.type="auto") nu. <- switch(x@family, ST = dp$nu, SN = Inf, SC=1) n <- slot(x,"size")["n.obs"] d <- x@size["d"] yh <- fitted(x, param.type) w <- weights(x) if (!is.null(w)) { wind <- w != 0 r <- r[wind] yh <- yh[wind] w <- w[wind] labels.id <- labels.id[wind] } else w <- rep(1,n) rw <- n*w/slot(x,"size")["nw.obs"] if (is.null(id.n)) id.n <- 0 else { id.n <- as.integer(id.n) if (id.n < 0 || id.n > n) stop(gettextf("'id.n' must be in {1,..,%d}", n), domain = NA) } Omega.inv <- pd.solve(dp$Omega, silent=TRUE) r.dp <- t(slot(x, "residuals.dp")) rs2 <- colSums((Omega.inv %*% r.dp) * r.dp) if (id.n > 0) { if (is.null(labels.id)) labels.id <- paste(1:n) iid <- 1:id.n show.r <- sort.list(abs(r), decreasing = TRUE)[iid] show.rs <- sort.list(rs2, decreasing = TRUE)[iid] text.id <- function(x, y, ind, adj.x = TRUE) { labpos <- if (adj.x) label.pos[1 + as.numeric(x > mean(range(x)))] else 3 text(x, y, labels.id[ind], cex = cex.id, xpd = TRUE, pos = labpos, offset = 0.25) } } else show.rs <- NULL one.fig <- prod(par("mfcol")) == 1 if (ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } if (show[1]) { # data scatter matrix and fitted curves (only if p=1) if(p == 1) { y <- (x@residuals.dp + x@fitted.values.dp) fitted.distr <- makeSECdistr(dp, family=x@family, name="fitted distribution", compNames=colnames(x@param$dp[[1]])) data.par <- list(col=dots$col, pch=dots$pch, cex=dots$cex, id.i=show.rs) plot(fitted.distr, landmarks="", data=y, main=main, data.par=data.par, ...) # previously it included cex=sqrt(rw) # text.id(..) se d=1, ma se d>1 si deve fare per ogni pannello (?!) mtext(caption[1], 3, 1.5, cex = cex.caption) } else message(paste("plot of (observed data, fitted distribution)", "makes no sense if covariates 'x' exist", "and fitted distribution varies with 'x'")) } if (show[2]) { # scatter matrix of residuals and fitted curves dp0 <- dp dp0[[1]] <- as.numeric((dp[[1]]-param[[1]])[1,]) data.par <- list(col=dots$col, pch=dots$pch, cex=dots$cex, id.i=show.rs) resid.distr <- makeSECdistr(dp0, family=x@family, name="Residual distribution", compNames=colnames(x@residuals.dp)) plot(resid.distr, landmarks="", data=residuals(x, param.type), main=main, data.par=data.par) # mtext(caption[2], 3, 0.25, cex = cex.caption) mtext(caption[2], 3, 1.5, cex = cex.caption) } if (show[3]) { # QQ-plot # ylim <- c(0, max(pretty(rs2))) q <- qf((1:n)/(n+1), d, nu.) * d plot(q, sort(rs2), xlab="theoretical values", ylab="empirical values", main=main, ...) # cex=sqrt(rw) now dropped if(identline) abline(0, 1, lty = 2, col = "gray70") # if (one.fig) title(sub = sub.caption, ...) mtext(caption[3], 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(q[n+1-iid], rs2[show.rs], show.rs) } if (show[4]) { # PP-plot p <- pf(rs2/d, d, nu.) p0 <- (1:n)/(n+1) plot(p0, sort(p), xlab="theoretical values", ylab="empirical values", xlim=c(0,1), ylim=c(0,1), main=main, ...) # cex=sqrt(rw) now dropped if(identline) abline(0, 1, lty = 2, col = "gray70") # if (one.fig) title(sub = sub.caption, ...) mtext(caption[4], 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(p[show.rs], p0[n+1-iid], show.rs) } # if (!one.fig && par("oma")[3] >= 1) # mtext(sub.caption, outer = TRUE, cex = 1.25) invisible() } print.summary.mselm <- function(object) { obj <- object digits = max(3, getOption("digits") - 3) # cat("Obj: ", deparse(substitute(obj)),"\n") cat("Call: ") print(slot(obj,"call")) n <- obj@size["n.obs"] d <- obj@size["d"] # p <- obj@size["p"] cat("Number of observations:", n, "\n") nw <- obj@size["nw.obs"] if(n != nw) cat("Weighted number of observations:", nw, "\n") family <- slot(obj, "family") cat("Family:", family, "\n") method <- slot(object, "method") u <- if(length(method)==1) NULL else paste(", penalty function:", method[2]) cat("Estimation method: ", method[1], u, "\n", sep="") fixed <- slot(obj, "param.fixed") if(length(fixed) > 0) {fixed.char <- paste(names(fixed), format(fixed), sep=" = ", collapse=", ") cat("Fixed parameters:", fixed.char, "\n") } cat("Log-likelihood:", format(slot(obj,"logL"), nsmall=2), "\n") cat("Parameter type:", obj@param.type,"\n") if(obj@boundary) cat("Estimates on/near the boundary of the parameter space\n") names <- dimnames(obj@scatter$matrix)[[1]] for(j in 1:d) { param <- obj@coef.tables[[j]] cat("\n--- Response variable No.", j, ": ", names[j],"\n",sep="") resid <- obj@resid[,j] if(n>5) { nam <- c("Min", "1Q", "Median", "3Q", "Max") rq <- if (length(dim(resid)) == 2) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else structure(quantile(resid), names = nam) cat(obj@param.type, "residuals\n") print(rq, digits = digits) } cat("\nRegression coefficients\n") printCoefmat(param[, ,drop=FALSE], digits = digits, signif.stars = getOption("show.signif.stars"), na.print = "NA") } cat("\n--- Parameters of the SEC random component\n") cat("Scatter matrix: ", obj@scatter$name,"\n", sep="") print(obj@scatter$matrix) if(length(obj@slant) > 0) { cat("\nSlant parameter: ", obj@slant$name, "\n", sep="") print(cbind(estimate=obj@slant$param, std.err=obj@slant$se)) } if(length(obj@tail) > 0) { cat("\nTail-weight parameter: ", obj@tail$name, "\n", sep="") print(c(estimate=obj@tail$param, std.err=obj@tail$se)) } if(!is.null(obj@aux$param.cor)) { cat("\nCorrelations of parameter estimates:\n") print(obj@aux$param.cor) } if(!is.null(obj@aux$param.cov)) { cat("\nVar-covariance matrix of parameter estimates:\n") print(obj@aux$param.cov) } } dp2op <- function(dp, family) { nt <- switch(tolower(family), "sn" = 3, "esn" = 4, "st" = 4, "sc" = 3, NULL) if(is.null(nt)) stop("unknown family") op <- dp if (is.list(dp)) { # multivariate case if(length(dp) != nt) stop("wrong length of 'dp'") Omega <- dp[[2]] alpha <- dp[[3]] d <- length(alpha) tmp <- delta.etc(alpha, Omega) delta <- tmp$delta Omega.cor <- tmp$Omega.cor D.delta <- sqrt(1 - delta^2) # (5.18) of SN book, but as vector lambda <- delta/D.delta # (5.20) omega <- sqrt(diag(as.matrix(Omega))) Psi <- Omega - outer(omega*delta, omega*delta) # four lines before (5.30) op[[2]] <- Psi op[[3]] <- lambda names(op)[2:3] <- c("Psi", "lambda") } else { # univariate case p <- length(dp) - nt + 1 if(p < 1) stop("wrong length of 'dp'") delta <- delta.etc(dp[p+2]) op[p+1] <- dp[p+1] * sqrt(1 - delta^2) names(op)[(p+1):(p+2)] <- c("psi", "lambda") } op } op2dp <- function(op, family) { nt <- switch(tolower(family), "sn" = 3, "esn" = 4, "st" = 4, "sc" = 3, NULL) if(is.null(nt)) stop("unknown family") dp <- op if(is.list(op)) { # multivariate case if(length(op) != nt) stop("wrong length of 'op'") Psi <- op[[2]] psi <- sqrt(diag(Psi)) lambda <- op[[3]] delta <- lambda/sqrt(1 + lambda^2) D.delta <- sqrt(1 - delta^2) Psi.bar <- cov2cor(Psi) omega <- psi/D.delta tmp <- as.vector(pd.solve(Psi.bar) %*% lambda) dp[[2]] <- Psi + outer(psi*lambda, psi*lambda) # four lines before (5.30) dp[[3]] <- (tmp/D.delta)/sqrt(1 + sum(lambda*tmp)) # (5.22) names(dp)[2:3] <- c("Omega", "alpha") } else { # univariate case p <- length(op) - nt + 1 if(p < 1) stop("wrong length of 'dp'") delta <- delta.etc(dp[p+2]) dp[p+1] <- op[p+1]/sqrt(1 - delta^2) names(dp)[(p+1):(p+2)] <- c("omega", "alpha") } dp } coef.selm <- function(object, param.type="CP", ...) { param <- slot(object,"param")[[tolower(param.type)]] if(is.null(param) & tolower(param.type)=="cp") { message("CP not defined, consider param.type='DP' or 'pseudo-CP'") return(NULL)} param} coef.mselm <- function(object, param.type="CP", vector=TRUE, ...) { list <- slot(object,"param")[[tolower(param.type)]] if(is.null(list) & tolower(param.type)=="cp") { message("CP not defined, consider param.type='DP' or 'pseudo-CP'") return(NULL)} if(!vector) return(list) as.vector(c(list[[1]], vech(list[[2]]), unlist(list[3:length(list)]))) } extractSECdistr <- function(object, name, compNames) { obj.class <- class(object) if(!(obj.class %in% c("selm", "mselm"))) stop(gettextf("wrong object class: '%s'", obj.class), domain = NA) param <- slot(object, "param") dp <- if(length(param$dp.complete) > 0) param$dp.complete else param$dp p <- slot(object, "size")[2] if(obj.class == "selm") { lead <- if(p > 1) 0 else dp[1] dp0 <- c(lead, dp[-(1:p)]) names(dp0)[1] <- "xi" } else { # class = "mselm" dp0 <- dp names(dp0)[1] <- "xi" dp0[[1]] <- if(p == 1) as.vector(dp0[[1]]) else rep(0, slot(object, "size")[1]) } if((obj.class == "mselm") & missing(compNames)) compNames <- names(dp$alpha) if(missing(name)) { name <- paste("SEC distribution of", deparse(substitute(object))) name <- if(p > 1) paste("Residual", name) else paste("Fitted", name) } if(obj.class == "selm") new("SECdistrUv", dp=dp0, family=slot(object, "family"), name=name) else new("SECdistrMv", dp=dp0, family=slot(object, "family"), name=name, compNames=compNames) } # introduce sd generic function, in the same fashion of package circular # sd <- function(x, ...) UseMethod("sd") sd.default <- function(x, na.rm = FALSE, ...) stats::sd(x=x, na.rm=na.rm) mean.SECdistrUv <- function(x) dp2cp(object=x, upto=1) mean.SECdistrMv <- function(x) dp2cp(object=x, upto=1)[[1]] sd.SECdistrUv <- function(x) dp2cp(object=x, upto=2)[2] vcov.SECdistrMv <- function(object) dp2cp(object=object, upto=2)[[2]] #--- # profile.selm <- function(fitted, param.type, param.name, param.values, npt, opt.control=list(), plot.it=TRUE, log=TRUE, level, trace=FALSE, ...) { obj <- fitted if(class(obj) != "selm") stop(gettextf("wrong object class: '%s'", class(obj)), domain = NA) param.type <- match.arg(toupper(param.type), c("DP", "CP")) family <- slot(obj, "family") obj.par <- slot(obj, "param") dp.full <- if(length(obj.par$fixed)==0) obj.par$dp else obj.par$dp.complete if(param.type == "CP") { cp.full <- mle.full <- dp2cpUv(dp.full, family) profile.comp <- match(param.name, names(cp.full)) } else { mle.full <- dp.full profile.comp <- match(param.name, names(dp.full)) } fixed.names <- setdiff(names(obj.par$dp.complete), names(obj.par$dp)) if(length(fixed.names) > 0) { fixed.comp <- match(fixed.names, names(dp.full)) fixed.values <- mle.full[fixed.comp] } else fixed.comp <- fixed.values <- NULL clash <- intersect(fixed.comp, profile.comp) if(length(clash) > 0) stop(paste("parameter component No.", clash, "is fixed in the model, it cannot be profiled")) p <- slot(obj, "size")["p"] method <- slot(obj, "method") penalty <- if(method[1] == "MPLE") method[2] else NULL constr.comp <- c(profile.comp, fixed.comp) free.comp <- setdiff(1:length(dp.full), constr.comp) if(anyNA(profile.comp)) stop("some wrong item in param.name") npc <- length(profile.comp) # number of terms in profile.comp (either 1 or 2) if(!(npc %in% (1:2))) stop("wrong length(param.name)") if(missing(npt)) npt <- rep((50+npc) %/% npc, npc) else if(length(npt) != npc) npt <- rep(npt[1], npc) log.comp <- if(!log) rep(NA, npc) else { if(param.type == "DP") match(c("omega", "nu"), param.name, NULL) else match(c("s.d.", "gamma2"), param.name, NULL) } logScale <- (1:2) %in% which(!is.na(log.comp)) m <- slot(obj, "input")$model x <- model.matrix(attr(m, "terms"), data=m) w <- slot(obj, "input")$model$"(weights)" weights <- if(is.null(w)) rep(1, nrow(x)) else w opt.control$fnscale <- (-1) par.val <- param.values if(npc == 1) { # one-parameter profile logLik par.val <- as.vector(par.val) if(any(diff(par.val) <= 0)) stop("param.values not an increasing sequence") logScale <- logScale[1] if(length(par.val) == 2) par.val <- seqLog(par.val[1], par.val[2], length=npt, logScale) n.values <- length(par.val) if(n.values>1 & (prod(range(par.val) - mle.full[profile.comp]) > 0)) stop(gettextf("param range does not bracket the MLE/MPLE point: '%s'", format(mle.full[profile.comp])), domain=NA) logL <- numeric(n.values) for(k in 1:n.values) { constr.values <- c(par.val[k], fixed.values) free.values <- mle.full[-constr.comp] opt <- optim(free.values, constrained.logLik, method="BFGS", control=opt.control, param.type=param.type, x=x, y=m[[1]], weights=weights, family=family, constr.comp=constr.comp, constr.values=constr.values, penalty=penalty, trace=trace) logL[k] <- opt$value } out <- list(call=match.call(), param=par.val, logLik=logL) names(out)[2] <- param.name if(n.values>1){ deviance <- 2*(logLik(obj) - logL) if(any(deviance + sqrt(.Machine$double.eps) < 0)) warning(paste( "A relative maximum of the (penalized) likelihood seems to have been", "taken as\n the MLE (or MPLE).", "Re-fit the model with starting values suggested by the plot.")) s <- diff((sign(diff(deviance)))) if(length(which(s != 0)) > 1) { warning(paste("The log-likelihood function appears to have multiple", "maxima.\n", "Confidence intervals may be handled improperly.\n")) # readline("Press to continue") # browser() }} if(missing(level)) level <- 0.95 level <- level[1] if(is.na(level) | level <= 0 | level >= 1) { message("illegal level value is reset to default value") level <- 0.95 } if(obj.par$boundary) { message("parameter estimates at the boundary, no confidence interval") level <- NULL } if(!is.null(level) & n.values>1) { q <- qchisq(level[1], 1) if(deviance[1] < q | deviance[n.values] < q) warning( "parameter range seems short; confidence interval may be inaccurate") dev.fn <- splinefun(par.val, deviance - q, method="monoH.FC") rootL <- try(uniroot(dev.fn, lower=min(par.val), check.conv=TRUE, upper=mle.full[profile.comp], extendInt="downX")) rootH <- try(uniroot(dev.fn, lower=mle.full[profile.comp], upper=max(par.val), check.conv=TRUE, extendInt="upX")) fail.confint <- (class(rootL)=="try-error" | class(rootH)=="try-error") out$confint <- if(fail.confint) rep(NULL,2) else c(rootL$root, rootH$root) out$level <- level } if(plot.it & n.values>1) { if(logScale) { par.val <- log(par.val) param.name <- paste("log(", param.name, ")", sep="") } plot(par.val, deviance, type="l", xlab=param.name, ylab="2*{max(logLik) - logLik}", ...) if(logScale) { rug(log(mle.full[profile.comp]), ticksize = 0.02) if(is.null(level) | fail.confint) low <- hi <- NULL else { low <- log(rootL$root) hi <- log(rootH$root) }} else { rug(mle.full[profile.comp], ticksize = 0.02) if(is.null(level)| fail.confint) low <- hi <- NULL else { low <- rootL$root hi <- rootH$root }} if(!is.null(level) & !fail.confint) { abline(h=q, lty=3, ...) lines(rep(low, 2), c(par()$usr[3], q), lty=3, ...) lines(rep(hi, 2), c(par()$usr[3], q), lty=3, ...) } } } else { # npc==2, two-parameter profile logLik if(length(par.val) != 2) stop("wrong dimension of param.values") u <- unlist(lapply(par.val, length)) param1 <- par.val[[1]] param2 <- par.val[[2]] if(all(u>1)) if(prod(range(param1) - mle.full[profile.comp][1]) > 0 | prod(range(param2) - mle.full[profile.comp][2]) > 0) stop( gettextf("parameter range does not bracket the MLE/MPLE point: '%s'", paste(format(mle.full[profile.comp]), collapse=",")), domain=NA) if(u[1] > 2) npt[1] <- u[1] else if(u[1] == 2) param1 <- seqLog(param1[1], param1[2], length=npt[1], logScale[1]) if(u[2] > 2) npt[2] <- u[2] else if(u[2] == 2) param2 <- seqLog(param2[1], param2[2], length=npt[2], logScale[2]) n.values <- c(length(param1), length(param2)) logL <- matrix(NA, n.values[1], n.values[2]) if(any(diff(param1) <= 0)) stop("param.values[[1]] not an increasing sequence") if(any(diff(param2) <= 0)) stop("param.values[[2]] not an increasing sequence") for(k1 in 1:n.values[1]) for(k2 in 1:n.values[2]){ constr.values <- c(param1[k1], param2[k2], fixed.values) free.values <- mle.full[-constr.comp] opt <- optim(free.values, constrained.logLik, method="BFGS", control=opt.control, param.type=param.type, x=x, y=m[[1]], weights=weights, family=family, constr.comp=constr.comp, constr.values=constr.values, penalty=penalty, trace=trace) logL[k1,k2] <- opt$value } out <- list(call=match.call(), param1=param1, param2=param2, logLik=logL) names(out)[2:3] <- param.name if(missing(level)) level <- c(0.25, 0.5, 0.75, 0.9, 0.95, 0.99) if(anyNA(level) | any(level<=0) | any(level>=1)) { message("illegal level values; vector 'level' reset to default value") level <- c(0.25, 0.5, 0.75, 0.9, 0.95, 0.99) } if(obj.par$boundary) { message("parameter estimates at the boundary, no confidence regions") level <- NULL } q <- if(is.null(level)) c(1, 2, 5, 8, 15) else qchisq(level, 2) deviance <- 2*(logLik(obj)-logL) if(any(deviance + sqrt(.Machine$double.eps) < 0)) warning(paste( "A relative maximum of the (penalized) likelihood seems to have taken", "as\n the MLE (or MPLE).", "Re-fit the model with starting values suggested by the plot.")) if(all(n.values>1)) { cL <- contourLines(param1, param2, deviance, levels=q) out$deviance.contour <- cL if(!is.null(level)) for(j in 1:length(cL)) { k <- which(q == cL[[j]]$level) out$deviance.contour[[j]]$prob <- level[k] }} if(plot.it & all(n.values>1)) { if(logScale[1]) { param1 <- log(param1) param.name[1] <- paste("log(", param.name[1], ")", sep="") } if(logScale[2]) { param2 <- log(param2) param.name[2] <- paste("log(", param.name[2], ")", sep="") } contour(param1, param2, deviance, levels=q, labels=level, xlab=param.name[1], ylab=param.name[2], ...) mark <- mle.full[profile.comp] mark[logScale] <- log(mark[logScale]) points(mark[1], mark[2], ...) } } invisible(out) } constrained.logLik <- function(free.param, param.type, x, y, weights, family, constr.comp=NA, constr.values=NA, penalty=NULL, trace=FALSE) { if(trace) cat("constrained.logLik, free.param:", format(free.param)) n <- sum(weights) p <- ncol(x) param <- numeric(length(free.param) + length(constr.values)) param[constr.comp] <- constr.values param[-constr.comp] <- free.param par0 <- c(0, param[-(1:p)]) # if(par0[2] <= 0) return(-Inf) # if(family=="ST" & par0[4] <= 0) return(-Inf) # if(family=="ST" & par0[4] > 1e4) par0[4] <- Inf dp0 <- if(param.type =="DP") par0 else cp2dpUv(par0, family, tol=1e-7, silent=TRUE) if(anyNA(dp0)) { if(is.null(dp0)) {message("null dp0"); browser()} excess <- attr(dp0, "excess") if(length(excess) == 0) {message("0-length excess"); browser() } if(is.null(excess) | is.na(excess) | abs(excess)==Inf ) excess <- (.Machine$double.xmax)^(1/3) # {message("bad excess"); browser()} return(-1e9 * (1+ excess)^2) } d.fn <- get(paste("d", tolower(family), sep=""), inherits = TRUE) logL <- try(d.fn((y - x %*% param[1:p]), dp=dp0, log=TRUE)) if(class(logL) == "try-error") browser() Q <- if(is.null(penalty)) 0 else { penalty.fn <- get(penalty, inherits = TRUE) nu <- if(family=="ST") par0[4] else NULL penalty.fn(dp0[3], nu) } out <- if(anyNA(logL)) -Inf else sum(logL * weights) - Q if(trace) cat(", logL:", format(out), "\n") return(out) } seqLog <- function(from, to, length, logScale=FALSE) { if(logScale & any(c(from, to) <= 0)) stop("logScale requires positive arguments 'from' and 'to'") if(logScale) exp(seq(log(from), log(to), length.out=length)) else seq(from, to, length.out=length) } predict.selm <- function(object, newdata, param.type = "CP", interval = "none", level = 0.95, na.action = na.pass, ...) { model <- slot(object, "input")$model interval <- match.arg(interval, c("none", "confidence", "prediction")) tt <- terms(model) if (missing(newdata) || is.null(newdata)) { response <- attr(attr(model, "terms"), "response") intercept <- attr(attr(model, "terms"), "intercept") mm <- X <- cbind(intercept, data.matrix(model)[, -response]) mmDone <- TRUE offset <- model$offset } else { Terms <- delete.response(tt) m <- model.frame(Terms, newdata, na.action = na.action, xlev = model$xlevels) X <- model.matrix(Terms, m, contrasts.arg = model$contrasts) offset <- rep(0, nrow(X)) if (!is.null(off.num <- attr(tt, "offset"))) for (i in off.num) offset <- offset + eval(attr(tt, "variables")[[i + 1]], newdata) if (!is.null(model$offset)) offset <- offset + eval(mode$offset, newdata) mmDone <- FALSE } size <- slot(object, "size") n <- size["n.obs"] nw <- size["nw.obs"] p <- size["p"] one..p <- seq_len(p) beta <- coef(object, param.type=param.type)[one..p] out <- predictor <- drop(X[, one..p, drop = FALSE] %*% beta) if(!is.null(offset)) predictor <- predictor + offset family <- slot(object, "family") V <- vcov(object, param.type=param.type)[one..p,one..p] var.conf <- rowSums((X %*% V) * X) if(family == "SN" & param.type=="DP") { alpha.interv <- confint(object, "alpha", param.type="DP") if(prod(alpha.interv) <=- 0) var.conf <- rep(NA, nrow(X)) } if(interval == "confidence") { hwid <- qnorm((1 - level)/2) * sqrt(var.conf) lwr <- predictor + hwid upr <- predictor - hwid out <- cbind(predictor, lwr, upr) colnames(out) <- c("fit", "lwr", "upr") } if(interval == "prediction") { if(missing(newdata)) warning("predictions on current data refer to _future_ responses\n") probs <- c((1-level)/2, (1+level)/2) npt <- nrow(X) lwr <- upr <- rep(NA, npt) if(family == "SN") { # convolve SN+Normal betaCP <- coef(object, param.type="CP")[one..p] predictorCP <- drop(X[, one..p, drop = FALSE] %*% betaCP) if(!is.null(offset)) predictorCP <- predictorCP + offset Vcp <- vcov(object, param.type="CP")[one..p,one..p] var.pred <- rowSums((X %*% Vcp) * X) omega <- coef(object, param.type="DP")[p+1] alpha <- coef(object, param.type="DP")[p+2] mu.eps <- as.numeric(omega*sqrt(2/pi)*alpha/sqrt(1+alpha^2)) alpha.tilde <- alpha/sqrt(1+(1+alpha^2)*var.pred/omega^2) for(j in 1:npt) { q <- if(is.na(var.pred[j])) rep(NA,2) else qsn(probs, -mu.eps, sqrt(var.pred[j]+omega^2), alpha.tilde[j]) lwr[j] <- predictorCP[j] + q[1] upr[j] <- predictorCP[j] + q[2] } } if(family %in% c("ST", "SC")) { # approximate ST+normal convolution dp <- coef(object, param.type="DP") betaDP <- dp[one..p] nu <- if(family =="ST") dp[length(dp)] else 1 predictorDP <- drop(X[, one..p, drop = FALSE] %*% betaDP) if(!is.null(offset)) predictorDP <- predictorDP + offset Vdp <- vcov(object, param.type="DP")[one..p,one..p] var.pred <- rowSums((X %*% Vdp) * X) cp.type <- if(nu>4) "proper" else "pseudo" cp <- st.dp2cp(dp, cp.type=cp.type) for(j in 1:npt) { if(!is.na(var.pred[j])) { r <- sqrt(cp[p+1]^2/(cp[p+1]^2 +var.pred[j])) cp.pred <- c(cp[one..p], cp[p+1]/r, cp[p+2]*r^3, cp[p+3]*r^4) dp.pred <- st.cp2dp(cp.pred, cp.type, silent=TRUE, tol=1e-4, start=dp) dp.pred <- c(0, dp.pred[-one..p]) q <- if(!anyNA(dp.pred)) qst(probs, dp=dp.pred) else rep(NA,2) } else q <- rep(NA,2) lwr[j] <- predictorDP[j] + q[1] upr[j] <- predictorDP[j] + q[2] } } out <- cbind(predictor, lwr, upr) colnames(out) <- c("fit", "lwr", "upr") } out } confint.selm <- function(object, parm, level=0.95, param.type, tol=1e-3, ...) { family <- slot(object, "family") object.name <- as.character(deparse(substitute(object))) if(missing(param.type)) { if(family=="ST") ptype <- if(slot(object,"param")$dp["nu"]>4) "CP" else "pseudo-CP" param.type <- switch(family, "SN" = "CP", "ST"=ptype, "SC"="pseudo-CP") } param <- coef(object, param.type) npar <- length(param) pnames <- names(param) if(missing(parm)) {par.comp <- (1:npar); parm <- pnames} else {if(is.numeric(parm)) {par.comp <- parm; parm <- pnames[parm]} else par.comp <- match(parm, pnames)} if(slot(object, "param")$boundary) stop("parameter estimates on the boundary of the parameter space") namesCP <- c("(Intercept.CP)", "s.d.", "gamma1", "gamma2") namesDP <- c("(Intercept.DP)", "omega", "alpha", "nu") if(param.type=="DP" & length(intersect(parm, namesCP))>0 ) stop("incompatible 'parm' and 'param.type'") if(param.type=="CP" & length(intersect(parm, namesDP))>0 ) stop("incompatible 'parm' and 'param.type'") if(family=="SN" & param.type=="pseudo-CP") stop("'param.type' incompatible with 'SN' family object") lev2 <- (1 - level)/2 lev2 <- c(lev2, 1 - lev2) intervals <- matrix(0, length(parm), 2, dimnames=list(parm, paste(as.character(lev2*100), "%", sep=""))) max.logL <- slot(object, "logL") if(family=="SN") { slant <- intersect(c("alpha", "gamma1"), parm) check.alpha <- (length(slant) > 0 | param.type=="DP" & (1 %in% par.comp)) if(check.alpha) { alpha.interv <- slot(object, "param")$alpha.interv if(is.null(alpha.interv) | length(which(alpha.interv[,1]==level))==0) { q <- qchisq(level, 1) alpha.mle <- alpha.sx <- alpha.dx <- coef(object, "DP")["alpha"] fn.alpha <- function(alpha) (max.logL - q/2 - profile.selm(object, "DP", "alpha", alpha, plot.it=FALSE)$logL) step <- 1 repeat { alpha.sx <- alpha.sx - step if(fn.alpha(alpha.sx) > 0) break step <- 2*step } alpha.sx <- uniroot(fn.alpha, c(alpha.sx, alpha.mle), tol=tol)$root step <- 1 repeat { alpha.dx <- alpha.dx + step if(fn.alpha(alpha.dx) > 0) break step <- 2*step } alpha.dx <- uniroot(fn.alpha, c(alpha.mle, alpha.dx), tol=tol)$root alpha.interv <- rbind(alpha.interv, c(level, alpha.sx, alpha.dx)) slot(object, "param")$alpha.interv <- alpha.interv # assign(object.name, object, pos=".GlobalEnv") } else { k <- min(which(alpha.interv[,1] == level)) alpha.sx <- alpha.interv[k,2] alpha.dx <- alpha.interv[k,3] } gamma1.sx <- dp2cpUv(c(0, 1, alpha.sx), "SN")[3] gamma1.dx <- dp2cpUv(c(0, 1, alpha.dx), "SN")[3] intervals[slant,] <- if(param.type == "DP") c(alpha.sx, alpha.dx) else c(gamma1.sx, gamma1.dx) } e <- rep(1, npar) e[npar-1] <- 1/param[npar-1] v <- diag(e) %*% vcov(object, param.type) %*% diag(e) drop.last <- 1:(npar-1) se <- sqrt(diag(v))[drop.last] if(param.type=="DP" & (prod(intervals[slant,]) < 0)) se[1]<- NA par0 <- param[drop.last] par0[npar-1] <- log(par0[npar-1]) interv <- par0 + outer(se[drop.last], qnorm(lev2)) interv[npar-1,] <- exp(interv[npar-1,]) if(length(slant) == 0) intervals[1:length(parm),] <- interv[par.comp,] else if(length(par.comp) > 1) intervals[1:(length(parm)-1),] <- interv[par.comp[-length(par.comp)],] } if(family %in% c("ST", "SC")) { par0 <- param par0[npar - c(0,2)] <- log(par0[npar - c(0,2)]) # log scale & tailweight e <- rep(1, npar) e[npar-c(0,2)] <- 1/param[npar-c(0,2)] v <- diag(e) %*% vcov(object, param.type) %*% diag(e) se <- sqrt(diag(v)) interv <- par0 + outer(se, qnorm(lev2)) interv[npar-c(0,2),] <- exp(interv[npar-c(0,2),]) intervals[,] <- interv[par.comp,] } intervals[,,drop=FALSE] } #-------------------- # Feb.2017 # dSymmModulated <- function(x, xi=0, omega=1, f0, G0, w, par.f0, par.G0, odd="check", log=FALSE, ...) {# density of univariate modulated-symmetry distributions, Feb.2017 dsbeta <- function(x, shape, log) { u <- dbeta((x+1)/2, shape, shape, log=log) if(log) u-logb(2) else u/2 } psbeta <- function(x, shape, log.p) pbeta((x+1)/2, shape, shape, log.p=log.p) dsunif <- function(x, log) dunif(x, -1, 1, log=log) psunif <- function(x, log.p) punif(x, -1, 1, log.p=log.p) if(omega <= 0) stop("omega must be positive") z <- as.numeric((x-xi)/omega) f0 <- switch(f0, "norm"="normal", "logis"="logistic", f0) pdf <- switch(f0, beta=dsbeta(z, par.f0, log=log), cauchy=dcauchy(z, log=log), logistic=dlogis(z, log=log), normal=dnorm(z, log=log), t=dt(z, par.f0, log=log), uniform=dsunif(z, log=log), NULL) if(is.null(pdf)) stop("unsupported 'f0' density") odd <- match.arg(odd, c("check", "assume", "force")) w.z <- w(z, ...) if(odd == "check") { if(!isTRUE(all.equal(-w.z, w(-z, ...))) || w(0,...) != 0) stop("function 'w' is not odd") } if(odd == "force") { w.z[z < 0] <- -w(-z[z<0], ...) w.z[z == 0] <- 0 } G0 <- switch(G0, "norm"="normal", "logis"="logistic", G0) cdf <- switch(G0, beta=psbeta(w.z, par.G0, log.p=log), cauchy=pcauchy(w.z, log.p=log), logistic=plogis(w.z, log.p=log), normal=pnorm(w.z, log.p=log), t=pt(w.z, par.G0, log.p=log), uniform=psunif(w.z, log.p=log), NULL) if(is.null(cdf)) stop("unsupported 'G0' distribution") if(log) (pdf + cdf + logb(2/omega)) else (2 * pdf * cdf/omega) } #---- rSymmModulated <- function(n=1, xi=0, omega=1, f0, G0, w, par.f0, par.G0, odd="check", ...) {# random numbers from modulated-symmetry distributions, use (1.11a) of SN book rsbeta <- function(n=1, shape) rbeta(n, shape, shape)*2 + 1 rsunif <- function(n=1) runif(n, -1, 1) if(omega < 0) stop("omega must be non-negative") f0 <- switch(f0, "norm"="normal", "logis"="logistic", f0) Z0 <- switch(f0, beta=rsbeta(n, par.f0), cauchy=rcauchy(n), logistic=rlogis(n), normal=rnorm(n), t=rt(n, par.f0), uniform=rsunif(n), NULL) if(is.null(Z0)) stop("unsupported 'f0' density") odd <- match.arg(odd, c("check", "assume", "force")) w.Z0 <- w(Z0, ...) if(odd == "check") { if(!isTRUE(all.equal(-w.Z0, w(-Z0, ...))) || w(0,...) != 0) stop("function 'w' is not odd") } if(odd == "force") { w.Z0 <- ifelse(Z0>0, w(Z0, ...), -w(-Z0, ...)) w.Z0[Z0 == 0] <- 0 } G0 <- switch(G0, "norm"="normal", "logis"="logistic", G0) T <- switch(G0, beta=rsbeta(n, par.G0), cauchy=rcauchy(n), logistic=rlogis(n), normal=rnorm(n), t=rt(n, par.G0), uniform=rsunif(n), NULL) if(is.null(T)) stop("unsupported 'G0' distribution") as.numeric(xi + omega*Z0*sign(w.Z0-T)) } # dmSymmModulated <- function(x, xi, Omega, f0, G0, w, par.f0, par.G0, odd="check", log=FALSE, ...) {# density of multivariate modulated-symmetry distributions, Feb.2017 psbeta <- function(x, shape) pbeta((x+1)/2, shape, shape) psunif <- function(x) punif(x, -1, 1) if(!is.matrix(Omega)) stop("Omega must be a matrix") d <- ncol(Omega) x <- matrix(as.vector(x), ncol=d) zero <- rep(0, d) omega <- sqrt(diag(Omega)) Omega <- cov2cor(Omega) z <- (x - outer(rep(1,nrow(x)), xi)) %*% diag(1/omega, d, d) f0 <- switch(f0, "norm"="normal", f0) pdf <- switch(f0, cauchy=mnormt::dmt(z, zero, Omega, 1, log=log), normal=mnormt::dmnorm(z, zero, Omega, log=log), t=mnormt::dmt(z, zero, Omega, par.f0, log=log), NULL) if(is.null(pdf)) stop("unsupported 'f0' density") odd <- match.arg(odd, c("check", "assume", "force")) w.z <- w(z, ...) if(odd == "check") { if(!isTRUE(all.equal(-w.z, w(-z, ...))) || w(matrix(zero, 1, d), ...) != 0) stop("function 'w' is not odd") } if(odd == "force") { neg <- (z[,1] < 0) w.z[neg] <- -w(-z[neg,], ...) i0 <- apply(z, 1, all.equal, current=zero, check.attr=FALSE) == "TRUE" w.z[i0] <- 0 } G0 <- switch(G0, "norm"="normal", "logis"="logistic", G0) cdf <- switch(G0, beta=psbeta(w.z, par.G0, log.p=log), cauchy=pcauchy(w.z, log.p=log), logistic=plogis(w.z, log.p=log), normal=pnorm(w.z, log.p=log), t=pt(w.z, par.G0, log.p=log), uniform=psunif(w.z, log.p=log), NULL) if(is.null(cdf)) stop("unsupported 'G0' distribution") logDet <- sum(log(omega)) if(log) as.vector(pdf + cdf + logb(2) - logDet) else as.vector(2 * pdf * cdf)/exp(logDet) } #---- rmSymmModulated <- function(n=1, xi, Omega, f0, G0, w, par.f0, par.G0, odd="check", ...) {# random numbers from modulated-symmetry distributions, use (1.11a) of SN book rsbeta <- function(n=1, shape) rbeta(n, shape, shape)*2 + 1 rsunif <- function(n=1) runif(n, -1, 1) if(!is.matrix(Omega)) stop("Omega must be a matrix") d <- ncol(Omega) zero <- rep(0, d) omega <- sqrt(diag(Omega)) Omega <- cov2cor(Omega) f0 <- switch(f0, "norm"="normal", f0) Z0 <- switch(f0, cauchy=mnormt::rmt(n, zero, Omega, 1), normal=mnormt::rmnorm(n, zero, Omega), t=mnormt::rmt(n, zero, Omega, par.f0), NULL) if(is.null(Z0)) stop("unsupported 'f0' density") odd <- match.arg(odd, c("check", "assume", "force")) w.Z0 <- w(Z0, ...) if(odd == "check") { if(!isTRUE(all.equal(-w.Z0, w(-Z0, ...))) || w(matrix(zero,1,d) ,...) != 0) stop("function 'w' is not odd")} if(odd == "force") { neg <- (Z0[,1] < 0) w.Z0[neg] <- -w(-Z0[neg,], ...) i0 <- apply(Z0, 1, all.equal, current=zero, check.attr=FALSE) == "TRUE" w.Z0[i0] <- 0 } G0 <- switch(G0, "norm"="normal", "logis"="logistic", G0) T <- switch(G0, beta=rsbeta(n, par.G0), cauchy=rcauchy(n), logistic=rlogis(n), normal=rnorm(n), t=rt(n, par.G0), uniform=rsunif(n), NULL) if(is.null(T)) stop("unsupported 'G0' distribution") drop(outer(rep(1,n), xi) + drop(sign(w.Z0-T)) * Z0 %*% diag(omega)) } plot2D.SymmModulated <- function(range, npt=rep(101,2), xi=c(0,0), Omega, f0, G0, w, par.f0, par.G0, odd="check", ...) { if(ncol(Omega)!=2 || nrow(Omega) != 2 || length(xi) !=2) stop("Wrong dimension(s) of xi and/or Omega") n1 <- npt[1] n2 <- npt[2] x1 <- seq(min(range[,1]), max(range[,1]), length=n1) x2 <- seq(min(range[,2]), max(range[,2]), length=n2) x1.x2 <- cbind(rep(x1, n2), as.vector(matrix(x2, n1, n2, byrow=TRUE))) X <- matrix(x1.x2, n1 * n2, 2, byrow = FALSE) dots <- list(...) nw <- names(formals(w))[-1] if(missing(par.f0)) par.f0 <- NULL if(missing(par.G0)) par.G0 <- NULL pdf <- do.call(dmSymmModulated, c(list(x=X, xi=xi, Omega=Omega, f0=f0, G0=G0, w=w, par.f0=par.f0, par.G0=par.G0, odd=odd, log=FALSE), dots[nw])) pdf <- matrix(pdf, n1, n2) dots[nw] <- NULL do.call(contour, c(list(x=x1, y=x2, z=pdf), dots)) invisible(list(x=x1, y=x2, pdf=pdf)) } sn/R/sn_S4.R0000644000176200001440000003550712733426536012231 0ustar liggesusers# file sn/R/sn_S4.R (S4 methods and classes) # This file is a component of the package 'sn' for R # copyright (C) 1997-2014 Adelchi Azzalini # # 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 or 3 of the License # (at your option). # # 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. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ #--------- setClass("SECdistrUv", representation(family="character", dp="numeric", name="character"), validity=function(object){ if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) np <- 3 + as.numeric(object@family %in% c("ST","ESN")) if(length(object@dp) != np) return(FALSE) if(object@dp[2] <= 0) return(FALSE) TRUE } ) setClass("summary.SECdistrUv", representation(family="character", dp="numeric", name="character", cp="numeric", cp.type="character", aux="list"), validity=function(object){ if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) np <- 3 + as.numeric(object@family %in% c("ST","ESN")) if(length(object@dp) != np) return(FALSE) if(object@dp[2] <= 0) return(FALSE) # if(length(object@op) != length(object@dp)) return(FALSE) if(length(object@cp) != length(object@dp)) return(FALSE) TRUE } ) setClass("SECdistrMv", representation(family="character", dp="list", name="character", compNames="character"), validity=function(object){ if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) np <- 3 + as.numeric(object@family %in% c("ST","ESN")) dp <- object@dp if(mode(unlist(dp)) != "numeric") return(FALSE) if(length(dp) != np) return(FALSE) d <- length(dp[[3]]) Omega <- dp[[2]] if(length(dp[[1]]) != d | any(dim(Omega) != c(d,d))) return(FALSE) if(any(Omega != t(Omega))) {message("non-symmetric Omega"); return(FALSE)} if(any(eigen(Omega, symmetric=TRUE, only.values=TRUE)$values <= 0)) { message("Omega not positive-definite") return(FALSE)} if(object@family == "ST") { if(dp[[4]] <= 0) return(FALSE) } if(length(object@compNames) != d) return(FALSE) if(length(object@name) != 1) return(FALSE) TRUE } ) setClass("summary.SECdistrMv", representation(family="character", dp="list", name="character", compNames="character", # op="list", cp="list", cp.type="character", aux="list"), validity=function(object){ family <- object@family if(!(family %in% c("SN","ST","SC","ESN"))) return(FALSE) np <- 3 + as.numeric(family %in% c("ST","ESN")) dp <- object@dp if(mode(unlist(dp)) != "numeric") return(FALSE) if(length(dp) != np) return(FALSE) d <- length(dp[[3]]) if(length(dp[[1]]) != d | any(dim(dp[[2]]) != c(d,d))) return(FALSE) if(family == "ST") { if(dp[[4]] <= 0) return(FALSE) } if(length(object@compNames) != d) return(FALSE) if(length(object@name) != 1) return(FALSE) if(length(object@cp) != length(object@dp)) return(FALSE) # if(length(object@op) != length(object@dp)) return(FALSE) TRUE } ) setMethod("show", "SECdistrUv", function(object){ if(object@name != "") cat("Probability distribution of variable '", object@name, "'\n", sep="") cat("Skew-elliptically contoured distribution of univariate family", object@family,"\nDirect parameters:\n") print(object@dp) } ) setMethod("show","SECdistrMv", function(object){ if(object@name != "") cat("Probability distribution of variable '", object@name, "'\n", sep="") dp <- object@dp attr(dp[[2]],"dimnames") <- list(paste("Omega[", object@compNames, ",]", sep=""), NULL) cat("Skew-elliptically contoured distribution of ", length(dp[[3]]), "-dimensional family ", object@family,"\nDirect parameters:\n", sep="") out <- rbind(xi=dp[[1]], Omega=dp[[2]], alpha=dp[[3]]) colnames(out) <- object@compNames print(out) if(object@family=="ST") cat("nu", "=", dp[[4]], "\n") if(object@family=="ESN") cat("tau", "=", dp[[4]], "\n") } ) # #-------------------- setMethod("show", "summary.SECdistrUv", function(object){ obj <- object if(obj@name != "") cat("Probability distribution of variable '", obj@name, "'\n", sep="") cat("\nSkew-elliptical distribution of univariate family", obj@family,"\n") cat("\nDirect parameters (DP):\n") print(c("", format(obj@dp)), quote=FALSE) # cat("\nOriginal parameters (OP):\n") # print(c("", format(obj@op)), quote=FALSE) cp <- obj@cp note <- if(obj@cp.type == "proper") NULL else ", type=pseudo-CP" cat(paste("\nCentred parameters (CP)", note, ":\n", sep="")) print(c("", format(cp)), quote=FALSE) cat("\nAuxiliary quantities:\n") print(c("", format(c(delta=obj@aux$delta, mode=obj@aux$mode))), quote=FALSE) cat("\nQuantiles:\n") q <- obj@aux$quantiles q0 <- c("q", format(q)) names(q0) <- c("p", names(q)) print(q0, quote=FALSE) measures <- rbind(obj@aux$std.cum, obj@aux$q.measures) cat("\nMeasures of skewness and kurtosis:\n ") attr(measures, "dimnames") <- list( c(" std cumulants", " quantile-based"), c("skewness", "kurtosis")) print(measures) } ) setMethod("show","summary.SECdistrMv", function(object){ obj <- object #------ DP dp <- obj@dp if(obj@name != "") cat("Probability distribution of",obj@name,"\n") cat("Skew-elliptically contoured distribution of ", length(dp[[3]]), "-dimensional family ", obj@family,"\n", sep="") cat("\nDirect parameters (DP):\n") attr(dp[[2]], "dimnames") <- list(paste(" Omega[", obj@compNames, ",]", sep=""),NULL) out.dp <- rbind(" xi"=dp[[1]], omega=dp[[2]]," alpha"=dp[[3]]) colnames(out.dp) <- obj@compNames print(out.dp) if(length(dp) > 3){ extra <- unlist(dp[-(1:3)]) names(extra) <- paste(" ",names(dp[-(1:3)]), sep="") # print(extra) for(j in 1:length(extra)) cat(names(extra)[j], "=", extra[j], "\n") } #------ OP if(FALSE) { op <- obj@op cat("\nOriginal parameters (OP):\n") attr(op[[2]], "dimnames") <- list(paste(" Psi[", obj@compNames, ",]", sep=""),NULL) out.op <- rbind(" xi"=op[[1]], " psi"=op[[2]]," lambda"=op[[3]]) colnames(out.op) <- obj@compNames print(out.op) if(length(op) > 3){ extra <- unlist(op[-(1:3)]) names(extra) <- paste(" ",names(op[-(1:3)]), sep="") # print(extra) for(j in 1:length(extra)) cat(names(extra)[j], "=", extra[j], "\n") } } #------ CP cp <- obj@cp note <- if(obj@cp.type == "proper") NULL else ", type=pseudo-CP" cat("\nCentred parameters (CP)", note, ":\n", sep="") attr(cp[[2]], "dimnames") <- list(paste(" var.cov[", obj@compNames, ",]", sep=""),NULL) out.cp <- rbind(" mean"=cp[[1]], cp[[2]], " gamma1"=cp[[3]]) colnames(out.cp) <- obj@compNames print(out.cp) if(length(cp) > 3) { extra <- unlist(cp[-(1:3)]) names(extra) <- paste(" ", names(cp[-(1:3)]), sep="") for(j in 1:length(extra)) cat(names(extra)[j], "=", extra[j], "\n") } aux <- obj@aux out.aux <- rbind(" delta" = aux$delta, " mode" = aux$mode) #" lambda"=aux$lambda, colnames(out.aux) <- obj@compNames cat("\nAuxiliary quantities:\n") print(out.aux) cat("\nGlobal quantities:\n") cat(" alpha* =", format(aux$alpha.star), ", delta* =", format(aux$delta.star), "\n") mardia <- obj@aux$mardia cat(" Mardia's measures: gamma1M = ", format(mardia[1]), ", gamma2M = ", format(mardia[2]),"\n", sep="") invisible() } ) setClass("selm", representation(call="call", family="character", logL="numeric", method="character", param="list", param.var="list", size="vector", fixed.param="vector", residuals.dp="numeric", fitted.values.dp="numeric", control="list", input="list", opt.method="list"), validity=function(object){ if(class(object) != "selm") return(FALSE) if(!is.numeric(object@logL)) return(FALSE) if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) if(!is.vector(object@param$dp)) return(FALSE) TRUE } ) setMethod("coef", "selm", coef.selm) setMethod("logLik", "selm", function(object){ logL <- slot(object,"logL") attr(logL, "df") <- as.numeric(slot(object, "size")["n.param"]) class(logL) <- "logLik" return(logL) } ) setMethod("vcov", "selm", function(object, param.type="CP") { vcov <- slot(object, "param.var")[[tolower(param.type)]] if(is.null(vcov) & tolower(param.type) == "cp") { message("CP not defined, consider param.type='DP' or 'pseudo-CP'") return(NULL)} vcov} ) setMethod("show", "selm", function(object){ # cat("Object: ", deparse(substitute(obj)),"\n") cat("Object class:", class(object), "\n") cat("Call: ") print(object@call) cat("Number of observations:", object@size["n.obs"], "\n") if(!is.null(slot(object,"input")$weights)) cat("Weighted number of observations:", object@size["nw.obs"], "\n") cat("Number of covariates:", object@size["p"], "(includes constant term)\n") cat("Number of parameters:", object@size["n.param"], "\n") cat("Family:", slot(object,"family"),"\n") fixed <- slot(object, "param")$fixed if(length(fixed) > 0) { fixed.char <- paste(names(fixed), format(fixed), sep=" = ", collapse=", ") cat("Fixed parameters:", fixed.char, "\n") } method <- slot(object, "method") u <- if(length(method)==1) NULL else paste(", penalty function:", method[2]) cat("Estimation method: ", method[1], u, "\n", sep="") logL.name <- paste(if(method[1]=="MLE") "Log" else "Penalized log", "likelihood:", sep="-") cat(logL.name, format(object@logL, nsmall=2),"\n") if(object@param$boundary) cat("Estimates on/near the boundary of the parameter space\n") invisible(object) } ) #---------------------------------------------------------- setClass("summary.selm", representation(call="call", family="character", logL="numeric", method="character", param.type="character", param.table="matrix", param.fixed="list", resid="numeric", control="list", aux="list", size="vector", boundary="logical", note="character"), validity=function(object){ if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) TRUE } ) #---------------------------------------------------------- setClass("mselm", representation(call="call", family="character", logL="numeric", method="character", param="list", param.var="list", size="vector", residuals.dp="matrix", fitted.values.dp="matrix", control="list", input="list", opt.method="list"), validity=function(object){ if(class(object) != "mselm") return(FALSE) if(!is.numeric(object@logL)) return(FALSE) if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) if(!is.list(object@param$dp)) return(FALSE) TRUE } ) setMethod("coef", "mselm", coef.mselm) setMethod("logLik", "mselm", function(object){ logL <- slot(object,"logL") attr(logL, "df") <- as.numeric(slot(object, "size")["n.param"]) class(logL) <- "logLik" return(logL) } ) setMethod("vcov", "mselm", function(object, param.type="CP") { vcov <- slot(object,"param.var")[[tolower(param.type)]] if(is.null(vcov) & tolower(param.type) == "cp") { message("CP not defined, consider param.type='DP' or 'pseudo-CP'") return(NULL)} vcov} ) setMethod("show", "mselm", function(object){ cat("Object class:", class(object), "\n") cat("Call: ") print(object@call) cat("Number of observations:", object@size["n.obs"], "\n") if(!is.null(slot(object,"input")$weights)) cat("Weighted number of observations:", object@size["nw.obs"], "\n") cat("Dimension of the response:", object@size["d"], "\n") cat("Number of covariates:", object@size["p"], "(includes constant term)\n") cat("Number of parameters:", object@size["n.param"], "\n") cat("Family:", slot(object, "family"),"\n") fixed <- slot(object,"param")$fixed if(length(fixed) > 0) { fixed.char <- paste(names(fixed), format(fixed), sep=" = ", collapse=", ") cat("Fixed parameters:", fixed.char, "\n") } method <- slot(object, "method") u <- if(length(method) == 1) NULL else paste(", penalty function:", method[2]) cat("Estimation method: ", method[1], u, "\n", sep="") logL.name <- paste(if(method[1]=="MLE") "Log" else "Penalized log", "likelihood:", sep="-") cat(logL.name, format(object@logL, nsmall=2),"\n") if(object@param$boundary) cat("Estimates on/near the boundary of the parameter space\n") invisible(object) } ) #---------------------------------- setClass("summary.mselm", representation(call="call", family="character", logL="numeric", method="character", param.type="character", param.fixed="list", resid="matrix", coef.tables="list", scatter="list", slant="list", tail="list", control="list", aux="list", size="vector", boundary="logical"), validity=function(object) { if(!(object@family %in% c("SN","ST","SC","ESN"))) return(FALSE) TRUE } ) setMethod("mean", signature(x="SECdistrUv"), mean.SECdistrUv) setMethod("mean", signature(x="SECdistrMv"), mean.SECdistrMv) setMethod("sd", signature(x="SECdistrUv"), sd.SECdistrUv) setMethod("vcov", signature(object="SECdistrMv"), vcov.SECdistrMv) setMethod("plot", signature(x="SECdistrUv", y="missing"), plot.SECdistrUv) setMethod("plot", signature(x="SECdistrMv", y="missing"), plot.SECdistrMv) setMethod("plot", signature(x="selm"), plot.selm) # y="missing" not required? setMethod("plot", signature(x="mselm"), plot.mselm) setMethod("show", signature(object="summary.selm"), print.summary.selm) setMethod("show", signature(object="summary.mselm"), print.summary.mselm) setMethod("summary", signature(object="SECdistrUv"), summary.SECdistrUv) setMethod("summary", signature(object="SECdistrMv"), summary.SECdistrMv) setMethod("summary", signature(object="selm"), summary.selm) setMethod("summary", signature(object="mselm"), summary.mselm) setMethod("fitted", signature(object="selm"), fitted.selm) setMethod("fitted", signature(object="mselm"), fitted.mselm) setMethod("residuals", signature(object="selm"), residuals.selm) setMethod("residuals", signature(object="mselm"), residuals.mselm) # setMethod("profile", signature(object="selm"), profile.selm) setMethod("confint", signature(object="selm"), confint.selm) setMethod("predict", signature(object="selm"), predict.selm) sn/R/zzz.R0000644000176200001440000000071512550703637012066 0ustar liggesusers.onAttach <- function(library, pkg) { # require("stats4") # require("methods") # require("mnormt") # require("numDeriv") if(interactive()) { # pkg <- Package("sn") meta <- packageDescription("sn") packageStartupMessage( "Package 'sn', ", meta$Version, " (", meta$Date, "). ", "Type 'help(SN)' for summary information.\n", "The package redefines function 'sd' but its usual working is unchanged.") } invisible() } sn/MD50000644000176200001440000000547713205415137011220 0ustar liggesusersf937a5207adda96e67e353f85b1abf0e *DESCRIPTION 3091f95579fde5633a3d575256fb34a9 *NAMESPACE c86cfcecdbdd97ee90f2df19bf3ea992 *NEWS 3999c618b0d72bafbb2fc7f7becbbcf5 *R/sn-funct.R d3cade84a9a5d7f630a01a365be651c4 *R/sn_S4.R 111ff3ae97375c9b57aa355627798561 *R/zzz.R c87d56eaa84f8f6d137ab316c0c046fb *data/ais.rda 936a3c981c887b1a652bb242876abe78 *data/barolo.rda 34eec837014af0f0f7cbe64666f9aa19 *data/frontier.rda 49a59ed7cd47e29078200e38e8855f2a *data/wines.rda 5d88e7669ed87059bf1cff85b2d63e78 *inst/CITATION 0629445e5f3de06acbaf6e4013c7deca *inst/doc/R.css 99b0862cc0138616fba26150d2a13895 *inst/doc/how_to_sample.pdf 7c840c8f05ef39e1425370bf4bc38b58 *inst/doc/pkg-overview.html 8447f5de5c2862fd28108c88e2d227fa *inst/doc/pkg_sn-intro.pdf d9d326a5d669a21d4cc2ed4f63bc0e8c *inst/doc/selm-intervals.pdf 5361b51ac600fdd254d2e9f3bd6429bf *man/Qpenalty.Rd 0cac7cda908cf82cbcf3150066af4532 *man/SECdistrMv-class.Rd c1be5ed5b919da51ff40a4c7a733c118 *man/SECdistrUv-class.Rd 8970a8d62fbf1fe02d744d627f3c092a *man/T.Owen.Rd 3d1eac2467a01f5aa7f3e4d888046698 *man/affineTransSECdistr.Rd c36e848eb9cf74fbc042a17e3b0cbfde *man/ais.Rd d46cce4c875557a11d80ca8ac8c4b23b *man/barolo.Rd d0f80bb7fcd38aa51f6612aadcfe09f4 *man/coef.selm.Rd f9361d9091a1e5b06fa9583154ddfbe6 *man/conditionalSECdistr.Rd 4416b7bb02162973f4ca603117bd2c7a *man/confint.selm.Rd ce428499f634fa674d7d31b3be61ef16 *man/dmsn.Rd 1b8c96e6c8de8122ebedbacc2bb9dff9 *man/dmst.Rd 04b5ad3c2a0bd9f04563f55aad0cabc6 *man/dp2cp.Rd 383f5b2e2f8c8bc78646c26cd047f42b *man/dsc.Rd 26c8628d277684f1a434b87e3be9b4c2 *man/dsn.Rd 1a57f778872a083e893cd631b4f32ef7 *man/dst.Rd 6b9e30a4866ac31ed62d6e3d9c267cae *man/extractSECdistr.Rd 8e9b88045386ec0467941a81e1e43a50 *man/frontier.Rd 95b05eebbb4ff97ddd98c6b75d359457 *man/makeSECdistr.Rd f85a1439b76bdda1d09c5f5b45824481 *man/matrix-op.Rd ba660f400e4c16327f7537a0cde78ee0 *man/modeSECdistr.Rd cc1fa19e07cf9dc90a8bd5af1a9faefd *man/overview.Rd 28c6969db750d78885dccc0c1a7d16d0 *man/plot.SECdistr.Rd 2c73aeb005c768fdfb0cfaff8557013e *man/plot.selm.Rd cbfc94c36e7e1393b566e2bcf7a9e37a *man/predict.selm.Rd 97c87d5c7bc65ebdf26d4c12217143d2 *man/profile.selm.Rd 792d26be992fcae3d65ad6d680551383 *man/residuals.selm.Rd cc3dc14383601c9fa0bf8d1196ed8049 *man/sd.Rd e5ebae18ba50e5358fc2a9ae857c9ad9 *man/selm-class.Rd 9c9d82c86dff2d355834eff08eb7c59f *man/selm.Rd 8271bfcfb72a46c9cc8221df7951daee *man/selm.fit.Rd 8e6c2f5d1e2a6d7e3b8ab0220e7b253f *man/sn-package.Rd 21a3be4081fda8716485cca6d329532a *man/sn-st.cumulants.Rd 668c242732e257950d3df47f8c86b331 *man/sn-st.info.Rd ac9e41daa309fce5cf5fc2f3f389880a *man/summary.SECdistr-class.Rd d158ef07ab30d3c03698eff12f4ca431 *man/summary.SECdistr.Rd dd09948e59e1eea5cd04478ba8e2a49e *man/summary.selm.Rd eee5e7c6e9123b329c384b200a3816b4 *man/symm-modulated-distr.Rd c9013b421d93931e4ee5b7d1100e6d4b *man/wines.Rd 872f1dc0586b1aac9d07417e844f729a *man/zeta.Rd sn/DESCRIPTION0000644000176200001440000000143613205415137012405 0ustar liggesusersPackage: sn Version: 1.5-1 Date: 2017-11-22 Title: The Skew-Normal and Related Distributions Such as the Skew-t Author: Adelchi Azzalini Maintainer: Adelchi Azzalini Depends: R (>= 2.15.3), methods, stats4 Imports: mnormt (>= 1.5-4), numDeriv, stats, grDevices, graphics, utils Description: Build and manipulate probability distributions of the skew-normal family and some related ones, notably the skew-t family, and provide related statistical methods for data fitting and model diagnostics, in the univariate and the multivariate case. License: GPL-2 | GPL-3 URL: http://azzalini.stat.unipd.it/SN Encoding: UTF-8 NeedsCompilation: no Packaged: 2017-11-22 08:20:25 UTC; aa Repository: CRAN Date/Publication: 2017-11-23 00:46:23 UTC sn/man/0000755000176200001440000000000013205231511011436 5ustar liggesuserssn/man/dst.Rd0000644000176200001440000001301013047130057012521 0ustar liggesusers% file sn/man/dst.Rd % This file is a component of the package 'sn' for R % copyright (C) 2002-2014 Adelchi Azzalini %--------------------- \name{dst} \alias{dst} \alias{pst} \alias{qst} \alias{rst} \title{Skew-\eqn{t} Distribution} \description{Density function, distribution function, quantiles and random number generation for the skew-\eqn{t} (ST) distribution} \usage{ dst(x, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, log=FALSE) pst(x, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, method=0, ...) qst(p, xi=0, omega=1, alpha=0, nu=Inf, tol=1e-08, dp=NULL, method=0, ...) rst(n=1, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL) } \arguments{ \item{x}{vector of quantiles. Missing values (\code{NA}s) are allowed.} \item{p}{vector of probabililities.} \item{xi}{vector of location parameters.} \item{omega}{vector of scale parameters; must be positive.} \item{alpha}{vector of slant parameters. With \code{pst} and \code{qst}, it must be of length 1.} \item{nu}{a single positive value representing the degrees of freedom; it can be non-integer. Default value is \code{nu=Inf} which corresponds to the skew-normal distribution. } \item{dp}{a vector of length 4, whose elements represent location, scale (positive), slant and degrees of freedom, respectively. If \code{dp} is specified, the individual parameters cannot be set.} \item{n}{a positive integer representing the sample size.} \item{log}{logical; if TRUE, densities are given as log-densities} \item{tol}{ a scalar value which regulates the accuracy of the result of \code{qsn}, measured on the probability scale. } \item{method}{an integer value between \code{0} and \code{4} which selects the computing method; see \sQuote{Details} below for the meaning of these values. If \code{method=0} (default value), an automatic choice is made among the four actual computing methods, which depends on the other arguments.} \item{...}{additional parameters passed to \code{integrate} or \code{pmst}.} } \value{Density (\code{dst}), probability (\code{pst}), quantiles (\code{qst}) and random sample (\code{rst}) from the skew-\eqn{t} distribution with given \code{xi}, \code{omega}, \code{alpha} and \code{nu} parameters.} \section{Details}{ Typical usages are \preformatted{% dst(x, xi=0, omega=1, alpha=0, nu=Inf, log=FALSE) dst(x, dp=, log=FALSE) pst(x, xi=0, omega=1, alpha=0, nu=Inf, method=0, ...) pst(x, dp=, log=FALSE) qst(p, xi=0, omega=1, alpha=0, nu=Inf, tol=1e-8, method=0, ...) qst(x, dp=, log=FALSE) rst(n=1, xi=0, omega=1, alpha=0, nu=Inf) rst(x, dp=, log=FALSE) } } \section{Background}{ The family of skew-\eqn{t} distributions is an extension of the Student's \eqn{t} family, via the introduction of a \code{alpha} parameter which regulates skewness; when \code{alpha=0}, the skew-\eqn{t} distribution reduces to the usual Student's \eqn{t} distribution. When \code{nu=Inf}, it reduces to the skew-normal distribution. When \code{nu=1}, it reduces to a form of skew-Cauchy distribution. See Chapter 4 of Azzalini & Capitanio (2014) for additional information. A multivariate version of the distribution exists; see \code{dmst}. } \section{Details}{ For evaluation of \code{pst}, and so indirectly of \code{qst}, four different methods are employed. Method 1 consists in using \code{pmst} with dimension \code{d=1}. Method 2 applies \code{integrate} to the density function \code{dst}. Method 3 again uses \code{integrate} too but with a different integrand, as given in Section 4.2 of Azzalini & Capitanio (2003), full version of the paper. Method 4 consists in the recursive procedure of Jamalizadeh, Khosravi and Balakrishnan (2009), which is recalled in Complement 4.3 on Azzalini & Capitanio (2014); the recursion over \code{nu} starts from the explicit expression for \code{nu=1} given by \code{psc}. Of these, Method 1 and 4 are only suitable for integer values of \code{nu}. Method 4 becomes progressively less efficient as \code{nu} increases, because its value corresponds to the number of nested calls, but the decay of efficiency is slower for larger values of \code{length(x)}. If the default argument value \code{method=0} is retained, an automatic choice among the above four methods is made, which depends on the values of \code{nu, alpha, length(x)}. The numerical accuracy of methods 1, 2 and 3 can be regulated via the \code{...} argument, while method 4 is conceptually exact, up to machine precision. If \code{qst} is called with \code{nu>1e4}, computation is transferred to \code{qsn}. } \references{ Azzalini, A. and Capitanio, A. (2003). Distributions generated by perturbation of symmetry with emphasis on a multivariate skew-\emph{t} distribution. \emph{J.Roy. Statist. Soc. B} \bold{65}, 367--389. Full version of the paper at \url{http://arXiv.org/abs/0911.2342}. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-normal and Related Families}. Cambridge University Press, IMS Monographs series. Jamalizadeh, A., Khosravi, M., and Balakrishnan, N. (2009). Recurrence relations for distributions of a skew-$t$ and a linear combination of order statistics from a bivariate-$t$. \emph{Comp. Statist. Data An.} \bold{53}, 847--852. } \seealso{\code{\link{dmst}}, \code{\link{dsn}}, \code{\link{dsc}}} \examples{ pdf <- dst(seq(-4, 4, by=0.1), alpha=3, nu=5) rnd <- rst(100, 5, 2, -5, 8) q <- qst(c(0.25, 0.50, 0.75), alpha=3, nu=5) pst(q, alpha=3, nu=5) # must give back c(0.25, 0.50, 0.75) # p1 <- pst(x=seq(-3,3, by=1), dp=c(0,1,pi, 3.5)) p2 <- pst(x=seq(-3,3, by=1), dp=c(0,1,pi, 3.5), method=2, rel.tol=1e-9) } \keyword{distribution} sn/man/dmsn.Rd0000644000176200001440000001200713047127616012704 0ustar liggesusers% file sn/man/dmsn.Rd % This file is a component of the package 'sn' for R % copyright (C) 1998-2013 Adelchi Azzalini %--------------------- \name{dmsn} \alias{dmsn} \alias{pmsn} \alias{rmsn} \concept{skew-normal distribution} \title{Multivariate skew-normal distribution} \description{ Probability density function, distribution function and random number generation for the multivariate skew-normal (\acronym{SN}) distribution. } \usage{ dmsn(x, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL, log=FALSE) pmsn(x, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL, ...) rmsn(n=1, xi=rep(0,length(alpha)), Omega, alpha, tau=0, dp=NULL) } \arguments{ \item{x}{either a vector of length \code{d}, where \code{d=length(alpha)}, or a matrix with \code{d} columns, giving the coordinates of the point(s) where the density or the distribution function must be evaluated.} \item{xi}{a numeric vector of length \code{d} representing the location parameter of the distribution; see \sQuote{Background}. In a call to \code{dmsn} and \code{pmsn}, \code{xi} can be a matrix, whose rows represent a set of location parameters; in this case, its dimensions must match those of \code{x}.} \item{Omega}{a symmetric positive-definite matrix of dimension \code{(d,d)}; see \sQuote{Background}.} \item{alpha}{a numeric vector which regulates the slant of the density; see \sQuote{Background}. \code{Inf} values in \code{alpha} are not allowed.} \item{tau}{a single value representing the `hidden mean' parameter of the \acronym{ESN} distribution; \code{tau=0} (default) corresponds to a \acronym{SN} distribution.} \item{dp}{ a list with three elements, corresponding to \code{xi}, \code{Omega} and \code{alpha} described above; default value \code{FALSE}. If \code{dp} is assigned, individual parameters must not be specified. } \item{n}{a numeric value which represents the number of random vectors to be drawn.} \item{log}{logical (default value: \code{FALSE}); if \code{TRUE}, log-densities are returned.} \item{...}{ additional parameters passed to \code{pmnorm}.} } \value{ A vector of density values (\code{dmsn}) or of probabilities (\code{pmsn}) or a matrix of random points (\code{rmsn}). } \details{Typical usages are \preformatted{% dmsn(x, xi=rep(0,length(alpha)), Omega, alpha, log=FALSE) dmsn(x, dp=, log=FALSE) pmsn(x, xi=rep(0,length(alpha)), Omega, alpha, ...) pmsn(x, dp=) rmsn(n=1, xi=rep(0,length(alpha)), Omega, alpha) rmsn(n=1, dp=) } Function \code{pmsn} makes use of \code{pmnorm} from package \pkg{mnormt}; the accuracy of its computation can be controlled via \code{...} } \section{Background}{ The multivariate skew-normal distribution is discussed by Azzalini and Dalla Valle (1996). The \code{(Omega,alpha)} parametrization adopted here is the one of Azzalini and Capitanio (1999). Chapter 5 of Azzalini and Capitanio (2014) provides an extensive account, including subsequent developments. Notice that the location vector \code{xi} does not represent the mean vector of the distribution. Similarly, \code{Omega} is not \emph{the} covariance matrix of the distribution, although it is \emph{a} covariance matrix. Finally, the components of \code{alpha} are not equal to the slant parameters of the marginal distributions; to fix the marginal parameters at prescribed values, it is convenient to start from the OP parameterization, as illustrated in the \sQuote{Examples} below. Another option is to start from the \acronym{CP} parameterization, but notice that, at variance from the \acronym{OP}, not all \acronym{CP} sets are invertible to lend a \acronym{DP} set.} \references{ Azzalini, A. and Capitanio, A. (1999). Statistical applications of the multivariate skew normal distribution. \emph{J.Roy.Statist.Soc. B} \bold{61}, 579--602. Full-length version available at \url{http://arXiv.org/abs/0911.2093} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Azzalini, A. and Dalla Valle, A. (1996). The multivariate skew-normal distribution. \emph{Biometrika} \bold{83}, 715--726. } \seealso{\code{\link{dsn}}, \code{\link{dmst}}, \code{\link[mnormt]{dmnorm}}, \code{\link{op2dp}}, \code{\link{cp2dp}}} \examples{ x <- seq(-3,3,length=15) xi <- c(0.5, -1) Omega <- diag(2) Omega[2,1] <- Omega[1,2] <- 0.5 alpha <- c(2,-6) pdf <- dmsn(cbind(x, 2*x-1), xi, Omega, alpha) cdf <- pmsn(cbind(x, 2*x-1), xi, Omega, alpha) p1 <- pmsn(c(2,1), xi, Omega, alpha) p2 <- pmsn(c(2,1), xi, Omega, alpha, abseps=1e-12, maxpts=10000) # rnd <- rmsn(10, xi, Omega, alpha) # # use OP parameters to fix marginal shapes at given lambda values: op <- list(xi=c(0,1), Psi=matrix(c(2,2,2,3), 2, 2), lambda=c(5, -2)) rnd <- rmsn(10, dp=op2dp(op,"SN")) # # use CP parameters to fix mean vector, variance matrix and marginal skewness: cp <- list(mean=c(0,0), var.cov=matrix(c(3,2,2,3)/3, 2, 2), gamma1=c(0.8, 0.4)) dp <- cp2dp(cp, "SN") rnd <- rmsn(5, dp=dp) } \keyword{distribution} \keyword{multivariate} sn/man/selm-class.Rd0000644000176200001440000001217012735017430014002 0ustar liggesusers% file sn/man/selm-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2014 Adelchi Azzalini %--------------------- \name{selm-class} \Rdversion{1.1} \docType{class} \alias{selm-class} %\alias{coef,selm-method} % superseded by coef.selm.Rd \alias{logLik,selm-method} \alias{plot,selm,ANY-method} \alias{plot,selm,missing-method} \alias{show,selm-method} % \alias{fitted,selm-method} % superseded by residuals.selm.Rd % \alias{residuals,selm-method} % superseded by residuals.selm.Rd \alias{vcov,selm-method} \alias{weights,selm-method} \alias{confint,selm-method} \alias{predict,selm-method} % \alias{mselm-class} % \alias{coef,mselm-method} % superseded by coef.selm.Rd \alias{logLik,mselm-method} \alias{plot,mselm,ANY-method} \alias{plot,mselm,missing-method} \alias{show,mselm-method} %\alias{fitted,mselm-method} % superseded by residuals.selm.Rd %\alias{residuals,mselm-method} % superseded by residuals.selm.Rd \alias{vcov,mselm-method} \alias{weights,mselm-method} \title{Classes \code{selm} and \code{mselm} of objects created by function \code{selm}} \description{A successful call to function \code{selm} creates an object of either of these classes, having a structure described in section \sQuote{Slots}. A set of methods for these classes of objects exist, listed in section \sQuote{Methods}.} \section{Objects from the class}{ An object can be created by a successful call to function \code{selm}.} \section{Slots}{ \describe{ \item{\code{call}:}{the calling statement.} \item{\code{family}:}{the parametric family of skew-ellitically contoured distributed (SEC) type.} \item{\code{logL}:}{log-likelihood or penalized log-likelihood value achieved at the end of the maximization process.} \item{\code{method}:}{estimation method (\code{"MLE"} or \code{"MPLE"}).} \item{\code{param}:}{estimated parameters, for various parameterizations.} \item{\code{param.var}:}{approximate variance matrices of the parameter estimates, for various parameterizations.} \item{\code{size}:}{a numeric vector with size of various components.} \item{\code{fixed.param}:}{a vector of parameters which have been kept fixed in the fitting process, if any.} \item{\code{residuals.dp}:}{residual values, for DP-type parameters.} \item{\code{fitted.values.dp}:}{fitted values, for DP-type parameters.} \item{\code{control}:}{a list with control parameters.} \item{\code{input}:}{a list of selected input values.} \item{\code{opt.method}:}{a list with details on the optimization method.} } } \section{Methods}{ \tabular{ll}{ \code{coef} \tab \code{signature(object = "selm")}: ... \cr \code{logLik} \tab \code{signature(object = "selm")}: ... \cr % \code{plot} \tab \code{signature(x = "selm", y = "ANY")}: ... \cr % \code{plot} \tab \code{signature(x = "selm", y = "missing")}: ... \cr \code{plot} \tab \code{signature(x = "selm")}: ... \cr \code{show} \tab \code{signature(object = "selm")}: ... \cr \code{summary} \tab \code{signature(object = "selm")}: ... \cr \code{residuals} \tab \code{signature(object = "selm")}: ... \cr \code{fitted} \tab \code{signature(object = "selm")}: ... \cr \code{vcov} \tab \code{signature(object = "selm")}: ... \cr \code{weights} \tab \code{signature(object = "selm")}: ... \cr \code{profile} \tab \code{signature(fitted = "selm")}: ... \cr \code{confint} \tab \code{signature(object = "selm")}: ... \cr \code{predict} \tab \code{signature(object = "selm")}: ... \cr \tab \cr \code{coef} \tab \code{signature(object = "mselm")}: ... \cr \code{logLik} \tab \code{signature(object = "mselm")}: ... \cr \code{plot} \tab \code{signature(x = "mselm")}: ... \cr \code{show} \tab \code{signature(object = "mselm")}: ... \cr \code{summary} \tab \code{signature(object = "mselm")}: ... \cr \code{residuals} \tab \code{signature(object = "mselm")}: ... \cr \code{fitted} \tab \code{signature(object = "mselm")}: ... \cr \code{vcov} \tab \code{signature(object = "mselm")}: ... \cr \code{weights} \tab \code{signature(object = "mselm")}: ... \cr } } %\references{%% ~~put references to the literature/web site here~~} \author{Adelchi Azzalini} \note{See \code{\link{dp2cp}} for a description of possible parameter sets. When \code{logLik} is used on an object obtained using the MPLE estimation method, the value reported is actually the \emph{penalized} log-likelihood. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{See also \code{\link{selm}} function, \code{\link{plot.selm}}, \code{\linkS4class{summary.selm}}, \code{\link{dp2cp}} } \examples{ data(ais) m1 <- selm(log(Fe) ~ BMI + LBM, family="SN", data=ais) summary(m1) plot(m1) logLik(m1) res <- residuals(m1) fv <- fitted(m1) # data(wines, package="sn") m2 <- selm(alcohol ~ malic + phenols, data=wines) # m12 <- selm(cbind(acidity, alcohol) ~ phenols + wine, family="SN", data=wines) coef(m12) cp <- coef(m12, vector=FALSE) dp <- coef(m12, "DP", vector=FALSE) plot(m12) plot(m12, which=2, col="gray60", pch=20) } \keyword{classes} sn/man/dp2cp.Rd0000644000176200001440000001665113203255121012747 0ustar liggesusers% file sn/man/dp2cp.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{dp2cp} \alias{dp2cp} \alias{cp2dp} \alias{dp2op} \alias{op2dp} \title{Conversion between parametrizations of a skew-elliptical distribution} \description{ Convert direct parameters (\acronym{DP}) to centred parameters (\acronym{CP}) of a skew-elliptical distribution and \emph{vice versa}.} \usage{ dp2cp(dp, family, object = NULL, cp.type = "proper", upto = NULL) cp2dp(cp, family) dp2op(dp, family) op2dp(op, family) } \arguments{ \item{dp}{a vector (in the univariate case) or a list (in the multivariate case) as described in \code{\link{makeSECdistr}}; see \sQuote{Background and Details} for an extented form of usage.} \item{cp}{a vector or a list, in agreement with \code{dp} as for type and dimension.} \item{op}{a vector or a list, in agreement with \code{dp} as for type and dimension.} \item{family}{a characther string with the family acronym, as described in \code{\link{makeSECdistr}}, except that family \code{"ESN"} is not implemented.} \item{object}{optionally, an S4 object of class \code{SECdistrUv} or \code{SECdistrMv}, as produced by \code{\link{makeSECdistr}} (default value: \code{NULL}). If this argument is not \code{NULL}, then \code{family} and \code{dp} must not be set.} \item{cp.type}{character string, which has effect only if \code{family="ST"} or \code{"SC"}, otherwise a warning message is generated. Possible values are \kbd{"proper", "pseudo", "auto"}, which correspond to the \acronym{CP} parameter set, their `pseudo-\acronym{CP}' version and an automatic selection based on \code{nu>4}, where \code{nu} represents the degrees of freedom of the \acronym{ST} distribution.} \item{upto}{numeric value (in \code{1:length(dp)}, default=\code{NULL}) to select how many \acronym{CP} components are computed. Default value \code{upto=NULL} is equivalent to \code{length(dp)}.} } \value{For \code{dp2cp}, a matching vector (in the univariate case) or a list (in the multivariate case) of \code{cp} parameters. For \code{cp2dp} and \code{op2dp}, a similar object of \code{dp} parameters, provided the set of input parameters is in the admissible region. For \code{dp2op}, a similar set of \code{op} parameters.} \section{Background}{For a description of the \acronym{DP} parameters, see Section \sQuote{Details} of \code{\link{makeSECdistr}}. The \acronym{CP} form of parameterization is cumulant-based. For a univariate distribution, the \acronym{CP} components are the mean value (first cumulant), the standard deviation (square root of the 2nd cumulant), the coefficient of skewness (3rd standardized cumulant) and, for the \acronym{ST}, the coefficient of excess kurtosis (4th standardized cumulant). For a multivariate distribution, there exists an extension based on the same logic; its components represent the vector mean value, the variance matrix, the vector of marginal coefficients of skewness and, only for the \acronym{ST}, the Mardia's coefficient of excess kurtosis. The pseudo-\acronym{CP} variant provides an `approximate form' of \acronym{CP} when not all required cumulants exist; however, this parameter set is not uniquely invertible to \acronym{DP}. The names of pseudo-\acronym{CP} components printed in summary output are composed by adding a \code{~} after the usual component name; for example, the first one is denoted \code{mean~}. Additional information is provided by Azzalini and Capitanio (2014). Specifically, their Section 3.1.4 presents \acronym{CP} in the univariate \acronym{SN} case, Section 4.3.4 \acronym{CP} for the \acronym{ST} case and the `pseudo-\acronym{CP}' version. Section 5.2.3 presents the multivariate extension for the \acronym{SN} distribution, Section 6.2.5 for the multivariate \acronym{ST} case. For a more detailed discussion, see Arellano-Valle & Azzalini (2013). The \acronym{OP} parameterization is very similar to \acronym{DP}, from which it differs only for the components which regulate dispersion (or scatter) and slant. Its relevance lies essentially in the multivariate case, where the components of the slant parameter can be interpreted component-wise and remain unaffected if marginalization with respect to some other components is performed. In the multivariate \acronym{SN} case, the components of \acronym{OP}, denoted \eqn{\xi, \Psi, \lambda}, are associated to the expression of the density function (5.30) of Azzalini & Capitanio (2014); see pp.128--131 for more information. In the univariate case, the slant component of \acronym{DP} and the one of \acronym{OP} coincide, that is, \eqn{\alpha=\lambda}, Parameter \eqn{\xi} and other parameters which may exist with other families remain the same of the \acronym{DP} set. The term \acronym{OP} stands for `original parameterization' since this is, up to a negligible difference, the parameterization adopted by Azzalini & Dalla Valle (1996). } \section{Details}{ While any choice of the components of \acronym{DP} or \acronym{OP} is admissible, this is not true for \acronym{CP}. An implication is that a call to \code{cp2dp} may fail with an error message \code{"non-admissible CP"} for certain input values. The most extreme case is represented by the \acronym{SC} family, for which \acronym{CP} never exists; hence it makes to sense to call \code{cp2dp} with \code{family="SC"}. It is possible to call the functions with \code{dp} or \code{cp} having more components than those expected for a given family as described above and in \code{\link{makeSECdistr}}. In the univariate case, this means that \code{dp} or \code{cp} can be vectors of longer length than indicated earlier. This occurrence is interpreted in the sense that the additional components after the first one are regarded as regression coefficients of a \code{selm} model, and they are transferred unchanged to the matching components of the transformed parameter set; the motivation is given in Section 3.1.4 of Azzalini and Capitanio (2014). In the multivariate case, \code{dp[[1]]} and \code{cp[[1]]} can be matrices instead of vectors; the rows beyond the first one are transferred unchanged to \code{cp[[1]]} and \code{dp[[1]]}, respectively. } \references{ Arellano-Valle, R. B. and Azzalini, A. (2013, available on-line 12 June 2011). The centred parameterization and related quantities of the skew-\emph{t} distribution. \emph{J. Multiv. Analysis} \bold{113}, 73-90. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Azzalini, A. and Dalla Valle, A. (1996). The multivariate skew-normal distribution. \emph{Biometrika} \bold{83}, 715--726. } \seealso{ \code{\link{makeSECdistr}}, \code{\link{summary.SECdistr}}, \code{\link{sn.cumulants}}, the \sQuote{Note} at \code{\link{summary.selm}} for the reason why \acronym{CP} is the default parameterization in that function and in related ones, the \sQuote{Examples} at \code{\link{rmsn}} for use of the \acronym{CP} parameterization } \examples{ # univariate case cp <- dp2cp(c(1, 2222, 3333, 2, 3), "SN") dp <- cp2dp(cp, "SN") # notice that 2nd and 3rd component remain unchanged # # multivariate case dp3 <- list(xi=1:3, Omega=toeplitz(1/(1:3)), alpha=c(-3, 8, 5), nu=6) cp3 <- dp2cp(dp3, "ST") dp3.back <- cp2dp(cp3, "ST") # op3 <- dp2op(dp3, "ST") dp3back <- op2dp(op3,"ST") } \keyword{distribution} sn/man/plot.SECdistr.Rd0000644000176200001440000001612212565412353014401 0ustar liggesusers% file sn/man/plot.SECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{plot.SECdistr} \docType{methods} %\alias{plot,ANY,ANY-method} % \alias{plot,profile.mle,missing-method} % \alias{show,SECdistrMv-method} % \alias{show,SECdistrUv-method} \alias{plot.SECdistr} \alias{plot.SECdistrUv} \alias{plot.SECdistrMv} \alias{plot,SECdistrMv,missing-method} \alias{plot,SECdistrUv,missing-method} \alias{plot,SECdistrMv-method} \alias{plot,SECdistrUv-method} \title{Plotting methods for classes \code{SECdistrUv} and \code{SECdistrMv}} \description{Methods for classes \code{SECdistrUv} and \code{SECdistrMv}} \usage{ \S4method{plot}{SECdistrUv}(x, range, probs, main, npt = 251, \dots) \S4method{plot}{SECdistrMv}(x, range, probs, npt, landmarks = "auto", main, comp, compLabs, data = NULL, data.par = NULL, gap = 0.5, \dots) } \arguments{ \item{x}{an object of class \code{SECdistrUv} or \code{SECdistrMv}.} % \item{y}{not used, required by the generic \code{plot(x, y, ...)} function.} \item{range}{in the univariate case, a vector of length 2 which defines the plotting range; in the multivariate case, a matrix with two rows where each column defines the plotting range of the corresponding component variable. If missing, a sensible choice is made.} \item{probs}{a vector of probability values. In the univariate case, the corresponding quantiles are plotted on the horizontal axis; it can be skipped by setting \code{probs=NULL}. In the multivariate case, each probability value corresponds to a contour level in each bivariate plot; at least one probability value is required. See \sQuote{Details} for further information. Default value: \code{c(0.05, 0.25, 0.5, 0.75, 0.95)} in the univariate case, \code{c(0.25, 0.5, 0.75, 0.95)} in the multivariate case.} \item{npt}{a numeric value or vector (in the univariate and in the multivariate case, respectively) to assign the number of evaluation points of the distribution, on an equally-spaced grid over the \code{range} defined above. Default value: 251 in the univariate case, a vector of 101's in the multivariate case.} \item{landmarks}{a character string which affects the placement of some landmark values in the multivariate case, that is, the origin, the mode and the mean (or its substitute pseudo-mean), which are all aligned. Possible values: \code{"proper"}, \code{"pseudo"}, \code{"auto"} (default), \code{""}. The option \code{""} prevents plotting of the landmarks. With the other options, the landmarks are plotted, with some variation in the last one: \code{"proper"} plots the proper mean value, \code{"pseudo"} plots the pseudo-mean, useful when the proper mean does not exists, \code{"auto"} plots the proper mean if it exists, otherwise it switches automatically to the pseudo-mean. See \code{\link{dp2cp}} for more information on pseudo-\acronym{CP} parameters, including pseudo-mean.} \item{main}{a character string for main title; if missing, one is built from the available ingredients.} \item{comp}{a subset of the vector \code{1:d}, if \code{d} denotes the dimensionality of the multivariate distribution.} \item{compLabs}{a vector of character strings or expressions used to denote the variables in the plot; if missing, \code{slot(object,"compNames")} is used.} \item{data}{an optional set of data of matching dimensionity of \code{object} to be superimposed to the plot. The default value \code{data=NULL} produces no effect. In the univariate case, data are plotted using \code{\link[graphics]{rug}} at the top horizontal axis, unless if \code{probs=NULL}, in which case plotting is at the bottom axis. In the multivariate case, points are plotted in the form of a scatterplot or matrix of scatterplots; this can be regulated by argument \code{data.par}.} \item{data.par}{an optional list of graphical parameters used for plotting \code{data} in the multivariate case, when \code{data} is not \code{NULL}. Recognized parameters are: \code{col}, \code{pch}, \code{cex}. If missing, the analogous components of \code{par()} are used. } \item{gap}{a numeric value which regulates the gap between panels of a multivariate plot when \code{d>2}.} \item{\dots}{additional graphical parameters} } \section{Details}{ For univariate density plots, \code{probs} are used to compute quantiles from the appropriate distribution, and these are superimposed to the plot of the density function, unless \code{probs=NULL}. In the multivariate case, each bivariate plot is constructed as a collection of contour curves, one curve for each probability level; consequently, \code{probs} cannot be missing or \code{NULL}. The level of the density contour lines are chosen so that each curve circumscribes a region with the quoted probability, to a good degree of approssimation; for additional information, see Azzalini and Capitanio (2014), specifically Complement 5.2 and p.179, and references therein. } \value{an invisible list. In the univariate case the list has three components: the input object representing the distribution and two numeric vectors with the coordinates of the plotted density values. In the multivariate case, the first element of the list is the input object representing the distribution and all subsequent list elements are lists with components of the panels comprising the matrix plot; the elements of these sub-lists are: the vectors of \code{x} and \code{y} coordinates, the names of the variables, the density values at the \code{(x,y)} points, a vector of the density levels of the curves appearing in each panel plot, with the corresponding approximate probability content as a vector attribute.} \author{Adelchi Azzalini} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{\code{\link{makeSECdistr}}, \code{\link{summary.SECdistr}}, \code{\link{dp2cp}}} \section{Methods}{ \describe{ % \item{\code{signature(x = "ANY", y = "ANY")}}{Generic function: see % \code{\link[graphics]{plot}}.} \item{\code{signature(x = "SECdistrUv")}}{Plot an object \code{x} of class \code{SECdistrUv}.} \item{\code{signature(x = "SECdistrMv")}}{Plot an object \code{x} of class \code{SECdistrMv}.} }} \examples{ # d=1 f1 <- makeSECdistr(dp=c(3,2,5), family="SC", name="Univariate Skew-Cauchy") plot(f1) plot(f1, range=c(-3,40), probs=NULL, col=4) # # d=2 Omega2 <- matrix(c(3, -3, -3, 5), 2, 2) f2 <- makeSECdistr(dp=list(c(10,30), Omega=Omega2, alpha=c(-3, 5)), family="sn", name="SN-2d", compNames=c("x1","x2")) plot(f2) x2 <- rmsn(100, dp=slot(f2,"dp")) plot(f2, main="Distribution 'f2'", probs=c(0.5,0.9), cex.main=1.5, col=2, cex=0.8, compLabs=c(expression(x[1]), expression(log(z[2]-beta^{1/3}))), data=x2, data.par=list(col=4, cex=0.6, pch=5)) } \keyword{methods} \keyword{hplot} sn/man/predict.selm.Rd0000644000176200001440000000602613077133226014335 0ustar liggesusers% file sn/man/profile.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2015 Adelchi Azzalini %--------------------- \name{predict.selm} \alias{predict.selm} \alias{predict.selm-method} \concept{confidence interval} \concept{tolerance interval} \title{Predict method for selm-class objects} \description{ Predicted values based on a model object produced by \code{selm} with univariate response. } \usage{ \S3method{predict}{selm}(object, newdata, param.type = "CP", interval = "none", level = 0.95, na.action = na.pass, ...) } \arguments{ \item{object}{an object of class \code{selm} as produced by a call to function \code{selm} with univariate response.} \item{newdata}{an optional data frame in which to look for variables with which to predict. If omitted, the fitted values are used.} \item{param.type}{ a character string with the required parameterization; it must be one of \code{"CP"}, \code{"DP"}, \code{"pseudo-CP"}, or possibly their equivalent lowercase.} \item{interval}{type of interval calculation among \code{"none", "confidence", "prediction"}; it can be abbreviated.} \item{level}{tolerance/confidence level (default value is \code{0.95}).} \item{na.action}{function determining what should be done with missing values in newdata. The default is to predict \code{NA}.} \item{...}{not used, only there for compatibility reasons.} } \details{ Predicted values are obtained by evaluating the regression function in the dataframe \code{newdata} (which defaults to \code{model.frame(object)}). Setting \code{interval} other than \code{"none"} produces computation of confidence or prediction (tolerance) intervals at the specified level. If \code{newdata} is omitted the predictions are based on the data used for the fit. The action taken in case of missing data is regulated by argument \code{na.action}, along the lines of function \code{\link[stats]{predict.lm}}. A detailed description of the methodology underlying \code{predict.selm} is available in the technical note of Azzalini (2016). } \value{ a vector of predictions (if \code{interval="none"}) or a matrix of predictions and bounds with column names \code{fit}, \code{lwr}, and \code{upr}, if \code{interval} is set.} \author{Adelchi Azzalini} \references{ Azzalini, A. (2016). Derivation of various types of intervals from a \code{selm} object. Technical note distributed with the documentation of the \R package \code{sn}, in file \href{../doc/selm-intervals.pdf}{\code{selm-intervals.pdf}} within section \sQuote{User guide, package vignettes and other documentation}. } % \note{} \seealso{ \code{\link{selm}}, \code{\link{summary.selm}}, \code{\link{makeSECdistr}} for the \acronym{CP}/\acronym{DP} parameterizations, \code{\link[stats]{predict.lm}} for usage of \code{na.action} } \examples{ data(barolo) attach(barolo) A75 <- (reseller=="A" & volume==75) detach(barolo) m3 <- selm(log(price, 10) ~ age, data=barolo[A75,], family="ST") } sn/man/Qpenalty.Rd0000644000176200001440000000625712654675076013565 0ustar liggesusers% file sn/man/Qpenalty.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{Qpenalty} \alias{Qpenalty} \alias{MPpenalty} \concept{penalized likelihood} \concept{prior distribution} \title{Penalty function for log-likelihood of \code{selm} models} \description{Penalty function for the log-likelihood of \code{selm} models when \code{method="MPLE"}. \code{Qpenalty} is the default function; \code{MPpenalty} is an example of a user-defined function effectively corresponding to a prior distributio on \code{alpha}. } \usage{ Qpenalty(alpha_etc, nu = NULL, der = 0) MPpenalty(alpha, der = 0) } \arguments{ \item{alpha_etc, alpha}{in the univariate case, a single value \code{alpha}; in the multivariate case, a two-component list whose first component is the vector \code{alpha}, the second one is matrix \code{cov2cor(Omega)}. } \item{nu}{degrees of freedom, only required if \code{selm} is called with \code{family="ST"}. } \item{der}{a numeric value in the set \kbd{0,1,2} which indicates the required numer of derivatives of the function. In the multivariate case the function will only be called with \code{der} equal to 0 or 1.} } \details{The penalty is a function of \code{alpha}, but its expression may depend on other ingredients, specifically \code{nu} and \code{cov2cor(Omega)}. See \sQuote{Details} of \code{\link{selm}} for additional information. The penalty mechanism allows to introduce a prior distribution \eqn{\pi} for \eqn{\alpha} by setting \eqn{Q=-\log\pi}{Q=-log(\pi)}, leading to a maximum \emph{a posteriori} estimate in the stated sense. As a simple illustration of this mechanism, function \code{MPpenalty} implements the `matching prior' distribution for the univariate \acronym{SN} distribution studied by Cabras \emph{et al.} (2012); a brief summary of the proposal is provided in Section 3.2 of Azzalini and Capitanio (2014). Note that, besides \code{alpha=+/-Inf}, this choice also penalizes \code{alpha=0} with \code{Q=Inf}, effectively removing \code{alpha=0} from the parameter space. Starting from the code of function \code{MPpenalty}, a user should be able to introduce an alternative prior distribution if so desired. } \value{A positive number \code{Q} representing the penalty, possibly with attributes \code{attr(Q, "der1")} and \code{attr(Q, "der2")}, depending onthe input value \code{der}.} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Cabras, S., Racugno, W., Castellanos, M. E., and Ventura, L. (2012). A matching prior for the shape parameter of the skew-normal distribution. \emph{Scand. J. Statist.} \bold{39}, 236--247. } \author{Adelchi Azzalini} % \note{%% ~~further notes~~} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{\code{\link{selm}} function} \examples{ data(frontier) m2 <- selm(frontier ~ 1) # no penalty m2a <- selm(frontier ~ 1, method="MPLE") # penalty="Qpenalty" is implied here m2b <- selm(frontier ~ 1, method="MPLE", penalty="MPpenalty") } %\keyword{ ~kwd1 } sn/man/frontier.Rd0000644000176200001440000000143013047130133013555 0ustar liggesusers% file sn/man/frontier.Rd % This file is a component of the package 'sn' for R % copyright (C) 1998 Adelchi Azzalini %--------------------- \name{frontier} \alias{frontier} \title{Simulated sample from a skew-normal distribution} \usage{data(frontier)} \description{ A sample simulated from the SN(0,1,5) distribution with sample coefficient of skewness inside the admissible range (-0.9952719, 0.9952719) for the skew-normal family but maximum likelihood estimate on the frontier of the parameter space. } \format{A numeric vector of length 50.} \source{Generated by a run of \code{rsn(50, 0, 1, 5)}.} \examples{ data(frontier, package="sn") fit <- selm(frontier ~ 1) plot(fit, which=2) # fit.p <- selm(frontier ~ 1, method="MPLE") plot(fit.p, which=2) } \keyword{datasets} sn/man/extractSECdistr.Rd0000644000176200001440000000414013047130112014776 0ustar liggesusers% file sn/man/extractSECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{extractSECdistr} \alias{extractSECdistr} \concept{skew-elliptical distribution} \title{Extract the SEC error term from an object created by \code{selm}} \description{ Given an object created by a call to \code{selm}, the function delivers the \acronym{SEC} distribution representing the stochastic term of the fitted distribution } \usage{ extractSECdistr(object, name, compNames) } \arguments{ \item{object}{an object of class \code{selm} or \code{mselm}, as created by \code{\link{selm}}.} \item{name}{an optional character string representing the name of the outcome distribution; if missing, a string is constructed from the \code{object} ingredients.} \item{compNames}{in the multivariate case, an optional vector of character strings with the names of the components of the error distribution; if missing, one such vector is constructed from the \code{object} ingredients.} } \value{An object of class \code{SECdistrMv} or \code{SECdistrUv}, depending of the class of \code{object}.} \section{Details}{ When the formula of the fitted model includes only the constant \code{1}, the returned object represents the fitted \acronym{SEC} distribution. If the formula includes additional terms, the linear predictor is eliminated and the returned object corresponds to the error term of the model; hence the location parameter \code{xi} in the \acronym{DP} parameterization is set to zero. The returned object can be submitted to tools available for objects created by \code{\link{makeSECdistr}}, such as \code{\link{summary.SECdistr}}, \code{\link{conditionalSECdistr}} and and so on.} \seealso{\code{\link{selm}}, \code{\link{makeSECdistr}}} \examples{ data(ais) m2 <- selm(log(Fe) ~ 1, family="ST", data=ais, fixed=list(nu=8)) f2 <- extractSECdistr(m2) show(f2) # m4 <- selm(cbind(BMI, LBM) ~ 1, family="SN", data=ais) f4 <- extractSECdistr(m4) mean(f4) vcov(f4) } \keyword{multivariate} \keyword{distribution} sn/man/matrix-op.Rd0000644000176200001440000000356613047130355013667 0ustar liggesusers% file sn/man/vech.Rd % This file is a component of the package 'sn' for R % copyright (C) 1998,2013 Adelchi Azzalini %--------------------- \name{matrix-op} \encoding{UTF-8} \alias{vech} \alias{vech2mat} \alias{duplicationMatrix} \concept{matrix operator} \title{vech and other matrix operators} \description{vech and other matrix operators} \usage{ vech(A) vech2mat(v) duplicationMatrix(n) } \arguments{ \item{A}{a (symmetric) square matrix.} \item{v}{a numeric vector such that \code{length(v)=n*(n+1)/2} for some positive integer \code{n}.} \item{n}{a positive integer number; default is \code{n=1}.} } \value{a vector in case of \code{vech}, otherwise a matrix.} \section{Details}{% For a square matrix \code{A}, \code{vech(A)} returns the vector formed by the lower triangular portion of the matrix, including the diagonal; usually, this only makes sense for a symmetric matrix of numeric values. If \code{v=vech(M)} where \code{M} is a symmetric numeric matrix, \code{vect2mat(v)} performs the inverse operation and returns \code{M}; this explain the requirement on \code{length(v)}. For a positive integer \code{n}, \code{D=duplicationMatrix(n)} is a matrix of dimension \code{(n^2, n*(n+1)/2)} such that \code{D \%*\% vech(M)} returns the \code{vec}-form of a symmetric matrix \code{M} of order \code{n}, that is, the vector which stacks the columns of \code{M}; for more information, see Section 3.8 of Magnus and Neudecker (1988). } \section{Author}{Adelchi Azzalini; the original Octave code of \code{duplicationMatrix} is by Kurt Hornik.} \references{ Magnus, Jan R. and Neudecker, Heinz (1988). \emph{Matrix differential calculus with application in statistics and econometrics}. Wiley series in probability and statistics. } \examples{ M <- toeplitz(1:4) v <- vech(M) vech2mat(v) - M D <- duplicationMatrix(ncol(M)) # D %*% vech(M) - as.vector(M) } \keyword{math} sn/man/overview.Rd0000644000176200001440000001547513203250611013607 0ustar liggesusers% file sn/man/sn-package.Rd % This file is a component of the package 'sn' for R % copyright (C) 2017 Adelchi Azzalini %--------------------- % skipped: R CMD Rdconv overview.Rd --type=html -o sn-pkg-overview.html % \name{overview} \docType{package} \encoding{UTF-8} \alias{overview} \alias{pkg-overview} \title{Package \pkg{sn}: overview of the package structure and commands} \description{ The package provides facilities to build and manipulate probability distributions of the skew-normal and some related families, notably the skew-\eqn{t} family, and makes available related statistical methods for data fitting and model diagnostics, in the univariate and the multivariate case. The package comprises two main sides; one side provides facilities for the pertaining probability distributions, the other one makes available statistical methods dealing with these distributions. Underlying formulation, parameterizations of distributions and terminology are in agreement with the monograph of Azzalini and Capitanio (2014). %% The present document refers to version 1.5-0 of the package (2017-02-09). } \section{Probability side}{% There are two layers of support for the probability distributions of interest. At the basic level, there exist functions which follow the classical \R scheme for distributions. In addition, there exists facilities to build an object which incapsulates a probability distribution and then certain operations can be be performed on such an object. These two schemes are described next. \describe{ \item{Classical \R scheme}{% The following functions work similary to \code{{d,p,q,r}norm} and other \R functions for probability distributions: \itemize{ \item skew-normal (\acronym{SN}): functions \code{{d,p,q,r}sn} for the univariate case, functions \code{{d,p,r}msn} for the multivariate case, where in both cases the \sQuote{Extended skew-normal} (\acronym{ESN}) variant form is included; \item skew-\eqn{t} (\acronym{ST}): functions \code{{d,p,q,r}st} for the univariate case, functions \code{{d,p,r}mst} for the multivariate case; \item skew-Cauchy (\acronym{SC}): functions \code{{d,p,q,r}sc} for the univariate case, functions \code{{d,p,r}msc} for the multivariate case. } In addition to the usual specification of their parameters as a sequence of individual components, a parameter set can be specified as a single \code{dp} entity, namely a vector in the univariate case, a list in the multivariate case; \code{dp} stands for \sQuote{Direct Parameters} (\acronym{DP}). Conversion from the \code{dp} parameter set to the corresponding Centred Parameters (\acronym{CP}) can be accomplished using the function \code{dp2cp}, while function \code{cp2dp} performs the inverse transformation. In addition, one can introduce a user-specified density function using \code{dSymmModulated} and \code{dmSymmModulated}, in the univariate and the multivariate case, respectively. These densities are of the \sQuote{symmetry-modulated} type, also called \sQuote{skew-symmetric}, where one can specify the base density and the modulation factor with high degree of flexibility. Random numbers can be sampled using the corresponding functions \code{rSymmModulated} and \code{rmSymmModulated}. In the bivariate case, a dedicated plotting function exists. } \item{SEC distribution objects}{% Function \code{makeSECdistr} can be used to build a \sQuote{\acronym{SEC} distribution} object representing a member of a specified parametric family (among the types \acronym{SN, ESN, ST, SC}) with a given \code{dp} parameter set. This object can be used for various operations such as plotting or extraction of moments and other summary quantities. Another way of constructing a \acronym{SEC} distribution object is via \code{extractSECdistr} which extracts suitable components of an object produced by function \code{selm} to be described below. Additional operations on these objects are possible in the multivariate case, namely \code{marginalSECdistr} and \code{affineTransSECdistr} for marginalization and affine trasformations. For the multivariate \acronym{SN} family only (but including \acronym{ESN}), \code{conditionalSECdistr} performs a conditioning on the values taken on by some components of the multivariate variable. } }} % end of Section `Probability side' \section{Statistics side}{% The main function for data fitting is represented by \code{selm}, which allows to specify a linear regression model for the location parameter, similarly to function \code{lm}, but assuming a \dfn{skew-elliptical} distribution; this explains the name \dfn{selm=(se+lm)}. Allowed types of distributions are \acronym{SN} (but not \acronym{ESN}), \acronym{ST} and \acronym{SC}. The fitted distribution is univariate or multivariate, depending on the nature of the response variable of the posited regression model. The model fitting method is either maximum likelihood or maximum penalized likelihood; the latter option effectively allows the introduction of a prior distribution on the slant parameter of the error distribution, hence leading to a \sQuote{maximum a posteriori} estimate. Once the fitting process has been accomplished, an object of class either \dfn{selm} (for univariate response) or \dfn{mselm} (for multivariate response) is produced. A number of \sQuote{methods} are available for these objects: \code{show}, \code{plot}, \code{summary}, \code{coef}, \code{residuals}, \code{logLik} and others. For univariate \dfn{selm}-class objects, univariate and bivariate profile log-likelihood functions can be obtained; a \code{predict} method also exists. These methods are built following the S4 protocol; however, the user must not be concerned with the choice of the adopted protocol (unless this is wished). The actual fitting process invoked via \code{selm} is actually performed by a set of lower-level procedures. These are accessible for direct call, if so wished, typically for improved efficiency, at the expense of a little additional programming effort. Similarly, functions to compute the Fisher information matrix are available, in the expected and the observed form (with some restrictions depending on the selected distribution). The \code{extractSECdistr} function extracts the fitted \acronym{SEC} distribution from \dfn{selm}-class and \dfn{mselm}-class objects, hence providing a bridge with the probability side of the package. } \section{Author}{Adelchi Azzalini. % Dipart. Scienze Statistiche, Università di Padova, Italia. Please send comments, error reports \emph{et cetera} to the author, whose web page is \url{http://azzalini.stat.unipd.it/}. } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \keyword{multivariate} \keyword{distribution} \keyword{univar} \keyword{regression} sn/man/sd.Rd0000644000176200001440000000130312504264237012344 0ustar liggesusers\name{sd} \title{Standard deviation} \alias{sd} \alias{sd.default} \description{ The \code{sd} function from the \pkg{stats} is replaced by a new \code{method} in order to introduce a separate method to deal with objects of class \code{SECdistrUv}. The function \code{sd.default} is an alias of the original function \code{\link[stats]{sd}}. } \usage{ sd(x, \dots) \method{sd}{default}(x, na.rm = FALSE, \dots) } \arguments{ \item{x}{a numeric vector, matrix or data frame.} \item{na.rm}{logical. Should missing values be removed?} \item{\dots}{further arguments passed to or from other methods.} } \seealso{ \code{\link[stats]{sd}}, \code{\linkS4class{SECdistrUv}} } \keyword{univar} sn/man/confint.selm.Rd0000644000176200001440000000647713077133067014360 0ustar liggesusers% file sn/man/profile.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2016 Adelchi Azzalini %--------------------- \name{confint.selm} \alias{confint.selm} \alias{confint.selm-method} \concept{confidence interval} \title{Confidence intervals for parameters of a selm-class object} \description{ Computes confidence intervals for parameters in a selm-class object produces by \code{selm} fit when the response variable is univariate.} \usage{ \S3method{confint}{selm}(object, parm, level=0.95, param.type, tol=1e-3, ...) } \arguments{ \item{object}{an object of class \code{selm} as produced by a call to function \code{selm} with univariate response.} \item{parm}{a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered.} \item{level}{the confidence level required (default value is \code{0.95}).} \item{param.type}{ a character string with the required parameterization; it must be either \code{"CP"} or \code{"DP"} or \code{"pseudo-CP"}, or possibly their equivalent lowercase.} \item{tol}{the desired accuracy (convergence tolerance); this is a parameter passed to \code{\link[stats]{uniroot}} for computing the roots of the likelihood-based confidence interval for \code{alpha}.} \item{...}{not used, only there for compatibility reasons.} } \details{ A description of the methodology underlying \code{confint.selm} is provided in the technical note of Azzalini (2016). That document also explains why in certain cases an interval is not constructed and \code{NA}'s are returned as endpoint.} \value{An invisible list whose components, described below, are partly different in the one- and the two-parameter cases. \item{call}{the calling statement} \item{}{values of the first parameter} \item{}{values of the second parameter (in a two-parameter case)} \item{logLik}{numeric vector or matrix of the profile log-likelihood values} \item{confint}{in the one-parameter case, the confidence interval} \item{level}{in the one-parameter case, the confidence level} \item{deviance.contour}{in the two-parameter case, a list of lists whose elements identify each curve of the contour plot} } \author{Adelchi Azzalini} \references{ Azzalini, A. (2016). Derivation of various types of intervals from a \code{selm} object. Technical note distributed with the documentation of the \R package \code{sn} in file \href{../doc/selm-intervals.pdf}{\code{selm-intervals.pdf}} within section \sQuote{User guide, package vignettes and other documentation}. % Azzalini, A. with the collaboration of Capitanio, A. (2014). % \emph{The Skew-Normal and Related Families}. % Cambridge University Press, IMS Monographs series. } % \note{} \seealso{ \code{\link{selm}}, \code{\link{summary.selm}}, \code{\link{profile.selm}}, \code{\link{makeSECdistr}} for the \acronym{CP}/\acronym{DP} parameterizations, \code{\link[stats]{uniroot}} for its \code{tol} argument } \examples{ data(ais) m1 <- selm(log(Fe) ~ BMI + LBM, family = "sn", data = ais) intervCP <- confint(m1) intervDP <- confint(m1, param.type="DP") confint(m1, parm=2:3) confint(m1, parm=c("omega", "alpha"), param.type="DP") } sn/man/affineTransSECdistr.Rd0000644000176200001440000000605113203256502015575 0ustar liggesusers% file sn/man/affineTransSECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{affineTransSECdistr} \alias{marginalSECdistr} \alias{affineTransSECdistr} \title{Affine transformations and marginals of a skew-elliptical distribution} \description{ Given a multivariate random variable \eqn{Y} with skew-elliptical (\acronym{SEC}) distribution, compute the distribution of a (possibly multivariate) marginal or the distribution of an affine transformation \eqn{a + A^{\top}Y}{a + A'Y}.} \usage{ affineTransSECdistr(object, a, A, name, compNames, drop=TRUE) marginalSECdistr(object, comp, name, drop=TRUE) } \arguments{ \item{object}{an object of class \code{SECdistrMv} which identifies the source random variable, as created by \code{\link{makeSECdistr}} or by \code{\link{extractSECdistr}} or by a previous call to these functions} \item{a}{a numeric vector with the length \code{ncol(A)}.} \item{A}{a full-rank matrix with \code{nrow(A)} equal to the dimensionality \kbd{d} of the random variable identified by \code{object}. } \item{name}{an optional character string representing the name of the outcome distribution; if missing, one such string is constructed.} \item{compNames}{an optional vector of length \code{ncol(A)} of character strings with the names of the components of the outcome distribution; if missing, one such vector is constructed.} \item{drop}{a logical flag (default value: \code{TRUE}), operating only if the returned object has dimension \code{d=1}, in which case it indicates whether this object must be of class \code{SECdistrUv}.} \item{comp}{a vector formed by a subset of \code{1:d} which indicates which components must be extracted from \code{object}, on denoting by \code{d} its dimensionality.} } \value{If \code{object} defines the distribution of a \acronym{SEC} random variable \eqn{Y}, \code{affineTransSECdistr} computes the distribution of \eqn{a+A'Y} and \code{marginalSECdistr} computes the marginal distribution of the \code{comp} components. In both cases the returned object is of class \code{SECdistrMv}, except when \code{drop=TRUE} operates, leading to an object of class \code{SECdistrUv}.} \section{Background}{These functions implement formulae given in Sections 5.1.4, 5.1.6 and 6.2.2 of the reference below.} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{\code{\link{makeSECdistr}}, \code{\link{extractSECdistr}}, \code{\link{SECdistrMv-class}}} \examples{ dp3 <- list(xi=1:3, Omega=toeplitz(1/(1:3)), alpha=c(3,-1,2), nu=5) st3 <- makeSECdistr(dp3, family="ST", name="ST3", compNames=c("U", "V", "W")) A <- matrix(c(1,-1,1, 3,0,-2), 3, 2) new.st <- affineTransSECdistr(st3, a=c(-3,0), A=A) # st2 <- marginalSECdistr(st3, comp=c(3,1), name="2D marginal of ST3") } \keyword{multivariate} \keyword{distribution} sn/man/conditionalSECdistr.Rd0000644000176200001440000000374712255403507015656 0ustar liggesusers% file sn/man/conditionalSECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{conditionalSECdistr} \alias{conditionalSECdistr} \title{Skew-normal conditional distribution} \description{For a multivariate (extended) skew-normal distribution, compute its conditional distribution for given values of some of its components.} \usage{ conditionalSECdistr(object, fixed.comp, fixed.values, name, drop = TRUE) } \arguments{ \item{object}{an object of class \code{SECdistrMv} with \code{family="SN"} or \code{family="ESN"}. } \item{fixed.comp}{a vector containing a subset of \code{1:d} which selects the components whose values are to be fixed, if \code{d} denotes the dimensionality of the distribution.} \item{fixed.values}{a numeric vector of values taken on by the components \code{fixed.comp}; it must be of the same length of \code{fixed.comp}.} \item{name}{an optional character string with the name of the outcome distribution; if missing, one such string is constructed.} \item{drop}{logical (default=\code{TRUE}), to indicate whether the returned object must be of class \code{SECdistrUv} when \code{length(fixed.comp)+1=d}.} } \value{an object of class \code{SECdistrMv}, except in the case when \code{drop=TRUE} operates, leading to an object of class \code{SECdistrUv-class}.} \details{For background information, see Section 5.3.2 of the reference below.} \references{ Azzalini, A. and Capitanio, A. (2014). \emph{The Skew-normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{\code{\link{makeSECdistr}}, \code{\link{SECdistrMv-class}}, \code{\link{affineTransSECdistr}} } \examples{ Omega <- diag(3) + outer(1:3,1:3) sn <- makeSECdistr(dp=list(xi=rep(0,3), Omega=Omega, alpha=1:3), family="SN") esn <- conditionalSECdistr(sn, fixed.comp=2, fixed.values=1.5) show(esn) } \keyword{multivariate} \keyword{distribution} sn/man/modeSECdistr.Rd0000644000176200001440000000416713047130405014266 0ustar liggesusers% file sn/man/mmodeSECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{modeSECdistr} \alias{modeSECdistr} \title{The mode of a skew-elliptically contoured (\acronym{SEC}) distribution} \description{ Compute compute the mode of a univariate or multivariate \acronym{SEC} distribution.} \usage{ modeSECdistr(dp, family, object=NULL) } \arguments{ \item{dp}{ a numeric vector (in the univariate case, for class \code{SECdistrUv}) or a list (in the multivariate case, , for class \code{SECdistrUv}) of parameters which identify the specific distribution within the named \code{family}. } \item{family}{a character string which identifies the parametric family among those admissible for classes \code{SECdistrUv} or \code{SECdistrMv}.} \item{object}{an object of class \code{SECdistrUv} or \code{SECdistrMv} as created by \code{\link{makeSECdistr}} or \code{\link{extractSECdistr}.} } } \value{a numeric vector} \section{Background}{The mode is obtained through numerical maximization. In the multivariate case, the problem is reduced to a one-dimensional search using Propositions 5.14 and 6.2 of the reference below.} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{\code{\link{makeSECdistr}} and \code{\link{extractSECdistr}} for additional information and for constructing a suitable \code{object}, \code{\link{SECdistrUv-class}} and \code{\link{SECdistrMv-class}} for methods \code{mean} and \code{vcov} which compute the mean (vector) and the variance (matrix) of the \code{object} distribution } \examples{ dp3 <- list(xi=1:3, Omega=toeplitz(1/(1:3)), alpha=c(3,-1,2), nu=5) st3 <- makeSECdistr(dp3, family="ST", name="ST3", compNames=c("U", "V", "W")) A <- matrix(c(1,-1,1, 3,0,-2), 3, 2) new.st <- affineTransSECdistr(st3, a=c(-3,0), A=A) # st2 <- marginalSECdistr(st3, comp=c(3,1), name="2D marginal of ST3") } \keyword{multivariate} \keyword{distribution} sn/man/plot.selm.Rd0000644000176200001440000001520112436650113013651 0ustar liggesusers% file sn/man/plot.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{plot.selm} \alias{plot.selm} \alias{plot.mselm} \alias{plot,selm-method} \alias{plot,mselm-method} \concept{QQ-plot} \title{Diagnostic plots for \code{selm} fits} \description{Diagnostic plots for objects of class \code{selm} and \code{mselm} generated by a call to function \code{selm}} \usage{ \S4method{plot}{selm}(x, param.type="CP", which = c(1:4), caption, panel = if (add.smooth) panel.smooth else points, main = "", ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(x@residuals.dp), cex.id = 0.75, identline = TRUE, add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) \S4method{plot}{mselm}(x, param.type="CP", which, caption, panel = if (add.smooth) panel.smooth else points, main = "", ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(x@residuals.dp), cex.id = 0.75, identline = TRUE, add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) } \arguments{ \item{x}{an object of class \code{selm} or \code{mselm}.} \item{param.type}{a character string which selects the type of residuals to be used for some of of the plots; possible values are: \code{"CP"} (default), \code{"DP"}, \code{"pseudo-CP"}. The various type of residuals only differ by an additive term; see \sQuote{Details} for more information.} \item{which}{if a subset of the plots is required, specify a subset of \code{1:4}; see \sQuote{Details} for a description of the plots.} \item{caption}{a vector of character strings with captions to appear above the plots.} \item{panel}{panel function. The useful alternative to \code{points}, \code{panel.smooth} can be chosen by \code{add.smooth = TRUE}.} \item{main}{title to each plot, in addition to the above caption.} \item{ask}{logical; if \code{TRUE}, the user is asked before each plot.} \item{\dots}{other parameters to be passed through to plotting functions.} % see \sQuote{Details} for restrictions.} \item{id.n}{number of points to be labelled in each plot, starting with the most extreme.} \item{labels.id}{vector of labels, from which the labels for extreme points will be chosen. \code{NULL} uses observation numbers..} \item{cex.id}{magnification of point labels.} \item{identline}{logical indicating if an identity line should be added to QQ-plot and PP-plot (default: \code{TRUE}).} \item{add.smooth}{logical indicating if a smoother should be added to most plots; see also \code{panel} above.} \item{label.pos}{ positioning of labels, for the left half and right half of the graph respectively, for plots 1-3.} \item{cex.caption}{controls the size of \code{caption}.} } \details{ The meaning of \code{param.type} is described in \code{\link{dp2cp}}. However, for these plot only the first parameter component is relevant, which affects the location of the residuals; the other components are not computed. Moreover, for \acronym{QQ}-plot and \acronym{PP}-plot, \acronym{DP}-residuals are used irrespectively of \code{param.type}; see Section \sQuote{Background}. % Graphical parameters can be specified via \code{\dots}, but not those % specified by the function: \code{xlab}, \code{ylab}, \code{cex}. Values \code{which=1} and \code{which=2} have a different effect for object of class \code{"selm"} and class \code{"mselm"}. In the univariate case, \code{which=1} plots the residual values versus the fitted values if \code{p>1}, where \code{p} denotes the number of covariates including the constant; if \code{p=1}, a boxplot of the response is produced. Value \code{which=2} produces an histogram of the residuals with superimposed the fitted curve, when \code{p>1}; if \code{p=1}, a similar plot is generated using the response variable instead of the residuals. Default value for \code{which} is \code{1:4}. In the multivariate case, \code{which=1} is feasible only if \code{p=1} and it displays the data scatter with superimposed the fitted distribution. Value \code{which=2} produces a similar plot but for residuals instead of data. Default value for code{which} is \code{2:4} if \code{p>1}, otherwise \code{c(1,3,4)}. Value \code{which=3} produces a QQ-plot, both in the univariate and in the multivariate case; the difference is that the squares of normalized residuals and suitably defined Mahalanobis distances, respectively, are used in the two cases. Similarly, \code{which=4} produces a PP-plot, working in a similar fashion.} \section{Background}{ Healy-type graphical diagnostics, in the form of QQ- and PP-plots, for the multivariate normal distribution have been extended to the skew-normal distribution by Azzalini and Capitanio (1999, section 6.1), and subsequently to the skew-\eqn{t} distribution in Azzalini and Capitanio (2003). A brief explanation in the univariate \acronym{SN} case is provided in Section 3.1.1 of Azzalini and Capitanio (2014); see also Section 3.1.6. For the univariate \acronym{ST} case, see p.102 and p.111 of the monograph. The multivariate case is discussed in Section 5.2.1 as for the \acronym{SN} distribution, in Section 6.2.6 as for the \acronym{ST} distribution. } \references{ Azzalini, A. and Capitanio, A. (1999). Statistical applications of the multivariate skew normal distribution. \emph{J.Roy.Statist.Soc. B} \bold{61}, 579-602. Full-length version available at \url{http://arXiv.org/abs/0911.2093} Azzalini, A. and Capitanio, A. (2003). Distributions generated by perturbation of symmetry with emphasis on a multivariate skew \emph{t} distribution. \emph{J.Roy. Statist. Soc. B} \bold{65}, 367-389. Full-length version available at \url{http://arXiv.org/abs/0911.2342} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{\code{\link{selm}}, \code{\link{dp2cp}}} \examples{ data(wines) # m10 <- selm(flavanoids ~ 1, family="SN", data=wines, subset=(wine=="Barolo")) plot(m10) plot(m10, which=c(1,3)) # fig 3.1 and 3.2(a) of Azzalini and Capitanio (2014) # m18 <- selm(acidity ~ sugar + nonflavanoids + wine, family="SN", data=wines) plot(m18) plot(m18, param.type="DP") # m28 <- selm(cbind(acidity, alcohol) ~ sugar + nonflavanoids + wine, family="SN", data=wines) plot(m28, col=4) # data(ais) m30 <- selm(cbind(RCC, Hg, Fe) ~ 1, family="SN", data=ais) plot(m30, col=2, which=2) } \author{Adelchi Azzalini} \keyword{hplot} sn/man/symm-modulated-distr.Rd0000644000176200001440000002715413202407456016034 0ustar liggesusers% file sn/man/symm-modulated-distr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2017 Adelchi Azzalini %--------------------- \name{symm-modulated-distr} \encoding{UTF-8} \alias{SymmModulatedDistr} \alias{dSymmModulated} \alias{rSymmModulated} \alias{dmSymmModulated} \alias{rmSymmModulated} \alias{plot2D.SymmModulated} \concept{symmetry-modulated distribution} \concept{skew-symmetric distribution} \title{Symmetry-modulated distributions} \description{Symmetry-modulated distributions, univariate and multivariate, AKA skew-symmetric distributions} \usage{ dSymmModulated(x, xi=0, omega=1, f0, G0, w, par.f0, par.G0, odd="check", log=FALSE, ...) rSymmModulated(n=1, xi=0, omega=1, f0, G0, w, par.f0, par.G0, odd="check", ...) dmSymmModulated(x, xi, Omega, f0, G0, w, par.f0, par.G0, odd="check", log=FALSE, ...) rmSymmModulated(n=1, xi, Omega, f0, G0, w, par.f0, par.G0, odd="check", ...) plot2D.SymmModulated(range, npt=rep(101,2), xi=c(0,0), Omega, f0, G0, w, par.f0, par.G0, odd="check", ...) } \arguments{ \item{x}{a vector of coordinates where the density must be evaluated; for multivariate densities, evaluated by \code{dmSymmModulated}, a matrix is also allowed, each row representing a point.} \item{xi}{a numeric vector representing the location parameter; if must have length 1 for \code{dSymmModulated} and \code{rSymmModulated}, length 2 for \code{plot2D.SymmModulated}).} \item{omega}{a positive value representing the scale parameter.} \item{f0}{a character string denoting the symmetric density to be modulated; admissible values for \code{dSymmModulated} and \code{dSymmModulated} are \code{"beta"}, \code{"cauchy"}, \code{"logistic"} (or \code{"logis"}), \code{"normal"} (or \code{"norm"}), \code{"t"}, \code{"uniform"}; for the other functions the possible values are \code{"cauchy"}, \code{"normal"} (or \code{"norm"}), \code{"t"}; the meaning of the names is described in the \sQuote{Details} section.} \item{G0}{a character string denoting the symmetric distribution used in the modulating factor; admissible values are \code{"beta"}, \code{"cauchy"}, \code{"logistic"} (or \code{"logis"}), \code{"normal"} (or \code{"norm"}), \code{"t"}, \code{"uniform"}, with meaning described in the \sQuote{Details} section.} \item{w}{the name (\emph{not} as a character string) of a user-defined function which satisfies the condition \eqn{w(-z)=-w(z)} for all \eqn{z}; see the \sQuote{Details} section for additional specifications.} \item{par.f0, par.G0}{parameters required by \code{f0} and \code{G0}, when they are of type \code{"beta"} or \code{"t"}, otherwise ignored.} \item{odd}{a character string, with possible values \code{"check"} (default), "assume", "force", for regulation of the behaviour about the condition that \code{w} is an odd function, as explained in the \sQuote{Details} section.} \item{log}{logical (default: \code{FALSE}); if \code{TRUE}, densities are given as log(densities).} \item{n}{an integer value (default: \code{n=1}) indicating the number of random numbers.} \item{Omega}{a symmetric positive-definite matrix which regulates the dependence structure of \code{f0} and so of the final density.} \item{range}{a two-column matrix whose column-wise range is taken as the plotting intervals on the coordinated axes forming a bivariate grid of points over which the density is plotted.} \item{npt}{a numeric vector with two elements representing the number of equally-spaced points on each axis spanning the \code{range} described above; default value is \code{rep(101,2)}.} \item{\dots}{optional parameters regulating the function \code{w} and, for \code{plot2D.SymmModulated} only, graphical parameters to be supplied to function \code{\link[graphics]{contour}}. } } \section{Background}{ In the univariate case, start from symmetric density function \eqn{f_0}{f₀}, such that \eqn{f_0(z)=f_0(-z)}{f₀(z)=f₀(-z)} for all \eqn{z}, and \sQuote{modulate} it in the form \deqn{f(z) = 2\, f_0(z)\, G_0\{w(z)\}}{f(z) = 2 f₀(z) G₀\{w(z)\} } where \eqn{G_0}{G₀} is a univariate symmetric (about 0) distribution function and \eqn{w(z)}is a real-valued odd function, hence satisfying the condition \eqn{w(-z)=-w(z)}; then $f(z)$ is a proper density function wich integrates to 1. A subsequent location and scale transformation applied to \eqn{f(z)} delivers the final density. Specifically, if \eqn{Z} denotes a univariate random variable with density \eqn{f(z)}, then the computed density pertains to the transformed variable \deqn{\xi + \omega Z.} In the multivariate case, the scheme is similar, with natural adaptation. Density \eqn{f_0}{f₀} is now \eqn{d}-dimensional, while \eqn{G_0}{G₀} is still univariate. The conditions \eqn{f_0(z)=f_0(-z)}{f₀(z)=f₀(-z)} and \eqn{w(-z)=-w(z)} refer to a \eqn{d}-dimensional vector \eqn{z}. Given a \eqn{d \times d}{d x d} symmetric positive-definite matrix \eqn{\Omega}, we extract the the square roots \eqn{\omega} of the diagonal element of \eqn{\Omega} and correspondingly obtain the scale-free matrix \deqn{\bar\Omega = \mathrm{diag}(\omega)^{-1}\, \Omega\, \mathrm{diag}(\omega)^{-1} }{cov(\Omega) = diag(\omega)⁻¹ \Omega diag(\omega)⁻¹} which is used to regulate the dependence structure of \eqn{f_0(z)}{f₀(z)} and so of \eqn{f(z)}. If \eqn{Z} is multivariate random variable with density \eqn{f(z)}, then the final distribution refers to \deqn{\xi + \mathrm{diag}(\omega)\,Z }{\xi + diag(\omega) Z } where \eqn{\xi} is a \eqn{d}-dimensional vector of location parametes. This construction was put forward by Azzalini and Capitanio (2003). An essentially equivalent formulation has been presented by Wang et al. (2004). A summary account is available in Section 1.2 of Azzalini and Capitanio (2014); this includes, inter alia, an explanation of why the term \sQuote{symmetry-modulated} distributions is preferred to \sQuote{skew-symmetric} distributions. Random number generation is based on expression (1.11a) of Azzalini and Capitanio (2014). } \section{Details}{ Functions \code{dSymmModulated} and \code{rSymmModulated} deal with univariate distributions, for computing densities and generating random rumbers, respectively; \code{dmSymmModulated} and \code{rmSymmModulated} act similarly for multivariate distributions. For the bivariate case only, \code{plot2D.SymmModulated} computes a density over a grid of coordinates and produces a \code{contour} plot. The distribution names used in \code{f0} and \code{G0} have, in the univariate case, the same meaning as described in the \code{\link[stats]{Distributions}} page, with the following exceptions, to achive symmetry about 0: \code{"uniform"} denotes a uniform distribution over the interval \eqn{(-1, 1)}; \code{"beta"} denotes the a symmetric Beta distribution with support over the interval \eqn{(-1, 1)} and a common value of the shape parameters. In the multivariate case, the available options \code{"normal"} and \code{"t"} for \code{f0} refer to densities computed by \code{\link[mnormt]{dmnorm}} and \code{\link[mnormt]{dmt}} with 0 location and correlation matrix \eqn{\bar\Omega}{cor(\Omega)}, implied by \eqn{\Omega}. Argument \code{G0} has the same meaning as in the univariate case. Options \code{"beta"} and \code{"t"} for \code{f0} and \code{G0} require the specification of a shape parameter, via the arguments \code{par.f0} and \code{par.G0}, respectively. For \code{"beta"} the parameter represents the common value of the shape parameters of \code{\link[stats]{Beta}}; for \code{"t"}, it represents \code{df} of \code{\link[stats]{TDist}} and \code{\link[mnormt]{dmt}}. Function \code{w} most be of the form \code{w <- function(z, ...)} where \code{...} are optional additional parameters and \code{z} represents valued of the standardized form of the density; in the univariate case, \code{x} and \code{z} are related by \code{z=(x-xi)/omega} and an analogous fact holds in the multivariate setting. The function must satisfy the condition \eqn{w(-z)=-w(z)}. It is assumed that the function is vectorized and, in the multivariate case, it will be called with \code{z} representing a matrix with \code{d} columns, if \code{d} denotes the dimensionality of the random variable. Argument \code{odd} regulates the behaviour with respect to the condition \eqn{w(-z)=-w(z)}. If its value is \code{"assume"}, the condition is just assumed to hold, and no action is taken. If the value is \code{"check"} (deafult), a \emph{limited} check is performed; namely, in case of densities, the check is at 0 and the supplied \code{x} points, while for random numbers the check is at 0 and the generated points. The value \code{"force"} ensures that the condition is satisfied by actually constructing a modified version of the user-supplied function \code{w}, such that the required condition is enforced. } \value{ For \code{dSymmModulated}, \code{rSymmModulated} and \code{dmSymmModulated}, a numeric vector; for \code{dmSymmModulated} a matrix, unless \code{n=1}. For \code{plot2D.SymmModulated} an invisible list containing the \code{x} and \code{y} coordinates forming the grid over which the density \code{pdf} has been evaluated for plotting. } \author{Adelchi Azzalini} \references{ Arellano-Valle, R. B., Gómez, H. W. and Quintana, F. A. (2004). A new class of skew-normal distributions. \emph{Comm. Stat., Theory & Methods}, \bold{58}, 111-121. Azzalini, A. and Capitanio, A. (2003). Distributions generated by perturbation of symmetry with emphasis on a multivariate skew-\emph{t} distribution. \emph{J.Roy. Statist. Soc. B} \bold{65}, 367--389. Full version of the paper at \url{http://arXiv.org/abs/0911.2342} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Wang, J., Boyer, J. and Genton, M. G. (2004). A skew-symmetric representation of multivariate distributions. \emph{Statistica Sinica}, \bold{14}, 1259-1270. } \seealso{ \code{\link[stats]{Distributions}}, \code{\link[stats]{Beta}}, \code{\link[stats]{TDist}}, \code{\link[mnormt]{dmnorm}}, \code{\link[mnormt]{dmt}}, \code{\link[graphics]{contour}} } \examples{ x <- seq(2, 13, length=45) wLinear <- function(z, lambda) lambda*z y <- dSymmModulated(x, 5, 2, f0="normal", G0="normal", w=wLinear, lambda=3) # the same of dsn(x, 5, 2, 3), up to negligible numerical differences # wSGN <- function(z, lambda) z*lambda[1]/sqrt(1 + lambda[2]*z^2) y <- dSymmModulated(x, 5, 2, f0="normal", G0="normal", w=wSGN, lambda=c(3,5)) # SGN distribution of Arellano-Valle et al. (2004) # wST <- function(z, lambda, nu) lambda*z*sqrt((nu+1)/(nu+z^2)) y <- rSymmModulated(n=100, 5, 2, f0="t", G0="t", w=wST, par.f0=8, par.G0=9, lambda=3, nu=8) # equivalent to rst(n=100, 5, 2, 3, 8) # wTrigs <- function(z, p, q) sin(z * p)/(1 + cos(z * q)) x <- seq(-1, 1, length=51) y <- dSymmModulated(x, 0, 1, f0="beta", G0="logistic", w=wTrigs, par.f0=2, par.G0=NULL, p=5, q=0.5) plot(x, y, type="l") # univariate analogue of the bivariate distribution on pp.372-3 of # Azzalini & Capitanio (2003) # range <- cbind(c(-3,3), c(-3,3)) wMvTrigs <- function(z, p, q) sin(z \%*\% p)/(1 + cos(z \%*\% q)) plot2D.SymmModulated(range, xi=c(0,0), Omega=diag(2), f0="normal", G0="normal", w=wMvTrigs, par.f0=NULL, par.G0=NULL, p=c(2,3), q=c(1,1), col=4) # w(.) as in (1.6) of Azzalini & Capitanio (2014, p.4) and plot as in # bottom-right panel of their Figure 1.1. } \keyword{distributions} \keyword{hplot} sn/man/sn-package.Rd0000644000176200001440000001575213203251365013757 0ustar liggesusers% file sn/man/sn-package.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{sn-package} \docType{package} \encoding{UTF-8} \alias{sn-package} \alias{SN} \concept{skew-elliptical distribution} \concept{skew-normal distribution} \concept{skew-t distribution} \concept{symmetric distribution} \concept{symmetry-modulated distribution} \title{Package \pkg{sn}: development and brief overview} \description{ The \pkg{sn} package provides facilities to define and manipulate probability distributions of the skew-normal (\acronym{SN}) family and some related ones, notably the skew-\eqn{t} (\acronym{ST}) family, and to apply connected statistical methods for data fitting and diagnostics, in the univariate and the multivariate case. } \section{Development and basic facts}{% The first version of the package was written in 1997 (on CRAN since 1998); subsequent versions have evolved gradually up to version 0.4-18 in May 2013. In January 2014, version 1.0-0 has been uploaded to CRAN; this represented a substantial re-writing of the earlier \sQuote{version 0.x}. Differences between the \sQuote{version 0} and the \sQuote{version 1} series are radical; they concern the core computational and graphical part as well as the user interface. Since version 1.0-0, the S4 protocol for classes and methods has been adopted. Broadly speaking, the available tools can be divided in two groups: the probability section and the statistics section. For a quick start, one could look at their key functions, \code{\link{makeSECdistr}} and \code{\link{selm}}, respectively, and from here explore the rest. In the probability section, one finds also functions \code{\link{dsn}}, \code{\link{dst}}, \code{\link{dmsn}} and others alike; these functions existed also in \sQuote{version 0} and their working is still very much the same (not necessarily so their code). Additional information on the current package structure and the set of commands is available in a more extended \code{\link[=pkg-overview]{overview}} of the package. The first instance of the \sQuote{version 1} series (that is, 1.0-0) has appeared at the same time when the companion book by Azzalini and Capitanio (2014) was published. Although the two projects are formally separate, they adopt the same notation, terminology and logical frame. This matching and the numerous references in the software documentation to specific sections of the book for background information should facilitate familiarizing with these tools. Information on additional and on more recent change to the package is provided in \code{NEWS} file, accessible from the package documentation index page. A word of explanation is appropriate about the numerous references to Azzalini and Capitanio (2014) in the documentation of the package. The reason why the documentation often refers to the monograph rather than to the original research papers is because the book provides a relatively informal summary of material which has been elaborated in a number of technical papers, sometimes very technical or with information on the point of interest mixed with other material. In other words, the motivation behind this policy is readibility, not indulgence in self-citation. When one or a few original sources appeared to deliver the required information in a compact and accessible form, they have been cited directly. In any case, the quoted sections of the book include bibliographic notes which refer back to the original sources. } \section{Backward Compatibility of \sQuote{version 1.x-y}}{% There is a partial backward compatibility of \sQuote{version 1.x-y} versus \sQuote{version 0-4.18}. Some functions of the older version would work as before with virtually no change; a wider set arguments is now allowed. Functions \code{\link{dsn}}, \code{\link{dst}}, \code{\link{dmsn}} and alike fall in this category: in some cases, the names of the arguments have been altered, but they work as before if called with unnamed arguments; similar cases are \code{\link{msn.mle}}, \code{\link{sn.cumulants}} and \code{\link{T.Owen}}. Notice, however, that \code{\link{msn.mle}} and other fitting functions have effectively been subsumed into the more comprehensive fitting function \code{\link{selm}}. A second group of functions will work with little or even minimal changes. Specific examples are functions \code{sn.mle} and \code{st.mle} which have become \code{\link{sn.mple}} and \code{\link{st.mple}}, with some additional arguments (again, one can achieve the same result via \code{\link{selm}}). Another example is constitude by the group of functions \code{dp.to.cp}, \code{cp.to.dp} and \code{st.cumulants.inversion}, which have been replaced by the more general functions \code{\link{dp2cp}} and \code{\link{cp2dp}}; one only needs to pay attention to conversion from 3rd and 4th order cumulants to their standardized form in connection with the replacement of \code{st.cumulants.inversion}. Finally, some functions are not there any longer, with no similarly-working functions in the new version. This is the case of \code{sn.mle.grouped} and \code{st.mle.grouped} for maximum likelihood estimation from grouped data, that is, data recorded as intervals and corresponding frequencies.} \section{Requirements}{ \R version 2.15-3 or higher, plus packages \pkg{mnormt}, \pkg{numDeriv}, \pkg{stats4} in addition to standard packages (\pkg{methods}, \pkg{graphics}, etc.) } \section{Version}{ The command \code{citation("sn")} indicates, among other information, the running version of the package. The most recent version of the package can be obtained from the web page: \url{http://azzalini.stat.unipd.it/SN} which also provides related material. From the above-indicated web page, one can also obtain the package \sQuote{sn0} which is essentially the last \sQuote{version 0} (that is, 0.4-18) with suitable renaming of certain ingredients. This allows to have both the current and the old package installed at the same time. } \section{Author}{Adelchi Azzalini. % Dipart. Scienze Statistiche, Università di Padova, Italia. Please send comments, error reports \emph{et cetera} to the author, whose web page is \url{http://azzalini.stat.unipd.it/}. } \section{Licence}{ This package and its documentation are usable under the terms of the \dQuote{GNU General Public License} version 3 or version 2, as you prefer; a copy of them is available from \url{https://www.R-project.org/Licenses/}. While the software is freely usable, it would be appreciated if a reference is inserted in publications or other work which makes use of it. For the appropriate way of referencing it, see the command \code{citation("sn")}. } \seealso{\code{\link[=pkg-overview]{package-overview}} } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \keyword{multivariate} \keyword{distribution} \keyword{univar} \keyword{regression} sn/man/SECdistrUv-class.Rd0000644000176200001440000000467212504265255015051 0ustar liggesusers% file sn/man/SECdistrUv-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{SECdistrUv-class} \Rdversion{1.1} \docType{class} \alias{SECdistrUv-class} \alias{show,SECdistrUv-method} \alias{mean,SECdistrUv-method} \alias{sd,SECdistrUv-method} \title{Class \code{"SECdistrUv"}} \description{Univariate skew-elliptically contoured distributions} \section{Objects from the class}{ Objects can be created by a call to function \code{\link{makeSECdistr}} when its argument \code{dp} is a vector. They can also obtained from an object generated by \code{selm} using the function \code{extractSEDdistr}. } \section{Slots}{ \describe{ \item{\code{family}:}{a character string which selects the parametric family; currently, possible values are: \kbd{"SN"}, \kbd{"ESN"}, \kbd{"ST"}, \kbd{"SC"}. } \item{\code{dp}:}{a numeric vector of parameters; its length depends on the selected \code{family}.} \item{\code{name}:}{a character string with name of the distribution.} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "SECdistrUv")}: \dots} \item{plot}{\code{signature(x = "SECdistrUv")}: \dots } \item{summary}{\code{signature(object = "SECdistrUv")}: \dots} \item{mean}{\code{signature(x = "SECdistrUv")}: \dots} \item{sd}{\code{signature(object = "SECdistrUv")}: \dots} } } \author{Adelchi Azzalini} \note{ See \code{\link{makeSECdistr}} for a detailed description of \code{family} and \code{dp}. Unlike various other packages, methods \code{mean} and \code{sd} here are not targeted to data or to a fitted model, but to a \emph{probability distribution} instead, of which they provide the mean value and the standard deviation. If these methods are applied to a distribution of which the mean or the variance do not exist, a \code{NULL} value is returned and a warning message is issued. } \seealso{ \code{\linkS4class{SECdistrMv}}, \code{\link{plot,SECdistrUv-method}}, \code{\link{summary,SECdistrUv-method}}, \code{\link{extractSECdistr}} } \examples{ f2 <- makeSECdistr(dp=c(3, 5, -pi, 6), family="ST", name="My first ST") show(f2) plot(f2) plot(f2, probs=c(1,5,9)/10) plot(f2, range=c(-30,10), probs=NULL, col=2, main=NULL) summary(f2) mean(f2) # the mean value of the probability distribution sd(f2) # the standard deviation of the distribution } \keyword{classes} sn/man/zeta.Rd0000644000176200001440000000464013047132121012675 0ustar liggesusers% file sn/man/zeta.Rd % This file is a component of the package 'sn' for R % copyright (C) 1998,2013 Adelchi Azzalini %--------------------- \name{zeta} \alias{zeta} \concept{Mills ratio} \title{Function \eqn{\log(2\,\Phi(x))}{log(2*Phi(x))} and its derivatives} \description{The function \code{log(2*pnorm(x))} and its derivatives, including inverse Mills ratio.} \usage{zeta(k, x)} \arguments{ \item{k}{an integer number between 0 and 5.} \item{x}{a numeric vector. Missing values (\code{NA}s) and \code{Inf}s are allowed.} } \value{a vector representing the \code{k}-th order derivative evaluated at \code{x}.} \details{ For \code{k} between 0 and 5, the derivative of order \code{k} of \eqn{\log(2\,\Phi(x))}{log(2\Phi(x))} is evaluated, where \eqn{\Phi(x)} denotes the \eqn{N(0,1)} cumulative distribution function. The derivative of order \code{k=0} refers to the function itself. If \code{k} is not integer, it is converted to integer and a warning message is generated. If \code{k<0} or \code{k>5}, \code{NULL} is returned. } \section{Background}{ The computation for \code{k>1} is reduced to the case \code{k=1}, making use of expressions given by Azzalini and Capitanio (1999); see especially Section 4 of the full-length version of the paper. The main facts are summarized in Section 2.1.4 of Azzalini and Capitanio (2014). For numerical stability, the evaluation of \code{zeta(1,x)} when \code{x < -50} makes use of the asymptotic expansion (26.2.13) of Abramowitz and Stegun (1964). \code{zeta(1,-x)} equals \code{dnorm(x)/pnorm(-x)} (in principle, apart from the above-mentioned asymptotic expansion), called the \emph{inverse Mills ratio}. } \references{ Abramowitz, M. and Stegun, I. A., editors (1964). \emph{Handbook of Mathematical Functions}. Dover Publications. Azzalini, A. and Capitanio, A. (1999). Statistical applications of the multivariate skew normal distribution. \emph{J.Roy.Statist.Soc. B} \bold{61}, 579--602. Full-length version available at \url{http://arXiv.org/abs/0911.2093} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \examples{ y <- zeta(2,seq(-20,20,by=0.5)) # for(k in 0:5) curve(zeta(k,x), from=-1.5, to=5, col = k+2, add = k > 0) legend(3.5, -0.5, legend=as.character(0:5), col=2:7, lty=1) } \keyword{math} sn/man/dsc.Rd0000644000176200001440000000531512354763532012523 0ustar liggesusers% file sn/man/dsc.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{dsc} \alias{dsc} \alias{psc} \alias{qsc} \alias{rsc} \title{Skew-Cauchy Distribution} \description{Density function, distribution function, quantiles and random number generation for the skew-Cauchy (SC) distribution.} \usage{ dsc(x, xi = 0, omega = 1, alpha = 0, dp = NULL, log = FALSE) psc(x, xi = 0, omega = 1, alpha = 0, dp = NULL) qsc(p, xi = 0, omega = 1, alpha = 0, dp = NULL) rsc(n = 1, xi = 0, omega = 1, alpha = 0, dp = NULL) } \arguments{ \item{x}{vector of quantiles. Missing values (\code{NA}s) and \code{Inf}'s are allowed.} \item{p}{vector of probabilities. Missing values (\code{NA}s) are allowed.} \item{xi}{ vector of location parameters.} \item{omega}{vector of (positive) scale parameters.} \item{alpha}{vector of slant parameters.} \item{dp}{a vector of length 3 whose elements represent the parameters described above. If \code{dp} is specified, the individual parameters cannot be set.} \item{n}{sample size.} \item{log}{logical flag used in \code{dsc} (default \code{FALSE}). When \code{TRUE}, the logarithm of the density values is returned.} } \value{density (\code{dsc}), probability (\code{psc}), quantile (\code{qsc}) or random sample (\code{rsc}) from the skew-Cauchy distribution with given \code{xi}, \code{omega} and \code{alpha} parameters or from the extended skew-normal if \code{tau!=0} } \section{Details}{ Typical usages are \preformatted{% dsc(x, xi=0, omega=1, alpha=0, log=FALSE) dsc(x, dp=, log=FALSE) psc(x, xi=0, omega=1, alpha=0) psc(x, dp= ) qsc(p, xi=0, omega=1, alpha=0) qsc(x, dp=) rsc(n=1, xi=0, omega=1, alpha=0) rsc(x, dp=) } } \section{Background}{ The skew-Cauchy distribution can be thought as a skew-\eqn{t} with tail-weight parameter \code{nu=1}. In this case, closed-form expressions of the distribution function and the quantile function have been obtained by Behboodian \emph{et al.} (2006). The key facts are summarized in Complement 4.2 of Azzalini and Capitanio (2014). A multivariate version of the distribution exists. } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-normal and Related Families}. Cambridge University Press, IMS Monographs series. Behboodian, J., Jamalizadeh, A., and Balakrishnan, N. (2006). A new class of skew-Cauchy distributions. \emph{Statist. Probab. Lett.} \bold{76}, 1488--1493. } \seealso{\code{\link{dst}}, \code{\link{dmsc}}} \examples{ pdf <- dsc(seq(-5,5,by=0.1), alpha=3) cdf <- psc(seq(-5,5,by=0.1), alpha=3) q <- qsc(seq(0.1,0.9,by=0.1), alpha=-2) p <- psc(q, alpha=-2) rn <- rsc(100, 5, 2, 5) } \keyword{distribution} sn/man/ais.Rd0000644000176200001440000000350513047150454012516 0ustar liggesusers% file sn/man/ais.Rd % This file is a component of the package 'sn' for R % copyright (C) 2004-2013 Adelchi Azzalini %--------------------- \name{ais} \alias{ais} \docType{data} \encoding{UTF-8} \title{Australian Institute of Sport data} \description{Data on 102 male and 100 female athletes collected at the Australian Institute of Sport, courtesy of Richard Telford and Ross Cunningham. } \usage{data(ais)} \format{ A data frame with 202 observations on the following 13 variables. \tabular{rll}{ [,1]\tab \code{sex}\tab categorical, levels: \code{female}, \code{male}\cr [,2]\tab \code{sport}\tab categorical, levels: \code{B_Ball}, \code{Field}, \code{Gym}, \code{Netball}, \code{Row}, \code{Swim}, \code{T_400m}, \cr \tab\tab \code{Tennis}, \code{T_Sprnt}, \code{W_Polo}\cr [,3]\tab \code{RCC}\tab red cell count (numeric)\cr [,4]\tab \code{WCC}\tab white cell count (numeric)\cr [,5]\tab \code{Hc}\tab Hematocrit (numeric)\cr [,6]\tab \code{Hg}\tab Hemoglobin (numeric)\cr [,7]\tab \code{Fe}\tab plasma ferritin concentration (numeric)\cr [,8]\tab \code{BMI}\tab body mass index, weight/(height)\eqn{^2}{²} (numeric)\cr [,9]\tab \code{SSF}\tab sum of skin folds (numeric)\cr [,10]\tab \code{Bfat}\tab body fat percentage (numeric)\cr [,11]\tab \code{LBM}\tab lean body mass (numeric)\cr [,12]\tab \code{Ht}\tab height, cm (numeric)\cr [,13]\tab \code{Wt}\tab weight, kg (numeric)\cr } } \details{The data have been made publicly available in connection with the book by Cook and Weisberg (1994).} \references{ Cook and Weisberg (1994), \emph{An Introduction to Regression Graphics}. John Wiley & Sons, New York. } \examples{ data(ais, package="sn") pairs(ais[,c(3:4,10:13)], col=as.numeric(ais[,1]), main = "AIS data") } \keyword{datasets} sn/man/T.Owen.Rd0000644000176200001440000000324613047145347013063 0ustar liggesusers% file sn/man/T.Owen.Rd % This file is a component of the package 'sn' for R % copyright (C) 1997-2013 Adelchi Azzalini %--------------------- \name{T.Owen} \alias{T.Owen} \title{ Owen's function } \description{Evaluates function \eqn{T(h,a)} studied by D.B.Owen} \usage{ T.Owen(h, a, jmax=50, cut.point=8) } \arguments{ \item{h}{a numeric vector. Missing values (\code{NA}s) and \code{Inf} are allowed.} \item{a}{a numeric value. \code{Inf} is allowed.} \item{jmax}{an integer scalar value which regulates the accuracy of the result. See Section \sQuote{Details} below for explanation. } \item{cut.point}{a scalar value which regulates the behaviour of the algorithm, as explained in Section \sQuote{Details} below (default value: \code{8}).} } \value{a numeric vector.} \details{ If \code{a>1} and \code{01} and \code{h>cut.point}, an asymptotic approximation is used. In the other cases, various reflection properties of the function are exploited. See the reference below for more information. } \section{Background}{ The function \emph{T(h,a)} studied by Owen (1956) is useful for the computation of the bivariate normal distribution function and related quantities, including the distribution function of a skew-normal variate; see \code{psn}. See the reference below for more information on function \eqn{T(h,a)}. } \author{Adelchi Azzalini and Francesca Furlan} \references{ Owen, D. B. (1956). Tables for computing bivariate normal probabilities. \emph{Ann. Math. Statist.} \bold{27}, 1075-1090. } \seealso{ \code{\link{psn}}} \examples{ owen <- T.Owen(1:10, 2)} \keyword{math} sn/man/summary.selm.Rd0000644000176200001440000001103712434141321014365 0ustar liggesusers% file sn/man/summary.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{summary.selm} \alias{summary.selm} \alias{summary.mselm} \alias{summary,selm-method} \alias{summary,mselm-method} \alias{summary.selm-class} \alias{summary.mselm-class} \alias{show,summary.selm-method} \alias{show,summary.mselm-method} \title{Summarizing \code{selm} fits} \description{\code{summary} method for class \code{"selm"} and \code{"mselm"}.} \usage{ \S4method{summary}{selm}(object, param.type = "CP", cov = FALSE, cor = FALSE) \S4method{summary}{mselm}(object, param.type = "CP", cov = FALSE, cor = FALSE) } \arguments{ \item{object}{an object of class \code{"selm"} or \code{"mselm"} as created by a call to function \code{selm}.} \item{param.type}{a character string which indicates the required type of parameter type; possible values are \code{"CP"} (default), \code{"DP"}, \code{"pseudo-CP"} and their equivalent lower-case expressions.} \item{cov}{a logical value, to indicate if an estimate of the variance and covariance matrix of the estimates is required (default: \code{FALSE}).} \item{cor}{a logical value, to indicate if an estimate of the correlation matrix of the estimates is required (default: \code{FALSE}).} } \value{An S4 object of class \code{summary.selm} with 12 slots. \item{\code{call}:}{the calling statement.} \item{\code{family}:}{the parametric family of skew-ellitically contoured distributed (\acronym{SEC}) type.} \item{\code{logL}:}{the maximized log-likelihood or penalized log-likelihood value} \item{\code{method}:}{estimation method (\code{"MLE"} or \code{"MPLE"})} \item{\code{param.type}:}{a characer string with the chosen parameter set.} \item{\code{param.table}:}{table of parameters, std.errors and z-values} \item{\code{fixed.param}:}{a list of fixed parameter values} \item{\code{resid}:}{residual values} \item{\code{control}:}{a list with control parameters} \item{\code{aux}:}{a list of auxiliary quantities} \item{\code{size}:}{a numeric vector with various lengths and dimensions} \item{\code{boundary}:}{a logical value which indicates whether the estimates are on the boundary of the parameter space} } \note{ There are two reasons why the default choice of \code{param.type} is \code{CP}. One is the the easier interpretation of cumulant-based quantities such as mean value, standard deviation, coefficient of skewness. The other reason is more technical and applies only to cases when the estimate of the slant parameter \eqn{alpha} of the \acronym{SN} distribution is close to the origin: standard asymptotic distribution theory of maximum likelihood estimates (MLE's) does not apply in this case and the corresponding standard errors are not trustworthy. The problem is especialy severe at \eqn{\alpha=0} but to some extent propagates to its vicinity. If \eqn{d=1}, adoption of \code{CP} leads to MLE's with regular asymptotic distribution across the parameter space, including \eqn{\alpha=0}. For \eqn{d>1} and \eqn{\alpha=0,} the problem is still unsolved at the present time, which is the reason why \code{selm} issues a warning message when the MLE is in the vicinity of \eqn{\alpha=0}; see \sQuote{Details} of \code{\link{selm}}. For background information, see Sections 3.1.4--6 and 5.2.3 of Azzalini and Capitanio (2014) and references therein. This problem does not occur with the the \acronym{SC} and the \acronym{ST} distribution (unless its tail-weight parameter \code{nu} diverges, that is, when we are effectively approaching the \code{SN} case). } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \author{Adelchi Azzalini} \seealso{ \code{\link{selm}} function, \code{\linkS4class{selm}} (and \code{mselm}) class, \code{\link{plot.selm}}, \code{\link{dp2cp}} } \examples{ data(wines, package="sn") m5 <- selm(acidity ~ phenols + wine, family="SN", data=wines) summary(m5) summary(m5, "dp") s5 <- summary(m5, "dp", cor=TRUE, cov=TRUE) dp.cor <- slot(s5, "aux")$param.cor cov2cor(vcov(m5, "dp")) # the same # # m6 <- selm(acidity ~ phenols + wine, family="ST", data=wines) # boundary!? # m12 <- selm(cbind(acidity, alcohol) ~ phenols + wine, family="SN", data=wines) s12 <- summary(m12) coef(m12, 'dp') coef(m12, "dp", vector=FALSE) # # see other examples at function selm } \keyword{regression} sn/man/selm.fit.Rd0000644000176200001440000002436713203046201013460 0ustar liggesusers% file sn/man/selm.fit.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{selm.fit} \alias{selm.fit} \alias{sn.mple} \alias{st.mple} \alias{msn.mle} \alias{msn.mple} \alias{mst.mple} \title{Fitting functions for \code{selm} models} \description{A call to \code{selm} activates a call to \code{selm.fit} and from here to some other function which actually performs the parameter search, among those listed below. These lower-level functions can be called directly for increased efficiency, at the expense of some more programming effort and lack of methods for the returned object.} \usage{ selm.fit(x, y, family = "SN", start = NULL, w, fixed.param = list(), offset = NULL, selm.control) sn.mple(x, y, cp = NULL, w, penalty = NULL, trace = FALSE, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) st.mple(x, y, dp = NULL, w, fixed.nu = NULL, symmetr = FALSE, penalty = NULL, trace = FALSE, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) msn.mle(x, y, start = NULL, w, trace = FALSE, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) msn.mple(x, y, start = NULL, w, trace = FALSE, penalty = NULL, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) mst.mple(x, y, start = NULL, w, fixed.nu = NULL, symmetr=FALSE, penalty = NULL, trace = FALSE, opt.method = c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"), control = list()) } \arguments{ \item{x}{a full-rank design matrix with the first column of all 1's.} \item{y}{a vector or a matrix of response values such that \code{NROW(y)=nrow(x)}.} \item{family}{a character string which selects the parametric family of distributions assumed for the error term of the regression model. It must one of \code{"SN"} (default), \code{"ST"} or \code{"SC"}, which correspond to the skew-normal, the skew-\emph{t} and the skew-Cauchy family, respectively. See \code{\link{makeSECdistr}} for more information on these families and the skew-elliptically contoured (\acronym{SEC}) distributions; notice that family \code{"ESN"} is not allowed here.} \item{start, dp, cp}{a vector or a list of initial parameter values, depeding whether \code{y} is a vector or a matrix. It is assumed that \code{cp} is given in the \acronym{CP} parameterization, \code{dp} and \code{start} in the \acronym{DP} parameterization. } \item{w}{a vector of non-negative integer weights of length equal to \code{NROW(y)}; if missing, a vector of all 1's is generated.} \item{fixed.param}{a list of assignments of parameter values to be kept fixed during the optimization process. Currently, there is only one such option, namely \code{fixed.param=list(nu='value')}, to fix the degrees of freedom at the named \code{'value'} when \code{family="ST"}, for instance \code{list(nu=3)}. Setting \code{fixed.param=list(nu=1)} is equivalent to select \code{family="SC"}.} \item{penalty}{an optional character string with the name of the penalty function of the log-likelihood; default value \code{NULL} corresponds to no penalty.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one are specified their sum is used.} %See \code{\link[stats]{model.offset}.} \item{trace}{a logical value which regulates printing of successive calls to the target function; default value is \code{FALSE} which suppresses printing.} \item{fixed.nu}{a positive value to keep fixed the parameter \code{nu} of the \acronym{ST} distribution in the optimization process; with default value \code{NULL}, \code{nu} is estimated like the other parameters.} \item{symmetr}{a logical flag indicating whether a contraint of symmetry is imposed on the slant parameter; default is \code{symmetr=FALSE}.} \item{opt.method}{a character string which selects the optimization method within the set \code{c("nlminb", "Nelder-Mead", "BFGS", "CG", "SANN")}; the last four of these are \code{"methods"} of function \code{optim}.} \item{selm.control}{a list whose components regulate the working of \code{selm.fit}; see \sQuote{Details} for their description;} \item{control}{a list of control items passed to the optimization function.} } \details{ A call to \code{selm} produces a call to \code{selm.fit} which selects the appropriate function among \code{sn.mple}, \code{st.mple}, \code{msn.mle}, \code{msn.mple}, \code{mst.mple}, depending on the arguments of the calling statement. In the adopted scheme for function names, \code{msn} refers to a multivariate skew-normal distribution and \code{mst} refers to a multivariate skew-\eqn{t} distribution, while \code{mle} and \code{mple} refers to maximum likelihood and maximum penalized likelihood estimation, respectively. Of these functions, \code{sn.mple} works in \acronym{CP} space; the others in the \acronym{DP} space. In all cases, a correspondig mapping to the alternative parameter space is performed before exiting \code{selm.fit}, in addition to the selected parameter set. The components of \code{selm.control} are as follows: \itemize{ \item \code{method}: the estimation method, \code{"MLE"} or \code{"MPLE"}. \item \code{penalty}: a string with the name of the penalty function. \item \code{info.type}: a string with the name of the information matrix, \code{"observed"} or \code{"expected"}; currently fixed at "observed". \item \code{opt.method}: a character string which selects the optimization method. \item \code{opt.control}: a list of control parameters of \code{opt.method}. } Function \code{msn.mle}, for \acronym{MLE} estimation of linear models with \acronym{SN} errors, is unchanged from version 0.4-x of the package. Function \code{msn.mple} is similar to \code{msn.mle} but allows to introduce a penalization of the log-likelihood; when \code{penalty=NULL}, a call to \code{msn.mle} is more efficient. Functions \code{sn.mple} and \code{mst.mple} work like \code{sn.mle} and \code{mst.mle} in version 0.4-x if the argument \code{penalty} is not set or it is set to \code{NULL}, except that \code{mst.mple} does not handle a univariate response (use \code{st.mple} for that). } \value{A list whose specific components depend on the named function. Typical components are: \item{call}{the calling statement} \item{dp}{vector or list of estimated \acronym{DP} parameters} \item{cp}{vector or list of estimated \acronym{CP} parameters} \item{logL}{the maximized (penalized) log-likelihood} \item{aux}{a list with auxiliary output values, depending on the function} \item{opt.method}{a list produced by the numerical \code{opt.method}} } \section{Background}{ Computational aspects of maximum likelihood estimation for univariate \acronym{SN} distributions are discussed in Section 3.1.7 of Azzalini and Capitanio (2014). The working of \code{sn.mple} follows these lines; maximization is performed in the \acronym{CP} space. All other functions operate on the \acronym{DP} space. The technique underlying \code{msn.mle} is based on a partial analytical maximization, leading implicitly to a form of profile log-likelihood. This scheme is formulated in detail in Section 6.1 of Azzalini and Capitanio (1999) and summarized in Section 5.2.1 of Azzalini and Capitanio (2014). The same procedure is not feasible when one adopts \acronym{MPLE}; hence function \code{msn.mple} has to maximize over a larger parameter space. When the SN family is fitted with the constraint \kbd{alpha=}, this amount to adopt a classical linear model with Gaussian distributional assumption. The corresponding MLE's are the same as those produced ny \code{lm}, except that the denominator the of the MLE variance (matrix) has the `uncorrected' form. In the multivariate case, the covariance matrix of MLE is computed using expression (10) in Section 15.8 of Magnus and Neudecker (2007). Maximization of the univariate \acronym{ST} log-likelihood is speeded-up by using the expressions of the gradient given by DiCiccio and Monti (2011), reproduced with inessential variants in Section 4.3.3 of Azzalini and Capitanio (2014). The working of \code{mst.mple} is based on a re-parameterization described in Section 5.1 of Azzalini and Capitanio (2003). The expressions of the corresponding log-likelihood derivatives are given in Appendix B of the full version of the paper. } \references{ Azzalini, A. and Capitanio, A. (1999). Statistical applications of the multivariate skew normal distribution. \emph{J.Roy.Statist.Soc. B} \bold{61}, 579--602. Full-length version available at \url{http://arXiv.org/abs/0911.2093} Azzalini, A. and Capitanio, A. (2003). Distributions generated by perturbation of symmetry with emphasis on a multivariate skew \emph{t} distribution. \emph{J.Roy. Statist. Soc. B} \bold{65}, 367--389. Full-length version available at \url{http://arXiv.org/abs/0911.2342} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. DiCiccio, T. J. and Monti, A. C. (2011). Inferential aspects of the skew \eqn{t}-distribution. \emph{Quaderni di Statistica} \bold{13}, 1--21. Magnus, J. R. and Neudecker, H. (2007). \emph{Matrix Differential Calculus with Applications in Statistics and Econometrics}, third edition. John Wiley \& Sons. } \author{Adelchi Azzalini} % \note{} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{\code{\link{selm}} for a comprehensive higher level fitting function, \code{\link{Qpenalty}} for specification of a penalty function } \examples{ data(wines, package="sn") X <- model.matrix(~ phenols + wine, data=wines) fit <- msn.mle(x=X, y=cbind(wines$acidity, wines$alcohol), opt.method="BFGS") fit <- st.mple(x=X, y = wines$acidity, fixed.nu=4, penalty="Qpenalty") } \keyword{regression} \keyword{multivariate} sn/man/summary.SECdistr.Rd0000644000176200001440000001416113057037024015114 0ustar liggesusers% file sn/man/summary.SECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2015 Adelchi Azzalini %--------------------- \name{summary.SECdistr} \alias{summary.SECdistr} \alias{summary.SECdistrUv} \alias{summary.SECdistrMv} \alias{summary,SECdistrUv-method} \alias{summary,SECdistrMv-method} \title{Summary of a \acronym{SEC} distribution object} \description{Produce a summary of an object of class either \code{"SECdistrUv"} or \code{"SECdistrMv"}, which refer to a univariate or a multivariate \acronym{SEC} distribution, respectively. Both types of objects can be produced by \code{makeSECditr}. } \usage{ \S4method{summary}{SECdistrUv}(object, cp.type = "auto", probs) \S4method{summary}{SECdistrMv}(object, cp.type = "auto") } \arguments{ \item{object}{an object of class \code{"SECdistrUv"} or \code{"SECdistrMv"}.} \item{cp.type}{a character string to select the required variance of \acronym{CP} parameterization; possible values are \code{"proper"}, \code{"pseudo"}, \code{"auto"} (default). For a description of these codes, see \code{\link{dp2cp}}.} \item{probs}{in the univariate case, a vector of probabilities for which the corresponding quantiles are required. If missing, the vector \code{c(0.05, 0.25, 0.50, 0.75, 0.95)} is used.} } \details{For a description of the \acronym{DP}, \acronym{CP} and pseudo-\acronym{CP} parameter sets included in the returned object, see \code{\link{dp2cp}}. The \code{aux} slot of the returned object includes other summary quantities, as described next. In the univariate case, the reported quantile-based measures of skewness and kurtosis refer to the Bowley and Moors measures, respectively; see Groeneveld (2006) and Moors (1988) for their specifications. In the multivariate case, the Mardia's measures of skewness and kurtosis are computed from the expressions given on p.153 and p.178 of Azzalini and Capitanio (2014). In the univariate case, \code{delta} is a simple transformation of the slant parameter \code{alpha}; it takes values in \eqn{(-1, 1)}. In the multivariate case, \code{delta} is a vector with components of similar type; they correspond to the matching terms of the univariate components. The \code{alpha*} and \code{delta*} coefficients are univariate comprehensive summary quantities of slant; see pp.132-3 of Azzalini and Capitanio (2014) for their expressions. These quantities play an important role in \acronym{SEC} distributions; for instance, the Mardia's measures of multivariare skewness and kurtosis depend on the vector of slant parameters only via \code{delta*} or, equivalently, via \code{alpha*}. The mode, which is unique for all these distributions, is computed by a numerical line search between the \acronym{DP} location and the \acronym{CP} location (or the pseudo-\acronym{DP} location, when the latter does exists). This line search is univariate also in the multivariate case, using Propositions 5.14 and 6.2 of Azzalini and Capitanio (2014); see also Problem 5.14. The examples below illustrate how extract various components from \code{aux} and other slots of the returned object. } \value{A list with the following components: \item{family}{name of the family within the \acronym{SEC} class, character} \item{dp}{\acronym{DP} parameters, a list or a vector} \item{name}{the name of the distribution, character string} \item{compNames}{in the multivariate case the names of the components, a character vector} \item{cp}{\acronym{CP} parameters, a list or a vector} \item{cp.type}{the name of the selected variant of the \acronym{CP} set} \item{aux}{a list with auxiliary ingredients (mode, coefficients of skewness and kurtosis, in the parametric and non-parametric variants, and more); see Section \sQuote{Details} for more information.} The list items \code{dp} and \code{cp} are vectors if \code{class(object)} is \code{SECdistrUv} (univariate distribution); they are lists if \code{class(object)} is \code{SECdistrMv} (multivariate distribution). } \author{Adelchi Azzalini} %\note{%% ~~further notes~~} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{makeSECdistr}} for building a \acronym{SEC} distribution \code{\link{extractSECdistr}} for extracting a \acronym{SEC} distribution from a \code{\link{selm}} fit methods \code{\link[base]{mean}} and \code{\link[sn]{sd}} for computing the mean and the standard deviation of \code{\link{SECdistrUv-class}} objects, methods \code{\link[base]{mean}} and \code{\link[stats]{vcov}} for computing the mean vector and the variance matrix of \code{\link{SECdistrMv-class}} objects \code{\link[sn]{modeSECdistr}} for computing the mode directly } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Moors, I. J. A. (1988). A quantile alternative for kurtosis. \emph{The Statistician} \bold{37}, 25-32. Groeneveld, R. A. (2006). Skewness, Bowley's measures of. In volume \bold{12}, 7771-3, of \emph{Encyclopedia of Statistical Sciences}, 2nd edition, edited by Kotz et al. Wiley, New York. } \examples{ f3 <- makeSECdistr(dp=c(3,2,5), family="SC") summary(f3) s <- summary(f3, probs=(1:9)/10) print(slotNames(s)) print(names(slot(s,"aux"))) # the components of the 'aux' slot slot(s, "aux")$mode # the same of modeSECdistr(object=f3) slot(s, "aux")$q.measures # quantile-based measures of skewness and kurtosis # dp3 <- list(xi=1:3, Omega=toeplitz(1/(1:3)), alpha=c(-3, 8, 5), nu=6) st3 <- makeSECdistr(dp=dp3, family="ST", name="ST3", compNames=c("U", "V", "W")) s <- summary(st3) dp <- slot(s, "dp") # the same of slot(st3, "dp") slot(s, "cp")$var.cov # the same of vcov(st3) slot(s, "aux")$delta.star # comprehensive coefficient of shape slot(s, "aux")$mardia # Mardia's measures of skewness and kurtosis # dp2 <- list(xi=rep(0,2), Omega=matrix(c(2,2,2,4),2,2), alpha=c(3,-5), tau=-1) esn2 <- makeSECdistr(dp=dp2, family="ESN", name="ESN-2d") summary(esn2) } \keyword{multivariate} \keyword{distribution} sn/man/makeSECdistr.Rd0000644000176200001440000001332713053060675014265 0ustar liggesusers% file sn/man/makeSECdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2014 Adelchi Azzalini %--------------------- \name{makeSECdistr} \encoding{UTF-8} \alias{makeSECdistr} \concept{skew-elliptical distribution} \title{Build a skew-elliptically contoured distribution} \description{Build an object which identifies a skew-elliptically contoured distribution (\acronym{SEC}), in the univariate and in the multivariate case. The term \sQuote{skew-elliptical distribution} is a synonym of \acronym{SEC} distribution.} \usage{makeSECdistr(dp, family, name, compNames)} \arguments{ \item{dp}{a numeric vector (in the univariate case) or a list (in the multivariate case) of parameters which identify the specific distribution within the named \code{family}. See \sQuote{Details} for their expected structure.} \item{family}{a character string which identifies the parametric family; currently, possible values are: \kbd{"SN"}, \kbd{"ESN"}, \kbd{"ST"}, \kbd{"SC"}. See \sQuote{Details} for additional information.} \item{name}{an optional character string with the name of the distribution. If missing, one is created.} \item{compNames}{in the multivariate case, an optional vector of character strings with the names of the component variables; its length must be equal to the dimensionality of the distribution being generated. If missing and the first component of \code{dp} is a named vector, its names are used as \code{compNames}; otherwise the components are named \code{"V1"}, \code{"V2"}, \dots} } \details{If \code{dp} is a numeric vector, a univariate distribution is built. Alternatively, if \code{dp} is a list, a multivariate distribution is built. In both cases, the required number of components of \code{dp} depends on \code{family}: it must be \code{3} for \kbd{"SN"} and \kbd{"SC"}; it must be \code{4} for \kbd{"ESN"} and \kbd{"ST"}. In the univariate case, the first three components of \code{dp} represent what for the specific distributions are denoted \code{xi} (location), \code{omega} (scale, positive) and \code{alpha} (slant); see functions \code{\link{dsn}}, \code{\link{dst}}, \code{\link{dsc}} for their description. The fourth component, when it exists, represents either \code{tau} (hidden variable mean) for \kbd{"ESN"} or \code{nu} (degrees of freedom) for \kbd{"ST"}. The names of the individual parameters are attached to the components of \code{dp} in the returned object. In the multivariate case, \code{dp} is a list with components having similar role as in the univariate case, but \code{xi=dp[[1]]} and \code{alpha=dp[[3]]} are now vectors and the scale parameter \code{Omega=dp[[2]]} is a symmetric positive-definite matrix. For a multivariate distribution of dimension 1 (which can be created, although a warning message is issued), \code{Omega} corresponds to the square of \code{omega} in the univariate case. Vectors \code{xi} and \code{alpha} must be of length \code{ncol(Omega)}. See also functions \code{\link{dmsn}}, \code{\link{dmst}} and \code{\link{dmsc}}. The fourth component, when it exists, is a scalar with the same role as in the univariate case. In the univariate case \code{alpha=Inf} is allowed, but in the multivariate case all components of the vector \code{alpha} must be finite. } \section{Background}{ For background information, see Azzalini and Capitanio (2014), specifically Chapters 2 and 4 for univariate cases, Chapters 5 and 6 for multivariate cases; Section 6.1 provides a general formulation of \acronym{SEC} distributions. If the slant parameter \code{alpha} is \code{0} (or a vector of \code{0}'s, in the multivariate case), the distribution is of classical elliptical type. Among the admissible families, the \acronym{ESN} distribution is not, strictly speaking, of \acronym{SEC} type, but it is nevertheless included because of its strong connection. } \value{In the univariate case, an object of class \code{SECdistrUv}; in the multivariate case, an object of class \code{SECdistrMv}. See \code{\link{SECdistrUv-class}} and \code{\link{SECdistrMv-class}} for their description. } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \author{Adelchi Azzalini} \seealso{ The description of classes \code{\link{SECdistrUv-class}} and \code{\link{SECdistrMv-class}} \code{\link{plot.SECdistr}} for plotting and \code{\link{summary.SECdistr}} for summaries Related functions \code{\link{dsn}}, \code{\link{dst}}, \code{\link{dsc}}, \code{\link{dmsn}}, \code{\link{dmst}}, \code{\link{dp2cp}} Functions \code{\link{affineTransSECdistr}} and \code{\link{conditionalSECdistr}} to manipulate objects of class \code{\link{SECdistrMv-class}} Function \code{\link{extractSECdistr}} to extract objects of class \code{\link{SECdistrMv-class}} and \code{\link{SECdistrUv-class}} representing the \acronym{SEC} distribution of a \code{\link{selm}} fit } \examples{ f1 <- makeSECdistr(dp=c(3,2,5), family="SN", name="First-SN") show(f1) summary(f1) plot(f1) plot(f1, probs=c(0.1, 0.9)) # f2 <- makeSECdistr(dp=c(3, 5, -4, 8), family="ST", name="First-ST") f9 <- makeSECdistr(dp=c(5, 1, Inf, 0.5), family="ESN", name="ESN,alpha=Inf") # dp0 <- list(xi=1:2, Omega=diag(3:4), alpha=c(3, -5)) f10 <- makeSECdistr(dp=dp0, family="SN", name="SN-2d", compNames=c("u1", "u2")) # dp1 <- list(xi=1:2, Omega=diag(1:2)+outer(c(3,3),c(2,2)), alpha=c(-3, 5), nu=6) f11 <- makeSECdistr(dp=dp1, family="ST", name="ST-2d", compNames=c("t1", "t2")) } \keyword{distribution} \keyword{multivariate} sn/man/profile.selm.Rd0000644000176200001440000001604112735017036014341 0ustar liggesusers% file sn/man/profile.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2015 Adelchi Azzalini %--------------------- \name{profile.selm} \alias{profile.selm} \alias{profile.selm-method} \concept{confidence interval} \concept{confidence region} \title{Profile log-likelihood function of selm-class objects} \description{ One- or two-dimensional profile (penalized) log-likelihood function of a \code{selm} fit and corresponding confidence interval or regions } \usage{ \S3method{profile}{selm}(fitted, param.type, param.name, param.values, npt, opt.control = list(), plot.it = TRUE, log = TRUE, level, trace = FALSE, ...) } \arguments{ \item{fitted}{an object of class \code{selm} as produced by a call to function \code{selm} with univariate response.} \item{param.type}{ a character string with the required parameterization; it must be either \code{"CP"} or \code{"DP"}, or possibly their equivalent lowercase.} \item{param.name}{ either a single character string or a vector of two such terms with the name(s) of the parameter(s) for which the profile log-likelihood is required; these names must match those appearing in \code{\link{summary.selm}(object, param.type)}.} \item{param.values}{in the one-parameter case, a numeric vector with the values where the log-likelihood must be evaluated; in the two-parameter case, a list of two such vectors used to build a grid of coordinates of points. Their range must identify an interval or a rectangle which includes the \acronym{MLE} or \acronym{MPLE} obtained by \code{\link{selm}}. See \sQuote{Details} for more information.} \item{npt}{ in case the vector or any of the vectors of argument \code{param.values} has length 2, an equally spaced grid of values is build with length equal to the corresponding component of \code{npt}. If the above condition is met but this argument is missing, a default choice is made, namely 51 or (26,26) in the one- or two-parameter case, respectively.} \item{opt.control}{ an optional list passed as argument \code{control} to \code{optim} to optimize the log-likelihood; see \sQuote{Details} for more information.} \item{plot.it}{a logical value; if \code{TRUE} (default value), a plot is produced representing the deviance, which is described in \sQuote{Details} below. In the one-parameter case, a confidence interval of prescribed \code{level} is marked on the plot; in the two-parameter case, the contour curves are labelled with approximate confidence levels. See however for more information. } \item{log}{a logical value (default: \code{TRUE}) indicating whether the scale and tail-weight parameter (the latter only for the \acronym{ST} family) must be log-transformed, if case any of them occurs in \code{param.name}. This applies to \code{omega} and \code{nu} in the \code{DP} parameter set and to \code{s.d.} and \code{gamma2} in the \code{CP} parameter set.} \item{level}{a single probability value (in the one-parameter case) or a vector of such values (in the two-parameter case) for which the confidence interval or region is requited; see \sQuote{Details} for more information.} \item{trace}{a logical value (default: \code{FALSE}) to activate printing of intermediate outcome of the log-likelihood optimization process} \item{\dots}{optional graphical parameters passed to the plotting functions.} } \details{ For each chosen point of the parameter(s) to be profiled, the log-likelihood is maximized with respect to the remaining parameters. The optimization process is accomplished using the \code{\link[stats]{optim}} optimization function, with \code{method="BFGS"}. This step can be regulated by the user via \code{opt.control} which is passed to \code{\link[stats]{optim}} as \code{control} argument, apart from element \code{fnscale} whose use is reserved. If the original \code{fitted} object included a fixed parameter value, this is kept fixed here. If the estimation method was \code{"MPLE"}, that choice carries on here; in case the penalty function was user-defined, it must still be accessible. For plotting purposes and also in the numerical output, the deviance function \eqn{D} is used, namely \deqn{D = 2\left[\max(\log L) - \log L\right]}{D = 2*[max(log L)- log L]} where \eqn{L} denotes the likelihood. The range of \code{param.values} must enclose the maximum (penalized) likelihood estimates (\acronym{MLE} or \acronym{MPLE}) by an adequate extent such that suitable confidence intervals or regions can be established from standard asymptotic theory. For the \acronym{SN} family and \acronym{DP} parameterization, the asymptotic theory is actually non-standard near the important point \eqn{\alpha=0}, but the correspondence with the regular case of the \acronym{CP} parameterization, still allows to derive confidence regions using standard procedures; for more information on this point, see Section 3.1.6 of Azzalini and Capitanio (2014). When the \acronym{MLE} occurs on the frontier of the parameter space, a message is issued and no confidence interval is produced, while in the two-parameter case the plot is not labelled with probability values, but only with deviance levels. } \value{An invisible list whose components, described below, are partly different in the one- and the two-parameter cases. \item{call}{the calling statement} \item{}{values of the first parameter} \item{}{values of the second parameter (in a two-parameter case)} \item{logLik}{numeric vector or matrix of the profile log-likelihood values} \item{confint}{in the one-parameter case, the confidence interval} \item{level}{in the one-parameter case, the confidence level} \item{deviance.contour}{in the two-parameter case, a list of lists whose elements identify each curve of the contour plot} } \author{Adelchi Azzalini} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } % \note{} \section{Warnings}{ \itemize{ \item This function is experimental and changes in future versions of the package may occur. Users should not rely on the persistence of the same user interface or the same name. \item It is a known fact that, in some critical situations, peculiar outcomes are produced. }} \seealso{ \code{\link{selm}}, \code{\link{summary.selm}}, \code{\link{makeSECdistr}} for the \acronym{CP}/\acronym{DP} parameterizations, \code{\link[stats]{optim}} for its \code{control} argument } \examples{ data(ais) m1 <- selm(log(Fe) ~ BMI + LBM, family = "sn", data = ais) pll <- profile(m1, "dp", param.name="alpha", param.val=c(-3,2)) profile(m1, "cp", param.name="gamma1", param.val=seq(-0.7, 0.4, by=0.1)) # in the next example, we reduce grid points to save execution time pll <- profile(m1, "cp", param.name=c("(Intercept.CP)", "gamma1"), param.val=list(c(1.5, 4), c(-0.8, 0.5)), npt=c(11,16) ) } sn/man/coef.selm.Rd0000644000176200001440000000437612503264064013623 0ustar liggesusers% file sn/man/coef.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2014 Adelchi Azzalini %--------------------- \name{coef.selm} \alias{coef.selm} \alias{coef.mselm} \alias{coef,selm-method} \alias{coef,mselm-method} \title{Coefficients of objects created by \code{selm}} \description{ \code{coef} method for classes \code{"selm"} and \code{"mselm"}.} \usage{ \S4method{coef}{selm}(object, param.type = "CP", ...) \S4method{coef}{mselm}(object, param.type = "CP", vector=TRUE, ...) } \arguments{ \item{object}{an object of class \code{"selm"} or \code{"mselm"} as created by a call to function \code{selm}.} \item{param.type}{a character string which indicates the required type of parameter type; possible values are \code{"CP"} (default), \code{"DP"}, \code{"pseudo-CP"} and their equivalent lower-case expressions.} \item{vector}{a logical value (default is \code{TRUE}) which selects a vector or a list format of the retuned value} \item{...}{not used, included for compatibility with the generic method} } \value{a numeric vector or a list (the latter only for \code{mselm-class} objects if \code{vector=FALSE}) } \note{The possible options of \code{param.type} are described in the documentation of \code{\link{dp2cp}}; their corresponding outcomes differ by an additive constant only. With the \code{"CP"} option (that is, the \sQuote{centred parametrization}), the residuals are centred around 0, at least approximately; this is a reason for setting \code{"CP"} as the default option. For more information, see the \sQuote{Note} in the documentation of \code{\link{summary.selm}}. } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \author{Adelchi Azzalini} \seealso{ \code{\link{dp2cp}}, \code{\link{summary.selm}}, \code{\link{selm}} function, \code{\linkS4class{selm}-class} } \examples{ data(wines, package="sn") m5 <- selm(acidity ~ phenols + wine, family="SN", data=wines) coef(m5) coef(m5, "dp") # m12 <- selm(cbind(acidity, alcohol) ~ phenols + wine, family="SN", data=wines) coef(m12) coef(m12, "DP", vector=FALSE) } \keyword{regression} sn/man/wines.Rd0000644000176200001440000000717413047150333013071 0ustar liggesusers% file sn/man/wines.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{wines} \alias{wines} \docType{data} \encoding{UTF-8} \title{Piedmont wines data} \description{Data refer to chemical properties of 178 specimens of three types of wine produced in the Piedmont region of Italy. } \usage{data(wines)} \format{ A data frame with 178 observations on the following 28 variables. \tabular{ll}{ \code{wine}\tab wine name (categorical, levels: \code{Barbera}, \code{Barolo}, \code{Grignolino})\cr \code{alcohol}\tab alcohol percentage (numeric)\cr \code{sugar}\tab sugar-free extract (numeric)\cr \code{acidity}\tab fixed acidity (numeric)\cr \code{tartaric}\tab tartaric acid (numeric)\cr \code{malic}\tab malic acid (numeric)\cr \code{uronic}\tab uronic acids (numeric)\cr \code{pH}\tab pH (numeric)\cr \code{ash}\tab ash (numeric)\cr \code{alcal_ash}\tab alcalinity of ash (numeric)\cr \code{potassium}\tab potassium (numeric)\cr \code{calcium}\tab calcium (numeric)\cr \code{magnesium}\tab magnesium (numeric)\cr \code{phosphate}\tab phosphate (numeric)\cr \code{cloride}\tab chloride (numeric)\cr \code{phenols}\tab total phenols (numeric)\cr \code{flavanoids}\tab flavanoids (numeric)\cr \code{nonflavanoids}\tab nonflavanoid phenols (numeric)\cr \code{proanthocyanins}\tab proanthocyanins (numeric)\cr \code{colour}\tab colour intensity (numeric)\cr \code{hue}\tab hue (numeric)\cr \code{OD_dw}\tab \eqn{OD_{280}/OD_{315}}{OD₂₈₀/OD₃₁₅} of diluted wines (numeric)\cr \code{OD_fl}\tab \eqn{OD_{280}/OD_{315}}{OD₂₈₀/OD₃₁₅} of flavanoids (numeric)\cr \code{glycerol}\tab glycerol (numeric)\cr \code{butanediol}\tab 2,3-butanediol (numeric)\cr \code{nitrogen}\tab total nitrogen (numeric)\cr \code{proline}\tab proline (numeric)\cr \code{methanol}\tab methanol (numeric)\cr } } \details{ The data represent 27 chemical measurements on each of 178 wine specimens belonging to three types of wine produced in the Piedmont region of Italy. The data have been presented and examined by Forina \emph{et al.} (1986) and were freely accessible from the \acronym{PARVUS} web-site until it was active. These data or, more often, a subset of them are now available from various places, including some \R packages. The present dataset includes all variables available on the \acronym{PARVUS} repository, which are the variables listed by Forina \emph{et al.} (1986) with the exception of \sQuote{Sulphate}. Moreover, it reveals the undocumented fact that the original dataset appears to include also the vintage year; see the final portion of the \sQuote{Examples} below.} \source{ Forina, M., Lanteri, S. Armanino, C., Casolino, C., Casale, M. and Oliveri, P. \acronym{V-PARVUS 2008}: an extendible package of programs for esplorative data analysis, classification and regression analysis. Dip. Chimica e Tecnologie Farmaceutiche ed Alimentari, Università di Genova, Italia. Web-site (not accessible as of 2014): \samp{http://www.parvus.unige.it} } \references{ Forina M., Armanino C., Castino M. and Ubigli M. (1986). Multivariate data analysis as a discriminating method of the origin of wines. \emph{Vitis} \bold{25}, 189--201. } \examples{ data(wines) pairs(wines[,c(2,3,16:18)], col=as.numeric(wines$wine)) # code <- substr(rownames(wines), 1, 3) table(wines$wine, code) # year <- as.numeric(substr(rownames(wines), 6, 7)) table(wines$wine, year) # coincides with Table 1(a) of Forina et al. (1986) } \keyword{datasets} sn/man/sn-st.cumulants.Rd0000644000176200001440000000375213047131112015012 0ustar liggesusers% file sn/man/sn-st.cumulants.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{sn-st.cumulants} \alias{sn.cumulants} \alias{st.cumulants} \concept{cumulant} \title{Cumulants of univariate skew-normal and skew-\eqn{t} distributions} \description{Compute cumulants of univariate (extended) skew-normal and skew-\eqn{t} distributions up to a given order.} \usage{ sn.cumulants(xi=0, omega=1, alpha=0, tau=0, dp=NULL, n=4) st.cumulants(xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, n=4) } \arguments{ \item{xi}{location parameters (numeric vector).} \item{omega}{scale parameters (numeric vector, positive).} \item{alpha}{slant parameters (numeric vector).} \item{tau}{hidden mean parameter (numeric scalar).} \item{nu}{degrees of freedom (numeric scalar, positive); the default value is \code{nu=Inf} which corresponds to the skew-normal distribution.} \item{dp}{a vector containing the appropriate set of parameters. If 0 \code{dp} is not \code{NULL}, the individual parameters must not be supplied.} \item{n}{maximal order of the cumulants. For \code{st.cumulants} and for \code{sn.cumulants} with \code{tau!=0} (\acronym{ESN} distribution), it cannot exceed 4.} } \section{Background}{ See Sections 2.1.4, 2.2.3 and 4.3.1 of the reference below} \value{A vector of length \code{n} or a matrix with \code{n} columns, in case the input values are vectors.} \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \author{Adelchi Azzalini} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{\code{\link{dsn}}, \code{\link{dsn}}} \examples{ sn.cumulants(omega=2, alpha=c(0, 3, 5, 10), n=5) sn.cumulants(dp=c(0, 3, -8), n=6) st.cumulants(dp=c(0, 3, -8, 5), n=6) # only four of them are computed st.cumulants(dp=c(0, 3, -8, 3)) } \keyword{distribution} sn/man/residuals.selm.Rd0000644000176200001440000000466113047130623014674 0ustar liggesusers% file sn/man/summary.selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2014 Adelchi Azzalini %--------------------- \name{residuals.selm} \alias{residuals.selm} \alias{residuals.mselm} \alias{residuals,selm-method} \alias{residuals,mselm-method} \alias{fitted.selm} \alias{fitted.mselm} \alias{fitted,selm-method} \alias{fitted,mselm-method} \title{Residuals and fitted values from \code{selm} fits} \description{ \code{residuals} and \code{fitted} methods for classes \code{"selm"} and \code{"mselm"}.} \usage{ \S4method{residuals}{selm}(object, param.type = "CP", ...) \S4method{residuals}{mselm}(object, param.type = "CP", ...) \S4method{fitted}{selm}(object, param.type = "CP", ...) \S4method{fitted}{mselm}(object, param.type = "CP", ...) } \arguments{ \item{object}{an object of class \code{"selm"} or \code{"mselm"} as created by a call to function \code{selm}.} \item{param.type}{a character string which indicates the required type of parameter type; possible values are \code{"CP"} (default), \code{"DP"}, \code{"pseudo-CP"} and their equivalent lower-case expressions.} \item{...}{not used, included for compatibility with the generic method.} } \value{a numeric vector (for \code{selm-class} objects) or a matrix (for \code{mselm-class} objects). } \note{The possible options of \code{param.type} are described in the documentation of \code{\link{dp2cp}}; their corresponding outcomes differ by an additive constant only. With the \code{"CP"} option (that is, the \sQuote{centred parametrization}), the residuals are centred around 0, at least approximately; this is a reason for setting \code{"CP"} as the default option. For more information, see the \sQuote{Note} in the documentation of \code{\link{summary.selm}}. } \references{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \author{Adelchi Azzalini} \seealso{ \code{\link{dp2cp}}, \code{\link{summary.selm}}, \code{\link{selm}} function, \code{\linkS4class{selm}-class} } \examples{ data(wines, package="sn") m5 <- selm(acidity ~ phenols + wine, family="SN", data=wines) residuals(m5) residuals(m5, "dp") fitted(m5, "dp") # m12 <- selm(cbind(acidity, alcohol) ~ phenols + wine, family="SN", data=wines) residuals(m12) # # see other examples at function selm } \keyword{regression} sn/man/SECdistrMv-class.Rd0000644000176200001440000000543112504013705015022 0ustar liggesusers% file sn/man/SECdistrMv-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{SECdistrMv-class} \Rdversion{1.1} \docType{class} \alias{SECdistrMv-class} \alias{show,SECdistrMv-method} \alias{mean,SECdistrMv-method} \alias{vcov,SECdistrMv-method} \title{Class \code{"SECdistrMv"}} \description{Multivariate skew-elliptically contoured distributions} \section{Objects from the Class}{ Objects can be created by a call to function \code{\link{makeSECdistr}}, when its argument \code{dp} is a list, or by a suitable transformation of some object of this class. They can also obtained from an object generated by \code{selm} using the function \code{extractSEDdistr}.} \section{Slots}{ \describe{ \item{\code{family}:}{a character string which identifies the parametric family; currently, possible values are: \kbd{"SN"}, \kbd{"ESN"}, \kbd{"ST"}, \kbd{"SC"}.} \item{\code{dp}:}{a list of parameters; its length depends on the selected \code{family}.} \item{\code{name}:}{a character string with the name of the multivariate variable; it can be an empty string.} \item{\code{compNames}:}{a vector of character strings with the names of the component variables.} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "SECdistrMv-class")}: \dots } \item{plot}{\code{signature(x = "SECdistrMv-class")}: \dots } \item{summary}{\code{signature(object = "SECdistrMv-class")}: \dots } \item{mean}{\code{signature(x = "SECdistrUv")}: \dots} \item{vcov}{\code{signature(object = "SECdistrUv")}: \dots} } } \author{Adelchi Azzalini} \note{See \code{\link{makeSECdistr}} for a detailed description of \code{family} and \code{dp}. Note that here methods \code{mean} and \code{vcov} are not applied to data or to a fitted model, but to a \emph{probability distribution} instead, of which they provide the mean (vector) value and the variance-covariance matrix. If methods \code{mean} and \code{vcov} are applied to a distribution for which the mean or the variance do not exist, a \code{NULL} value is returned and a warning message is issued.} \seealso{ \code{\linkS4class{SECdistrUv}}, \code{\link{plot,SECdistrMv-method}}, \code{\link{summary,SECdistrMv-method}}, \code{\link{affineTransSECdistr}}, \code{\link{marginalSECdistr}}, \code{\link{extractSECdistr}} } \examples{ dp0 <- list(xi=1:2, Omega=diag(3:4), alpha=c(3, -5)) f10 <- makeSECdistr(dp=dp0, family="SN", name="SN-2D", compNames=c("x", "y")) show(f10) plot(f10) summary(f10) mean(f10) # the mean value of the probability distribution vcov(f10) # the variance-covariance matrix of the probability distribution } \keyword{classes} sn/man/dmst.Rd0000644000176200001440000001275412550701402012710 0ustar liggesusers% file sn/man/dmst.Rd % This file is a component of the package 'sn' for R % copyright (C) 2002-2013 Adelchi Azzalini %--------------------- \name{dmst} \alias{dmst} \alias{pmst} \alias{rmst} \alias{dmsc} \alias{pmsc} \alias{rmsc} \title{Multivariate skew-\eqn{t} distribution and skew-Cauchy distribution} \description{Probability density function, distribution function and random number generation for the multivariate skew-\eqn{t} (\acronym{ST}) and skew-Cauchy (\acronym{SC}) distributions.} \usage{ dmst(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL, log=FALSE) pmst(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL, ...) rmst(n=1, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, dp=NULL) dmsc(x, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL, log=FALSE) pmsc(x, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL, ...) rmsc(n=1, xi=rep(0,length(alpha)), Omega, alpha, dp=NULL) } \arguments{ \item{x}{for \code{dmst} and \code{dmsc}, this is either a vector of length \code{d}, where \code{d=length(alpha)}, or a matrix with \code{d} columns, representing the coordinates of the point(s) where the density must be avaluated; for \code{pmst} and \code{pmsc}, only a vector of length \code{d} is allowed.} \item{xi}{a numeric vector of length \code{d} representing the location parameter of the distribution; see \sQuote{Background}. In a call to \code{dmst} or \code{dmsc}, \code{xi} can be a matrix, whose rows represent a set of location parameters; in this case, its dimensions must match those of \code{x}.} \item{Omega}{a symmetric positive-definite matrix of dimension \code{(d,d)}; see Section \sQuote{Background}.} \item{alpha}{a numeric vector of length \code{d} which regulates the slant of the density; see Section \sQuote{Background}. \code{Inf} values in \code{alpha} are not allowed.} \item{nu}{a positive value representing the degrees of freedom of \acronym{ST} distribution; does not need to be integer. Default value is \code{nu=Inf} which corresponds to the multivariate skew-normal distribution.} \item{dp}{a list with three elements named \code{xi}, \code{Omega}, \code{alpha} and \code{nu}, containing quantities as described above. If \code{dp} is specified, this prevents specification of the individual parameters.} \item{n}{a numeric value which represents the number of random vectors to be drawn; default value is \code{1}.} \item{log}{logical (default value: \code{FALSE}); if \code{TRUE}, log-densities are returned.} \item{...}{additional parameters passed to \code{pmt}.} } \value{A vector of density values (\code{dmst} and \code{dmsc}) or a single probability (\code{pmst} and \code{pmsc}) or a matrix of random points (\code{rmst} and \code{rmsc}).} \details{Typical usages are \preformatted{% dmst(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, log=FALSE) dmst(x, dp=, log=FALSE) pmst(x, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf, ...) pmst(x, dp=, ...) rmst(n=1, xi=rep(0,length(alpha)), Omega, alpha, nu=Inf) rmst(n=1, dp=) dmsc(x, xi=rep(0,length(alpha)), Omega, alpha, log=FALSE) dmsc(x, dp=, log=FALSE) pmsc(x, xi=rep(0,length(alpha)), Omega, alpha, ...) pmsc(x, dp=, ...) rmsc(n=1, xi=rep(0,length(alpha)), Omega, alpha) rmsc(n=1, dp=) } Function \code{pmst} requires \code{\link[mnormt]{dmt}} from package \pkg{mnormt}; the accuracy of its computation can be controlled via argument \code{\dots}.} \section{Background}{ The family of multivariate \acronym{ST} distributions is an extension of the multivariate Student's \eqn{t} family, via the introduction of a \code{alpha} parameter which regulates asymmetry; when \code{alpha=0}, the skew-\eqn{t} distribution reduces to the commonly used form of multivariate Student's \eqn{t}. Further, location is regulated by \code{xi} and scale by \code{Omega}, when its diagonal terms are not all 1's. When \code{nu=Inf} the distribution reduces to the multivariate skew-normal one; see \code{dmsn}. Notice that the location vector \code{xi} does not represent the mean vector of the distribution (which in fact may not even exist if \code{nu <= 1}), and similarly \code{Omega} is not \emph{the} covariance matrix of the distribution, although it is \emph{a} covariance matrix. For additional information, see Section 6.2 of the reference below. The family of multivariate \acronym{SC} distributions is the subset of the \acronym{ST} family, obtained when \code{nu=1}. While in the univariate case there are specialized functions for the \acronym{SC} distribution, \code{dmsc}, \code{pmsc} and \code{rmsc} simply make a call to \code{dmst, pmst, rmst} with argument \code{nu} set equal to 1.} \references{ % Azzalini, A. and Capitanio, A. (2003). % Distributions generated by perturbation of symmetry % with emphasis on a multivariate skew \emph{t} distribution. % \emph{J.Roy. Statist. Soc. B} \bold{65}, 367--389. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monograph series. } \seealso{ \code{\link{dst}}, \code{\link{dsc}}, \code{\link{dmsn}}, \code{\link[mnormt]{dmt}}, \code{\link{makeSECdistr}} } \examples{ x <- seq(-4,4,length=15) xi <- c(0.5, -1) Omega <- diag(2) Omega[2,1] <- Omega[1,2] <- 0.5 alpha <- c(2,2) pdf <- dmst(cbind(x,2*x-1), xi, Omega, alpha, 5) rnd <- rmst(10, xi, Omega, alpha, 6) p1 <- pmst(c(2,1), xi, Omega, alpha, nu=5) p2 <- pmst(c(2,1), xi, Omega, alpha, nu=5, abseps=1e-12, maxpts=10000) } \keyword{distribution} \keyword{multivariate} sn/man/selm.Rd0000644000176200001440000005461713204565461012717 0ustar liggesusers% file sn/man/selm.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2017 Adelchi Azzalini %--------------------- \name{selm} \encoding{UTF-8} \alias{selm} \concept{regression} \concept{skew-elliptical distribution} \title{Fitting linear models with skew-elliptical error term} \description{Function \code{selm} fits a \code{l}inear \code{m}odel with \code{s}kew-\code{e}lliptical error term. The term \sQuote{skew-elliptical distribution} is an abbreviated equivalent of skew-elliptically contoured (\acronym{SEC}) distribution. The function works for univariate and multivariate response variables.} \usage{ selm(formula, family = "SN", data, weights, subset, na.action, start = NULL, fixed.param = list(), method = "MLE", penalty=NULL, offset, model = TRUE, x = FALSE, y = FALSE, ...) } \arguments{ \item{formula}{an object of class \code{"\link[stats]{formula}"} (or one that can be coerced to that class): a symbolic description of the model to be fitted, using the same syntax used for the similar parameter of e.g. \code{"\link[stats]{lm}"}, with the restriction that the constant term must not be removed from the linear predictor. % The details of model specification are given under \sQuote{Details}. } \item{family}{a character string which selects the parametric family of \acronym{SEC} type assumed for the error term. It must be one of \code{"SN"} (default), \code{"ST"} or \code{"SC"}, which correspond to the skew-normal, the skew-\emph{t} and the skew-Cauchy family, respectively. See \code{\link{makeSECdistr}} for more information on these families and the set of \acronym{SEC} distributions; notice that the family \code{"ESN"} listed there is not allowed here.} \item{data}{an optional data frame containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{selm} is called.} \item{weights}{a numeric vector of weights associated to individual observations. Weights are supposed to represent frequencies, hence must be non-negative integers (not all 0) and \code{length(weights)} must equal the number of observations. If not assigned, a vector of all 1's is generated.} \item{subset}{an optional vector specifying a subset of observations to be used in the fitting process. It works like the same parameter in \code{\link[stats]{lm}}.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{\link[base]{options}}. The \sQuote{factory-fresh} default is \code{\link{na.omit}}. Another possible value is \code{NULL}, no action. % Value \code{\link[stats]{na.exclude}} can be useful. } \item{start}{a vector (in the univariate case) or a list (in the multivariate case) of initial \acronym{DP} values for searching the parameter estimates. See \sQuote{Details} about a choice of \kbd{start} to be avoided. If \code{start=NULL} (default), initial values are selected by the procedure.} \item{fixed.param}{a list of assignments of parameter values which must be kept fixed in the estimation process. Currently, there only two types of admissible constraint: one is to set \code{alpha=0} to impose a symmetry condition of the distribution; the other is to set \code{nu=}, to fix the degrees of freedom at the named \code{} when \code{family="ST"}, for instance \code{list(nu=3)}. See \sQuote{Details} for additional information. } \item{method}{a character string which selects the estimation method to be used for fitting. Currently two options exist: \code{"MLE"} (default) and \code{"MPLE"}, corresponding to standard maximum likelihood and maximum penalized likelihood estimation, respectively. See \sQuote{Details} for additional information. } \item{penalty}{a character string which denotes the penalty function to be subtracted to the log-likelihood function, when \code{method="MPLE"}; if \code{penalty=NULL} (default), a pre-defined function is adopted. See \sQuote{Details} for a description of the default penalty function and for the expected format of alternative specifications. When \code{method="MLE"}, no penalization is applied and this argument has no effect.} \item{offset}{this can be used to specify an \emph{a priori} known component to be included in the linear predictor during fitting. This should be \code{NULL} or a numeric vector of length equal to the number of cases. One or more \code{\link{offset}} terms can be included in the formula instead or as well, and if more than one are specified their sum is used. } \item{model, x, y}{logicals. If \code{TRUE}, the corresponding components of the fit are returned.} \item{\dots}{optional control parameters, as follows. \itemize{ \item \code{trace}: a logical value which indicates whether intermediate evaluations of the optimization process are printed (default: \code{FALSE}). \item \code{info.type}: a character string which indicates the type of Fisher information matrix; possible values are \code{"observed"} (default) and \code{"expected"}. Currently \code{"expected"} is implemented only for the \acronym{SN} family. \item \code{opt.method}: a character string which selects the numerical optimization method, among the possible values \code{"nlminb", "Nelder-Mead", "BFGS", "CG", "SANN"}. If \code{opt.method="nlminb"} (default), function \code{\link[stats]{nlminb}} is called, otherwise function \code{\link[stats]{optim}} is called with \code{method} equal to \code{opt.method}. \item \code{opt.control}: a list of control parameters which is passed on to \code{nlminb} or to \code{optim}, depending on the choice of \code{opt.method}. } } } \details{By default, \code{selm} fits the selected model by maximum likelihood estimation (\acronym{MLE}), making use of some numerical optimization method. Maximization is performed in one parameterization, usually \acronym{DP}, and then the estimates are mapped to other parameter sets, \acronym{CP} and pseudo-\acronym{CP}; see \code{\link{dp2cp}} for more information on parameterizations. These parameter transformations are carried out trasparently to the user. The observed information matrix is used to obtain the estimated variance matrix of the \acronym{MLE}'s and from this the standard errors. Background information on \acronym{MLE} in the context of \acronym{SEC} distributions is provided by Azzalini and Capitanio (2014); see specifically Chapter 3, Sections 4.3, 5.2, 6.2.5--6. For additional information, see the original research work referenced therein as well as the sources quoted below. Although the density functionof SEC distributions are expressed using \acronym{DP} parameter sets, the methods associated to the objects created by this function communicate, by default, their outcomes in the \acronym{CP} parameter set, or its variant form pseudo-\acronym{CP} when \acronym{CP} does not exist; the \sQuote{Note} at \code{\link{summary.selm}} explains why. A more detailed discussion is provided by Azzalini and Capitanio (1999, Section 5.2) and Arellano-Valle and Azzalini (2008, Section 4), for the univariate and the multivariate SN case, respectively; an abriged account is available in Sections 3.1.4--6 and 5.2.3 of Azzalini and Capitanio (2014). For the ST case, see Arellano-Valle and Azzalini (2013). There is a known open issue which affects computation of the information matrix of the multivariate skew-normal distribution when the slant parameter \eqn{\alpha} approaches the null vector; see p.149 of Azzalini and Capitanio (2014). Consequently, if a model with multivariate response is fitted with \code{family="SN"} and the estimate \code{alpha} of \eqn{\alpha} is at the origin or neary so, the information matrix and the standard errors are not computed and a warning message is issued. In this unusual circumstance, a simple work-around is to re-fit the model with \code{family="ST"}, which will work except in remote cases when (i) the estimated degrees of freedom \code{nu} diverge and (ii) still \code{alpha} remains at the origin. The optional argument \code{fixed.param=list(alpha=0)} imposes the constraint \eqn{\alpha=0} in the estimation process; in the multivariate case, the expression is interpreted in the sense that all the components of vector \eqn{\alpha} are zero, which implies symmetry of the error distribution, irrespectively of the parameterization subsequently adopted for summaries and diagnostics. When this restriction is selected, the estimation method cannot be set to \code{"MPLE"}. Under the constraint \eqn{\alpha=0}, if \code{family="SN"}, the model is fitted similarly to \code{lm}, except that here \acronym{MLE} is used for estimation of the covariance matrix. If \code{family="ST"} or \code{family="SC"}, a symmetric Student's \eqn{t} or Cauchy distribution is adopted. Under the constraint \eqn{\alpha=0}, the location parameter \eqn{\xi}{xi} coincides with the mode and the mean of the distribution, when the latter exists. In addition, when the covariance matrix of a \acronym{ST} distribution exists, it differs from \eqn{\Omega} only by a multiplicative factor. Consequently, the summaries of a model of this sort automatically adopt the \acronym{DP} parametrization. The other possible form of constraint allows to fix the degrees of freedom when \code{family="ST"}. The two constraints can be combined writing, for instance, \code{fixed.param=list(alpha=0, nu=6)}. The constraint \code{nu=1} is equivalent to select \code{family="SC"}. In practice, an expression of type \code{fixed.param=list(..)} can be abbreviated to \code{fixed=list(..)}. Argument \kbd{start} allows to set the initial values, with respect to the \acronym{DP} parameterization, of the numerical optimization. However, there is a specific choice of start to be avoided. When \kbd{family="SN"}, do not set the shape parameter \kbd{alpha} exactly at 0, as this would blow-up computation of the log-likelihood gradient and the Hessian matrix. This is not due to a software bug, but to a known peculiar behaviour of the log-likelihood function at that specific point. Therefore, in the univariate case for instance, do not set e.g. \kbd{start=c(12, 21, 0)}, but set instead something like \kbd{start=c(12, 21, 0.001)}. % Also, setting such an initial $\alpha=0$ or close to 0 is a questionable % choice anyway: if one fits a model of this class, then some asymmetry is % expected to be present and it is odd to start the search from a symmetry % condition. Recall that, if one needs to fit a model forcing 0 asymmetry, typically to compare two log-likelihood functions with/without asymmetry, then the option to use is \kbd{fixed.param=list(alpha=0)}. In some cases, especially for small sample size, the \acronym{MLE} occurs on the frontier of the parameter space, leading to \acronym{DP} estimates with \code{abs(alpha)=Inf} or to a similar situation in the multivariate case or in an alternative parameterization. Such outcome is regared by many as unsatisfactory; surely it prevents using the observed information matrix to compute standard errors. This problem motivates the use of maximum penalized likelihood estimation (\acronym{MPLE}), where the regular log-likelihood function \eqn{\log~L}{log(L)} is penalized by subtracting an amount \eqn{Q}, say, increasingly large as \eqn{|\alpha|} increases. Hence the function which is maximized at the optimization stage is now \eqn{\log\,L~-~Q}{log(L) - Q}. If \code{method="MPLE"} and \code{penalty=NULL}, the default function \code{Qpenalty} is used, which implements the penalization: \deqn{Q(\alpha) = c_1 \log(1 + c_2 \alpha_*^2)}{% Q(\alpha)= c₁ log(1 + c₂ [\alpha*]²)} where \eqn{c_1}{c₁} and \eqn{c_2}{c₂} are positive constants, which depend on the degrees of freedom \code{nu} in the \code{ST} case, \deqn{\alpha_*^2 = \alpha^\top \bar\Omega \alpha}{%? [\alpha*]² = \alpha' cor(\Omega) \alpha} and \eqn{\bar\Omega}{cor(\Omega)} denotes the correlation matrix associated to the scale matrix \code{Omega} described in connection with \code{\link{makeSECdistr}}. In the univariate case \eqn{\bar\Omega=1}{cor(\Omega)=1}, so that \eqn{\alpha_*^2=\alpha^2}{[\alpha*]²=\alpha²}. Further information on \acronym{MPLE} and this choice of the penalty function is given in Section 3.1.8 and p.111 of Azzalini and Capitanio (2014); for a more detailed account, see Azzalini and Arellano-Valle (2013) and references therein. It is possible to change the penalty function, to be declared via the argument \code{penalty}. For instance, if the calling statement includes \code{penalty="anotherQ"}, the user must have defined \verb{ }\code{anotherQ <- function(alpha_etc, nu = NULL, der = 0)} with the following arguments. \itemize{ \item \code{alpha_etc}: in the univariate case, a single value \code{alpha}; in the multivariate case, a two-component list whose first component is the vector \code{alpha}, the second one is matrix equal to \code{cov2cor(Omega)}. % \eqn{\bar\Omega}{corOmega}. \item \code{nu}: degrees of freedom, only relevant if \code{family="ST"}. \item \code{der}: a numeric value which indicates the required order of derivation; if \code{der=0} (default value), only the penalty \code{Q} needs to be retuned by the function; if \code{der=1}, \code{attr(Q, "der1")} must represent the first order derivative of \code{Q} with respect to \code{alpha}; if \code{der=2}, also \code{attr(Q, "der2")} must be assigned, containing the second derivative (only required in the univariate case). } This function must return a single numeric value, possibly with required attributes when is called with \code{der>1}. Since \pkg{sn} imports functions \code{\link[numDeriv]{grad}} and \code{\link[numDeriv]{hessian}} from package \pkg{numDeriv}, one can rely on them for numerical evaluation of the derivatives, if they are not available in an explicit form. This penalization scheme allows to introduce a prior distribution \eqn{\pi} for \eqn{\alpha} by setting \eqn{Q=-\log\pi}{Q=-log(\pi)}, leading to a maximum \emph{a posteriori} estimate in the stated sense. See \code{\link{Qpenalty}} for more information and an illustration. The actual computations are not performed within \code{selm} which only sets-up ingredients for work of \code{\link{selm.fit}} and other functions further below this one. See \code{\link{selm.fit}} for more information. } \value{an S4 object of class \code{selm} or \code{mselm}, depending on whether the response variable of the fitted model is univariate or multivariate; these objects are described in the \code{\linkS4class{selm} class}. } \references{ Arellano-Valle, R. B., and Azzalini, A. (2008). The centred parametrization for the multivariate skew-normal distribution. \emph{J. Multiv. Anal.} \bold{99}, 1362--1382. Corrigendum: \bold{100} (2009), 816. Arellano-Valle, R. B., and Azzalini, A. (2013, available online 12 June 2011). The centred parametrization and related quantities for the skew-\emph{t} distribution. \emph{J. Multiv. Anal.} \bold{113}, 73--90. Azzalini, A. and Capitanio, A. (1999). Statistical applications of the multivariate skew normal distribution. \emph{J.Roy.Statist.Soc. B} \bold{61}, 579--602. Full-length version available at \url{http://arXiv.org/abs/0911.2093} Azzalini, A. and Arellano-Valle, R. B. (2013, available online 30 June 2012). Maximum penalized likelihood estimation for skew-normal and skew-\emph{t} distributions. \emph{J. Stat. Planning & Inference} \bold{143}, 419--433. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. Magnus and Neudecker } \author{Adelchi Azzalini} \section{Cautionary notes}{ The first of these notes applies to the stage \emph{preceding} the use of \kbd{selm} and related fitting procedures. Before fitting a model of this sort, consider whether you have enough data for this task. In this respect, the passage below taken from p.63 of Azzalini and Capitanio (2014) is relevant. \dQuote{Before entering technical aspects, it is advisable to underline a qualitative effect of working with a parametric family which effectively is regulated by moments up to the third order. The implication is that the traditional rule of thumb by which a sample size is small up to ‘about \eqn{n = 30}’, and then starts to become ‘large’, while sensible for a normal population or other two-parameter distribution, is not really appropriate here. To give an indication of a new threshold is especially difficult, because the value of \eqn{\alpha} also has a role here. Under this \emph{caveat}, numerical experience suggests that ‘about \eqn{n = 50}’ may be a more appropriate guideline in this context.} The above passage referred to the univariate SN context. In the multivariate case, increase the sample size appropriately, particularly in the ST case. All of this is not to say that one cannot attempt fitting these models with small or moderate sample size. However, one must be aware of the implications and not be surprised of problems, if they appear. The second cautionary note refers instead to the outcome of a call to \kbd{selm} and related function, or the lack of it. The estimates are obtained by numerical optimization methods and, as usual in similar cases, there is no guarantee that the maximum of the objective function is achieved. Consideration of model simplicity and of numerical experience indicate that models with \acronym{SN} error terms generally produce more reliable results compared to those with the \acronym{ST} family. Take into account that models involving a traditional Student's \eqn{t} distribution with unknown degres of freedom can already be problematic; the presence of the (multivariate) slant parameter \eqn{\alpha} in the \acronym{ST} family cannot make things any simpler. Consequently, care must be exercised, especially so if one works with the (multivariate) \acronym{ST} family. Consider re-fitting a model with different starting values and, in the \acronym{ST} case, building the profile log-likelihood for a range of \eqn{\nu} values; function \code{\link{profile.selm}} can be useful here. Details on the numerical optimization which has produced object \code{obj} can be estracted with \code{slot(obj, "opt.method")}; inspection of this component can be useful in problematic cases. Be aware that occasionally \code{optim} and \code{nlminb} declare successful completion of a regular minimization problem at a point where the Hessian matrix is not positive-definite. Two cases of this sort are presented in the final portion of the examples below. } \seealso{\itemize{ \item \code{\linkS4class{selm}-class} for classes \code{"selm"} and \code{"mselm"}, \code{\link{summary.selm}} for summaries, \code{\link{plot.selm}} for plots, \code{\link{residuals.selm}} for residuals and fitted values \item the generic functions \code{\link{coef}}, \code{\link{logLik}}, \code{\link{vcov}}, \code{\link{profile}}, \code{\link{confint}}, \code{\link{predict}} \item the underlying function \code{\link{selm.fit}} and those further down \item the selection of a penalty function of the log-likelihood, such as \code{\link{Qpenalty}} \item the function \code{\link{extractSECdistr}} to extract the \acronym{SEC} error distribution from an object returned by \code{selm} \item the broad underlying logic and a number of ingredients are like in function \code{\link[stats]{lm}} }} \examples{ data(ais) m1 <- selm(log(Fe) ~ BMI + LBM, family="SN", data=ais) print(m1) summary(m1) s<- summary(m1, "DP", cov=TRUE, cor=TRUE) plot(m1) plot(m1, param.type="DP") logLik(m1) coef(m1) coef(m1, "DP") var <- vcov(m1) # m1a <- selm(log(Fe) ~ BMI + LBM, family="SN", method="MPLE", data=ais) m1b <- selm(log(Fe) ~ BMI + LBM, family="ST", fixed.param=list(nu=8), data=ais) # data(barolo) attach(barolo) A75 <- (reseller=="A" & volume==75) logPrice <- log(price[A75],10) m <- selm(logPrice ~ 1, family="ST") summary(m) plot(m, which=2, col=4, main="Barolo log10(price)") # cfr Figure 4.7 of Azzalini & Capitanio (2014), p.107 detach(barolo) #----- # examples with multivariate response # m3 <- selm(cbind(BMI, LBM) ~ WCC + RCC, family="SN", data=ais) plot(m3, col=2, which=2) summary(m3, "dp") coef(m3) coef(m3, vector=FALSE) # data(wines) m28 <- selm(cbind(chloride, glycerol, magnesium) ~ 1, family="ST", data=wines) dp28 <- coef(m28, "DP", vector=FALSE) pcp28 <- coef(m28, "pseudo-CP", vector=FALSE) \donttest{# the next statement takes a little more time than others plot(m28) } \donttest{ # example of computation and plot of a (relative twice) profile log-likelihood; # since it takes some time, set a coarse grid of nu values nu.vector <- seq(3, 8, by=0.5) logL <- numeric(length(nu.vector)) for(k in 1:length(nu.vector)) { m28.f <- selm(cbind(chloride, glycerol, magnesium) ~ 1, family="ST", fixed=list(nu=nu.vector[k]), data=wines) logL[k] <- logLik(m28.f) cat(format(c(nu.vector[k], logL[k])), "\n") } plot(nu.vector, 2*(logL-max(logL)), type="b") ok <- which.max(logL) abline(v=nu.vector[ok], lty=2) # compare maximum of this curve with MLE of nu in summary(m28, 'dp') } # m4 <- selm(cbind(alcohol,sugar)~1, family="ST", data=wines) m5 <- selm(cbind(alcohol,sugar)~1, family="ST", data=wines, fixed=list(alpha=0)) print(1 - pchisq(2*as.numeric(logLik(m4)-logLik(m5)), 2)) # test for symmetry # \donttest{ # illustrate final passage of 'Warning' section above: # the execution of the next selm command is known to produce warning messages # although the optimizer declares successful convergence m31 <- selm(cbind(BMI, LBM)~ Ht + Wt, family="ST", data=ais) # Warning message... slot(m31, "opt.method")$convergence # a 0 value indicates success # the next case is similar m32 <- selm(cbind(BMI, LBM)~ Ht + Wt, family="ST", data=ais, opt.method="BFGS") # Warning message... slot(m32, "opt.method")$convergence } } \keyword{regression} \keyword{univar} \keyword{multivariate} sn/man/summary.SECdistr-class.Rd0000644000176200001440000000407012255404114016212 0ustar liggesusers% file sn/man/summary.SECdistr-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{summary.SECdistrMv-class} \Rdversion{1.1} \docType{class} \alias{summary.SECdistrMv-class} \alias{summary.SECdistrUv-class} \alias{show,summary.SECdistrMv-method} \alias{show,summary.SECdistrUv-method} \title{Classes \code{summary.SECdistrMv} and \code{summary.SECdistrUv}} \description{Summaries of objects of classes \code{SECdistrMv} and \code{SECdistrUv}} \section{Objects from the Class}{ Objects can be created by calls of type \code{summary(object)} when \code{object} is of class either \code{"SECdistrMv"} or \code{"SECdistrUv"}.} \section{Slots}{ \describe{ \item{\code{family}:}{A character string which represents the parametric family of \acronym{SEC} type } \item{\code{dp}:}{Object of class \code{"list"} or \code{"vector"} for \code{"SECdistrMv"} and \code{"SECdistrUv"}, respectively} \item{\code{name}:}{Object of class \code{"character"} with the name of distribution } \item{\code{compNames}:}{For \code{"SECdistrMv"} objects, a character vector with names of the components of the multivariate distribution} \item{\code{cp}:}{Object of class \code{"list"} or \code{"vector"} for \code{"SECdistrMv"} and \code{"SECdistrUv"}, respectively} \item{\code{cp.type}:}{a character string of the \acronym{CP} version} \item{\code{aux}:}{A list of auxiliary quantities } } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "summary.SECdistrMv")}: ... } \item{show}{\code{signature(object = "summary.SECdistrUv")}: ... } } } %\references{%% ~~put references to the literature/web site here~~} \author{Adelchi Azzalini} % \note{%% ~~further notes~~} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{\code{\link{summary.SECdistrMv}}, \code{\link{summary.SECdistrUv}}, \code{\link{makeSECdistr}}, \code{\link{dp2cp}} } % \examples{showClass("summary.SECdistrMv")} \keyword{classes} sn/man/barolo.Rd0000644000176200001440000000347412531106134013216 0ustar liggesusers% file sn/man/barolo.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{barolo} \alias{barolo} \docType{data} \title{Price of Barolo wine} \description{A data frame with prices of bottles of Barolo wine and some auxiliary variables} \usage{data(barolo)} \format{A data frame with 307 observations on five variables, as follows: \tabular{ll}{% \code{reseller}\tab reseller code (factor with levels \code{A, B, C, D}) \cr \code{vintage} \tab vintage year (numeric) \cr \code{volume} \tab content volume in centilitres (numeric) \cr \code{price} \tab price in Euro (numeric) \cr \code{age} \tab age in 2010 (numeric) } For six items, \code{vintage} is \code{NA}'s and so also \code{age}. Three items have a non-standard volume of 50 cl. } \details{The data have been obtained in July 2010 from the websites of four Italian wine resellers, selecting only quotations of Barolo wine, which is produced in the Piedmont region of Italy. The price does not include the delivery charge. The data have been presented in Section 4.3.2 of the reference below, where a subset of them has been used for illustrative purposes. This subset refers to reseller \code{"A"} and bottles of 75cl. } \source{ Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \examples{ data(barolo) attach(barolo) f <- cut(age, c(0, 5, 6, 8, 11, 30)) table(volume, f) plot(volume, price, col=as.numeric(f), pch=as.character(reseller)) legend(400, 990, col=1:5, lty=1, title="age class", legend=c("4-5", "6", "7-8", "9-11", "12-30")) # A75 <- (reseller=="A" & volume==75) hist(log(price[A75],10), col="gray85") # see Figure 4.7 of the source } \keyword{datasets} sn/man/sn-st.info.Rd0000644000176200001440000001505713047131223013736 0ustar liggesusers% file sn/man/sn-st.info.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013 Adelchi Azzalini %--------------------- \name{sn-st.info} \alias{sn.infoUv} \alias{sn.infoMv} \alias{st.infoUv} \alias{st.infoMv} \title{Expected and observed Fisher information for \acronym{SN} and \acronym{ST} distributions} \description{ Computes Fisher information for parameters of simple sample having skew-normal (\acronym{SN}) or skew-\eqn{t} (\acronym{ST}) distribution or for a regression model with errors term having such distributions, in the \acronym{DP} and \acronym{CP} parametrizations. } \usage{ sn.infoUv(dp=NULL, cp=NULL, x=NULL, y, w, penalty=NULL, norm2.tol=1e-06) sn.infoMv(dp, x=NULL, y, w, penalty=NULL, norm2.tol=1e-06) st.infoUv(dp = NULL, cp = NULL, x = NULL, y, w, fixed.nu = NULL, symmetr = FALSE, penalty = NULL, norm2.tol = 1e-06) st.infoMv(dp, x = NULL, y, w, fixed.nu = NULL, symmetr = FALSE, penalty = NULL, norm2.tol = 1e-06) } \arguments{ \item{dp, cp}{direct or centred parameters, respectively; one of the two vectors must be supplied, but not both. For the univariate \acronym{SN} distribution, \code{sn.infoUv} is to be used, and these arguments are vectors. In the multivariate case, \code{sn.infoMv} is to be used and these arguments are lists. See \code{\link{dp2cp}} for their description.} \item{x}{an optional matrix which represents the design matrix of a regression model} \item{y}{a numeric vector (for \code{sn.infoUv} and \code{st.infoUv}) or a matrix (for \code{sn.infoMv} and \code{st.infoMv}) representing the response. In the \acronym{SN} case ( \code{sn.infoUv} and \code{sn.infoMv}), \code{y} can be missing, and in this case the expected information matrix is computed; otherwise the observed information is computed. In the \acronym{ST} case (\code{st.infoUv} and \code{st.infoMv}), \code{y} is a required argument, since only the observed information matrix for \acronym{ST} distributions is implemented. See \sQuote{Details} for additional information.} \item{w}{an optional vector of weights; if missing, a vector of 1's is generated.} \item{fixed.nu}{an optional numeric value which declared a fixed value of the degrees of freedom, \code{nu}. If not \code{NULL}, the information matrix has a dimension reduced by 1.} \item{symmetr}{a logical flag which indicates whether a symmetry condition of the distribution is being imposed; default is \code{symmetr=FALSE}.} \item{penalty}{a optional character string with the name of the penalty function used in the call to \code{\link{selm}}; see this function for its description.} \item{norm2.tol}{for the observed information case, the Mahalanobis squared distance of the score 0 is evaluated; if it exceeds \code{norm2.tol}, a warning message is issued, since the \sQuote{information matrix} so evaluated may be not positive-definite. See \sQuote{Details} for additional information.} } \value{ a list containing the following components: \item{dp, cp}{one of the two arguments is the one supplied on input; the other one matches the previous one in the alternative parametrization.} \item{type}{the type of information matrix: "observed" or "expected".} \item{info.dp, info.cp}{matrices of Fisher (observed or expected) information in the two parametrizations.} \item{asyvar.dp, asyvar.cp}{inverse matrices of Fisher information in the two parametrizations, when available; See \sQuote{Details} for additional information. } \item{aux}{a list containing auxiliary elements, depending of the selected function and the type of computation.} } \section{Details}{ In the univariate \acronym{SN} case, when \code{x} is not set, then a simple random sample is assumed and a matrix \code{x} with a single column of all 1's is constructed; in this case, the supplied vector \code{dp} or \code{cp} must have length 3. If \code{x} is set, then the supplied vector of parameters, \code{dp} or \code{cp}, must have length \code{ncol(x)+2}. In the multivariate case, a direct extension of this scheme applies. If the observed information matrix is required, \code{dp} or \code{dp} should represent the maximum likelihood estimates (MLE) for the given \code{y}, otherwise the information matrix may fail to be positive-definite. Therefore, the squared Mahalobis norm of the score vector is evaluated and compared with \code{norm2.tol}. If it exceeds this threshold, it is taken as an indication that the parameter is not at the \acronym{MLE} and a warning message is issued. The returned list still includes \code{info.dp} and \code{info.cp}, but in this case these represent merely the matrices of second derivatives; \code{asyvar.dp} and \code{asyvar.cp} are set to \code{NULL}. } \section{Background}{ The information matrix for the the univariate \acronym{SN} distribution in the two stated parameterizations in discussed in Sections 3.1.3--4 of Azzalini and Capitanio (2014). For the multivariate distribution, Section 5.2.2 of this monograph summarizes briefly the findings of Arellano-Valle and Azzalini (2008). For \acronym{ST} distributions, only the observed information matrix is provided currently. Computation for the univariate case is based on DiCiccio and Monti (2011). For the multivariate case, the score function is computed using expression of Arellano-Valle (2010) followed by numerical differentiation. } \references{ Arellano-Valle, R. B. (2010). The information matrix of the multivariate skew-$t$ distribution. \emph{Metron}, \bold{LXVIII}, 371--386. Arellano-Valle, R. B., and Azzalini, A. (2008). The centred parametrization for the multivariate skew-normal distribution. \emph{J. Multiv. Anal.} \bold{99}, 1362--1382. Corrigendum: vol.\,100 (2009), p.\,816. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. DiCiccio, T. J. and Monti, A. C. (2011). Inferential aspects of the skew \eqn{t}-distribution. \emph{Quaderni di Statistica} \bold{13}, 1--21. } \seealso{\code{\link{dsn}}, \code{\link{dmsn}}, \code{\link{dp2cp}}} \examples{ infoE <- sn.infoUv(dp=c(0,1,5)) # expected information set.seed(1); rnd <- rsn(100, dp=c(0, 1, 3)) fit <- selm(rnd~1, family="SN") infoO <- sn.infoUv(cp=coef(fit), y=rnd) # observed information # data(wines) X <- model.matrix(~ pH + wine, data=wines) fit <- sn.mple(x=X, y=wines$alcohol) infoE <- sn.infoUv(cp=fit$cp, x=X) infoO <- sn.infoUv(cp=fit$cp, x=X, y=wines$alcohol) } \keyword{distribution} sn/man/dsn.Rd0000644000176200001440000001211313047127737012531 0ustar liggesusers% file sn/man/dsn.Rd % This file is a component of the package 'sn' for R % copyright (C) 1998-2013 Adelchi Azzalini %--------------------- \name{dsn} \alias{dsn} \alias{psn} \alias{qsn} \alias{rsn} \title{Skew-Normal Distribution} \description{Density function, distribution function, quantiles and random number generation for the skew-normal (\acronym{SN}) and the extended skew-normal (\acronym{ESN}) distribution.} \usage{ dsn(x, xi=0, omega=1, alpha=0, tau=0, dp=NULL, log=FALSE) psn(x, xi=0, omega=1, alpha=0, tau=0, dp=NULL, engine, ...) qsn(p, xi=0, omega=1, alpha=0, tau=0, dp=NULL, tol=1e-8, solver="NR", ...) rsn(n=1, xi=0, omega=1, alpha=0, tau=0, dp=NULL) } \arguments{ \item{x}{vector of quantiles. Missing values (\code{NA}'s) and \code{Inf}'s are allowed.} \item{p}{vector of probabilities. Missing values (\code{NA}s) are allowed} \item{xi}{vector of location parameters.} \item{omega}{vector of scale parameters; must be positive.} \item{alpha}{vector of slant parameter(s); \code{+/- Inf} is allowed. With \code{psn}, it must be of length 1 if \code{engine="T.Owen"}. With \code{qsn}, it must be of length 1.} \item{tau}{a single value representing the `hidden mean' parameter of the \acronym{ESN} distribution; \code{tau=0} (default) corresponds to a \acronym{SN} distribution.} \item{dp}{a vector of length 3 (in the \acronym{SN} case) or 4 (in the \acronym{ESN} case), whose components represent the individual parameters described above. If \code{dp} is specified, the individual parameters cannot be set.} \item{n}{a positive integer representing the sample size.} \item{tol}{a scalar value which regulates the accuracy of the result of \code{qsn}, measured on the probability scale.} \item{log}{logical flag used in \code{dsn} (default \code{FALSE}). When \code{TRUE}, the logarithm of the density values is returned.} \item{engine}{a character string which selects the computing engine; this is either \code{"T.Owen"} or \code{"biv.nt.prob"}, the latter from package \code{mnormt}. If \code{tau != 0} or \code{length(alpha)>1}, \code{"biv.nt.prob"} must be used. If this argument is missing, a default selection rule is applied.} \item{solver}{a character string which selects the numerical method used for solving the quantile equation; possible options are \code{"NR"} (default) and \code{"RFB"}, described in the \sQuote{Details} section.} \item{...}{ additional parameters passed to \code{T.Owen}} } \value{density (\code{dsn}), probability (\code{psn}), quantile (\code{qsn}) or random sample (\code{rsn}) from the skew-normal distribution with given \code{xi}, \code{omega} and \code{alpha} parameters or from the extended skew-normal if \code{tau!=0} } \section{Details}{ Typical usages are \preformatted{% dsn(x, xi=0, omega=1, alpha=0, log=FALSE) dsn(x, dp=, log=FALSE) psn(x, xi=0, omega=1, alpha=0, ...) psn(x, dp=, ...) qsn(p, xi=0, omega=1, alpha=0, tol=1e-8, ...) qsn(x, dp=, ...) rsn(n=1, xi=0, omega=1, alpha=0) rsn(x, dp=) } \code{psn} and \code{qsn} make use of function \code{\link{T.Owen}} or \code{\link[mnormt:dmt]{biv.nt.prob}} In \code{qsn}, the choice \code{solver="NR"} selects the Newton-Raphson method for solving the quantile equation, while option \code{solver="RFB"} alternates a step of \emph{regula falsi} with one of bisection. The \code{"NR"} method is generally more efficient, but \code{"RFB"} is occasionally required in some problematic cases. } \section{Background}{ The family of skew-normal distributions is an extension of the normal family, via the introdution of a \code{alpha} parameter which regulates asymmetry; when \code{alpha=0}, the skew-normal distribution reduces to the normal one. The density function of the \acronym{SN} distribution in the \sQuote{normalized} case having \code{xi=0} and \code{omega=1} is \eqn{2\phi(x)\Phi(\alpha x)}, if \eqn{\phi} and \eqn{\Phi} denote the standard normal density and distribution function. An early discussion of the skew-normal distribution is given by Azzalini (1985); see Section 3.3 for the \acronym{ESN} variant, up to a slight difference in the parameterization. An updated exposition is provided in Chapter 2 of Azzalini and Capitanio (2014); the \acronym{ESN} variant is presented Section 2.2. See Section 2.3 for an historical account. A multivariate version of the distribution is examined in Chapter 5.} \references{ Azzalini, A. (1985). A class of distributions which includes the normal ones. \emph{Scand. J. Statist.} \bold{12}, 171-178. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \seealso{ Functions used by \code{psn}: \code{\link{T.Owen}}, \code{\link[mnormt:dmt]{biv.nt.prob}} Related distributions: \code{\link{dmsn}}, \code{\link{dst}}, \code{\link{dmst}} } \examples{ pdf <- dsn(seq(-3, 3, by=0.1), alpha=3) cdf <- psn(seq(-3, 3, by=0.1), alpha=3) q <- qsn(seq(0.1, 0.9, by=0.1), alpha=-2) r <- rsn(100, 5, 2, 5) qsn(1/10^(1:4), 0, 1, 5, 3, solver="RFB") } \keyword{distribution}