sn/0000755000176200001440000000000014150203404010663 5ustar liggesuserssn/NAMESPACE0000644000176200001440000000552314025406331012114 0ustar liggesusers importFrom("stats", ".getXlevels", "approxfun", "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", "median", "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, biv.nt.prob, mom.mtruncnorm) 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, fournum, st.prelimFit, mst.prelimFit, galton_moors2alpha_nu, pprodt2, pprodn2, qprodt2, tr, blockDiag, dsun, psun, rsun, sunMean, sunVcov, sunMardia, makeSUNdistr, # plot.SUNdistr, summary.SUNdistr, affineTransSUNdistr, marginalSUNdistr, conditionalSUNdistr, joinSUNdistr, convolutionSUNdistr, convertSN2SUNdistr, convertCSN2SUNpar ) 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", "SUNdistr", "summary.SUNdistr") sn/data/0000755000176200001440000000000014150121606011577 5ustar liggesuserssn/data/ais.rda0000644000176200001440000001350714150121606013051 0ustar liggesusersy]]'vjYx˼Iٷ73oc'NbӴ#"Ħ MUQE@ J Ql*)9a)G-{~ܳLmd)eiK[[ۦԶiݛsWmXo_+};6}K {5>ظ>݀sSxNʵfšWn^vorX--?ݦwqwm~~ [߇wN~c$c/댨-QC]Ӡڸ'}͵i֟V_3>}*O?V%xru毿0o{0/mL|i3Oa#\}>Qjvw:?+77:٨(u_n_sFE ۵[P?tKh[o ?U@ ߽mrUގF\ٯNl"]oxnvߝʷm3{:Z'mKRR; Z4^ۥ'zɕC=+h߅=GO#/4\vSvwu__ڨ(7 vK/QN;tŸP|w#GwS߭zD+z;h~߭6z^z5'ծ\ۍKqJy%~4n5Sx]kvO q*?^y(wzo!N{8A.xwJᵇtmWvP6ŧmzP#?jHSKp-n q3މݤsoî^A^Iwn턿_~[Il^}e.wv*N9A^ g ôIz a}@ peOW@A<|Az]Sx=!݃)W|i~@䫿@'=:u.{{7'_G+Q 8}oA\.8m,.TA W;yϝA\~a  yS<Ɂ7WvbO#;Ʃ/ma+=/rWK.zP/='8#=^O}L~="9xW?g==O҉iy7A܏z/o\oǣ{w\\#(~ş=JO|*GH[)Ƅ^M~wC3%'|z߄삿 E;=IR07 /5>L_ŋ/'5h|z{~{(|'=Rڟ}ɫ)Ӈ^*~xP)U~:~{TI>œEz4J%_ IUʵ ?<"`v&i+?t"/+>H_!X//TW}~'g_vY^r}?4cgdrd g@iڟmyM_Cߝm0Jo-N08  pdg)nIn&W^Gv-=dx?3|hxmKc^3Kp*/^}4.,|񈞕Rz\k~/OO+Rѯ}M,Nyu8ϸ{{;EsxEur<.+7~bxW3Nr;<>xygyCaA`{"G u8K8ρg/Ñ -ЮH&[ C^~?{dwLP|ڕk}H3fyg `tcyw!U1?..} qŵ^yy.1, 9U%o>:r/υ_uE#L˽@'9%z\@o~{c <^\K#zSN_o*-]e^-<տt,>מ93>s2ޫKZ_ݟU\>׿z]5<<u3sou%>usb=̺"wn r3ޛYGiWDnV!ޓ1+={2gi߁_ nauruǬ":B"b]կ>k`tVXd ֛݀2N Y7a}c=z 7n>9 'Hn9} INOO#?g烬t|O?:(c{!9] .;ߏ{|g|oہ^h7|Cz}?uvmۉ>8~9?~=>~鷗uA;W߫d~)};h]oaz;k7z{]ف^;i}跛g=K}O?ٳ7o7|K/}Ky/8?}wUAa^͏i_+C  b셯S yQpQHq(\ǯWx̰F2){784=O1U{&Uƞ2O3_:'ʌϹ7:̺~uyé2|g ?+Ys):!}boӑkggo[0(vO_s2YMHu9:g~~wr樟8{?NrU0gG?;O;ӜCcMW^o8ԯ;~'/2O'&9'e7WxpAا\>/}z//U~.h_ [T;Jb>Y וݻԃۯJܹwn_ {_{ϵ>4|ho)}_7ܛ.e}pM;+ׂ{'3~CrB?|.]nU-ZMnK]4؏5ʾsӮ{F_烮}Z[eܬ6%|ZTZ{x/EuKOƑB<8$>Z[{8ij>K?)^> _')=l\÷HƱ4ʼ"b*XK.Wy]qۤe-.J82O>]}0_J g_ kȫ2~W#X/MVt!U [*U^NkU!W5Oj,bCt/x^D_~_G%N,b35Xuj;OVFCgoڟ=nbO-=OJmc>V3\6M77i,\>|v]o*!"=!CAEi鷧=e)gO=)Ğ dYF05ad #kYF0r3a #g9F0rFdaDFdaDFdyF07a #oyFlaĆFlaĆFla$Fba$Fba$F0 Q0a `(F0 Q4a hE(F0Q406gc?fc?F1cǂhhhhhhYhYhYhYhYh9h9h9h9h9hG5S }JwW*RD3k+?Dߌӊ7QTϽ *kZA. ?J߉'beb:eW]QQxPT.yK{(*ωӲ+ ܠ?eZ_F> _cK>F }<(_]/rK$wJK+{/ת}+*exJ(.7C~T6* GT"[vA+Θo^H+ e@oƟz} y+JgR*)exԓ^gS'\5M|kE77g OuS=)_^^/ϕǵgz]y;KS4>7O>gYgg ѿJgO~Wc 7~ )r΄|wucNxww]huo3M{O7ڧ LWD?7-$gw:[K;gꓪjpJne4jL8ZXo7]OGM'Kqθ\c[|!)Hߏ鷈^/\'z@yb]{Iߤtk}ɽHzhXµH)mq\uLޥo18cBUcg|S[4bqx\~q 6tJ7&Un{L@~{\Ieo,ksAO\8}حYr,]GC/ȃx7 w3~ ?=vZ>["byl~ rg/KE~Ԋ}U=.,4=XziQjM?d/WBE/ZnVRʋޒö7k6G+Eg)UUjg7K6m-e'oU5p13wFxyIuP忐~ KY=}+\?s+x% x(?Z ~>s^ϲG) <d/~}.B<'>IyA~I??D^__~W*^#ݵ.>U@Nɟ?hPCB^,Q1E(Wy=ᒻ@ȕ٢+}Џ!('~)9JGʎhl$tC4R/D@iɟGuBޏ^CL͒FgG~ɾ]ğ4D?7i/>\_ >~_%9h$)Jx"7/Uޗ? UKi7 3>YkC:M;ViW=XY`oGgz Sd/\e\]7i dWI'%;Dٌ? vc<}P̑e5+Tt(=z>[-?g.4J;wߑGyzYN(ꩿvr+Q8q]r i+gJ?Lz_-<#P8Ug<1ܭzߏpC[ 7iןN%?ȯH%n:joIߴOsZyͫ>T}FxW~'ѿZ]_^.x3)>3[rO}g?\Yy>8㴳4 @.;޿7r=7Qzg{{ONɏvH/zs/`qqqv9+>g=8]7v=h'5d>w^'>d>M2N+Kh>ixa\6L;yc)d\PWχ1k < 'ƳG0ô^}^kB5 xr[ ~Cn~Hѓ/A=}IϚWD.yˇ?vg}3GN_z?\%0@EwD.9~ 9,G9OSye/a藿!}L*կ%9N9:i7+͹<ӽ~s:Unw;}9jsvĭ?p"gYs5W+?GdH~}KtXXA'9l'@8?{9ԣy*揈ZПVWsNt>_Nyo:<٢_$ C%~ߧz3VUؿmʿSC-qGiG~k ~=4{"=nMa9_܁٣IÒH 9cS?9Xilp~{ />a~)~v`^%~IG?_ƎVu߳t8?Xz']Z7~v< ʍu+l~C'˜mT9ΫBoPG>N`ᚫJqY)L".V"c8xhﴏfelW km-Kܺ^'Y.v:R.Wx6hvnwǷٱysMnrxP>ufs|{.uzkivr`&ο[[lr 6~;r74%nhOW8anͷ^N^o˜|~%>+]גF=ߪuKEvMtSOKjV?jo|%['sZϽzg oۀgϫ~yEڪ[>zAxT|PNtξ~+z`1w6h{L9V/?)߫O'[Wz&/>n_O\m]6zI-E'zTUpu[~=Zr>@rn^Юd zoqЏ܋Am>E{λ{ogg+-9hW\O6GOl_z,-OWGJ'mݓ}>v[+`'ϼm&7.N`ºihp n~:qGv{> uEvҗ6Wn[wtEy̭Y8<8Á| ~jwg"e3`ݵ*cu~~><5Ͻ_{7QGg_7>3ϭsfg7Mnɭcv7/~o? |;j&'4:]pNX?mtuj?3q>.k+Dz_ĭ'~atobA_Pc]:cpaG\@;L;\'D=᲋#A!poS> ~yh J9ǽpnXiO\4tG8W}=Η/q/T=s2?{_ݹq{Gs# N#r.{zO;iw{i[ï==>)ȿh_9}z7>\?΅D#&ne_v\hߴ1p6UýpY&v&y?w9esRy2n$_;wvyphuΪ?z_~Ľ__^/=ǓR),r/skq}H<wJ =doUopCW' }I\C9!}HI|~*9H)x/E:?|?Yz/j?z'~v+~{CGG7rPy)_ŗr^n;Pn{'Uz =ʁG/c@9Q~ Qt'A. ^tht|']{/=P<=Ÿ~WsRc!UÏ]ћR zx@y}'/)wD3N3B\0]¸zş8kDWO sKx8a}G'n 6Jz|W]ʳ2tx6!nw?,]ϱe>Auv!Kv~G;ï~W@wC笃ׯ=zS?a=9X1/RK6^C\.>gJy+".O!DWm\qXٝ<|~5O&Nl !.o⠅ 9iW|AOH_!?ŏaIo0?$n<<ú#q/B-ێB n$?úJpO\.3A/N4K\ }CO/߭OwXߤ`4z?^Szq2ް$8f=a'ջCr~kG,!r\lY (Ol}`?1wx[>-{ Ey9z q\|T옰(<}?bO%*_+|} ];7G;HEXk}L:YcR*7E;{tH$J Mt/B6W_z8> q^qq&[Y tGc \K<'^N"q¾3SK|\I G~蓆q\N>xwι)|-D/ǀ]Ow[XG@y$8]za{v*SăO~)^.uF0o83EcCqK9p0nG{򋰏-~g|Ž trqB\?O=}:5=Q.>V.ebRO̯4b~@<|͟r]|ćҸŸJOwxXa 43 qЛ{y#w;qL毜c,p^$Ɵ9g~^+88`~-'4iOp0.q)|_w(4}6>ű]7cwLS!6qo>޶;qxAp'%|aKpރᅵp꓆xnNw># # }.Xwl;tozqqē~zT~$?9T|cRG"8-vMthđ/xn(G]3.߱BXW}1]n~x;NBMQ>a7]C8&Hbm\,՞&\S=h~qz?Qzc?{}E8;ND[apM|DEoLR{ƟqC;v;H2{U_yG'Wě#>>zoy8YGmEvn C=g׶Gt*վb;tuUΣm-}_mttw_S7a[~_)>ܗxO ~mV. ^w ^!z;w*{>v+ne-wN-ەwtX/X{U=wŏ菸gT8;7ޓ.%:#ZErX d]Խm㯽Z_~ŕ n$O}Hv,e~!v1}g[ooV:byO8FhxVjRs&7%T#%nWǹ-O,ߟ'+bUWև}<;C_ʧnx2V/ZgʝCs}_r/p~r!g).?aos8gdߏ=>] grg8s uMWۮ} @0 C@mv`Oqb'oBzƳ #[}C&ۮ9'Eٸ͇|o#Q^c/><ƞƯ9m |O;cz5q^1oz3=#.LXQ| /LVGy4u;C#Nx=_LJQ['<_iwxX㷰&_jYc7U_%LMCDS"ꠅѿ=$!/P}+C&LZ|%Ax4atb5L&X_J  i:аϾi^[Bt:Y+qRɹe?z^'sn/man/0000755000176200001440000000000014150121606011441 5ustar liggesuserssn/man/st.prelimFit.Rd0000644000176200001440000001062213637426374014334 0ustar liggesusers% file sn/man/st.prelimFit.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2020 Adelchi Azzalini % \name{st.prelimFit} \alias{st.prelimFit} \alias{mst.prelimFit} \title{ Compute preliminary estimates for a linear model with ST-distributed error term } \description{ For a univariate or multivariate linear model where the error term is assumed to have skew-\emph{t} (ST) distribution and the location parameter is a linear function of a set of explanatory values, the functions compute preliminary estimates to be used as initial values for a subsequent maximization of the likelihood function. These functions are mainly intended for internal package use.} \usage{ st.prelimFit(x, y, w, quick = TRUE, verbose = 0, max.nu = 30) mst.prelimFit(x, y, w, quick = TRUE, verbose = 0, max.nu = 30) } \arguments{ \item{x}{design matrix of numeric values. It may be missing; if present, the first column must contain all 1's.} \item{y}{vector of observations of length \code{n}, or a matrix with \code{n} rows.} \item{w}{a vector of non-negative integer weights of length \code{n}; if missing, a vector of all 1's is generated.} \item{quick}{logical value which regulates whether a very quick estimate is produced (default value \code{TRUE}); see \sQuote{Details} for additional information.} \item{verbose}{an integer value which regulates the amount of messages printed out; default value is 0.} \item{max.nu}{threshold for the estimated degrees of freedom} } \details{ The underlying methodology is the one presented by Azzalini and Salehi (2020). In its essence, it is based on the selection of parameter values achieving the best matching between certain quantile-based summaries of the ST distribution and the corresponding empirical quantities for the sample or, in the presence of explanatory variables, the same quantities computed from the residuals after fitting a median regression. Argument \code{quick} selects whether the above-described matching is performed in a quick or in an accurate way. Since the output values of this function are intended to be only initial values for subsequent likelihood maximization, this explains the default option \code{quick=TRUE}. Since the methodology hinges on some selected sample quantiles, it can occasionally be spoiled by poor behaviour of these basic quantiles, especially for small or moderate sample sizes. The more visible effect of such situation is a very large value of the estimated degrees of freedom, which then hampers rather than help a subsequent likelihood maximization. It is therefore appropriate to set an upper limit \code{max.nu} to this component. Argument \code{x} may be missing. In this case, a one-column matrix with all elements 1 is created. } \value{ A call to \code{st.prelimFit} returns a list with these components: \item{dp}{a vector of estimates in the DP parameterization} \item{residuals}{a vector of residual values} \item{logLik}{the corresponding log-likelihood value} A call to \code{mst.prelimFit} returns a list with these components: \item{dp}{a list with the estimates in the DP parameterization} \item{shrink.steps}{the number of shrinking steps applied to the original estimate of the scale matrix to obtain an admissible matrix} \item{dp.matrix}{a numeric matrix formed by the component-wise DP estimates} \item{logLik}{the corresponding log-likelihood value} } \references{ Azzalini, A. and Salehi, M. (2020). Some computational aspects of maximum likelihood estimation of the skew-\emph{t} distribution. In: \emph{Computational and Methodological Statistics and Biostatistics}, edited by Andriëtte Bekker, Ding-Geng Chen and Johannes T. Ferreira. Springer. DOI: 10.1007/978-3-030-42196-0 % https://www.springer.com/gp/book/9783030421953#aboutBook } \author{ Adelchi Azzalini} \note{These functions are mainly intended to be called by \code{\link{selm}}, but they could be of interest for people developing their own procedures.} \seealso{\code{\link[sn]{selm}} and either \code{\link{dst}} or \code{\link{dmst}} for explanation of the DP parameters} \examples{ data(barolo) attach(barolo) A75 <- (reseller=="A" & volume==75) log.price <- log(price[A75], 10) prelimFit <- st.prelimFit(y=log.price) detach(barolo) # data(ais) attach(ais) prelim32 <- mst.prelimFit(y=cbind(BMI, LBM), x=cbind(1, Ht, Wt)) detach(ais) } \keyword{robust} % \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line 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/zeta.Rd0000644000176200001440000000464314030035650012702 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} \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{https://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} \concept{Mills ratio} sn/man/summary.SUNdistr-class.Rd0000644000176200001440000000312114025671652016253 0ustar liggesusers% file sn/man/summary.SUNdistr-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2021 Adelchi Azzalini %--------------------- \name{summary.SUNdistr-class} \Rdversion{1.1} \docType{class} \encoding{UTF-8} \alias{summary.SUNdistr-class} \alias{show,summary.SUNdistr-method} \title{Class \code{summary.SUNdistr}} \description{Summaries of objects of classes \code{SUNdistr}} \section{Objects from the Class}{ Objects can be created by calls of type \code{summary(object)} when \code{object} is of class \code{"SUNdistr"}.} \section{Slots}{ \describe{ \item{\code{dp}:}{a list of parameters} \item{name}{the name of the distribution, a character string} \item{compNames}{the names of the components, a character vector} \item{HcompNames}{the names of the hidden components, a character vector} \item{mean}{the mean value, a vector} \item{var.cov}{the variance-covariance matrix} \item{gamma1}{the marginal indices of asymmetry, a vector} \item{cum3}{the third order cumulants, a three-dimensional array} \item{mardia}{the Mardia's measures of multivariate asymmetry and skewness, a vector of length two} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "summary.SUNdistr")}: ... } } } %\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.SUNdistr}}, \code{\link{makeSUNdistr}}} % \examples{showClass("summary.SUNdistrMv")} \keyword{classes} sn/man/matrix-op.Rd0000644000176200001440000000470314026332730013660 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} \alias{tr} \alias{blockDiag} \title{vech, tr and other matrix operators} \description{vech and other matrix operators} \usage{ vech(A) vech2mat(v) duplicationMatrix(n) tr(x) blockDiag(...) } \arguments{ \item{A}{a (symmetric) square numeric 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}.} \item{x}{a square numeric matrix.} \item{...}{an abitrary numer of matrices or objects coercible into matrices.} } \value{a vector in case of \code{vech}, a scalar in case of \code{tr}, 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{vech2mat(v)} performs the inverse operation and returns the original matrix \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). For a square numeric matrix \code{x}, \code{tr(x)} returns its trace. \code{blockDiag(...)} creates a block-diagonal matrix from a set of matrices or objects coercible into matrices. Generally, this is useful only for numeric objects. } \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), must be a one-column matrix of 0s tr(outer(1:4,2:5)) blockDiag(M[1:2,], 1:2, diag(5:6)) } \keyword{math} \concept{matrix operator} \concept{duplication matrix} sn/man/dsn.Rd0000644000176200001440000001316013650031662012523 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.} \section{Details}{In version 1.6-2, the random number generation method for \code{rsn} has changed; the so-called transformation method (also referred to as the \sQuote{additive representation}) has beeb adopted for all values of \code{tau}. Also, the code has been modified so that there is this form of consistency: provided \code{set.seed()} is reset similarly before calls, code like \code{rsn(5, dp=1:3)} and \code{rsn(10, dp=1:3)}, for instance, will start with the same initial values in the longer sequence as in the shorter sequence.} \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} sn/man/dmsn.Rd0000644000176200001440000001205514030035421012670 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{\link[mnormt]{pmnorm}}.} } % end arguments \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{https://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]{pmnorm}}, \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/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/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/profile.selm.Rd0000644000176200001440000001615614030043736014344 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, levels, 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{levels}{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. If this condition does not hold, the function still proceeds, but no confidence interval or region is delivered. 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 additional information, 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 the 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(s). \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, package="sn") 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 the 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,11) ) } sn/man/modeSECdistr.Rd0000644000176200001440000000423713370543057014276 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}}; if this argument is used, arguments \code{dp} and \code{family} must not be set, and \emph{vice versa}. } } \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")) mode1 <- modeSECdistr(dp3, "ST") mode2 <- modeSECdistr(object=st3) # the same of mode1 } \keyword{multivariate} \keyword{distribution} sn/man/extractSECdistr.Rd0000644000176200001440000000414114025314127015006 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 distribution 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 model } \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/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/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/SUNdistr-class.Rd0000644000176200001440000000624214147735543014573 0ustar liggesusers% file sn/man/SUNdistr-class.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{SUNdistr-class} \Rdversion{1.1} \docType{class} \encoding{UTF-8} \alias{SUNdistr-class} \alias{show.SUNdistr} \alias{show,SUNdistr-method} \alias{mean.SUNdistr} \alias{mean,SUNdistr-method} \alias{vcov.SUNdistr} \alias{vcov,SUNdistr-method} \title{Class \code{"SUNdistr"} and its methods} \description{A class of objects representing Unified Skew-Normal (\acronym{SUN}) distributions.} \section{Objects from the class}{ Objects can be created by a call to the function \code{\link{makeSUNdistr}} or by a suitable transformation of some object of this class.} \section{Slots}{ \describe{ \item{\code{dp}:}{a list of parameters of length five, as described in \code{\link{SUNdistr-base}} } \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.} \item{HcompNames}{a vector of character strings with the names of the hidden variables.} } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "SUNdistr-class")}: \dots } \item{plot}{\code{signature(x = "SUNdistr-class")}: \dots } \item{summary}{\code{signature(object = "SUNdistr-class")}: \dots } \item{mean}{\code{signature(x = "SUNdistr")}: \dots} \item{vcov}{\code{signature(object = "SUNdistr")}: \dots} } } \details{See \code{\link{SUNdistr-base}} for a description of the required structure of \code{dp}. Note that here the methods \code{mean} and \code{vcov} are not applied to data or to a fitted model, but to a \emph{probability distribution}, of which they provide the mean (expected) value and the variance-covariance matrix. The object of this class follow the S4 protocol. } \author{Adelchi Azzalini} \seealso{ \code{\link{plot,SUNdistr-method}}, \eqn{\quad}{} \code{\link{summary,SUNdistr-method}}, \eqn{\quad}{} \code{\link{affineTransSUNdistr}}, \code{\link{marginalSUNdistr}} \code{\link{convertSN2SUNdistr}} to convert a \code{SECdistr} object with family \code{"SN"} or \code{"ESN"} to the equivalent \code{SUNdistr-class} object } \examples{ xi <- c(1, 0, -1) Omega <- matrix(c(2,1,1, 1,3,1, 1,1,4), 3, 3) Delta <- matrix(c(0.72,0.20, 0.51,0.42, 0.88, 0.94), 3, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.8, 0.8, 1), 2, 2) dp3 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=c(-0.5, 0), Gamma=Gamma) sun3 <- makeSUNdistr(dp=dp3, name="firstSUN", compNames=c("x", "w", "z")) show(sun3) plot(sun3) mean(sun3) # the mean value of the probability distribution vcov(sun3) # the variance-covariance matrix of the probability distribution summary(sun3) # a more detailed summary } %---------------- \keyword{classes} \keyword{distribution} \keyword{multivariate} % \concept{SUN distribution} \concept{Unified Skew-Normal distribution} \concept{CSN distribution} \concept{Closed Skew-Normal distribution} \concept{FUSN distribution} \concept{Fundamental Skew-Normal distribution} sn/man/convertSN2SUNdistr.Rd0000644000176200001440000000331614026666127015410 0ustar liggesusers\name{convertSN2SUNdistr} \alias{convertSN2SUNdistr} \title{Convert a SN distribution into a SUN} \description{An object of \code{SECdistrMv-class} or \code{SECdistrUv-class} representing a \acronym{SN} or \acronym{ESN} distribution is converted into a \code{SUNdistr-class} object representing the same distribution.} \usage{convertSN2SUNdistr(object, HcompNames = "h", silent = FALSE)} \arguments{ \item{object}{an object of \code{SECdistrMv-class} with \code{family} of type \code{SN} or \code{ESN}.} \item{HcompNames}{an optional character string for the hidden component} \item{silent}{a logical value which controls the behaviour if the supplied \code{object} is not suitable. If \code{silent = FALSE} (detault value) an error message is generated, otherwise a \code{NULL} is silently returned.} } %\details{%% ~~ If necessary, more details than the description above ~~} \value{an object of \code{SUNdistr-class}} %\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{SUNdistr-class}}, \code{\link{SECdistrMv-class}}, \code{\link{SECdistrUv-class}}} \examples{ esn <- makeSECdistr(dp=c(0, 1, 2, 0.5), family="ESN") sun <- convertSN2SUNdistr(esn) mean(sun) - mean(esn) vcov(sun) - sd(esn)^2 # 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")) sun10 <- convertSN2SUNdistr(f10) mean(sun10) - mean(f10) vcov(sun10) - vcov(f10) } \keyword{distribution} \keyword{multivariate} \concept{SUN distribution} \concept{Unified Skew-Normal distribution} sn/man/summary.SUNdistr.Rd0000644000176200001440000000450414025467060015152 0ustar liggesusers% file sn/man/summary.SUNdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{summary.SUNdistr} \encoding{UTF-8} \alias{summary.SUNdistr} \alias{summary,SUNdistr-method} \title{Summary of a \acronym{SUN} distribution object} \description{Produce a summary of an object of class \code{"SUNdistr"}} \usage{\S4method{summary}{SUNdistr}(object, ...)} \arguments{ \item{object}{an object of class \code{"SUNdistr"}.} \item{...}{optional arguments passed to \code{mom.mtruncnorm} for the regulation of its working.qq} } \value{An S4-object with the following slots: \item{dp}{the parameters of the distrbution, a list} \item{name}{the name of the distribution, a character string} \item{compNames}{the names of the components, a character vector} \item{HcompNames}{the names of the hidden components, a character vector} \item{mean}{the mean value, a vector} \item{var.cov}{the variance-covariance matrix} \item{gamma1}{the marginal indices of asymmetry, a vector} \item{cum3}{the third order cumulants, a three-dimensional array} \item{mardia}{the Mardia's measures of multivariate asymmetry and skewness, a vector of length two} } \author{Adelchi Azzalini} %\note{%% ~~further notes~~} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{makeSUNdistr}} for building a \acronym{SUN} distribution object methods \code{\link[base]{mean}} and \code{\link[stats]{vcov}} for computing the mean vector and the variance matrix of \code{\link{SUNdistr-class}} objects } \references{ Arellano-Valle, R. B. and Azzalini, A. (2020). Some properties of the unified skew-normal distribution. \href{https://arxiv.org/abs/2011.06316}{arXiv:2011.06316} Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. } \examples{ Omega <- matrix(c(5, 1, 1, 6), 2, 2) Delta <- matrix(c(0.30, 0.50, 0.50, 0.85), 2, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.18, 0.18, 1), 2, 2) tau <- c(0.4, -0.8) dp2 <- list(x=c(1, 0), Omega=Omega, Delta=Delta, tau=tau, Gamma=Gamma) sun2 <- makeSUNdistr(dp=dp2, name="SUN2", compNames=c("u", "v")) s <- summary(sun2) } \keyword{multivariate} \keyword{distribution} sn/man/SUNdistr-op.Rd0000644000176200001440000001573714147741110014100 0ustar liggesusers% file sn/man/SUNdistr-op.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{SUNdistr-op} \docType{package} \encoding{UTF-8} \alias{SUNdistr-op} \alias{affineTransSUNdistr} \alias{conditionalSUNdistr} \alias{convolutionSUNdistr} \alias{joinSUNdistr} \alias{marginalSUNdistr} \title{Operations on SUNdistr-class objects} \description{ Given an object of \code{SUNdistr-class}, or possibly two such things in some cases, the functions perform various operations, and produce a new object of the same class.} \usage{ affineTransSUNdistr(object, a, A, name, compNames, HcompNames, drop = TRUE) conditionalSUNdistr(object, comp, values, eventType = "=", name, drop = TRUE) convolutionSUNdistr(object1, object2, name, compNames, HcompNames) joinSUNdistr(object1, object2, name, compNames, HcompNames) marginalSUNdistr(object, comp, name, drop=TRUE) } \arguments{ \item{object, object1, object2}{objects of class \code{SUNdistr}} \item{a}{a numeric vector; see \sQuote{Details}} \item{A}{a numeric matrix; see \sQuote{Details}} \item{name}{an optional character string with the name of the returned distribution} \item{compNames}{an optional vector of character strings with the names of the component variables of the returned distribution} \item{HcompNames}{an optional vector of character strings with the names of the hidden variables of the returned distribution} \item{drop}{a logical value (default: \code{TRUE}) relevant only in the case \code{m=1}. When both \code{m=1} and \code{drop=TRUE}, the returned object is of class either \code{SECdistrUv} or \code{SECdistrMv}, depending on the dimension of the returned object, and family \code{"SN"} or \code{"ESN"}, as appropriate.} \item{comp}{a vector of integers representing the selected components} \item{values}{a numeric vector which identifies the conditioning event} \item{eventType}{a single character value which indicates the type of the conditioning event, as described in the \sQuote{Details} section; possible values are \code{"="} (default) and \code{">"}} } \details{ For an \code{object} which represents the distribution of a multivariate \acronym{SUN} random variable \eqn{Y} of dimension \code{d}, say, a number of operations are possible, producing a new object of the same class. This \code{object} could have been created by \code{\link{makeSUNdistr}} or it could be the outcome from some previous call to one of the functions described here. The function \code{affineTransSUNdistr} computes the distribution of \eqn{a+A'Y}, provided \code{A} is a full-rank matrix with \code{nrow(A)=d} and \code{length(a)=ncol(A)}. See equation (7.6) of Azzalini & Capitanio (2014). The function \code{marginalSUNdistr} builds a \acronym{SUN} distribution from the components selected by the \code{comp} vector. A conditional distribution can be computed using \code{conditionalSUNdistr} for two type of events, selected by \code{eventType}. The \code{"="} case corresponds to the event \eqn{Y_1=y_1}{Y₁=y₁} where \eqn{Y_1}{Y₁} is the subset of components identified by the \code{comp} argument, \eqn{y_1}{y₁} is vector specified by the \code{values} argument and the equality sign must hold for each component. See equation (7.6) of Azzalini & Capitanio (2014). If \code{conditionalSUNdistr} is used with \code{eventType=">"}, the conditiong refers to the event \eqn{Y_1>y_1}{Y₁>y₁}, where the inequality must be interpreted components-wise; see Arellano-Valle & Azzalini (2021) for the underlying mathematical result. If the conditional distribution is required for the reverse inequality condition, \code{"<"} say, this is equivalent to consideration of the event \eqn{-Y_1>-y_1}{-Y₁>-y₁}. The corresponding distribution can be obtained in two steps: first a new variable is constructed reversing the sign of the required components using \code{affineTransSUNdistr}; then \code{conditionalSUNdistr} is applied to this new variable with the \code{">"} condition and values \eqn{-y_1}{-y₁}. More complex conditions, where the \code{"<"} and \code{">"} signs are mixed for different component varables, can be handled similarly, by introducing a square matrix \code{A} for \code{affineTransSUNdistr} having an appropriate combination of \code{1}s' and \code{-1}'s on its main diagonal, and 0's elsewhere, and matching changes of sign to the components of \eqn{y_1}{y₁}. Functions \code{convolutionSUNdistr} and \code{joinSUNdistr} operate under the assumptions that \code{object1} and \code{object2} refer to independent variables. Specifically, \code{convolutionSUNdistr} computes the convolution of the two objects (i.e. the distribution of the sum of two independent variables), which must have the same dimension \code{d}. Function \code{joinSUNdistr} combines two objects into a joint distribution. If the arguments \code{name}, \code{compNames} and \code{HcompNames} are missing, they are composed from the supplied arguments. } \value{an object of \code{SUNdistr-class}} \references{ Arellano-Valle, R. B. and Azzalini, A. (2021). Some properties of the unified skew-normal distribution. \emph{Statistical Papers}, \doi{https://doi.org/10.1007/s00362-021-01235-2} and \href{https://arxiv.org/abs/2011.06316}{arXiv:2011.06316} 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} \note{ The present structure and user interface of this function, and of other ones related to the \acronym{SUN} distribution, must be considered experimental, and they might possibly change in the future.} \seealso{ \code{\link{SUNdistr-base}}, \code{\link{makeSUNdistr}}, \code{\link{SUNdistr-class}} } \examples{ xi <- c(1, 0, -1) Omega <- matrix(c(2,1,1, 1,3,1, 1,1,4), 3, 3) Delta <- matrix(c(0.72,0.20, 0.51,0.42, 0.88, 0.94), 3, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.8, 0.8, 1), 2, 2) dp3 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=c(-0.5, 0), Gamma=Gamma) sun3 <- makeSUNdistr(dp=dp3, name="SUN3", compNames=c("x", "w", "z")) # a <- c(1,-2) A <- matrix(1:6, 3, 2) sun2at <- affineTransSUNdistr(sun3, a, A, "SUN2at", compNames=c("at1", "at2")) sun2m <- marginalSUNdistr(sun3, comp=c(1,3), name="SUN2m") sun1c <- conditionalSUNdistr(sun3, comp=c(1,3), values=c(1.1, 0.8), eventType=">", name="SUN1c", drop=FALSE) # Omega <- matrix(c(5, 1, 1, 6), 2, 2) Delta <- matrix(c(0.30, 0.50, 0.50, 0.85), 2, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.18, 0.18, 1), 2, 2) tau <- c(0.4, -0.8) dp2 <- list(x=c(1, 0), Omega=Omega, Delta=Delta, tau=tau, Gamma=Gamma) sun2 <- makeSUNdistr(dp=dp2, name="SUN2", compNames=c("u", "v")) # sun2conv <- convolutionSUNdistr(sun2, sun2m, name="SUN2sum") sun5 <- joinSUNdistr(sun3, sun2) } \keyword{distribution} \keyword{multivariate} \concept{SUN distribution} \concept{Unified Skew-Normal distribution} \concept{CSN distribution} \concept{Closed Skew-Normal distribution} 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/plot.SECdistr.Rd0000644000176200001440000001613314025557053014403 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{Plotting 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/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/galton_moors2alpha_nu.Rd0000644000176200001440000000526314025314441016235 0ustar liggesusers% file sn/man/fournum.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2020 Adelchi Azzalini %--------------------- \name{galton_moors2alpha_nu} \alias{galton_moors2alpha_nu} \concept{quantile} \concept{asymmetry} \concept{skewness} \concept{kurtosis} % \title{Mapping of the (Galton-Bowley, Moors) measures to the (\eqn{alpha}, \eqn{nu}) parameters of a ST distribution} \description{Given a pair of (Galton-Bowley, Moors) measures of skewness and kurtosis for a given sample, a pair of values (\eqn{alpha}, \eqn{nu}) are found such that a skew-\emph{t} (\acronym{ST}) distribution with these slant and tail-weight parameter has its (Galton-Bowley, Moors) measures equal to the input values. This function is mainly intended for internal package usage. } \usage{ galton_moors2alpha_nu(galton, moors, quick = TRUE, move.in = TRUE, verbose = 0, abstol = 1e-04) } \arguments{ \item{galton}{a numeric value, representing a Galton-Bowley measure} \item{moors}{a numeric value, representing a Moors measure} \item{quick}{a logical value; if \code{TRUE}, a quick mapping is performed} \item{move.in}{if the input values \code{(galton, moors)} are outside the feasible \acronym{ST} region, a suitable point within the feasible area is returned} \item{verbose}{a numeric value which regulates the amount of printed detail} \item{abstol}{the tolerance value of the mapping, only relevant is \code{quick=FALSE}} } \details{For background information about the Galton-Bowley's and the Moors measures, see the documentation of \code{\link[sn]{fournum}}. The working of the mapping by described in Azzalini and Salehi (2020). } \value{a named vector of length two, with one or more descriptive attributes} \references{ Azzalini, A. and Salehi, M. (2020). Some computational aspects of maximum likelihood estimation of the skew-\emph{t} distribution. In: \emph{Computational and Methodological Statistics and Biostatistics}, edited by Andriëtte Bekker, Ding-Geng Chen and Johannes T. Ferreira. Springer. DOI: 10.1007/978-3-030-42196-0 % https://www.springer.com/gp/book/9783030421953#aboutBook } \author{Adelchi Azzalini} \note{This function is mainly intended for internal package usage. Specifically it is used by \code{\link{st.prelimFit}}.} \seealso{\code{\link[sn]{fournum}}, \code{\link{st.prelimFit}} } \examples{ galton_moors2alpha_nu(0.5, 3, quick=FALSE) # input in the feasible area galton_moors2alpha_nu(0.5, 3) # very similar output, much more quickly galton_moors2alpha_nu(0.5, 0.5) # input outside the feasible area } % Add one or more standard keywords, see file 'KEYWORDS' in the \keyword{robust} % use one of RShowDoc("KEYWORDS") 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/convertCSN2SUNpar.Rd0000644000176200001440000000663514147731113015147 0ustar liggesusers% file sn/man/convertCSN2SUNpar.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{convertCSN2SUNpar} \encoding{UTF-8} \alias{convertCSN2SUNpar} \title{Conversion of \acronym{CSN} parameters to \acronym{SUN} parameters} \description{The parameter set of a Closed Skew-Normal (\acronym{CSN}) distribution is converted into the parameter set of the equivalent Unified Skew-Normal (\acronym{SUN}) distribution.} \usage{convertCSN2SUNpar(mu, Sigma, D, nu, Delta)} \arguments{ \item{mu}{a numeric vector of length \code{p}, say.} \item{Sigma}{a positive definite variance matrix of size \code{c(p,p)}.} \item{D}{an arbitrary numeric matrix of size say \code{c(q, p)}, say.} \item{nu}{a numeric vector of length \code{q}.} \item{Delta}{a positive definite variance matrix of size \code{c(q,q)}.} } \details{The arguments of the function match the parameters \eqn{(\mu, \Sigma, D, \nu, \Delta)} of the \acronym{CSN} distribution presented by González-Farías \emph{et alii} (2004a, 2004b). These parameters are converted into those of the equivalent \acronym{SUN} distribution, which is unique. The converse operation, that is, mapping parameters from the \acronym{SUN} to the \acronym{CSN} family, is not handled here. Its solution would be non-unique, because the \acronym{CSN} family is over-parameterized. Note that, having retained the exact notation of the above-quoted papers, there is a \code{Delta} argument which must not be confused with one of the arguments for the \acronym{SUN} distribution in \code{\link{SUNdistr-base}}. The coincidence of these names is entirely accidental. The \acronym{CSN} parameters must only satisfy the requirements that \eqn{\Sigma} and \eqn{\Delta} are symmetric positive definite matrices. Since these conditions are somewhat simpler to check than those for the \acronym{SUN} parameters, as indicated in \code{\link{SUNdistr-base}}, this function may provide a simple option for the specification of a \acronym{CSN/SUN} distribution. The parameter list \code{dp} produced by this function can be used as an input for the functions in \code{\link{SUNdistr-base}} or for \code{\link{makeSUNdistr}}. } \value{a list representing the \code{dp} parameter set of the corresponding \acronym{SUN} distribution} \references{ González-Farías, G., Domínguez-Molina, J. A., & Gupta, A. K. (2004a). Additive properties of skew normal random vectors. \emph{J. Statist. Plann. Inference} \bold{126}, 521-534. % González-Farías, G., Domínguez-Molina, J. A., & Gupta, A. K. (2004b). González-Farías, G., Domínguez-Molina, J. A., & Gupta, A. K. (2004b). The closed skew-normal distribution. In M. G. Genton (Ed.), \emph{Skew-elliptical Distributions and Their Applications: a Journey Beyond Normality}, Chapter 2, (pp. 25–42). Chapman & Hall/\acronym{CRC}. } \author{Adelchi Azzalini} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{SUNdistr-base}}, \code{\link{makeSUNdistr}} } \examples{ p <- 3 q <- 2 mu <- 1:p Sigma <- toeplitz(1/(1:p)) D <- matrix(sqrt(1:(p*q)), q, p) nu <- 1/(1:q) Delta <- diag(q) + outer(rep(1,q), rep(1,q)) dp <- convertCSN2SUNpar(mu, Sigma, D, nu, Delta) } \keyword{distribution} \keyword{multivariate} \concept{SUN distribution} \concept{Unified Skew-Normal distribution} \concept{CSN distribution} \concept{Closed Skew-Normal distribution} sn/man/symm-modulated-distr.Rd0000644000176200001440000002715514030036034016023 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{https://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/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/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/fournum.Rd0000644000176200001440000000615413635423332013441 0ustar liggesusers% file sn/man/fournum.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2020 Adelchi Azzalini %--------------------- \name{fournum} \encoding{UTF-8} \alias{fournum} \concept{quantile} \concept{median} \concept{variability} \concept{asymmetry} \concept{skewness} \concept{kurtosis} \title{Four-number summary of a numeric vector} \description{ Returns a quantile-based four-number summary of the input data } \usage{ fournum(x, na.rm = TRUE, ...) } \arguments{ \item{x}{a numeric vector, maybe including \code{NA}s and \code{+/n Inf}s. At least 8 not-\code{NA} values are required. It works with objects which can be coerced to vector.} \item{na.rm}{ logical; if \code{TRUE}, all \code{NA} and \code{NaN}s are dropped, before the statistics are computed.} \item{\dots}{optional arguments passed to \code{\link[stats]{quantile}}} } \details{Function \code{quantile} is used to compute 7 octiles of \code{x}, that is, quantiles of level \code{(1:7)/8}, denoted \code{oct[1:7]}, and derive four summary quantities: \enumerate{ \item the median, which corresponds to \code{oct[4]}, \item the \sQuote{(coefficient of) quartile deviation} or semi-interquantile range: \code{(oct[6] - oct[2])/2}; \item the Galton-Bowley measure of asymmetry, that is, skewness: \code{(oct[6] - 2 * oct[4] + oct[2])/(oct[6] - oct[2])}; \item the Moors measure of kurtosis: \code{(oct[7] - oct[5] + oct[3] - oct[1])/(oct[6] - oct[2])} } The term \sQuote{coefficient of quartile deviation} is adopted from the Encyclopedia of Statistical Sciences; see the reference below. What is called Galton-Bowley measure here is often named \sQuote{Bowley's measure}, but some sources attribute it to Francis Galton. For the Moors measure, see the reference below. } \value{a vector of length four containing the median, the quartile deviation, the Galton-Bowley measure and the Moors measure} \references{ \sQuote{Quartile deviation, coefficient of}, in: \emph{Encyclopedia of Statistical Sciences}, 2nd edition (2006). Editors: Samuel Kotz (Editor-in-Chief), Campbell B. Read, N. Balakrishnan, Brani Vidakovic. Vol. 10, p.6743. \sQuote{Skewness, Bowleys's measures of}, in: \emph{Encyclopedia of Statistical Sciences}, 2nd edition (2006). Editors: Samuel Kotz (Editor-in-Chief), Campbell B. Read, N. Balakrishnan, Brani Vidakovic. Vol. 12, p.7771-7773. Moors, J.J.A. (1988). A quantile alternative for kurtosis. \emph{Source: Journal of the Royal Statistical Society. Series D (The Statistician)}, Vol. 37, pp. 25-32 } \author{ Adelchi Azzalini } \note{ Computation of octiles makes real sense only if \code{length(x)} is substantially larger than 8. If \code{x} does not contain at least 8 values (excluding \code{NA}s), the function returns \code{rep(NA,4)}.} \seealso{\code{\link[stats]{quantile}}, \code{\link[stats]{fivenum}}, \code{\link[stats]{IQR}} } \examples{ fournum(datasets::rivers) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{univar} \keyword{nonparametric} \keyword{robust} sn/man/sn-package.Rd0000644000176200001440000001527014030035136013745 0ustar liggesusers% file sn/man/sn-package.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{sn-package} \docType{package} \encoding{UTF-8} \alias{sn-package} \alias{SN} \title{Package \pkg{sn}: overview, background and history} \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}) and the unified skew-normal (\acronym{SUN}) families. For a number of these families, statistical methods are provided, to perform data fitting and model diagnostics, in the univariate and the multivariate case. } %---------- \section{Overview of the package structure and commands}{ A separatate document is entirely dedicated to the presentation of the package structure and its basic functions; see the \code{\link[=overview-sn]{package overview}}. } % end section %---------- \section{Background information and references}{ The package adopts the terminology, notation and general framework of the monograph by Azzalini and Capitanio (2014). This matching constitutes a reason for the numerous references to the book in the documentation of the package. An additional reason for referring to that monograph instead of the original research papers is that the book provides a relatively not-so-formal account of material which has been elaborated in a number of publications, sometimes very technical, or re-elabotated over a few papers or possibly mixing the information of key interest with other material. In other words, the motivation behind this policy is readability, 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 cited sections of the book include bibliographic notes which refer back to the original sources. } % end section %---------- \section{A bit of history}{% The first version of the package was written in 1997, and it was uploaded on \acronym{CRAN} in 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 \acronym{CRAN}. This represented a substantial re-writing of the earlier \sQuote{version 0.x}, developed in broad connection with the book by Azzalini and Capitanio (2014). 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. After various versions 1.x-y, version 2.0.0 has appeared in March 2021, providing support for the \acronym{SUN} distribution. Additional information on the evolution of the package is provided in \code{NEWS} file, accessible from the package documentation index page. } %---------- \section{Backward compatibility versus \sQuote{version 0.4-18}}{% There is a partial backward compatibility of newer version versus \sQuote{version 0-4.18} of the package. 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. } % end section \section{Requirements}{ \R version 2.15-3 or higher, plus packages \pkg{mnormt}, \pkg{numDeriv} and \pkg{quantreg}, in addition to standard packages (\pkg{methods}, \pkg{graphics}, \pkg{stats4}, 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[=overview-sn]{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} \concept{skew-elliptical distribution} \concept{skew-normal distribution} \concept{skew-t distribution} \concept{symmetric distribution} \concept{symmetry-modulated distribution} \concept{unified skew-normal distribution} sn/man/plot.selm.Rd0000644000176200001440000001520314030035743013651 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{https://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{https://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/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/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/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/SECdistrUv-class.Rd0000644000176200001440000000475514025215051015040 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{A class of objects representing univariate skew-elliptically contoured (\acronym{SEC}) 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/selm.Rd0000644000176200001440000005704114147417576012723 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, model = TRUE, x = FALSE, y = FALSE, contrasts = NULL, offset, ...) } \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. If \code{family="ST"}, an additional option exists; see \sQuote{Details}.} \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{model, x, y}{logicals. If \code{TRUE}, the corresponding components of the fit are returned.} \item{contrasts}{an optional list. See the \code{contrasts.arg} of \code{\link[stats]{model.matrix.default}}.} \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{\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 either to \code{nlminb} or to \code{optim}, depending on the chosen \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} 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.01)}. % 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)}. Since version 1.6.0, a new initialization procedure has been introduced for the case \kbd{family="ST"}, which adopts the method proposed by Azzalini & Salehi (2020), implemented in functions \kbd{st.prelimFit} and \kbd{mst.prelimFit}. Correspondingly, the \kbd{start} argument can now be of different type, namely a character with possible values \kbd{"M0"}, \kbd{"M2"} (detault in the univariate case) and \kbd{"M3"} (detault in the multivariate case). The choice \kbd{"M0"} selects the older method, in use prior to version 1.6.0. For more information, see Azzalini & Salehi (2020). 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{https://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. Azzalini, A. and Salehi, M. (2020). Some computational aspects of maximum likelihood estimation of the skew-\emph{t} distribution. In \emph{Computational and Methodological Statistics and Biostatistics}, edited by A. Bekker, Ding-Geng Chen and Johannes T. Ferreira, pp.3-28. Springer Nature Switzerland. % 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, especially so with the \acronym{ST} family. 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 if problems 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 degrees 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 extracted 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. An example of this sort is 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", opt.method="Nelder-Mead") summary(m) summary(m, "DP") 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) } # 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 the final passage of 'Cautionary notes' 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 } } \keyword{regression} \keyword{univar} \keyword{multivariate} %------------------------- %% next example has been superseded by introduction of profile.selm % % \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') % } sn/man/makeSUNdistr.Rd0000644000176200001440000000714614027105675014324 0ustar liggesusers% file sn/man/makeSUNdistr.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{makeSUNdistr} \docType{package} \encoding{UTF-8} \alias{makeSUNdistr} \title{Build an object representing a SUN distribution} \description{ Build an object which identifies a Unified Skew-Normal distribution (\acronym{SUN}) within this parametric family. The \acronym{SUN} family is essentially equivalent to some other parametric families examined in the literature, notably the Closed Skew-Normal. } \usage{makeSUNdistr(dp, name, compNames, HcompNames, drop = TRUE)} \arguments{ \item{dp}{a list of parameters as described at \code{\link{SUNdistr-base}}.} \item{name}{an optional character string with the name of the distribution. If missing, one is created.} \item{compNames}{an optional vector of character strings with the names of the component variables; its length must be equal to the dimensionality \code{d} of the distribution being generated. If missing, the components are named \code{"V1"}, \code{"V2"}, \dots} \item{HcompNames}{an optional vector of character strings with the names of the hidden component variables; its length must be equal to the dimensionality component \code{m} described in the \sQuote{Details}. If missing, the components are named \code{"H1"}, \code{"H2"}, \dots} \item{drop}{a logical value (default: \code{TRUE}) relevant only in the case \code{m=1}. When both \code{m=1} and \code{drop=TRUE}, the returned object is of class either \code{SECdistrUv} or \code{SECdistrMv}, depending on the value of \code{d}, and family \code{"SN"} or \code{"ESN"}, depending on the \code{dp} ingredients.} } \details{ The argument \code{dp} is a list, whose components are described at \code{\link{SUNdistr-base}}; see especially the \sQuote{Details} there. In this respect, there is no difference between the univariate and the univariate case, differently from the similar command \code{\link{makeSECdistr}}. If the arguments \code{name}, \code{compNames} and \code{HcompNames} are missing, they are composed from the supplied arguments. A \code{SUNdistr-class} object operates according to the S4 protocol. } \value{An object of \code{\link{SUNdistr-class}}} \author{Adelchi Azzalini} \note{ The present structure and user interface of this function, and of other ones related to the \acronym{SUN} distribution, must be considered experimental, and they might possibly change in the future.} \seealso{ Basic information on the SUN distribution \code{\link{SUNdistr-base}}, the description of the class \code{\link{SUNdistr-class}}, Related methods: \code{\link{show.SUNdistr}} for displaying the object constituents, \code{\link{plot.SUNdistr}} for plotting, \code{\link{mean.SUNdistr}} for the mean value, \code{\link{vcov.SUNdistr}} for the variance matrix, \code{\link{summary.SUNdistr}} for various summary quantities Functions \code{\link{SUNdistr-op}} manipulate objects created by this function, producing new \code{SUNdistr-class} objects } \examples{ xi <- c(1, 0, -1) Omega <- matrix(c(2,1,1, 1,3,1, 1,1,4), 3, 3) Delta <- matrix(c(0.72,0.20, 0.51,0.42, 0.88, 0.94), 3, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.8, 0.8, 1), 2, 2) dp3 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=c(-0.5, 0), Gamma=Gamma) sun3 <- makeSUNdistr(dp=dp3, name="SUN3", compNames=c("x", "w", "z")) show(sun3) } \keyword{distribution} \keyword{multivariate} \concept{SUN distribution} \concept{Unified Skew-Normal distribution} \concept{CSN distribution} \concept{Closed Skew-Normal distribution} sn/man/SECdistrMv-class.Rd0000644000176200001440000000551514025215063015026 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{A class of objects representing multivariate skew-elliptically contoured (\acronym{SEC}) 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 = "SECdistrMv")}: \dots} \item{vcov}{\code{signature(object = "SECdistrMv")}: \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/sn-st.info.Rd0000644000176200001440000001572513607130226013744 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, at.MLE=TRUE) 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 them can be a non-\code{NULL} argument. 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 (only meaningful for the observed information, hence if \code{y} is missing); if missing, a vector of 1's is generated.} \item{fixed.nu}{an optional numeric value which declares 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 function from 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.} \item{at.MLE}{a logical flag; if \code{at.MLE=TRUE} (default value), it generates a warning if the information matrix is not positive definite or an error if the observed information matrix is not evaluated at a maximum of the log-likelihood function.} } \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{cp} should represent the maximum likelihood estimates (MLE) for the given \code{y}, otherwise the information matrix may fail to be positive-definite and it would be meaningless anyway. Therefore, the squared Mahalobis norm of the score vector is evaluated and compared with \code{norm2.tol}. If it exceeds this threshold, this is taken as an indication that the supplied parameter list 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, at the moment. Computation for the univariate case is based on DiCiccio and Monti (2011). For the multivariate case, the score function is computed using an expression of Arellano-Valle (2010) followed by numerical differentiation. } \references{ Arellano-Valle, R. B. (2010). The information matrix of the multivariate skew-\emph{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: \bold{100} (2009), 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/overview-sn.Rd0000644000176200001440000002102514026653534014230 0ustar liggesusers% file sn/man/overview-sn.Rd % This file is a component of the package 'sn' for R % copyright (C) 2017-2021 Adelchi Azzalini %--------------------- % HTML version: R CMD Rdconv overview.Rd --type=html -o overview.html % \name{overview-sn} \docType{package} \encoding{UTF-8} \alias{overview-sn} \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} and the and the `unified skew-normal' (\acronym{SUN}) families. For the skew-normal, the skew-\eqn{t} and the skew-Cauchy families, it also makes available statistical methods for data fitting and model diagnostics, in the univariate and the multivariate case. } \section{Two main sides}{ The package comprises two main sides: one side provides facilities for the pertaining probability distributions; the other one deals with related statistical methods. Underlying formulation, parameterizations of distributions and terminology are in agreement with the monograph of Azzalini and Capitanio (2014). % %% The present document refers to version 2.0.0 of the package (March 2021). } \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 probability objects operate according to the S4 protocol. The 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. The \acronym{SUN} family is mainly targeted to the multivariate context, and this is reflected in the organization of the pertaining functions, although univariate \acronym{SUN} distributions are supported. Density, distribution function and random numbers are handled by \code{{d,p,r}sun}. Mean value, variance matrix and Mardia's measures of multivariate skewness and kurtosis are computed by \code{sun{Mean,Vcov,Mardia}}. 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{Probability distribution objects: \acronym{SEC} families}{% 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.} \item{Probability distribution objects: the \acronym{SUN} family}{% Function \code{makeSUNdistr} can be used to build a \acronym{SUN} distribution object representing a member of the \acronym{SUN} parametric family. This object can be used for various operations such as plotting or extraction of moments and other summary quantities. Moreover there are several trasformation operations which can be performed on a \acronym{SUN} distribution object, or two such objects in some cases: computing a (multivariate) marginal distribution, a conditional distribution (on given values of some components or on one-sided intervals), an affine trasformation, a convolution (that is, the distribution of the sum of two independent variables), and joining two distributions under assumption of independence. }} } % 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. The facilities for statistical work do not support the \acronym{SUN} family. } \section{Additional material}{ Additional material is available in the section \sQuote{User guides, package vignettes and other documentation} accessible from the front page of the documentation. See especially the document \code{pkg_sn-intro.pdf} } \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/sn-st.cumulants.Rd0000644000176200001440000000375113622450426015024 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 \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/selm.fit.Rd0000644000176200001440000002462714147417327013502 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=list()) 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. For \code{st.mple} and \code{mst.mple}, see also the paragraph about \code{start} in the documentation \sQuote{Details} of \code{selm}. } \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{https://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{https://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/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/makeSECdistr.Rd0000644000176200001440000001364514027103134014256 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. An object built by this function operates according to the S4 protocol. } \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. The \acronym{ESN} distribution is included here as a members of the \acronym{SEC} class, with a very slight extension of the original definition of this class, since the only difference is the non-zero truncation point of the unobserved component of the \code{(d+1)}-dimensional \acronym{EC} variable. } \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/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/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/SUNdistr-base.Rd0000644000176200001440000002670314147745534014405 0ustar liggesusers% file sn/man/SUNdistr-vase.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{SUNdistr-base} \encoding{UTF-8} \alias{SUNdistr-base} \alias{dsun} \alias{psun} \alias{rsun} \alias{sunMean} \alias{sunVcov} \alias{sunMardia} \title{The Unified Skew-Normal (SUN) probability distribution} \description{ Density, distribution function, random number generation, the mean value, the variance-covariance matrix and the Mardia's measures of multivariate skewness and kurtosis of the \acronym{SUN} probability distribution. } \usage{ dsun(x, xi, Omega, Delta, tau, Gamma, dp = NULL, log = FALSE, silent=FALSE, ...) psun(x, xi, Omega, Delta, tau, Gamma, dp = NULL, log = FALSE, silent=FALSE, ...) rsun(n=1, xi, Omega, Delta, tau, Gamma, dp = NULL, silent=FALSE) sunMean(xi, Omega, Delta, tau, Gamma, dp = NULL, silent=FALSE, ...) sunVcov(xi, Omega, Delta, tau, Gamma, dp = NULL, silent=FALSE, ...) sunMardia(xi, Omega, Delta, tau, Gamma, dp = NULL, silent=FALSE, ...) } \arguments{ \item{x}{a vector of length \code{d}, where \code{d=ncol(Omega)}, with the coordinates of the point where the density or the distribution function must be evaluated. For \code{dsun} and \code{psun} only, a matrix with \code{d} columns representing multiple points is also 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{dsun} and \code{psun}, \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{Details}.} \item{Delta}{a matrix of size \code{(d,m)}, where \code{m=length(tau)}; see \sQuote{Details} about its constraints.} \item{tau}{a vector of length \code{m}, say.} \item{Gamma}{a symmetric positivedefinite matrix of dimension \code{(m,m)} with 1's on its main diagonal, that is, a correlation matrix} \item{dp}{a list with five elements, representing \code{xi} (which must be a vector in this case), \code{Omega}, \code{Delta}, \code{tau} and \code{Gamma}, with restrictions indicated in the \sQuote{Details}. Its default value is \code{NULL}; if \code{dp} is assigned, the individual parameters must not be specified.} \item{n}{a positive integer value.} \item{log}{a logical value (default value: \code{FALSE}); if \code{TRUE}, log-densities and log-probabilities are returned.} \item{silent}{a logical value which indicates the action to take in the case \code{m=1}, which could be more convenently handled by functions for the \acronym{SN/ESN} family. If \code{silent=FALSE} (default value), a warning message is issued; otherwise this is suppressed.} \item{\dots}{additional tuning arguments passed either to \code{\link[mnormt]{pmnorm}} (for \code{dsun}, \code{psun} and \code{sunMean}) or to \code{\link[mnormt]{mom.mtruncnorm}} (for \code{sunVcov} and \code{sunMardia}); see also \sQuote{Details}. } } \details{ A member of the \acronym{SUN} family of distributions is identified by five parameters, which are described in the \sQuote{Background} section. The five parameters can be supplied by combining them in a list, denoted \code{dp}, in which case the individual parameters must \emph{not} be supplied. The elements of \code{dp} must appear in the above-indicated order and must be named. The optional arguments in \code{...} passed to \code{\link[mnormt]{pmnorm}}, which uses \code{\link[mnormt]{ptriv.nt}} when \code{d=3}, \code{\link[mnormt]{biv.nt.prob}} when \code{d=2} and and \code{\link[mnormt]{sadmvn}} when \code{d>2}. In practice these arguments are effective only if \code{d>3}, since for lower dimensions the computations are made to full available precision anyway. A similar fact applies to the \code{...} argument passed to \code{\link[mnormt]{mom.mtruncnorm}}. Some numerical inaccuracy is inevitably involved in these computations. In most cases, they are of negligible extent, but they can possibly become more relevant, especially in the computation of higher order moments involved by \code{sunMardia}, depending on the dimension \code{d} and on the specific parameter values. Consider the \sQuote{Warning} section in \code{\link[mnormt]{recintab}} which is used by \code{\link[mnormt]{mom.mtruncnorm}}. The above-described functions operate following the traditional \R scheme for probability distributions. Another scheme, coexisting with the classical one, works with \code{SUNdistr-class} objects, which represent \acronym{SUN} distributions, by encapsulating their parameters and other characteristics. These objects are created by \code{\link{makeSUNdistr}}, and various methods exist for them; see \code{\link{SUNdistr-class}}. Moreover these objects can be manipulated by a number of tools, described in \code{\link{SUNdistr-op}}, leading to new objects of the same class. } \value{ The structure of the returned value depends on the called function, as follows: \tabular{rl}{ \code{dsun, psun} \tab a vector of length \code{nrow(x)} representing density or probability values, \cr \tab or their log-transformed values if \code{log=TRUE},\cr \code{rsun} \tab a matrix of size \code{(n,d)}, where each row represents a \acronym{SUN} random vectors,\cr \code{sunMean} \tab a vector of length \code{d} representing the mean value,\cr \code{sunVcov} \tab a matrix of size \code{(d,d)} representing the variance-covariance matrix,\cr \code{sunMardia} \tab a vector of length two with the Mardia's measures of multivariate skewness and kurtosis. } } \section{Background}{ A member of the \acronym{SUN} family is characterized by two dimensionality indices, denoted \eqn{d} and \eqn{m}, and a set of five parameters blocks (vector and matrices, as explained soon). The value \eqn{d} represents the number of observable components; the value \eqn{m} represents the number of latent (or hidden) variables notionally involved in the construction of the distribution. The parameters and their corresponding \R variables are as follows: \tabular{rcl}{ \eqn{\xi} \tab \code{xi} \tab a vector of length \eqn{d}, \cr \eqn{\Omega} \tab \code{Omega} \tab a matrix of size \eqn{(d,d)}, \cr \eqn{\Delta} \tab \code{Delta} \tab a matrix of size \eqn{(d,m)}, \cr \eqn{\tau} \tab \code{tau} \tab a vector of length \eqn{m}, \cr \eqn{\Gamma} \tab \code{Gamma} \tab a matrix of size \eqn{(m,m)}, } and must satisfy the following conditions: \enumerate{ \item \eqn{\Omega} is a symmetric positive definite matrix; \item \eqn{\Gamma} is a symmetric positive definite matrix with 1's on the main diagonal, hence a correlation matrix; \item if \eqn{\bar\Omega}{\Omega°} denotes the correlation matrix associated to \eqn{\Omega}, the matrix of size \eqn{(d+m)\times(d+m)}{((d+m), (d+m))} \if{html}{formed by the \eqn{2 x 2} blocks} \ifelse{latex}{ \deqn{\left(\begin{array}{cc} \bar\Omega & \Delta \\ \Delta^\top & \Gamma \end{array} \right)} }{ % non-LaTeX \tabular{rrcc}{ \tab \tab \eqn{\Omega°} \tab \eqn{\Delta} \cr \tab \tab \eqn{\Delta'} \tab \eqn{\Gamma} } } must be a positive definite correlation matrix.} The formulation adopted here has arisen as the evolution of earlier constructions, which are recalled very briefly next. A number of extensions of the multivariate skew-normal distributions, all involving a number \code{m} (with \eqn{m\ge1}) of latent variables (instead of \code{m=1} like the skew-normal distribution), have been put-forward in close succession in the years 2003-2005. Special attention has been drawn by the \sQuote{closed skew-normal (CSN)} distribution developed by González-Farías \emph{et alii} (2004a, 2004b) and the \sQuote{fundamental skew-normal (FUSN)} distribution developed by Arellano-Valle and Genton (2005), but other formulations have been considered too. Arellano Valle and Azzalini (2006) have shown the essential equivalence of these apparently alternative constructions, after appropriate reparameterizations, and underlined the necessity of removing over-parameterizations in some cases, to avoid lack of identifiability. This elaboration has led to the \acronym{SUN} formulation. A relatively less technical account of their development is provided in Section 7.1 of Azzalini and Capitanio (2014), using very slightly modified notation and parameterization, which are the ones adopted here. Additional results have been presented by Arellano-Valle and Azzalini (2021), such as expressions for the variance matrix and higher order moments, the Mardia's measures of multivariate skewness and kurtosis, which are implemented here. Another result is the conditional distribution when the conditioning event is represented by an orthant. } \references{ Arellano-Valle, R. B., and Azzalini, A. (2006). On the unification of families of skew-normal distributions. \emph{Scand. J. Stat.} \bold{33}. 561-574. Arellano-Valle, R. B. and Azzalini, A. (2021). Some properties of the unified skew-normal distribution. \emph{Statistical Papers}, \doi{https://doi.org/10.1007/s00362-021-01235-2} and \href{https://arxiv.org/abs/2011.06316}{arXiv:2011.06316} Arellano-Valle, R. B. and Genton, M. G. (2005). On fundamental skew distributions. \emph{J. Multivariate Anal.} \bold{96}, 93–1116. Azzalini, A. with the collaboration of Capitanio, A. (2014). \emph{The Skew-Normal and Related Families}. Cambridge University Press, IMS Monographs series. González-Farías, G., Domínguez-Molina, J. A., & Gupta, A. K. (2004a). Additive properties of skew normal random vectors. \emph{J. Statist. Plann. Inference} \bold{126}, 521-534. González-Farías, G., Domínguez-Molina, J. A., & Gupta, A. K. (2004b). The closed skew-normal distribution. In M. G. Genton (Ed.), \emph{Skew-elliptical Distributions and Their Applications: a Journey Beyond Normality}, Chapter 2, (pp. 25–42). Chapman & Hall/\acronym{CRC}. } \author{Adelchi Azzalini} \note{ The present structure and user interface of this function, and of other ones related to the \acronym{SUN} distribution, must be considered experimental, and they might possibly change in the future.} \seealso{ \code{\link{makeSUNdistr}} to build a \acronym{SUN} distribution object, with related methods in \code{\link{SUNdistr-class}}, and other facilities in \code{\link{SUNdistr-op}} \code{\link{convertCSN2SUNpar}} to convert a parameter set of the Closed Skew-Normal formulation to the equivalent \acronym{SUN} parameter set } \examples{ xi <- c(1, 0, -1) Omega <- matrix(c(2,1,1, 1,3,1, 1,1,4), 3, 3) Delta <- matrix(c(0.72,0.20, 0.51,0.42, 0.88, 0.94), 3, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.8, 0.8, 1), 2, 2) dp3 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=c(-0.5, 0), Gamma=Gamma) x <- c(0.8, 0.5, -1.1) f1 <- dsun(x, xi, Omega, Delta, c(-0.5, 0), Gamma) # mode 1 f2 <- dsun(x, dp=dp3) # mode 2, equivalent to mode 1 set.seed(1) xm <- rsun(10, dp=dp3) f3 <- dsun(xm, dp=dp3) psun(xm, dp=dp3) sunMean(dp=dp3) sunVcov(dp=dp3) sunMardia(dp=dp3) } \keyword{distribution} \keyword{multivariate} \concept{SUN distribution} \concept{Unified Skew-Normal distribution} \concept{CSN distribution} \concept{Closed Skew-Normal distribution} \concept{FUSN distribution} \concept{Fundamental Skew-Normal distribution} sn/man/pprodt2.Rd0000644000176200001440000000454613635423126013344 0ustar liggesusers% file sn/man/pprodt2.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2020 Adelchi Azzalini \name{pprodt2} \alias{pprodt2} \alias{qprodt2} \alias{pprodn2} \concept{bivariate normal distribution} \concept{bivariate Student's t distribution} \title{ The distribution of the product of two jointly normal or \emph{t} variables } \description{ Consider the product \eqn{W=X_1 X_2} from a bivariate random variable \eqn{(X_1, X_2)} having joint normal or Student's \emph{t} distribution, with 0 location and unit scale parameters. Functions are provided for the distribution function of \eqn{W} in the normal and the \emph{t} case, and the quantile function for the \emph{t} case. } \usage{ pprodn2(x, rho) pprodt2(x, rho, nu) qprodt2(p, rho, nu, tol=1e-5, trace=0) } \arguments{ \item{x}{a numeric vector} \item{p}{a numeric vector of probabilities} \item{rho}{a scalar value representing the correlation (or the matching term in the \emph{t} case when correlation does not exists)} \item{nu}{a positive scalar representing the degrees of freedom} \item{tol}{the desired accuracy (convergence tolerance), passed to function \code{\link[stats]{uniroot}} } \item{trace}{integer number for controlling tracing information, passed on to \code{uniroot}} } \details{ Function \code{pprodt2} implements formulae in Theorem 1 of Wallgren (1980). Corresponding quantiles are obtained by \code{qprodt2} by solving the pertaining non-linear equations with the aid of \code{\link[stats]{uniroot}}, one such equation for each element of \code{p}. Function \code{pprodn2} implements results for the central case in Theorem 1 of Aroian et al. (1978). } \value{a numeric vector} \references{ Aroian, L.A., Taneja, V.S, & Cornwell, L.W. (1978). Mathematical forms of the distribution of the product of two normal variables. \emph{Communications in statistics. Theory and methods}, 7, 165-172 Wallgren, C. M. (1980). The distribution of the product of two correlated \emph{t} variates. \emph{Journal of the American Statistical Association}, 75, 996-1000 } \author{Adelchi Azzalini} % \note{ ~~further notes~~} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link[stats]{uniroot}} } \examples{ p <- pprodt2(-3:3, 0.5, 8) qprodt2(p, 0.5, 8) } % \keyword{distribution} % use one of RShowDoc("KEYWORDS") sn/man/dst.Rd0000644000176200001440000001303014030036123012513 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, depending 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 the value of \code{nu} determines 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{https://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-\emph{t} and a linear combination of order statistics from a bivariate-\emph{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/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/affineTransSECdistr.Rd0000644000176200001440000000607314024446333015606 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} \encoding{UTF-8} \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/plot.SUNdistr-method.Rd0000644000176200001440000001003714030060361015674 0ustar liggesusers% file sn/man/plot.SUNdistr-method.Rd % This file is a component of the package 'sn' for R % copyright (C) 2013-2021 Adelchi Azzalini %--------------------- \name{plot.SUNdistr-method} \docType{methods} \alias{plot.SUNdistr} \alias{plot,SUNdistr-method} \alias{plot,SUNdistr,missing-method} \title{Plotting method for class \code{SUNdistr}} \description{Plotting method for class \code{SUNdistr}} \usage{ \S4method{plot}{SUNdistr}(x, range, nlevels = 8, levels, npt, main, comp, compLabs, gap = 0.5, ...) } \arguments{ \item{x}{an object of class \code{SUNdistr}} \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{nlevels}{ number of contour levels desired \bold{iff} levels is not supplied.} \item{levels}{numeric vector of levels at which to draw contour lines.} \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{main}{a character string for main title; if missing, one is built from the available ingredients.} \item{comp}{an optional integer vector representing the subset of the vector \code{1:d}, if \code{d} denotes the dimensionality of the distribution.} \item{compLabs}{a vector of character strings or expressions used to label the variables in the plot; if missing, \code{slot(object,"compNames")[comp]} is used.} \item{gap}{a numeric value which regulates the gap between panels of a multivariate plot when \code{d>2}; default: \code{0.5}.} \item{\dots}{additional graphical parameters} } \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.} % \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{makeSUNdistr}}, \code{\link{SUNdistr-class}} } \examples{ xi <- c(1, 0, -1) Omega <- matrix(c(2,1,1, 1,3,1, 1,1,4), 3, 3) Delta <- matrix(c(0.72,0.20, 0.51,0.42, 0.88, 0.94), 3, 2, byrow=TRUE) Gamma <- matrix(c(1, 0.8, 0.8, 1), 2, 2) dp3 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=c(-0.5, 0), Gamma=Gamma) sun3 <- makeSUNdistr(dp=dp3, name="SUN3", compNames=c("x", "w", "z")) plot(sun3, npt=rep(51,3)) p <- plot(sun3, comp=2:3, compLabs=c(expression(x[2]), expression(x[3]))) # str(p) } \keyword{methods} \keyword{hplot} 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/dp2cp.Rd0000644000176200001440000001666113632732112012756 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 the 2nd and the 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/DESCRIPTION0000644000176200001440000000214614150203404012374 0ustar liggesusersPackage: sn Version: 2.0.1 Date: 2021-11-26 Title: The Skew-Normal and Related Distributions Such as the Skew-t and the SUN Authors@R: person(given = "Adelchi", family = "Azzalini", email = "adelchi.azzalini@unipd.it", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7583-1269")) Maintainer: Adelchi Azzalini Depends: R (>= 3.0.0), methods, stats4 Imports: mnormt (>= 2.0.0), numDeriv, utils, quantreg Suggests: R.rsp VignetteBuilder: R.rsp Description: Build and manipulate probability distributions of the skew-normal family and some related ones, notably the skew-t and the SUN families. For the skew-normal and the skew-t distributions, statistical methods are provided 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: 2021-11-26 09:06:14 UTC; aa Author: Adelchi Azzalini [aut, cre] () Repository: CRAN Date/Publication: 2021-11-26 16:10:44 UTC sn/build/0000755000176200001440000000000014150121606011765 5ustar liggesuserssn/build/vignette.rds0000644000176200001440000000050714150121606014326 0ustar liggesusersmRMk@V`<Ђ's/D~PZɚbvWConbCvf7og߲iozEAұn%sM,0cqH5ˡܢrÕIc֢s-\%Sp0X `00⋍R#X(1 @ƥ6њ.Z *H@9DE²A=즱[W@p#iDB%~3*]m<]YZ]]{Nx0(RJ.ǘ` +֧F%Й]?ڷ=vO}(Z&2jh+Csn/build/partial.rdb0000644000176200001440000006165014150121605014121 0ustar liggesusers `z6AO4o3 @$H Arwi}Џ3g@bW+l>u[Ozr.+r:cNDXˊ(q(9\׃4UXm|?1zD[c_[1}D75m,keJY~X0݊]#TдD Vu&_5|aƗ]'kLAs~UWĉ 67P|b>u ȷdTf X_qËʶ{ϗ~IZa5rYzhdeʎW̦dbpLy+swcnnU_Qys4[J6?,Vb!{c|Vv"eW3]-u[ϔ c|љJͱ/s}=?:^<>!zu)l0]1Ե]*ۖaU4{MlZYϿ k]lG[ ^_ط9 e™H'9ģH:ļ]r627ƲX.b~f?H/)u.됯ǟu>!E.ϥ 1%RC<4s GKP |XZS+~sT>G7 ?! ÷oM^ ҽW4UxB xхg#_am< Y(YOD(UK `C 7t}7 eq=1F[FlG b5H/л ] .j>؁r 68!M^x"McA 0ZtS9ѝ ZYZV%!A(L87 /[O0fm:h;%P}T+;jʖjbڡunH8I@Г*fج}ExMHO4'W×G1WyhX.sdjkU+OBRst`4ZZ5mݰ G? (MX5A﨧Xmꎩ[y#ŚVZIg{xK)pj4f]+O*hzseeUթخx,䳑Ս t8 y4wlkk:E݉]>([)n1ۭӎupG87ȁZӹ4&|N$ @<>iIjo̤dIQ0դX/\(k3gϒZ^gGIͥy NGuyK>UtBZNEYaf)#N8 yV9101" I}‡Fǚ%0)np9CSuf]5Էq(QKT%(J[ypk B,FV7xiytֵM#_YZl[s x\ODs%o(QW _QvIˆU`r:2,Xy8Uأ2Bj >@ s՛һ6Y.{޶Yj֋/ۦU/ J>h.NatxI#DZVUC3h% սIúyd.!#ҹۺBIT@ %;UvY^J(gd-: x3W3F9Y}\[R"I` r*28pKq{'1j/F! |2I"ܰ]Csv@xvgC~'! ݴXL|y5DØ#,4Jidd^pQa?xO uA;(php՝sj w!l I=M)y [9$u&j[$(XݼUbU1˶kVM#U0L9p0ZU(4ґB0*Z'g#u Խ] %琟+*xō0FE7CcE tIqr( 7xZ8CCI'oH)M#^5cM['A8h4s k~$\=B iWnK0T{XGG._") uf)^2mcȏ1 d1?Y} dpg&8=XRx]pr\Wjpۖ[qt| Y :d!7P' iPFܫe []X77Q;GG2`ioU_mMd-o_I5$W9֐ԝ@QvIշDk60 fb}pk6R?!EnȞ?2;?1ognzwRXeCx>}#%qy |򻭯ggFH ?_"{^UWcnBgsuҋt."R78FџL0,7ϲ/ސjCf%N{ģHP'e݄ e ^@Zt+~[cUf VSWX)[|( r$;&ŪlR7,5ݢރ,U2 3Q۬U 7F„P ;aE< js3`?;3@PwflxpԶ&mcW|& B>G&9<Iv W# G!FYI,% ׀iRC͋n}]2<U2@NVmMě5R~8Y=XF:Ҵ fMm6rdq09loKQo8pX8+TS#iz[,뱹e#;,:2^dF BJjaS!47!E#hw;[&=&l&]74$husGVS:'ڬ+kcpS4>%ȗZ_^,up Yn#y]eFw rDzg[Zڋnz 4Ie="БtZ&)ȩȂNLJHl" RNA}׷Y1$jaXl=UKa * IZ 8Yn`t;8>g#ͽ:cDxb'yo;>,uZ(J9ģHCb5J\BuT|݄k9KpC84pxsP u|ŊUWF0:HuD C~ZhgK3Y*o;Z]AR* GbF JCGZ]]6X^4g[<]fnFl>I­J-qˋGˋ EX]m2"Z@ۚrO[Kfq+=݈0;/Z`r CN mt6Jk^eZ뢅!/p XuFfymV˴2.aԶCw]fSj 2p/hB7aa&a"Q v T_}!{z`RBJ >뱭WZY&7 ,EM@VtQr7)K$|.hZk^*|h2x A1dS{ÐBu5ȚFO'W[)"B$*)X;\f!K_}@xz-Sh:22^`?d1 uD2K{G (r1v9 <|{Y3+>}N߃2njgd"g{ ;z.CמEcϷR<Y(*Rhj͎29HY`G}-%JoA5^cog6G&S QԞ^S໐6|+ Y=T CJJ $%j;! B.4 R߳Rj[Cn/ĝC7zJ罄߮G1Wj%} 10ڼ}!9<9]AYg 4Ckg@{ie7)M+tE݊؞.@Uo^̫⧂Y] [Kp1BMNC}'?QmR7LX!->uELC =}spn"@.*?$fX,B~Il,zW-|H;Z4$aGxD.]_9{YR;Bg!j ? _^D 留 FDpe)/ڄ ˝Qq'" _h}q'u!b\6t'U{Hmo嶝\DtND`Ep:hvs笲^,a 8}ВrמNE (l-bħ27X">KDD.33Jnqz| Y*8 QCDp6Q-Gx7O߁,u~߅>l&|\^i5BAk9P8fZxҀW!Gyq,5#c8EG!*;~B%׀jU_eӖ26 k߬MY;ۭoےU06J[֛I -i4X/&ƛ ’jBʶ뚔U%MxC 6(wRcMyzѳHcB0i7 {ER}Bh"Ť\huKddad"A|OC>,,-+VپwI_|G 7=F7l箖!8,5 MNTT7hȌ"Z;f >a7ÐIcIDb4Q%d%k$Hr]&~Yk %sQȣw)PbGӸ:Dt"=ǀ[_ kǐ xi LDW{8y0ң!'nW㐣<,2DD/B6Ne+Cn8Y59*- Q+&JJt│-Q}$]6BŢ{aN7Lŗ>e?me)D,ꁞ7?p/jT2|2goKkw#H'Yx zy}"]C3eO]_%v*&r} AJ嗋^&| zDj8 Y!V>YS6)^ k[5k"Cl榝#V k4(vK 䌲$1`rNHzg@zà:?_oG.s+A0 YfQ-C "Ӑ;zeoCV?Ƣ]B `pQ\Dh@J!O 9xn#hCو`?׺ 8y`olrC<1Eux i`(prt#ᥣ1c:[?F4%VrNhOԲ]u2<)]+xR>xL>]W2+xR  *x:W+D橝#qIU`z눶Ո8p2sH(u+oXu%|o~A>WCJ!!8wMǐF@|A>rMڀGޤ2!zx 1LlwHrjnUEbEnOpʪRX1bh+eWUbBoC# 9SDۡ:@:eբެ.Dv bR!2`EkՌWKw #+|'r ,ѓC7$$o C"8ģh5F*=)`ADTj}pSQ7"v3Wl9{˞ vˣ[}\PUӺ!tsк!c<*dS89(>6KI.9`p#&F]s Utɪh!'F7!ovm^-W6߻B\Mqڶ5*qoޅ|W9 ==!{rWIߋb'mA* Fګlܢ~D'#Rۑ ik,C<1Uuq6)CC r xևpXDOny]8\NBܭun}cDog!˵,\&  u" RCHM4Hp#?mq19~nhABV_b"d-V<l͝Ν.":w9C%:ػ )}ùR=;axuxJ#ĩ ߈ik0 :8OF#1$-ƅZ%ݴޭaY.eI? !, Ɵʟ0vH\1vCΈس;Rm ,uyQķ V oyMAz!_P8\vƲ%\/K*7zHt׵wKjuD1~&(t xrt{`܉ @` Doj -0G54"*c?c|4Hzitb 8 _8%5dJ 9Oކ~Ap" p} ܸcRDLJ +/lxYnG?"/_;WQ\0ga*,ldfY1jpJ3;9H8x3Q r2G/N ? vVmmtPUOMX #0thpRi'|Y}u]^o }"KԦlii4xSA] rwV0Z=[npÎ{*S^ X41,@uY^* I$ρqJ۝˔xODUa.SRw8 y8V|[[/a x|訴nd]AkyKڮ4]}eh&R9O5qd`uBFi/̈́yMhsA£&J5;<Y}xV4_^J8d~܆BUj%B׺|/.K@57\jېXj1N/ /Y.ye^J)lRVpז G -+jVVNx\󓑹Q YRuLH}j7QSOw8#MßlLEVcMhm_j(5;)y8a ˨hz4%Hh URF!Q*oMi)e/:ꆞƪs]dol#dexj9Y FKH33qG8yLfu,.ʜ2uѬce>G]l̘ڢ201%b'k2ͼG;\m; `8>[x`/_J(GģHI`emʳ}y<9礻a5Q4 媹ihj d̬?‚L\FڬX70].{c0Apr29FM#= LjT)zW3{ס^$]٢clo\F4ރ|O9OMIH]b]nbkmX8J*5366z$>j/6LW3赾@,+`FA"k{ۗ_.JLBncӁ=V)Dy` 9""ށ7yn1q]b7,3O|ޮZ N;`&+/yia%y0ZAu՜^6+eԎdo&KՓ7TikѴ+ݒ]`u[ˮ`%ͫŷkHỐߍ?ס:h‹ق$sop j( !K- (\[%`J?*\% :1ƟMƿ P26Xy(ZɦZ_yAw ~JVY,MMy7hz-ꗬߧ:5Rh| |jU4 CrY=TqoXxє`OC_bU-׿"" =\jWQz•/oO4@{2 ӪtFŸ bշwIm)=H':Im6NpwqcǔY<륪Ţ,YK6 dͺHyi흴B bȰD>>(zPyvq >Ð#ƪ],= kKkVbr,j?DipiI2M̦U&ӅD 33ʤiF :V60 OEV&dtѓs~5גҕj,Vc*$Vm_mANMLoBz)$݊n̬Vb?vѝ^*|H}X͑ F?\ۨTt&>Iz&;Ύ̸cc㓹+Jln|" IpGK sKϛ?B%$zc%JlF}C}:*ƛzKBV& ӌ˥g[itϓJRl<,WǦ++獏? #b22r͵J˳-ԫǻq x~[ݍ?tV8)[?2g^uGdߞUV!= 7mn{ꖿcFާyjwً[q]zRa, ۖϣ ζB"C>IGQBA&_F<ymQsӫ/U7fcI:AXC9vduUb5@KRmRC<L]H6|_:4VOoJ^7\zni.g`Gx a>Jw@gҋiA OC_Cn~&?!z(SQ/C !S + LjSm?f''Ux"u 09̻u3V}W[Znm f47$ Bko9%:bd/Kh}Q&DJ5RыX9!m?mHӐDҪc eni=ZԞ.,k e;zy\af.\u}(N.Z>{g$ cC+lWlV$'e\W+鈴mTHaV$q]f/bfmNٿͪ3Xł 9Z3ڌ&$j r2"dC& RC<٩= u` v @]!WIm"MM.@D$<_5,U4FW^Pu+7GxJpznxQ!= D~W[Q/4E9{ǽHIN4O96 Y}LBn#MFVVFsu \hJ+U^ px TRzX*Dm74(CN&u3k>j.=].!g#;pV$"9 7bi2I(p)Wd+ #>L)͟f® 6A~o}OAwiZ&/1q 9: kHyd)kHi$I6HhOx PsNiRs-ޚe Wلš1m*arnpUq{V" ՘\0՘@7aBA֓4brp՚0R k/, <s\x+Ƃ5NLQo& 1InjWD&!+ I-[LS)Sw0Q"2'3k7 fpKE879̡z?L[ģ-CoLNJˏdXRKeCy%9CuGr,O&}&q8D m|\Gz,}3KX接'L#-9_n9K/B oԻ.5Y:~xN GS("떌1gޘIgR3Lj:I1䰔x~'#z_6T>%#BKwֲDV7I礶#wGZ~ZV8 /hށ~D͵ByШNFrn4f'RzG}9#y2^N}cȓcƈOodtn.+R_?<5M4.\؇$s2Bm+oz63TtHm C.~Lsu\^+ "sImU37Ui[V*MX 'miAiiIiƼDD"bzaDC>AOD^U{d}Z>4#J!g1x"ϥy䛈A0E\v7a;эa 0+f?섏b:~zWƿ흾Rڡپ;W\zϧ^l_;kM^X1<>}ΆXjV{Wz {65skGsxbV;r_*P{нR0<+K۶;)ژA͞سTJwŭ֮ 5iJaIn6O~(Oqw˲ˮ֧`Nj+:oJo[hƒ+eV(&fou]+lmʦ^hE*k[yޗy6\ Vw-:_`]ΆԋiʹgO٤X5Vf+/]+Ŷ^ ) SuMd5Ю+ł]sG%;UFzmt_CxR RM.xrޮ:+mEYnӐ jC;hd~NF5`EFa6u_&/$%Cx~pg5 >??ȇYEij OpJ$!S" 7Lq$|{/:hm^QυH9ar!򚲡C)8ؘe2 ܫk"ہQ1ʬByN"{7?m\pYӨ5LAݮ =\w1."!O\9FO,dF/ t(푇h d)gP~8EC*|֔X Df~@S KQP1ppo|{ jg+nuڦZk+SP }vC<尾ƺ/r?&ylJi}l?ߗ[h}H'o[o*U/Jڧ6>Xڧ6 0zlEo}``~\6}! %۔5A0d@0Bd_0G9atgݔa㐥}AqHIMc9`AeÿlK?u{BxN`BS`4;-/.;)MG7U $G1W?67 KӃixWvC"ht5W!_(IG (\R/*mͭiZwE!+smZk -5i 7aWY Y>ϦmȷpN.;v74]\ѠԸ:1-H(H* 7ڰihڝԧ8ܣڝvC-2'\p6ȅ͖tH&yцZzR61k*4͒paBV>QǡDJC~MHU6 ($$A7lzCٖhXV2 c=v$CL%c" i5C&T=SڗԷq'n5êtxCLQ4dH4-@0[E'"XEHNl,6At).!Kgfc& Lg!϶cDn@~ZhS9s7!xb/}Ou|.AC<c3G۰ͼJ\CR䈊s`0k1cM_f!g[_InK6'n78q^/a n[V3q3Q5X"|{b,ΤřԏsWI8wl/b ,AiZo,D١˝=]+ _uI;uJձ)*zP?%.ڄJK0E9R;y(w ~z\oj]뮍zIBr_86G;\X^ D`b{A[褮 8P8B "CC(u^x$i3@ Q`AV|]M/Y]o`.Q,7BF(Rhq[#RC,TyMݜ?OnkgZܺ#s[kf~C3 kbF[?>,pb~og\8w8Zݵ?v.sߢpy:)E*Wh36?|Y}.A(^=Wcd \%xXr5ށ<.Ha8Y}Ge_Ex>>vs(lj6wOaaOB>_J-q|luWԝ^|QNiQ!u"s ɑY箔u!KM[gxr ˆ`]^."w9Qܡ{w/v)eoO4n  *?Jbg] :D$2;t2j?,Za1LnQSwk.yQܫk%ުd!q>|BEAB7ڄ}Ƌjly f إں=ђFt SPKrtѹ!Jj^|YFT$ t89 OkARwx"Iշ7j8hG!/*>$F~$ڻ9{;,LA=!wX6D89A!?!evX6MC[5 Kc/4%c4䴒Y2> ]]yοj cQ1Dm]cڄ?dwY¬}W ֳ ·"#f ^,5ڸeһǕ2 3]f ˕0ݦHd)uh&23w!w/y]C[2L|?2 %mi#ȳt@{MSI RE>6ϋ 1Cn!Y{: ufL7)ikJOo(-mH]7pv{XO;)c#smvw*"t xlzG"&$ wH00YlT`[6^% V6D-22GnՋND}k%B ;~ >pyCʳrBUԪiver5-aAtL琺+d˽*z4d=!lҖ2mQcQ&3g2pե ̊D-D.dS_&1(ףEw~E@0Op#7~sջlP}WX^bu.BClu.1BPuI[p!&VxGC~ 0=q@Yh!MͭɆ_/B R Y p8 y42}63 9!Rw x!?˕Eb3|Y?JmR/ ]xã;ɩ?V8L$6g _hc@*DpHv%,7N.Ie/ ωn"uY}a_0V%f':vKx`<!* fGW!K ˉ6@+O5 {$ˣ>Mv)\5T~]j#fH7[VLF&Dk/7җ) Ge xZ]RH%u$f@V&=/y4\rg OC>zOTW TrՖiB(*u5H)> \^! DÇf$b{(jwFbU{ӐcpoR7<Yݽۄc (9"H7E0*׉e` Yi͂T(d㐣~牒is7 Ck=kVRC<4KN\Z$:v˻|ɛšյI*`&Cw`_\yھU6!oO4^! nx-.AjE2$dyM My?D4pTo[!uGꛪݿ⭀ѻx TOM[IuMPRc%Q̕L뤶 "؃f؇-7 2e+fwxl԰Z~ OEV9 -W `Og }9Dx'TQxIeJ@N@ڴl);*8[׍obEwzzz!a6G.\^_pmR)ә $m;X:;6v3㎍OR(ƲT.$/---=ojYN8yL4Fߎ|^aci%LoxSr2,dzYylZ{{Ìyv3@gQg&S>A+FMׁ^u [ǟ YZWjY?5Ts-8~&?<mȂժnU:ߞeG: @VAYƚ`mm3؍4(w0Un1/Eځg!Uw ppW_j7IMR-ȷ 8y*H46d-+U\oz73BBCO9YH^t6!R|JDm%Cw#T N-Эߓg@ģ-CoLNJˏdXRKeGqd!eb%c]'na#\2ӲqIm/N{A0FROz,}3KX接'L#-9_n9K/O ~7@tGtvkڱG);,VebpLy+swcnnU_Qys4[ J͏/2K@k\.qLI25v9XLýߩY{afG68P0BjOŽe@sn/vignettes/0000755000176200001440000000000014150121606012676 5ustar liggesuserssn/vignettes/how_to_sample.pdf.asis0000644000176200001440000000017713647323114017204 0ustar liggesusers%\VignetteIndexEntry{How to sample from the SN and related distributions} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{PDF} sn/vignettes/pkg_sn-intro.pdf.asis0000644000176200001440000000015713647330070016753 0ustar liggesusers%\VignetteIndexEntry{An introduction to the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{PDF} sn/vignettes/pkg-overview.html.asis0000644000176200001440000000016113647330112017151 0ustar liggesusers%\VignetteIndexEntry{A brief overview of the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{HTML} sn/NEWS0000644000176200001440000002211614150121340011362 0ustar liggesusersR package 'sn' - NEWS (ChangeLog) file -------------------------------------- Version 2.0.1 (2021-11-26) Change of the tuning arguments when numDeriv::hessian is called, to improve computation of the information matrix following a ST model fitting. Fixed bug which in some cases prevented the use of the 'start' argument. Re-organization of some internal functions computing SUN summary quantities. Improved documentstion for selm, selm.fit and SUNdistr-base. Version 2.0.0 (2021-03-28) Support for the SUN distribution is introduced, as for probability distribution operations. Two modes of working are envisaged: (i) using classic-style functions for probability distributions, plus some functions of similar style; (ii) using S4 objects of the new class SUNdist. For mode (i), the functions {d,p,r}sun, sun{Mean,Vcov,Mardia} are provided. For mode (ii), there are {make, marginal, conditional, affineTrans, join, convolution, summary}SUNdistr, and related S4 methods. Additional facilities include convertSN2SUNdistr, convertCSN2SUNpar and two matrix operations (tr and blockDiag). Fixed a bug in plot.SECdistr affecting the plot of a subset of the variables. Version 1.6-2 (2020-05-26) Fixed wrong computation of standard errors when a multivariate ST model was fitted with the constraint alpha=0; similar fix of function confint. Change of the algorithm used in rsn: the additive representation is now used both for 0 and for non-0 values of tau. Use of the vignette builder R.rsp. Version 1.6-1 (2020-04-01) Some minor changes in the selm function documentation. Version 1.6-0 (2020-03-28) New intialization technique for numerical MLE search when function selm is called with family="ST". This is performed by the new functions st.prelimFit and mst.prelimFit, with the aid of galton_moors2alpha_nu; the package quantreg is employed for preliminary linear predictor estimation. Related new functions of more general interest are: fournum, pprodn2, pprodt2, qprodt2. Additional facts: an improved version of function profile.selm; improved coding of some internal functions. Version 1.5-5 (2020-01-30) In sn.infoMv, new argument at.MLE is introduced. Arguments of selm are updated to match changes in R. Fix a bug in dsn when called with a non-scalar argument alpha. Changed internal checks on 'try' output, to accomplish R changes. Version 1.5-4 (2019-05-09) On request from the CRAN group, a modification is inserted to get around numerical problems arising in connection with use of OpenBLAS (version 0.3.5). For plotting of a multivariate SECdistr when 'range' is not supplied and 'data' is non-NULL, calculation of the plotting range has been modified. Proper handling of the 'name' argument of marginalSECdistr when the result is a univariate distribution. Version 1.5-3 (2018-11-08) In pst, improved implementation of Method 2; slight modification of the automatic selection method when 'method=0'. Internal function qst_bounds introduced for better initial bracketing of ST quantiles; improved qst coding. In profile.selm the selected parameter area does no longer need to include the MLE/MPLE point. In sn.infoMv removed bugs in the stage of parameter parsing, which prevented computing the expected information matrix. In internal functions st.pdev.gh and mst.pdev.grad, improved computation of 'nu' component of logLik gradient, yielding faster fitting of ST models. Improved handling of arguments of sn.infoMv. Improved documentation of modeSECdistr and coding of modeSECdistrMv. Version 1.5-2 (2018-04-24) Improved checking of input arguments to lower level fitting procedures (those below selm) and improved handling for those of pst. Fixed improper handling when not positive-definite information in st.infoUv occurs, pointed out by the CRAN group. 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) Tools for user-defined symmetry-modulated (AKA skew-symmetric) distributions are introduced: {d,r}[m]SymmModulated and its bivariate density plotting. Fixed 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/R/0000755000176200001440000000000014150121606011067 5ustar liggesuserssn/R/sn-funct.R0000644000176200001440000070463214147451257013001 0ustar liggesusers# file sn/R/sn-funct.R (various functions) # This file is a component of the R package 'sn' # copyright (C) 1997-2020 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) za <- cbind(z, alpha) z <- za[,1] alpha <- za[,2] logS <- numeric(length(z)) ok <- (abs(alpha) < Inf) logS[ok] <- pnorm(tau * sqrt(1+alpha[ok]^2) + (alpha*z)[ok], log.p=TRUE) logS[!ok] <- log(as.numeric((sign(alpha)*z)[!ok] + 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(z[k])==Inf) p[k] <- (sign(z[k]) + 1)/2 else { 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: (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 } p <- as.vector(p) 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) {# since version 1.6-2 (2020): use transformation/additive method throughout if (!is.null(dp)) { if (!missing(alpha)) stop("You cannot set both 'dp' and the component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] tau <- if (length(dp) > 3) dp[4] else 0 } delta <- alpha/sqrt(1 + alpha^2) if(tau == 0) { tn <- matrix(rnorm(2*n), 2, n, byrow = FALSE) chi <- c(abs(tn[1,])) nrv <- c(tn[2,]) z <- delta * chi + sqrt(1 - delta^2) * nrv } else { # rs <<- .Random.seed truncN <- qnorm(runif(n, min= pnorm(-tau), max=1)) # .Random.seed <<- rs z <- delta * truncN + sqrt(1-delta^2) * rnorm(n) } y <- as.vector(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)) if(d == 1) return(psn(x, xi, omega, alpha, tau)) # 2018-05-02 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(is.infinite(dp0$alpha))) stop("Inf's in alpha are not allowed") lot <- dp2cpMv(dp=dp0, family="SN", aux=TRUE) d <- length(dp0$alpha) # rs <<- .Random.seed y <- matrix(rnorm(n*d), n, d, byrow=TRUE) %*% chol(lot$aux$Psi) # N_d(0,Psi) # .Random.seed <<- rs 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 'dp' and the component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } # rs <<- .Random.seed z <- rsn(n, 0, omega, alpha) if(nu < Inf) { # .Random.seed <<- rs 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] } dp.std <- c(0, 1, alpha, nu) delta <- alpha/sqrt(1+alpha^2) 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) return(rep(NaN, length(x))) 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<0 | method>4) stop("invalid 'method' value") if((method == 1 | method ==4) & !int.nu) stop("selected 'method' does not work for non-integer nu") pr <- rep(NA, length(x)) ok <- !(is.na(x) | (x==Inf) | (x==-Inf) | (omega<=0)) z <- ((x-xi)/omega)[ok] nu0 <- (8.2 + 3.55* log(log(length(z)+1))) if(alpha == 0) p <- pt(z, df=nu) else if(abs(alpha) == Inf) { z0 <- replace(z, alpha*z < 0, 0) p <- pf(z0^2, 1, nu) if(alpha < 0) p <- (1-p) } else { 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 <= nu0))) # method 4 p <- pst_int(z, 0, 1, alpha, nu) 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 && int.nu && (nu > nu0))) { # method 1 out <- try(pmst(z[i], 0, matrix(1,1,1), alpha, nu, ...), silent=TRUE) p[i] <- if(inherits(out, "try-error")) NA else p[i] <- out } 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) )) {# method 2 p0 <- acos(delta)/pi # CDF at x=0 int <- integrate(dst, min(0,z[i]), max(0,z[i]), dp=dp.std, stop.on.error=FALSE, ...) p[i] <- p0 + sign(z[i]) * int$value } else # method 3 p[i] <- integrate(fp, 0, Inf, alpha, nu, z[i], stop.on.error=FALSE, ...)$value }}}}} pr[ok] <- p pr[x == Inf] <- 1 pr[x == -Inf] <- 0 pr[omega <= 0] <- NaN return(pmax(0, pmin(1, pr))) } pst_int <- function (x, xi=0, omega=1, alpha=0, nu=Inf) {# Jamalizadeh, Khosravi and Balakrishnan (2009, CSDA) if(nu != round(nu) | nu < 1) stop("'nu' not a positive integer") if(omega <= 0) return(NaN) 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))) # if(some.unknown.rule) message( # "Running qst with small nu and high/low p can be numerically problematic") 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 bounds <- qst_bounds(p[nc], abs.alpha, nu) xa[nc] <- bounds[,"lower"] xb[nc] <- bounds[,"upper"] 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 bisection/regula falsi 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] fail <- ((xc[nc]-xa[nc]) * (xc[nc]-xb[nc])) > 0 fail[is.na(fail)] <- TRUE xc[fail] <- NA x[nc] <- xc[nc] # 2018-05-22: swap two adjacent lines to yield either NA or last estimate nc[fail] <- FALSE 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) } qst_bounds <- function(p, alpha, nu) {# function created 2018-05-03 if(length(alpha) > 1) stop("alpha must be of length 1") if(length(nu) > 1) stop("nu must be of length 1") if(alpha==0) { upper <- lower <- qt(p,nu); return(cbind(lower, upper))} s <- sign(alpha) if(alpha < 0) { p <- (1-p); alpha <- abs(alpha)} # from now on have alpha>0 lower <- qt(p, nu) # quantiles for alpha=0 upper <- sqrt(qf(p, 1, nu)) # quantiles for alpha=Inf wide <- (upper-lower) > 5 if(any(wide)) { for(k in 1:sum(wide)) { kk <- which(wide)[k] step <- 5 m <- 0 repeat{ lower[kk] <- upper[kk] - step p0 <- pst(lower[kk], 0, 1, alpha, nu, method=2) if(p0 < p[kk]) break step <- step*2^(2/(m+2)) m <- m+1 } }} if(s>0) cbind(lower, upper) else cbind(lower=-upper, upper=-lower) } 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(is.infinite(alpha))) stop("Inf's in alpha are not allowed") d <- length(alpha) z <- rmsn(n, rep(0, d), Omega, alpha) v <- if(nu==Inf) 1 else rchisq(n,nu)/nu y <- t(xi+ t(z/sqrt(v))) 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 the component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] } # rs <<- .Random.seed z <- rsn(n, 0, omega, alpha) #.Random.seed <<- rs y <- xi + z/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 'dp' and the component parameters") 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 'dp' and the component parameters") xi <- dp[1] omega <- dp[2] alpha <- dp[3] nu <- dp[4] } if(length(nu) > 1) stop("'nu' must be a scalar value") if(nu == Inf) return(sn.cumulants(xi, omega, alpha, n=n)) n <- min(as.integer(n), 4) par <- cbind(xi, omega, alpha) alpha <- par[,3] delta <- ifelse(abs(alpha)1 & nu>2) cum[,2] <- s(nu,2) - mu^2 if(n>2 & nu>3) cum[,3] <- mu*((3-delta^2)*s(nu,3) - 3*s(nu,2) + 2*mu^2) if(n>2 & nu==3) cum[,3] <- sign(alpha) * Inf if(n>3 & nu>4) cum[,4] <- (3*s(nu,2)*s(nu,4) - 4*mu^2*(3-delta^2)*s(nu,3) + 6*mu^2*s(nu,2)-3*mu^4) - 3*cum[,2]^2 if(n>3 & nu==4) cum[,4] <- Inf 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 <- lc.family0 <- tolower(family) name <- slot(object,"name") dp <- dp0 <- 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=="SC") {dp <- c(dp, 1); lc.family <- "st" } } if(family=="SN" || family=="ESN") cp.type <- "proper" cp <- dp2cpUv(dp, lc.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, lc.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])) if(family== "SC" & lc.family=="st") cp <- cp[-length(cp)] if(family== "SC" & lc.family=="st") dp <- dp[-length(dp)] 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) direct.pmean <- dp2cpMv(dp, family, "auto", upto=1)[[1]] - dp[[1]]/direct maxM <- max(abs(direct.pmean), na.rm=TRUE) opt <- optimize(f, lower=0, upper=maxM, dp=dp, direct=direct, maximum=TRUE) mode <- as.numeric(dp[[1]]+ opt$maximum * 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[[4]] <= 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) # SN book: see (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 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.mardia(delta.star^2, nu+a[4], d)[2] 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) } #-- function mst.gamma2M is subsumend in mst.mardia, in practical terms # mst.gamma2M <- function(delta.sq, nu, d) # {# Mardia measure of kurtosis \gamma_{2,d} for multiv.ST # 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 measures gamma1 and gamma2 for MST; book: (6.31), (6.32), p.178 if(d < 1) stop("d < 1") if(d != round(d)) stop("'d' must be a positive integer") if(delta.sq < 0 | delta.sq > 1) stop("delta.sq not in (0,1)") if(nu <= 3) stop("'nu>3' is required") 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, symmetr=FALSE, 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]) rv.comp <- c(rep(TRUE, upto-1), rep(FALSE, 4-upto)) param.type <- switch(cp.type, proper="CP", pseudo="pseudo-CP") cp.names <- param.names(param.type, "ST", p, names(beta1), rv.comp) cp <- c(mu, beta1) names(cp) <- cp.names[1:p] 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) names(cp) <- cp.names[1:(p+1)] } if(upto > 2 & ! symmetr) { g1 <- st.gamma1(delta, nu+a[3]) cp <- c(cp, g1) names(cp) <- cp.names[1:(p+2)] } if(upto > 3 & is.null(fixed.nu)) { g2 <- st.gamma2(delta, nu+a[4]) cp <- c(cp, g2) names(cp) <- cp.names } 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 of 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 of 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 of 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 of 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) # function b(.) in SN book, eq.(4.15) {# vectorized for 'nu', intended for values nu>1, otherwise it returns NaN out <- rep(NaN, length(nu)) big <- (nu > 1e4) ok <- ((nu > 1) & (!big) & (!is.na(nu))) # for large nu use asymptotic expression (from SN book, exercise 4.6) 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)) return(out) } # st.gamma1 <- function(delta, nu) {# this function is vectorized for delta, works for a single value of nu if(length(nu) > 1) stop("'nu' must be a single value") if(nu <= 0) stop("'nu' must be positive") out <- rep(NaN, length(delta)) names(out) <- names(delta) ok <- (abs(delta) <= 1) if((nu >= 3) & (sum(ok) > 0)) { alpha <- delta[ok]/sqrt(1 - delta[ok]^2) cum <- st.cumulants(0, 1, alpha, nu, n=3) out[ok] <- if(sum(ok) == 1) cum[3]/cum[2]^1.5 else cum[,3]/cum[,2]^1.5 } return(out) } # st.gamma2 <- function(delta, nu) {# this function is vectorized for delta, works for a single value of nu if(length(nu) > 1) stop("'nu' must be a single value") if(nu <= 0) stop("'nu' must be positive") out <- rep(NaN, length(delta)) names(out) <- names(delta) ok <- (abs(delta) <= 1) if((nu >= 4) & (sum(ok) > 0)) { alpha <- delta[ok]/sqrt(1 - delta[ok]^2) cum <- st.cumulants(0, 1, alpha, nu, n=4) out[ok] <- if(sum(ok) == 1) cum[4]/cum[2]^2 else cum[,4]/cum[,2]^2 } return(out) } # 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=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=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.mardia(delta.sq, nu, d)[2] - 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 <- force.symmetry(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 <- makeSECdistr(dp=dp1, family=family, name=name) } else new.obj <- makeSECdistr(dp.X, family, name, compNames) return(new.obj) } marginalSECdistr <- function(object, comp, name, drop=TRUE) {# marginals of SECdistrMv obj; version 2, computing marginal delta's family <- slot(object,"family") if(missing(name)) { basename <- if(object@name != "") object@name else deparse(substitute(object)) name <- if(length(comp)>1) paste(basename, "[", paste(as.character(comp), collapse=","), "]", sep="") else paste(basename, "[", as.character(comp), "]", 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=name) } 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) | length(Omega) == 1){ # 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, model=TRUE, x = FALSE, y = FALSE, contrasts = NULL, offset, ...) { 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") # in lm(): quote(stats::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(force.symmetry(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=list()) { 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 the Gaussian distribution ls <- lm.wfit(x, y, w) # note: offset already subtracted if any res <- residuals(ls) s2 <- sum(w*res^2)/nw dp <- cp <- param <- c(coef(ls), sqrt(s2)) x.names <- if(p==1) NULL else colnames(x)[-1] names(dp) <- param.names("DP", "SN", p, x.names)[1:npar] names(cp) <- param.names("CP", "SN", p, x.names)[1:npar] j <- rbind(cbind(t(x) %*% (w*x)/s2, 0), c(rep(0,p), 2*nw/s2)) j.inv <- pd.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=cp, dp=dp, dp.complete=c(dp,0), opt.method=list(ls$qr), logL=logL) boundary <- FALSE fit$opt.method <- list(method="least_squares", called.by= "lm.wfit") mu0 <- 0 fixed.comp <- p + 2 fixed.value <- 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" | family == "SC") { fixed.nu <- fixed.param$nu if(family == "SC") fixed.nu <- 1 fixed.comp <- fixed.value <- NULL if(symmetr) { fixed.comp <- p+2 fixed.value <- 0 } if(!is.null(fixed.nu)) { fixed.comp <- c(fixed.comp, p+3) fixed.value <- c(fixed.value, fixed.nu) } # free: the free components of (full) DP, those not in fixed.comp free <- setdiff(1:(p+3), fixed.comp) npar <- length(free) fit <- st.mple(x, y, dp=start, w, fixed.nu, symmetr, penalty, trace, contr$opt.method, contr$control) dp <- fit$dp dp.complete <- fit$dp.complete fit$cp <- cp <- st.dp2cp(dp.complete, cp.type="proper")[free] pseudo_cp <- st.dp2cp(dp.complete, cp.type="pseudo", jacobian=TRUE) fit$p_cp <- p_cp <- pseudo_cp[free] Dpcp.dp <- attr(pseudo_cp, "jacobian")[free, free] boundary <- fit$boundary nu <- if(is.null(fixed.nu)) dp[npar] else fixed.nu mu0 <- if(nu <= 1) NA else { if(symmetr) 0 else st.dp2cp(dp.complete, upto=1)[1] - dp[1] } info <- if(boundary) NULL else st.infoUv(dp=fit$dp, NULL, x, yInfo, w, fixed.nu, symmetr, penalty) } if(!boundary && family %in% c("ST","SC")) { # 2018-04-24 u <- try(Dpcp.dp %*% info$asyvar.dp %*% t(Dpcp.dp), silent=TRUE) info$asyvar.p_cp <- if(inherits(u, "try-error")) NULL else u } 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 { if(symmetr) rep(0,d) else c(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 if(d==1) z$param$fixed.terms <- list(fixed.comp=fixed.comp, fixed.value=fixed.value) } else z$param$fixed <- list() z$param$dp.complete <- fit$dp.complete return(z) } #--------------------------------------------------- summary.selm <- function(object, param.type="CP", cov=FALSE, cor=FALSE) { family <- slot(object,"family") fixed <- slot(object, "param")$fixed if(length(fixed$alpha==0)>0 && fixed$alpha==0 & family=="ST") { param.type <- "DP" note <- "ST model with alpha=0 is summarized with param.type=DP"} 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") 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' is not 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 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) } 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, currently 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"), note=note) 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, at.MLE=TRUE) {# 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 == "expected") { y <- NULL if(!missing(w)) stop("argument 'w' is meaningless for expected information") } if(type == "observed" & !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(x), 1)) if(any(w != round(w)) | any(w<0)) stop("weights must be non-negative integers") n <- if(type=="expected") length(w) else nrow(y) 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 <- 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 at/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) # score function of theta; see 2008 JMVA paper, p.1377, lines 9-11 # (except for a multiplicative constant of S2, irrelevant for MLE eqn's) 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.1377 on JMVA paper 2008 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 # cf (19) A1 <- (c1*(diag(d)-outer(eta,eta) %*% Omega/(1+alpha.star^2)) - c2*outer(eta, a1)) # cf 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)) { inv_I.theta <- matrix(NaN, nrow(I.theta), ncol(I.theta)) if(at.MLE){ warning("information matrix numerically not positive-definite") return(NULL) }} if(type == "observed" ) { score.norm2 <- sum(score * as.vector(inv_I.theta %*% score)) if(at.MLE & (score.norm2/d > norm2.tol)) stop("'dp' does not seem to be at the 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 # cf (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)) # cf (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.)) # cf (22b) jacob <- Dtheta.psi %*% Dpsi.cp I.cp <- t(jacob) %*% I.theta %*% jacob # cf (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) n <- nrow(y) if(missing(x)) x <- rep(1, n) else {if(!is.numeric(x)) stop("x must be numeric")} x <- data.matrix(x) if(nrow(x) != n) stop("incompatible dimensions") if(missing(w)) w <- rep(1, n) if(length(w) != n) stop("incompatible dimensions") d <- ncol(y) nw <- sum(w) p <- ncol(x) y.names <- dimnames(y)[[2]] x.names <- dimnames(x)[[2]] opt.method <- match.arg(opt.method) 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") y.name <- deparse(substitute(y)) if(!is.vector(y)) y <- as.vector(y) if(!is.numeric(y)) stop("argument y must be a numeric vector") n <- length(y) x <- if(missing(x)) matrix(rep(1, n), ncol = 1) else data.matrix(x) x.name <- deparse(substitute(x)) if(nrow(x) != n) stop("incompatible dimensions") 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") p <- ncol(x) if(missing(w)) w <- rep(1, n) if(length(w) != n) stop("incompatible dimensions") nw <- sum(w) if(is.null(dp) | mode(dp)=="character") { Mx <- if(mode(dp) == "character") dp[1] else "M2" if(!(Mx %in% c("M0", "M2", "M3"))) stop("invalid 'dp' initialization") if(Mx == 0) { # old method, not recommended 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(Mx == "M2") dp <- st.prelimFit(x, y, w, quick=TRUE)$dp if(Mx == "M3") dp <- st.prelimFit(x, y, w, quick=NULL)$dp 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, # Note: do NOT set 'hessian=st.dev.hessian', much time-comsuming 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)){ # 2018-10-30 new coding, code computing int.g moved to 'hessian' section logTwz <- function(nu, alpha, z) { r <- sqrt((nu+1)/(nu+z^2)) pt(alpha*z*r, df=nu+1, log.p=TRUE) } DlogTwz <- numDeriv::jacobian(logTwz, nu, z=z, alpha=alpha) score[j.nu] <- 0.5* sum(w*(-1/nu + digamma((nu+1)/2) - digamma(nu/2) -log(1+z^2/nu) + (nu+1)*z^2/(nu*(nu+z^2)) + 2*DlogTwz)) } 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) 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)) 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, silent=TRUE) # modified 2018-04-23 if(!is.null(asyvar.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 in the linear predictor. param.type <- toupper(param.type) family <- toupper(family) 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 == toupper("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()) { if(missing(y)) stop("required argument y is missing") y.name <- deparse(substitute(y)) y <- data.matrix(y) n <- nrow(y) y.names <- dimnames(y)[[2]] if(missing(x)) x <- rep(1, n) else {if(!is.numeric(x)) stop("x must be numeric")} x.names <- dimnames(x)[[2]] x <- data.matrix(x) if(nrow(x) != n) stop("incompatible dimensions") if(missing(w)) w <- rep(1, n) if(length(w) != n) stop("incompatible dimensions") nw <- sum(w) d <- ncol(y) p <- ncol(x) opt.method <- match.arg(opt.method) if(is.null(start) | mode(start)=="character") { Mx <- if(mode(start) == "character") start[1] else "M3" if(!(Mx %in% c("M0", "M2", "M3"))) stop("invalid 'start'") if(Mx == "M0") { # old method, superseded since version 1.6-0 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 dp <- list(beta=beta, Omega=Omega, alpha=alpha, nu=nu) } if(Mx == "M2") dp <- mst.prelimFit(x, y, quick=TRUE)$dp if(Mx == "M3") dp <- mst.prelimFit(x, y, quick=NULL)$dp } else { if (all(dim(start[[2]]) == c(d,d), length(start[[3]]) == d)) dp <- start else stop("argument 'start' is not in the form that I expected") } alpha <- if(symmetr) rep(0,d) else dp[[3]] nu <- if(!is.null(fixed.nu)) fixed.nu else dp[[4]] dp <- list(beta=dp[[1]], Omega=dp[[2]], alpha=alpha, nu=nu) if (trace) cat("mst.mple: starting dp = (", c(beta, Omega[!upper.tri(Omega)], alpha, nu), ")\n") param <- dplist2optpar(dp[1:3]) 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:", format(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 funct.logT. <- function(nu, d, L, Q) { sf <- if(nu < 1e4) sqrt((nu+d)/(nu+Q)) else sqrt((1+d/nu)/(1+Q/nu)) pt(L*sf, nu+d, log.p=TRUE) } dlogT.ddf <- numDeriv::jacobian(funct.logT., x=df0, d=d, L=L, Q=Q)[,1] 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 dp.full <- 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)) # include fixed param penalty.fn <- if(is.null(penalty)) NULL else get(penalty, inherits=TRUE) args <- list(eps=1e-4, d=0.01, zero.tol=sqrt(.Machine$double.eps/7e-7), r=4, v=2, show.details=TRUE) # inserted 2021-11-23 for v.2.0.1 H <- numDeriv::hessian(mst.logL, vdp, method.args=args, X=x, y=y, dp=TRUE, penalty=penalty.fn) J <- mst.theta.jacobian(theta, p=NCOL(x), d=NCOL(y)) # identify fixed components of parameter vector fixed.comp <- if(symmetr) d*p+d2+(1:d) else NULL if(!is.null(fixed.nu)) fixed.comp <- c(fixed.comp, length(vdp)) # free: the free components of vdp, i.e. those not in fixed.param free <- setdiff(1:length(vdp), fixed.comp) tmp <- try(force.symmetry(-H[free ,free]), silent=TRUE) if(inherits(tmp, "try-error")) { warning("Problems occurred with numerical differentian of the log-likelihood") message(attr(tmp,"condition")$message) message("The returned object does not include standard errors") asyvar.dp <- I.theta <- I.dp <- NULL } else { I.dp <- tmp J1 <- solve(J$Dtheta.dp[free, free]) 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, no standard errors") 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.dp <- list(beta=se.beta, diagOmega=se.diagOmega) se.dp$alpha <- if(!symmetr) diags.dp[p*d +d2 +(1:d)] else NULL se.dp$nu <- if(is.null(fixed.nu)) diags.dp[length(vdp)] else NULL } if(!is.null(asyvar.dp) & nu>4) { cp <- mst.dp2cp(dp, cp.type="proper", fixed.nu=fixed.nu, symmetr=symmetr) I.cp <- t(J$Dtheta.cp[free,free]) %*% I.theta %*% J$Dtheta.cp[free,free] I.cp <- force.symmetry(I.cp) 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[length(vdp)] }} else I.cp <- asyvar.cp <- se.cp <- cp <- NULL if(is.null(asyvar.dp)) { asyvar.pcp <- NULL se.pcp <- list(NULL) Jp <- NULL } else { Jp <- numDeriv::jacobian(mst.vdp2vcp, vdp, p=ncol(x), d=ncol(y), cp.type="pseudo") asyvar.pcp <- (Jp[free,free]) %*% asyvar.dp %*% t(Jp[free,free]) 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[length(vdp)] } aux <- list(Info.theta=I.theta, Dpseudocp.dp=Jp[free,free]) 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) if(missing(y)) stop("required argument y is missing") y.name <- deparse(substitute(y)) if(!is.vector(y)) y <- as.vector(y) if(!is.numeric(y)) stop("argument y must be a numeric vector") n <- length(y) x <- if(missing(x)) matrix(rep(1, n), ncol = 1) else data.matrix(x) if(nrow(x) != n) stop("incompatible dimensions") y.name <- deparse(substitute(y)) x.name <- deparse(substitute(x)) if (missing(w)) w <- rep(1,n) if(length(w) != n) stop("incompatible dimensions") x.name <- deparse(substitute(x)) p <- ncol(x) opt.method <- match.arg(opt.method) 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) 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):", format(cp), "\n") cat("(penalized) log-likelihood:", format(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") if(any(is.na(dp))) return(NA) if(dp[p+1] <= 0) return(NA) xi <- as.vector(x %*% as.matrix(dp[1:p])) 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) n <- nrow(y) if(missing(x)) x <- rep(1, n) else {if(!is.numeric(x)) stop("x must be numeric")} x <- data.matrix(x) if(nrow(x) != n) stop("incompatible dimensions") if(missing(w)) w <- rep(1,n) if(length(w) != n) stop("incompatible dimensions") nw <- sum(w) d <- ncol(y) p <- ncol(x) y.names <- dimnames(y)[[2]] x.names <- dimnames(x)[[2]] opt.method <- match.arg(opt.method) 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(missing(npt)) npt <- rep(101, pd) if(missing(main)) { main <- if(pd == 1 | pd == 2) paste("Density function of", name.pobj) else paste("Bivariate densities of", name.pobj) } compNames <- slot(pobj, "compNames") if(missing(compLabs)) compLabs <- compNames if(length(compLabs) != pd) stop("wrong length of 'compLabs' vector") family <- toupper(obj@family) lc.family <- tolower(family) if(lc.family == "esn") lc.family <- "sn" if(missing(range)) { range <- matrix(NA, 2, pd) q.fn <- get(paste("q", lc.family, sep=""), inherits=TRUE) for(j in 1:pd) { marg <- marginalSECdistr(pobj, 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)]) # 2019-01-13: next lines have been modified if(!is.null(data)) { q <- quantile(data[,j], probs=c(0.05, 0.25, 0.75, 0.95)) dq <- diff(q) range[1,j] <- min(range[1,j], q[1] - 2.5*dq[1]) range[2,j] <- max(range[2,j], q[length(q)] + 2.5*dq[length(dq)]) } } } dots <- list(...) nmdots <- names(dots) if(pd == 1) { message("Since dimension=1, plot as a univariate distribution") objUv <- marginalSECdistr(pobj, comp=comp, drop=TRUE) out <- plot(objUv, data=data, ...) } if(pd == 2) { p <- plot.SECdistrBv(pobj, range, probs, npt, compNames, compLabs, landmarks, data, data.par, main, ...) out <- list(object=pobj, plot=p) } if(pd > 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=pobj) 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(pobj, 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") cat("Family:", slot(obj,"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((note <- slot(object, "note")) != "") cat(paste("Note:", note, "\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 updated version 1.6-0 profile.selm <- function(fitted, param.type, param.name, param.values, npt, opt.control=list(), plot.it=TRUE, log=TRUE, levels, 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)) { message(gettextf( "Note: param range does not bracket the MLE/MPLE point: '%s'", format(mle.full[profile.comp])), domain=NA) bracket <- FALSE fail.confint <- TRUE } else bracket <- TRUE 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*(slot(obj, "logL") - logL) out$deviance <- deviance 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(levels)) levels <- 0.95 levels <- levels[1] if(is.na(levels) | levels <= 0 | levels >= 1) { message("illegal levels value is reset to default value") levels <- 0.95 } if(obj.par$boundary) {message(paste( "estimates at the boundary of the parameter space,", "no confidence interval")) levels <- NULL } if(!is.null(levels) & n.values>1 & bracket) { q <- qchisq(levels[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$levels <- levels } 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(bracket) { if(logScale) { rug(log(mle.full[profile.comp]), ticksize = 0.02) if(is.null(levels) | 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(levels)| fail.confint) low <- hi <- NULL else { low <- rootL$root hi <- rootH$root }} if(!is.null(levels) & !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) { message(gettextf( "Note: parameter range does not bracket the MLE/MPLE point: '%s'", paste(format(mle.full[profile.comp]), collapse=",")), domain=NA) bracket <- FALSE} else bracket <- TRUE 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") mle.profile <- mle.full[profile.comp] fn.dist <- function(p1, p2, q, h=1) sqrt(h*(p1-q[1])^2 + (p2-q[2])^2) dist <- matrix(0, n.values[1], n.values[2]) for(k1 in 1:n.values[1]) for(k2 in 1:n.values[2]) dist[k1,k2] <- fn.dist(param1[k1], param2[k2], mle.profile, h=1) # dist <- outer(param1, param2, fn.dist, q=mle.profile, h=1) s <- which(dist==min(dist), arr.ind=TRUE) s <- matrix(s, ncol=2)[1,] spiral <- discreteSpiral(s, n.values[1], n.values[2]) pts <- spiral$path[spiral$feasible,] logL <- matrix(NA, n.values[1], n.values[2]) last.estimate <- mle.full for(k in 1:prod(n.values)) { pt <- pts[k,] k1 <- pt[1] k2 <- pt[2] constr.values <- c(param1[k1], param2[k2], fixed.values) free.values <- last.estimate[-constr.comp] opt.control <- list() opt <- nlminb(free.values, constrained.logLik, negative=TRUE, 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$objective) last.estimate[-constr.comp] <- opt$par } out <- list(call=match.call(), param1=param1, param2=param2, logLik=logL) names(out)[2:3] <- param.name if(missing(levels)) levels <- c(0.25, 0.5, 0.75, 0.9, 0.95, 0.99) if(anyNA(levels) | any(levels<=0) | any(levels>=1)) { message("illegal levels values; vector 'levels' reset to default value") levels <- c(0.25, 0.5, 0.75, 0.9, 0.95, 0.99) } if(obj.par$boundary) {message( "MLE/MPLEs at the boundary of the parameter space, no confidence regions") levels <- NULL } q <- if(is.null(levels)) c(0.5, 1, 2, 5, 10, 20, 40, 80) else qchisq(levels, 2) deviance <- 2*(slot(obj, "logL") - logL) if(any(deviance + sqrt(.Machine$double.eps) < 0)) message(paste( "A relative maximum, or a minimum, of the (penalized) log-likelihood", "seems to have been taken as the MLE/MPLE. Unless the global maximum", "is divergent, consider refitting the model with starting values", "suggested by the plot.", sep="\n")) if(all(n.values>1)) { cL <- contourLines(param1, param2, deviance, levels=q) if(length(cL) > 0) { out$deviance.contour <- cL if(!is.null(levels)) for(j in 1:length(cL)) { k <- which(q == cL[[j]]$levels) out$deviance.contour[[j]]$prob <- levels[k] }} else { message(paste( "There appears to be something odd with the fitted MLE/MPLE.", "The contour levels denote logLik values, not confidence levels.", sep="\n")) contour(param1, param2, out$logLik, xlab=param.name[1], ylab=param.name[2], ...) return(out) }} 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=levels, xlab=param.name[1], ylab=param.name[2], ...) if(bracket) { mark <- mle.full[profile.comp] mark[logScale] <- log(mark[logScale]) points(mark[1], mark[2], pch=3, col=2) } } } invisible(out) } # discreteSpiral <- function(s, maxX, maxY) {# spiralling around s=c(sx, sy) in rectangle (1,...,maxX) \times (1,...,maxY) outside <- function(pt) if(any(pt < 1) | pt[1] > maxX | pt[2] > maxY) TRUE else FALSE if(outside(s)) stop("invalid starting point 's'") heading <- 0 # 0=N, 1=E, 2=S, 3=W h.add <- rbind(c(0,1), c(1,0), c(0,-1), c(-1,0)) step <- 0L path <- pt <- s feasible <- TRUE repeat { step <- step + 1L for(j in 1:2) { for(k in 1:step) { pt <- pt + h.add[heading+1, ] feasible <- c(feasible, !outside(pt)) path <- rbind(path, pt) } heading <- (heading + 1L) %% 4L } if(sum(feasible) == maxX*maxY) break } return(list(path=path, feasible=feasible)) } constrained.logLik <- function(free.param, param.type, x, y, weights, family, constr.comp=NA, constr.values=NA, penalty=NULL, trace=FALSE, negative=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 bad <- if(negative) Inf else -Inf par0 <- c(0, param[-(1:p)]) if(par0[2] <= 0) return(bad) if(family=="ST" & par0[4] <= 0) return(bad) 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, please report"); browser()} excess <- attr(dp0, "excess") if(length(excess) == 0) {message("0-length excess, please report"); 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(inherits(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") if(negative) out <- (-out) 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") { nu <- slot(object,"param")$dp["nu"] if(is.na(nu) | is.null(nu)) nu <- slot(object, "param")$fixed$nu ptype <- if(nu>4) "CP" else "pseudo-CP" } param.type <- switch(family, "SN" = "CP", "ST"=ptype, "SC"="pseudo-CP") } p <- slot(object, "size")["p"] param <- coef(object, param.type) npar <- length(param) x.names <- if(p>1) names(param)[2:p] else NULL par.names <- param.names(param.type, family, p, x.names) fixed.comp <- slot(object, "param")$fixed.terms$fixed.comp names(param) <- if(is.null(fixed.comp)) par.names else par.names[-fixed.comp] 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(length(slant) > 0) { 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[p+1] <- 1/param[p+1] # v <- diag(e) %*% vcov(object, param.type) %*% diag(e) vcov <- slot(object, "param.var")[[tolower(param.type)]] v <- diag(e) %*% vcov %*% diag(e) # avoid vcov() method drop.last <- 1:(p+1) se <- sqrt(diag(v))[drop.last] if(param.type=="DP" & (prod(intervals[slant,]) < 0)) se[1]<- NA par0 <- param[drop.last] par0[p+1] <- log(par0[p+1]) interv <- par0 + outer(se[drop.last], qnorm(lev2)) interv[p+1,] <- exp(interv[p+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 fixed.comp <- slot(object, "param")$fixed.terms$fixed.comp free.comp <- setdiff(1:(p+3), fixed.comp) positive.comp <- intersect(p + c(1,3) , free.comp) free.pos <- which(free.comp %in% positive.comp) par0[free.pos] <- log(par0[free.pos]) # log scale & tailweight e <- rep(1, length(param)) e[free.pos] <- 1/param[free.pos] # v <- diag(e) %*% vcov(object, param.type) %*% diag(e) vcov <- slot(object, "param.var")[[tolower(param.type)]] v <- diag(e) %*% vcov %*% diag(e) # avoid vcov() method se <- sqrt(diag(v)) interv <- par0 + outer(se, qnorm(lev2)) interv[free.pos,] <- exp(interv[free.pos,]) 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)) } #---- # functions added in v.1.6-0 fournum <- function(x, na.rm = TRUE, ...) { x <- as.vector(x) if(!is.numeric(x)) stop("x must be a numeric vector") na <- is.na(x) if (any(na)) {if (na.rm) x <- x[!na] else x <- NULL } if (length(x) < 8) m <- rep.int(NA, 4) else { oct <- quantile(x, probs=(1:7)/8, ...) q.deviation <- (oct[6]-oct[2])/2 # terminology from ESS2, vol.10, p.6743 GaltonBowley <- (oct[6]-2*oct[4]+oct[2])/(oct[6]-oct[2]) Moors <- (oct[7]-oct[5]+oct[3]-oct[1])/(oct[6]-oct[2]) m <- c(oct[4], q.deviation, GaltonBowley, Moors) } names(m) <- c("median", "q.deviation", "GaltonBowley", "Moors") return(m) } #--------- galton_moors2alpha_nu <- function(galton, moors, quick=TRUE, move.in=TRUE, verbose=0, abstol=1e-4) {# given (galton, moors) values, finds matching ST parameters (alpha, nu) deltaV <- c(seq(0, 0.9, by=0.1), 0.95, 0.99, 1) npt1 <- length(deltaV) nuV <- c(0.3, 0.32, 0.35, 0.4, 0.45, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0, 1.5, 2, 3, 4, 5, 7, 10, 15, 20, 30, 40, 50, 100, Inf) npt2 <- length(nuV) log.nuV <- log(nuV) moors0 <- c( # Moors values at alpha=0, from moorsM[1,]: 9.9456, 8.5883, 7.1096, 5.5251, 4.5430, 3.8879, 3.0876, 2.6296, 2.3393, 2.1417, 2.0000, 1.6522, 1.5167, 1.4033, 1.3542, 1.3269, 1.2977, 1.2771, 1.2618, 1.2544, 1.2471, 1.2436, 1.2414, 1.2372, 1.2331) galtonInf <- c(# Galton values at nu=Inf, from galtonM[,npt2] 0, 2.4746e-05, 2.0388e-04, 7.2391e-04, 1.8496e-03, 4.0097e-03, 7.9865e-03, 1.5413e-02, 3.0388e-02, 6.6491e-02, 0.10594, 0.14343, 0.144292171045) moorsInf <- c(# Moors values at nu=Inf, from moorsM[,npt2] 1.2331, 1.2331, 1.2331, 1.2332, 1.2333, 1.2338, 1.2347, 1.2367, 1.2408, 1.2462, 1.2375, 1.1889, 1.1764) approx.invNu <- splinefun(moors0, 1/nuV, method="hyman") bound.GB <- c(0.84423, 0.82327, 0.79244, 0.74352, 0.69838, 0.65727, 0.58661, 0.52943, 0.48311, 0.44533, 0.41421, 0.31849, 0.27109, 0.22551, 0.20376, 0.19113, 0.17712, 0.16694, 0.15921, 0.15541, 0.15166, 0.14980, 0.14869, 0.14648, 0.14429) bound.Moors <- c(10.0810, 8.7251, 7.2457, 5.6544, 4.6611, 3.9927, 3.1645, 2.6812, 2.3698, 2.1553, 2.0000, 1.6161, 1.4677, 1.3464, 1.2953, 1.2676, 1.2384, 1.2182, 1.2035, 1.1964, 1.1896, 1.1862, 1.1842, 1.1803, 1.1764) min.GB <- min(bound.GB) boundary1 <- splinefun(bound.GB, bound.Moors, method="hyman") boundary0 <- approxfun(galtonInf, moorsInf) boundary <- function(x, deriv = 0L) ifelse(x < min.GB, boundary0(x), boundary1(x, deriv)) eta <- matrix(c( 2.213831, -0.315418, -0.007641, 2.022665, -0.240821, -0.012001, 1.790767, -0.164193, -0.021492, 1.506418, -0.090251, -0.047034, 1.305070, -0.050702, -0.087117, 1.156260, -0.028013, -0.143526, 0.952435, -0.005513, -0.307509, 0.819371, 0.004209, -0.536039, 0.724816, 0.008992, -0.818739, 0.653206, 0.011596, -1.142667, 0.596276, 0.013136, -1.495125, 0.417375, 0.015798, -3.365100, 0.314104, 0.016371, -5.011929, 0.192531, 0.016274, -7.304089, 0.123531, 0.015682, -8.676470, 0.080123, 0.014987, -9.546498, 0.030605, 0.013674, -10.561206, -0.003627, 0.012113, -11.335506, -0.024611, 0.010334, -11.977601, -0.030903, 0.009149, -12.343369, -0.031385, 0.007650, -12.789281, -0.027677, 0.006721, -13.074983, -0.023285, 0.006079, -13.284029, -0.005288, 0.004478, -13.874691 ), nrow=npt2-1, ncol=3, byrow=TRUE) invert.GM <- function(galton, moors, alpha, log.nu, verbose=0, abstol=1e-4) { # invert (galton, moors) starting from initial (alpha, log.nu) if(galton*alpha < 0) stop("unfeasible initial alpha") loss.GM <- function(param, galton, moors, verbose=0) { if(verbose > 2) cat("param:", param) oct <- qst((1:7)/8, 0, 1, param[1], exp(param[2]), tol=abstol) g <- as.numeric((oct[6]-2*oct[4]+oct[2])/(oct[6]-oct[2])) m <- as.numeric((oct[7]-oct[5]+oct[3]-oct[1])/(oct[6]-oct[2])) loss <- sqrt(64*(g-galton)^2 + (m-moors)^2) if(verbose > 2) cat(" loss:", loss, "\n") loss } optim(c(alpha,log.nu), loss.GM, galton=galton, moors=moors, verbose=verbose, method="Nelder-Mead", control=list(abstol=abstol, maxit=200)) } if(moors < 0) stop("moors < 0 is not admissible") abs.galton <- abs(galton) note <- NULL feasible <- ( (moors > boundary(abs.galton)) & (abs.galton < 1) ) if(!feasible) { if(!move.in) return(c(NA,NA)) if(verbose > 0) message("unfeasible (galton, moors) reset to feasible area") if(abs.galton >= 1) {# note: GaltonBowley=1 for alpha=Inf, nu-->0 galton.new <- sign(galton)*0.95 if(verbose > 0) message(paste("'galton' reset to:", format(galton.new))) return(galton_moors2alpha_nu(galton.new, moors, quick, move.in, verbose)) } dist <- sqrt(64*(abs.galton - bound.GB)^2 + (moors - bound.Moors)^2) k <- which(dist == min(dist)) galton.new <- sign(galton)* 0.95 * bound.GB[k] moors.new <- if(k < length(dist)) 1.05*bound.Moors[k] else moors.new <- max(moorsInf) + 0.01 note <- paste("(galton,moors) reset to:", format(galton.new), ",", format(moors.new)) if(verbose > 0) message(note) out <- galton_moors2alpha_nu(galton.new, moors.new, quick, move.in, verbose) attr(out, "note") <- paste("unfeasible input values,", note) return(out) } log.nu <- if(moors > min(moors0)) log(1/approx.invNu(moors)) else Inf if(abs(galton) < (.Machine$double.eps)^(1/4) ) alpha <- 0 else { pos <- (log.nu >= log.nuV) if(all(pos) | all(!pos)) { # message("all(pos) | all(!pos)") eta.f <- if(all(pos)) eta[npt2-1, ] else eta[1, ] # browser() } else { k <- max(which(pos)) f <- (log.nu-log.nuV[k])/(log.nuV[k+1] + log.nuV[k]) eta.f <- if( k < (npt2-1)) (1-f)*eta[k,] + f*eta[k+1,] else eta[k,] } x <- log(abs(galton)) alpha <- as.numeric(sign(galton)) * exp(sum(eta.f * c(x, x^3, 1/x^3))) } out <- c(alpha=alpha, nu=exp(log.nu)) attr(out, "method") <- "quick match" if(quick) return(out) if(verbose > 0) cat("(GaltonBowley, Moors) quick match:", format(out), "\n") log.nu <- min(log.nu, 5) # avoid huge log.nu at start, especially Inf if(verbose > 1) message("Second step of (GaltonBowley, Moors) inversion") opt <- invert.GM(abs.galton, moors, abs(alpha), log.nu, verbose, abstol) if(verbose > 1) { cat("opt$(message, convergence, par, value):") cat(opt$message,", ") cat(opt$convergence,", ") cat("(", opt$par,"), ") cat(opt$value,"\n") # browser() } out <- c(alpha=as.numeric(sign(galton)*opt$par[1]), nu=exp(opt$par[2])) attr(out, "method") <- "two-step match" return(out) } #--------- st.prelimFit <- function(x, y, w, quick=TRUE, verbose=0, max.nu=30) { # quick values: (NULL, TRUE, FALSE) n <- length(y) if(missing(x)) x <- rep(1, n) x <- data.matrix(x) p <- ncol(x) if(n != nrow(x)) stop("dimension mismatch of x,y") if(any(x[,1] != 1)) stop("x[,1] not all 1's") if(missing(w)) w <- rep(1, n) if(n != length(w)) stop("dimension mismatch of w,y") if(p==1) { beta <- stats::median(y, na.rm=TRUE) resid <- (y-beta) } else { beta.fit <- quantreg::rq.wfit(x, y, tau=0.5, weights=w, method="br") beta <- coef(beta.fit) resid <- residuals(beta.fit) } q.measures <- fournum(resid) if(is.null(quick)) { alpha <- 0 nu <- 10 } else { galton <- q.measures[3] moors <- q.measures[4] alpha_nu <- galton_moors2alpha_nu(galton, moors, quick=quick, move.in=TRUE, verbose=verbose, abstol=1e-4) alpha <- alpha_nu[1] nu <- min(alpha_nu[2], max.nu) } omega <- 2 * q.measures[2]/diff(qst(c(0.25, 0.75), 0, 1, alpha, nu)) shift <- qst(0.5, 0, omega, alpha, nu) beta[1] <- beta[1] - shift resid <- resid + shift dp <- c(beta, omega, alpha, nu) names.x <- colnames(x) if(is.null(names.x)) names.x <- paste("x", 1:p, sep=".") if(p == 1) names.x <- "xi" names(dp) <- c(names.x, "omega", "alpha", "nu") logL <- sum(dst(resid, 0, omega, alpha, nu, log=TRUE)) return(list(dp=dp, residuals=resid, logLik=logL)) } #----------------------------------------------------------------------- mst.prelimFit <- function(x, y, w, quick=TRUE, verbose=0, max.nu=30) { matchMedian <- function(omega.bar, nu, obs.median) { if(any(abs(omega.bar) >= 1)) return(NA) pprodt2(obs.median, omega.bar, nu) - 0.5 } d <- ncol(y) n <- nrow(y) if(missing(x)) x <- matrix(1, n, 1) if(missing(w)) w <- rep(1, n) p <- ncol(x) dp.marg <- matrix(NA, p+3, d) z <- matrix(NA, n, d) for(j in 1:d) { fit <- st.prelimFit(x, y=y[,j], w, quick, verbose, max.nu) dp.marg[,j] <- fit$dp z[,j] <- fit$residuals/dp.marg[p+1,j] } nu <- median(dp.marg[p+3,]) # wd <- max(5, 1000/(nu + (.Machine$double.eps)^0.25)) Omega.bar <- diag(d) for(j in 1:(d-1)) for(k in (j+1):d) { w <- as.vector(z[,j] * z[,k]) w. <- median(w) rho.max <- 0.999999 nu.work <- nu repeat{ f1 <- matchMedian(-rho.max, nu.work, w.) f2 <- matchMedian(rho.max, nu.work, w.) if(f1*f2 < 0) break nu.work <- 0.9 *nu.work } r <- uniroot(matchMedian, interval=c(-rho.max, rho.max), nu=nu.work, obs.median=w.) Omega.bar[j,k] <- Omega.bar[k,j] <- r$root } lambda <- dp.marg[p+2,] delta <- lambda/sqrt(1 + lambda^2) Omega.star <- rbind(cbind(Omega.bar, delta), c(delta, 1)) k <- 0 repeat { m <- mnormt::pd.solve(Omega.star, silent=TRUE) if(!is.null(m)) break k <- k+1 Omega.star <- 0.95 * Omega.star Omega.star[cbind(1:(d+1),1:(d+1))] <- 1 } omega <- as.vector(dp.marg[p+1,]) Omega <- diag(omega, d) %*% Omega.star[1:d,1:d] %*% diag(omega, d) Omega <- force.symmetry(Omega) delta <- as.vector(Omega.star[d+1, 1:d]) tmp <- as.vector(solve(Omega.star[1:d,1:d]) %*% delta) alpha <- tmp/sqrt(1 - sum(delta*tmp)) beta <- dp.marg[1:p,] logL <- sum(dmst(y, x %*% beta, Omega, alpha, nu, log=TRUE)) dp.fit <- if(p==1) list(xi=dp.marg[1,], Omega=Omega, alpha=alpha, nu=nu) else list(beta=beta, Omega=Omega, alpha=alpha, nu=nu) return(list(dp=dp.fit, shrink.steps=k, dp.marginals=dp.marg, logLik=logL)) } #---------------------------------------------------------------------------- # from ~aa/SN/ST-various/St-start_MLE/SW/cdf_prod_t2.R # 2019-01-07 # Function pprodt2 computes CDF of product of components of bivariate Student's # (central) t variables, via Theorem 1 of Wallgren (1980, JASA, 75, 996-1000). # # For nu=2, the results have been checked agains those in Table 2 of # Nadarajah & Kotz (2006, Math. Proceed. Royal Irish Academy, 106A, 149-162). # The results are essentially in agreement, although with some differences, # typically of order <1%, often around 0.1%. These differences can reasonably # be attributed to rounding errors. Notice that their computations involve the # hypergeometric function, which is notoriously numerically hard to compute. #------------------ pprodt2 <- function(x, rho, nu) {# implements formulae in Theorem 1 of Wallgren (1980, JASA, 75, 996-1000) if(abs(rho) >= 1) { warning("abs(rho)<1 required"); return(NaN) } if(rho < 0) return(1 - pprodt2(-x, -rho, nu)) # see text following Theorem 1 sinA <- sqrt(1-rho^2) cosA <- rho alpha <- atan(-sinA/cosA) A <- atan2(sinA, cosA) piQ <- function(theta, A, x, nu) { # see (2.5) of Wallgren (1980) z <- nu*sin(theta)*sin(theta+A) (z/(x+z))^(nu/2) } neg <- (x<0) p <- rep(NA, length(x)) if(sum(neg)>0) { # see (2.4) of Wallgren (1980) m <- sum(neg) pneg <- rep(NA, m) for(j in 1:m) pneg[j] <- integrate(piQ, alpha, 0, A=A, x=x[neg][j], nu=nu)$value/pi p[neg] <- pneg } if(sum(!neg)>0) { # see (2.3) of Wallgren (1980) m <- sum(!neg) ppos <- rep(NA, m) for(j in 1:m) ppos[j] <- (1 - integrate(piQ, 0, pi+alpha, A=A, x=x[!neg][j], nu=nu)$value/pi) p[!neg] <- ppos } return(p) } # qprodt2 <- function(p, rho, nu, tol=1e-5, trace=0) { shiftedCDF <- function(x, prob, rho, nu) pprodt2(x, rho, nu) - prob m <- length(p) q <- rep(NA, m) if(nu <= 0) stop("nu>0 required") w <- max(5, 20/(nu^2 + sqrt(.Machine$double.eps))) for(j in 1:m) { if(p[j] == 0) q[j] <- -Inf else if(p[j] == 1) q[j] <- Inf else if(p[j] < 0 | p[j] >1) q[j] <- NaN else if(is.na(p[j])) q[j] <- NA else { r <- uniroot(shiftedCDF, interval=c(-w, w), prob=p[j], rho=rho, nu=nu, extendInt="yes", tol=tol, trace=trace) q[j] <- r$root }} return(q) } # pprodn2 <- function(x, rho) {# central case of Theorem 1 of Aroian et al. (1978, Comm.Stat A, 7, 165-172) if(abs(rho) >= 1) {warning("condition abs(rho)<1 fails"); return(NaN)} if(rho < 0) return(1 - pprodn2(-x, -rho)) fn.Phi <- function(t, y, rho) { cr2 <- 1-rho^2 G2 <- (1+cr2*t^2)^2 + (2*rho*t)^2 G <- sqrt(G2) I <- 1 + cr2*t^2 u <- (sqrt((G+I)/2) *sin(t*y) - sqrt((G-I)/2)*cos(t*y)) return(u/(t*G)) } m <- length(x) p <- numeric(m) for (j in 1:m){ int <- integrate(fn.Phi, 0, Inf, y=x[j], rho=rho, subdivisions=1000) p[j] <- 0.5 + int$value/pi } return(p) } sn/R/zzz.R0000644000176200001440000000074313616001650012055 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)' and 'help(overview-sn)' for basic information.\n", "The package redefines function 'sd' but its usual working is unchanged.") } invisible() } sn/R/sun.R0000644000176200001440000011245114147705604012037 0ustar liggesusers# file sn/R/sun.R # This file is a component of the R package 'sn' # copyright (C) 1997-2021 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/ #------------------------------------------- # # Some support functions # all.numeric <- function(...) {# check if all elements are numeric lst <- list(...) n <- length(lst) if(n == 0) return(NULL) m <- is.numeric(lst[[1]]) if(n == 1) return(m) for(k in 2:n) m <- m & is.numeric(lst[[k]]) return(m) } blockDiag <- function(...) {# create a block-diagonal matrix from a set of matrices lst <- list(...) n <- length(lst) if(n == 0) return(NULL) m <- as.matrix(lst[[1]]) if(n == 1) return(m) for(k in 2:n) { mk <- as.matrix(lst[[k]]) m <- rbind(cbind(m, matrix(0, nrow(m), ncol(mk))), cbind(matrix(0, nrow(mk), ncol(m)), mk)) } return(m) } tr <- function(x) {# trace of a numeric square matrix if(mode(x) != "numeric") stop("not a numeric argument") if(is.matrix(x)) { if(ncol(x) == nrow(x)) sum(diag(x)) else stop("not a square matrix")} else if(length(x)==1) x else stop("not a square matrix") } #------------------------------------------- dsun <- function(x, xi, Omega, Delta, tau, Gamma, dp=NULL, log=FALSE, silent=FALSE, ...) {# SUN density function if (!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if (!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } if(!all.numeric(x, xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- dim(Omega)[1] if(length(xi)!= d | dim(Omega)[2] != d) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) Omega.bar <- cov2cor(Omega) O.inv <- solve(Omega.bar) m <- length(tau) if(m==1 & !silent) warning("When m=1, functions for the SN/ESN distr'n are preferable") if(any(dim(Gamma) != c(m,m) | dim(Delta) != c(d,m))) stop("mismatch of dimensions") x <- if(is.vector(x)) matrix(x, 1, d) else data.matrix(x) n <- nrow(x) if (is.vector(xi)) xi <- outer(rep(1, n), as.vector(matrix(xi, 1, d))) tz <- t(x-xi)/omega D.Oinv <- t(Delta) %*% O.inv p1 <- pmnorm(t(tau + D.Oinv %*% tz), rep(0,m), Gamma - D.Oinv %*% Delta, ...) p2 <- pmnorm(tau, rep(0,m), Gamma, ...) if(n == 1) { if(any(c(attr(p1,"status"), attr(p2,"status")) != "normal completion")) warning("return status from pmnorm is not 'normal completion'") } pdfN <- dmnorm(x, xi, Omega, log=log) if(log) pdfN + logb(p1) - logb(p2) else pdfN * p1/p2 } psun <- function(x, xi, Omega, Delta, tau, Gamma, dp=NULL, log=FALSE, silent=FALSE, ...) {# SUN distribution function if (!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if (!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } if(!all.numeric(x, xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- dim(Omega)[1] if(length(xi)!= d | dim(Omega)[2] != d) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) Omega.bar <- cov2cor(Omega) O.inv <- solve(Omega.bar) m <- length(tau) if(m==1 & !silent) warning("When m=1, functions for the SN/ESN distr'n are preferable") if(any(dim(Gamma) != c(m,m) | dim(Delta) != c(d,m))) stop("mismatch of dimensions") x <- if(is.vector(x)) matrix(x, 1, d) else data.matrix(x) n <- nrow(x) if (is.vector(xi)) xi <- outer(rep(1, n), as.vector(matrix(xi, 1, d))) tz <- t(x-xi)/omega y <- cbind(t(tz), outer(rep(1, n), tau)) Omega.starNeg <- rbind(cbind(Omega.bar, -Delta), cbind(t(-Delta), Gamma)) p1 <- pmnorm(y, mean=rep(0,m+d), varcov=Omega.starNeg, ...) p2 <- pmnorm(tau, rep(0,m), Gamma, ...) if(n==1) { if(any(c(attr(p1,"status"), attr(p2,"status")) != "normal completion")) warning("return status from pmnorm is not 'normal completion'") } as.numeric(pmin(1, pmax(0, p1/p2))) } rsun <- function(n=1, xi, Omega, Delta, tau, Gamma, dp=NULL, silent=FALSE) {# SUN random numbers, use (7.4) of SN book if (!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if (!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } d <- dim(Omega)[1] if(length(xi)!= d | dim(Omega)[2] != d) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) Omega.bar <- cov2cor(Omega) # O.inv <- solve(Omega.bar) m <- length(tau) if(m==1 & !silent) warning("When m=1, functions for the SN/ESN family are preferable") if(any(dim(Gamma) != c(m,m) | dim(Delta) != c(d,m))) stop("mismatch of dimensions") Delta_invGamma <- Delta %*% solve(Gamma) Psi.bar <- Omega.bar - Delta_invGamma %*% t(Delta) u0 <- mnormt::rmnorm(n, rep(0, d), Psi.bar) u1 <- mnormt::rmtruncnorm(n, rep(0, m), Gamma, -tau) tz <- t(u0) + Delta_invGamma %*% t(u1) t(xi + omega * tz) } #------------------------- sunMean <- function(xi, Omega, Delta, tau, Gamma, dp=NULL, silent=FALSE, ...) {# expected value of SUN distribution if (!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if (!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } if(!all.numeric(xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- dim(Omega)[1] if(length(xi)!= d | dim(Omega)[2] != d) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) Omega.bar <- cov2cor(Omega) O.inv <- solve(Omega.bar) m <- length(tau) if(m==1 & !silent) warning("When m=1, functions for the SN/ESN family are preferable") if(any(dim(Gamma) != c(m,m) | dim(Delta) != c(d,m))) stop("mismatch of dimensions") prob <- mnormt::pmnorm(tau, rep(0, m), Gamma, ...) if(m > 3 && (attr(prob,"status") != "normal completion") & !silent) warning("return status from pmnorm is not 'normal completion'") deriv <- dnorm(tau)/prob if(m>1) for(k in 1:m) { Gk <- Gamma[-k,-k, drop=FALSE] gk <- Gamma[-k, k, drop=FALSE] Ec <- as.vector(gk * tau[k]) Vc <- Gk - gk %*% t(gk) deriv[k] <- deriv[k] * pmnorm(tau[-k], Ec, Vc, ...) } as.numeric(xi + omega*as.vector(Delta %*% deriv)) } mean.SUNdistr <- function(x) sunMean(dp=slot(x, "dp"), silent=TRUE) sunVcov <- function(xi, Omega, Delta, tau, Gamma, dp=NULL, silent=FALSE, ...) {# variance (matrix) of SUN distribution, using Proposition1 of RAV&AA-2020 if (!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if (!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } if(!all.numeric(xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- dim(Omega)[1] if(length(xi)!= d | dim(Omega)[2] != d) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) Omega.bar <- cov2cor(Omega) O.inv <- solve(Omega.bar) m <- length(tau) if(m==1 & !silent) warning("When m=1, functions for the SN/ESN family are preferable") if(any(dim(Gamma) != c(m,m) | dim(Delta) != c(d,m))) stop("mismatch of dimensions") mom.U <- mnormt::mom.mtruncnorm(2, mean=rep(0,m), Gamma, lower=-tau, ...) omega.Delta <- omega * Delta Gamma.inv <- solve(Gamma) A <- omega.Delta %*% Gamma.inv B.BT <- Omega - omega.Delta %*% Gamma.inv %*% t(omega.Delta) E.U <- if(m==1) mom.U$cum[1] else mom.U$cum1 E.U2 <- if(m==1) mom.U$mom[3] else mom.U$order2$m2 var.U <- if(m==1) mom.U$cum[2] else mom.U$order2$cum2 return(Omega - A %*% (Gamma- var.U) %*% t(A)) } vcov.SUNdistr <- function(object) sunVcov(dp=slot(object, "dp"), silent=TRUE) #------------------------------------------- # expand array to matrix (which are used by RAV&AA-2020) array2mat <- function(x, d) if(length(x)==d | length(dim(x))==2) return(x) else { n <- length(dim(x)) if(n > 4) stop("length(dim(x))>4 not allowed") out <- NULL for(k in 1:d) { s1 <- if(n==3) paste("x[, , k]") else paste("x[, , k, 1]") m1 <- eval(str2expression(s1)) out <- rbind(out, m1) } if(n==4) for(j in 2:d) out <- cbind(out, array2mat(x[,,,j], d)) return(out) } sunMardia <- function(xi, Omega, Delta, tau, Gamma, dp=NULL, silent=FALSE, ...) {# Mardia measures of multivariate skewness and kurtosis for SUN distributions if(!(missing(Delta) & missing(Omega)) && !is.null(dp)) stop("You cannot set both component parameters and 'dp'") if(!is.null(dp)) { if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] } if(!all.numeric(xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- length(xi) m <- length(tau) compNames <- rownames(Omega) HcompNames <- rownames(Gamma) if(is.null(compNames)) compNames <- paste("V", 1:d, sep="") if(is.null(HcompNames)) HcompNames <- paste("H", 1:m, sep="") u <- sunValues(dp=dp, compNames, HcompNames, ...) return(u$mardia) } makeSUNdistr <- function(dp, name, compNames, HcompNames, drop=TRUE) { if(!is.list(dp)) stop("dp is not a list") if(length(dp) != 5) stop("length(dp) is not 5") xi <- dp[[1]] Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] if(!all.numeric(xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- length(xi) m <- length(tau) if(!all(dim(Omega) == c(d,d))) stop("mismatch of dimensions") if(missing(compNames)) { compNames <- if(length(names(xi)) == d) names(xi) else as.vector(outer("V", as.character(1:d), paste,sep="")) } if(!is.matrix(Gamma) | m==1) { if(length(c(Gamma))>1) stop("Wrong dp$Gamma") if(c(Gamma) != 1) stop("Since m=1, dp$Gamma must be 1, but it is not") if(drop) { delta <- c(Delta) if(length(delta) != d) stop("wrong size of Delta") if(length(tau) != 1) stop("wrong length(tau)") Om.delta <- solve(cov2cor(Omega)) %*% delta delta.star.sq <- sum(delta %*% Om.delta) if(delta.star.sq >= 1 | delta.star.sq < 0) stop("unfeasible arguments") alpha <- as.vector(Om.delta)/sqrt(1 - delta.star.sq) if(missing(name)) name <- "Unknown_ESN" if(d==1) { dp.ESN <- c(xi=xi, omega=sqrt(Omega), alpha=alpha, tau=tau) obj <- new("SECdistrUv", dp=dp.ESN, family="ESN", name=name) } else { dp.ESN <- list(xi=xi, Omega=Omega, alpha=alpha, tau=tau) obj <- new("SECdistrMv", dp=dp.ESN, family="ESN", name=name, compNames=compNames) } return(obj) } } if(any(dim(Gamma) != c(m,m)) | any(dim(Delta) != c(d,m))) stop("mismatch of dimensions") omega <- sqrt(diag(Omega)) if(!all(diag(Gamma)==1)) stop("diag(Gamma) are not all 1's") big.Omega <- rbind(cbind(Omega, omega*Delta), cbind(t(omega*Delta), Gamma)) if(max(abs(big.Omega -t(big.Omega))) > .Machine$double.eps) stop("(Omega, Delta, Gamma) do not make a symmetric matrix") big.Omega <- 0.5*(big.Omega + t(big.Omega)) eigenvalues <- eigen(big.Omega, symmetric=TRUE, only.values = TRUE)$values if(any(eigenvalues <= 0)) stop("(Omega, Delta, Gamma) do not make a positive definite matrix") name <- if (!missing(name)) as.character(name)[1] else paste("Unnamed-SUN(d=", as.character(d), ",m=", as.character(m), ")", sep = "") names(dp) <- c("xi", "Omega", "Delta", "tau", "Gamma") if(missing(compNames)) compNames <- as.vector(outer("V", as.character(1:d), paste,sep="")) if(missing(HcompNames)) HcompNames <- as.vector(outer("H", as.character(1:m), paste,sep="")) names(xi) <- compNames dimnames(Omega) <- list(compNames, compNames) dimnames(Delta) <- list(compNames, HcompNames) names(tau) <- HcompNames dimnames(Gamma) <- list(HcompNames, HcompNames) dp0 <- list(xi=xi, Omega=Omega, Delta=Delta, tau=tau, Gamma=Gamma) obj <- new("SUNdistr", dp = dp0, name = name, compNames=compNames, HcompNames=HcompNames) if(class(obj) != "SUNdistr" & drop==FALSE) stop("Error. No SUNdistr object created") obj } marginalSUNdistr <- function(object, comp, name, drop=TRUE) {# builds from 'obj' the SUN marginal distribution identified by 'comp' class.obj <- class(object) if(!(class.obj %in% c("SUNdistr", "SECdistrMv"))) stop("object of wrong class") if(class(object) == "SECdistrMv") { if(slot(object, "family") == "ESN") { message("This object is ESN distribution, passed on to 'SECdistrMv'") return(marginalSECdistr(object, comp, name, drop)) } else stop("wrong 'family' type of 'SECdistrMv' object") } dp <- slot(object, "dp") Omega <- dp[[2]] d <- dim(Omega)[1] if(!all(comp %in% 1L:d)) stop("some comp values not admissible") dp.m <- list(xi=dp[[1]][comp], Omega=Omega[comp, comp, drop=FALSE], Delta=dp[[3]][comp,, drop=FALSE], tau=dp[[4]], Gamma=dp[[5]]) if(missing(name)) { comp.c <- paste(as.character(comp), collapse=",") name <- paste(slot(object, "name"), "[", comp.c, "]", sep="") } compNames <- slot(object, "compNames")[comp] hnames <- slot(object, "HcompNames") obj.m <- makeSUNdistr(dp.m, name, compNames, hnames, drop=drop) # if(class(obj.m) != "SUNdistr") stop("Error. No SUNdistr object created") obj.m } affineTransSUNdistr <- function(object, a, A, name, compNames, HcompNames, drop=TRUE) {# distribution of affine transformation X=a+t(A)Y; see SN book, top of p.199 if(class(object) != "SUNdistr") stop("wrong object class") dp <- slot(object, "dp") d <- length(dp$xi) 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)), ") %*% (", slot(object, "name"),")", sep="") else name <- as.character(name)[1] if(missing(compNames)) compNames <- as.vector(outer("V",as.character(1:h), paste,sep="")) if(missing(HcompNames)) HcompNames <- slot(object, "HcompNames") Omega <- dp$Omega omega <- sqrt(diag(Omega)) OmegaX <- t(A) %*% Omega %*% A OmegaX <- (OmegaX + t(OmegaX))/2 eig <- eigen(OmegaX, symmetric=TRUE, only.values=TRUE)$values if(any(eig <= 0)) stop("singular transformation") omegaX <- sqrt(diag(OmegaX)) DeltaA <- (1/omegaX)*t(A) %*% (omega * dp$Delta) dpX <- list(xi=as.vector(a + t(A) %*% matrix(dp$xi, ncol=1)), Omega=OmegaX, Delta=DeltaA, tau=dp$tau, Gamma=dp$Gamma) obj <- makeSUNdistr(dp=dpX, name, compNames, HcompNames, drop=drop) return(obj) } # convolutionSUNdistr <- function(object1, object2, name, compNames, HcompNames) {# convolution of two SUN distributions; see SN book eq.(7.8) on p.199 if(class(object1) != "SUNdistr" | class(object2) != "SUNdistr" ) stop("wrong object class") dp1 <- slot(object1, "dp") dp2 <- slot(object2, "dp") m1 <- length(dp1$tau) m2 <- length(dp2$tau) if(length(dp1$xi) != length(dp2$xi)) stop("objects with different dimensions") name1 <- slot(object1, "name") name2 <- slot(object2, "name") if(missing(name)) name <- paste("(", name1, ")+(", name2, ")", sep="") if(missing(compNames)) compNames <- as.vector(outer("V", as.character(1:length(dp1$xi)), paste, sep="")) Omega1 <- dp1$Omega omega1 <- sqrt(diag(Omega1)) Omega2 <- dp2$Omega omega2 <- sqrt(diag(Omega2)) omega <- sqrt(omega1^2+omega2^2) Delta <- cbind((omega1/omega)* dp1$Delta, (omega2/omega)* dp2$Delta ) if(missing(compNames)) compNames <- as.vector(outer("V", as.character(1:length(dp1$xi)), paste, sep="")) if(missing(HcompNames)) HcompNames <- c(paste(name1, slot(object1, "HcompNames"), sep="."), paste(name2, slot(object2, "HcompNames"), sep=".")) names(xi) <- compNames Omega <- Omega1 + Omega2 dimnames(Omega) <- list(compNames, compNames) dimnames(Delta) <- list(compNames, HcompNames) tau <- c(dp1$tau, dp2$tau) Gamma <- blockDiag(dp1$Gamma, dp2$Gamma) names(tau) <- HcompNames dimnames(Gamma) <- list(HcompNames, HcompNames) dp <- list(xi=dp1$xi+dp2$xi, Omega=Omega, Delta=Delta, tau=tau, Gamma=Gamma) obj <- makeSUNdistr(dp=dp, name, compNames, HcompNames) return(obj) } # conditionalSUNdistr <- function(object, comp, values, eventType="=", name, drop=TRUE) {# Conditional distribution for the "=" case as given by eq.(7.7) of SN book, and # later amendment; the distribution for the ">" case is given by RAV&AA (2020). if(class(object) != "SUNdistr") stop("wrong object class") type <- match.arg(eventType, c("=", ">")) if(!is.numeric(values)) stop("non-numeric 'values'") dp <- slot(object, "dp") xi <- dp$xi Omega <- dp$Omega Delta <- dp$Delta tau <- dp$tau Gamma <- dp$Gamma d <- length(xi) m <- length(tau) if(!all(comp %in% 1:d)) stop("some 'comp' terms outside range") if(length(comp) == d) stop("degenerate conditional distribution") if(length(comp) != length(values)) stop("mismatch of comp and values sizes") omega <- sqrt(diag(Omega)) Omega11 <- Omega[comp, comp, drop=FALSE] Omega22 <- Omega[-comp, -comp, drop=FALSE] Omega.bar <- cov2cor(Omega) if(type == "=") { O11.inv <- solve(Omega11) tmp1 <- Omega[-comp, comp, drop=FALSE] %*% O11.inv values0 <- matrix(values - xi[comp], ncol=1) xi2.1 <- c(xi[-comp] + tmp1 %*% values0) O22.1 <- Omega22 - tmp1 %*% Omega[comp, -comp, drop=FALSE] tmp2 <- solve(Omega.bar[comp, comp, drop=FALSE]) Delta1 <- Delta[comp, , drop=FALSE] Delta2 <- Delta[-comp, , drop=FALSE] tau2.1 <- c(tau + t(Delta1) %*% tmp2 %*% (values0/omega[comp])) Delta2.1 <- Delta2 - Omega.bar[-comp,comp] %*% tmp2 %*% Delta1 Gamma2.1 <- Gamma - t(Delta1) %*% tmp2 %*% Delta1 s <- sqrt(diag(Gamma2.1)) sDelta <- Delta2.1 %*% diag(1/s, m, m) stau <- tau2.1/s sGamma <- cov2cor(Gamma2.1) if(missing(name)) name <- paste(slot(object, "name"), "|comp[", paste(comp,collapse=","), "]=(", paste(format(values), collapse=","), ")", sep="") names <- slot(object, "compNames")[-comp] dp.c <- list(xi=xi2.1, Omega=O22.1, Delta=sDelta, tau=stau, Gamma=sGamma) hnames <- slot(object, "HcompNames") obj <- makeSUNdistr(dp=dp.c, name, names, hnames, drop=drop) } if(type == ">") { xi.c <- xi[-comp] Delta.c <- cbind(Delta[-comp,, drop=FALSE], Omega.bar[-comp,comp,drop=FALSE]) tau.c <- c((xi[comp] + (-values))/omega[comp], tau) Gamma.c <- rbind(cbind(Omega.bar[comp, comp, drop=FALSE], Delta[comp,,drop=FALSE]), cbind(t(Delta[comp,, drop=FALSE]), Gamma)) dp.c <- list(xi=xi.c, Omega=Omega22, Delta=Delta.c, tau=tau.c, Gamma=Gamma.c) if(missing(name)) name <- paste(slot(object, "name"), "|comp[", paste(comp, collapse=","), "]>(", paste(format(values), collapse=","), ")", sep="") names <- slot(object, "compNames")[-comp] hnames <- c(slot(object, "compNames")[comp], slot(object, "HcompNames")) obj <- makeSUNdistr(dp=dp.c, name, names, hnames, drop=drop) } return(obj) } # joinSUNdistr <- function(object1, object2, name, compNames, HcompNames) {# join two SUN distributions assuming independence obj1 <- object1 obj2 <- object2 if(class(obj1) != "SUNdistr") obj1 <- convertSN2SUNdistr(obj1, silent=TRUE) if(is.null(obj1)) stop("object1 is neither a SUNdistr object nor adjustable") if(class(obj2) != "SUNdistr") obj2 <- convertSN2SUNdistr(obj2, silent=TRUE) if(is.null(obj2)) stop("object2 is neither a SUNdistr object nor adjustable") dp1 <- slot(obj1, "dp") dp2 <- slot(obj2, "dp") name1 <- slot(obj1, "name") name2 <- slot(obj2, "name") if(missing(name)) name <- paste("(",name1, ")x(", name2, ")", sep="") if(missing(compNames)) compNames <- c(paste(name1, slot(obj1, "compNames"), sep="."), paste(name2, slot(obj2, "compNames"), sep=".")) if(missing(HcompNames)) HcompNames <- c(paste(name1, slot(obj1, "HcompNames"), sep="."), paste(name2, slot(obj2, "HcompNames"), sep=".")) dp <- list(xi=c(dp1$xi, dp2$xi), Omega=blockDiag(dp1$Omega, dp2$Omega), Delta=blockDiag(dp1$Delta, dp2$Delta), tau=c(dp1$tau, dp2$tau), Gamma=blockDiag(dp1$Gamma, dp2$Gamma)) makeSUNdistr(dp, name, compNames, HcompNames) } convertSN2SUNdistr <- function(object, HcompNames="h", silent=FALSE) {# converts SN/ESN into a SUN distribution obj.cl <- class(object) if(!(obj.cl %in% c("SECdistrUv", "SECdistrMv"))) if(silent) return(NULL) else stop("wrong class object") obj.fm <- slot(object, "family") if(!(obj.fm %in% c("SN", "ESN"))) if(silent) return(NULL) else stop("wrong family of distributions") dp <- slot(object, "dp") if(obj.cl == "SECdistrUv") { xi <- dp[1] Omega <- matrix(dp[2]^2, 1, 1) alpha <- dp[3] Delta <- matrix(alpha/sqrt(1+alpha^2), 1, 1) tau <- if(length(dp)>3) dp[4] else 0 names <- slot(object, "name") } if(obj.cl == "SECdistrMv") { xi <- dp[[1]] Omega <- dp[[2]] alpha <- dp[[3]] etc <- delta.etc(alpha, Omega) Delta <- matrix(etc$delta, ncol=1) tau <- if(length(dp)>3) dp[[4]] else 0 names <- slot(object, "compNames") } dp <- list(xi=xi, Omega=Omega, Delta=Delta, tau=tau, Gamma=matrix(1, 1, 1)) makeSUNdistr(dp=dp, slot(object, "name"), names, HcompNames[1], drop=FALSE) } convertCSN2SUNpar <- function(mu, Sigma, D, nu, Delta) {# convert a set of CSN parameters to their SUN equivalents if(!all.numeric(mu, Sigma, D, nu, Delta)) stop("non-numeric argument(s)") if(any(eigen(Sigma, only.values=TRUE)$values <= 0)) stop("invalid Sigma") if(any(eigen(Delta, only.values=TRUE)$values <= 0)) stop("invalid Delta") p <- NCOL(Sigma) q <- NCOL(Delta) if(length(mu) != p) stop("mismatch of dimensions") if(length(nu) != q) stop("mismatch of dimensions") if(any(dim(D) != c(q, p))) stop("mismatch of dimensions") DS <- D %*% Sigma M <- rbind(cbind(Sigma, t(DS)), cbind(DS, Delta + DS %*% t(D))) M0 <- cov2cor(M) Gamma <- M0[p + (1:q), p + (1:q), drop=FALSE] DeltaSUN <- M0[1:p, p+(1:q), drop=FALSE] list(xi=mu, Omega=matrix(Sigma, p, p), Delta=DeltaSUN, tau=-nu, Gamma=Gamma) } #---------------- summary.SUNdistr <- function(object, ...) {# dp <- slot(object, "dp") name <- slot(object, "name") compNames <- slot(object, "compNames") HcompNames <- slot(object, "HcompNames") u <- sunValues(dp=dp, compNames, HcompNames, ...) new("summary.SUNdistr", dp=dp, name=name, compNames=compNames, HcompNames=HcompNames, mean=u$mean, var.cov=u$vcov, gamma1=u$gamma1, cum3=u$cum3, mardia=u$mardia) } sunValues <- function(dp, compNames, HcompNames, ...) {# Some moments and other characteristics values of a SUN distribution. # Computations are based on Proposition 1 and 2 of RAV&AA-2020 if (length(dp) != 5) stop("wrong length of non-null 'dp'") xi <- drop(dp[[1]]) Omega <- dp[[2]] Delta <- dp[[3]] tau <- dp[[4]] Gamma <- dp[[5]] if(!all.numeric(xi, Omega, Delta, tau, Gamma)) stop("non-numeric argument(s)") d <- length(xi) m <- length(tau) if(missing(compNames)) compNames <- paste("V", 1:d, sep="") if(missing(HcompNames)) HcompNames <- paste("H", 1:m, sep="") omega <- sqrt(diag(Omega)) omega.Delta <- omega * Delta Gamma.inv <- solve(Gamma) A <- omega.Delta %*% Gamma.inv # A=\Lambda in (17) of RAV&AA-2020 mom.U <- mnormt::mom.mtruncnorm(4, mean=rep(0,m), Gamma, lower=-tau, ...) E.U <- if(m==1) mom.U$cum[1] else mom.U$cum1 mu1.X <- A %*% E.U # see \mu_1(X) in Proposition 1 Esun <- dp$xi + drop(mu1.X) names(Esun) <- compNames # E.U2 <- if(m==1) mom.U$mom[3] else mom.U$order2$m2 var.U <- if(m==1) mom.U$cum[2] else mom.U$order2$cum2 Vsun <- Omega - A %*% (Gamma- var.U) %*% t(A) # see var(X) in Prop.1 dimnames(Vsun) <- list(compNames, compNames) Sigma <- var.X <- Vsun sigma <- sqrt(diag(Sigma)) Sigma.inv <- solve(Sigma) mu2.X <- var.X + mu1.X %*% t(mu1.X) #--- # Calcolo cumulanti/momenti centrali del terzo ordine. # Partiamo da \mu_3(X) della Proposizione 1 di RAV&AA-2020. # Calcoliamo (I_{d^2}+K_d) utilizzando eqn.(4) e (7) a p.57 # di Magnus & Neudecker (2007, 3^ ed) D <- duplicationMatrix(d) Dplus <- solve(t(D) %*% D) %*% t(D) twiceD.Dplus_d <- 2*D %*% Dplus B.BT <- Omega - omega.Delta %*% Gamma.inv %*% t(omega.Delta) # \Psi in (17) mu3.U <- if(m==1) mom.U$mom[3+1] else array2mat(mom.U$order3$m3, m) mu3.X <- ( (A %x% A) %*% mu3.U %*% t(A) + twiceD.Dplus_d %*% (mu1.X %x% B.BT) + matrix(B.BT, ncol=1) %*% t(mu1.X) ) # Now apply shift \xi=-mu1.X in (A.7) of RAV&AA; first two terms cancel out shift <- (-mu1.X) cum3 <- (twiceD.Dplus_d %*% (shift %*% t(shift) %x% mu1.X + shift %x% mu2.X) + matrix(mu2.X, ncol=1) %*% t(shift) + mu3.X) cum3 <- array(cum3, dim=c(d,d,d)) # convert matrix into array gamma1 <- cum3[cbind(1:d, 1:d, 1:d)]/sigma^3 #--- # Mardia measures of skewness and kurtosis; use Proposition 2 of RAV&AA-2020 AA <- Gamma.inv %*% t(omega.Delta) %*% Sigma.inv %*% omega.Delta %*% Gamma.inv # AA =\tilde\Lambda^T\tilde\Lambda = \Lambda^T\Sigma\inv\Lambda in Prop.2 vec.mu3 <- if(m==1) mom.U$centr.mom[3] else c(mom.U$order3$cum3) gamma1M <- beta1M <- if(m==1) drop(vec.mu3^2 *AA^3) else drop(t(vec.mu3) %*% (AA %x% AA %x% AA) %*% vec.mu3) mu4.U <- if(m==1) mom.U$centr.mom[4] else { cum4 <- array2mat(mom.U$order4$cum4, m) # conversione cum4 in matrice # Usiamo (2.8)-(2.9) di Kollo & Srivastava (2005, Comms.Stat-TM) per # passare da cumulanti a momenti centrali del quarto ordine, con correzione! D <- duplicationMatrix(m) Dplus <- solve(t(D) %*% D) %*% t(D) twiceD.Dplus_m <- 2*D %*% Dplus cmom4N <- twiceD.Dplus_m %*% (var.U %x% var.U) + c(var.U) %*% t(c(var.U)) cum4 + cmom4N # matrice dei quarti momenti centrali } tmp1 <- Gamma.inv %*% t(omega.Delta) %*% Sigma.inv tmp2 <- B.BT %*% Sigma.inv beta2M <- ( tr((AA %x% AA) %*% mu4.U) + 2* tr(var.U %*% AA) * tr(tmp2) + tr(tmp2)^2 + 4 * tr(var.U %*% tmp1 %*% B.BT %*% t(tmp1)) + 2 * tr(tmp2 %*% tmp2) ) mardia <- c(gamma1M=gamma1M, gamma2M=(beta2M-d*(d+2))) list(mean=Esun, vcov=Vsun, gamma1=gamma1, cum3=cum3, mardia=mardia) } #---------------- # plotting SUN densities # plot.SUNdistr <- function(x, range, nlevels=8, levels, npt, main, comp, compLabs, gap = 0.5, ...) {# plot density of object of class "SUNdistr" obj <- x if(slot(obj, "class") != "SUNdistr") stop("object of wrong class") dp <- slot(obj, "dp") d <- length(dp$xi) if(missing(comp)) comp <- seq(1, d) if(!all(comp %in% seq(1,d))) stop("illegal 'comp' value(s)") pd <- length(comp) # actual plotting dimension if(missing(npt)) npt <- if(pd==1) 251 else rep(101, pd) pobj <- if(pd == d) obj else marginalSUNdistr(obj, comp=comp, drop=FALSE) name.pobj <- slot(obj, "name") if(pd < d) name.pobj <- paste(name.pobj,"[", paste(comp, collapse=","), "]", sep="") if(missing(main)) { main <- if(pd == 1 | pd == 2) paste("Density function of", name.pobj) else paste("Bivariate densities of", name.pobj) } compNames <- slot(pobj, "compNames") if(missing(compLabs)) compLabs <- compNames if(length(compLabs) != pd) stop("wrong length of 'compLabs' vector") if(missing(range)) { range <- matrix(NA, 2, pd) dp.pobj <- slot(pobj, "dp") m <- sunMean(dp=dp.pobj) v <- sunVcov(dp=dp.pobj) s <- sqrt(diag(v)) range <- rbind(m -3*s, m + 3*s) } dots <- list(...) nmdots <- names(dots) if(pd == 1) out <- plot.SUNdistrUv(pobj, range, npt, main, ...) if(pd == 2) { p <- plot.SUNdistrBv(pobj, range, nlevels, levels, npt, compLabs, main, ...) out <- list(object=pobj, plot=p) } if(pd > 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.SUNdistrBv(...) 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=pobj) 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 <- marginalSUNdistr(pobj, comp=ji, drop=FALSE) out[[count]] <- localPlot(x=marg, range=range[,ji], nlevels, levels, npt=npt[ji], compNames= compNames[ji], compLabs=compLabs[ji], 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) 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.SUNdistrBv <- function(x, range, nlevels=8, levels, npt, compLabs, main, ...) {# plot BiVariate SUN distribution (hence d=2) obj <- x if(slot(obj, "class") != "SUNdistr") stop("object of wrong class") dp <- slot(obj, "dp") d <- length(dp[[1]]) if(d != 2) stop("wrong dimensions, d=2 is required") if(missing(npt)) npt <- rep(51, d) 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(dsun(X, dp=dp), n1, n2) oo <- options() options(warn=-1) compNames <- slot(obj ,"compNames") if(missing(levels)) levels <- pretty(range(pdf, finite=TRUE), nlevels)[-1] if(missing(compLabs)) compLabs <- compNames contour(x1, x2, pdf, levels=levels, labels=format(levels), main=main, xlab=compLabs[1], ylab=compLabs[2], ...) options(oo) cL <- contourLines(x1, x2, pdf, levels=levels) for(j in 1:length(cL)) cL[[j]]$level <- levels[j] return(list(x=x1, y=x2, names=compNames, density=pdf, contourLines=cL)) } plot.SUNdistrUv <- function(x, range, npt=251, main, ...) {# plot density of object "SUNdistr" when d=1 obj <- x if(slot(obj, "class") != "SUNdistr") stop("object of wrong class") dp <- slot(obj, "dp") if(length(dp[[1]]) != 1) stop("SUN distribution of wrong dimension") dots <- list(...) nmdots <- names(dots) topline <- if(obj@name == "") "" else paste("Probability density of ", obj@name, "\n", sep="") if(missing(main)) main <- paste(topline, "\nunivariate SUN distribution") mar <- if ("mar" %in% nmdots) dots$mar else NULL if (is.null(mar)) { mar <- c(4.5, 4.5, 4, 2) if (is.null(main)) mar[3L] <- 2 } omar <- par()$mar on.exit(par(omar)) par(mar=mar) x <- seq(min(range), max(range), length=npt) pdf <- as.vector(dsun(matrix(x, ncol=1), dp=dp)) xLab <- if("xlab" %in% nmdots) dots$xlab else slot(obj, "name") yLab <- if("ylab" %in% nmdots) dots$ylab else "probability density" yLim <- if("ylim" %in% nmdots) dots$ylim else c(0, max(pdf)) plot(x, pdf, type="n", xlab=xLab, ylab=yLab, ylim=yLim) lines(x, pdf, ...) abline(h=0, lty=2, col="gray50") if (!is.null(main)) { font.m <- if("font.main" %in% nmdots) dots$font.main else par("font.main") cex.m <- if("cex.main" %in% nmdots) dots$cex.main else par("cex.main") title(main, line=2, cex.main=cex.m, font.main=font.m) } invisible(list(object=obj, x=x, density=pdf)) } #============================ classes and methods ============================ setClass("SUNdistr", representation(dp="list", name="character", compNames="character", HcompNames="character"), validity=function(object){ dp <- object@dp if(length(dp) != 5) return(FALSE) if(!all(names(dp) == c("xi", "Omega", "Delta", "tau", "Gamma"))) return(FALSE) if(mode(unlist(dp)) != "numeric") return(FALSE) if(!is.character(object@name)) return(FALSE) if(length(object@name) != 1) return(FALSE) if(length(object@compNames) != length(dp[[1]])) return(FALSE) if(length(object@HcompNames) != length(dp[[4]])) return(FALSE) # numeric checks are assumed to be handled by makeSUNdistr TRUE } ) setMethod("show", "SUNdistr", function(object){ if(class(object) != "SUNdistr") stop("wrong object class") if(object@name != "") cat("Probability distribution of variable '", object@name, "'\n", sep="") dp <- slot(object, "dp") d <- length(dp[[1]]) m <- length(dp[[4]]) compNames <- slot(object, "compNames") HcompNames <- slot(object, "HcompNames") cat("This is a SUN distribution of dimension d=", d, ", involving m=", m, " hidden variables:", sep="") cat("\n\nd-component parameters (xi, Omega):\n") out <- rbind(xi=dp$xi, Omega=dp$Omega) rownames(out) <- c("xi", paste("Omega[", compNames, ",", sep="")) colnames(out) <- compNames print(out) cat("\nm-component parameters (Delta, tau, Gamma):\n") out <- rbind(dp$Delta, dp$tau, dp$Gamma) rownames(out) <- c( paste("Delta[", compNames, ",", sep=""), "tau", paste("Gamma[", HcompNames, ",", sep="")) colnames(out) <- HcompNames print(out) } ) setClass("summary.SUNdistr", representation(dp="list", name="character", compNames="character", HcompNames="character", mean="vector", var.cov="matrix", gamma1="vector", cum3="array", mardia="vector"), validity=function(object) { dp <- slot(object, "dp") if(length(dp) != 5) return(FALSE) if(mode(unlist(dp)) != "numeric") return(FALSE) d <- length(dp[[1]]) # m <- length(dp[[4]]) if(length(slot(object, "mean")) != d) return(FALSE) if(any(dim(slot(object, "var.cov")) != c(d,d))) return(FALSE) if(length(slot(object, "gamma1")) != d) return(FALSE) if(any(dim(slot(object, "cum3")) != c(d,d,d))) return(FALSE) if(length(slot(object, "mardia")) != 2) return(FALSE) TRUE } ) setMethod("show", "summary.SUNdistr", function(object){ obj <- object dp <- slot(obj, "dp") sun <- new("SUNdistr", dp=dp, name=slot(obj, "name"), compNames=slot(obj, "compNames"), HcompNames=slot(obj, "HcompNames")) show(sun) cat("\nExpected value:\n") print(slot(obj, "mean")) cat("\nVariance matrix:\n") print(slot(obj, "var.cov")) cat("\nCoefficients of marginal skewness (gamma1):\n") print(slot(obj, "gamma1")) cat("\nMardia's measures of multivariate skewness and kurtosis:\n") print(slot(obj, "mardia")) } ) setMethod("plot", signature(x="SUNdistr", y="missing"), plot.SUNdistr) setMethod("mean", signature(x="SUNdistr"), mean.SUNdistr) setMethod("vcov", signature(object="SUNdistr"), vcov.SUNdistr) setMethod("summary", signature(object="SUNdistr"), summary.SUNdistr) sn/R/sn_S4.R0000644000176200001440000003633013661501477012223 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 <- slot(object, "dp") namesV <- slot(object, "compNames") # names of the variables if(obj@name != "") cat("Probability distribution of", obj@name,"\n") cat("Skew-elliptically contoured distribution of ", length(dp[[3]]), "-dimensional family ", slot(object, "family"), "\n", sep="") #------ DP cat("\nDirect parameters (DP):\n") attr(dp[[2]], "dimnames") <- list(paste(names(dp)[2], "[", namesV, ",]", sep=""), NULL) out.dp <- rbind(dp[[1]], dp[[2]], dp[[3]]) colnames(out.dp) <- namesV rownames(out.dp) <- c(names(dp)[1], rownames(dp[[2]]), names(dp)[3]) rownames(out.dp) <- paste(" ", rownames(out.dp), sep="") print(out.dp) if(length(dp) > 3) { extra <- unlist(dp[-(1:3)]) names(extra) <- paste(" ",names(dp[-(1:3)]), sep="") for(j in 1:length(extra)) cat(names(extra)[j], "=", extra[j], "\n") } #------ OP if(FALSE) { op <- slot(object, "op") cat("\nOriginal parameters (OP):\n") attr(op[[2]], "dimnames") <- list(paste(names(op)[2], "[", namesV, ",]", sep=""), NULL) out.dp <- rbind(op[[1]], op[[2]], op[[3]]) colnames(out.op) <- namesV rownames(out.op) <- c(names(op)[1], rownames(op[[2]]), names(op)[3]) rownames(out.op) <- paste(" ", rownames(out.op), sep="") print(out.op) if(length(op) > 3){ extra <- unlist(op[-(1:3)]) names(extra) <- paste(" ",names(op[-(1:3)]), sep="") for(j in 1:length(extra)) cat(names(extra)[j], "=", extra[j], "\n") } } #------ CP cp <- slot(object, "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(names(cp)[2], "[", namesV, ",]", sep=""), NULL) out.cp <- rbind(cp[[1]], cp[[2]], cp[[3]]) colnames(out.cp) <- namesV rownames(out.cp) <- c(names(cp)[1], rownames(cp[[2]]), names(cp)[3]) rownames(out.cp) <- paste(" ", rownames(out.cp), sep="") 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 <- slot(object, "aux") out.aux <- rbind(" delta" = aux$delta, " mode" = aux$mode) #" lambda"=aux$lambda, colnames(out.aux) <- namesV 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", 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"], "(counting 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", note="character"), 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/MD50000644000176200001440000001010214150203404011165 0ustar liggesusers6077750ddc89d91ef9510b3fd559a88b *DESCRIPTION 9d8e09151c54a9e83dc1465db07d51a4 *NAMESPACE d49b77bca2e037a14bdac4d24fe23859 *NEWS 87f31a0eefacc2b7981a764b3351f665 *R/sn-funct.R 59890b14a0612cda1ad0a0886b9251af *R/sn_S4.R 8025611e9134f46d393502043e1ea4b1 *R/sun.R fce63a3a3fcaedc7dfb5abd59d49ff5f *R/zzz.R fa6396601ec6c6535c9b1b6368fea417 *build/partial.rdb 4220d3fea3c6b947892dc97c8e28dc61 *build/vignette.rds 41297d84e085d6f64207ae77aa602a6b *data/ais.rda 0eb20880278c76ca3435e599106c21d3 *data/barolo.rda bdfa050ac56c1af49490ee933f02d3db *data/frontier.rda eff10b0bbb47bd3e080175ef09d78370 *data/wines.rda 488e94d5d276677cb1b726ffdba20459 *inst/CITATION 0629445e5f3de06acbaf6e4013c7deca *inst/doc/R.css be8a746c65a096871b7650f4c006919f *inst/doc/how_to_sample.pdf 2b11e4c3e0e1a0832b3efd6814b0455b *inst/doc/how_to_sample.pdf.asis a734ce57965d06aa5ed6504ef384a27e *inst/doc/pkg-overview.html bf0571487f0d01e9af5c5d36891271d6 *inst/doc/pkg-overview.html.asis 9bb1bdb5fde275ab31727b4abf6a0f4d *inst/doc/pkg_sn-intro.pdf 5d3f468e91971ed3d8e7ce13a0656f09 *inst/doc/pkg_sn-intro.pdf.asis d9d326a5d669a21d4cc2ed4f63bc0e8c *inst/doc/selm-intervals.pdf 5361b51ac600fdd254d2e9f3bd6429bf *man/Qpenalty.Rd 463c59c535655b21a331ee051341b848 *man/SECdistrMv-class.Rd 28b11b85dd96bdff30a83d9e0e02b4d0 *man/SECdistrUv-class.Rd 0c39aa16a2ef13e3ad341a93aa753ba7 *man/SUNdistr-base.Rd ddd6076bd0822ef6fa6bf09021d6f1df *man/SUNdistr-class.Rd 32376703096682fdb83f8b8bbc9b3607 *man/SUNdistr-op.Rd 8970a8d62fbf1fe02d744d627f3c092a *man/T.Owen.Rd 375419f609caa2db6017d54d4e66f2e3 *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 382a5a2e5ac5cdc8e4a7bbb846a17a9f *man/convertCSN2SUNpar.Rd 2c17bed1c33a3986e8975d1bede73b7a *man/convertSN2SUNdistr.Rd f81e2e68742afc2466323c9dd796fdf5 *man/dmsn.Rd 1b8c96e6c8de8122ebedbacc2bb9dff9 *man/dmst.Rd 4a91699f231ece7e61ad251ce11a277a *man/dp2cp.Rd 383f5b2e2f8c8bc78646c26cd047f42b *man/dsc.Rd 56357c5fe96cc54522d969dd20e1663c *man/dsn.Rd 955d331705447f711f16a98f32f754f9 *man/dst.Rd 1d22732a88a116f43d642f678d9e8270 *man/extractSECdistr.Rd 278591a357fb0b7bfaf281557eb36ae5 *man/fournum.Rd 8e9b88045386ec0467941a81e1e43a50 *man/frontier.Rd d48052f6e1ba7e2d11ae6a8ee53b91a1 *man/galton_moors2alpha_nu.Rd c00453b3453010a35592338b44a189ed *man/makeSECdistr.Rd 3a8df06dafb8cbed76a7c4459c1abb39 *man/makeSUNdistr.Rd 0712ef8b01523502cd7d5b83efab3489 *man/matrix-op.Rd 6aebeb7c7478d128781d1a49b944311c *man/modeSECdistr.Rd f1288c20ced62c0cdffe23706d91f237 *man/overview-sn.Rd 58f03da64127b119ccf056451c9bbe6a *man/plot.SECdistr.Rd 2db26cc29a967e52b477af60a9775e93 *man/plot.SUNdistr-method.Rd d0947a9c741acd3ec2616b7414ccb31c *man/plot.selm.Rd a7abf1a1aab537bb40e2d491409317ca *man/pprodt2.Rd cbfc94c36e7e1393b566e2bcf7a9e37a *man/predict.selm.Rd 2bf129d8042243e28179801bda32897c *man/profile.selm.Rd 792d26be992fcae3d65ad6d680551383 *man/residuals.selm.Rd cc3dc14383601c9fa0bf8d1196ed8049 *man/sd.Rd e5ebae18ba50e5358fc2a9ae857c9ad9 *man/selm-class.Rd 52c628a3efc40f908ff450472040237e *man/selm.Rd c51d853fd877ea693c0fa4978429cd3e *man/selm.fit.Rd 669280d0faa4e52de979f7af3ed2c0e3 *man/sn-package.Rd 076f880a91b013ab11e03d60c8287ef8 *man/sn-st.cumulants.Rd 75e35fa20488e666fdc608f36624fcbe *man/sn-st.info.Rd 94a0965fe4fdc18f43e940db35ea3b22 *man/st.prelimFit.Rd ac9e41daa309fce5cf5fc2f3f389880a *man/summary.SECdistr-class.Rd d158ef07ab30d3c03698eff12f4ca431 *man/summary.SECdistr.Rd 8d59ddc439d6455957e79fc5612fb114 *man/summary.SUNdistr-class.Rd 77403442e103fee02805d8d5b12872d0 *man/summary.SUNdistr.Rd dd09948e59e1eea5cd04478ba8e2a49e *man/summary.selm.Rd 0062d1648a0dbd041973521fb86bdd51 *man/symm-modulated-distr.Rd c9013b421d93931e4ee5b7d1100e6d4b *man/wines.Rd a16f815018d5565f4fa7798ad2f47b48 *man/zeta.Rd 2b11e4c3e0e1a0832b3efd6814b0455b *vignettes/how_to_sample.pdf.asis bf0571487f0d01e9af5c5d36891271d6 *vignettes/pkg-overview.html.asis 5d3f468e91971ed3d8e7ce13a0656f09 *vignettes/pkg_sn-intro.pdf.asis sn/inst/0000755000176200001440000000000014150121606011643 5ustar liggesuserssn/inst/doc/0000755000176200001440000000000014150121606012410 5ustar liggesuserssn/inst/doc/pkg_sn-intro.pdf0000644000176200001440000163607614150121605015537 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4502 /Filter /FlateDecode /N 90 /First 751 >> stream x\[w۶~?!jE~qu&NliwWhʢHN~){)bYNv{Eq`83|AD+Q1&LRC $K8,$dR@N0Ax !A#!7Dp X"#BZC8pD8 D9sA DH+-Hg5tJUD1;b(!FrH 0ϩS)QB(!qaf8 #D$#R̃䄂zER'f`YXf+h2(D?5 (- aLz@)u2@; 8<\8 JT hdPԦQ~5j}x<&@ xc dALA1@Yi#A뚬 ll׌kYc72weX Exd-,pZ6Y)o9Srʣ gB S8- SvS|OI!VEdPlP~Ⱦ'/"{yVd/s)gTp P)e(}д.^e'䪨GiSgUM^"ې9(<>~~<U]EM\@yNz v'F%G9" b"a#gFכ,8LXT0R>Sg|t1 Z.)iqp>u@-T SM #lLЍ؝]V"XdR:# mc24-g'p 6P^<-Á9H&b[A- fSXQ^~\ٳr\NA90ߏHF%0;|:Hl@zɯkx 4 ςj&yQK1jĜZjo- ; W:O&1v6zDMGypIcQQQDřhs Xa-)¬ZP*5 *ڍaeL+Deoʩ]*:DGu췕޳#)EMGR*VR$DRFFqXBP / J, o*(iW7hRA*< T+vsӴ#;-E[%==gc@ӓ^M7p߇y""+ϳbKM4FP9S;Lz{H)̠kD++D~AJw=x &t4vn5 򇢟=6w#a1vv˞F|Q#"kU7=14JHIU <y6ʦ{2@rf8ŷa $ϵ7%5v~W JqWYc؇>? zJHu,yp A^<5ݪBp.~ʋd!LQ,8Z8Ӵwqڂ#ĖK` ! #I|6v[: 3޵4zm6XM6Uyp_q .mւvڛ1vd{|̛o Z m-׭+nr~# qk.B L:\ ߀JƒHe)&.tSDkE4S׌7Vjg} f1f׵n evo9;r ˬ`=\n8WZ7+~ۼ>U}m繙-ZD6!Z}cUm}e>qN1<#TP` zFIvQr41 {Oҹm5gγt/1}✷/Mq8~fPs܌yV7vϺ5EB|b1uZ_" !OGG [acqf}t8(Kڢx6|qNЃ;ҙ\XA8O(ZǶaQixXZ2  $&Tz0qLsǎƆ'=tH]y@ hҫ!i$\yq =jy&l a̻bt6W`Gl6b mЭXKZ>ba#nisOSNLkT'8 ;8zULl󛽟Öݔ-1{1pcnSƘq 4q]W9p;k\01c͊zMYR$cZ3S*4sv1Ws.*{ 곫O02lR1;nK WNdud{p`qO?/'e?EVzNؼu݃~6AA3_ \#CWuZNՀLg7~Aӳ-KŃ0اS<!Dnx Avt ]za˜׋̇ )ѓVީ'yv*0430Oŷp [K> 2Xʂzh :Fw}I?"[j+lo(sS=dӆ;78eQ:G\=b ǓG#IxkT;izuu\9^Vhs=B޷yB@>{_Nw4wlX.TWyoRON+ot;0CY͕ bqgYcLeɣ 2(206' 2UoDi&l==?B70y(/jl2x$ F!߱'m`#+߂ 'c15%͵1^s|qhN9õjE[?Bb`s׊Ȧ7kGdswn4.t{q kB-!&VnNJL,fxm&7<&u&ߴ&sod#E?ٷ'7{7/dB'I$<% ˪|ýb8!ο4-pO>_mH|V?ēdr7Nٱ/oVendstream endobj 92 0 obj << /Subtype /XML /Type /Metadata /Length 1636 >> stream GPL Ghostscript 9.50 2021-03-24T14:15:55+01:00 2021-03-24T14:15:55+01:00 LaTeX with Beamer class An introduction to the R package snAdelchi Azzalini, Università di Padova, Italia endstream endobj 93 0 obj << /Type /ObjStm /Length 2961 /Filter /FlateDecode /N 90 /First 809 >> stream xnH}w;`q ?0ms#I%|T5$v66>Y]]w)'"L@s¬"% ҇'H(QZP bܸ$u|K[I|1V@*C h/3`0Xgpc&7Ș!+[}"| =p"q"*ý5HgR 7pX,V x@"| 3DaJB%NV,nLX9BsD T,!jaH5I)xR1*,1*\ @e'. #VJܟŻRpcEC 緁_Y Bo&C͠gb i/N;xHt HeS_Y4te`5fFH2$ 08UI=kc|,Dqt(>Y XP}$4,(KoNO>caaz  8ޣe2+4y:"З?~L9|=ذ',GX8'X5gHi6g,}g>vGyֺB e8b'a7-sPzFuk5V*(bo!Rz8hbvs l8'JA}ï,;4 >v{`*L/zNU =Y -PnTT Aw(yւHE%$J,UUȵFZi]\"J[dˈ`HVz` $A(M bޣtr(2̀F,4svuVЎ@q#,o }ϋKgg Y+- m30[]oiʰ 3їP'H `s0\~[plw%0 $Vql$7,iu/EAx,/. t F}I4΀x_]tN#zNeF/(1/L&4:̢de-C:tN,S דќU\/h-K~7m>`XӣExY^~4t5`ixs+Ut =/EifZ|V|G=O}J p+zJ'__ }Gka>Y͖We1gOhYVV?GE r`ȹn4 4-+dkTrŐQ;N$S2z 1S3b/QʪO4 K a~22dӿ, S* /T_> u|@ˣmr[֨P=_>.-{HJzVNAKJ<^uD C2g¿[e[]yȊ P|7GYOY=ll+wh47bzOl5_y?-Hr F} 2gmǽRz$^}K']aH9d1J])t] 1Ə + rۏu66@[ w*Gmpl}0n~l ܅pleH~9sh*\<M0P{&gNkU ]Nqu}"8\|/IҢ$P e{`Lt{AO0|^07c̸<]rY]FiI[fxS0}[ܥpy%]2n)[%.ț9F9ts-,YR 0X3suKcݲ.XOa<:f;:ЦaKwu};v*YsZeYTSuGoz?&Zu? JȐKrpNfQNz6LBOn","lxe ]a%G7Rix!y^2>'EQ/,Ku)||dJCr^{#mL, ܪv@A+ ߎxl W׎03]#X[*[qu(p>8|+q! V&:ll[ݗ)y{]YK;浪+|wϳFxίxnkܨjD$7@#MiR AOjx Dy%2je[v0"jBc7 8Bl1k ͌3ZY kȎ8qMqbtl QtgUUV:Fa?(QRFQbx(V?jG=~0|{ r /͉ۆ ڛqDmq #:f %n̄g`OK\i㮿/1nޭs|#/W_x~;S31Ui}/==#pd`t2Uz]VB@endstream endobj 184 0 obj << /Type /ObjStm /Length 2559 /Filter /FlateDecode /N 90 /First 820 >> stream xZ[s8~_ݢU55U!$l: P<8'n,NMVMH5lI"3,e"LOǴxf:zzd£J3V6F(h&7PUPpL* z>cJGAu2@^47)a0UL)!PLikFe9 `Ne``@GLyP |FLIeB@ 4`6ĦL;C qȘI-(Pwp`% 4 T(X1Aƒkcij ʙƠAR&Ƭ$?Ŭ%*ͬR),sBQwǜ=cNk0c:et%$ ĘVy@BΓ0aYJA"Sq(>L[=<$MʼyAj^ӼdмBe4ւ8n,)aPHEKI% TCRP)Xl,И0+N3OZdI,`RD%d*cC*wC8tNA1Y􅹡~G؟Mk{p`p4z {촜3L~Y݋NPC|\W >#Ɵ屑oI`N9{K&_geدYWEy~VȨ3~Ɖaj'A@G O>4|7k헓B7ӤWˢ/u>);I!0@ HcEqVK[0EۨbzCAߎ}~8D쾲?8(&U54PLWӮPˍ|780C,-"E_燂!-_Z٪1??gG|\UgYT+G똮ƴɈI<ш6۰Rݳ^?F@8zmWv :ҴlmV`C 1}lc +lf6Ԫm*J>Z)')<?}ᎎ]W=ao-Vnk|Rt$h`GBysJ&(Nc@qe: [ڶ)9YdmMlF-e`G6t:C8SgԳ AsF.ݭfW2SI,K`4em4Wd%ksĖq1gl2FLB"Z}.BJE˼jE5E>L\ȣ<8&%"\Z3y$Kj:G{o`<%m"-=5 Tjom o= ȭZͬuMkzdD㜾 b 6UE' 6H,~tHY+QU9pz=PãbL ]DPoMم-_V6-/ȗ>12&OXJ Θ8k}y;kHZ;e*!XCYSZ%X15΅.'ka{NiƧ;YםV8+X ~aGi}iŰuݑbs_9 FioR/1Qb T.>7DcN{1Q՘u'&6HnU֘xUISi 1X^`ZZ3#PQD&)ih}%b%&JqJIӴ -;O^}thcُ< LݶYܢ}Z.~=l\/>n}\:Tau>4۷?Jۓ&[ձ\ ,T+[t v*s@#&С\]7zqSnVRGзm]n o^%)o0aK}15.5n5}Zs!갴fiIm5,u _eCڢY ` PDk"5jAF? (kWVpa߷B^j o&vʽoa(f/w|[(EdڲM-on޺C~ϻSXG%G|?{?K>@|\u99- ?gu[1// ՞&Ep[ /ŗbKOÉ119\.k~$(#$yy9e|FAbֻs@L5l+F54Bs.awH6&s,M3ꁔNR;ya= 54 0n.wS鞧Y@K|lZ Vۚ wWZsGbA;cxFHl#$vi|ƛNON =-=ށٵ:?)yClVtߺ5doCV<;+ҁfkX4S-endstream endobj 275 0 obj << /Type /ObjStm /Length 2267 /Filter /FlateDecode /N 90 /First 807 >> stream xZ[o~?bA} bN|IZ䁑8RT.,/")f=@A^gggfJyS30L T"z"N3^Y *LjM-I3$L`Q`STH `V ~ SQ3O@q`"1'i:115PE9jJ[ aثh3ioh:@4P fD%D$fk !YҠ@ӥE֒GkI6` VZ $T*2ļ2ZH [a LA;s?Z,sh˜#:Z1*mNCX^yPTGA*(@zJ؀Ojmo`QPưica, %AYD$,iE !i+X0ЩA̲ (8l ÖGV'A0;%DlI')U;RHhCJ=jGf$,Bw1~Aق￯[eX5QEu L0Lkɦ_Ӊ XXicam߬a޼Ų\Ѥv:O_?yo?^.lYru2(D4I`ʫF0ivMilf妘ekF,/bJgY8⇏iYt"iZYQ54+?}xcI+O/|q! >2"q~R{ev?{ge>K?Kbr~&eMR2-p*fYeA2zփH|y[F~+0W2?//Tt7Hh ̟~㚏6kҲWCkTj]Om"]3v>imw=#88]M#mgOy*<tw|ίf|W|E8ޕU k&#%// K8)8d^tt}쳄My3>YYzfW?<=X\3LOVm!OWjX:VhYgE}"E57$i-1ouvޡvj]g֙F4[giFFwϙSL>ʙS>֙P2 t蝹Fk @' GAz+ЮFZ1`:qg(XKtQP oCA(x@ @A'c61k 5jU?u4{0Q1&ju1Q&$oV.bӴ,rJ|4"PՆHImW')y1qM=M?xk/Ń:6lN0a.R sb,T6ot Vg-~1Aw yK&iܔ!8Ou{s_{tB NzUo 9#/t3JWdW6[U.IEiCgnc+_?8Y7M <og2N3`]TV}:_me*8y<U4:׀|%4]]X,I/!z=DrJÀU"sS񢹮%&75/s%8s{],mOo9wÏ7MM[aDϬduFuo]DiM\Ev7oj{yS;̛ڱyS;>o?~W_0jxk{iGkcE;t6qUuo |T~mfY*c&r1~2'/^Hz C[s8٘~gK)mWZk-U"Q+ϳozʧJ~G4߹͍'o>ՄFBCtПS|+qݢZ*P?ء6H54MT ݦY O;ց#[FN+:'@e/v$/7ɫo d @8RxyC0.+(EH_v"p'g_P<%ʽ~!zX2dewr1Y' endstream endobj 366 0 obj << /Type /ObjStm /Length 1331 /Filter /FlateDecode /N 90 /First 794 >> stream xn7yyg ;6AH!ˀdˎ6VrÂ$g8;]JB$$bA)y8GBm%2P#E(`3q`M+8L0 :؛rR!xfR lB9Xl`ɱϙ9 ,ّSqେd !z.x*ĴdZ\FPpfeMZo^ `Lˮn" ڰS.Tlr K%r ,Y``aJҗMW6h?>i;Qån./pfc. H-@cOn\~\,צ)n}ʮ36s$> stream xYmoG_Aݝ}E9Q@>皸5v8UIHϐP33;c2ʇ GuxZE6 de *g2>eYY|"r*9kQ9c䢜 1ȑ #y.X+&"I0۰dl$ ƀyqc!ExW,r``@NM(/, L3{50ğ$XE`ac" {Dp= Y6pl5xI,± ^[Y a bX(-=COY(V. qN$a`0 2' }5x\-ZN?^˚0V>LP Wgl7Yb?*-I3ԝzޢ9<()A>䫢oX5}e5%YͨY\d7 [b ͝7w5oClԓ3xXGLJ Vʩh2;"  DfPOkq/ FG [A1y.-mңy}TՂÌk9-H}X%BR| 6D6QG} oVlt2A!l|fbj.FpPTˤu{پ!+hNqf&Yΐuo)iN䌘E00.?\|b(H$GZ&KQ2E*%%]DC2.-|'Cp-ByQvu nEy*EwNVt#vPDoDR؂Kh`KQgVO=BH߁lN+ɝH.~'~{ېtf@ 8Ϫ䯭wQvv-em$[Ez<,n5A gqN:G~P(:$Seskȝ^H1˭pN={Qλ@2AN/GJAnq}9_ l4EEU^k. M+j9oqVz^q$ݯ*\+f^% *Ϭ̺ަZ EU`Pih.q!Bfekv\fE#ΎCeǥH>X՜]>Ss:N_YS0+٩秏gmt $|VMFX ݻbW *̧zt4*#~9k~Na%mXy *\_xG._~řsxNͺK*FѢiW_<Mf ^LfgIhvNF5{@Eדf^K/Z|:jY\~ܝL+R;dѻ=iFxZad `x.p]VX#K_R|X酢T/0Go+]ثYoSF S%(endstream endobj 545 0 obj << /Filter /FlateDecode /Length 625 >> stream xTn0+xa/ry-Pi 8/u]JDG)(gg>; BPÌ0mw=ԁV}sm" _ yݴlwæFPrNns׍iHmvwGo3@#pk0eU+*Bsqcb| QO}|gIH~?&at}VZz򇗛 "H {R! CY={2;xS(%PC JPqI1WČM{tvD̡6 T9Gy?eG$P4gG:ӊV;_?ɜg:ϞLdּ҈SDt򖂎 kAM[brl_[ ew"@ vE8H̅Z`E<0&i IsOY(1h>i#rg]2^$ƿ4nBmt&@! 瓀 M@U 9N",/@_V R˪AKZ5^ls4֘0raxNœTAi1fCګwNX>SAYX?~w@b;endstream endobj 546 0 obj << /Filter /FlateDecode /Length 655 >> stream xTn1 +tVDk@OMcI\u ?~)zsHa+ J˝ lޚvs4`7B#{L6>f{x2fQ \a;v}E${\\I[|R&ozk?jmK)ٮMX)9{dW[-vحK=hzR 3$]T4%$7?VǕBЇqŗ&]Rm9'reTqtb+ ~/ɧ};<[G*X> stream xUMo0 W>aN`u5EdǖhDxƗ؁y D Q4&s0*Zyl*s,`_vE]`A] |TK.z0f}W+UA lC4d)Lݭ #{Z'&J1!C#ͺ*vcтyoYwGÔ]yH>|> j~nsv^Ucsr!u(^xS$H C\Hz2QiŻ I s dͷQNpD(k"8V-'$#VRz|\]fþ:]YZ5~m.Kƌ6 3OH=Ne 5ΩcQCA/ղFxɜIԀEh̨UdU4 ۛj HbeSD26g.>)oN$s+Nhy \vy7yWendstream endobj 548 0 obj << /Filter /FlateDecode /Length 630 >> stream xUMo0 W>뀡N`u6k3 K|lǑ])bv6xzkݘ QF,͓٩ j+lg&a>=/4@~XUdR]=>5S 9{ɮ曻] rd^,&Qa*̐vQє(1>w2wk䜢{yXVW;/%:'qs%$!w?u,PC*HuHIbě " l"b|`!qA+1i_) oE4!k!j8!I1(:EFw-ynޘ5mendstream endobj 549 0 obj << /Filter /FlateDecode /Length 610 >> stream xTn1 +xQ$Rk@OMcƵ]u?~)zS) 뿫G`k*D f fcBVF!H Eh/)F'>צHu$.a1ÁR8dJP5 p'I+]{j Wj"Zz)miԪqF2ª1VvF1[_c~ z,5 Id%:<"ui\R:DY$ѯj$9"5 jƌD+P0'L؛13 =2ZN{S*WK+7ILӄ>&RYdѷhoҢOZYendstream endobj 550 0 obj << /Filter /FlateDecode /Length 1437 >> stream xW˒[5Xh\/Z;BQl ,=%]_ݱ'łTYji^*#v naBD\.[!]eKYwu^z8|a-U,+rA_-gV e\o곥S67SLɲ]\DC?~(k{}wP'oOwWu?e$E2oɽi_YZbppS@8گN^fDzGT%n'1]_ڇ&:eӭmӺwi(KF]J><~׷;nNx3&74aF9Q]4c4I[rs:<̮&endstream endobj 551 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2731 >> stream x}VyT!p8euB}Zں*E>\ Ԋh|"T.u)(^J+;vRm;93z2{I܌ IR%̜;sčs4qaDbERKMdcǢ4ڼiT Zf{:h+2#a5@` -K?N#ly-.$_E@"<"q.Me޼+իYy҇vjՈvd$&3>(.Ϭ@t ׁlN+ϡ.%`> K*EzDdhQ[ɋ{ߺt 񧃐Fm *quYL+W΢R@Jp0#比X^xȀޘs곍bqi=P@ B9p0kwğ>~o /P_1tQP>Rfy~uH *"JeS (x],/j#5$ba4H%enR!z3_8UsX\,Pf>^5sD>1+a3L/(WOBuyh*L II+W> [Or>E0♚u`6NP#/sy_>xQi6U"?ΓNc EEEffSP )#oj0l*==N V$f]7rGsg!kamfQmpߞ/`uZ}6k*UjuRjG%*/~=6fF mEë_@yԅE= Ƴc[VԟIt~@-z9 HB7I!)h^,½A37^xiQ*(%D7wQL[ʐQmL'nD͵Kd'p7upgYQhUFL[joѴy z^;-GF *7n*Z_8 ݤoQy*iI6OWVݲ#< a'42 ^/èL/7|@+S_urVrM?\-?^ 3`&RFqk<*$0}[,u?ВodX4>x+3x&x׻ƟQU<-NLqH#ێ#-2 yyu/C~@).%tvQ'wgBU1RUf<a>p<~g4/f\yb -CW?yCg0ƢZ}^GRꤊ8VԮVkT$rU=!Ϸ&^i "P`aXB]~Bw>sAw]u HpG&0< `aQ`751`fkVXkPӯk& ^όՆt6<Ճڅp)BtLAii??K#@ @mb*/9ۇ7̛:s/$ S,%cUǪ/hkJۏ5vrFzB--xNVU(VSHQ(+m+r3oj'6vp@[@'w9ulEdCDO*%,Z[^M.L5,Rf|&M=~WS|lSހ\\T) \/xs="Vf_/O΍'|pe v {0ɹa3a:s\2bb/sUEOswv8hG Sւ̈]1_Ҁ\W/Y컿#XuJ)!=ʬN. { bm c'=ǣBBӥİ V|0s`/:ӗ([+؞n;+&?`}_ ZO,v1ϣut{>MUOx͗d)31o$4s瞓vqMR/.}!97(c'OE(J'5 vBlO:+ endstream endobj 552 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 503 >> stream xcd`ab`dd v 100q~H3a]cOoVY~'U;WVNinn?+~."(土[PZZZRYZ^ Aa```.d`bd;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<Pendstream endobj 553 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4057 >> stream xWyTS׺?!#*"i*8$>kVbAD&G  3 v$̣UT@ `E"uFlV~I7sWzw[;+ke콿oڊp8#ܽfΙ31<<aIM"Ƹ,ژXr-E+'Gl V΄]a1!Q=!Qᓽ319E7zyLd[\}AkBֆznN]޻ gf/?>")Z=“XGxz#‡%6.J|Fl$7b:N 3 b6C" b 1#Fp& >1NbaCa.rsgV\jZkuoup-҉iKZGqfM FF֍:*yԟG_[[lm`._EE_VRQ ; %3fTxPBvc^'^9>kL/8yV pC*6">3^/D<]۳zoYB-=U*=t-CI$dt.#<&!S-2ɕJl?tJ%HtX b.M|Y\Rǰa52lCffuU%E4x&h]Ie+TH8 l1Y;#a?mq,> D"'/UAӖȑL#glvdH0,̶fؿp<*xO)2ҵ L w @h~>cCt0 ̾ s9jɸ2vl[Ci_;ygUJ'xV)/8.q_ Sia񡲝hL<Ƞ4( *mO> JdNꢣ,}&FBM!s&Yya2g\LDi-..Gx`G3ZxR+!\D#dX`$SrQ.}0Д)ә4Y*]hh<WχVRsCAM3%7Q?? Y=Íh:;K>\&q oj?t1 V\#i 8A ҘaDyl l0U2UN;\)ʠYyS+Utً:2 H=֘LkߊeUrjvgʴ`(kقhOvT~N@ P)R$(ˏ/ ld@j }xǤS>.zhLQy Z!3M$#RV/Wtn2ks+VGݎ _O^U)0 u#2ttuS+>W˻Nb?- %R ShՖmBBP0S8߾s!рSP)~r+pa ؍6Nehm&.M%KI=!EQorT~bC3ߵr>~OP+ J-7,+ߞE ,؀'3܉}tE.Kt gelo1^f8l{(MEoxH:Y J@J:QBYcݡraQtU]L窬elnne on vz;Ey}87t,}MX!-O(w ֩ʒt9_Lź.p/bXqY[8@)} 5d4r,6oa>9800cxK능`,ohb-C#E X```n5Jn f G BQ#Zendstream endobj 554 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2115 >> stream x}Px](.͘Qkҩ/iVh$m_$"wǽww&(GѨ5RmF3Mbm's6t!Q̾<~~q{U4jJυސ|6?~FZCgPv3^« UL s^wEV1/t1A}8km*cҮq89}hÇ-F[g?{͕N:x3ki?1OU(& ~8KVچ& ƷqnR׳*Ϩ<;Fy8#7J(`N@G'Cn&0݁FTplj)_֜u|Z֙׬&2PAX|9(֫;G~1s)rnv{n59دmV{dk8NpjzM-+uX}蘆gЯm< -䲩5%6RҔr>TZnh~Mز}gCKGt@§Eܶ)3girt8*;BQ=r|c-#&ڣkw:d-Pku)CWs]};Юmbl66Fp!ٵ I> =ĿGfq0*T^c+_)A.mdj ظXaS5,B]+8c˪MJ_Ǡkx0j^%.SՠiZa nng2nG}H^Hkl~fl%fM}ZAQ&3(?wsO/m%|'^_fjAKslGǵ .MCҏ_ o_K/VvTl$Xhto 6t1{ Ejj*_QqHf@ VSZNm SGUmv[AK*< PRJHk!үoVւZ-BH#!j1{?_'OV/fIw=Ȯ>P7zzo4-I<w"y#)?@ݔendstream endobj 555 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1629 >> stream xP߽v7eGZtfjcTôhPQ$ E;8h`̩Т ?^iICKdG3ٝwޝ>_ (EQh7h_^{X')%4&[g3Kт'EKOc%l]?]HAQA/&K}`Zβ=i9˴)˴i9{!^{PJjmt=hhEopv EM( mEAYp";Cū Qq^CcS*Feyeڰ +Lѻy' i@(XYk2WNԌBx{LiKZ}Vo5SgWUYAWCAW|:\i2™TaL B&Dn& AM1Ƞ2`jt2OI7Ĺi? uC!;\73^,4lq1Glnc'ſ&6*- G2TtP %dA0a8n x|_? D ن/?U/' E۹'<2 Qn7nsi9 F+W11@3b{l^zJv$4۫=^}]YZKͥ9ÖN/"垠asO[w;mNk3na{k# Qq>/Kra&ivbnnw_7,7.y-me끻Z1.QwWJLOyT[n1dӃoHcv'.i0ʵJ|[7k4~HJYyo7&>$ˆAB&qp{ݏ#ˆ$xd ,4߽:7YC~n&(۠d1E;*w|srdU8}uמ𖜜$3< G#6 Xs̪C1vʫ'/q yD4NC^X8e):%ݔ$:H}NƂ.C?x`2 +E;@gqj |/ t]3{xendstream endobj 556 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4672 >> stream xXyTS?1䜃Bީ:UڪT*JAeTPfB L_00"bAZU(tj[=zzZ99|o~;bp,]7.?(d h@{Zj+Ѹ̢h,8:9`g l&89kD9,po)~x5ak׭+o~!n;O;|/X~zߛ5 [i 1F fI! b I%uzb1p$ ;‰p&6fb1XB$ +b&l>1[ Kb4MA*ι9~TѨ7f bEEo ),0^I[r-}FIc΍{lq*ǻ6ʘB+ bQ |yPNV=Ļ*^7QV&+K7o? d(KUr c|7y4qU``UyUWأᄮ.W$c#P6Ήg04i_;?8Z6&QguB*J4'ǣg;t7=Hs%8z]y n&83o`ŏ/)Qؾ@@{m,D诳ZO>SwL!ƆJg_2 mE4 K\:Ƀo!bJĆyKfαPɅd?0%8 $X @"¶B<#FrRAM_$MBN:GĶ~mDK"Sl,e ۇvE:NWv \>ROě]ܸW$2di(g*bU tuBC.,0MaWtn٘b}E[K!:xkuD|u*O]sq $Wgᴏ!}6WbLSf8|)ȇf [ Ŗ-]bNW ݺB;^+,C G0:فH?7qj¦v8= IP/|UDU{U0¶bqݡ?/ ER(0(#`=y^i:ˡV~:rwn)vep̼m]kS+v.Qbcg MőIAhO"M]SMb.<27i(NB@ȲjY5;I08(?E~agNSϦiIf^dRE*S#BRTJ9r2+Q#e"_g.to8z ^7q ] c%N"ÜdL.6]]pA}9::Dީ{ӕ qV6exDm^~Fm,ˮ>YŪ9,b~y W_4QRs!RIhPhphPX'|. ̄0oe518C(o)m,1f1fƃ[n@0& urMlkwydLŖ[~HrXD0TĜr бUSp KjHV)i*J)H]Q."WOV&/U)KQ/:ܣmRp/۠3dC!.Z($HClz Y@Wg irwpj;y2TI$5D7cH;}`Ow?}QezdPe蕚2TF5&,O,s36w`>X]:_YȽs ߰e_ro>yq)#!Cy?AL8.u6i֯WvD/_R7Ht'ׅ||+nD) s]@F_Js)lnhiGmEь/DMӯ78M\x5qFWFa/O V"m nxc )[zmJYċbkL8"B¤תbu\ vg S'C] 2&F5a_!g+Nw*TMPN.G[\$呈=adg+=vNx>l4P( ΥFoc-y|:]/AǼ́]EC3c0ph[p|V6gTplX !L1xTA Pɑ*e3s˓kOTǓ$GaVҼy|&U Rrӳbr͇BsEZEɑ,1^.KR$EabV0yyJ LG}e;yG.H>8F}u'gE21,GofC{l?55 >xP fP_xtT:^n&u)Oí A?*f%kٕv_?@h. o!?׿c"lu.Qޥ,7G"Ǵ!kxQFF%ץL?caxGCz3myje%&ea:5{S;>EKBB~<'CȬ;*P2S vꑿ¶;=t*cVOG9LG_gdYfn.dus Uf$1CS1~ DTfu)ǒ MF`Rv2T E,hrtYY55ʊ h(^`?3śXF^esh$t={Nfŋ\J(żg~rbNQ6s:F8_;4u} rr%oqPۍ5 mFn!,rTs٥6|xu%ڑLDZBw\7eħǫ$o9,= C}{dmyi3UMV5;^A#ϝPVZzxnCE\8ZV7m^?0'^R ed_êS6$TSJkHm.Bɺ~܂bg$ 86IHHK; +Bck^L/`9 6ܣ<a1f]-A\fi@TDKõ8i8iPKfUaM n5?>1˘__^X _R*LCA悈%?*7| 7ͬ|,y@G )Q 4SaXwFíg7rڲZs4L^x@m堈a&3.@Mv% exܜHӝ.T4*È'iLs !X3Dw7;ϴ_QxdddDĊt;M)rK'ukzxˮ| dfzRɕ(4麌,y^> e$p o3e+ e%5~j9o|@&Sal j ɊzYﵨfD0Z'ch-?p$4לviK#LXT:iB e.]8޽uJhB!cxh4iRc*!x>C+3M|,H:dLԘT }'VahIJv\z=,B0^Գ&b*5$ͧ^>?F8rendstream endobj 557 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4177 >> stream xW TSW!ޫ"(1bk[m Y@*N(UD0! IIt:+b,O8}Uow]+sá(3(/(hԹ=c+// -8ݴq+r"ڱapt8,va9wĄq+vŌ ?.(<.:_P5s~. $&o[2?" 2jUt՟9ySޙ1}o)?@NRoP j"ZC}LMR먏/5 PԻ5ZDMSKRj&E-VP+)j'5rܨR,5B"P UJrr8;%9U:]wswpp{y3BxzbB`Y6zP`CVIs"w9rch&q\]9sKp36|XGsͤ\wʷRIUI}؝[GtzӌtO-3"&M_ItQ\_:Wmˏ:fZiY- `rv+%x/ްgebo(3|mFe#+s!þM2>\4䤧QyeNopS<_qX#!rg3慾9aκddakK k(AJ$#%k[F x <f} ee2]ՕF2f3@\plrxE0OF*e$2+ʱ@ ޵~ns4ˤ3$*?u'.k%o  >؈UD5;{gfS F!"\m#ܛ4b^޾eKaa.ט=Eu.EXyobF-dl6cx[ZAy}зX|}ӍgCY=Ļj[&)t]WoU YVGo $9!3k+e. rqTUxOԜTJM@q&9rv=Ӂe=vT2)LQrcCզ73z-Ģie@>uյ;_w3Ŝ'_m̟ߍFkgO>m5'GћT@ f,>3bNEpoƠKl]Fm_4>fnp។]a2}K8շ9rc$K׳4xx4pc,,t|[`!gFVJ ]!CqÎaW}:J CzM>p:Og-ji]hQXQS=R5d_#*iD#0p`=bWp<g׏{?C]ɓ"v=-A 4cmjhT(+.8s4e_9mbv/-5Ah ż?܀K_Z|Q ސ"d IZ^YmA88ayd#aNWؿBG*R+ Hj+T1Q;#Siw ^~OVRj0Y8䠨~r3PQ[B>.C+:*Tpm}cl_0ǣ[`ooGI@Rp3q3ڢZ49J1f/O >p%RGX""NJRd RUҴDw[Q4}Mg[`f^BK]BQڲLNPVh,JK쯛$ %7CT>vl_)w:FT.+ee2Nk@9 R  :uX0PCEBY8r؇^fN rl5xv .^ @s&Ide?Ad&c齇b|9}bRdP@+sf, !wHkE6<}؟}πg!Ej8-zΡA/YX9 lޱyw DoٛSÂF-Y׷qhy71l< GљyHYRK_]X}_Y:JjsÅ_B8(5aoyS.ՔAkz}"02\N}L_-#b ų둢tDBNj2Mkrfȴrwp~و4cgpQg;S_-/1KQx %&p >.CvA`.ۙ2a\$Qi҈ Zܡ̣ +Lim^GUxVJʹSτ|yBoU_2-,744%4r"Y%Fb4;Pmeh3X|S2:2%RJd2qoG9(`6Edž|"6ㅪx$aԝ:^Eдգ=:e;$:$ʁ]}~%`zs#b2F̹νݟ `rM7wp,C&o;4^7iKIg8`nD1]z =>fZ#̨Vv[}Ƙ-85? Yᬘ`%jXBf#61A3ٜU& yHTdl!ưPS l.ؗO K FBTȖ+*RdZvh> 1 ^kuHzi4mCUhf,lf6&W $if\$#^}xG0g>0ɓ#iC1@scc~M[כ=w Uk>P\󍑫o +bjv%U,v&z1~! ޟfIQQ2b RgUl) ^kŠzQz~!=m卶1Z)T Uǔ]"V\Z{ ޏozHT$K0뇙EQ")k+\ pNs~Eio=aH,8=c:eoz,)IN ƅndK3Mu;|`*/P0d,-1k$##U> /Subtype /Form /Type /XObject /Length 8 >> stream xendstream endobj 559 0 obj << /BBox [ 0 0 144 120 ] /Filter /FlateDecode /FormType 1 /Matrix [ 1 0 0 1 0 0 ] /Resources << /ProcSet [ /PDF ] >> /Subtype /Form /Type /XObject /Length 8 >> stream xendstream endobj 560 0 obj << /BBox [ 0 0 143.999 120 ] /Filter /FlateDecode /FormType 1 /Matrix [ 1 0 0 1 0 0 ] /Resources << /ProcSet [ /PDF ] >> /Subtype /Form /Type /XObject /Length 8 >> stream xendstream endobj 561 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 31368 >> stream xw|WmcA,D1S{%b1^$[eIVs/{%wSl0B &$lϕI-ygF{n㆘qdQdU/FhLPJe7aRJĜNw(?8NY SVnh0`XHNqpo;z=GޣGѣ|Owwѣe!m iJDemAqDqeY|[K]#ɩoK%"&%:"%=^q%%9PDBxr9|KL z/ٶtQxh!zSc"n2F/?Q"̵߾;Y0{DŽ94!Ñsz ~쮱cƚ=6;;8Nyʕps߱X6 c18x)nG;n8qN%\Lj uƧ/_9c|_c?;މMxޯ&`fbD#:;݌w:tps̏㿞lҁI9&M*L,dLv\0|o{~&8'Sũyru;Ýc?w$AN Nr/yYHsSSO>e) SN3SR Y2uzJK4A4I#Z$Z#j(U\!n:.o/]&\Lwr.\>ԅS}N]6uԽS5SNm_a&N#͚6-qZim,z N;9nM7sMo^8bztG1 ̘2cƌy3w\\zkssssV̭>o:Λ5y{I)k=F]w{w;q~|~ߟx_3_ v/P,P/0,hZоsA߂<_v6-m*nnnnbL7[[[[[[ۀ۠GnO~[[_`ᚅa .ZرwYxqՅ/v>=i ݗop.qsor?~3oqv\C1cGb=:A/=i OoŞzn y333SyxzVx>3}|l#)1T4t \o>]wo!_ҷԷٷU߻}_~/7oob~v~~E~*zn~.'~N4W?UC#:2#/7?ow'  fx, ; :@( h 8p.j'|S W '::t \2pm`H`x`L,0'86#?T%46h|?H4=hN{Ҡ6 ɂ҃rڂ  EwA-[4nѤE΋f,ZkEkm]{Eb,R,f&% CUv!wJа$,O;KZ3&-I,1Vs.7ی8ZF4 i  XgGp `'$xpZRB(]gvW ?~Zt~hX;eJ҈s EzT]&⤋[j|αNQcj|EpkQT\Tf)&ycmUy}ZSWWV4 XAƦECh?wh#Ry?$ȎNUfi$NiQI+#$`ʴ;+h '憪M)R 2M}7ߩ[:~`~m;DS3[wȋ؝ޒ6QIOmy_~r<,NJS0vJTh2H;#%.}V)qΌY< 帪̆KJyxXJ.>VD1c :sJ&d-wtK:ҍ-FS+٦lN&+E(p32Ĕ9ɲ"Eі}})'Y9pBæ'D2=! l>C`YcBIF0ě9PsnܹO|n}t}1|a&ԥxIJqjr/Ǝ _F/܄ฐC'gAr'&)]LzZ2H$-E%⡠ e܈b of*}씮Z״ \8~䳟q:Pt\B9V;;a= ;0 "Xn?^^W c9?ފ?=x1z Qci:.D^Δ0@LTk .{[uYdFJYZ-LsZ },'}3A\#mKCE'qY,Z`Ǥ3귓N|)7j 8+ XAJ53m_p,~`jܹu 8}B?ZJ,%Y88:Tk? 6 3ةp-΃N0G{.Ҡ)j]P'Ef ^[HBw(\m<9E,o ЧS:ZQ܏AH?+n'D'w-m.a;XP.*74u v&@l̪M'Z}ǚW^$M$74W]ܖE˹uM' xkMsor49(lASdra5*2r7P~ :BO8i't@!\K~8YR4'M8Œ cU* 7%;\!+$xώ&8+8AkrnPs -i R֗QgO^4,tcaI#N2AéC[f{Vߋ>\QUG6Tu 3$=y;$[[bǏoSjJM{5QjY+YW%x"*=b{+ϑ#(cȔ[ SSQ"vH-wgP.y P+t䤣z**1^nl/^*.Fy_&sOhZƔbr`yy"}hrk..!ߢ\q٦fUN$fge*U2pL&۔OTD77W@;!\ei6ʆ.l1ӉV 6*@ }ʒu6#|VgPuu ܜF;^~i h :0~Bv֙PJ%F %%W(lׇحRJP ܝ4Yh`P@gBJK@v sc׵ujSEv%v枃%/cgeC.>s{niyn-v/C=ײ{fכ oyCy8{Crą/v f7Uc/M_C`wVړJ:>Yv)yDȷ`feMsm}5ZК\m#RmZzZtBFW%f׹Kb2Kh}=\% 9Xl$>єhRv7F 4yg޼65}jpk7 %R Ct/}W^]yAIxDkԝH8J4$̓p\CņK\ïƓ S rA5y,R;n!&]#d%q52[zDLaKjŎViw3mGO2IêRU;h"3 D˨~`D-"`)P}_9FqșֳdGPqRLdL(45T5Z$M'm_v ~DaX\HǙk$"2M5;.ViJ("cp* 5uf8>NKy|LXjjTT2;*9`#Ͽ{>VsltЬx0R-ެIi]KN:DޒDF p n5;±Oyp>5Ӈ5T^q$[DwUcC"VPB;Q#٧a(N>4n& ƿڱ-?HYQSuKCT_6+ eʲҪju>kSqD^Ł0NM2K'œ)1~غ}'Y~ $zpgQ8SGzn^FњB\ XQtZ2]|#%V-8B .VEIE \\wREEn7ۖ?pE<ƙcsrUjqkJsX3vp$܉1G)ea37QO[S^xoj{ ~L]\Ϝ$$$%]]ѝIrczwub<0$w2>]h((6cteߡu" v?*.O7,~q'NX~:?^(KHH&IۻZ:h\x܀@f$ bѰwXҒSHq}Y'vl=E7OËm'W sTfaW⻷iåJ\ѨUdfCvmeyiUM$s0YΌ8%H=M= fQYZm{SV҄2Yn(響)y7YĢݣܾ 02Ҵr֍y)AՊU3҄Rueagb]}.e\FcgȚm䡦w*J*Ez]fz^06~`j^l(_^^~q9l< 3j4PTQ7::MA'hTo<)`4 _1k#GSnOENjki S8^g,!4$|!, H62**%N'N4oVKu]y9KY=^ћeɠ9 Kgdc$4Z޳n`߳uh~pvMsKq^Sp."36W7oPI> \9/LԞ(8ܹd.\ y[ɼbwp)vSg_CI֪u{ 赇Kf#(':n.ΟygClFckNB+'WN}Ǔ:-nAK øJclXxrV1#ެz!M/rGӕ>f-cܿ\@UqQؽIB%vʌ+BM.nSQ{\)[!ibf |}Rק0|(xIۖE)_Gi3-ʌ-Fa5ڎNnG_#kAW)D -'76vm+#ې'X1l:#39 CBA7TH? 8>@<.B-a صI~M\Ntܹ~r,h1:$lDWٸ ;;$T֥夨Ru,<="k.@#++Q9VB+~(43natB_-,)t}|ʯ(ĕV=+.$1 YZ54J+oˋ/S2*dS@ž>wFĠ.dh쫊r`רuA| ϟ$aS–G[ocjj"xipsn%ZG_< ˕Y9L6LFd*9WFznƉx8UJRiT}%!0$⢍λ!0OP(MzLh(=s}70_g0tS(6kL,_Ȏ!8VZUa+;ʆwd񘁂Ǜua7.mz$B^04r(Nd̓گE}$%dl0]adv>!aPrۀ$&Il /IzЯ3sSm"wSdIfܣz0!v\߽78tݴy|ԸQS4":K Jѵx8@⿴qڲO`[ofocکߐ`xC-=ؔj}tNPYm(ߴdmb4%A{cũ蘽%ꚒZa{mz`M9G3?s0F 凌|h>~SS+(RHCWc)UTNvK^]'dwYY J>{Z{Y z/e׌"`c(~\LwKce] TZjl#|p{p-IQ($Du r\$e]:Ld4TբR+TiN1҂m<"`G/`^Sȑ]1ILcNii)9"z:]79(S— E4\mȧt5*8H\ĶSԒL&rkajK*G'݉ JnhEсCs݃2ԭBsoV:ֳςi} #>Ӕv+hi  w w+L!A!CD3(Im!Y)Wmu[9VYRi ܥQu$f. ;]V~ iq&Jy=/0؉ֽTR};!v|p#KK@הv PԒL&50xN8 lphpGtcfSg=o[eVu+Qc&cp,Յp  5|.xt`0dQ3H(@P!ė~V"ؾAELiN r$SN=]#vAdbC+Rv5b;M66H.vUD׊[Maή^amHlbP[& "Pr#dzG(P].[YQI\ w:WN ζt"Kڌjh x32]ޙu Jmt3\ u8IJY ~:oI7U5u7:, O`'Zuhe*[c7SttE7bf (eթݩ  O*02x.gaI8-Voj퍤nD/(PR?umvWS N)D@ѼHAD0TO`VQݑWU Oۿ!Gpwt>ޜpkఐme"#;46 5"u F2P_^=oP=*F1) =F7Lt e@[`ݧuR ZX[RrqbT]}[Z;SIJT3ͫmb6Pp 7RQrA6qfHJ bc{nG?L#V,jFp3UL,P6Ct0 DQUjJPqMϊa>~DFf ХLIBmGׅ*S3t'jte4'$KB XWz2u#Ή́ .3/D[ 1˶ Ю_٣h/q@>J+縠0%R7 B xV1!Rn?<:;V?@2Q^5n.HReY055Li-Ҥ4 OtY:jےCh߷fZ a!USd 6WITkj;ܾk|9VJ#tcŰb7ߜg{δd5ɒE(#=R+5ӍE$,+UTܧBKFX`)jj*zW:tQx|׀e6кh8Ll~D,!0ČٳPNzfkeeWQnmh4G;Z,znGeucSF]bxl8NɒSdBQSJd2ƙ&ߤQ)-ii].tc'/a>\wv?$;z#;gГs*˞\ 3Ͽo? f2tEf@>k$+v= ` q`Ph[GT3knn{T(=M&UgFEPRj,kʫϧ_֛$8JC=M{XJ,@φҋښo>o)=kHGTVp:Nʓ veIU0,'Nښo{tQ@0uw5") KOOРx3L@-RxEDZ?h$`"BrMe͚a/.0G X+(^eL %f!m#ݎ'5|s/N;*St~pw|dS\,!yЕ kl}@젚֔ vK$v)ř(-|-)L#c{El,ETS~=lT$H@'8 ڥ6&Lg?T>䛔Wmx\Rq@ye&" =0˸Wtx뱶c"O^$ll˃-@9^O\U:N/B@ѓd5+;[#k %ZTSTb ?b~S#J/iYO1&ECRdvQL9%MI]~㶕b0\Q qZ}ZܤZ@҃$V|8n]Bh((-/(DPY;# NcQuNC;ΙD\gmi8`s@`y1KM w"x9 ` ր<o]nfN~, +R-H) S<7+jpi^ev1@eXW>/DIK7HP?6o+p"kMmY qQ1'&ɀXUrA!aM8 "OS$P5z(E*LN K C 'J*iQـXDN<})oACRlxȌ'Gor䠛Y8>./cS6h1'=p}"̧@Gv/W.gÍP 8zfD0eC+”EA{dd! PPxDm ` z^lWH%c}~9 ne@)  ^ ZЈ9=G1H~MMl+ t@LALT%k 6Z@Yb_%9xC0g.R shA6ICby 8eY0`]wJaHZ2B -ڌp͗W6ymN@m'ź(@\Jhm6O?̼@.!%A_*|Wَx&2[{[Ra,")j説Ԋhgw9w<=ۺSFj&$J"c"8б g'v `͠7_.KZ;}k`+@E+k% pD밠 NQ3P,բbi oLI+ڵ_ ͜p'%8@QZ /$al>v:T꒬R#ÅD)XEtƉJo{?Ɓ#)Xp`>B1B l $vBó?qwݾ t6 t@WmK&[KցVj V$`rR@wa:zMȿ{'E{b4P[佔(۩۝k2a=a}8;M1b5b5sȧM:X/0/(g>?b:^fP͎N7G[`ne!]*LԖ$.*/ξzݡpA&-],~S'LvK㑿 Y-;O2b2~3; J˧58)kQ Kv}d# xM؈BK# RkmVe%Ix aUe %q ^Vi;&" cYuA*)&>Z7cVkeqd*ƻL"_0v)!fuc~#RP1{_9@u®fg^8!v>J 68ƺHٹ^b8@vW>-r{܁{ 4bMiU;9_I )Њ$se|00q[g_GNE둪!!3kirzeڨ)P9삜e1_VԓEw:.\F~KvRҞݼQc נwAT.ikMi,:`Mr~~bIiVݬΖj:H9dVQ3 ճe\!|$X "ljB񄃯-7ٙn {eW_3f1KTisy)69wxucƚL(8r^s1n w-wf>,~ig=w܇6 G|@l'bT")Hߏ8p| y5|Ύwcpt3AX(H4nllPBn1.ٲnK[rt N z 镄=囑 !o-X c*gG}bF ^_w߻ǬYyZZ[^Ehh8 ;?7ToMTa֟Yo 6L-S; *~IlM7w\qǝff2&b|JHID+)TI>̤kL^39brs'&wM2;l]m}lٮl6666϶`;d{ Oxvٹڭ KK˴++km))3N<%zJʔ))S.Nyȩc9u-Sæ&LUN͚Z0xjکFM7m9ޞrL˚68iL~?ttӽ?=rzӇ>3\gwbF-3zfqjƅfܚto33_3k3g\8s̈3{gyf慙f~847Ycg5u,Y޳Z6kY)fg :4~=`?~BCsKO_?؛fM=[4zg?;tv٪ٚ Ͼ2/f0F:H:8,vwvt(ww08pr8p#~p`~s#(th(qqv x\Zf>ǃ9^tx'OHL<9欟}NȜ9sΩ9΅9y:$v8:;9;y:-tziN;BTNNN9r+ί:K98w^9999Y\\\\<}'sysߘ;c%s1wx3ans}0_n.k.c]l\$.\f8q pQԺ u9r.|u+Mqޮ\F\3]]\]\tz#Ǯ_Fuusq{mN( BJ7An7c ("w]>}R5wSs݇ϸ_t]߻?${g+7o6y;z{x/^{www[.n>}};ޏ6Lg]>{}||2|r| }J|*}|x3b&%ҋKϱgs0(%S*R*zD9$y[ ])q]2<^PgoO4oWHV@ςm CFl"4dg[uq-Գp9I8)g'9,LBpp26n|e?%WL][Xǭ4{ZG7_sOzrYjL*OT$ŧ 3z%{3G)ՂT.{%-&J#}^>O 7MԿMp}}mM*_Y,P L>d_c\X jZ*e.Yjv_Jv9 ,]50Q m=TQ!-+\)@[ֻkSqqG7 pi2iu/OL'-ى pe$} { e(=IMIJk|}4H[ۃko ͬ2'P$oGFH!R#Hb5RnQ#)jd6R#"" ]\-$HH$⺥:rT"OskTaFFt(>^dDwdԭ݉K2ss!`u+5In3B3L>LCJr)#4 #LR (4ĔUǻw/&` Oap_&3XF~j l]g/_efx ֚eM4l .83%z\aχ׀>}W,f-ذ'œk! ,̹+PoLL~8ۻв]$+_9tЭAyH@֫KS77+s0퐆7Z5zM%|3BLD%&+[[ґ8|vKwpox+@%>2H_ {#\QhVKo|^1{ժEo]>'iN?{%Q"S"I96!^ 560^_ƿ[uˈ22 y8;#=GM'OJ `Kk zEIbmbmjuToLgذ^pHeplgD6+3X@=G837}zѧ\KTd5>`]g8Koq%a\)_t/)ԸQϦnkUNܻRn<.}w*%GS$Sn$ J}ISa3-Un΍n ⋾ȑ.K!B{?GՂhlrm%gIc!BT*TUl&|]+ ɮA0K`L''$yJEv=G+:܎CALq 36N23t%.#zvT"t%%1k^펇gFZt>K٧LeӃGEmZ0rGZܥ)`lZ 孄\*谩=|_/ЪfXu / _̽o:n㠠(pن-Ftk")z8n7ZR#Be˨7#=|oɃSg7F ߸Fd?5Gڰ["JG=#`#Xw>V2W)7 X{5[!gcHL KSd R&y̏L-hLcxj 8\T^'h-,Vl9-bS? hNIK5Vb^[| '݆>]nR΍XsQx! V?݅?~sʛQxo:Rޔ8ITRDBD`8nG:,Z$GWXB\B\ؔ+Z&kg(_L>h/\ Kӵ+X~"79咎^b۸MmUuVc;jI&}- C6fXXO'Ep3qpAv ' b2"z늒#sBZ:g  ܻ2Bڒ٬-H$G y֪ZTbvVZmS0yZo ] ݙ6-VB9DS]ZlSӼwH *zYUf2m"<!<[|u:90*>>:*8[қHSS Hb@ 鞟A1}ѓmzVUim4r$65̂S-y$o3 BPA?7Lb'_F^,Ac&BfVo~q覙*+ڗqLۧA&&n'LH~olY)LdG3K [N"z|&*~Ζ!LA .$cH>Ͻk͛űnXuQR#&soD3Y;PFt_=\?`0j '033\I&O0ô?9e;сL{1%g"5reK]lxxB\ЌņNj"8VUql8.`-O.hg?͍$^w\&ݳ'*nu@uB8Sz7RL,M>O; qw9ʶh age1ڜ('Bn%Sғ2pzvOҞu 2l70u ʰ@°OԘ\eEV0vFICUcU/>#Vdd1Q沖BM\+ R :-ߛwϜ~iѷT)ɒH;vG^W_*--n7FإE_tc"?/J!mjKLї2⤢UᩅI 4CXaQwK1‚(b$?a? 5B93!"iL۩7bD9#*gHѹ@Z _RvBN.>obZƵ>mݥ gWm $Z"o)s8sD_8VZw 54߻Bw+'j a !0E꯬㍅ȉS-re#6+9\Jl,*mk{պFީ^Fj%frrIM_;=8hHFךxHY x[ %w[Rу6.amAQ6ofgx?q8rzn۶>\w_jO阷:% {@ AhV "re7I<xyAw1DIUrlc@_Q<ݳ.$b{mtwO}}5ropg9FcfD-4%yՂ&r>&,Oa?eR +v-hz™\BEi`+xȱƦ ef[lە'W> o\ATy,˯,vɾFCY*TDF0]1})Auޝ Dע;ހEC }9=&.+"e]ֽ.wY. ] ;[WxU7:siwƃ;%[ÏU5+.M1Al(%xo@E‹k.I8$42D* Jm[/hᷟ<9pR de uMN%s1Zגm̜vȼe z,ƞo6' #31RQdvJZ%E5M{$_^r}YEC*ά"KTYmll2cd(>_ϳ^;UIr%=:Mh3cL4QzzR2AaSVۑheiCSui)3$T M>wYʏ?]Aqz}5}޷l=s&$HCA<8N@Yu{ӑ|BLXk즮9ŁGO\H߄>OS{LLih$ߡh<19y ̑ΝGr17և}~O{qOwKʍr݉P3dK}fxc_o2SɕyB!Cw$ FcɃ#dA#ѹ;}psUH(Xe]B+!ki$IF'+y٥e9~A}NE]Kr} )vD!5 .G(X&DәY9YRl|8DH佴fPנ-,oP /0 VJw`3Z1S`dK a=w~F(W%m+39TAN3G΃Uzm|Dڱ]yԚ5yrRmmЄ[}Ϊ=9FbOOk[߷_pBHM-VrħD)潠~eOfpاn#j_{ΓK9+Ս%jkual|Zn&4I2%)0%)ڦۄ^<k w̡zﴑB!3!gK7s<'shF4|2\ 8ty@Ln<wRX[j|)M/TJ~{q'GaǤd즁)SlT?_)9 +7qFaR,fhMl%|Zʠּ͞lꗁ$Vn0!'R"3?ħK'D4*W佧V??L˲DQ%pcBV'gŲ(,$9qMЁɹS)~_TkO4Şg ˗DahTYIu| ׊HfZy6J漛pۼ\$=䘭멼w+^N+=T8_pm',/ x o/{, +;`l< |)&ѮЇ@Jx y:m:dTY䕎3J9-?+*32c7 ݕE4| yVļƋ$hԧQ1ɒHv[L=%yd ׁy˒?cn|I=bǐSsU*ZFC\ٌlW“"ЛخEמ*܃6+5% e7R1jݘF`וVbKy[-m| &| _^K^\R_K L_00 ~i ލwyzþ}>LuVZVzAZY @LMSHǓc'0օt];p^!g(S %+##nRTB-s4ܘA-d8=dN<]C@ s\Q*RA'ni0ĭIIYLp֠r4LS?LAψ+pC8TM=PgЋd xG4$̑t F&`|qCLu8`RID@-Zd:RYFyf&Euy:DT)=msp 0ZAG;0uABNw lZ)( K7A F~C=Zcp/>СFdePd_2*82 3>=qZ͏XǯM$[Bڂ:#B7Ʊv-ޭ6D ^n/g:*غo*.:vނM(74\^~*m3_4]&>fܰȽ;ݸݎ쥕$ Gu"0(DBS d WznvT#0c DPih|-p+נcWD?0O*&H'SPK[v5r(C?<[r-Q{RرLzVzvZo/IDHnxtF͈/~/_Ģ| yl h3(Z`Q'ڿIXŸ!AOT# E<] >D. ́J-Al EmF~"| R `4b+QGWl;6 1|;Oݤ;>{Vۻ'(e m ͆Hd'_BHEDGIDIn{Rn@IBkQ..+x?b_s޳8/ԩ'&9ly{ELc5, C$Gy~ Vyl-zS|Ł޽))$by}^j8L_ڥÙy2OfE 1*z4)x$@~SE+͛Z7\Y6A05rNʬvuu5t]sɓ 7-3C\Ĺi W;Ϝ"1=> n j*hH|3MՈpQ[ H'ou^sN+rpVqFTX0}H(?-p3rp8+MΘz1pJp,QTvH"b .[J-T|/7]vE*-nq#A |L6 }I L<&Sb^SSԕTSMц`P MLMMS"v F&~FF6'Ԧaݽ3j][yS`߾ʋW3Nkf eBņ!67 9ݩ&doRPSTVSd] ֐Os`kJD?jXy;|A9`#s݊M(FVQĽEO1 +GBR~{Ȅ(YmA'׫ZIkk<mGWyn 9)1V*%$z]AqPV^^EVSZcC{iPUTQ[l}؁Ե:%_vZG{Vա\iɊ\;eww,ˈyI D_` h,٪hk ϓ簴e(,X;=S'L|Z+E&[W9wӍmtu&J R|ٛ#W>!TȡaW"DtE KjGbTL܀mPbW1ϑ3ޱ]&'*,1Z&Oh6h ŇV=?Z:< UVciqm헥7 K MN?#>cm,aĄG6ƴO0'[O8m}6`@Zj%\ o\\8 G[`KqIgc "q`Cw tT$af6ܒЊ6Pi>97-5VP;kCwYTH w9mt<7i/lFj^p,tmـ'SJd􃪃Ѣ_Zp셎doɗAz,|L*N`rDt:c9P`f0K7ϼ# NI c!Tnҷ绂{4;?vH嚶0)|䏄e3(~wF Po _K8\BV@ 8sJowNR&[꿕$k|W k0&p x?E|[͵uട.@GfF 2*e'L&yˍ[PC{&ӣ$B1/q+}јC OWLP~FP^BsHNʍe2iPzw04iBV`D@<:^R$G)aC%cλp&wNPtW'Oƕ.a5~`^Y[QM80v(x4ZBI`Ӛw>vRqc=h0fGJqZ!h#K7ȹ"a]H`aVkfQ(-C+ҲMTkHsgBIżaaW $ǥVs: @f2鏉{/YdŬg@?1 ::Pj<@*Qaˣzh 8HmUfPZ賴$7A4[z INfS9`5LbmJKrrǬ߮3lt|${}6&kI|@m5$f`Ig,`2XA*ZW XA3<=ŰH^epC.糀I^CHűwL!9T(kOhۍ~:3E#Iys}k@n^7^^m#LUL@PL!)**jڦ԰0yp&/w1o-[ i5)Ͱ Mɛ x֎( !JGVӕ4v + xkIB?}:PAEѓ+.SKnJHXltZ/ES@[*J2KӋ0/W }[;12hR^z~ѯT@U & ZKqDh$|xXKm2 "FVI"Y1/0\fc0E@ s$ZL-9.׸u3 BB_*2(}\ELiGE0E`'̈́E47vGDɃDwJk9 \J PYžÀhVLj " TVu1YR|-%$^odgj6[0j}ƌlB:[ZzP. m͍Z͵%;ަ< }4 #AR-WDF׵}AWiq| oRmz5zFq=>bd LoC#}3wQpFq<_MIJLU<ѝ%ȽUۑ"f䲸83mW ɐР ?C EYT6[A~~!Z}F\28s#-9!`o1@Q$ghZJJHjvldkv`Ad+}Az#8@sU |>0m&5@gH>$m 23s3iѡDwv݇2 (#N0ZA߄ڑ55vF&yn| o*]OQDOu<~[CZu,Xd,Ǹah B\?x>r"R0V뻂$K㤢&*I8P}>n>J3zG# 0;6c |}{ =ݕ5q԰ b8}od7{nl)J#WC+ ؑRq3y@1|J'>(Lmt*@D_ ,}8{bvlIPOb|t]s 7)d3J\{OvuړޡŚO0֊Ai/y:#lZ]2 ,I:Zj#pZ(I_k4q۶@Z7_?%-)@Jh4ZuA=?Șvʜ#ftqTzxV8\<e?wn&A"*0 v?s͋6s$qf лôs(C6Ye@K THFx ͤx|WprU4#8VY`sd,W*"0p7 |%O>O*U!YH#ahd%|A;ވ<(IԪ@_o͐x#ȁG߅Z]](lR2Z"UD WG!2M~jPVv JY (9 >Xצ'endstream endobj 562 0 obj << /BBox [ 0 0 1865.96 100.1 ] /Filter /FlateDecode /FormType 1 /Matrix [ 1 0 0 1 0 0 ] /Resources << /Font << /R64 56 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 163 >> stream x% Eo+ &.&T;~nrν# k4w'gq xX Fˢlz ߁X-'QHL~;v5qAHŞB 0͘ӟYc׻a wsW.vendstream endobj 563 0 obj << /Filter /FlateDecode /Length 2895 >> stream xZKoWmG5\bXA(ʖ-2EUwL 9MQ+:QGuWϞOd#_OwGywD$TmWSY/.>'eA_h=+/nga/@soqVv{ל^ed:+tr67Goؑ΄vq| DԾ_}Ҷ7DVvoGO,n$> j?:uiW't(D AWt:vs? ?SVvxz>ѽe0Fo46@d֏jB zKj$he.F%c&(mTg"UMZ.FNf`Dݠ:]hHk /pY${3B~$UlHZ,Z( ҅zƻL{[&r4W<>1JwZBjOlhUNFoyV'RQXp: lI>Z+!=pw@d yUH~rDu!B.Z5V14W`'UQ8)32_~*,$CC1C .z-s (ϳzĔo2S7tpN P8\H,`P$`DĆ\+DxK/˂[$qAp NP 53uDjv`f;۞$o`,`} ;g]{YL_sƷ| cc]SL XW0km:xle;jnR0@-ph"NrH{$p*ePRUHz|/4PDXMv!(X!h2&Rdtw 8ww^sCZa"HjP}2QT2!i 6?Uk6=}eW鷌}/*,q@SD=Pv *"ݣx FW@ln/n&AQƴ|SAm-5tM V$'Y LV]9 ;k0Ơg,쐈D#Ƣ({mqQbE&VYH]W ؜DbC7 i v yactr5UlL@'F$CѢѓ)%@e7?;Σ5OG*sɻ+FNْ{he1&5qΏde NH+3ܟGXM ^i?*^YoU(dJ-8#!"o1)lv cLn> stream x TW0&3P J&hVm}TXj("E]@AuAV\[M UWm7ӝ@=wΜ3gf~Qh(9dIHTS8o'n'C/p'ܰ+]Y#`;x GN=qaքԔ$񛢒ߖ_oB/mOHJNIקmH߸iET!ql}mi_?(V=-@( -BAeh9ZGnyQEE /rޢN:99:t %&5B NNb{쀳v6Kjrq/a}kFXm9sP,}6Ζ|;aἏ׳'RawY^:W^q4bAmY~ g#Ep{xA>#$Z^MD/Eb\̊>uy|f6#RJ2`2_s!Xrj0 1x3JܓX5&v I,iʴoB7/Du"$Yy$=qUs`/QdaPd)(z[^SSIY 8AKVmJ_Y34(G ؄u>/JODG{Mwn۹t+{Wc \,bWe׫~9S~IwG0אs1Ju\E7R7+bqΈY-}vMZ]3#-`G6!e"t7<W+Jv74büht+3J˿:w iT 0T ^Ô)HT:+Hf#ʵ[WJ?:Tt`yU+`,V$ z "aY! E0CHFd H0~Ir逽rwӶ8X)߮)q GEHY8ɔ_={|iFDq=C:O^l'^mkWg._kвy ܑȌďJxhx'f1 sy6xK Ӫ5qbf̎ٱI)F,:pR AD96ÝTmJ[Ypz;O?٤Jj芵%jlfFM 4q%^"OOUTآ-@E'tlVyk&!yK "/@D?t?!6 .Vfk?\J\ ?y7Ud<7+;/pS}1z>rꡍsl`44 ?J cP\:C7hx*Sޒ윹I D*1cӕ-C*| Gۮ+iu?plPvwPO>r@c!6ȶֶܐYT9fO!][ηNI,GIH|slkf,_*MRȏ'._T]\' QQ>t'~;K~8ƠVh. _{CURUot?#9U%VkR6nN-7%JJ;ل:QkO; (VNoA@ntأؗV^:xdZ`E%E gyyezOD _ ;cq?|LO?>:5Rd]!c.}wg}NY[V`JYb?/#|qxJ);|n}M =5z +89~t[[$E |JˡK=j] ׹K|E+40ko[ҰE(ZΆpSn0W3E_ 9U gis58Ǡ))vfe&U-7#jop}X='}Vc}aޡ qDKf PހWXH;} I8˔+g1L_04,KH#qH10 UI2:oeŻ2LY2~1Cu8Fτfl5F/D5i q򚏰c$.q=?endstream endobj 565 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 9249 >> stream xzxT !fDAAi*MZ-H2LfO^" 5t =]WL{gB9uwvrrr͟RT4hĠA.~2Wӻ{ {t¸_g?uM>tGacX&m.rz*+^һH\Vو# e&/T13;WV%)~susoq~IѦom~aɋ/-偃*2t_3♑F~16=Fb}X?l,6{+ž`oa "l"6[M^Ɩ`l6{{ ƦcCPl&6 FaaccGأcR,ca˱' .XO,u 1{ 0`cv0gr]rmfJ>OvM6umO=?} >Xc/}=_ʪxBn>z{50'<zF>%|&ťj{iӿY3gW~MϾ܂'?_X©vyHmI Y;hc֬$_$WU^]m.1#*suzSݖ<wc@ɕ˅4\T)֎jsu_OH|]EW+^W(>| b|#PIu똗361 Jip08g2{/pv88*ݝ"yf!5APY3 q7|L i4'xX k8h7jZ"V&7q <fZŇ},oZOuHʁ؟_138_( I-i5.ئOo9kjB6V鎻[€ ?o j>7N|k2!O,.h [kȫUf6>b"|_%(_>lAc)*xKa  Gny ^^]f+S ~e|+5׸%ypDJ?joG}b8 kbwlX X+,HJA ;mؕ`߹AXR:^ȐmcWa=3LWŘޤ`ro0]`>a_I'sGAN1=Lv`#eƯSuDfEH1"LUUz}E@4ťY"APX-߰D[\! {΀4 5,X~BxJ C}.gzQӿ'6x6*>f<d_hi:^GO bJƥDedt@+>~hfp@'>L]3\bsgYv8;SpQJ߶k;"@ž.zhx4K $ڣr:O+ar"fI$>HG(>XY@:rKHQ@I\D%ӅÂpLob5 u``q}dhu&]! D֜.F!Si0+\4>K<ȰZb5_:O! td0 (LϣVpo!<&I$b:;:˽aڂeg~r~jQrFlC6bb,Fñx(}`lhܻ3]2 &vC5.KGQxՊs Я_2w9@rfTܼ"RZ"B˷VMC.BubF|KBTSvoK5mF~ftb>ȧB 9RDLoÏ6K2G0+g֯`HjC0\ C@B40{8ڦC ‹C*.uɚiśxǷ z6z&v6v{-^1C娙" ?b"/RG ˜ >JY1ά+"PѬV^PB9X966flAid ޭ1[6I3V7 5tI9Pq.*8}_;-=5Y\uUUނH"QV q'#1H=zvqi5G-Q@"G383o\B;n!bb>GîDL2#H`<GQY+y!51'8kir&X=&F9Fjp}`*k ,@Dj#5ha{لǃxRLβ#]+KU-D>EN:χǽpBv[!Rcsj#0/\J£J`n,ZnX6T554bهJbRǩ4|Rv;T Jw;ku='GMo3$a뽞CFEΞH ?y43(e &:[-@O*U6U1FoR`8T@ *&@L0~ z5h9/)[ce|z '1<6ӆ.F !\uH UPPtfQzz"E38Τ5ˤ'Tu9C}- B.#(^ 38웺X{n"cbYɅQ~H͑Q L*@9aiXMs֥MM߅0z&B6#/S ,]/Le9]jVڔVeCz:z<uᓁV UniGw Ni>'Qy,|0K UP! jZEe3 g<)BUw3v-`;l@Qe6I5TsGO*`3)JXFk"B_ EbH_N-e\D˶3ζ ^#v$X(\7>ĺ"+`7ـvÏ);~xx1(*5dQk>:o6ӐskWt&ȷ$J-EiIM8D=[g2}]<`u+iD~ gZTEfJ[냕Sau5[ * 4M|g f.zI| ylj~yy> ng'6|ʝ|D*t|Wslر$86O>EFRv'=J3ծdFe`99s,C kGr?~Zm\'a.kh[69K&>w*w'8NOZZ"D.K }x#aJ"{¾ 9Ly% Kl&k07}15LÜS$ȕ^XbZwZƌfz5,^0h 69k.SZCa+dQ_ kíjߡXU+wn Ƿ = 5)uni(\'̎9R7I¿r޼~_MqL^pmFdžO:Ԫ`ڜg4\~يk<ۃu[j` Zw_'~P.!,_U\ymeqYtQr6"[5IygPFĐh8Rhu8*PeFPe1Q^VTW9u` ZiGhTbJ.Oj6 ,^O>3Z/rRE퇷.޽Z WX aCGv 1oߚ{ spm*V; _.UO ؅<~ѳ7Q*@6أaI('4PKJ+yQbav-U"Wq%r(C( woHVj+Y sBY$ll|*p%ӯۅ6ŌBI_ iki?Rl8[m;|||*|KH)LzgD˧˵R=(jB2٨Xf̃:f2\Ip<Ӧxܨ&hwV~CZǷ)>.m`ɞ75*C~ #;!3Fp<3*#H7̋Laۑk u' ¦0H$B龘̇pc-,?42WpJrsHe AW4FA)TK~_$)sL o3" h'HnjMHh%ѿW |p[F6WZ.}=d WBIˎc#fQmՔAU>ҙ Vuu !{#|>awDtS,AfgqB)䇔 ;OuOF&vIes-"j.kyFIӊwh$sv!. <zq7%#dSd< IdbF ~,9;+a):gM,_)XY jWECѹWoY H`Q&tLf3pI.b (B&efOF77p(2苰'187~tPLNMދa\he+6AR+I&҅ϯ|tZf;ߖ..]~? QԨi#{:HejB[DHd /Ϭ]BY43[s-5je@NfGv=xp8Ƭ-gƴ^4=Kʹ(V+gLzRƼM["-afoUH% UB~@2Z%qkűbȘU YU&Sս&'|": ]Frcm;T5ਉ&Z uUzܝlQ/J0Nd߂嫆d b,BYw~ < w›p`,dl?n_#5ur]0g;3rF}t:X sVLٹT޶ 7Sݵ _ Y GhJL ')ԗME xC-b3]ԀQ!@hDMoMw4k¨h9>Np*ahz`աX쀺t $2{b4n۹i=UQ2 zDK6lYZͭ,M+(c}s} 3Ǐ:p:Z*2]/1909E7Euh_B>Z>Y7g1|SŢU2H 1BhD7 mL(u_BaGi YIxϙno  (0~yiEv9"Aوpq/r3;ý0@pxw ٬ʪR2iɳN|B9 S'?m"KfGsň|1G Jȇy1o.ΕECX6 t&y-S"Aⱘ+P$nn`%KLOerOZsKf]BR3WB!>GgkWЬ.ಸl08$2eQR9{Φ53^ bzʨ$Ȱr7"|8Dg\:=.2h&}fOH\(L=M< "yXLw 1uM{xa9l+Kg(r$c]h}w%l'L0x `lgV+RˁȼbN1l?yZ"RꗇAO?KA g| CB}#EUƌP{pgv=H=P{$Mendstream endobj 566 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 349 >> stream xcd`ab`dddw 1-H3a!cO/VY~'U;㚬܏|<<,+_^$={3#c~is~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWqr-(-I-ROI-c```La`pe`bddcYÙO|ϟx>?D|~]8[7oߚ5v|cyxcTsendstream endobj 567 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 329 >> stream xcd`ab`ddds ,H3a!/,qBVJnnw }=S19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUWL:)槤1000201012t`y vVS]Z6{_Dg-^V?҅ݳJ=t܅l-b>D{3xx$w;endstream endobj 568 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2860 >> stream xVyPWo@^7ЙrƸQM1}lbb0LO303of ED ƘD4&11GE}۩mp V_US=5o^;/%$$,͝2y$='GO~ 3gֽcTK=%-F-JGy cPCXbBBքe"aq粕Lu `mBS-Pq-[&brulb+7U7l6[-a^Ö`Ke(,G>!15q$ۈF\J=X2:>yꄴQi9HLc(ˍѤQ 2xH㫢Vb~M&by<(5b:BlwDBrCO.\nXGq|\ImFSA 7) |~_#)L{} }K8u\LB;'ԸKx@Pmxpu(iڏHHp+ZN\IyJZ Te˿PO;I1t~Ry:V;FZ!SXr<֫k!ؽe F{-+[*^5{:$\=1znE3SaAOg` Y[KoG9y UުVQ( ib&74@n*lGVhBEnIc@婦8GP"MYPS _}(MXz6 2&DwVtyww2p6N Z{AvT Ҏ6K0H_C*D(TIc/sɢ ܋8?Y')ʃaq/An*,e8PK<`-| aċh `R)a9#CsDQ`z7Vޫ<͵BE<ԓy=ཪ<2hȧ K<ԗ{|Q$x `8sA8Ҹܨ*}h2!aV(w6H|ڌH c Zhk89'-*4C-ff-^f+W. ?ee0İݱt]DA, eRtPdngSA@?NGJ:e6.?7=$hn>kRKv$wČL:yOImX;f}aEZUԫՒnɶzz#ƥ.|}2N r'K:HV\ݏ ;T0Xw. !7 y|Kkqp=c^xK<5 tá={NfЫ nC:A51Qin-Z h%>FZbUF%Ts/Z :Cd,!>$D\:SM_Zɿ^S,Z[;P$\t&!¬-3HjԔxK|#>Aܡexhe@EO|jX m # hO\%~Q;ȜrRxZ(2A D)=|=:j6! [/V̛Z4V%}h>Ƥfm ',~i {omzR`["["4oգOGSw,'2CORˀXg VD.[Qu[_ƁknFfTwnk-, 05G+o}dZ)Pg &h&zOu袎ZoMpp[Tn376%vv!>NAwb*{;M7hHA~3y8y7*%2H= x;&̤m=1!ZȝAI|8C4ķ0*g@Rm#H/ *#-Q6(MCif rNfQ<(QOF~p J&xjXTФPЄ(neRhwYQ'DQD@e MK;z+o\#_]VvSbF$u˃tq&?ntUS_sa9RQCy1!<K5fG#l$Qǝ`.HE|9g L%D郟 => stream xK$q) Д0̋À`4rEYo?"*kg\J #'&+ʈ_V8~x}o}[^=DQ,1/=2/ot)ˋ|iyx扁x˓[3xb?^^%ֲ}{ҭPS^^:aWv~qsstǗښ7yW>E-wYZ[.Ͷ_q|0/?|s]liC_?<Ȏ`,iMkcTo)9Ͽۡ+WcSx68 4C=@o 15'}k4Y2ŧ5t^&.WTJkNӟ.: ׺q[h9O| WtPocA#`hNWcHu5"|b>Kk@(0|1ٮTnTa1ײf0=Nw7#.ӤWnSH~ũ{龞齩5./.bWU-Jq6W#'pxttz()WÕG~8"}^J:F ŗ 4!G}gN\o$aML_qz]k]['+<c+W/,bNG\_:7?Lsn8}FJ{G'B~ᶸ?i]Wxk3c7C0O_[Ef%8}bnO W?gQQG",{Qd^_qY__Qݬu&5e}?Ls>;XI\UOiF6/O^./O4OW5f S_q7>'}2f4?* gK>s]K^_N9rSpGzK_Ldi>XeywW68Ybߟ^V׭>VOO-՜IEWfd]Yv?_PWZ[_|e-qih@|\%#= <3KMh[^Ty\N!;*)\EV4"I6ݑ΃>A$>Q%QSPI'5qQ%u-\!$zVt&+6Vs⺝ء2HPVIE}mXb 4Ovl+;_%"AoS>? .vkY!"^BgqŮz$ *+Ki5I+zD ~F4.~ux~뫩|qH >m{UI\ai TRѕJtt<]TW6p1}EG)y`N4al*)+NL^[+"m wCWRdI@hIa'FkuU.)m{>BΩ33({ -z^fRCp%$!עD4%'C{( >į \pAihG X JZZeDh_ k@PHTBD7*I ޴]RQ+r$]^C.PAGAИ.DotJ8J*A΃sEJ {|H`z A9lCjή!R<JXa ҜZUp0FUv1Tefڂgq&iu>Ss -(54WheI]K22jm>rOqgl3rO1)}*u>1癤)TDR)MRx/c,arYSdi*i(b E tTjZm9K -KF1U3#-SyL2 li0OySP sꆱn*KNL[́Sxdw3^%vHrRF$ptu|Cuttn׎ \k:0LjuQ\IN.r6:eQY/N=%"T_Ъhh^,N"fT, AAUβ(/L)^wǪgAIНK-E+h!R%V"B{H2s]uER(25* I3EYAH'fMmpCP:!I`5R C:zCXNkZ ]ǰ.(d&7uFj7+c`B 淧hTHbE}Fi$1lQÂB¼c,ѣ kNTe*t"wI T P\!.22eHipe14^Ez'\;)bwHM  aXTPu]iX Sb٥KKX PP%,6t,<6CHM4=u!.u*a9D $YZ'8'u K!Ԫa90*ڬ:\eM$)R"=DEU$QH Eͬt <&zېTGIYe"K,ia$n`OǥO&RIѓG(1KDEE$N._HE͌y}*KDI'=E+K~~̐pǣ6UG%pQC26u5$(QC2`diHY dɩ'=L܏|k< y\^+A 7ufL[~فKcF > )-vgAM$7A)\g 2(F%22aT(F顧A>x4--[*,EEux%zk/i~&)8&ՓЏ$sLeހ`ʂ>I/+47HȰqw>r˿N}xiR@*LQRXM2GIba$4Sہ|3}ҵTɐ_MTbedԅxzMS^fF`WI S}N="$vY[\>)>8񼲷I/fk}jrGhc:+#^ږ%vORU~T]|P@Qygc*oFI6!XՓV&0T[ΨrUyReTf [F$ ;ɨ\r' i*QW@SU| }zk tgƘ*KlZ2:gΠ2I*{_J *#4Y6UAe}*SVoؘ2*dge) Lb0Uq1LJoYrFSF>1咓c>f3S'rM"o0e:r1ʔ5̶eV`X:d e/eBD@v\v̂BU:0@|JWLZxc~|m1eW xmL LԲĘrx33eV/*L9.ڙR.1Aahl@^>d[fEm0du'xzCdbz'7#O1;O6f?dM@P:ߛ(k<gL3Q~&D(?ODp±peX[O>A1L&‚յw<"mD2y픭~+cóyNbMvdõ7"mi=1\E_ ZD͞Ckqme5Q|_{fKϛD=T-Wz!HOAʺ5$E $>w޶WT"~ݔi%%~<5TY~ &Ͱ3 E$Zqlu?ewk_9]ʹ4Lt+jͧxN|H4|t)nT,*SLmEWd_%!F} b ${rCݤ)f;L,uY2])*Ղ- _2e ՃDim?Rjc3Zll7\6PNCP*d1@@4@φ2ðφMnflޒO^M]'+c 9'g כD'+ծ0][ctq`alb0>;8vUHT `*ahQѧt }FսQEn'h`'j 'OooD3U2OHۙ@ا>O<VըOfاG(+ƞ0ˆO&9gCLOV{:gdnTr}恈$hit>Ӧ>IB}DiS'C:mbѥ }69')41Lb蓾A }fV**o8\?} }0UC]>!{,~`QYXTYp> }4Iek賄Ҹ^ĠOJnRj>i~x;Si՗674;tqs:̭Ĩ3wg3M7?OT`3GÀLbo3~+S\O߆d*'e ~6#'RV7'>xcxc34C&Jt;>clѢ{uѿ͇w9@?=7z8LDZ1k"sǟebßAhlǟAN?ylzPnή͝:;?ѝԪxÙv砝z`?#~Vc;ԯyfiۛVs4> stream xmW Pg%n-zIjCxEDD@"5 rUE-~ԂE^ 4Plڛ괞eg2LݳyssLM0?IJI TtΜ߁#f#l/gS³LrW M?Wj ]Æq0#݋f\cck;[PfcR;XEeZ}b5>6j#-&Iacrb2K|kJj<#/3c@̦U!I?]?.~~VϚcab,sƂ%56[BPl5b2lybs1/l1l>`f6,1[l6ñIdLʱ"7Ln`/pWL([&J0KpE SiKbqNN!CC*z߅*aE`uc?vXϱ̶Uc1b6 JTqj=gS3tAs$ 宾r[)jZ=OJE)}7"+P8qs l٠ dL֢hEQei:R Zdqgd9>D;:(6ߕkvA"|[,@Ԥك e\h) 摠2,#ЅAJiilBь&*Ϥސ$`_SY.8~FVGѳ$1z_,w-?:Ƙs00si zG;")pXES"8\05]$;ȞٖުW`&OAxwN ؐ@tؠwT%@!wAȅa c6[Nrw-;xq̏Ծ]{ wJ'ǰtS=Z[|n7:؂a6ؾ$EZ:=8n,g^pdLyw:XEt(IHz)a孊{O8Pz$Nd_Q/YR9>^ cL̐ ʭ< ʢClJO~6߈i{ zУݰZíFM`&Ph(7#} ApJ22ȁsNKXdO&}0Zn?]Iy`TO#~Di˙*4 itF|F$DQږ#>G7V *(yZZÖ]<|NB~)͌an`y}$^cOrL_f 1 F^X;"f]UgwKdF$MCxP>Ig^(]YTPoS9r*1P4|2nQ%Alylͽ``q~nC4Ԩy?6wYtlIU:sbwɞ|·BJ6 Wմ$&, 9Iq(c:ǫ犙Wͪ$.h:E ޠn:˞k.i'g+m쒤*f0YgݟϊF_9x}Y"GY"dPoNkTzjJ-׮ѯ0-b 8ISHq}E~~7 |f&Sy"RyK~;?w/^yXhb:侾`u =tZH^Kdv򗒮l}IH ^@MJ"kSl4&'4E.NQdn'bAE2fϔ{.V?N䋺zd cb-#jk0Arii'0W ˿} VAgXAV:B xN1dQR~抑WʌqS~ƌO"sendstream endobj 571 0 obj << /Filter /FlateDecode /Length 4421 >> stream x[n}W e ~ $F  NtQH&9gұ޳5U.ݳ0OϮ>ڷ͙^%9)Pg/>ૐ7_wt`tA<37g,j%S{e|yPS.ξ=>wʗv/v_5wWDsiw@~dz//Z8ZdKkVrڽz%x>?/_l7ˏ_o/-yWqwF4‚.XҜ:ּ|>|w8w;M)+Wg|޹=+VdtM6œ˞`ySLqiJn*߽kLJkiOoU j]9s~-:P>|M*k.o˂=% |)~k1$ߺ:tiF TKMjo<:Ȯ ny4RuܘW]ϸ!&a ]b#a\H\2S!bP/%tn nC%6z L{O [?3k#Y`$=f̎$22;_oWfŒo7k{c~;o0&<:OgfoEZ;3~lr9lv [fA³#~/.{8񣽊yC΂$2 a[˯jaD&^m3>~t֍ݰ Hy!ΘdISVs}#['Y;ܳ:շfь0_c1Z^M n6[6e3.ǂަk6g޲-+Oí3$n/SC":^fc{'mAZ;79;Bo؞Oٸ5C皦ˌ|u.mw\Oܲ8P 1ɷ6'a?}[>EחsD?] Sͱs's!'Ln܊슓V3>NC+Y?.SIY 7oJ## V'8*[1RÐ9-.Zo`#:ZrK 0g4>H)G޵0a<-CStamJ1U QTj⿁X\2R bЫzH-J7~%5T̈jb+Js*Vj +a#e0?5Ä?e/bafw~W߅wa]\}7wmE+cĊ,8UP ȶ%MEö²Q-:VF"4zEj,ߐN EڇutZK0Hѫ yX-YT ]B3pm,8ϔylt/G&FH`ޣ :1L},$6:<^YV_ caXQ`X+ѯ`0Os t9PF  \u1 6#%쉧]*12AL0KV\aߠ.%}'um<'B\Q-8U $@ʬ[iI8 $7$x\fAϝ$ND}E77h:Avy@kڅ)Ò0Usn $zClvMYe*)h#S( ΏlfM-97B'2kg 13\3 |?ҐMf@n|3 \ч`y2jWukkr%M%5h!ӄ)Ińs׍ w2M3]rcMcJ sqLE}4VDՄon!IIƀ"It1k* ٧FvkIF>gчq'}#gJΊ!l3a b1D!'-T5AèD6/Y,d1 T]EXGfkrEm2mnT Ӳ*$duq\'v6,ply:͖[ÉYX[=]%~j?ٲPN 0Wc`äƺP'P UFB Cz|"M]Ct, >G~D;/^"9g ?@TұxRL%~Gُk蜔s@4A.W zTI%hkuW39J 0v ]S]NY鞢}cL*k3Գʍ$ W ^IGԭ q4; #@Y&Uj aGr"]Ȉ^C"eQ{B!Gw`M^YO΍CԻQ%w7мg:L$BB"H1/3l"G WaIӧF^*k |TAu[ }h "Q:Q]v9Ԟ]DDx!9 wVD ^Rvuwihu(BBH 鮠 ҏyo\ 7 I$C) !ٷ4}m>!#@GcFۄ>T&$9J$h]ǃ` (wMv7a&fG C У.2"fA5"+.52E6RcrDi <&ǽiR u >#D&RfZ{?덫gT D8\?I@QB8> stream x]PSG&{ocHh ISTڡX`(0RG:%Mr 0M7 J. "2Qmub:>tʹtL3>{={A 1 $^QPf]m-)NGpFP)jLfD"}gێSEm{iTakپvzX#zXh׽"kѫ%¢2sl̺J9V4JtQ,y\gW!JJRs+6t2QZRvdA !-ԪU^zM}\:] fVШi=Am  &a&7nveݕb 40qǤI,+!&/*-882|n[7{{0nab %fw^S39`!xN ?՜)rڳp"]Ȯr6a+ݬ;]%Is.Dy8\u z6u=˄m'N< NwU>fM7N f0,K_~Lqx-tp؋{={^zW?G07IN0zLfң je-Lg*#htuz<T0g^ Xw(plZTck¢/s3Ob\|YsM.ϱ])]۠v7Vy Z:(o :nݜyb!907~d{mVqa3܁q;9zT<1Ӑ$3wKS S CU{=XX7ʴosQ 13C:2ATGM:` '$$~2 냦|Tzzca@rcU{GGگxxN_浢LNģ'ׂ]|0A:Ayb) bN7렗V92]Q D59қFrz&#G{ )3w__Vd,)əXcpSFu\]tq j_\V |6e?endstream endobj 573 0 obj << /Filter /FlateDecode /Length 4162 >> stream xZn}߯8/w GL`;Db,d}Ω%wGgR]u3o&|wӋۍL/6Bu i ~ (5֦[<8^:1ٸ%a7f)-<]<ߘh2%d9/tqv~uJrvs44|8Z%7[)8/Oťꏥn]Ra~ϾOwjW_*V~v'.ԸU_ݭJ ˸aKl ;f}!XŌ Rs{V drk^l!%='%c1K0I\B$[ZE1PkG(V5?P\uf]@;[Jk΂SٺէBql$ˀ{w\z[>lw8 28Vg›yJ{1|\\oŁAarx~4<>߅ĹcF<򨻺4|YG:0_QGGH8*U:s0>0 WCSEwg7_ЬC0љha'~= >zdR"eGü K|5 xcg뱿|L#㞞aٓ3&< h/B=]Z0T>-())(`SA(_[Yvso4ކX OćJU ^ʝHaס:3 щA*R$-)YT]-(7G[uC&<_.$P:0yIrEڢt%eaSBH$y@q+'řpٙڒT=s0ZIϊ4_U[Ĉl79qp: He$"Hc 5DWEU]cH8}hta~Cz,h, r` xzV$7<6 ģ) 92CS&HjHW i"0;P "PvQ !|Bȑ a)u iل| g2hlc`Yd\8` IHhVU_"p aڀg@WGT{xm` Ԥ5*O聺y@O#Ctݔi!V {$D Ɯ IE# n k~읝=nd"Bhݑ2 @xH=eAz] ]V$) D 3=A(|x, C& 2 CZ蓐"CMUIdde+V48`I=` oc%ူ!$Flp8 -YjAal:Q|]mY^(Aӑz,8D{884ge#Uf'v&yYĩi'I`_&aN- '26)57! (yh&1CdKU O gr-T%bj#|A#52 @ pkGP128 Du7Pfwpc(+,5ITS_} ׾@L*#}P=qZxzA8::#46 rla,L1\~ʢ *GgwDhXVF^FB'FrBk{dt"(ҜA0jEQu\kEQUx?t"GҳJZ+r4{5h -ix86 eq0% 9nM~o-iNu`Y{2z'j`M T0w9%!H( 6⧫>J¹/V^B_^yj_ J8M`/&O.{|9ƵuWh1M(>6hݷ ; $~u,_P~j؝D} Q}9?jB~ljr~s}L*%YX |_u+؍꧈A24-}?f_6endstream endobj 574 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 388 >> stream xcd`ab`ddp 44-H3a!,i +c nn }^=_9(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUXJ;)槤1000002Ţ^ǒ?~g~㧗)o^?f646閌bx 3^> stream xmO[HQYWֱ遹s[C|l(Z香Ng]W\-(nZB R!QPEj}> ~΃s 0a:J=<Sh1@Nm8p/XleP "" r%*_Evo*(/D T#J+t#EIPLހFʯH$R$H"Y)(DGŰ^VQ h{q69e)ԣ r 0ɾjܠ o&p WX=v5\38kE3`>OnډX~$ilX"ٛEs77[5TX w D\+Ĺ_eWa<2|m81MQ|z3x{#3v^pP[CXάDX~_ek/nSC̍/SxR/6}~:<. usIfϒ~0u\͟u3k)Ny#1Gn"{h MIҚ'TXh;lS5k~jnY endstream endobj 576 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2026 >> stream xUT TW!L5㠒Iuw ^KjHb!袀DEd=" U|Q_K#Xնvsѳiϙ3g`8 h7kRTT.ӏ&>4zHKxac{)jz%_%Vdr\Űuc͈,a,No4ϒ/SeUd̴ 4cFodda~NbެUSj֥i7;oEc1-b8,KK‚, "H, 1/)&a…Rߥ`Qµu &o-2Abd"S8֛ŗYAmO;gfְaNt7n5f*R'FXNJ d;drp-|`b˖2} 7q`@Aiw|FFww _Mdz/I072-3l-kYaN ƢI~SV+7 @ B~7j.E*K.x9%{GivɊ@ K[PQ:nvIE6;~.$Y 7XycdFDUO@Ω۲3QU7J!dEB^pE+k l!BQWPsƫ]ͺ H\hͤrL_LiʠАzTqPJ++̬@i < ?RN^VXe CrS=8Vcum6)QS/F?;l=Q"ۈ"8|\eb|̈́EXBF9e YZxØ/$[3mF})FŅ+>s.G?ufV(+%gU.7U 蕥2S$>3 W'f~ ;t9ԢOkw># ]yTJ՟RC\p`˙H)zk+u/է|$EOI!up'{Pχ2` h +P@ɹ GQ(^ v aR|VrBĈe)Gsºc> stream xS{LSW? *Coes3[\7 *(kqZy UZJy@Oyfbٌ2j5s1lfNDQ^䰸[,IN|~~ @dŲ#}(.܏[@B,,sb־RJM-$ ^V"GHU(>wVa"Izr$07_yJUQY$D Rvbm@w)qxw\A!D_w4"&(K7f>YE*j32}),֋(h1X%ݻ"9Qf\fӭW^py"TߡӈB!+| +rjp<0z#ݚ8yhU2*G*LJqw=>G3<( X7W4h豋Fa$SW+vWkOCƸTlOU~tQ8B\&8ڴ*ڙzsHo_=Zyd;S99ͦl諻-W ēa)d0rOJi^}\k{/XyT ST)!Q`bTXfzIv~EW)0(/We8GK<\tOAA5t$sj_Cg [aw@Zz$<(K0,^H|+Ρ@z&z[o8̓44R=%^JUֱ oebxIAb֧]nu=v=`W&sk\),d[4蠎`yFWq8 MFYXWɚpEP7hb4Yua8.+PvD9h0BїjD^) ~@eu$teGĥ/.'xe̴1Шo7>Ѽo[2S?uYZ ߖ~ IS+!Sb4 y "L'9KJq& pvl\kқi5b#g0-Q'7K+ G+OxO3j㛉٥#Nj||ˆQ5y-ê+Lh% (8'&ϮoAgğy;wYBAm^g/>wѢAϡm;a|~61XmPACAdxendstream endobj 578 0 obj << /Filter /FlateDecode /Length 1725 >> stream xYKoG9B%ޡmDHȆػ<_y~m"q@>g ^|OናD')+]L!+)Ji.IChZRet\\$^2p58/~{MaJ_UODJÕkr+ac錞%`U9' ;ـ?>'?}؋?jӕRZ.͂I2ru8V/}WNV#2XAK,\ boX-ke<{3VPd gEؒBx(@KF,9),--S~[&*.2I(Koۈ QBp)Eè+Vސx`UJ UΔJ J]uM6}jVsT!WA@[p\ɀҺJVڢ9elE0t±8>N++t5Uɭ3hLgZ*ZWFEvDzVtFJ!RJnueC*^VFg-'{։:lKIߐb+v%{lQ9H9mi#zڀ\7t:5=nXhOgؖ @ƭ{ȕTXiE?)Vr{ ~<Y>L'XW |o2J]!:?(\'P1="\y/>k|d?0;nno{d/}?C8'6r c!k`g T]j YE8 ³Ij^n3j_=!Eup<ŭ] .f_2Z!W97;…+>iA>ː4V ߌujЌ* flqP _R2Cݒ=< xyn(iy FD0d*>gFeN3|_q֨x8мYיj>킌83~G5t $PDzQ)A>gg, [Zzg g݃%hIk.cjY?n pq?&*#2EpJ窎,;^NbFphiX@2˰dh 7ԬRwZq$1\ GC2"<ֹ5EC5N+Q36 '$̈́z㾋r {$G188޿w8ֺ3wYstl>ydϑ9P!?<'YHy'ʵJT7K]o| 7n4aK#dl[j5"6ĉGm%N\;RxA Pt( _2. xBiRq=* >PÂ~,Ǹc>y<@4!O8<ˌqՇs> stream xcd`ab`dddw441-H3a!ܝbVY~'U;㧬܏yyXV~?!H{>fFʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17U`=土[PZZZh go3 ySz&vO9r{%&vtvsԷ46On*c?77utJ6Oj3q_قSM^wT\gXp.}7endstream endobj 580 0 obj << /Filter /FlateDecode /Length 171050 >> stream xM-6_Q$3LyRIrw˭n7Zk2S;2G0W]W??̟5 ?ϧk?@8W5?? >_Cu)r^y}_tLJ?ǯ?y?/y=F~uǿ˔Jubkw:g49oӟ/cr*O.G=?GJ4s:_l8g_ONiTԢ}]0(qĨmPyS0k;cL~Ɇ?}ɳ}󫝽:k)G-^#~w\tʯ<ʸ_On:gu_&n^7h{ǰhɷ98T Z/GO}ܣ2~/hcrn /IO:Dӟ&Js[%FۚѼFoszv9mnE>ܯ-iF3?3ǽhGѼ}s#ne'9j!꣑7 Ct'?|\|5t]U:1}lx:Wo*_?80aj~לD|kụ͹Q/!nhnti\W#B{NWHsi_gj s]'5؅KO`c4lJ3ݓeqlŠȣuzW ƜfL%eb]]q}>'f2sU[+\κ=5nSS*kF52Oٟ* zoJ9WfOacsks(75]GMijbkΝj 7 ^*^jxv3_$]v/M>t-6fs<9:sl=\bo; :eς%c7GZLdq[9m?sNns{ꘜ >hto]8$ @2͎/v/,4uF}6>f[\F|vMT.ǔG>\FM s!f*p=MmMumNo؜&CU4c.S>0 L %jl \\4oT!tjZ W*=՝9WzS88TrwP`lZMUfa'2>8KƭoΆ{uIٞgЯ79?\X!~̖!.koc۝17 b9]sk|p; >\NQks~.9JSsI;#9Mk>|jЦub: `| ~p3.)L7ϙ81]z77KUS!l0Pl`eZtÇJ-aǜ,{P5Aҋs=ЊmvΔTʺ0Z֘1HCoMz`1Nsd$[;2pG]Xˉ0qIbB:UYVPr 817N$k,c_-1X x~[3GbqWM0*<]^gXA0&噛xxN^܄LC! [}m>n]<}{9nRiB)3t gӥpB/UfsR|% V:5W9kR|=)؍/3Ks+ИCe:5~SZz\xV[%7/B#-8pYkEqbC~'A 4䉹)D%)q_H jۍ}y\&.bo[@ V3\& c8ćhFB N NPs~yt8+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繦C ˪z<*T'Y],`[6uWivL?橎S1ub*M?Lu=i$=Q C #q C>ǒ?pFҰ“AZ™]TvǩM{H47Hs姓(tSPy>^S#pFuڻ*mW G*N!# 9,~G~Uڔa>Dq"J}ǽXJ8RՆ{ )\ S%V;yph6MH}w8qXtgTiEp"\V G* rkJwM[_ G;P-p/-E8R8G*Zgi0x\gT0`BY{U/Lv| Y'Γ9BC½~#Q]Rb/$ &u$gT8b _nX" Hò_Q6٩_d\QM7rNGI``\GI<55tp4qҡЏw3lx[|JyvqKan|&a(Rґsσ&mUֵt&uMt([;*O:R~,"h+=a1є3)uJt`]l~}xm1ƗO;D%./XX|Hte@L7:6^Sg]ƱqC$M֩ѵ[1:"VBuuޤ8DuT;x=+a(Α)w#w+ΑNNqw1qjtiyRUzo]kI3Oשɧk !LegDo{]b{q C"ēbE#,V3zH8.|JLǠO*:h?uCј[T8<3 }*4σa&:1i͖{.NWcҜa|ǤvpʘB;I]|;ib8D| S7U@gn8Xv|4/<6AsLLo㠹k*V!=lgřSO-!B,g""H4sE4s\W8nW&x[\8Ԩ'? 8_XgUQdEQcMa!4jMÀvX$DėjqLb,V)Ex<ъA󈳹7.p7WjlPQN ,)p  \yG/9!Dx;B" ;HBM r䖭Oa)p>v؊-_Ko eG^gs=_p-<+`K+p ]3ci 2 )Lˆ1َX-|-Lf*zEzđO>6ߌ Lq[wv*:8-g&eWgĐ잫T܇M"d;uƴp^xXR s5a""#Z Z1GՆi7E_VFoc 벘٢hf/`߄*MFɕD½~%f⤊4rݘsp/;T'>w9Ն{ATӝ>U^?Vw.@jHeY99}LT g->Τǹ>%}½ks7p/'\6۩6KZ?gxd=G*_;ΨnUzT]R{t goIo"^?ƒ=iVc?pԨ Hm H7H p:C/94MnDTRzHu~CTԯQY'1GoNǚA;oٺ1d)ҙt_`vLZw)oΰYw/FYۼӃ'읞zSߜӃƪٲsH(2#?Ma.R''' zpK\v1Fq*H39C,Yvy~291"iYgwÔ&{N+'jCFbTv@bhht{6/]I }Ft4K6o496o9#QܧpK.QF)C=(Pi~hD";SGڽA5.CIQQ:\gơowQetDPgY7,MXb=>2./{'W|Ä2Je*oxfy'' GS|v:VOAͯ0'[׳_}]~m`C]n3- pXV%,'6\-'6Ž/;sre14&'6} E[8tݙ;qʅ^{ ?/wGm 0ISxI6U~dwc>kḶ2.gmvzd깕\f*"^LUZ6CQˉm\"e.ه`~gs"b=Z$usQځ;| ia=ift)Otf*#ψ\1pª`6 pk<-L`9167ϥbdZ]iVX|=K8fDw [;wD"p;*nG ;}}{bC`eL'4Ń9'8s(ZLlpd,q%6Pu% ,m ֖3]܅9.a53,\fRr~3Gi7Bsjgbrꑳn$c˫3 Wʝϡ,4&Ev-c8qm^MNz(՟<]\>UswljfasR^-Êe Rt9fjҫ909`ҷ3Xy5N΃Kp'vĚ]RMVҷЛD=X.偽Hu*\>7K]) Rˏ3^a{)lX5jÑV9TwÚ|QFfxN;ƫTTrE`#Syty\gNx۩PDEZ{m׏q$^un/횷^Lnbs;#c>W- Dl*_[@qotǑ[M!׎#Ձ5Jk츗N8ws.4F#Ս)jýt/BgG*Y?pj*]|,$s'3* TEsz{Ip׏$*E*&QL_#P|[tCC ֠ӛp&VµjJ+ZpF`Yr~Lj J8 >wKaXG*x=|68G -2qZ7c=PRəB-; U+_ ss]L<<0-Zt [!SY`V=rvpoЅ˓z͓pnyoònw'uC3wN\ ۹9V,#fbdUOm9nw`Ff}~uOj r'an<Ϛl>@>U >ΏY&$B ND׹YBNfDDۼ )̓eŠWn6;8̜̾ iw-).bhwFrcYiyp샲 λY'}PO?m5#-Wx%h堄\ > 1~sh;Vό[LBl݋G+S5;+ %rǷ%.5[-!>+Y9CQi2ƚq,ytxs^[  ӹf$O)!yň:d25:~$O{U%95ʯi P=#QWx%zjR}h3O'R L}2*Y޹';wnXr JN])!ey=rPö\@W]tn~:h> ɣjBeN!{l-Ze7f2d;'0!ЫR]M0%wֽPȱj.Y5]\d.ȗFTufJW=)]zr@mɓS'mAvai,Or>6ES6h/v;2t~S*4H^eG]VJVaSgi{whទflqtK^)L N܍s3+mK>|oJ9Ԓ->2-X2 7-|. i%voԒ) ws33ݵcsÔݑҋ+K_[)-wk)(cK$&LJgZ[ymNm\Nzd'i'RR4*16vʒvP6`7v.1+ˮؕO3m{Mh]=h4;*C!HIlX)UDZ(˾Hu2ϖ8QF sw;-i:wk^Z5<8P=;8R; G.cyǑֆ47JZF_g-޷D}V G*i츗x]Lv-{G6sZzg$+uǽ\G*ݧ"tpǽ~ 2R|Ŝ E0^z6ij(<׊^qFB|Ԉ-qF5#թq#WHUQJͤ'FH *,O Ho8qIVr?Q G*qR~|+ )jt25hkN8R=sxwi08RDA^Ryxz;C~'\83_:, PTR4sJY{\GgUG*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ơ̇̄ hp5C5=^5NyysȈe"Btzf|19lC^-"W|]F_&Ќ6K[p|>6`-Hxh(b3<~=bAV-$Ohf ^Si G`9si$[ lk56X}㷞 5^m5plHi[7uƶ/Ea.n~9Jû"vd';Lt?;ΨgIEPW֎3U1w#j R8 WjÑ-!`;M5fo;*&bzVNȖKG^N$#)+3Qժ3uj<ȕgB^3FvKP gߔaCx\$uRI6ED9؞ua;Qzli~*;{A* kȟ5Uۛ Kd7voA6D? J(t+er񒭤@k>8ya3{hc%E<8w-I} }/UJ/Yc*0%;+DEK#*`㌊n5^}Rfk?O{^+qǑ*d&Ǝ{i&[}P-]vǑJXIBqF=xeYć(up5qA8R5U.n׏QdQ(nT4p/{ξE(;T],g׎{AT~j3 U=oTT~I5:\;Ω<'h,f5QJR^RA3{TeÑ!֎{i[\x4ŎRaG8G7qV#S‘Yaㆲwp8.z 1+3+XA.a]>'(TWΥ8)TjeY{4֕w.z2w[%@0YxV-ex]kq/i.ϵ7㌊ hhhpi,>j/tl{qf̸n go'g_+q`/pB+3*p׎9nb‘RD7tYFHqfq[e8q^mkDY p,gLzj/{X @>k>o>~0?j+LpEJN̅ROEAZ9qB"j+,DrD&Lr'o)'_/_#7u\uqOީ7ɿ>??V?O'ڟϯO//2? ɣA,4sXmN={D1XhEefr,",}f\DYwx S'Y;@X51v,"<]%ΐEJmS lMrKCU!*aUPڢPa4HƠZhB00!…t[/1`Szu|` k#4+)):+B獊l$pϟ+ZE8GzY_41q vE[>-8&!jՄ%Sa7W[&H$f170L(LdL~E[ . $w9YR+0%5ANB2'xZ)&(A  -cEWTZppXm|$ CY76Lp .ۡ9_zCg:/ XU%Jz@6nGhiX8 .[bjd|٤LRqS%zKCt >aBoqea!cI&s]0"[t4+0$>', 6Jb^',0(t0aE1 |¥p 9l"R,^M7 &cÒkPYTg [XP037!MAa2ZDq+1Þ2*l2B#b0`DpWEAr;45JJgn曹0;cPY9nQEa'A}Qgiű I($epuuCaʋ.k`WX,Q|$.iKn~[ו o <}L fZD0l}0X;Qȯt̍s7;AVr[i=(N*O] Bā)&%d a!1{aogLSFG&]ZeBpBRWKa!qaYgԉcA LK b%9DE dZNG!uV0OYLH>͂0@jG(BH1{ZQҽWTu/aKn^qD1W+1-ưŀ@j,.{4ۯ `ބ z yMZ np <-W7! AR;`bm|[AP2&ng:XQuV[}Pq' -90ܟ*ש:Lք@K.HRv}F!&bʡO2y4ݝ odF=4Ghca`Ն%EPa63%KWbX" "* d |1E&N2:Z+kR/R(9NWTYa,ZU2, ^f S1] p l03bu°DoI|2n 2,^TP0H ,Ն%EPaƣUi!T,g?eL钌EqsinELDC! :U 5 d-'K*뜿nR;ŝBzk͝$A<'2_yqP^ Se*īPd LcF)X)q0Xm a#9e~a0AaR^P;΄<^業Փ@p<80Ko5! NRq +|Ԯ#xx_vCkۉ ŬCœ,8y6ۑRI~HSl.F]N~=d0x}5&K*86W)Al:TCۉ6"(LC#oڱ0*+M"i;)dcY;?R@pFĕ6:h68h:h 3Au8穲86f'/ . <[yz~ w::aEmz0+:0@9ѡHTçmy ҜY< f AR;ښ+tr׮xøfo>2-k.{ SF jA %Bnx|`7Pa gn'NE!}91P6m+K p)o/rLi;)W2#N`5' SyLh9{)l[[ ;al@K a~+;}Uqɟ@={Ae5`GH(L`LF s5|:iv[SڷBq싃l|* ?BE!)f3U]q!e`Y^ }X/9B򃠰aQUܛdlg6FBx5Cv # Lxoj e4{/tbaJ L`ֽ0N XɏO8VžD @ s pmnB0p!et{/Q4ӵf0ulNJu4b V|06uԂ%BPaez=^R%ùK4 +`3S>)EppEmap;8tc6,)¤ [? UV+an&2GDR ^1aš3>e!XsHl=7zB%Wۆ뱑P9{Ξ) 'W[=qn`BX ?BEaB Ӄ[Ee~ | /)T }3w"8YMt1pXMt;OΜg_-L=X2, 콐϶;i0 U$syb1nқ(&1a^l#i{Ad,~vMz*Ր%XD.10{_%Y=_q7 $ڏMx)X\ B\nBrLפ }2p6ECbq3'P|+~bLAOp`ڰ9GEt 9Upå 28t`EFeO` *r]>LLcAՆ%EPa뇾ۣ<y DUFa[ flũp1cc qYmRI~AQtRiҲs)=w6,Wd0yY`2ĂV|pK'p p*4,R#D+hoT?# gS* 08Zp{)\JCo"OV,0OU!KT]oٝdMrxJ?^\ܫRRN9M|V-[V`-c7E buPЮ88\Jq46 bQa)d 4S՜\0u P=V- "sGaKp :uha^+a*3c&f튱Z #Xvbచ ,`P!U.?@aY*j,PPq5$z]ZXW&PX1hѭ|d l8B~a #"5r BL<. e4`t]g-wߺ`bB9nI10`O3>BpqpV st9_m&EPaE=ZU|Qc7 ;L`ExAr']7]`Aq`闬,.~MWqhkV`p􅩶9N&SӖ N2hU*ZnIMwފXp}U@wu.0M8g-vPeN28 ^pjahFÉR0\a5wy %\֢MçY'a |„pl"_3#}u]-ۇZ~aPվ`PU9'(A3T #:Yw1 tGePKQB}eC 2'/یj#ST.El¦0:.:&h`Xet[/AVRTJ0a|up2Kt2+0n+10XM aP1cт@"[dUXc+a4aEZiDWݛ0 DM]fQ`.>k6NNRc]ڟfVQad]\$rNAO Cwb$S`|U>oݶ0,3ż_&;Z)=7l1 0.lL0m0̠_MB i ^Xp / g/KÒihT q1p0*8Ho&і N2:^?ZYYzcP _Q@_әibݵ02BW )\Fg"*8-d~Oµ=޿*,MaVX;bH VVTa9VS 28l]XW{t`N- 2\FWÍ[Et>7`' SXfq@3!ONR:kk"QAY=WqMS1.w,9+==ZBB8E){/,Q/TJNrUPJqVy'Y|qpXm 4>4܆)I~=,TJt%Q~0?;W+/; /}Pi5]mTK^R8K~Qc1Sjۑ)d\H ufA#Ia!qa;äb5C$+Lc_^c,YW| ׶Ta!cI.s qV{a\163$[|qp8ⅹ̭lf! tꇕ3xVzaN@_gHK5濃W- j¨p(Dڛ8,Z|.1{vIElSUVNMS;s1jPY88\-gaT>8('Lp)$0\%._ PqqӬ!e ֵA7X "J3_т`>a"8N$4DW4*U5؊b(\s5uIXеMjO8*Ն`>aR8Em~/+x,0TUM%J\J(.X 3]'L p)uLTסi5^Q3 [7E5Elj 1RMf"(\j r갂 fWbǤquH;穊9ՙVMaaxRY * V $ϟ[ *kҴxˋ5hg[\4tt>'==nSaS [`G&bp;aqp%Ǡt Z*?#<;-=]' AD)kr.CnB['r2WW$ MLF=R-%+qZ1h V|1rk8@'In.=oɌ+,S#jMk)~XQg&8G c-a.iM'Wpk`KD>և+S*:covѽۍNp=* ^P<0\A(&L p B6sG}yU JSfg ^w986;ٱE¤t{?d.(J+N%)bx q/ wApW?}4`A94B(^|CB(sỳ\JX#!( o ֟l &3,,ٻcrŊ0 6f͖gE|A' s+W Q[Dd 콰LSE2ʻ0RW+v*BW,c*2L9ՄLՆ`!!d [/Lw*:cQU\Tz {BrڴޮܙpLѕ@Ρ3~!I!qa^3 9I*cqʉӡupF;yA]+'h@!(\Dg`Ũ#,POE(֔8y1 Hs8]PXhFBs 8PT&Rل:݊;xx8䬖). %E4 P_mTiI Q,)V@5BP>DطNs(\<|3oUCE] > xT0OAa2j(%0]ߢ~[b< h-_0Y'1«jWK'pǫq[9j̛|[aA[u բcTV?AaRҦunOA] J!Ynˊ sYٶ`Bg.̡ Ρv@ѽT{H!qVUV<2&`к;(d=%VeaCX؂šކa5H&epa*Bi %|s:Q*t Eʼn?s  fg`GȰ((z>wAz0V`\_<v-iǣ{+ j A1,\9̊0EVaNR: "U .X7?v88 "~m4s[-)¥t[?xdMP|%Lu,Ne)T&88\':lΡ(aUt)"v߭114'v)(&`-LzqCf |BB ^-a*ioMڞTyU"Pz0{X1Zh^4d0ЮvĘo3%qʕ(N)w="0ma~u8 |¤p 9:R/#gDȬeqȼf\`6| 0Nm.EPaGЛ]WSƂMgDJP(J{1p`3q& 6!BDgAՁNN2ImaNթ;n925`TiCEt!f3ma '(B p)09UcnMz'R'q1(,q0S%8T6 )¤ [?,XM_S-0r"ß ^aBbqpxT LDq06 "(\J"u]'m \]CSIʠVo)x.(T)8lm ܺB8T̺ka0ʇG9('Rs2f׆-|VL0:((E88|Eǜr5J_jr$Qa!ؽ`Iytﭭ³P-CL#QŰ88|{^j`tגsq İ ¥t[?!snۧI:([o8 [kth.Bv ^74ՆlCR, 9lAR^T<:3XIu7;O!(֐0la86~H)¥t[?_eYFE-[~ϋBV=p ]& 080̃o{Fֶ<2[Rv[sd s C 7a0 @.[,ܢ5sKu !!J]L'^5N^40u|&MB p)+z:NSM ,(@KkPGPLpSf(-3A#I.sa9'wi|a:k#N+jc@$3KM77#֙^w3vښ8 ̤U)\J?~If!GƣۏΪ~]Ao]qՀYYϟ/L: In.=onJS{e Ck<`C%{^N0?eq@<nC00)¥t[?aG.xCyۥ='S8\c÷rXxcaGH(LCnAΛ^ |nQ.@Pnҝo 09lF !\FgJ"N{J"-=ƒOD`ZA SPE :0۰vas1@kKMv .1zh,Ӽg cYBfC^*E@ޭ@\Ǜw%l]l2j17m |8[5+"hE0]3~*8h 08SŝDp 8읐r*k Jn tJ]6(,9<"Lf,-7!: !qza+́2ź"0a#W( s{|@@ ?uD@8cM%誇ʊu A CB4Š꒡hJHBEi^h(^ႺgaIMe,>Vʘ).C =B!K.Xd45.\1e.yC\ɛoWsDN&LOzvex-rm\0S9Nucpe2*} XUGTh.[7\V9 U]6L0) ~xS:H| ! #5ߨn \=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'=o B%dW\dҶԆ`>aR~{Z9+cMłM8 )RƾWp`͒F%Sa뇼f'N{*QjId6`ãxh'jOF)A4ѼB&1{a65Fcf$2lx/HZZ?[~ý5 #M#8 DI!qa +5rXT )u[ޚʤ7r~R];l&A4K!R4p*.? jdV %0U}+⌻td鯚bR%<7GV8@V-R~h;CnTƜP軩 4;NUPࢨj, dŁΧ6YNR:V[ 0(SlE?*\W߼"19i޿EmZ0pM|u+Ex[5ppdd+wlWF C=Swad$]dD]mx%QaPsoA<p- 2rL qHDq`v% >! \hÇa0@2.[/ +0:+GEsPrNОiNN$(:ewU4B.9¥t{?,[:9-a5/FKd(ȹ8bXN":SYs_K Ky@i/Λ?Ñ COcڤ& !…4{/,@Mx-LU䥸O⑻ʪJdUmTh-01@;Ď ?BER;êu=7vM,#WޙQTnu>0/!(\Dg3I_cDRHi@ac Np \$0GmQp) #WY0˟U4G  R퍠hXjO8`anZe نX&epaE[tW̑ 1 :v/o(fq,7 Y)8,|I.sa?_Վ #}4PWQ$B -o+}g ^~aF`R؃Sp 9lбzj Pdn(K+0#+OMsPe&'@ Cza`\ yY #\ 0ktR2=ކKA*-s}=p'2{~J|-@n.ޤ,q8U ޱ$K8?&jT(߽ŒXT$O͈tk쪀s-Rn,14szo5ouMR<kGKgOI3(G'h)wi\3Bʝ]?' )xH*a(Q a FL DYBoxL/\o-e+lDFå =nvBOߟ"-L&de7D% ]JWNkL)mw]wTjJ 4Mi !3ӑ Qu(6 KH<dR~sZ(PqsGp+*k8}u(!v)c9{qOpL ޥ'@Nn lQ a&'.M51)n?9joM?񌯯ė FKE ,2Ky&@ODR*M}=2Y=̧9-@-A0H.-,2F!H v$;' 2PPp|cUbTr-}AmUi؋V>v(l(#eY~(-e;p^wQjʲ`e!XޘTcB>"-e",f6r$o) MRp)2o@ZL9Y9"ӂy n/!S! >s1:.:vrW)޺1c<$GS5 ع;-sa9|mۑ;8xۏ Rq{]H{rK-mq c0s8"s|Pyp mDS+)nO>y8״["d 2}?iJ~2¦(2}Q4:[lPmˤ9"}M c1,.|!F1ǦF1,2J!PQ@7knu:D}1_:xy 2ktŮ ,;u&V OfG.S~{;b(ˇvVԠ_"Q>$di(C'$55;ݸx5Δ>~5Bgi@V7-S:p|FXfY7 f)kGԕ/X$Mo+5Eoi|:Mҿ>wxğl(5~OD;x,}OẎ*˻]KUD!ǣ|x<42]! ÿYX:#ؘ_gX|L[ Eq,Nn ;fiBs;e Yx;qOz>.mq/WdYN-p/,TͿ_0`>,b6!"gBxfu#Q ^*$@f/%24pX&ŗ,!y#7^xP-9j X/mZRq"$0nl `B6hH"V5ׇv&bن7Ѫ#ŗ>x$Sw,=Hz{cLl:iB<\&NG/fi(a3rvdd4 ,{N3exJ$DgA>EZ(DXOX/RVx&1[7!H4huZ6Tɇd=#P#X74ޘQp'6!kM}΂npB}j*?_;<^9u|r 5}MSʊ1eXU/ J4CeDZ8H#̳`EƂ~u,f 0+ mcT#Ũߐ:lH +])ِp\PŐ,շ2D)E.Y 6!,^4ʴ˚)ߦrJI"�|%ei(C\]Zōִ bU#-dǎeT |?7"SjCQNeb:#ɑgD1v'Nq\)ڳ+g/@+b6j.ہd `e a.my΅&Q鄚LqIɸ[e}Yn,E:1@rA#DZ8H#̳MאX,5io+ԛN vSŏDHP lf 6}tfpBX@!ppcx[t:qRHq+7i.v踹y`dy:Z%/!Hȳ''9JٯQLeb;i{QbГߟDJn ly7#V4>wr8Gyq$^',p)M` I|38p4Y \eWf "YnA#EZ(DXfQ7)78Jyl; 2<֌';0{I?Ű-2~hyu\,V!x`{<*zʱIzY,j^oE!yp \.6 l 0B xn:&>A88BsH4Z5S' .NnSDMoH;&ߟ ,ldۻkKÊHˊr΂hΈf %dž/RvIci`*,4f2BGq-ӏ/Y_p<@dTFe`wH;f8()M1? ?}>Rш{PdnQX[ohtk2@ ki"48yTh(r 1S@gQXjndǦ|@FAvP HI/-X5ѯ<o|r9g층4;N 1H"$iW:RIf6VB@Y>$ǼEYj ue60ۙ&+NK/ AY[) 4 xOߟ )Z0P >:VP\DkAX˝,خ$;E*oDoمd`e a)Oq 'qviF:ޓ?{uuY[,"( =`t@-!;I#bx9ߝdU׃7~Gǘ>ptL ߰lM|05z تp@!)XOd=nuR1i:j8H'.KxC[ht4Z"1X$RiR%#deBL!M$ ϣxXa Cu,WʧN=iT%sO : ГIz2 8[8FPdž8Ĥ8[!zld2`VEP "]c"&^:sG/ʍiɞYv.=:y(ro B aM,sxckt J)[8$NI'hp"kgKWi02)wբձ.vWg i B'' ?$N)0Ӵh$ťADfAR5E{CS w%My9nxZ8ZS5Gԡ3%rm oOgJd4~?Id4ɋkO#`ԠF1p7,di1"-|BHySDS a(ߟ,e!,oD #R5Lff͋;67d&lDg/(BQ&2>ٟC=n}Sqʁϋ7Ē,ndq .,3iL|tOÌ"-y2}CYR4smB`@77bQB! `C^s42|E%jlY\INDHP2[*j-Ttѝ̖AAa'ގf۸ xaKuPD2Ҳdd"\լr;GW(l(CgOOJ2[W}c[8Bq,԰& D]= Dz½(*[8F#,*{!49Js*GZSdzJp>=-Y Q%Jc$tlL"cwVI+;b5Ku*jd(?EZ8J!Pf%3N˚&RwHtl <6ozxʛ[uYԦGQ[G/'z}قŅ`;i6!rAQ;oCe*.{,KsŊuw*(Np'|I: "-yhn"?MYq}ZKǘ~- d`]"| t墫.4< =̃}\tX#޴u"OPYx^IP3RY͕g )ǠH huC;޴',5;;l'ypq)u?)j*-:i3&1ؒQlE(#OqFoܼ-7fĦ0T_682#1L:&`L35rA.C(Xf +oMYo\Uj-ŗ=Ȫ0ñ%5'<:nz VTWkQ\%7HDd}(]- eZD~b(l! a+͸KbTp;zo7\%#%\`a_%fI΋u= ǧKy:Q$vOQG (';n$0uLYl",&Qh@%]| %ic42lO2PplPl$x5_6gK Q9cFlю8~.__)DGRd A2}`4dO/  l ΂`|j.n:)@rIsEBFH}Pj2! ٧CBy_+G4)pIM߼3}dU >0Kgxۅd `e `lڋGiAE|z=6q'9{b.q?]c,X[/b@vI"Dp+"-y6:v}-RH+]X(fFQ:rM &aְ 46%f -:#Mu~1iC%}(Qa7I>u5'ےc5J? ^}dd AnvB>(c4: `4A崳^[_mAkUB$Lͮ$$#DT/ߟ! c,EWbyJ d=z/Y)e~ͱR֑G)v];Q.(*[8H!, d\r$I O?1h|iclʱ:_A-S М=N &Mc?b\r!#DY0BXfy"bu5C=8؛2H,>Y)M9 .1A6: H߭C#0ka,M4̝J!vA<:?Ԛ&6&\zN.ܣEIujßjDK=!eod {/{Ƅ >0B> %2(PXf MXc \ϋO[^tKrAZ5R)դar!`9LEa G)u|b4*ךѡFrV.Q6-OdDdi WD.$cb(زfl[AE[$^M}pcߍFr\\Ef5[ mB,2Fv\BLUac,Jrd #%H'gY.4R>MN[.BcPezn@o+R؛r"_eeMF+rB\ jNW |T(g܎$9󨪈: 4q%T7I{۴ye::?  I cŗ× :f|; #]}9EO9J\$S*F@_ c,P#eaU,ne;ԲJ0Z-6uDzk.v:5@\ݓ !-Y:3A7[`$w6U(Cl)/l^&ͽ)U5iwW.*KnQ(i{|Ami:rqAm`Z,2+qldJ&;7Ӟ`HR9[-l!XfڏB|HIcH E]S&JGgȸC ˍ|Yt\B*98:Ɓz6[P#B!D.2F\Y@ meYNb\>]jO"ՎExvEN)B0H.2[8F!\'zSzMp>)GU"!e`mtqeQ,,uqt da2?&FspJWIQŠ #BZ(d,3nR855nB8nc(?EZ(DX桼"MB A\OĹ'PD$:K* `7bz ,iKhҐGTs2+ǧ)5l[f吇d `-x+˰F>Td)b2T M9qP\PD"bHhuJ!ϤM"A_uD?IdqJBd)H ien{5K=Pݩ%kAfe5f d.4B}A#EZ(DXSp{ ^E_sWv4\[MlhV)F@Q>$c( Ec)΄ P>)c΂Ȳ(N,j1BcAY[ Vqah.E'(JYOh((񘇎QOa*\!iȘݧJ_VEẁ"RAHo?іOO&jJNܡ| >gfj)0U_o2\I~E+-đ)w槂$@r-Y0HҴc=7kx9]5wtFdZ>h2[Xeb' Ӏ /}4* YdBX硔ǍS-padہ_pf/Lߨ/dXt fl W2,/q'Jm7iy$:ųxqZţ,ZjBLϤbjX>IFa[<"oƲ=R[8'co,"1xvA Qa6^W+/RCJ(f%Vt'{ʤO]7pa6}P~* [dBX!"8/IZd ` R]L4z"`ZS!XAj!R"-e",Ѓ`m;)0 $N_̉ߘ?'<,Pe}Yp[rh9iN&-#6$џ2xZIi' xa'|y4TA1`E\̚yF@sHx^~\]5YR);4]JGEGFa G)u|~)JcW@)N ,>n;CqJ=$+ +$tBh`(ߟ) [8J#, @oL hRdt':9)2܍𔇮JM-k˿?v|@W SJ=ҫ_-1n1[HI$^;&@$=]HVwQ 2Yd"p0Du-[F:hwIEsàh.ҰP4J,e')PXgo⭷F}Sju%H lROI}P~*pFXz$"]bi5$efJ~y=hJO2Bt%}RqPހG3wFa Gie| ;YCgW~=ȋJL]4*cvFa Give\x%<3H "oj!v$Ѭmq\"T! Xo(}X?,e"g`׌o ~FԂ:2X\c OSLiGp e xxh!_loc {"|4 .9 cⵢEF)uZcaa.Ь`X}xoSHwl1"H]sReTi |ޓŮ! ܄Mxd}⋤,;\85C\di AG#23PCOI7kU큌7QGr t-OIGS@‹rADZ(H,]u\_S~uq!zPx>BD(Zx 2-rP]\S+ ̯~\7iH~cP-:j 7Y|t#WpFX=߬Q7xjՄ8NQ_EPu=JQ s cȜxcġP|Pcf)lܒ[k~g)郚CF09}}Ea G)u|\C=?֢:q/!hMQi{;ҐɭƳum⻵m#i0|_YVn<AH9IKYYEE%#XBi\̶5B$Ѝee*pBX!ƜM߸S]Rq+Ӕkh_/ѡƩ [0G,b `de BV TLLQg(`eNj%2eAB0oe!|b(QaGfEyo;jxy)O_ F/˗XKËDvŵgbHheΨ ( eVR_֦Kz']aG!pV>,2J!PpGk0[؊w97;EE{(t;:Dlq]JBUhI0 OR,T4HÜIìxnQlFrVA?#L"c>fߟ"-73q6t&BP:sB$lE_'+8_ ;eO>Y|mFLOjT;'(ʂQ2Ң9vUGQÎMDu)9~`,nV$BޚnJA>EZ(DXZ/2A4B<%ٖ뺨QlܔMp/D܋AbLe"mt(4̑E`lfQ0,HCWJˌ `42RѵmC4d SLq1#+5b?!C2R)EY0DX#$j|՚fOJ g2c@k;Y$cM@C.,c,㄰BM4nvp氧Lx,x8EZSʂn2|`5xU:VB(C\Hs΄Dj /h͌/q 9Vxѓ?M#[q}M>(c4:>IvRǝ'߯M玃'ћS-`F: )ߔȀbKԜecQq l3EyWewiJSB@߅G1OEa GieyԨ19ﰡa{{Tll+_Y1,_SpdVH me\ji{Iԍ9x>!pܞh{ߟ9вLN:&pϚ\sGK:u|!_GeF")|ZZuB|i;Yw}P`(42eQtUjv6elD=Rʱ>,=;!H&Z2kA#EZ(DX@74" ݿ j޴.zk3 }Wi9H Gieڪ#hfO.]!\jFev,k+:+ ψr1n4< -Y}"5ȸAХdG9E8%$]򭔸ҜxM$Ivq"H Gie%}FѸ 16˸]EeFQ]|%DyinE A)})f Emuj 6bc(i.ztJW˸Xwf\JVӦ- &dkx‰p"-y_ {*&*n|Rt|5Gl0B% pDK쨒9ՔYLt(eŁBLOib=B"OE2y1}pW8m'\r +-7 |`57П!#EY8n#,ILc?E-\u;̓bouO&JÊh[nr2}4|I_-߬i\ŋؖU0JOu\X|f́LBn.wvĐ1Ym8ԳÚx5 ]j{Ri (0P4F7s @Q'2 ]A+$H-'5km x_/5\FcIB"\02P ̂KB˨15g+ cÎǓDn͡pav(BQ&:7aĿYsqpwnH/ (EP~쓅i- &-N?(l(΃mpm7k/ƅDi9,eq!)=J aVtUQ":牔K6K- {hq`2;'aقBŚ8E# qˇd`i(ax ԰HUP m2߳EpHY [hQ'~Z;2P L yж4 /E z]W i"|%5@W pH M6be&cH huaؚ;6 em't->Bϱ@E ,!T#\'C2cG teA4Pፅ%"$j;V":ES,8We -crA#DZ8H#̳{Yٲ=Yy'`;GoE:YhBLOi:o-!Drd|P~*P̃s;joĞ!}~%X}?~wWbg!Xq90O` (ugE%Jyc (SNZʨc!kY!@!XtxUc #]&| dA`RZ9P4qx\3+,bZupɇE0P+ !-b",Pr*é!#piXgZodn#elBHt0+X>2 YdBX!꿓1CwV!Z\ H*cR=p ,C#5k֣8UģtNn˙#V҅2sd1 `o:C{ Rvx-2tnCl\hi5 , M4C#/A##PЉLBhJݷBytɗJZN$$R`}!e+ Иܙ.3[8H!,PT8ˤ--D0qL}5SlӧbCi.^ .s>'s 2w%B n0@utW\eb5*o [[)z'd1PF=.YʂOD-Vuĉ2\(pFg2_k}Gi.6(xTȓ%sll0"KKG19 !-a,sאx'ĚZ :drJ m 3e0A>EZ8n#,6&CmF:6&F>}l|KF(lkB(`I̖) [8J"g\PU Y&߃-8ˣot Ip-XScfGąy^epFX桹_?S}>51ϿW#:Xŷ_*,?aS^?QQaGQafg=HHayp)lXZ%`>0šFDص6}@G!R<28hdM2)$`K`RVvxgM)M>H/FܮBQ&24$4l ƬX>y7#L[pˇI,ubyk5}.D1MB"J77& )M\Ob; Hb`A/fԜ<=w^A])1bg&cZ(FXsY2 [8J#, 25)(! y0n=EH/@# A2}`5ѳ;K!D5C2F0P΃'liM,c6Pe)`}vCr<vNo'ɷyRsG|HF<#7ksVu; ep_vlq|6,_xH Z;}P~* [dBXW4yu f1.>0QͅDgˇ'( muk!h7]K[c׸5I c0h_v ,m&Bʻ Sӱ,&Nh|3(l(΃njuCM ~oOߛ{)54ٷ.>d iBSߛ QvjX$cH GiuzY-eGT^Ҝ,/֣h7aJuYI$FH3w/?U"-e",`wa}~q(2 :zt(Δ#;rft=  12@Z(>WQ8ٷNiH˽B\&g$jDHM [;!I",L1BQ42~C.9rTtγ#/;9Hq=Sj+|C{|4p ^EKĊF Q+> T{/K5ڸ(^KIPsQ$c#H Ghe ,4hL/y}Ov id ~2$GvYxR>=ip*?!w1xC(c4:(cf " YpfnNM]q#fЛis3ptր6]|GYtW\!{!AӉ/j9n4t@" >0hcy!ܗtq_V \!uhJ.B߬* *٥]9*ʂDHR _iNؙj(lQ aɣ:"[< na(ogS `ױ4(1A1`$T+zTٙܬ0]Y#ƣP{ !-be~4tS"RiKy]u$zX?L¶Elg7ř Bh([-cH EiuY7uix9.1W)X*ŎoL!X4_h"ഋ# B$Y$?7p&>ES<ɢ)ѯƿ DEd} !C'aLDEa Gie\8ب R.'[`uA%Dz\>早[K=sB sO ŗ×T5Oqj*iP[C@@`.&VXM҃mAŽcw\cR_͒|۶Kg.M(cBH me`4Rl|0TV>(kq,aC& xl#,'_>x(l(̃ۗQHcijlO1U9Rv=%/A ox>5' p.;]PFH (u:&j֢Lͮ =:jZ\8`˕7ad rW4 |t%(1BQ42TFۂxG^ѳjc7U6-GܝB(=Ky-.(l(̃n߳JY™{E7G8S:/ 6*s.jW,A c:e=N*o %jnDH[~ ۣ@y`YO$I^ _Ui(a(z0ڦi:'.џiX'B5x=Y:95#26PܑV73[ y%ɩa>C!tGWcEa Gie\Wc^7Efc@F9c@T Lan 0:R`d}Y(<^IF[2fMgsm&~l-1Zkۂ;Bi`RSB煵Q"-e",Ѝ- w$15i/~Pm+R~dBL! RBqT!7"-yprlq0'9RH/7|GAr,vL0$')`jm[d+I QQaGxcׇ)d85'.ˤml2Hy8)5kD`?t11 `Oʼn&ZigC6 hA9xo[ `.0š y ?eiBb;q7kb]Ә-zD#3[ EHq gHIN?-\",sJ[ҐCC)"GTނ $p%CK3t-ی)G,t6EY}\ j D(6u-9|O)Zl$۸ O 2YqDIX&g@Z?_6tdiN!z cZ>$?EY(DX=7RR°-Mۻ(޻Qs`a!HgҠ8vqe3[,TP YPl xQ;HIݓ% T`,^*)  j.(?DZ8F#,Ir xvQs4-.t `ĹY%㜬ѽ,L#'d}HFQ;yٟAa?HD!iAbT'H,宓 0'tDÓ8®l>zsF+L![ ?@pS t/[=}G!X4A0~ ag}P$c( FY͕Q" x~nA&ˇ;頻'CC;it*&[Pm;Ir`4.zKtH,:WA2}`4 *<}lVdi(an)r:( 57Kn̚[2#,_Js+ u!1BQ42eZbG㿿IÝUیoNj)#oꎝJY Nn6XF`rNDZ(F#$9*=6[FD=#Dwߍ~ pBL!?a`;ʇ(QaL.ܼSErO:Rx-?mh`,#aKBAV,[-HJCҐ BqjF2`IXUZeFh枥 2FP&+c ^\2NN\N 9x%=PYdDd}N#lxojO97[̫&#02F( [dBXwɃ\9UDqPiθ78̴m"~3eл3$:{,w",!љn+dy~GX,@kIʿ@[dyEBE(u*?qp^DOf#d##/ Q -˹H JGϔNGa GiebzB;)CsM[-{h#ϲ8H0eiA(l(C෉kz[y#KSFaڧ3X 2R"9^9P)[8D# ϵI:. R=sSJH$L9Cն7٧$Isj(fAY=<EZ8J!PN>]JƔO*ZA##Hg'۲FKlj` d&Pƀky>;)%wRoW-RLr|G -p9!XޝsdppFX ˅)*]Z,(EA򫤊ـ)`Yߥ9 ,(ȴ+`>O _qv쏹9!88@y  I XYBogjP8wN_A+ݿIssGH557qxb7ڑ-L,<[c8WQw _}"|2G>(,y"r)@0_Ns"d3D7& < @"`4;p^]47 l LA#'fK-г|Ba92n8a`>00F !YIEY0DX!N|Ls_mzbhmUE9[ ׵,T/˅'H iu|O?& NT7zuYQL'ޫ`.0 \<@\L 1A"2 a-G"zS>x<ߊ)ǃdKaL/?@Rö;h+!1QLep=0ȏJ-zzb~2rvK ތCk_ AV>CG2ym~bpwdnsO}#۶gNʐ *2rg\)61(Co9?0Y8D,sH F<. v#;A>uj246cŁrBHGån!`1hY_QQao6[‹.cp.k)A`RXQpo_8A9F8 [8J#Suj %{s b!XVˤ9qQ;i1e޲3j~jhI;Y3Q,;8,㧰r2->#H:zr!Y7DY(l,&Y!pj׏7;keߪaBʛtq~vAYW"-YPfXGK C>_; `6AmjN{`qR(?-2FP]*350X`\OŽҖ}t8})[!XJM+ `cwt}EIu*)p׆XT>TI;XZ %DP&jcQ89i`WF{ Q t tXz݋-p"RrƄDH>ޟIêB`>{x7Ea Gie|hwϋ҈t1:H4}&! ARnLMd`,=0wXz:<*c9$dX鏆7ǹTJ%`5,vb 鳮p-V\ᳮwGl ?Sc=ǵj ugI,:ߴpĢ,Ϗ(E>ybUl;9pҖ4o# ݫ!*YH0B~pAǑ AC~sgTsUz5xsQh'?@bgܖdg`=typm` (YMN͢ƄS o73"U 笷s"w`,ue8ӈʁ*k8D[uE;,xdEn*_GZ4Z\-#$asbsqA "5 |f7ֹ4,z#_ȢIT8.5Ɣp,hN++8FBl Cl»ɔ8Һ.Q"YѬ0o;{>{F (k\$ ^ ( =dA Q`)J hO)y2 Pq8H\p=a4ŀ0]`$]4j2RCj(4ӣCkFUrmT͠Q adO|Ko4`8- ,e ʅ[$Up𙅞CBɁkNm"QTcV ?htVQHw 5^/tGF5oY0>ޒxzIޕ`KOFQ࿛9AL XjFa?x78^* Ң߰8JJ S1Q㶅1AX!c,9k !Rޢ0"7 o|c$‡bXy-/>c^AH!c,DXps샜l[EmcD@>bAxe@;I6%-QB~k:S2]/%_hSӻ@E.Ylζj  |*[$cq ]cp/G'e%8zh@-:Tn XrvOǦC)5Mѩ @R³]驱 ]8vc55z|q{IX=P*,~YVpZ"꿃ok|!MDqkN&{gIiCZHER[iL5b-Ej8J[CKEoD~:.[!xpBT駱Ʈ+ .`J(]2@NA d=QL1w Z4_,FH"҅ ҅M[QL yP/U8Vw, >LDƒ*KBIBLJ tAT Ve; ;,7:НW Y*͍$XEWn\tsli2OA\=dwG ǧ5%h`yhN-VFq{!h^Bb*K Fn,>c9(QI[w,lӏ> ;psHH6NDiWZH/<|Ca9 V,BH ( Y]uH$у.W8m0~5X0v9}I|{.X<;X_;1I]gSI]oݎjbA>0B~B|c(JCQF"ScgZ,5 !5-|f+(oE2X+}X-l=TUaѮĩWjLrĝEfFe(>zV-:pCn>gQИ0$+'hi\K8\Mk|8<T%=e23vQly݉>j6/ (ģ,LrRzE2-|桋ZI]Kj +!P_eeIЕi[Wfm3  (^d׹L09˳i4G(芍4@<VO3 ٵEZt[$;S[YnCqE7b\[/ DgC8F(p81R˗іt;/:N~w] A`ɞ|#K 7i G?wXnTz)3]'z~4v.pӀ{eKNܤHŘ>PyPcI\9]|LbuL1򧄍qBEa Gi y5r7Jvxϝ ݸ86.Z 6p\څ00p23z7ٛd.wf^5+L=zX1V, # SC'n%7p&T.#Ә꣤vU>P>E­AYPC%-g\#΃g~ꢷ9E1U 1V|5SM Ɲ+EZsA"5-|桅GÑ$|R#[A~\>uA_4|}=?KO,q `7i z(^=C%mY,)].^bc,<<#Teo fD" 29E!2lt}I;8z:P6v""[%;;%_ 6*vL=_8Emi 3SΞe!|4g6fpjJ[F]$qJ|6B'; 4Y8:lhLdϤi Hb+ k8J[C?d,DG)Sr=dTcTOQG,1YSo wwLK-F:B,|21t[}PZ3QOrc7꺮;1^OH\4XZT; 4t7*Mݎ*PiaG/Krk?p< /R1,$ Ͷ"!}4( G) yuN`ݒ-'b+vgQ1 L!.!$OŐ 1 |fe0 yIGs^l.5ĸpw.owj0kB 2es|;my mZ]g^l8?nuqjj<'xRQa3G"GGjXPƟqt{&Vy{~!.zl+uŸnC%)h0’e>|cH[Py)_$rfr_LpE`2cPrZ0>t^iuKZTp2x(YzZA3 o9lE0C $7-đgC#Ei(ڀ饘,,uxAυC9h8+ d> 4HK)5 |g.K VI6DQ%EA#5$.K40X.2k8HB)ܒo$2ӿH;R"F@۶li@dlB*(DA'86p"NRo|C.(- N7,I'RZhUfrH6`ӱ.NyQlO65[)}Yؘu>6~\<"j_ -(r zp=u\mcw _(I͓ c6_ shAH;6;:tBuMh2`)ޜ:7#{1CaP,J#甝&S lFLGK JknӢ;HddڄOM##mLj0+,уMBZ`jԠFF) y(TOxWkɩ DtpH|PNF )W(RCQNi`1] L ma'4\SK0c3XA+|$X?ޑDL_^-C[P59's+R$3>%QٔRq7Ҙܔ$d,H -Q3Pi3eCLdld 6gKfS҂OV4 DAX"5-Іua}Iȟ4x +=tup<"^5v˂%-IYlĮQQH#<8 #%J5Q}Ĩu:~KcGNuY0DPH( Ei yocSZo'bQxrdŪk {2$=0Bg7.K(e;8T|C[|7]#;۵j2OA\(J5~QD'LJ.kc:㩴\͈a7bL;.؇0F0Pi3Qŋ{Qza/cuLa,Qɴ˃ 7!Xrܼ[B]bџY86yO`w1q߀X7d - XcI66( ŗ\Ő  S^zWQw C&j&XS46[JܠC{h RA!Vcq: d+.,`2Dbڋ5W xo{ڦ0xFa Gi y {LD:L7GSR|uoxj|Mn~O|`k:8Ž?^:c{[\Dd,sle]EͱZ0t[h)Y@p b/"p΂UF‘ Lqz#pG۵jsmO9G`.TÃr 8R@|5~WsؑR< (a7><4Ia5ܘ0@Ke s@BH h I$w8 '"y7wsٯĢG.Cj >l7|I@e^"k(p;12&ǏF%5nȢre?޲`<7]Yma>2 k8J[̃d~tCjMfIp}6x ۣk~I[}ӂ֖gea⼴|LV(gJVDw$w$/6Zp$C3/%kѹuu@F` ZuD44ḀrnV /.8 2i DIH T>cH(Y(ՈԴwxK hiֹ+a9'SaX; &~. nyF.N?g e; [$[uS\oH1QXd~ƈobA>%h!V(JCQ1QTPi3@FVzׁ&mYu'~HD1ֈ9m&3 ҷF<:X>W/NAaȩ筨"-G`Uvcp⿂[]9 p4ĥL񺔱aH?BXS+Ȃc~h*B~Ln肂4|jt255\g-([Trz!a*|F+,7rRdY5j +W \!$5ҍRڧJmn9cdPΨbH;d^FP.b7aAb(h~U/Ċ{~X!q .?y}`B:AFoL_L >\_ϕS:RVTF\bMsnr)45´F37URd3~.pGIؔFh_$!Ɖ8qR#$Qh;1B8(P2E2&dKJ{$xX-䉮ƛnSr\c S@8 x~~rg7lHrH!xFAxi d LOIs>e1A'}43Pi3ݪ}*oVuZ"A$\?"8V`$CiG!jEa Gi y$ -8BkAFB-`EJd(Se.-ӇΖ(asдu`=/ Ej8n[C-Zq HJO@[aRR#nV _$yeaEکUpϲ#FZжޒ$W,?Ppc{xFȹj}?2Nu=}q@ `L:QxQrEjϔ^(anڳ$WbBC*(4𝅚͠ X=SBN8q)d69˷4?%dwO;a?cc,3./Jp{+$^RaHɏ2XƕhUw`mor9s ǙFIq/sGF7(;+ /pִhD_̃?btFJd]5 ~;$fhh\z L!IUO:7p{QL yTTqsSJbksDn{2 [kFcԸNoi>D- [}c(RCQw\ w4ޱL?$bQ?|m$wBhmX0$޻G4-|硹a)jZ=.&:3⊃aDE`U[0$km!NQ>17Fе /ohfU)aҸ_"f/'i!E,iw5-|[ٓɶb%i]'{^Kםɻ-/e#y5Zo 9~ӥoy)+z'~NPġ 򣱐=@,hod< .5o 6 8ܗkl"۠M[%cԓW)QaqL>. S%a@Yw{eEEa Gi ypn%AK xG5^Wb~i|pڂ|`$'l!q;|c(Rqwzt! \o8J)vjh}~RVcXv뗡 iO nj˃?q| \'בx['˂?zJFLQL yhnZ^ʓMڔ;|?k쫂6iw,=Z p6j0EKئnJ=ۋ8q31v YTY0J) @GrB$ |g<|co``;nZ'y ]B{xFO=XɼkZxJPtE:63=#G}-ϕ}gUG S::. `%DJ.>#e{ '艟dǪł2L>@SA"5eZCL$` I!>-Kjޑȓi oj |` bd#-ĩP *?w,QsC,%:OX+}/ \,FH"8#Ej(ʴcYh<\I5EK>Ru{>ĩoqZiԃ>u(qwL8} ۶%'v{t/I(~@K=)5:^,FH,\t&T \!$T˲ jEr`Lwuo8I1&- SメZ,(;(}t'fԨ(i?P6I揩T0 ĨB +/#o לZ,y0SGN- b@*8^yuodeM6KV#ZAq>8p,x:{9FXC;~x٤'bI\,'\-w8tH 7cU/C10>+ kdiO&QIN Xc U&HHb(n;;1N%`ȕ7\ ~lP@Z0بk0c6-ldI( e3 1 7H1Zhq`W?1z+?5XWOɁC˭1(p2H,N7@^}>IX :XcpGzr A,,3P͆5PQIDiK;Wc頇[4+ CF%{x/rȯzFa Gi y̾1Y\ aߋQ!]~s C XFǞdq[oZ7~~sR_n,_=gb,N!jYH|PiaP>42JYCKîE {ԠO:^:DQ kS gYHE1:<ٔQXQwp(ƮM +^/[D ЭP[ԃ߫ ӀqwhJ6&@4^<RC!z:/2F_`qAɱql}~0$3T 7 c<43if gjqaa] tJr:eAQ ֈrK5-SB-pPN5-|桢RAޕEbʎ`FXߕ}XycJ;Y0S}QL y,*֕]|b9 F9X4V˂jJ1Pgir!u| ғDƣsi~,֣j}3phlA=X0>O$?o@V.1@A,OeB'xJ?ә:a Gџyʂ1|XQCk=\GAW3%.VGеh7@bi/3 s=㠶UO"H Cyf ʂqXDM7}Հ(RQgˇ-4偵@b7VY3?łpRާd=,;nf"5-|!߃6VɁ⹁Ol"w,V}A6ײ`oHqN|ŗMs -+8>N@;]{%A9f+gl'Fz/k(.-$ޝIn@W򠮛>wW2kf %#^ Ǻ$|iz5 n$g3 D{q! "5cZ΂yR+ɒ 8qS钛dW_4#, -%KlAg#3pG&"b] ̅hg8t_[ >*=sȹ́TEp__3 :8_( ŀI{A?/GPJ"rq$QHBpZE^no6t$p@,OI䒁E{~~2P6𙅎nD#KdcYsahJY˂1|ֳHX,bPp2p=O._LN ŏï!n'F4Ō$",ķn_|ÇH Gi y^ۭr4 H1CLhrOj0e<-ӇN)agҴc3gFa[P=ϸdq5 =k`S}2ν-+ t$m , >u_`8$%&":Xm1(]4PX>ͭ8š,!CX;4eZCS?8sf߷Ίpjxw4},. gOePPI&F+ TpGVB=ߒyvJؓ]˂od%%Vix8}fQ<sQKNHϻ%Z|HKcCϯ`<\Ԓ]ui=EEj(J[CL/ w6~jw6.; v/C/I[0.;JISU,bه0|0Pi314w4sחc/%fhgza-_¡C7[r_ǟ|u@ vf`YsP f.ɉ|H&!plQj euIȐ^:nGWaN!QЅ:ұڌ-`qdm t}:Xn9lX0ٺLPؙ\4+k8H[Xg#]i;R㧽*5v<:aw46_]Doi7~q&u5تWAhآZDT&7]i|4pY D68]??2DmwD.XJra(16Q[4g L! uEt! 4 |fAZ,kF*zI.Z =_pzgGS@CNkg_(+Z_;: Ư3j T)8um5"T{G.dЧ15X Z݅$\ș\}k(Qwz8!+S P^gb`nY-$>$:L>(RQg:…MTb5\Ȗ g7x?]_łNIeQhBXYDj8H΂۳9XFUBLiz“Ɗd\M#Z]K#V ,S)xI(Rqw"4ƶ&Mh,A31ɳw@E8Х4&z`%1ѹG2\??Dj(ȴa4^l v(<>?B)(4A oxAJɻn#W1QN yg `Ǖq1B8-M7 `<HP޳X@ s߷D!Rs@OT^\}K%b]|5V{qLahipUPCOqJHCUGcw% k8J[CrhpYe]J$# ]&.|0r'.K y 3%G* 飹8"uCxՉ=%;xp6=&2#qwsgx]4=, ɒzzHswߗ*lhs=9#l$I#wil\,FP9 k]Zxڇ0F0`e3Y8cI {Va2rJ$RFcvvZ0;'%;B9:OE>P &sۼ;mC(@󃃗Q("@v2 La {$3Q `ZzkoJB.كr=y /4`|=$L %vAT m3 %|[r5%(0JeeYLe4=rI||M(Rqg>{rm}O;~P7n<ǢAUY$l/>CQ㶅cH Ei y-3djW[l_K<;k c?dc&[8JR1gZb!~:$KN)7>aP(rs9pc's542BNOE5Ƶ1)A֋wPL_Q,`R%9y*΋V8/?|Ej(ʴGx.w$ Gk\Ǿ+dJ>#Jŀ jB\;-.!cBl G\F׭䮏2/[L½jloX>ݖ:%ΟgFQ2-|Aҁˮ$h.=pGѢMbX̅de(?/ 3pZ=vv/[%;T rk^' N҂qw@J–u%<EAg^*C&/ VV{0>TNK6]dO5oQXV ת(g*R8ܠx.n~X> [ nO60{ = w'R!u >Vv7`0s4ρg 5&?nKв`L!ɻxoYoK7r5/. `|ՙ_8!h;ȲWb!zix($L:, 2e5-|I~9Ǎr$G]Y~/Λx{⇗qPZ Ӆ65\Zֱ vߪg*Y?Nsm.NIW6ӎj8Qa;2R{`e$o8ORjSA,6nEdr]Cu}ҟ3(VO<>܋b`<~^tLQ%Uel qjd?lunhtv-kRr"2 D1 {&gYAdN0K*^gh5k;RttS9xsF jd~s|\??Aj(´BhwJxbZMyHJ cx~Jo[M((m;UDsΊhIo&&n E5sMW~̝z ƻ: x~~=3U)}n*4Kr"-X<}=p^.VK˂ifVZT>"5-|WX$")$ɻ~i7u xAGJ;u4t@*0ƯZ2$b)9Lg'ːCFO  dG'𮒎kAD2-|9‘%%̆HͿO X2N$ZO'!J`LOIQ%?3}Q1BQ<~S>,M ɚ8xT/aI]y%bᘦ\4TpnXӚf$N^w\ስo*yEҊЙ-7\$8) q: F- y%5EQ/_ i^>mn<,ɎeaPzN{m3 T˩.6`>N|#t<>G]mH+ :'%JK MezG2-|8 R.D'cģ/;"y9F 7HܴPAiiQ  p%r~7o'Z_:N‘8V L[ S6te; AurlvіD5ڽxĶo.3یF hJZY0'%Q6-$aa(w:gWƔBQ!D,a q*Nj0 69Q!&OP 1-|&:%*b5`JP+bԟ8:&=p ,;O})Ab]]owgL0Bܘ[][c ]V\D$7Β5 6 cCxr* ,S_1. }'9}??Ej8J[̃UKgksw8}cH Gi yd%JZW&oxo{ާעp|, Sm!h.{?hYq81  .zIEAcU`2@L: 9> ;/:@9z58ٟfܬjէ[~&Ƃq]$x\%AfYpކ}GRHٰK7ԆE#/qFR:W P^(/)aOZo4Š3h Nhh5efh+]C.h3},Y-6MINǟImabPi3g#DyIgLk #;aJ/Ɯ}ZxL'PBPC)02.w&Hn|)q-1`~&~xӋعdH Sb[ k!+D<){?67RO_!%ƹu5s, o:)NnZcQL ypn7ȂU9~ lfNwO7 V n^QXP㜲aEA E)MddLn6.⁆75BjLQB!4>&ꕏs5*JZ<$ 2H` "5b׈QD87wQx%nNA,@h_"?s?='E,v*qD"F>dhDƵ0޼H$@, qx0nǩY`Ćo*ٙE)Obav9fnEp<Z$K|wdI:M.fa4#pj|,$|2%;ŽDA#Ej(J[CuNIc7r~#g2xs/P͂իǎ#c@Xg JeFJǿU0+BjlzUsGnJbBCXeDa Gi yh?Sr S8S6u3M*r:Uעi͘%SE"Bu ي!#nI$ܹAϴC&h`X$3-nl!g/F(gւRźޙւj Df2T@M/6t,('>Zߟ;`į, \XEE@s eING8~7\7~H">d q[,FHŠumATpRӰ[%tIm $ql%"X5HF OKTik_hn=Ac,TA J+'ڨ"[@w¸-qiGY0>yHpvX^Y"yI較ZlN90/#Nf즁*{/-o'a&BH9pY '%Xէp q3aDmFcWZ0WӀ&1F(p"yY0:`tӲ@p0qm'p8m|FC4 8BgjxgtНA!XC:_ˋ/f@vS vJ n<:L6p4{  383#½h4٩t.ɁIoq{\r1j0,a0,D|f0B(RCQpv!z!Aƈbxk`u^'_\` R>̶BH(^{pv7Gf]ڣ4[,WTI6ZN voV*\!$ěEy{YP3m١:٭4HzUoLIωt>"5-|C 3<:Yɇ8:#iaĩq|BS21NDj8HYB|eGfɡF[juH30%qH.I C*HjSBgAKFF) 8vw $ڸX>1ތ8E-XzwJcݚ#(s\cBTY>1QXQ=ZƵ)QMԖYHITLٷV]ge`sWZzؖ !aAd FKn\c 4 ~D){. m %FY- zAc,XmzKpfcA0gcv0 NZZF"b3kh  ұ[%Dj<f|{‡}U hƛRW?q`l q5t bc,r٦ &mK֬Wn_yi(Vldw9X__Wp %oJ&ntja}xYK7aID*^m,>1BQXQw\XnTpc\w j#S,腱x*˛YÅv_ ZTnuз`t^h4U)3 J-虅f& kmǪq7dwZ|QXQwZr "34./{R#b!n-7,8gy|~B}sw |t=Q~Ir O(`LOIGi@hnoQ<0( ;.fW#%gcXQF:vgӊXp^,Ijg1@,!ɅyZ?ˇ0F RPi3 ~ODeP#-G`18+q|W^469P)9TB- ŭ|c( E>~ cѥ~%):ۄZ_5Сt`쓒ʳF$S& sy(HGǮX=65҂TPIZY,s((m3# 0\wyRE/j`W)hJp<-Z!H#C$R=rEF&Rθonc[UjHPs,>1Q+qVʫ$/ <飙;$jO;/waxHXQy/®ZƁwfZH|["߲sbWFF) yg.& KJNҝlEhuxb8xm rKBG7pF!RP* c?/HZ9,FHr m" r!LQ R .G0v${ {F r``ZH$ƲGs3B,|-6|kV {nhq&T෧, L J{<|  -W*k8躅G(:SKN%FrNalJʂ0}cf"r$iIWĹIdcqp, i#-7l,'z$|( FY>P+n$v0Fgx8 yT/E3Wa )Yt`6_VT.*uUK۲`lo 8.$b YhΔq-ίcI$[[vңdKlgnlqm.ꯙ鯙>p ˳7[|ΦZqWH;j[H??Ai(´NA}$O8TtѾ|T'di0u,wdcs[kA"5-|G#j{6%4L!izBjl!1|`%i/}Ѩ(RQw3;Hs:(~>+t`@-yD^"5eZCüu,Q/ޘu{.Ce뀶)w@b*IBY#!]l1wyP\2;%}4t؍ˆP1H#,9qmvAĥsUp>bN%E^LLfߔxx h>;%/jd )dJC1,_lb%ETf?93JWc DvK>;2C\zg jhr>R2C#l7 aѝYh .ʂp7MzIoY T E>fUJDŠdűæB8MޓiAX>Eli@B JawJq䷑ToV5S cpW(k& <-,xvt e&=}l*V((m3 'VHԼ-8nW?ŀ0]`$vmg=3.:k}gE2UJ* D8uCsֈ{xw[Jz6ȠGhNw((m3ġ,X9$]Q>C*{q 7AIV6Y !5bZLBMdPy6'=C&-wsdk7< \$vai3%  | .É)LccX䟠]_YRҙh4>kkKжѫ%B 3:ͪfA(CY,FHX]bÿI˦y Qʕ T1ԍ=>y͓Í,,]xߖ3<Ưff5m&E^LQFfvK ~Kc /m!KB洰>}"F(RQgo-t$-y3UBitˀ麪L0jI>#XcBv6[%M Q% ~H%0ڪA`)Y%%bfI 1(RCQPv'[Jv|"EhO$!3QZp ޜOlId_11bLYRkVIGE,l6%,3~w  QL y(ՃADlXDWwxU|W Z^ftVp6AGS]}HP,M8]tH[u'qJ'm }lQTqUAX1gzK YmaDQ;-| Kް[$Vg\?@e\5S7CXpny a`g|<KnJҙ_$9* ~J9O3E!Ryۈ=Bd ^`iLagd#WEIث*-2(r1؛1sE ?QMVw*h'}RT*xԷ+ґd))ԑSc#:5:Pj1`$@?BgA]uJb<%ztkV|k upu)IG[ʲ׭\? P6:W}L'$("Ag+#֦Oex0s,'cy5-,Ѝ%ѕmA sR@I:c];5k gzK[{U#zE2-,[ܞu+n/%5ufmָTuʀC#tv@T5~|2$ xJ:V͵ RLr!C]hM 4~_YHQspvJ-}gyyb◽zY9 5^9\$ erN~//5ts ~*i=߃+r]/V ~i¾,oy*ܽph8}U_2-,/`}'^ɍqޔ0)+ڰ;BS%e +&((maG֔Qdoay#3i|3'lJ o> ]U,PtqPVxBLxVv[0F8 k8J[Xz=q󜒓9I"7#"ȅKc?qext8x@gtݚ+H ŘYw>LؒSd`;Ev3>kufY0 BW},vp΃okUIƜIrַA?"뼸 7yd2 5ąOVOiap?}z_g(ea!:ASrW뛒aAx«4NݥĻ~;% N>FwB,H,In hA Ľ?I4xSZcJ2sE7vp//3`iU\d}D%x"})QE;kTQ`Kx($x.Nܜ|aE!RyZ \>j'hPrfSe0EJP1Yz1GWe y$%LI#ėd3l8f`VASg / |JdRG"5-I:uJG=.M{I58V:AT lT,A}{<43p6"+u%+ueفtR+0OҺI$`R,4ES#A  5p*;i`>Ej(ʴCNl\HMN8k8yZ){'ġġ&Vjaƛ(RG ` :<RA1e`2t)!_"S8F\;nqY0>HIEZņL)}=|_bfe=K{xY:F?Ζ`AF`swdwSAp۪`EjEeH)XBox)45)i: ~2TP|?ǯr;=QA+ْS|G_3V4ڕaI4bL>1BQL <c?HuKI< E<_Kۙpd/mKr05XnM1: $qNo scO+j8Xo=^FdAMFINVcBAc]ƈ]Eq,,odjov I\"5'AFuFdA>0BUFdkrA "5 ,P/ZkO%AY]_MQ.(/ PL) & OFQ;-,fIxC2A?S9`NQN\Un\]o/Pbxp1eAeOrqh9i|y4!m C~kvsHzTe. ( V8qݓb P 2 -/EWW c6ԥ$) AL.laH.i(JQ2%Q5j똂Dpт适/ImC;?G4ZhA$ⷡQUr  _X&]%y4|%@RyFc8| Ojzr L!Բ@^A"5eZX!lJ: Pz" cznJlhGMϹ4^ &r̞AbL ,x0Hpy-96cÍ<}$a\ t0ΊmLз{&&h"r:CW% -:rB$HTA_z̔d2yzTea,9x~=ItkJx$P}L 7>x+pKMmƹr64kd 6<1v#cޒ1KCy<ՊD#L(*Β"~ xB1E~uittI>E5>X:I7?s\D1mJ†/qncڦo.%.8H - 7fFcC _Kc@~dAX>0B [ЇQⶅuJBq-Aw}IHzWit-EŽHeMi ʂ1}`$,miatLUQuZcV3ƒqU `񊼻E=ktfax&}-\6q9Ae\0E2+K6 N$DP`,:sJetӮ\] qsT Vp6̂` ꟿYGz-1`˟4HSo',eMG EaRyi`]_xJv_ + n.T0GIYje@0<%56}Ћ.1AbL ,K{X =}N ⭏7AT =;Ѐ tJw6gLVO̡y<rE8%q… 99U&n zbS ;Ӏ1]`$q,,Tp2=zϔ<_@ ׍K`X]-+cKN~}cH Gi Ej8J[X={Et8i=JWZH<$9YhL#OgSp̃y;=~W=hNJߖ&TMr7B- c`'i`C ), Oln"3.(nWbhD LZERi!mXs3@ezKaOM$)K(÷~% 'AV$$]dat| FF) < K6$?sq<}N `)9tl dr(Qu@Ӫx\nx;vGp%TƷ3 vM-\R*OsVPi`E%rp&%vr1k-0Y0@)HO )* idΣvZP=\[=NfAL-rH,'t᜾0·g ]:cXf[dM wʑrk7QV`(' ʮ$;;ܥVEa i$t{ݾ/C8Aݣ+[ZJL5^*!ʆ<Gn}dA:9o&JFpLA/瞽u/gKXS`֔~sC ilB]=K2r Y /ӿy*РZAJoKsipSJ@Tg<c"()C,$@QDA>ˆ&IF-$NҶ>؃, w)mfj0rnȸ+AW_vO T/ةM t^,3 EIpr?" &QoABlg6)O !S o2@ 9aώ]zf8<.[ cKPx b P e`޳JI ƭ>gr 7v ;ky-^Ny;YQw!yQJPv[E8=OV{f `y?9I/Ƴt9e97>~]%/UZxaKقƮZ*[0>LZGYƾ|tVZLQXQ2~B4|t])"hx:Iq܉ФS|`$v2?>1QN vӋg(maGrOER,WNT-ޤX\i/+ef4?MI'mGqId $>z&›q-4 Zhd"3e ʺ=v=$YC ,`J0$](eAx7CJBWn&r !z: ox ^3.Vb9g r7-#52nYXm4|rJ:m?LBĭ=02k / &MI4[?q1i!Z`eaxO]e Cpp={ñPgX߳b@AdA>0Bl"O}Q YH38#0zMhZatR eÓ5 H-{+p0ς_7 }f c/`4 Jy'q|U3KC$[Hb0|#+QFF) U[4̚,r?Sp̃Kc&-CMv`w=*yg.?%,%`,lMΘ3> _gY IǛKBƊh%qBG׬T2`)S8%{ـ*vCj(4̂5*q*.%sH:^Υm cEwTzR,NCNUe[l{ Ő YHhtCw&赳B_6; z!̿?OwElr}Sv4vfK{GA89Gݞ=Ycpg,$3$YГ֌5$JezvTwҳPA8~(qדߡYe>ޟI .(TȰi`[čJL^p,tԶ˙,*HA# 4dH x/;p΂Ag)Τ_-?s.4%`6 ۴/ϩ0=z::N o ,%1jteق0}訃[CA+ Dypnq[YjۋW~VpI!hg/u(A.@2t{1X12b |2n\E Z=_M~jDl>ޟtfvo7 >| ~*Pia(.,z"+ޒO\hAs>{ ":e <ЌL)DE/; 0 ,s2,a.@%AW"fn$Rao5 dzZXc^ (%'='#Ej(ʴ̃ S}%K'oFbKsljуdZ6cw/ 1Ӄq5~U[ǃ| )ޥ~QX ؍ sdx$HE)uJPQW *n@g{Em`"ԃ,$|$p ] q*Kn;5\PQ D;VAkF` Gh 6~L2 dT^^<_X夰s)ui.ߟ  y >8Ѳ+k=''liȟK [RIف$-DF!H Ey(1"#pB!Gb5ԅ_/Y!XUu 6Txλ.gr2$ 7YQ;nq;kĩlA;M(%c[BYC#Ei(ʴ#+YI Yh|r ={ vpxKH;I: 5/񋨞u<}ޒGșδGSˀqSXI6禅NrPĐ Yp=F,/͗Ddjcpw2([XkL&/Nn`<-IGIY W0[WEa Gi cxZw)IǿFY`Qhp((ma7b#s2*)ylov[ qf=}H02Syзk A  ,sPE7Ibߦn IHDF@Le;I='7Rϥ`ٗ7MvA3Ő Q9r%zl p9dpk9r4.u>/ ƿT3^QXQ:=7D8M8" z'4>#1h1iĚ,'mdJ">ne~HjOFy>eZņ4v9i%l>0BU[8F8P#BIJYLOǀA ԥ/B65Hn u\tm !>>G <-%HSNЗx=|^"Qo)l%'tm ޓe Ktp0-U.S VȨe`x~)H=_!;y~COeg7*&}qTO@cЖ`h?Gy{׍ߚ(8x狫P(v]!XcMrtm^AXA< wcfJHz]G܉oBT*פoH ITaB@a B*8BX砚l͏K0طrP50֛H9ڕ<^-n 6ǟc#%~mE*JM6w-z ,$K *pCuFM{hOM/xsRJ!K)X7F(+ k9)"qt3 cD.?5>߯'$xx6)SX##u !XcҼ$qwujJ{kbm~xX zJxt<'맶ݟ;2_b#VIIp@;ٹށx:Ns9\(%Ml@ga3Q` h $:P*+8FXfsz Z [wL/OY exAotTqRC!e#]dJ!5$?HB_Ճ2z {x<<\왪;.i 5 ,S{h%q7cXBR1: r?س$Z0 ϯhFZ2L+|`$'O4lVlM(Rq:q3guQBViRSQ}8(pSir!p|gpP3P]:D`]$qaٝiB%xh|}b Pp6NA`rH,7ǶuGrpyEI5^pW}J :i=Zi^O)k8@X 2 Qe\7gpXlR!5-,`&@?etdOb. :#1Iј3%!a5|c6K:؜m#$8pGg9L#q,\ޘ-$>[' tCSp#/OJ¤G;Oi\Tc %WY0>眒h_qFa Gi L3c)Nm BP m`E^L Y{tq$'>| մyK]7_g|@ A,LjYl 2;N_3G'nf dcy`e|: i0H)ދ\%9i\;\l"2P(o,Ot`$iL!}t-dpCwKo6l$OMO/6_}&Ƶ莜lcKjhAz|ceW8r}Ypb4\\s5,-$LO"A~ve! RYpMߖbIr;]K0т`O,XƁl.0pS4d7QNF )acy]8( Iz\{D)9n2Q|Qyj|ϸkXZlli&wtժH G) ^'<|_+)n9lݽƲָ r8yv'ƸT_\EP 8IDT葇6 yZ!Nz,\d8o+a`(mao_򎎳+8IPw6w8v~rQӀ'F8.sgea,@'ϥJ6||l<\jp%T\)cUM$|Eyfʱ$ȖEEמ)~NI?/-wQҕO·vAT e`~{cS긄ѯ%;Dq~8^V,%Yiӂ1}(Y&tЖ(RQ:? O*ȋ5Qn{c- 1-H! [HT`)-|AQuF^A)Jr"g3␗y=1NjR4X#21B⃻I2YY舼|tͭuړ"ٕ*(WqG!359o`|&_}'c}ʎ(RCA< e#rYEZ{@g/?\P|'g[7TChV[A)jƭɡH$ۣ g4k4 wdc,[`>Ej8J[X r],%[ߗmܑ)'$K Bbw/I#-l5xFRy+qP\'}#Z%Hrye;Vե d9-tGn~I Y` %58Ncn|1 6i8s,$c=h * B%0F 9C$DyCdIiJl/S(eesVxi,A?q8'Hd>à5~e"!Oqٴh w86-4P7Y>?2}6(R㙇?ƃy$ 0fǖP%V[xF WLc^Yu4~[Q8ɼQb i!A'5 ,$$SQCgmg$!ZtjDbW\$Uj,HIGra`=Whf e`6vh$ ſr] - ,\+*CȸeaX-~G * E4Asуr"kf9^pw,U|ӥs ǧKZA!['so, S;ӝN4rbk~8| Ӆv!)K7,zه0F RPi`Efn83ȄܙUqiwlH;#%1"2@WߟayxBj(ĴLBKM~dSr],QˊDd/ĪY$OeA>ޟIsv[5 Ea[y:.7,I]7(i h2CkCwilEixS#DefCq"( FyhѫWTIH>_xzmƊ!kD#f%B%%[h Z'?׬(2_Xaf)Aqε%Pр}Rh,LƻrKV2H?` h,x \hW$QFeD2 |1e#, ʥ.޲[ Ea Gi <97#âw4Cr#ۥG9D͟I#[(LOI)a& H<ˇ0p$%-wʾ俥͒Hmt_+vy~hoU ˧4`O)tZ^# Y({RґX m(zԕ 7f$jtPLߟF/$\wx^_qR^/|Y!vx_,{U6>95Og厓E{(phcKة_VY2,5:^eXIrS8-l{Gm "5-,lgߛMJ!GO /jgpx'6?ѣ;|Ay` ht^bfIpEA;َVc ɵ44❔ıM +LA0@Ʀ{&q ^ 1ek?˒8+p1xi.&Ɓ%OZH|$8͜,ojRQH#u_BB_H;vHI`FnaA~?#Ob36^bvlb9ݘٖy~c;& Sl:ye1`@Bi(B& J5bg.wGz}GTtN]l ~%9$PB,PexJ"H)XQk(bl74iDQlA>\fuo望(#&OE2-,4 Lf◖$8"y7@Cą<%~HT~>848L#$ oAg B  g:n| hwM*܉#98I` d`;Y: G{DE!Ry$]l|]yEfß2BPd\}ֈNͳaxJZ#Ej(ʴCXBwlP]a( >G7mx'%' =>ֆi雟9.\"W)z=hfId\9=M1X,LuJTS1X12RIM| /(LQ w'8N%>}nkl8c 6 k}4x['PxM`锨eΥl͸@L5XY;+%LK P>zg9pC;D-eK Jn#qAiָΖwvŜ$قyEj8J[X=v, 2mO ƓkĦu6e`#/bP@`hp|T h $KR1&BY0Prݷ,T)OEyTb&IۧmیMh,_.ɕSQ㶅e*Sd-(I z?j"Ă|މ_uj,;O$;~I((may܈7 m5!:?] Sc'cZHn8yCigz2:)7d@[sPG(o/4-xJ6fmah>QL <@9Jo(|e#`)N@<-%q4~ Z(JCqe*K,!Kp"άWTO#K2`< ZRB>uOŌY( -rcT"5-,3$J[~Tm P';QU;le}B5P6JG(¡/ =~YlICZ) h]fmqj43&1iIo(fAT0LonRS9v^vEU2W9~ %`+ǜB CY0VflhjܳC,SR_Scq_ʤfꦪXYai0ٱ,ߺ)ɉ |l*(Q:sQlj;ZI&Y ^j9~8mџ*:$H'p>Sy_[~|%"~!%AMS9~m]?-n)9"Y36FjBm ,l(r#I.B=;]?C)(4BI+LD:u+JE5 &8q޿#raIHZeك>}tw(RCQe\Yă 5 fisKXZ;`uk[v9H "MHh*p̃l!ㄸaI}JXP$,BG,uYe%¡*| H EyhEɮp7In0b>Լr}wy~fri.0Xiu扵DȐ9 Jsؙo\Y4NĘ w=Sd)"%/I8D; L5",$ګ$̇, ̟,6W(ma.mbd. cq_mG <+ Ƣjy?ʅ.͏>k;Y(ыm͒NEx$MFH(AV&*ᔠ鷇wULݝ3P̀߇StXSt^\n7icizs Z\K5%H8x.1@AX#u@ld4*m[c3(12v$I7e@oA#G99 ~*k0> bcg7DdÌqxt^u&Ƃo*Mpc>X 814M`l9:ʢkzb( |E[ci}:5T+9}Y hX>1E!Ҍ3j}"f0% w$=HVuCR`|$qQpDj8HXf7F $Jo{%J Nƺ^?zě{%Qh' ^9CƺG#i(ʴypRht0W0]wq&" xDϧ>6t!Tc6M uNEsLS/,p6UPKepc<e>9Kre`c~LE qsh,~ɰ秓Ʀ-NO zMvn.ys(9ؚ$7(ryktt &5>i\dH $%- <ꩊRy$5`AtDڙZaeXa5JA$E3 ;VmP sP13H$KJn1_Axt;xP{5F=irsorGa Gi <ԀȤz%ru}ubE|8Ԁ?۵E p f{bH}J'T=L 7~e3WS 2aq> xQuiA>TS[gATmaGI.+ByKs+慔K~Xtƅ'bHKKLkHC QY05^5Δ5z|M đ5)E05P2QZ`#1WQ.cH YՌ%3 sj$Iƙ0^ɘtoZ^z7fJw\y: fE3|Qъ܈ȋ֪ ob "5.ėJJɂ,ǞuG!Rym޾78?FBTd;gxs@D/lsS:yF֐x7M(*x*!s ՒљCŔ%-ܬ LOEy%,*plj7{t{kkjĉl OXp3LLvX_@ {C_A|u_X,ozgYش,}cH EymQ<ԶGⴌfrU8vȦӀ!?%8g<{)#4 Ouv/v%ђ}w KUTEcCOO(OI.B#C)(4A׬<@ޒUkS,$"+y+Eޱ1.Z Sv KdG"c#jhl@p7*u頹.C5&㢯mLɹL^xt nG8$ꝉ_^3s ̿?/VyipgrcZnSCz=oۡnTKWC4jVI;ԾMncۖI /ݨ`-D1>Ej8J[Xi Qh#V!Jl iб+t|K7Bit d5|r6Pn"ds't}u2ƎrY0ʒ崠SB,W֦,?%=`҃\6-~Ը$Jw<3c)-/whyrVp6j|xSIqY9t&Cq05) , (q:"S<mʏwTqnC:k|?s;{3%IC  RA: V_7qI@?:spU݅#q^Le/Ʒv%!EtZtM R12 @A.W] w w{~߳68t/Sh>&9v]Ƣ_0\DɲНPO(S.muʂRR12 *8U:.r |3AJߟ1?uԸB < pP{oj|XT;E[+܁Y#2`lRڔ ᥁qH+Pi`nndG+/IN<#:i < } (C FH2itiyD!Bep!$2VyD3F9W`x=E.r-W)o bS{oI{5n*B"qqNq;o "e!n18dm Kdf/YSܿȩ+Ap$] Qch5oma|Ǯ;S? m~LBmj I OJB~20Ocub#N:2 "b"`:da#:FpIN i4UƼtМJ9~ %l3IHKC4X49i|6[H|fF08K |5,$#Q9MғE0qûo㮛59ɂYJ&wOPWgd hJ/ k~ #1ʤI:1I6VŽ5] V:DyvAxlv\G݆5ZeҸWwN$8i(JQ:e+k#uJTFhLHb,YgXP@g,lhJYKW+{GqG]?^zo7:Ԥbɀa @b P 2rnU!9Q^}g~5z{,r׬32@( MV&хAN ,3Ȃ-ou3 '3;)r0@]6Y' 4]}Kr0g R OqWɞ>Ī$]l48}VuRyq L$h>ƞwZ͝mعjL ᦄe4}tfpC\Wتv)ySaKO] w=yn|9>%'Ym`߹|JC!: Qk2:.oNO$ry"*2wF3K7>w|araM[Ig{ˇ}sp3AYIXɎȍr93st®ǒw>!~<|_CbϏ}戦dOP+o6<{g{i^9)iL `n~4p ?I/I)! ZP}'~yk6uyY0̭s=~2pCk)o>`$9ЌMvŅϕP+8(@I^vq;@3 mtSPGIr@!#±*5NkjV=IZ) X+ᣫ!va1-:8&%OG\ho)bB>kT"-gMJX)c' -"5 ,P6h~bI24'^wލ!>Fs$;r9~'/ыmGm,4%Q8N"Hf14nFO $nxea?D+OE3Q^Mٱђb^O|/?@4H%%;7GmLP\i`\7LG8ؔ57B";d8[a c]Y0FL X4M>6WdpCW=9G U>f]в%'>iD壻p8eEmόIadZ xk%RKoAT;Ӟ8!2;i ð,FHI:ByRY|r܇J{K(VrYYM0om5,YBW}tՔU=K-,*cQQ%OzѓgK~JxH Oqec( e{-+mXRr #FQa`B>X9 HyO ߔݻt,í* k8J[X!nq*Jz{>(JrUh ' dcZ *ݔ5z|diE⢨>+RFC|~AYN˂|`$l`>].p uښ-N䨏kD8܊ܳ72[D.aA$^;.ts bcu:B_M#%&֨h FߗVFuJY6GbI-~ӂ Gf(2؞,߯}KyDy<"`yDyĎJo5ȥG"d@.0G3mAȁ0Bi0́ b8c,KYfCD]y ◝Z#:5Je`LaɅ4k̴I(Pi`NΆ6mޣ|ȓM8'yR#R WY`e:6x.f ϟ|M:>}hlRp__yT֛R˹428YXW T"KA|?hL-9pS~KQoJdO 1-,7(r..Z¾qQs1 4 u?/rxxb8x&@IoH_3ҿ>wxĽqdj .4)`lop[oSq 44Лj |"‚} @BCN RCAyܙ52G:3IKr3aM֑0i;Icߴ2i_,+ylh[2Pf42JYX8"pp` Pd%F*G' & tl2-D%9 v`5 ̓yC?2>Ճ>%A; oxs2_`* ݍS"}[ 9ˇ0F0Pia~h3/z,N}c XwV"ݓ6s|gctX2,Vyw,j5pԢ))NK_bgle! ewr eavҼ&N>K§E uX>vC~ؗyþsKPag[єpSo|KtjǬ^e@ܒ 6qf J1e\s|k_4*nLu( X2(^bH Gm,c`ŧo 64},6rݛ1ĵ0t܈i`gCtA!/sPez C bN:3lMgaX|azP#J.VnqpQeñ/)Fs#QZ>0%"r+>"QX9k\'?%-4V觏&Qv/ܾs7 $ s+ߑ0vlґmxs\KO&]bbHŘYha"'VU5[)ZQŪuY ٟE.Hɔ×8 KJn5xP|n>E7d~*;i`{>Y$QY=ZT=ʇ(& Ey||QݤҔ).((yq(pGZw'( \x i!P[`U6&^ RYhց.=,a3E_g:g'd%r"8to2X#f \\q>E(Rq:@۲$^8;@-$Gq|oƅ>-e>b%WQ6}4(RCQe1nfՔ}xnl@Dk*)]< iq7jI.l{|g1z: ~*p2LA{f ˂ KJȉmAZ"5-,ЕHi@ʠf<8"Gd<Nt03u24z& |8N8D[-FQ2-,50΁H$7kg@N6kFё|x`$!NɁd8Fع528YXR$LM#R;.Ԯ14k҂Ɣl7 laXf(RCQeJx鉿$qJt+ 3,:H`@Cɂ6)aAgY`ϊy$oTD\S q_.hӾG^~$>ёz\#$a74krADj(HXgd$ȫ0kfu%8ſDԒǏ{)5f4q_J ~Vu"t^J ֢7S dm_qit҂0}`%i{SQ㶅eԋ)ȦiX)6pFK<5AiA4%_I 6 V:H m c4-`5c'qBnG~/J9 ֈ1YHIr"jA#Ej8JYXvORp^bWo.."-tUbP(2.9 m6Gm#r±h֬hCU ,$x։a}?V`Qj'Q[#K6v07nC575v`%qnZp}l((maH;њ!dob3NjLvؑZ)F~Y[uiwQ:PiaʺYq|{1Nvv7%| 5g*Kv+xPOrϏ38^W_mH4X6N^A;0.{aA5ƃdִPx`I rCC.&g.twg i}rI&ktDH wʦs[VəuۆOUQJ:x>[s U=IԄkY} 1,'%[$":ˇpMQHQch0kIv("8h$ H[P4nt- D)p_؇06Ei0ʴC|Z'i@G>-KN:H 8/[,YC/4`,I–9eĂAX12 Uap7KV`!JGA$͈-*KB8J$ٹK {PO>ߟ4eYXod$Y,mXI2H?-#ʝ } gwLAI'֤Jebڂ $zxʀy!5 :B@5X'@6׬y FPҤLIPp0}Pc[XB^6o8h<jf}(aڅ$$c$k+ۦs+ϩEt$<zݸ4FgCzwilP%iG?8ˁJP;עŮ )EWynΠx+$~I?fxK `Jf9º\Z'Tm`=<MJvR/숺8i;%&ǂ5^05+H\ƺ^.11"LLБotub!y% Rͽ+-a²ݤg6u=qw*H rzxߺ%lcTXiȕK ;>%C ?D+R!2 ]045K}v 1/2 m!1}`$'l)i>Z: kdybFC)r8Ԩ-^E|zo,gƗRr Ï;fn×b_8rJqj)&NR]8ˀ}9|p52BXgg?:4Jc|NXkY$_lZHђ!z85)H EyyNHZߒ%=::~c_Q@jt52CպiFvMzU!s/ٰ쭍%jzq\i`G[Tk ˂0EeJvd5PFF) 78,'SJ[Rx0 :sxcP: F 0 ,SPN``noJ£V`:%VI.Pq2+-$X 1IWNbW(pC +G5rpEE>.l+iK]Gm' ,!I܊ǶXB<Q㶅ud~b5,, w؊:=.EmW<|f-fI RC1e CKyZ_y@;NqghH( jI3IFuO3Ea Gi +m2 LOIbyhY6 A ` 2̘B7%{Z\/N0V%ANYpKxIt g cdr7sC퇃;) =l'Л5eįqYcg^hZ0Z4W+ 7"pC|1<cm 鏝5Y)FUb*4ؔ኿tV 悿 Y jdű ؚG]͌IWV@O2 ̏fI+Ʒ}j@5?sPA uxgo/Z8㽅xć[d\Y`rnQXQ2.>UEJ R#|qMfwbT_ ~i@p|$%;ikb=7"5cZXf4Óo `J ۆt0 IcaE'2LE*ʊgƗ9܏Y \P->礅ķd)aɤ h7>aڿY¢A>8bA"NcVhPxI20X*ձ;<^&:b#uj!I0Ģ2XfS<`$)l h.1AN ,bt(xHVDΎ ~ 3pؑ{z 76[I[>W@;>_fEH $豜$]8)Gȇ(-3InQBxfmH m <1u*g)8dӸ]/ ڬXÅ-@N Vmҿ5ы U^ \,+psDpX>4ߟ%+>"( )]vl (Iǝyl| {wŖLgF);rt@6}<| _6$@H8T<[9Rj<=n$SOV#$(! ZهQ㶅u #J/p=6u_vU@d\ H |a`2q LMNAXh#C͠$,|D%!PZo>]@ma~f觀3nSRrv['NYTIN4\JgK!p9:NJ//3Ж=7yTJN ~v2ģ(ԫ{ Q#,I`c q2 `ZYvg$A: 3LfUs'~y_=aVoU4ifn]ҘAyޙ(IWLcs+q׿Y,b]I LI! ;{3uzC߬jJKBxe܌˔AMitJErTR򗏦k Y\y%: ޑ;'ajiJY0$M!>6?3 k8J[XWڍVU'&A͉_E ?G],.26sq)oQ|qi00GRte5_I*8ׄ8|EGOt%)3 N!bA'mvMH529?vug$@ݏaOO+/&gv^3jm`{z  1-,P0of\>IFS4?юl=:if@,!ɭ?Yi'( ŝy('jףóq(A #b#&ޥˀ1=`$&{ {8Ծʃ0qCj(D_7-v֘9I:n4։ H8-7[_@a7ldCK2!\ccHE9>{vtC4ķ+`w\aU!ibiA4)pX)\g N`8PLaE+-R":etI aC[H;u*%OiacbT؜:QXQ2mw'&&Ɂ kA}-I exx'$ iލ¤0*>c_^ƺĥɂJGw&]m`|0yݓbP 4QYwTuvFox.&I[kc'bSDxH|nJv1ʀZN.5 о }B͖;ҁ_V8 cOח5:O҂;-KNvOp>ߟ"5-,`v4?"I@v Nb7!cȬ.0ƁKx2 P6hLNM*id̂l1:lq7 6yQt/BtX X^ 4Ki@pqPã=9 0 3:ǒ8P'!#Ǯ82~vy L!ni!1F(Pia./doJ6Wf-!%Gi,o*N}sh qQL vu|GG9"o]D]DwBÖ¸a Tj|xBķ#Jrk-8ERy;Jݒy^lw[k[?^FmAYz$~+(JCqejF *+Ɏ+v*5ԮVSeg%Ņ{mH Gi < xog5YC$Xpsob`lio81Խs<`FUsJ.).x{ldUt{&5G2psJ҂BGޖ:+8FXfF8?:ybj ^ֱOX8F5-FXfY,(Rq2]iV XaLp#!u= t H& $N,8]Ӈcce}I0c R횱Mi4aIͦ ч0624-H^*慤%1YOKc?f Cxx& a&YLŦ+5},BdF.Rr,2:/b+9ywvrxb8%;؃#zue/2t K7ȃހ_,gG⸝UɀpVhBȇ1FDm`!q֢&ɞ.;9[Ӂ{qg X2b-gh:((maġ}ď`ˌh5#.@NY&t\cA /sP-l̃7j"c| FbO{cbi^ n~Jhxd|W?Bi0IJL"jGB$y0Ʀ.Gbk/{i|_XS1cŗ×&zUʥh `)(RCQeYmbR Ehj[PO\Cƃa싀 S{5wLA8L{yv2$>׍;DZe0z!v@ ˷<ſP7Kl'mFX(d ]*Wi܁µr5 ,!:i!%h凥W;s lǬر,u-IgEZ@麯e+ž5QJvGmm^SX-~vW 5LQJ2Sd!'OP 1 ,()Gʑϣ(8ut#JdEaA _[@\u&5 he3o#g%hL[X='Lh:iק HLϿ2/> 1-,PS<ӀSr>Ҧaqldu5kxI)! d|wB R1: ZM w,c1$09lEV d9^pK8R5Zi?O@*0?E LGA'IInH4T$z%ul&)lPxC:K؆9 LTe`z|x 5yp#s1Dtޯ`gNFv=gwMe_{vB|6Q113~&ɛ|ДDlfPG=w).PƬqٚOv$[t8`h,T7$aT!ai3W9}8ط1-$@Iف`GAT(maz\'~-1.4;,wmRY:9#1F(p0BdMrKR.],ew,ߐ}qInIL bR6cLi|4tDPwOFj%Bؙ# GJ{w> o pz Ő1 , e%~[y(wO -x& <' #HqK z|?Ei(CYa KYay ){8j[_T͙q)JCy s8bƑ?԰Ih\oB qƺvhm8d]J__Zʸa`2B513i:R_Xgf,Օ0;ȘX\$( eMi ,O:N+}'A𢡊?UIKXߨIWex?sJR˂$Ŗ! a&wnmq ),]g / ƍT%,ċ|?Ej(ʴCs%sU,<4'1BR7HX^hOߟr-Gϱ~9(Q?ZFS8Hأ& \,liSFyxԇ] [r7ףG6eENl*jeks)M ߿= Ő YsM鸚/$:ʀPGl:Ui`7XopL@<$h0f;m$gХ&.P>pkWÍR\K%-Jj??8?3ЬN>b%ё􉚽h-`$ol;q$²ahb5-,HR/r{.hYba͌&Ѕ~?LApEB} µiU D,Љb|%J9-Źu2a`&N]{`LH|$%v4 ,nG8X&#Q'.Q {fw.U\7SpMDDI+—D179ߟIکސ*yƦkjv15"T5ym'Jy4e8IRr[wRMEcZQH#u׊K2҂ogX8qI;,$|,m']4sd <>')&X̣Ab9sc$~g 4ӛ,7wD-l 8 '( Yѭ\?YA\] /Ɔֈd!16;^5- t6p5i&d[wSHOи wWWKۭvLYB]TZedM "5 ,ڹkosk$$Ia]pC%b: $>Ē ?br1V1X!r:q"6(з3.~}۷NH͏7ta)('dizGoɵ>W`;ͩ32xDopdn7q%:|N .-IT[n1F(pCf%͖崨1j/۬5^uQLѬ-]5 ,SPÆS"NID?nkWU-qmlS/ ƛpREc 1F( k8J[X!#T]>ϖSvh'/[˖`LA Q=&C(JQu>B9R4)Z}@^q&3i -cP=$Ml2\<]l& RCA2|;,Jr0E?T›<y}ji,[hoX˓kAsoL <2-,߄%a(O}O *1zˀq_IpÂQ|2Rp6̂DzQ$x<7ޓfƆÉ2`LIci 1jU Vp60ρ-{}qvS >XEs&rf>Ʒ %Moqb?9 !5 ,3X?!$7o7p' 0}sdOÅ@KJH"-S+0vlA#Bj8D[X'Hȍ֙AɈ(&a{1ol~y(( ÅR;( aGY(+]OCL%9TT7r()iN#g,;I" P[qQ㶅e&7f}ۙ>X3 |aϷHK|8Gub%cSL#@ $^gw"4{x4N;tY^1j@P؃#sb %|sGk䬼<) HdI ~CMj,FXrǂ7 D1(kd4B\`,C䦄Au.Њ%q]lh rSEpk M8QXQ:z%!(c]7IWN/nnz~_o ]Y0r5)Ť|v(QaD(21EGX@Yp`*zޏĨ@FqŤ@9PQtD 1:\#MRC!2 /%-y "yʒGʚ5bL#$Ubs蟽 c#ICa: ڨ1yԖv `, >Lrj<#L)&If[8ԕBaQY(mcV?h$7xnONt `u~N~n|x$q0a%d)<5~. GՊ|D9 nҷ޽W|YC)izT2(dV]ÅH Gm ,0$n q2j"DTݟ&pc:ɕe60F(8:dma{UyvwKx\Pb7+`oZHE,%, Ǧ2yߢ1qR3 l?5^G3$@㦫y<<q@˵>wd\堑VMU#U(-iz4xW4 G>vNAi`9s09Uȴa%"F 5P]WP[લ|e|n ~-7iKҳ$h`%˦N?9%;~>CQL {7> ^xDq ‘!Su@dA>0BxY= E2-,P9z$;qv8UII/X 1e@ޟI5FHa(ݴDj8j[Xf=&L~uiFch,0; d_`htvK6iS\(mq`|KX?5NaBÔl}?52JYXmk9 o&Sѥ l0]YEe TÇ`0BCߣv5,)A;e y84.,{BCD%dc{FF) +dcg5-,<]Y%TYN5Y0ޕQ\Na ),Tst9Kr6="Eq J_+ vԈt/DO  =.bOE )hZhqMR,X s$~I͹? Ӳ`LOIBNӓ.13Đ;D_'!-$U! `IpQhj _q)<@lOIzOP7a#Ei8n[XSb'J+O>F#=ɏG=(R)5ex}SJZ<& / b}S`h,n~ ʜJ1>L?-Rl, ·nS ۱ xB3\y bq$Kɵlڠ!&ea!{t}~rc hږܶye'9Õ5L(oMN{rnlHDo]ב5ƛ t$<^-mP??gx9|߽ PcK3m|u]`oߍA#(Ro >cb _&r#w |iq[8"5#*pHꡇgdxsB%TǦ}=L>Uv 1 ЎlKr &8}S"0v.M_0֥A|~P TYv59,ɉ)v~|P}MHR $>, B˾޾cu*x)̒˙ֱ¡y\ JWA`|$L- 9c3yWՉRf'iQJpap(7i*D W񕅓p]cԨ b`xELVGYk, !`(%R,ԡ|e|П*nC%9I(І]4ˎ3Bx'/9S C9u²T_~fǞO!V;#G/ B=1.N2[ 3]/%ʶ*sO.1BAX#cuꪵOIFϫ6p'34rʂxLkWl Ra: Q?4<~VIH&Oq tK`fѠxf:PTcH* <+;+W(QQ,˓q>,ɅeD뫳ISaU+%5S#,tZ8q[S>NTmaݰ†]KJjoʉuzk vAN wUiwh((ea6㌇I?N}~$d FY06]I:~ueAD#.3 id΃ny?q4-οiE/ͅBI[CY<%e]-<Dj(HXfT'(1niYs]ܢ,THm'ɀ1=?%gVʟ ia}V`9~!WrdKb@ց ")ܪ1 Ykyy1V;owy;܅vpE$N.Jr4p.vmaE^g3fJz{ AP-hĥ* Irт4LJ.r|L/zбjQ %; mOT7xFɅ˴iRTay}?Ej8J[X78Jg$y=@lĭ-q1k`7Yۺ$ia,za`(2Wʟ$=J/JX,F\y&<1sD։Fd` >VшS[x:aXWCM ؔ=-aġ򱩿AEa Gi k..^m8Hi ƻiJrALEa[yvU+_ϖgn-iv\1^ / >˂Kp;Wv>nB,`}i~)؍9h:'Ѭy\XGN%ڤFOxqԜvrv2-sG̦DIn<0/ 4f* 3m6%L|M\,'FI,eۀx#~r̔0)Nbޫ4v5k֒tV•WpCyLES }nXq FK$}'&th6t!cXfde͒[yҗe?8x&D=4TAI30] e Re`!;H7%,D6z4R%FƵ4b& I\a)IQXQ2%2kmg ,aC!ljt5\Y7- ħNDK2uv:ǮKE!Ry(уACIcI2ѣ=X]XiWLz. \ӐLh^de`"//r$`xq 5p{l;G }PGP e6 srRi KmP"ǚZK.N/Y|Ḱ( ,FXrb+.2Ej8J[XHuwt5diJDp5\cpg& ֲaKXQ4 *(Rq2X/76$."Qâp; pLI'J#"f ›y,[@dC#Ei0ʲCIʾ[O@> ϥy/.o=+đ4y)0ǙF֗1( W @o nʪ:{4nvwK #Ri gp Ra2 ^U?s:TX^$WcsH T!7n f+xlr蝷i~=H+aV2 ERY3i|Uaw|\a5 O ǯMc#H Eh =r[]H$ˁ{ ;e$,($&R12 ೃVo ߁~#(.;YaIu+ jbǦ "cXf3~(93KzDz61!}xXO#$i$D\c( i,mU_JeAdZ:FR=%*K cSuEEa G) !ܒЪ ez/C#eZ;PC,'n0M7'Gx x.xhN_RCyjqT< IN8a&Ho ܲmLa<HIN6Ǔhr?/~FM 2[f N`V]U{yjh nG]taX6lZ~ѣm$-F{lbmп61yj41Ϳ?%"hiGP8e^?5 ,P4#`T5IMy)h;&a"0Έ(ɥiPtA  "5-,`o%f d8犼>\av))GWSskl' 'uc'DR1MZHNWixkHcTp΃i$)$,R^F@K]fi$)>qI>1BQL <8C߽'QՂ_ĊU05Bb߿dU,|osA#Ej8JYX7wV, bu+{įںq& C](Jp)SAyZB>oxbI>p;-wciaؿL.1@1ce {Olj?/F)U16.JFdqL|_9w5 ,3IH$A?<-ZXwwsyF 7,r- l<ÅBH IhOv%1)%a.:o8pTbu N>IXU\LR1X12 q=E9ؤT) î$#+YIX՞v\ې`B:@>Y)(jXgclnL`R7-Upҫ4" H(ƱH Gm ,]nql2J.F؉LOw9kOEd(7-}+ۮFF) /sNôXFyBslv|)3ᖻI0-7 d,-l^o#Ej8J[X 8Bļd)yk]#a Ƿ1SA-c@$'۱BL)C>Ei(ʴ̃n7w$͂7 c"9ej\H _Y k>FE( ) ,De $Z<&M=o1 $.)1QL <>9#K$.GpR86~y˂1}`$Nz]?5 P 'nMM7I2G8zlXloFl-'[JNvO='G~2PCc8)At$K]|/oƱht6k. Ʒ)`*W"]>ߟ"5-E.{>dv/"8¨,SﷃYUC8F(pܶ΃ɝ],hdJhD笰2pb|}V)_d@.0B{i.Y3TPi`Љzt~72%Ё&'qI T &s<>3Io(M-;}*%4[ޗr"5eZX i/Qv}zӒQ"eg`q<@,FjGclH,4@0Y>AAFϴеnXb_&LHy3 OAB!ON iR!4ԭt X>XXCy¼5$J5;8g—r ,>Ixt12cce<`BCuڡfFv[$t!Z2i0{O;bI/-ܼ B3\AeJƏ +zk`a>4ӣ}MDz;5a9zmzK$1hdx*j קKP%MmPtM3idBd﾿YwN"Yp:ΚK)42=Vg 8$||lwr(Pia(=n2F~SbTMaTq_F9kdcӜOzB^((maGFeFJ:^P{dIz>g` 75%q_d|3qK}]>njY 7J =&FmS ʀqW OV11F0+8B'7S’6m-Ƙ5\=YAr#-Ě}!4eZX|~s?hF#6"~Ip $HIϤ)dgDxVvuo1: m&[5bGL7ٞaj~n|*$#~5~V ?*nnqX5 n*EÜm?A-QS4)D?6H|$8O/%kˌ!5/SP: \g<-F)8z/=|DD%SijMJ.뤁OtATȨea [ ώc%A1T;`Q`[e)_Y(btE(2s2)ٴ)*^% x{ >ˀ)R_C!sX%}$BF ʴfKd fMD0<3%  #5-,B81EۂƭN\OrNb4Vi@0`  CB R!e E=coI 7 i xO>}|F'NI &Y(@ͥĸIDV fOO /Gs2OT4~_`ҔL}MȐo29g pO)GE[LMZ"PialU,S^A]U ў($į,7gZd㽎- 4+:B(ma|ǫ× ެ| >ت ( $ {,v A]F e?PDhWp6P</58~݀Ū;.ʂq BIO0 Ey$!ߟ"5-,{OK[͔;6`t{0iW>45XyBfJ\\>j+ k8JYX|_;M\H#l-ߡ})_FM )Nm ^.AbL ,k{X9[g%ypru h Qg?IEeGIN\Mmb>d! ,P.5bĈ9Iȯ-۸>6 _tc5ƃPX+WQXQ2űHoj2IЀ c7.?p5/^?yyk:yҚ.e Y0m*HQRrKh2'T?kHTMRA0Hm`E?zsДg%ؑb V/~ɩ^B]C-. ŞA"5eZX BђT?q91/o笁|ɂr?Kh{NC(RCQu*bb .  eG5ԞU1) &X+ +Ӄ*+8BX)w3XW)jV 4L n-1v=& ,ӇCLă!4eYXfIh;gևR%vme(7rsTe(-g.bxJrY@v!d2P|ewo“iH'p|(99mrXṆvz7Uۉl y 1.A6itn҂Fk,V|E5-,0=j#hÁSW,w⯶'N._Ǿ֟)hƤtAT ma8w2_g%7wfAXv??7K4%aG&&#>v\ȹҸ]_0swF\;~cpo$G;Ļ%AdT|4'ugpC:4-6[ehgzHBõԤ@R2 LJabx B P Vp6B? P05ђvϿ/xE 8L'?aIn>m1.b A{: A@ut{GlJ_:ՠ|8X @tof+G?BCh TĐ 1 ,P1TMQXQ:. Omo]RG6LAjW4ڀJ&ū`eJpJY(u/޷R((bbٹ8=nKJ%sS{ق|h 6p8IOFQynRwX(RPqzcT4d,LAcJ.6MAXA< dGgIGXS@f !^jH,;$+=la02} S e(maG䌇dLHIH7t6_g0sysnb%aw46y ~2+d2NAo3'4L8| hչ>ۨ>» Sи+ob-%!-g nA~??- nM++~i:-7)! n,qxHKm,2Sj0e!-$(IgZZ nС42JYX!R 5CaEJɍA0ě"vNv%~YVk.~,$>u)TDea!s򴢰uZWYTđ$ Wm! ʮRo>$8У{|)02DW3zT7_͖ۀfZ=xmq' ƗSr/-Iد}p̃Uߟu}46+NjexJ#&'dC6e_. aDi(F[Xg!*dF{ip)aESAE~@eMaJ4b>$aeW 1: )\L ov@jSIB9rŔJL3k8@[Xmv˚$}^Ï=ҳh:IϫذsL]R٠! 4R%f2 "5cZXf^;Xe;ѿ,}H+ Kgvk`c٨tXihIe/PLɉ㸅{XCum8̡$9[??4|F\=4(Ѩr<yD{+ oeA2`marHዝcLwsXGY ,`T~gH@F>D15<RC!&!P?=U$Hd,{xW6M & _Ӕ'.i7]?C*8FXf┹/'*Bj%>$r߫4o ʴJjj4*&[eP?ǟ͸.RoɅ4F)wrmW'V0ARpPxKv&\΄ѝQXQ:Lw@(A# b u7&DF*Z+3aXj9<&2l eX//3P0{Ό8L.vtjcO&idƱ'wYn&TP?-V3"% XBkWӥWg ؘLwB]6[Fa Gi H].K2X:'Cw7 QIdXa4I^$@zo>k4ֻ?0XL"5-,9 ㊏x:{6kp^Sf,y y/TT=e`N4'>u;z+ͬѸL ;nR?MSpCCT ۍ멳fo 4ma\f- Ʒڍį(-e>1BQe:ٿPDsoܥ :dP] e.0B}/Ej0HX&hѱ^ݙk/jN_44t/Ջy*e!N1F(pC%Wʨ$ޞۦTo#=U/d.4৖c X: ,`AΫ̿YwŇ,@^1:9w::H1W{ƅjIv$җ}cH Ey͆=4R]Y{\JwdˠsJym*KL+8& bA$ |rma ),B~mkÒ[\8l'2Icafz .'8u t^ 2f,|r=ncV`oxf `xF]< 9 m{ࠆ'j>კB߳BAz>kd.0Bo7N&e!rҗI1: %]-W)AOhT/Sp$hJ:CivƐYL dW5Ɂ'G̎o gP}Z0nL ^-ˇ+2+pC ."Rq.#8O%O8t) M%akp+^ EyhmcHgn$+8ҵ ]Աj\*$yuEyƧ ۯR3KGF#-KItl!YI;Yb;ظ&elkK$|ql{AWclW=kā{ 'r;9Ý@* 6V1M!އ<#AƂ', e>``j&,3LOӫt1DPAÖeZx3KI?=z~f Q3=ZBT*ʲUE2-,Ђa$b7=r9ہ|?5, ܵC5-AGcKwM`!: >w &XpN s(qӠa!#PiahbaXR]BnϬ`|ZreH i ,Ҩg32j|"Sͭ6ӵG7JRTYH|+i$lqo J铏su%rϒܮ-3р􏪂Dʹ@ KQ:M VsyŴ)IvтՑXiSaH꓅)Jxapa]FgʜPZ/&˃Z@sQ ?OL^( ƻوR\@NќQH#uZ0z[^ΖDXZ8 ci:%10Txd;~^Q?~^)q  ?XR"M ?/K#da'^MŗQL <8aoupn}Dv*$.x.ec3mX}*MmAUea?Z*| ^\@EZV83~<|Y|We@0@F4D}"H ŘYbWzn bg.D #nba"3>5Zq/x:҂]."t0LFyy\׳DjakwX Enx١!}2}IbiW9 yA RPi`?I,A$fgg4 ./ɲ:r\YO̱g A ` 2d"=$j˅ht!F 987kKx^r IDP0-SPc=S%LT?NH}e"Zf$ߦq`%Q+.Z[h=}nŞQXQ: I+)H) QqtO ,Eqj]tjvyU1X!<>w.i(&ɳUy9XmJtaK.BA"5xwK(C6^8!7 B o At@B*(4A)Y+;,9Q+h5VB(h"vg#(ciP5SĎ'Rܤ3 vT5 Cdq9i( |;ޅ8}"( Ei <׊H$L=K*+<4+qAF#-lH*GLQ6zP8V%dާ'ԉlt쾏/J95:1҂_I<|t+ k8J[XEsLl̸O x #L]ڄ_qqAZH|jR҈t5,30-|ߘ# 7!A#1AB?iz@ܳ5%+Bd[TDJ~Dj8lXgsx\e>L,8LW8/[uB4;ҾNYc-piё-n2/2@|5~[geg55ӉU6Fq!?>&Ĵ|Ɓ,*H!MA$us중BcBctL6lG}2Oʿ5 ,Ъ|Om,E/at.C\T W 5XL9$ lTDb3E` G(ħfI"0F !&Ϙ KM@I IfD;,wu il5xm?^{R`LAɎ4$.,t m`Ѯ!ƪmlto&2#G:Yf6.\Bv37蝙i~w.g` h]7?[x\NVr=)`HtK`I)!2%#9z~)%M& ϩFCwϑ$dZ3qpȸeaG^BQE7AD󼍭k'Hzy15HKA\a dXٲwj(T^"W-AEr>%d[h'PЈ$1:y,KI:m*  _VDD2-%OF$$*pZ'|pPƂOeItgʫߕ&ҿIm"$2֑X֢Vy 6%FVj쬍O L|JX UWzCin~$qt7>>8b#4YArg<a4-Щ+(Uaɉ~hi5Z˸4eX#FXvA:bP(2dTv'!,|/%1F(Pia=g=,q'0m[` ʒkdY Y[0[E!RyL˛;Sf-9Q .__-~ R`L0޳%=6p6!5cXf7jZ?73:qA\ 8@3!~q^X,+ ?S?i$bWYa i ,OTT|m{okyfW=~Q4#$:]td okoh^#e@_I^B\c( ŘY=q\I+r܎`rig2&ޔc3\ue=$ B P m`:Ab #JT(0? ي?Q(+ʥMJY0m-dOg+p#I+w,M)Bu&oÍKҬ5pjSw/, [D WtXC:` Eh t?8({y2lIqIq]oKLcۉhh9;6H0΂;"$a/8o|l;c‘+1k46H ƗrJ$t~i: BH x3п7妞)9??g ˂)(ڡG^u;fn' &o dۊf$'yJc' $(RCA2 _`UÞU) Vn ZTo8w?/5j ;7œ_Ӓ3: _B4;Y&ɉu= ?:;+RjR,+ NƧA "5eZXgbw:[$*d;.@Xw<8Z7 h& ,s' JoCXFQ2-,йFzÿr|?u\Ýq4|& PxB9I"- e -(R 90Wb%+Ɂ#-JƑo}|`<Թ$Bdi1|(PiaSl߫ KnQ(%Bmȁ⺣4( ;&I#NZ|YQXQ:qpEd;Y*t=մ ɂO5J<3L;{! bU5!PiafA>'eYsa=oЎ{'Ri;%H2, MK) idCyKNJUj H?07iRZ0>Ԣ$'e3}6}t W(ea Ch}:WĔIt e;v;0=ۤ15#,ObM>_FQ[y(SIj)%?npK # 7'@7Ӳ L!InM[|ه0F0PiaМ(4DW/>[hcy\k껾^NIr 7IH̐T_)%7[s_kiH0*\%dXخ7*XI8hlAq"muG,j' Js :`#5-)t_7 ؾ,^!~/.O;i˂qӶ;%7kAyd;4r J؊52 i/{A:[Hd$ ia8}"5eZX!jkՇ&Y2 >P"EAXf w[#{c#( E)e|yA'/ ޘx&t!]}) xA ~Pv\E/w /gu~\ZԶ]/YWin7i>$Ȃ+ l_>6]EWpC-@}fo8s{6hYmp;iQ/T(ɉ$[CQɇ0F Rp6BI;D. 9gSSoByhX[. =@OSQS/3 6G>k8F[Xf9XwJ8O{ZIMa-5H(IPVOO].q]AH#udh$M>$ŴO~>+t-{J20CC2+8BX RH=%G X7#K/k6@6%NXv2+8FXg!Z84Kp\[$ĉd\"^^I'iAdI@>4p,|S*kdԲBU7>$7D߮7qiO;v0Q/O&<Ó W1ce[$hT5|D aٕʂ4ڢ `ظy<X,ɥ_BcŰ£4x%Awi8)%A7ot` g w,iݴDhۺ?1khY0đ2t`'ĺYCQezzrt;IH|A"Ov8Ig}GR~Iц:G$'r|O/y>A[zJʨYx%BB= zp'X;'=" У)NbI2pW#>+- $!y~ B P Ve`ggx#9AI  ނ`tc"D~<mx$zkj|uB_%ƣ(_BJ*/H%/phQikҿ>wt/kkC N6,"y?S,{/Z {ytJ=73k(>?"}T8%XEIet&'Ѥgr} "w/>@J!y٠+#ӥu7袄۟`:x/̟ v0ֻ$;!iad/HŘYQ'H Fq]pI\'>Ɖ`L*dg'0d#ӘEj(J[X񧾃ݴlt_c⁍~8JJiRi!qc$؎uA;42JYXR2Җ\lnw)$)#¶k9<$p,tKهAX1: :hMJrzd yRq#|~~Y0`. b "5 [T?%''0ioӢ(ļAk4tKk?5I:V^eGSRyd.t.JO]\( E{lskD6l!pEd>-[|gp2̂ 80jllbQzbU笁gDZHL$1e=m9B,* M?odو"%n,l^+1;"%vٱ&!;JX (6g :ln#Ԧ|5z=K&@/p-qJgc!OIgqW>fp#㉚fr#r+Z'}_IDvZWKԠ-F7#cIw1q1KAs Z—dB>+m2 L$=B4ȹ!(+8FXgz[ ݗ2JE.Hj /˕4 KrdÛzA!5-,3D_$xer7>Gv5l3Y ފ39%Iea#q؊5YQ㶅eZvv؁w/K5Pr2LX=k- 7J}WZn)}Rp6B~G,aGb;I~|>z\I9E[0i!jfﯢH - <*<ʊ2kҗ@g]=~(hǻ&*NYcoRp-lY1F0Tp60ρGyw^S)%Nj+hh5-,P M %lB #dcY4Ѓ}PSԒ X)2"5-̳fsėNلH!N+ ƗrK1F(pCw 0b)q^Gܝė7bjeC5p8 }s 5uztVp΀O5炸$Ѷa = am<] |x5\es䚴}y×E.R5Yrdjyk=S 3+y,b×Ir*_adcF(,$?2Jب+yqJ߶'˒|pXQ]#(v8 ]Ce(:myбtt7偷lgǝ%wղ`S;yG WAXA2$ I)96cܢɳ8uH;oS SÛiAӽUF`h,Vx;:[pVPq:A6NʗƆ2߲`L1’苇,u C>Ei040OGq!Cۖp$UፍWwucLFg o)$] [2pBuU[f {.mT0X5OxXY9f잰%AŐ-i<ʇq`uP 1 ,y9ZndH~@}2DzW;9Y7)xޓbP(eFqO X q)!?6Gb*-$$#' 8|4RMQXQ:6\ڒ]ԶFUVp6̢3]Qq 7I.,w6gg7cg~[IDapfH* +A gPiaױ9 OJ/>MJC;aKc5AZÍ$dKjmas:l$'Asȝ5׍VƱ"`i L[H=BF>_FQZP:U4o_XWr>VX:8ȑ??jz{y'Ɂ9Poӗӯ?vX`eM&[JPq U^+ ƧKN <} * k8J[XYCk4LҰuGY=SȸeaX.Xso<ػڐ߼ x $`QY0|U禅˩A*p̃'#3|WJn޽s*+AZs_N Ls|21(iT,S]Z*%920r {d1 F.-$$$\oia#'}lj SQXQ:?&w1I ~;$Fr2O?Y 3Cr!>-/C#Ei(CLi7oiH V<֐ "q 'sKo>4+pea OFpΆW)B]!hP5ܙ Ϭ(z'55ֿ ,&. .%*L+Srǝsxm@'AB> ?Mġn4z _ %mK?R򐥰&7KcgA9+l5o6׆W1X#cu\nH9:M)xl88N2&cCq۶ʴ@FdAxSu3 kʅ0F0`eaR Zzc$AWy3ᩪbo!5ܸ1{$!ˍ <cBCu|1\DZzI{żoyhh'Iy[MO[dM#( x^~!쳈4eYX桧a#3K&=>$Ze(K+tԶ`LAp0K.$S \!uy25??3'd4; m]xX( |Py<] w F֡rk D݆0$|B*(4AoďoXq\ NA"+A3n<kՖ cݦ²%no:.Kx?: Pp:8O `ZPLT>1BQX#㖅ub)y/vd'i@U7 nϞe58la$ϤdV:G%GFa Gi <ĝ Tْ xPTHtW[ĔSٲ%9h8b(Q:f3/.vMyt" &A=k4!)"SҹrMM vђ#R1X: +Lwt~UFz9kԷ,$7/ +C"5-,PW)txlq|{[ܽ^#ܖ- ^I1F(pܶCY5NBLN~ 9|%/*iX %9nnۂGiepCcX 1_}6/53_uui",>Nɡ _%}w((ma#I N _]lWw'}H_ wQJF7Fv3. _#v8Di|xv\Z'Rwi !xߦAg!otP! ;Pјg?I2=θ#b+1 hy_Z0ń/Ic,tl1F(Pia_bk|Yam7^ӚKfh]/ D&hB4;}EyeMOT*KJNQE>R2 2cG@oR؅0F0`eaJ2wRJäM`B᡺ђ,s#Ga GI 3HK;vNI,F:5MZ|ly}Gق)١,-t"5eZXU>w;ȷsIXHj'0'oO_1k,K–Fe\QXQ2bC8Y'XnNڴ1?.Z=NԯYO EZ-{49F(x#stg` lqqd{~տ5:҂J@4=[@gNlyY>&ɁGXU)xqXC#2> &Il,;aK` ( $URqlNm nl墟GΣ 5cݳKe踁xRe0Mw2Ny8$q SR 87wT1 ,g4$:f/#HƗs Jnnkc{& u,nW6sK<*> m`2Z?)lV;EYM52Efw]e4jYtJ6URAH G) :WfVp6̂]O>IfɍT;3vGf8.j#nvN yJ Ɨ%S'zZ1F( kdCM<8M=]øFV59Jc,iJm $ /;rهw"<"MXX"f|i^x 1k0I;Gdwp=v _̊"۾%-`ou8ȡǙ3kl4h bMn2֐ a` < -ŊnWӽw;]a^=UQF;[H=,`4+ 5-PianyoK6;/۷8.;Ǭ(-FXrN0-쇞8A"5-,;U,)9pw BדgcS" js" s,8]˲8_/?ϰ4| \`\DM`$ |ÿ?Yd c5,z|Ee kc eG`$ :Ζ9e~<ǃ0"\,H {May5<k(a0`i`"u$AlWI؄7IfIsr>k `VնН((RQ2m ݨ"Ir0?'`gxލd+(ʆ>&M\įC+Iғ㦲2-\A>1BQX#u1H%ڒL48&" $HRH9IYU._Ő 1 ,.8>bJNeAqw6X'c7QzQ e J 7ec)X>[xep#qg+r:7<IDMnȒA0n?Bj(QUzCHlH\FE_\G nyzB"}OIY5^t2G <bB#u:ƾ,pI}Xf^O`KX>nJdX9r"5 ,`i r9%`iޙ߻ѻI> ڭb=Y((YzNQ0HXyX]Ottƃ|wQH#uFK (ںvlnY9VÍ2Iǜ #`9P @;>_f@"k0+o0!N>߅M35)+F7DԔdt02!"u|.;.b5=%< Sp7m>; 㑵oA9 ے]B<>z'/\y*H|]. ,h6wl(Q: Nx-uh'!ʓ | N K$AACY`NxEj8JZyk;VL$6ܲ(%ѱaj \IM,FH5 \ó+ Di(lXg!1%U)IItt)^9 L4 Ikɀ|xB#'@>1AbL,gkE~JqfN&icdbj,$*.ɦ%WQܲ3?69'r |H{2Ė?61k-XX8%vA#Dj(H[XfD sr,ҁ"&Ta[k켙7V% Gb)F# O×E5JASW9"mZpw%M&T@N i`Szشée`CV.=f צsqwƫq3p\Í_>IN7^/;!ľ^4/3EZ%H]98զ3q +EƬAbVђ0$-|;cA* kdC7X47K\6vB8!◩#𦕏7I8_7#5-,PZ0lKv& ؼn'ͳK3O>WQF'<+ W@5le9SyFk*#έ$ aMpr|yg`gL PPxMo. :Z莿Hٽ?fl;#(R GJ jb%s<.J/Z yIraIn ׄ#Ej(ʴ̃gRfKd@$jM.e7pX5:m҂WIpw6Yd") k8J[X|=yo|?<^9[jAt@4`ƒ , d颛_!ccuze憥h i(45YE?_+1 Ea Gi f7`M$iXm((ma(I{$7#n%V0 1<ҁ +k8>YXggLB.,n?t$F~46D^3Ij8) !5 -~A"5-,_.8X)%};3jcq4C0~YcUdA>0BQZkA"5eZXw}z][*D=`t=' &R^>^QXQ2 9JB^Ը{}t q'Ťe@0@L\2Ʌ J1: C6`QCFjIbY;S4}/IdΩʀ\`$8laM._Ɛ YTzYz]ƍe/K˦yevo>wL!'/S +5dpU_?KpzqLyY]ۀ賂by =(6[}~y~[N8~Y\a_YFdAx7u]J#l>1BQL !3 id΃gF KMTco5C( Y$g & Be*"5,P glt I5`;Nˊ`Mcʂ1}IUKa!cb1BQuUq ~nqaH~c oJ(ٓc[U/3 rw@em`n63AMꕔ72b59pwqywǕ6G5>2whf%⃌H֘3g/LI@>^:(/əOH+ ϭ4xS3DF`[z FbBe |7'EQk\dh|4Tq%u&?ഐJ2%;- )C5,X aD$yqg?ǿ@tgl ϱO _NIY2~wyI'+ COZ ʡǐMU?ۭ+рL|=.sj4J^&ܦd`_/-TUxaђKj'e>o uşa 7W`bK{A.Bi(ĴLB,.`g&v'ޜjYo`,IW.}l((ma(< $ r'ItAP4Yd -Ӈ!d HHRGa[yh8(EYl0 Kb%}m!CHK:Bd>cH Ei <0{+:qM(9Yс; @$? QY7 .UNt*H Gm ,UQقV_4jw~;qs}>i4JYDR",4-~^85XZX" 5{l#%翆\tE BWb:4F|' »sϦկ1k(ʴ̃ˎLG8&b}0_MT #Eץ#,h i_^{QXQ2qG:\ƑAZTE5I)k+8NuR7΅GJbpAs<BC*8FXg&)ؽi(z7**>>Yأ{Z &r @*(4NAJnU $,=>`;% #0a͔Y0:NXi.Gg Vp6̂3MLr+ɉ+.2LLmKj>N ƻJ2r|$B,؉7xvɕkIc>˕"u`˩ L\i-D#Ej8n[XZ#;`$8P5:O')o[OJcЏ}i12}צ(q:%[bQLΊ`F" G?Mۀ =@_N(vNBH - $ijMƵ,9H{>*'P &Ts pc8K qܴ &Z3n[S5UI:ܣk[<}/H,-dJ$]R|4uP︴C B*eSrЧ zF,Pȟ_mT%a2i`^C:p4ǎNyx!j*O/Aʓ{xi{'8;AY TC9Ea Gi <5 ̓ECee +I-Ȥ!F*?4'h;1ߨ3dqBt66Sᗍ >k]YB|g(Rq2%Q$'S_* A^Ee2X4Z#xB9}?$m <8.11bNTvrtD5H!ݎalC 4l[ŵ-D#Ej8J[X3v$I~RH*GWxJa|UgvTaI=#Lw\bbB(3 >!'fwNɁ{߶L[ b҈}lA>0BϲZ#Ej(ʴCiD;hg&ؘϦSdcDyӓdi0,$ւi⮖b! kdܲCu6{gZIIR2Ģ%^RԷſ'Qptn)a+q]7VMXҲȰ$.,nQ5i ʂaNT% ؘ\JLAuyPmQJo~b]wr]\9 j`7u-x96L8]꘾cu&%k{BaЂ6 LA1"35vӀ wp,h˾ַSRe`_ŗ;0i nU1X_{p' ig7TE 0j8A-[F`DS[rߗHTRp;q0'HiIt4xĞ_bQIr*rq*F) ,,7%HCQa߆2]JeQZ0vĒ4$}cH Gi <0(ښRXM sqIxSZɂqE$9cTN|qpȸeac1v ndǿBc0}n$ ]=R$-$V!$Adɇ:MQXQ27l;gƵ%r.kFV8^7,Kq>:N[V wMb]TƠ/P[miIv9/v]nui!.>BYh*朸y𽼓$ɭp3A)0ɊIUuj,>#Ej8n[XɰڞǏWChj(!-ر$+ l_>E(RCQe|HdpڟCs+Ʌ_#5zxi E?'M$`2,\\o Y p/Ra4#yCz#[~I#+[(8\ 2|,)k8F[Xf!0HjŕuqlVRO%. R˂qY\I6D/飉褢H Gi < g(%%W^IޥPy=]D!5x]$d%-t]G.EKg̃bKɁT0'y>ËI=0]Aofh?W9z."1$G,:  qJZ0uҡBW@B1N52nYXtlj{<\d'5q9^\vGh_W笁dA>_I ea#X Ea Gi EyNt +AJ*pmpC4M# =,)f2NFŇ7~uΔoPj<"K[pYʀ1\(sI 76vȌ  Q$PV*ʙ(qAj UR6#Ej8J[X)8.&ߑKþɬOHJ9@: V}2dXܴoޘoZ\M{Dxi) ޣ-RbY82#MKi8J[X$yx~Y!q mWq}qm[ÍO>' 딁5eJBQ;7,ǂm9y&T^`5_K`=>lP?E`q!K%{Bm7ywثƍAY0>L,i2}Gy(}cP\PLڦB"y|l*w@"}Wۢ'RɅ2_j\aK..#m>a(q:lti{T LAac} cб%v5Sz55]mr@  5aZ f?<%l LcP5pNJFuߕGu3/3FeYAOU}u0}Q$3,yEp NDOΌڴЙQk11buZd$Br=k+y@>L.y5ZMk12ak`\!NJIz8cV[j]3YH ! - &1QuWmzjض9(sI0iߚe!FJ5Ym((eaG@菝=(au㵲zGeOtM De)aEY`F&l((maN4o=RK D|8mޤXW]*\!il0SQeEs.%צS gcylWb%*/5:qeA>$ݙ-S1F(pܶ̃nѺhF}$Qm)D*8֘8DIhbI.1QN 9%(q3W`?0K"mKe$a=cp̃Ro\/_ʒ?:Ǒgʇo||JtJ lΜӃ0Bi(D[X'͝:)D}#'1JH9wRbـq6RL ʀ$CQt 2 葢7I"=9($r}%ĊyץuN0 CWķRaB\!?-]cXfEMZA`9}Blx_~ZPp%|[![.+B7YrL:2MJ"6GbjXBCtv%ٙUY>fYQH#u|*> ,Oax#kLݳƁjw7JK!;7#%~i#6uR B8X(7<0i,ih'ƁeX>tʹ][BQ㶅u>$(!%FZp<.Ǻ{I{iW,$8e>\J*pܶsrVUo)@n2Ҹ?mOq6[~+ di!xP!(JCQeV&shÒi݆-nf0BDthz'iF)耔{܇f;XGq_PYiCI5Ѱ]M6c-e:'uhTZfȿpB9@lJ>κTd07MɉiG.EkR12 5N`uf Q}Dd_,DXįZ-ܓFgⴐ>$PfՔTpCς_UD}~~Я. <[KOZ Ӄ3s<xō}Ṛd8m|[1,C&do8K[hvj)˛)k(>_#,4t})P~m>q, *(PB}I"(=cbH E90/9Od/Ir[II# |aKTNI4.Ib8-6FI,@UTJ[Y>-v4>$4kMӂpsTJ66.#t&/( Ey( zCVÃ)t b5~:hl?:$ܢw(ڔ(& D9YXL)1FCۡXK =VҖN-Q-YxaIkiL.1@AXA: >ERv8籿1ȪL|, D¡pn>}(JQu"MtjOWOn;9N= q<[c}j0,wmJ-(#Ej8J[X2[RIy1yϒPg\&oˍʼI_ɀ0]`$Wd!.11cuW>uOICTeҐmZOp1aJHTټ<eƞuօxվql-ڑHOtO4xQϱ Ju.ZntDj040MA_?e$ѦH6UN6/5q`ZJr"!3-xl٨%H - pQ6.S2#_g1HWOC\~OH, H~!2p#ptG$x$1ƃatЯ'KT/κ o$ D>#52jYXf<a 8^L-pIy1nMhuFG,d\t×E$:3R4;rSc g &聾?XJ4 WAX#eʻ4胙IRFwd\*Pʀֱ$ mi@!s3k8FXf?X|x˻³?NCWyc /6~Di8lXf!.#жDnKI(r2R#c\3݉_2ESil,FHr-C#Ei(CY$5ܰs 4(K'ą>KeX.0’d!Nr!,RQ2 ~xrsuƹspZG߮8N'h;Y6-9 E2-,M 2.\,ƈ1"|cOę:7UZRCr?I-ijң$:A`R/-' >ʂb0,dn5-,P [MKr4/n4vV\-157J>-$޵-`iZ`zh&\(Q:$@ 1[䡜" x&v+MЦvs+Ije`. o郃P ร}O<7+S[ĝғeϓ,&((eavp]Yu>NY [8F'TIMIOٿsGKbgr:찰4% {|⯲'~ h8`f:- Gsl#OZ'OW:Mh.FDlcta+5i8M ƇŤ i.]tep2Btk ЖVBz( "ƪMzN,$oK%2.: mζO+@Nk ڂqsn%e!.g(RCQezh|ߪڶwvx;=G+ӷ~'C/HxoWspvBF2-,9M:gd\S$|ynܯsdLÍR7k u ϣBs]R\קmy~ꦼ,!wn*z^\ק`u]"vm`F,BW߿I"ȝAQm4f ӈU3i / Ɨ{ $7I8.! d#ubٗn . kuy(z8W?^E `Ԓ 9C,5U(2.ʃF)VFƔ$mHˢ;RRK #H|q\,KuW!CyJq,7R2nQ4v}Hs%q{it&f Д A6 Op "5 ,`.7A$=qi x"dyQUwoɇ\((maOI[>.5#$Nml]*QuU-m0iUS;)idB:b oXp-:qu_Si9Zʀ~o颹s_! RYhb[ȟ %C~8,FHm"_L5!"5-X{V74YXxSXdI M2)I 1F(Pia1!te3ɒizE ; 1k h`W*%* •%+ k8J[X*GM-X!^LƟH)ob[225k&dՒ*} <)(9c_N $Fo;-%[ k0tth6-٧6="K KZG:7\<7~T$y1֍3Bg҈+ɀƧ_4zd|}bYCrV@>ei"4U|uZǥ<N,`_OBru_: ~5 TjA Ra2he?xl}n8<ϣF^e`5XJ62~ǖ톃H ŘYn8S*x"2ZbV\aq>kBR'K5eX 5]ZX_!<ؒ; 򕟄}VaH,JIN[ea.;011: k:Kr<(M &HFMNlvbP ;,I$, Mtr1s$~-90բ~/ޢH+[0Iv+6 GL]ٹ^r4Uv4 ݍuƀ (he,x]eEjoYxyˉ7듭#-9`wk6Xy R8-hF-[dXp?$agd+y#mO /M6W0KEqhKM ~مҠ6\N_pSQUJтr%9Q݄oNm ]-o:s_v G`yA5>AZ/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㾤뿯޾?|[hHrթoxQA_Gsr_=韯QTendstream endobj 581 0 obj << /Filter /FlateDecode /Length 1566 >> stream xXr7 W-"9䐔%qĩ6[v,)Ҍ}a=ҡYv0ju vEëUQ80i?nu5Nsm^a{v OWF;\pr>gWw| Ny3h`5Y7lVgkۨG#'uym 1SWXu>"#QW?<+kYuszB\vwmӧKz}ȵ7o/k'#`&,Ln[Y·M:68qHZQ/TY[qIXOL5-p1l[pbY;?k5})2b=/B|5{ܬ9hK> WȎꏼ>pRsB N]焱1.j}$KNE3nNq҄Ju^k(^z[مv0r,B($Ӫ;Ի)"38mp"߱}p6:R$-R@YMp2-F|U"NbdD\ v@ H0 J7hɱV!& &ʀW ա!(P,쇂#aWny(!JQW'Ȉ "B{b۟܋,!ɡ/=v'K @9hLcmE<+cFF1}zo,]6ƙΗ- 7E$v"QGȷUd~`Q3bUf,y&D3O xFj+l7(fB~m,$B){;1o ]4ʡY4/cih}4> l7W/ )D0L$4YLSqg]u4x0vPs="|'2hz [u\㾎?] ,endstream endobj 582 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 691 >> stream x}O]HSa9MZ M,J guB9flc2/i&sIfŴ &Dd7^u9}}^ aV+>IM`xǎ< Pi&.BYnt~r@avOf:-&h$lR an4ZI6Q#'mhh/Qli{aN-Nr43iYM9)j"٬4YaPVcV,vM9HrX`l @|P hL@*e!lc¬F,'bٿ4"Gω\=Ape,.0_?Cg|-g-TPטo4/t+ |C}Qt%aѥӀŗ 8 \v^(mo?WJ~ pȥ :vejAK{N(0>EcVKt~LepYk>=BԢ➳'4PPDIk ad0n}G(V荸&+Z& uU0,zd5' Ohcji< ;`PWL ֶhvI $L R0endstream endobj 583 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 499 >> stream xcd`ab`dddw441-H3a!ܝVY~'U;RV|<<,+}^H19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUXB9)槤%d$2000q303v1032>snʂk3 i&O=yBÄ?ϔ4uf{qmK[kwdÔi}ݓfnXCw!㖫wcQA߲%~+V;nE'[C'tttWFwwvst\wt߹|Q&We jlgא៻VuuۦuV.璉<<Hendstream endobj 584 0 obj << /Filter /FlateDecode /Length 1858 >> stream xXKo7W,rx!9|R`[ďR#uVA|͐n^͞A9_Ϩ9!Ml-7&joV->hP͟5fu\>PW326QپNy.7ܦ|8UӨ-k1޷Y\RGs ȻN8G'u° 1yeNmWXuWd=;usrBݪf9{pkͥuȏ}̶7'o78&fUͺBSXcČ@YZYN|0T< zH! .XgZ*)c2}_mȵy3 );r37uA}X ^mpZM5DAv8Gq_!DFd%&8,)owCbպ 8$;"A*,̬>̢cQ`+hF]m<8֤'d*Xvfr>7L>'#qY=ujr茒]aֈ` R*^T'2E]dԾ%ˤIs!"C}GJ|t )+1&q4He݇uqs:XUrWuG١;td[)$Ȣm/LS ڈ9*o`"ܻȃ& !v>vM> QJvB&dIjs!>xl1:jSdu''|Sg[k$I;3TGS ^dz~^:@3!o|'c!?aC K:!;(,eПlpA"!r9Y sɫK1~2NLQbrSPR>Wb0`%/ŸП4Ʒ^--r={■= #UA+HmP qDgiQsfW &cT4qNۑGk6\r}}4"a(s&as^@@Y+wil^xC}AW',{OBb(Dq1$Py; P jISRexخxwQ*zNT./`EェD̿+I&"̧X *aڣ*sT |c/V .dw;׭kC?}/yW5`úx;; msj=Iw_\tnO("΅y-J^'}Ho7<]1ȩ1u$Mebv|"S#bbzTQhcK|~cst*wk톍^drh^D"KեO+ѤE9ukVa_Cjߗtca4P\d&= v{ǛInL]+S:mi8B~'䕐|(B^ yI)\=!R']W ]cxF}k;B9j1w-ɥ4f碐v%-kQ:<{zNcIA3N=+2q4 LIendstream endobj 585 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6458 >> stream xX xSUދ`cXWE!0(P ;InnfONfR*I-jQADAQG}swy3Px{&99~'8tNqc&gbp@fTf= 5*eTCrhI>1.!8 #DPq5 Z1w.bj 5h7SXz_3ʇл6-$XE_)DWpi9\mk` X^#MõAij9*.'N,4T-;x]>ճ3 svJSWKPq}uJ`"ք%m~H]Ḇw%3z}c^Jz6 -Bnl@Cй?~B!ơwzԓeï0kڲi#>ͽc-ץ3tξXy Z{n:7p4z~̈́6.fwHZzqkN]'Z=> @:1>IR1R7fx&lFC. j|}z 6{Ň ɫ0?ρ7tjii) m+Bì3rκK~h@}ؙ1Zl鍒t>B 8t9 BЉi8r!ZWp98R`>͍h: 4@Q\ ϬFq9j4\ ̂wJ FϧhcYfFq;"KDJȤj̀6@'LV꒱hh@˰2}%s pqh\W B'$=aJ2@^'Ze#m!xvsR`%EhKG,K4]z'ZͲAU96g!,Fo#pa{khAP ¡#0q:IaxBiVTFIDQ:4 Gp#O/pgo7?sʰM vV6G,FN4>V) TilKV@N尚_*= W9r.7*J:)>M J#"KJP_htNqϥP&˅μ ת5 9_ xO4\N%굒-eRP'% )47+UIʛWķO8|<]rhmcڃ8J"ĺԧx2nH(|RzBD\qR#D 0UBq5M./wgt$A C{}J\&e5XQpj_еMpp<1{~Wb')N}rw8;pOi=/s'H Ԧ."VOaS oԳ7 XF|oYg^@2e'poy$@HO P(͚6֯nBGgD@N&y4^u6}XfjRFy_اi)iҶn7h4MLUR3Ԁ,Eh[5 Sg*|IchY~@"/_#jH;G/TUq\fѨdC8Ԫ:>kV7:\4љ&ڰHƘ*o&Pc@-MR.)orcҙ]TM:v7 lLTd+q7r:^G )%s(AZp7fT8;O"-O|"1Q!ۊ`uj _]9ޡwj4fNjH_z,XHQ\ڐ Sꋨm8׍ p8ˁT۩#9\!$r<0ŖnSnρ9-Njϧߥ1y=eOιn8{.[{T)QجoO"Wmږae%%ުlmJx[ .\L\mAuŌ{ e0 Q[1F2W4cҘ4@MZp0M~木OWѻqF"yN"7\uYVˆt>@rM Z6'#yT.{7':xE-2=<%镙)H3B4Qz$?9}KV5P@mS +~i.ctÚd]IrЂ2&I"y:A% J!w˝ u4_TH7ELhπ1 ũDF3Z3gF}HyU@ک3rDBY0˄6O\[lgsy wSv^@L םv2m==BG͟+B+*TuLy1xt/aស\$7e5]Mx6N@~whwMt W=OXО o l++ʪ(d2ZI+lH$ѸX!-^gHPY$"\PvێQ?Gt߹r2)UGGG58](-jWWl|p!\ӷEnT!)4# pdaZͷ݈ZFQ;' :Ra" ogYpi-(gu4@P2T|4V#XZVKAYl.k@ɻ꓀طw^;Ȧݠ<{vrrWEEi8h 2UJڴcud% ∧.{ICҜЎ6mo$ļEk8wmr)aBS%Zq͜˜Ye7qU Aո>0W,z @ 0HȩyPYDNb>Lyo솏Ĭftf !g(n<.jJUW7u[uK D矈@ïѤ~ *xSV\Rz |0L} ( QEHz!Bf,6RwDxw:? .weaXL1j Iֳx"IeUE8$RPߕelGHf1OЂC-:O瓴vvԠFu!_ y  'c|weJ$G!1ō"^$+=$jRC6Bԋ1 ew=@H ң i-{)*A&7KyD3V,{`_: waqV)ҁRgo^%r;׋f@H ]|*:(S{#(k#OiN`!nN$NiyLJYpͮX)rOB@WlX& = !7B (uKy·n"*^eX9A X݅ф! q@/J۫! Bƪ(7C5Q(9*5RAnorM޶nYvݲkC(7P*uڸ>p"A]A@֩_{hg»Yc(ÅYgf*|{mx*ta9~\09b]!VpJe7=(ûbC l"Z*S $wToMӓX}p_r܃%,EgpmOJΐONm/S(8dDr Ca=vgArehgXxČ'*-9V fXO5u*CPqBJKP ,2o1.+b%o?z /O]^J:)QF&&dZapg?B,J{ u)43LF8{ (!EHmq\w)@:b-QUU͔ hVmyki`l5 IeNFaBY !E 5.'@.Ip͝=f6QC Λ-Vs!p֬Ve9EZS>2t8v.4-~,z SRdP1o4086H8(4e#} rcpJ%T $]-m:H; :98@AǿC4<䥑 Ģ K/ݝ.wmZ#U xѸ̚eVʄϻ̬[=Pr-XbP.d;/]Qx,.+& In+ֳ9!?J:Sdu~/g 8P/ۇx4OPoWw~Ezӄo$Lt26 GF4(4RvN&"e*J_I+Sk]cjڧ\3ɺݔޒrfȠ. g\ Gk/ Z=27p2=w?g31~p8(xnY/37Sjo…ŊmK lϖk:F j~ݡ3Z#IxL~}ub#lTuf2_6x>ǎw6n=/܈|=u5rB߱vfںʢCD횰ӏswn9| lOePvνK;~ߓR/ K+a3p绎 2_%aendstream endobj 586 0 obj << /Filter /FlateDecode /Length 1555 >> stream xXnG+ ıF`(Zl.Iߧgkjڱ:zztT|5zn$QVNZjn4Ư4Z Ww$H]EfkC ܌DZjik*Sl5=5[ WATZhSMWdiWj #'v X9aqDQ-We3V*Mh9ġn6sr|J_]ia~β&٨~0v L.;\̓4FD bX2xɆR46fbK B0 ERiY۳RY[& rRi[)$| yi Ȳh+%cЙ63W _6xdmq_M_ZF6 W//+7M_{T5qtsSM HO߾} 89丯nQ!dsЎ}D? ^ڏE A`ۂN*1|}k+)Ꟃ|p,и7 [R>Maw/mfVFA筴Wo| W9@ 1FeAFb\Hg$5E (&lj|^4bpDgu?f2aB=E6@;1}2ES,u#\v3n x6*f+׌ܿ@ƻx;I*-H '`Z*)Bz ˓{¸HxW@]E„^E~hX.sOҕ$/꿤M?\h1t t 3A/۪?.B)\j3;[typQk`gISp&k{P^,PQ*AtҐAl]ߜ] c8@(# d,:'%T1>9n1̰{[Ya£̜<> ^k@g2CēFw4PXg  7>dOXJm'XzWPYR䪠q r֥6֟^@]=A{T9;u lk_N-͝KU2{N>${*`>:>7L~Z{'D'g֜$2oFJ hendstream endobj 587 0 obj << /Filter /FlateDecode /Length 3308 >> stream xYˎ>{"H.H؀m BzCkf s&t.z~Hy-)۫Ͽ+#twUOWX&RVtǫ$ _S?;wx^{D㿽ʫbWŗO۟oߞr&]gx4Vu$fkiz<9ehU5(=Umy}. w5˭?0m ݿ:}?只[)vYYy`b}?j:roa|kc`0 XFkuys:3~V2BJ[(9Bp 2Ԓ6nRj,SV4>S.j5fhHN,u-cm@c2z[nNe-jPiϣtsyCc92j髖Agt:XAnI1>Q@ڍSȐQF,3syV8 =dӦ h̘q(F5uYg_N/(1r׺oB7@ߴ7]3^YkjԵquFRxR;ru:HOdgQE Ćl&uCجS=-Q!؃lPBٙ*̬H1STKn hB;p*Ah.6:NҢ4PU"ő}~l;|u7gLj =}돆fDS sO7wO>=aaaZU/ܾË77N^_=~\ j?I)@*t(\QȚ!PE6Adf^ iGZ]6tm~ES3d֊ 8bI ԱX L2"] YsFՆcfl][YKG|A]"sla4΁ ܋8l."J~n@z*MVA@C[tNԢ::#  ° S=hՏ)*d-ɔBu]֜jOF5XU7Bupw/,CWtgd }X|8PT6ď)> stream xUkPWn'UfFPUWqUDcp`TԀ50S>b,P!:WF#U,(j]LRwYV75^Rwss)FF4=!$޴3>3)v칁Sc'HBK2CpdRxP.+F//A7YE3΢u7@m)-ZIͣUZHQc)OMhJE)%AL1JjNȦvbKf2ca*>WVdjw.CTP&Y] ˀeN+5 ˆZ7+oQc P~`%ZwJbͦ<J%@~@)R颈 1g} Ly2X/9vSa=3!rժ_oW q΄U(+=(55M-7>V-@a.!5$Y%,™{%06HZt^j6=1b.wչ;*g9-]Dbi)$xT"J,|>\!fG wbY^ŧeǡ0d9u,Dp m6=_b@}K;@M GWď$uAkd$fQR{1oxWqmTo  [\aU0̳^'kb׌N0 4Ra$9a^ਁ41פF60$DpJģd}iR$w~x~zlj<<+juvdc*P;Gx*O ĖK}7wl%/1X69׊oáU "v«aG^{y{!;眒+a)%p[\Viendstream endobj 589 0 obj << /Filter /FlateDecode /Length 1529 >> stream xXr7+fƾJ%)]RGLesHjE-$%Ƭ إ4Fkg2D_]|5(RJϔɤI-磳=4>ٟ5Veǐƿqfh(E$5a9MFk"pD&eBlˏ N^ }>-ƴ@9y/L("k b64vJ/K,5:9ǡdzV;et4!uWxG]9hFAuq0T>Y xc/V&ot!Enczd!8ouֲ!#26)BzJKflJ$4M9|[ʄfJ[+)Yu~,<͛_c%|TU~Q>*DjJ~ʅ|c%6_yc5%R$UR~FĤ^$XAMy2q+cѡj tE4w[8#5gCi# 2M\V6OBY 4"QFT J*Ǥ>1F asFP$xȢyPv D>zKfމ*B-`U4$h9i(} xx ABQ#;@mauz@Eߎ,(72ղǂq"\8ͯ@/>ip 6ZEFql?>/W8ץ~uHg~k/}xx}T er H:>N7TFbjP6[v':|Ejvkt_g6x'h*/H⏀瀏!mG]) &35Pfoa6YZ½%>_ ]ᙀ)*dOz1Pz_  㪚g޻'lS+tm` l?W,sL_|,m彄? ?v O7zA+x|qÔ&g!=ˆj V=Vmz|?E{5|UY 0z_G\ZcX$&)`T&GhI,qC-u9`7;:N/:t!R0|T;v}q`y34JjF 6MU MFHznوE~%`r &G Зtl~x |;J:S~Q,ŌENߤ "XƥwFendstream endobj 590 0 obj << /Filter /FlateDecode /Length 36809 >> stream xK.Kr6?b|? x`,l@jR.ͦ!|XY6ɦ@Tn~UYXǏ?Ϗ#~rK3׏SLR](G?]-~O| ͏Y #??>~Z5?Rkԏ=?ϟ_ի_~]1_z5g2s_~q`U}<~ᗈ/Oh?~3>j+kvƹՄ/m-ϲw%#f̩/ҏRֳ9ko_k5_~7&]m m^CX>Z%HגZy_Z5L5ؙi1YY?:mtN]끏kux/Ĝk!f[wCY1J2gm5q EiS2`Xu?0#?FY?Iiv^׷Q?z^7c|I15_}GdDb{DxouoՏK_`}yƏ"kga_kC.$S:6@s"sH"H\Ȑ'Wπ?zaǦYkȫGXeF{dgy>u^=])K_}tK蝹Y)u<^>@yXS^8KcIrܐY:{G< ϥ\ t@x^s-?jMG)2i|tk ?Qj'Yw5W䵵jImAx8Yg"ik5rȹښ]w/$.|.V~>[ [玳U+fg,+m-Qv" ~J`nes]2drHϧxqhaȟrC>wNkMJϷӊ*(K6muNZ-$l^CO%PƇt>u*S󩍪#b.Oo쏺GnZ5o*GzXzT'{uclJPѣV2= {ըM%ߘeݚ|2NS5Ӆ=j9:[]*B =zĊNβ`߶uQ]W{ Ok%$,=zjB/2[أhz c+WOܭ`:b[Ue{ }hϺG&wEbu`yx]՗Rmo:t lV.!nu`b YcKУH {$sw5jx+/џ *˿aJJuBϻf&)qĉVDaݘz ="'n ֙*fiGBU0iUDeУ(Rfۃp`lXd4nu`jp)¤Uyiua*o0Lss(66ؒ'>ՅI󺾚6b!t >SPNX? sqrS1ÃE屟*ufਆdT/!]Z9UP8j*XQjP g1PBIv5$ E4˴k=?YAR4@t~i̔Rq?t@!ɏqBdZWs"׷75=|p*Ց8A.gQfɢ ]rsӜ׽:JN`wʏ|L-\\V"7(^ٳvA\S6k"^H= "y[/j.;e\̶ g6So{E-Q9I˹pbSTۚ9u r%m~$3g*p=|N͵pu%HѷQaXԆv{H<ቮ o¡<ƆBޥFrBNڝq6ۥֺks6bDpfI`^ |ֹ 9,3b5ǼXD薈. yl^b{btQMk b>E>rb6:s[uckK6* e'fHBCntR5wLWͷg֍|.-@t#+L+}ݛzւӣXO} as7[3lPR/A[E)2F2GC?@xZ3"pN¤أ.(Q (n]B9{ۆfXc1E5wc+Q/ȬެS0V/0B8hoQq#:J+N0it ,q|v.vgSaaRԋaVЮ:fT4co5Ѱð6p6=*qa¤J]t*/*{w OjOR#҂js {~xHZ=LVEgG`1ZS c+nu`Y~q^CU`o*V`:GUZhrz](jlxnLZݘY {A[i:=ܶJױ.FY;8e-'_x8.QX(V]s0Zb%RN|a*õ!XZ]أ_-&oHP,][鉷gIlVQw:cУ |)X {;y=RSsBl#vv.r hj?@nTb[ݨp"@ jdgh/ eɛAE7f՗cjmENvƳ\e-ATI]mWD>:ɍ SF$3rϨ oET?D|VRDt1R/NQFNJ^I6(-X,E6N1q:ADic.t&%A1#L+neWL3ZB8 B5w$eW?1O-[3*YGbL6WxњC 0Uk<郫WKf-U8ghF;BZbRTCX@UaN̥Yy9&* t235x2V2=I3yR*h!E]yb(RI%Hi\srE+kWȹWl.ExIS^.}Rtk ;}WTuk'X6`XHCPƥ-^0*RC"K :A!NSn-v].|ܝ $q 5b[yw_.D},yhG "¥=SI)`)BhU ?>3х'0[&3ES<.w~/ l6`!LXH<5ꁦ,)yd 3B4õ*Aƣ*&-d(e:"f(]ѴGAj* vK9!_%=6}Wi>02eҌi r=bl]4fG POKf! 0kg!Wn*/*[Tt;p C ̨[jnV?ϛ.լ2 SD"Eݞٳuhp O76N O>qE޾=.řFlSWv+Ug-iLm0| N|bgfG3iYB "w  -1{kGG^cX5$|k|W\cXe`@"NꟺAɴS[-*~*b3 }}D޺$I; 6QOo]m«_4n .A}rU!pn-ڧyvk)*ě!)m/:MC#03+~Ehy?!<]75Sg\a0`ƖګĈ -ްҳ=cG:E=.XdMqb X%] }ʹžNqH)d]Mjpjo\V.adYKvEt^B dܸDs:۵OH&\7ؖD~{kOv'1N'1%"mh<Z/w/MYWqFj9V"jVI СjǞ5\R$^zLֿIa<RA al̀ίoA+ 7 %еj {nYn]`ԥJL= Q-e7LZ1LOύ=[ M_M´nHjuz^>0i%eÍ=:Bdu)4pxqjv^¤Uc0;[xF0 }f>&0I~ v%/Q~UT jYnLZ4ߘReȽo6:G9_SwJJou`|ߠ"'ɍ2cm ycX\Tdq~D==/s-Z辡oF) tsiׅI ^kGJsmWܘJ&+Vg]yaJi>C7^sIU;ƤcM1<xal%sWq:GǹyaNĤMoîU8lQ7z $m/1iWsxa*rfǚ/JNHAHdNdiVRpj#4Q&Fxy,%uhfi%LMkii?'.RdFU)C_R!Dr|XXH[M΄fh'YM_c˫{ ܮէf؎L{p+3#s'7%;(N56?"1ZWiܰ.7\,3 E^*ړia8m RTM]oSu4#-Y[ՂZf;o|o D@Bo|ݷ6筸t}򖭼~Na/Lޯ~ Ouo`f<GNg>Ĝs돲[͖aN:1Lfn 2t5e(W=@4P73j2yWS!~LeZȤIm\yNͪx+ՠݞNOqaFAR-g/&+Y~vּR2c#2N?"h잟%3|(~>pwQߡ{ȨC@=n&J}ԃ畝n!gH x4:(ǐ)yu4QB"f j؏&JՐLeML4&яuJH V}riv VfM idfقBg)]t{Q.q]oQECnޘxi "أKYn[7LZe2 Z䍱F iHx7&ߧYoأNNƤzodN9Cf<0[$hNU30s!S2IbgmK1FJыؓIFbG ,I+T'гs_$u`Ҫr'~V0m@ HSnLZQkD=oua:+RGmڛyc|܍ h&yT K%=jja|{buz7&^ aC+h)n#qcҪ*1 {S|HlLZ1JSFs1i4{oQ]O~I+v} $[dXt%xƤUzJ1wk) #y%$ICm$n$@ńVī< AԈ4qLj {M3zhj9 *ijfPRr] y((4Uju>Wmp1 9-;>[0)lAv6aR.VPӐ|VJ˨ga_@NJV|bm' ,pM5zr ԅ"3kTi^kd[52 ^0:T aJ݂*g#'Ȉ5&Iv{ōGeZn(AI%PƏm6=p{FGEpyZ(#f x:7UL# F &uBG̀G$O n0r:-D/1w'6R`-s2AR'yz9=Lvz!A}~@e~.Aj`*"zH"rj&/ΫX ˶-͔f5~h;{cҪŲ-I.1i5v8a^4 t3봺mc+Mҙg](3Z ͍碯 DoSأ2PgG:,=:!OfIOIjtH⸿e-H Cq$yU0 RGIbITal8c>7fI}֍ve& ޯ ۖlʦ .312"Mב5@ǿJLV7rc'# &jϖe=z\m 9R S+nh.L8zAdUיyZR=bx4Vxۅ!A"-~?%KTlE~?eϼW4%vxujR0HUEw3^BmsQ5mdx'EH-1%P=iV3B8\\;ECC6N]uzJ`z1aWצaqO j;Lu ES=X* H~v f5MTKgb 3sp:Ѵ xr 7H4G8 JayeڒDyjZ!7cU\H< Dfg#)W'R,30O&=L3 y??Be$->$(;2(!e:$5Kd!ԈT& >ر2KV7"Arwz{rh`,5Ő2'(q<5[|:%;L .:3 M~ŌI d]}7x\ֵ>V"%3iD$ Bmj&JlFM !8*&+MnrY,N׽&DzE.9t.0wsuά1&ڸdOvNŃѳN59 |y8D< 댱brݛy6"Ogh:qEۙt1KA%~DRUrUy'%tyZ KyJ[̖(MI- m^FY);RHE>:$І@rH*̉)FReZQv3$v.JV eFm$4z8Ho;Ӏ-沄1r0Sך}= ݥװY!>džZ Vd=/d1Bg)sUbՁXEPMe59vVS7]lnUa9|2Z+d:\"f!sf`ocpsٛs'.Dd.G*_sJSwhWS4]43iEM4>C礤_?.ۭ:\۹ml%u,H.-Iu=/tD%Q~$ j"+5aFYWdM=$K0 Bї:o!EoF:أǞ0 )ng=z\ޘt9KƤ$qXr7&Dvmqal%9cϺ1Q7&."ta_1VM)WN{tRcUftԦ%%O.k?dըh=:$NN(6 7&E¤al0 Qkت1 +yaҪkN7+/ 7P-{4ƃ=/&]! i#,lO0>0u?u`*krߘR66Oos Ϸm SdXuQM=+^7h c.m5x DzaƂ֪VuZ\7xК(vY7&ȐjG Vb&.1 cg/ZMdzQPv 5)lZ8^+ V d27I/2ys˫{?f }h!tՁI+)z'k;0%di\g8oBĴ.IK D ؾ1ij_/LZe&KoLZ57%I,o Fqr{a~s|ޘ=~& /{,Q(W$ώ>7"c0`i^ai^gO gGyJdZU韙;Ꝁh=v0NpDd3_}GGv1R3:sGF+GvZ(c軑#{rG! ə; J?EJ3;i=ӟy~U+DVⱘg+"W+9VDV֋?q0>b-l\ϒAJ63m1z͜jkRn㩶"uط9S-6+gj@, (v1s=9Z-j(9c掋ي17&XOqL\4M JA \F2ALDQ.`h5crl^j uD#" F3;g"LQcмb^#mz+ @}Z hy k䮳Ȑ1xvQǨUI=&)#=֤t~SL,qmt0Hg# 5Q':Bg/2X Id kF(*W {5?fM²gST^ sﴘ$3>aZŘ$1F;nFg~ U ^Lv9׀Tb: /]fKjv2pelED֏e(ݖTD݀>;_{ o\měn_4צGgT%jp 8'S({h%lՏLZyOf^/-$ ش?YzX=%KގR6 "+֬ztt<8d0"Yݺ~$>T8Q0Q4 ~:v (Bd!QckbI!SQŹ݊$Namf) 7:6L:b5˧Uݰm^>f%W~i TwCzVAZ%2CAH+|a#뱹z\u䃇.W>GFlK𮞨C^Ð)|IIIYԗ g4vuHo1eu aUnCT3{ӎ:^ۢHDZc ф(4(|5;ƶ,..bOJ TT CR_GT;J)ZNLr"acp5eٍ:j3ņO]DvjTYTMɴ&Uvޤf4ϛD+tIztiI{pLr,X(kM rc>AY~. z`OrԚI+XsF<*K?F@i@'p=7" 0 BQ.@51iUϴl_0iE Mocۈ>?A$C=zc> @VHiE1T ՅqG-E2nac4'fzpV,x=X,3|| 'DQeT{S%m8oHt5-~/kҽ~},9ײ!i#~}bLZeG 6'$m4McG2o*`Ϻ1>K ~IdH 4/_أ|[C|Q 5EGescl5hg[*Ky =zpFG22VC腡UJ ,]УzɈm70yj6/Q-h׳nLZu B=)&Ii{\dmclJޝ:G:Uޣ~aҊ$QcUlojy F/ĴhTY @2YifDH!2f'-2ISʰh]~hEji&_cŘڒ8v(ՉvC{Vt؋{&z-!;KRd<ق5Xn4H IS8`$@ql9 r*S""JcE˗eD"Cx mLw$Elb`svV'S>'VO"Wh%pN^&#il-֊ rI]@8ɑ4(牳+0qfB3ը<)7@C|!0 )^;CP &t pz 7$R;bR26}Q26nnb5dA#Ggp=N_5X~O7?6L,@ҲlŜ酒s()P_[$p^a노uX<_Zه"ʣB j}z&hT: DNčS諰2ޤT <)~xq$ݓ{;G5[D90RFr2Ǔ#ACl86ODC,_NL~@ֹLII7U|}7E{{icV%Dǎs]ͷsjItv\\P'&V:̱yuTiS5C}-]m^1M u..G'n]Qx6z Y@/L!7> IoA#/*RVAjo79GvcҪK@͇8}: {t|ƤrNacF%ES43eVR x4k2^4ڷxcu֝0iUq1AM -~퍝=ʻ ;W}~_0iE%ofy"Z+02,83EG],k ;U~{I: rckD4U9 {kks,~6Ysゞo=SBvUdNwYbꜯiyR$pE!أlT脤MS{xE6z?_ZMzY&)^س5g_ [فJ]:0ic19{/Q=do {T= 1LlFƤU5|~.QA{I#UR@HۜYZ/&34L: ϥɶ_12i"H' 7bwdvQf\ݼGRSFJ(Ll=!5΀$9Bu=Ϳ73vat†982XqCN|H,OV ,%bzQlbd '1#y0#3ƍSm)&ds0ȉ49gn&Vg.Y !gʼnhB)pbDDB"iJtش4L]o$ׄ-s5np=!Noͪ,(XzfFRLβBkc[TWqe.E`@J_}(4 `5:}O&[FW;@jJPMR++ğ7GV.3JnEG\7W9Z\gY\)i< (%L .Hz\2b<,d%G+  S@3 #t $kM]v:6[yձPf/&kc xx#XF`CRrX ?`HX0ţ_rU2}!Dt bJDqSyb{OⵒDeh!d_`iɤaH2/*zw``FM΃GDX )7ҡQdt/圇N :{l P-yO9Vx%B9W,V$r3ȈjΒKf/Pdxa#JZCyed Z0ɫ1ĸ6SLc@-fߑtȐ:UY5d6D]#o$tZlo7^3sA襝;qNq3CkrM'w .1u 3b50^{f;91:Z(iTs!0-߇8ܬ_'{5!6Zʖy %ȸv@IFv4ci xҖE%.Ncct5>7+r +ab1 աKAl}RA$q&Ԛ<}ȫM<~>%#Aɉ#(U;!<Ǵ0eZ=1qrtg1'cp`Ϸg׋T#ƸDhoJ^GːXhأ\Zq iq=1҃(9KߍgƤ=ƤURD:Z VJ;//LZ =5~]Z;LGY~ݘ|(8uF\$mGY^scJofdЦP X1iJ٣;G|݀wS&'S} "!p$G߀/`L Q]3$GulۍGﮈy]A/`%Ia˰ V"TDikbϵuVpDZpg֪evVcqN#C4a _я׻Ϗ$V>h7=  wӤIksFL'&A~H8|޸ӇyF$cNO[|nQ r9tdĉh(P+ןWK(XJǗ3ȺR綝o{LC/g mnnVmbbk`ilU`op@k ^zM.Zl/*՞B6`ca * X4U>Thaz.H߂m\qJs_+&$ІK|.WD(6M lVr#¶YZLp^U>^źZ#zsռE I10HZ8 }Ƚ/2"-qJqd?*8c<g>jb*Zv`eW G+h5Җ~^.r"BTi5-әsLgNv g|L%ᱚKO/!\>,OUj[Pg B[`s~^`鍡ʹ9O?qPoLZU5I:/*fq4¤emㅱ.@hkۭo>>oLZ5"z/LZ%f}հh9Lf ć=:*Nbє-]'̨I ]Vx4war=VU{ېޘP0ݺucl8aV共UTCI[iy { ƤUw׍U _}cK^xA&3/Fn3Ised/,yf]gjθw=?hѺJV=2vP{wPZoJL{A[!N0~oNh7]",7 oucܥ `.!1F+ouNzk;% ya*st+tClnpc|_aqc%hj=I{T;Tٻ0V4q8W47LVu^9iC/ȴy?L@mK"&v!frDtP~/#5VyXs2R4RƴEa26[dI Bm54V5p5|XK#n5J.pe-L\!s"ӏn526S-dMfp&5p55JehWZbJGRsmfr&5}*%C>N tSôǾhYі%]apiݚ= ЋѫRSyjr€t޸p2X7.d Z\Pdv!M8 q@{^YCm@cQSX*u)=%<uǙM'X:J;{I~fjB~*5j;'\8sQiAtZ_% ?BUe~fI6b`%7F$1UY$m4;7oLZ1fP7&5-}S$7NoҍUua|sG%(\Ώ_.1iEmgycJ$dP_6|"H1tɉQx,i% k%Q91KNjFs_rpFf헓7VYpXbKS?w@A20i%bor83Gw csu`$[|=oHi]Y5h 4l.Y"6|cQ3ƞo}VjJs,5mW"?~JfefӚ;!6Qmc_أj{TU䨡{cҊjtkua :K ~=͒x+O+VƤUa*ޜՁIDk07&A71h.¤%ot~tax5V́']j}[A[ڂ|>ykMq﹦hm.&!r&wKx7O[jx;:K8ޔ_bM!u(54,tACDE"0Gnz)7JF$&MY3nX-I\7Oٓh[n}'+}E7oƛusUbp^K]YA}Q _A1i$ PFd6?o$G"BW*+LKgn@k i vv="ZK63rX_9$ b/wI͓23]͖HTXtvetœiSdbD ;qWBPe4N@.I xST=̌nݨtl,iĸ28h -_ogAF!Oü?NbB=[3ŝV/19]aቨg39 DWQ9iTJN"ܫ&LJ*͙%tOJ'G9Zr3ݖn@9.;5-IH=iX@pQ_|3/oW+|CN8|g=t@0$^i(im ljԁXJՕ[r Ure!UM_zj ĝm+'[IFgVðEj7T'rp+ߚh8r:@נH!ʙeٺn[&aM u֢^m ]_\o0`(ldK1;3?4eo[@(*%þhn 2Ȍlt]Q0bT4^f:+Ljv̟_2$^Aj%WiՂŔ6oA^:ݨkxqSm  c5#b! M v֡F6CkʦǸvB,!x 4z4L甚0 P/~Ͳ̘[fve?rӘWS(z,*-h3ޘr`^$lNc.K$T[HKI{SY&FG³>n{1;)COJR#H )ZQrGMQɪ!PgSL5D3RDL]JɴPrRuE3M%<~;?QݝA3-ud$9Ǧv)Ӭ,SGF[X1i+WAERT%yJf(t-Si1$yGq2SiuūAꩿ̆BztA,w23򐙬vFiCrN}DC.:ANLƻs=nN1 eP|fm3CHaFɾJڡW!'!uQF!X,FC?ˈt ZL'm5uK> ]U [AQvnA!kU\H):I|(KpQ~lF@%&L!l"^LqDRS̓ꐬdB?kźP8 ^Tcx`9vh/'/a5g5vRB[8,`s7#_=r_q)Y7YF9^Y|] Yf <){9;yc}7ּ3OQ0z d得 G'y&7fa燳"4(Xx9/Fdf4-kt(K4gƞ{%ޘL Uޘ*ˮt0>dIQzTG1G{TLuVk͍IilH/Hh`('.LZM9S#M.LZ[.Q\g { HͦWkXA zW"[ GoLZiyyνt7|끊ܨ1d r$o0|AҦhŃ|Z^ʓ :oLZ9=jUw/LZU *oH(17'iqGCAt7LZR~⅝e7Q(` I _b9Sͽ y?R=zL zVu`*3{c\+Ϻʆ8F_=j&;_0XIv)ӠQh^L6!!7$m:y¤w_Z!WҕZ.O ;~/QG̾^E=JI0s~}äZB/LZEfX]أ|S#x^篓pbGm^Уܕ(XdǎP8lGo~fs|WժT ZKͭeMVg c[=BjWh5dMmd!rQ%pf;u9V?Jl{戥8܎--ObȈsvS\Q|p\ Mggb^u埥Bk纠8@X_K`k%!YB!#_R fi={G{> P͉ d8{ xŖ' A=_L+K ކO?z1(QA*JCH1eP77: !T+bg FYsf?VjCFo#[]OG<|!~ h 8N%z;XD+%Lp^0v S0tS)fy S2"\BYtmR-tݲI\)KeHĨ[V /9E&F+ $%K .YOVњ7b\r”ɓaj hFuaaֳW n`aQz\zTvP˙`<GO ꅱ)T%@d)=zG>ExD .Sт' ;!PUOxtV1Q!Agd?'2 ";x 6mL\Xy$y:<_8'Już<'%D4RSzGbܞzemCw9l' Fvq)+-*o˚KيH!eB\'$s-R0>L@V@C$^jYfx'Ao߭J49ȌԵDr{H6?7&$Y=7&$3V> Vٴxc|V,220cwE/pCFbg&ʰB7$m$Q+ɁH S\:3`񚵺0mȞ$b yأ G]mh( 'K)2pٖ =^R-*xaҪ0 ߅=zo8 qR8֫qhoQ>V=`1Gj1l֯oأNS . VED /omcl5_ c.N fkzVRZR7&T6778 U1~c2oXhpm D+r@,'}3RTɑd 1Vmi[U嚈[@tT"|1aJ_]Fn#ZƩθluFdH,6I{Z ,qa7(Cť^SYEAExI0>ɼke!!EW~7J3b.ѓ4EwQPīTӮj&b G^ zXW|W-5V C49,.+9Xwim_I+ZxK>&I濽D4TJn hpH-Ȟh J 'F@ t o/vd޵ 7Y!IIV ( MVCo旃3nC [hKqzq+\a!]'lmeUqZb\`lqt1f`Ҁx E?t#4rՅ})ŰlT/f~RXrUԄV8ɸQ֡ޠeN$  c_)pI1Kr,OQ[-Y$܂i$Kے2BTET:'^A ztؑA;0(㜟Mg=4Nv-xrS"4%v˛IҡaT\T9Yku2=Ė2=RĄĎ4I UbW{Q{miʜw2(5G$ǹh)AMAN&ID;N"DTv|N$z+L'DN}"t`na\6&ImKcp?CP@)tHBU9vIMHkΉZRPA P-Oޤ/ g;nLZɽ*㌅1Zf(]6=.)콺0i f6(Q%WoQ+$d&oHHn)aI6۬FTմn a"Xnв8AGT,g|6S_QՅUӱ c?%"1 9]Z:|}0Ze 2=1i%FK #A%kucxqFMf\[!r`㍱_Uxg6ds,7|[K|T;H4𔴙[]أS$[ȅI+~=Z \w8k*DU7*,ZV^f+[D/~A,dGLZJ)4[7]1弍} ǁ"%R1F>– q.~zE@hOz8uԅNx{?xw\#^1ʙj&U7ӈPD{WpjAκP?R@O.ieD?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 ELVfʲ+v7Wʛ0G\U)]jN!$ 'YO%oY:Ds?$QV` HKm/4RLugE٣mcW1%B@B5fwІO0 2%'G$ GtӣS7Lp3 X ZE먷jJ{?zwY Y$Q 1k(nL욍fT‡~PZa2=hEA  >%QrE |{ոqF[ ̠H KI2D,57h3p~@EZ:b\l3Y l#x~S:l<toAL7/%PPaxL ܑ`jlcd 2$(f͐H8|GMj]\FMu`gYaDއ9qۧTYUA1pb5sWžkx8qie2)K-VUch%81B14j}1؜A Ki! ^&0C3a<%%1Xj141_$яԷD{-Y,ZRݙb7 - 4l^\YKY u hh2Ȼz1+K߆ ɍ35(B8%P |8ݠ@X }KEv{ fh&e`/Q H?- magLc*-ҳ<#k[# iL1vڮ\'EZڧ!Dw&4%'z8$?$0 a 4K8sjW d-OÀrjU1 2輤^L5NY箪s6ogu~;E|ZIRJ `2L](A /O(/9 rrтCxLg+3pu184-e8'I!TSFSQCS#+IK>~Oڡm,ZBsĄ%ѺMCQQy͎8Dd7 (,sMCG}MKtK}Pj>i z20l34< Z U< OkD(ПN~By 5^c6LWG։pK4&33G@='3qC?R92n8 w/,F{Q :JFy:mճ'|;%A M<<B3dgWw]<V>Z4(yI>n- ^bBXM ig bӼAlUg+ͩDX$5bn?O̭›%4>1s)/605kȒ72a܏d-w+ѾqfX(Y):bHJ},#"M g8`4 i/;Dt̏%yZBɞ*"n`̙13h [#&C|{D.awflJWքؤ/'M R =łKPiu)NbW $ݬOrZ kF)™A + 22#+j;B(1w"Cޡs[xh'U0҇r.Af'WPcȫd S>7$bhru?_Gэ*\1bWNzikiMA0]!IƔT|ǬF g8@oG]T~0;NR`4&NZF$6\0 *L:FuoGU" iN~`>_Guz tlW0~V10-cȂq)(ذ@MQ%g.0"@W c4 G>oGlŞգb@̄ {̊L G1WL,u6 9\|Jv°6챜>A {,-;lAeFwbjB/Maoܰg$.=_,B ݿ@Pg4{Nhn/@| -=B 6:1']iarG3Das^Hy'As_s\icWu3s4ɴ,0*7ŕV Jp1 èbcJ?_cHpCQT= {iWPi0y&_,׶=GU,Z!9Im>_GQGWLvZ n:x QX*~[iWz/ }h @(MF_}VJ ʖH(Hן/;Ose&՟D:P]~c?!'zl<}uV#qTGHE09G@xcm jr6dglskFRU-C-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Ӣi! zn3 UU*֝9[v 'd3ج]kaG_Z@< P[lz1A&=mO8Rv~ b8ʤD;i &Ϧ偩 lr=y&mG$+1(h0:$qiHymG幆&߭tH 0̦Ǩ{lSM+.^u7AC`e}3-ڬqk<㨳R[Kr_۰ǎb"OgPoG.nklcK̨aW1XWcL I̬ {lfPM.Wv%TuR_71/~ft[!L7 㨋Ő|a!ށV'N&W|6L&겖9*`u9"Qٰ̈́Ǽ|!auRHLٰ|J)|asbUb J? nܖ A嚕V"H#Er-᲼I,Uzwqzuwt6νiEj`:#[24Z{svJdi d*ȥ)6)cQNwQ頩# BArF d>ąT\(I$Hl˔6D_&JSI~&wԓtFOψBB!7h)<(;$<ʛiM](yB%JE[Mk,}Q5%G(\e3I2EBu̩$̾_AhMTTxiaZ0i\!(l2-:vW+o,ِ`s/AB~-SA2ygZI)‹ԥI<(""AۘY1#ɹ#-٥Ó <ݦXb$SH +Y&-+FQt7 &;1c^!e -J7k^6+Õ^!#1a}<k5*yLea@- yP8# ^AƔ# 6!L03ָkZ[b t!A4,&|}ޏv/?zP}ȝ[f<&· g&M{1bĺ&{ k-c|V>h@D8|ÂS4`=oE ڏiO-7jWXn{Uc(YS@st]gy]po*DPS0 &E5/hPNmoGQ6 ȈnctV:|aeй=PaEcp =–}g{ŗ {gymfG{K:㨓;Y/g9~qI_PwOc oZhqyˤ'ⴘ#2=̶6jcYa-{'Q̆= ̐ (t\(-`4ۊcd##X=63QduP0bΩ>(BSLQ (REVHcfY2/VF-^jY!a% `1 *-Ӗc+بY\4<)Oa~6znK0bXf{bXzG0jBe2wۜnUoGz6$*0Um /B77ՙ4a}0&63h|#qlk8 r;4Gvӆ=_kM1WLT`Z]rq4_֖C$R +jyc0<(^$ zg.~DGl]Z.tQ}h+'= LLذǞ hG (5$X!LnQaMUr+٢ dč|aUMl,5BP9FFU%$UJ^o^^(g*Uūΐo_TF7~[ၡ}wZJ%>ϿǞ뷗~D %8Bc_}#D@@[7?0q Ͽ?s ?XVendstream endobj 591 0 obj << /Filter /FlateDecode /Length 1779 >> stream xYYoG Q,jPHm郭ñaY%'ο/9NJޕ?8Y#?LTl5zVl3UJϔI[.F |% hJxTWTWZ9S6 H]mfW=͈3܌DܾUךʰQ:<3\QIkЦFјéվ'/@ԫ1jQ^'+X(Koק\ l㿦?^O>!ۮO/ Q0isLUoOޑ19 Qʄݸ7L"ۘX\ 3,D6)BuxJKflJ$&.ߗ"*VBJslЯ1/p* s|vuR+;bq,Uىp j7q&k5$xF $-sΔgw|p~r 'f^zmpX=M'Ƙ|䎮&#%s4FӯdHYL_ coF '~g}}=>48GT A'A c{TR 2o1h8,+c1<8ehH AxZr ] [B}d XE9mav꠼H$":eXޛ.Ds:q$e/i`K훸bpT@ڠq˂>_:ؽprp;Pl+tBS|N+"/<%-Oz" m|\H~M?yN7["#͹G&&FD ȳ '[4p~կFFϬKlHdi l:e48W z5vfseDI)a[.EBi4md:הykNN%-s>YH{Vc9<Ү8Q"M${z Sutl}b6yx^9}x"028Yѐ & 53mD$Q=,MX7l20h}6szm96(՟;9_;8Wrd0nFypq[9#P2Sm t*CL'&h d <&|3S tyRz+7 SQ}NH>f eI9@17%ޱޕ_Ēu03%WFƤk/|D=XXpLrfCLxA'2lp5ᴲԊNYܔLnp*",]h,NHJ#2;c QM6N]@lǏ:;$ KEz̍NڴπGCqڳշ"S['ҭz70~VkS؋ψ~q3o M3`C3<`Zv9ig]~X$ gNlQkӅQL_]L/4Ɍmv/)%%nM=-!x{ jCgx:)~0x-I0ikSRInL`H|mE$_:%8{wa "vzmқ)-:\GH}FgO"oAA s[..6`"@I?a즉;y_yERSɴo(YXh~@\Ekw. wJendstream endobj 592 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 334 >> stream x%=O@(?'p1* 52U&rX0`rڨĂ?t>ϳB.+\_| 07'G_1OTb?\g*kBP2Z=S%I+)ѱM4QY!*2U J3˲ҊNf0BFTtؼ5tf4 :Wt !De& }>xľ=C#M6z^qC]ˢ][0lweԉy6zu9wvKx.ˑ`ޓ&O4}V+)|endstream endobj 593 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 JXЪj8(Nߗ,N>ˮGֱ4%"@cQ+0I!O X d7~Y]ʪB A#E#V?i vwVgN%Gs&#q*MK\1 >_.@S*endstream endobj 594 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 320 >> stream xcd`ab`ddds ,H3a!}ُì N"v܏|<<, ^*{ #c^qSs~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWvt-(-I-ROI-+(Me```4``b`bddq}˖? 3}< 3'uOX0?!].S;6vvuO4xOl妳ɽs.usendstream endobj 595 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 576 >> stream xcd`ab`dddw 441-H3a!3G=,yXVGnn?. }A1s~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWqr-(-I-ROI-K-,,KIKN-I,b```f``X 6 CF|?NYw>w?$=~zgosdccSCKo1cqCCggwdԦ{{O ɿ{&M얜>yʴ ]F[bY3&L1yJ}s{{C៺?~؈Ι=~ewlUgxGBt\LH9[u9Pfn/Add<0DNmnknk q-bgNnߌ gtL'ݧw'I?|7wcߙ/i4\Xy87b^+Rendstream endobj 596 0 obj << /Filter /FlateDecode /Length 2902 >> stream xZr*x1YR3c,i37hf~ eR! @f|TP⛿ؽ]/TvAS(tJh],,>v4;1ж[,?.p8B>:'R(WS]N:PugRh w'6!F%:gl\)iXGlqWb̿xA՗}AY1M2z9n="J𑴤5.xd1VŦ^I9YXmRJNulS*uW:mΏSI mӚNYa׳R$_vQFLyATM0e5F2@cII!_s)R=n$'6͟Mc#LÎoUI%qQ(/Wu3#\a1xI58CI#ZaR:Qf"iP^R2or-jN j̀v)y]0L 54~I ~KKxu4ɕ72TI փ4V{WCq2 eN :*XK#S51X^ݸ5|44Κ=Hi!?-[)g7wտ:8)͍Ş!DrZ/M*der7cK"*5kʩA0X8h4U^mDN69}(L<4.sJr2X,llSJyhهnQtZ: ZQ}Bp'ms>0 vX`hy!uxyv;0R,W$Ꮟ)HTTdi'4 vУZљ(.c!J+q#"tr*(1k О|0b}mG/٭i3 p]hY5.rnxbc7mh^n$b~<"j{W _4 !*mH,|X8 P5""(RN1>-Ľjda96Ƥ8ɤ*1i;aQV.'57vSuEN`v6 xރ+ۑR  F&/93rz[ab)5ȗþ=_# ?Hx#'n52rʂVyWqSI;'fɇ/Pp9R8<%5d+J y06Q 2Ba<,r r0ĨO EAF =UOSBM"`DhH8RKզ#1J-NxbB:!%P~k*4Kwr36~Gn ('*=} $k2϶ZSG:Y!Qb[J=p ¶.֦B93euqLƒzH)PJ&9TMh9>~Mu檰[vVSYsSQ'T`HdِKpk7ė;|y[?˗)vغ< 9b3 7ʗQP}Z9uR ^dXz\撡eF^։)5:<7p= zF#*<1J3xhD2/kW% tI7_):q 4EVLmaI|Ӻ(&'QךY>ƃsÔL{J,i5Φpȋ܁j:5aC6U$\U'%`Z j޵evQmYb#k ==JaϊYBmm!72Zl#n_6K[$ڡ nAdZj-IPF/o4vW&7^i;S҆xv 7qih x|s`83*ڲܮYRko0鹮QcM"0Ō*~o˺rmNǜ{6_F:vRI3ɪ8Naް8߳%Ϳ/fok zJVTDc6gyU<Mڮ۝lڷ3*,m=M 1Hq jV71_./8xt)(L/_[Ou-kAt|kLD${ߍu`Ss[]fzʨMyfAF*syӎ@x0Tmb \b#J r+װ e@ٳ| }CVB)Qm2fwlmllJ>cζ/[:˷PWC5;A]IC yh%8I3sjda`Q*E]Pg$Z_iו݌< c'9um6q|WVg_~*3vzGX|ffZ{W7 $Ա9g.;!-yqWGotTHkmE 6ֶW䁒pZaԋ:T1PǬOll+y+Wl=}>9zBRo+l$-@%hv^pluz.l*5ZYz*>'ys+qNu3V fU *-oj>ʐo?TcS2D2ʺXs?4s+)glM:N?q?PHendstream endobj 597 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 523 >> stream xUNMh`ηv&ةPv0Mˠѵ^CtZt 5kڱ&!Xk._ZŖR݉?"7a/خ0`# ] s8ˆs貣_>f0]+}.̻;Nv|'(|GT zf)` 9Ñix,YY$%$+Ȩ'i33il.K'AixYz^N༔upXjV3ØueQrej*+-6ڞC^3 S[b0f9U@$Nxss󏷃$5*"Vmk& I<^zӿTy@Vѝ\[peMYN&b;\˶ Lxyµ8o^?RO],_d@Wqc sMlwv -me+bNP,M> stream x]olunpwsfcw4D0"8$DfHDu1nw Gm`]{]Ε(d ,ff́Fj\/ /1&>$Z]47ϓy}<$"H?qyvoG~w!vЦ9{9{tSDuqO`G3lHCg#ΣC=N0 jU{`fs\'-H`fxO+idž AS)Azk ̽߁eǏz;t ~թ}GNK9;7n;5tendstream endobj 599 0 obj << /Filter /FlateDecode /Length 2198 >> stream xZr7r[U!Fc1%XU9$9HdǶ$[Tǧ $%  a rGëW BoB7`@?ܜ/.+h pEO[zC csa|X@~P?֗'J!bQD!*1`W`pry|$xrEz$j|}Nb7^.y9r#*?~ 7ymwv>[t{7_O^|uBc4>CWML8ޞn1t^֪}l%˘]Y+ :=h=;9X})%X Ag =HFy&?~=-`ZoZ%_6;чd䵨ф:D! sn^#R_m El,Y )^y)?AduR赎=yIm2O&c6m;:MFřT#3Ivͦ·ϊ~Gp>N ) 祰k#4N8j>G@Bǀ@i.U*`H&Lѣ&#iG$eRC11#kKQz^E}eܦu8]{{b18hԩ⦮߉u7Q߭=V}STMR"R-O{6tWb@@Ԋ6_X^e8du.L<&s7uAb}[\rQv) ŋ:9}=Wl1Ϯ@dn9 (w&`ur3Zm"E؅HyRMQ-Ȫ8&+X%NOɓv0t%eҿ P9HR%fr%)t9%Oe[D m]_VM{YFXWYB>L%rXħtR(P`w{CY*$zEQ0;f6o2~v|6i)x#p69ʁi^ax-L~3Ts̾e'pv_`Qm`%ʁY$=A&yu;x8,%ן;vD$Iz<'o3Z}ݔQ+㞅1ƸU$X?-/kt iOr;ޞ8 &et(qp,3^d\=!FEᘙ@10<0fr*@R{Ʒ9lY`v#3[GS蛹,}mSmcHӓ/PprFszOEB򓥂!;Vc\tm'<^Γ}Ibd*&,"h\g8F'E%9y4=`7T a'p4 DRVhV%JhA<23o320l%Ӯ^ʥણ)Pt]%VuÒI[B:~`(pdI\pñ2Ȝg>FKlls9ŻvV!o-j)>mqiԊD5xيd+}>M;/e jͩI(RJ̬S dbm=x y:9.J8G*4 " ^vs 9(YBG$ IG-O-Iv{⣶))'~u55RЌCX>vS(%VeKZMNSgrxU/*f((BV,7=1Q|lXwteS"8EO0MLVih,q]vM~^ i`m=_.y[ jf DϚ=U 3N;_l` T$vx,K>9iY+Iw+Ƈs8P*!f$<!%X2yHX hy0%E@dƁ>e3"ζu =+D FA2T b ܻ):@_/O֍*_ƍ?qPC?q @L<'s43ĽW~Fe4).w~(pԔ<Y`\^[̔yEHur2bܩڋYtzgRNlp/)-4/ %UTZ%M,^"!-W2$Mh?,0fendstream endobj 600 0 obj << /Filter /FlateDecode /Length 1031 >> stream xWK5ϯPj%9&cgZ~;yg=7Rw#?@ioǪȔ&*xq\$6?3-~;ZЈeE8Q-w#Mۋku DTmaWP̷ō|[j:x岜Qɻ6(efrF|]cMvCF~sӜi|PA0m8Ue y #XT~CD|'k,&~˦"?0lk)%O@,:cQ{A2ʓzfT7Nx/grʜs!'KPV =LHrR6KBPIf ,G"MeAcmrU$,9$w./>қBlw)P1H]r厱OQT15 &8Ԁ5)-lLаʣN" XOj8yTTB&14EP.2|dxb|Ə S7T BƐdVgȹ3VK_77Ȏ&Gٳmx8>0Ϥ$Qw54Y1|pֱ7yOy5_0|QH$h l&j롣k3c;a|xDdtxp]nN~dAeX1|`'$ L/- <2I-ؕ>ժ| fws-yM,]s=)n2Gma=m)WTW+$ޏbbx;=䵝<9>@oxE\GNOXOÂt?00VSA'/&8pާj"'Oˑ?xWS%uF|f3v?*Y`bc4ŞԬ/k(M< xS O֯endstream endobj 601 0 obj << /Filter /FlateDecode /Length 9498 >> stream x}M]9r>޿Bϗl0U,*vQ*u?f 6 %O8d0 ݎG}~>>ۿ=J5G*bxzïbB'|߷o;z{b}|3QPwOAy˭:߿y: m{ݫ׼_bomؕRhƝ}-#vGo|Dj T{(OݴK곔VzczKdCB(.GM\h?0W@{Y\ֽ>﷟߂i98 +/(c6L}jT jGF.ڏR=U?׏GWA#6ڪ%[9p %6#5Fj#j By3R A1&IAʚ.*?.5]^c7:d:`_V ݾ&p^ L===aш߬A '`K٥'&4Im`Cf`j~`Lvk GBĸ6uҥG@ {-Q- 7rUħ*r@p_rO[<ŒW_ݧw{ۏ՗F~I(n%> _&{ws0balF3CQh[FOSE)eAK<0VO>t4U/JD+exjzYWSOlGePLs9^Oʠ8x`dcYH9_&c)狗h:O|-аԆK*FzYJhLDAC$x"3 "G2! s5` F!d%{̖{B#ft!G b==1uI`"R!Nqk2$__4̔[Ƶ̘[J@#*ݓRiتń+̍dWd\0R1 !P8lاunG>Ɍ)g4Ʊq(Q=sM`Q׍&(CjաǐCn͗(ejBۢqά8-MhրHad "Afv!jDbu5N[= NΞX4d6 nb6 >80xGzFH&v*pчؓ5D|hH&"=wC7qD`2aj!܄ 2`eF2$(C*ÐJGwT吭Nr ^; H2a9 őL.&f‖Q1[!9fJ"SPg־^]$}=DnadT 3KJj8$:6xZkG% ő]&#l164{{mǀj`1#xXXbzۜ9 0!TӠr[FԨ7Z.လ )L"¾w<>MngBsZx0@LQG8b8DF(ʰtY#vcǒG)r9ˁ>rv8y 5V@^̵ePurle,X^aUjg1 ].ַcVFY$0 0bA-Hw6dtNNrF h[h~gD_h䷇~h6 C81YF7C04ƙUcgtZ~ثcX&.'n= w_xe k4>i/6iۭӲztZ`\.13e0-2AGX91jф>.1i0BsUB 4jӹ$ W1' .H4[ .K)CKl%A kDH1VݺdLK[15NB@8Z926B6Ӗ#&^k&c9gbP[;^UHP8؊e(s-\#mCe"hM4S 0sl!B?;FN3g"hhٌ7+)2:π =v4"g'9t_} ْ:Qf˅677K#E">e@> 16mrUv tT ׎10d01+DsMs{Q͜ "؁}9ɽL\v-k#r1f׷ t|Y0 &?-/=H \yKW`( ܳ.+ԓUaKY-@\ؗ"jX4Ҝ .QXVzpS vSO[l`9-ه q4ۓ C@3s{dV1zG+ВNCbW2yV2̋/SO(]s #^jR׆2CFOg`Lٰo2B㜎$g͂CgUrP;_T^vʑb,Ё60zcE=I::>Ns.~w=̹|y Ew7nR ٥汯Sj"Bj(K9Kq]ȁ]s[r?$)Z ٥] s-&5]j;&_,a}Qz‚Sf!)̻#[/&/Al MdoQMjc\R ㋱4)#9g #RQ'r.R\Q9Rؤ&+"#)?I9r #\qG;&r"ȯś#Dv)ՉlR~WXyw<9=_}o_}w>}s{';RO}@W,0LS_85 :x:D) I9qve0V_!a"fZ,,ù)G#]aȝuΤ<9}c7 h*aohq[ӪӢfJpea̸ W.&u,Ƭٵ3GbǴOU33%T pfYsa+jnؘ59z;3vJvmͱ9LfVؘ̪'3Wr2pf fʌO,`~,]+3bg_0kWf.|̣r`ofDHdSB[ *%藖著{i)$B{'%*l0mMyӒ.KpY3L[`HoYxB秥’0 WNo &oH-Ш`XIoFRam̴U-1j$Y{^LtLU1l[\~Cf(kInLXiի -DՏ:1OΦEnP:fZuHSbj9Kpn:1L bk~d:',b[s7Vbua`:,#ݗQWW.rN {*a0iYL58+UU 3*y&)XɣgwR]iUv{iD٫y:<ŒpgƋ7. 8y):yj /x Yx ;/G/+yMµ\H8,wx90tD!vtĕ~/vhwag3nkW < ’*.VQ&F[51U{$и}+V73||ViU`*,,J‰5:3јA Zgނ{`Umu%WW 3*Xuyx)*Z #{%c'5tTTӫ><&q6 R}Wl\%1UFNjT^*{)i<}r/UI Kbh/ ~I90Uptdef"5'eOpJNjg R7R p¡?Ns'G#.a/3EjeUy'5UKE20R~Wrlƚ ']c5J(꺵UiRw:%=KסYUmaOgfbILg W sMn܆vX'wnA6n]WOn޹94Nͭi$޳+p͑_:tƻgڽ,ŬSqcfJ,,˜ME%`Q^tR|OΤӰD&Ut47[.XVUTX*H:yЩ*nl#ϴD^;~Vs'KwVL[%+aUiUaJ, qP0V<wcњHK(_"]8gD3%g 3muDseYUi$\U•qT?.&25kzҼ<6v5OnY V͵X*øuݹMdjϼ;D`ckO95Nͭk$\U•q㳅WnN9\V.<\|6'7GNڕױqs-N~v!n9Vu8LUx,*r : iɞ*M+X-f L|;k`+c[gJ>? vyZ8Lԉƛ^LbHGo4,r >WI/qN۽{L%.Iz N|!nJ@;);R&h}JXi5,`=8yM%+J^앴hKonܐ\1#0fr&7=VL[1}`b:,S%1<-mfR'YL>)ZE+\HV [Z(#st%D=}aS)!-E}ᛇ|H6,nO >ob#3ADY%U28t,elUX9\%x?8)Dwh~ ǥBv)>~{)k!Uj"8M%3.]@AGϸ^=GX{t0{:yg]Y2?2e6 .Nsڤ&r:ѰHԦlOd ]^/;Hl[XtXO=;>Ü^"?ܿ߿t9[VO8UƷ9+j~?ց9:T_XZCJ~T~7s7>>G7'ݛ?}߾?mn٦Ijnævӽ$ʾ:o U%k{s/`y|BA>/kuI/t_ C.xI^!?d8endstream endobj 602 0 obj << /Filter /FlateDecode /Length 1319 >> stream xXnGWtKOb{_ @v"E- CZ%?I$"jj^.LU7UUrUD3etR0ivQ\wJƷD&5T HMzֿ)83]!Io"OZC Y2,p2 wm!*ar^/@U(MDpum쌕nkYzk4&q)+Z.Yٟ٨??McJn*(;Ue< snp$֊ }-KԘ 'mEl#ҒCO,?OLi+Gq9 =wD ϴSX5tt`2<݁ȝ^xzSC?8Kz^Jˬrpځa>X'ΗրT1#)cfX* }^6P tDKHPx?U8|k="X Ladh H`vD X\]U Q|,xdSeۛ!h8 Pn|DOH~*$Q9< qL-_#{Fy\`}=o2/21.3arb'-NZv8%Wi>WL^g @1k]ϑh'ljo#}&b$AmB!}ϐm=zqk_  ϢZ}?#/یz7ϰ?ye I8Q̯5n{aзCs1\oF}a]B7ĦCL" `9<4toBG#S 鏾 HQW,`V+6V+m>rN]|__? 4s Q6u=q rL&ąeR6Cbe08q8.2ttuv- zk.2ʀt;ޗt`x?K}fO}L}GM}¯i}?k;4ueXj=1KpcL]gC> stream xˮmn%__'VY`@-_PZz\˿?qcvQ.9'1g_?8>rK3׏SLw߯R]?,??Rq=G??Es>~T㳆kglK>ϒ?b̥l7%|/?,="_ m*UGq/?Ei gySj-jKrQ-X[3Y}Ԧ 2Y!-p~4<]Q~Tz*K2Co?~.i_He@C*Sc3Du?ͭCsRF'o]_umu[MռDYZRt3jK\߽9>JKFjywlA@_ΟgH)g9/'R?keu)ږ(jR .|K[^%3ȯ!o;O}}~[dYMs^H*d#CL }fL2a@Z"}}fr 5ɇ4'|ľuԇZ_FYz*"otTeȗL+MZܕ AS_Zg2P^h#KUW(cWs CUե7}-UP,EjFE\֤Ț ,y*fvYkc Ȕ5B(Z޴Y_iQuRtsP ^XOE-dʋSD?w x~4.VaʋZBJJ¼߄"i>HW;軱wFU/3!-j!ss!EB;!O[,dYُQTN+S[5υXVף+59"wȔ!twASm [umm5oeoRa@< m F=gl}E ԭr57C jH"PLu:Ab>jkަ؜[K]{`R )gGikjWgj:^]lV.a!B W~q#*6QqF |0/3\]3ju}0fY3 cʬ8 _4^@ ?09SBf>gWwORրGYpsNY{Cj2 (:RWT^a )d#b[o\jM!R23kJYX2?|:ludzhs{X$kAetMfedYyյ]~Nfk{OfMMf2Tu55"Xg|6[Ffe1' }5VmWl[HtxMgKLL~O]KRkթةj5UC>֞Vi󚅚ϛkJT ils!]6',Y&IFVz&iVr _7@=鯖 ÅpXo =7R2q}'m)~!# xj}PUwO]VS* Nk$'*$u;'<߱:y)2u\:nb4S諕]I/I%I\LO @&R134?eod37${6yɛ lm̔#S*ޞԒ^omuzXǫ/Vjdzԣ {^7Q/4!E*%:{$ AȅK`K Ufn;tz^{Ru^:1dm*{VSx`NxAO|9:ӉMik]eL2:7 "SlUU?11,$zcxX+ RM/ sb)DwSZݛ3EBQ Jv*S˒5 ˺!ᩔFzޱηXZͿA(Owbм0p7L֘Y?&]1^@Ù.LB٨uaʵ1鄌Q.XF$Sw`hՍ~`| YurL~ɐ3Gva/>/8j {aGپao:+eƆ}D]l9|U@] ZZ.Utc/, ǴaL'jY=X,uU8E ]zMW\l֊3ou%#e>~blb mX/u>=)˔.oej כ!b-esF6g1FV=yѓSˋ˻%bU_JGynuy;ͼV͑ycb:zizX͆fsٮs]#l1}@t4cٰ')].fK6,jtmiX[HY ,i1be 3]-DӂdаCL3ڞֺb!U0mhy ^D0dH"F6E *bd׀qEk q ai*p3jiG5m#h34[,;A, ݖFfܠ<6$DoUocBrJǓ2|! l(kzacv(+u^5Ucul> p\cAkm4F>q3Yn Ytз{[} W/>m/߃m1A1̠cFLtoe] XVy_6mRΞd+{toK8amzOuu&6J]Jѻ q%DRR1LH|E-+n U _RiE] 0wfSգzZbvu1C=]HT=ݠHQ` an_{e(:0"Tr WܥNЪ%s0 n5˩&(!QwOZ[  T{w쥫:p#BV$亱3c};R瓮,c0piD4ܝE2a_0{Hg;Lxawzc/uI$R7 o~꠹͟KpyFzma/Y7^KjoK&ƌaܞG];V޵_`NjBcB+"0|7b ȹ9׉Tώ {B[-tc/J3B7enDz2 u {ăyAXY<{Cѭ|ĄKL_5N{j!& {}kGf %w|C y44j0XVFmvU(h&^JMM3Z#|a{8NhBBkLW]zM ^xaFٯ.@TXA5]HE.BoyhuoL:2@ڤzhc+uuXBq)z$w5w?`Q>nUk\ 259A:hmRGGymV&Lur!3ke,Rx9He֒RRHuK;ަ-K 71{L12Hh5b<7"5^L hWHz!If`tU-2it +2S@$Ӷ\5nN4nLo@ħ5L٩+&)[oåtyF-",qnL v,++5GxӺClaMkf˵6R\JaLT4[K-nt;D!LϏ"vr)%4_DnU 嶙tjJV1q [yZmXT%PH7NCn䪽Zk6sXI,لo0C־fUX*=w2 Lh ZSCHwu4`x  Rݑ4WeSb$FW\CϗwlU?IWC[" ]p3/#X-QSUȼCY=N(yaf-k!:2oeZ]1h_rRj310Kl+.6]-lHAjnnO0Kl_<\Zk.=tga9"q-]qy`l:Qi blsg{V Avhu=Ӷ"M80ȧff^ iGC`Z o840L UI IykfQĆ`m-kMQ[ߴ_^>iH<;G6Sk1X7_HEX P/Qap(X"Ƣa^ f@.jeߣB` |F/EhEF4pKh8`%9bШPItr JzK mFYlO2Y Z%be Ga`L$DuC^&tQY3NU`ˣ%H S' ?AES['Ibav:^?I/IdzKRxٓb~]d_NH:*w$vC~_#)x|$ŀyɦ5+(6A0DIsJ::@p2k :dG1eJ3$[Ϩ`Ak"w$"H=)/FOG[%܊'VL!ԝ{?UcWj:}cw\4ycL";8<L巰%[@("ExhšC=ax#F+!YXwbuH{[d)YG1]M7@Xۋ#HJ(KobٯaTЬDYḮ9魖@cQʠɇt\HsAAjky9յA`tԡ1՞m4,X/ͧ YHm3nmj第oXbs殭}]r.xu`CT\TYgs S@#V>U\ 5zV_G`U%t.j aR-sLqW ]5P S'yE򵺬E*U&ǫDIYp ³=I>r-%ǵ;by"X `_ńjR(|"5wwE2Oڑ?35HMa2 1ɱ󭚱#߿dCҪ[KqPwo(\޶>%H3V.gCFysY] nv9lX)jIG"UÇwK(| sykz?!6Zv0Hln"tm +[;c"yb/SOo5^7 \#\'FWp '6k)w{^;>PMުzVO D.ؒ~} !ju&#Rz\pu3]t`bŞTe M\r|7/+lqPeSuSSȗ槼1ҷ\OFSɟ)z@r9F9[Wюcr?> rc̝CF^~n7vU6ӆ,~wctA.D?saʅ<^w<c¨Ua#Wfڐ&\߁s ļm]2[El :.\)m7q{bUJN0y (G0f%5w^C,Q/4k],q՟ޤqYC|>w O_[eGAn7QHD3Rm|mM>i-uDXBc4 k'1""bH8 EMr61!W@䥓2nȖeObǃ.x7ӏ_x#2HVd<%nϿAeG)Ok)=/'W*ı|0dt̽=(v q|GSwٛ#lD (Ο0錗 m,7fN{tmȟ.@iLrpW0X2 Q4 RVo&fRsFjt?Gʄ]hR [Ax“߈8&%RotUsj2s&/#jt`wtD|l E χ+a kF<倄RyZv%TlUJ92:LhO\B/Ap-66g%2SQQGƲ -#s9A8`22 ޔ 0גzdm$k2;GDRU`|HSKIuf χk9LKpuHYR`2r'z4#LEboRnp 8$e\8QQh}Z8iiz1ʴU&JH^V]GdIӼ%-8xL s'r\:!by.S_?W_ʍDHEf4"ݤ>%88; Qck$x|&qxF:57&=%.ީȕӸW%2[B\YqޔpCFmR,%˺PKɔܦ.O$C=vMe%%>QmɠEaQAd%yېHX}=XtjpGT a )d8$hBthAtLdL[D/ZlRwئ'G%8e<t'% v4w0-)rw=,#Mm'-ghVіѶfC1mh8-c69 #L{> -ȱzn<&8710ҌU.V4q.`s!kDkcKX#^: KBlhZ<0*h.o,rl7@:Ixw>aZCTxj#Rlj@suq7͍n##Kpt }HЄ6GJdD-ZR]?jS#lDוz`b`uLrlt1@R]@H[ r2Z Ab@L'n &ۂFL9@S.n: Ew VB(E }kOUm8?=w! vz;Nb{lVxq6dj$[=^%\)[ͦl"S4sji"[,ڦG4rΣ$ǡ.+8+Hw B514=i.֥ n,: =]}SВ6e<t8+p-õzX/3N$ eWTS p1X6tE#,ߏaV ( @u"ٌU! U$d=E \xƣ кaZR]|l; G| Rԫ+"Ɗm4x>CR h8\n][Ҵz aZD= P#m\ı'Ƌ}؝lx?vJ? p)>] V+=1Qƻ&^OZ2 r$P4FV8q<^@2>T#J B/oK̀r8C 'rܿ0;&-c?NaCU'׳0 .sDyJ]#{4_gD>ﴖ|Hþ1A?wR_p ] {8& gc4y?0Ny"d|>H[_6`ޮ: ˑjT2rӅ&B_K( ( ZM w=!Kܰ cN1h6 $Fw1$l]Ӄh[ rpqpׂc9Ds/ Lb/fo4 j`\tÁ $elia&8LpW=FK26wC'I𩛦fOEħ ᠵxdL]ZiaTxڙrn&EIH!7C%h棌/Val#W-X,#.uҩ1$ϤF5uGbp6ێhLޖI+2@U8aZ2ﮇ^fD#z})<=f1{s$.)H-]"b.@U uO;sPv.Nl4iYulkA9~ezB4!N|')˧/mGڵ1=ʤ 79fXEi(CdL`0F-An(X`@cp)அQ!Lt`D֕ts:u[㰬&Ft8 0 oT:c-дry%il -`ӕzklcwlF!O;U8ig sb(<(Gl`K0n[Bied,`-ô4 W=ɝ?G<.7~qHp1ȧ&33NG6.GġQ~>aR]&L隍I܀֛OhףzƑ|3 F@4fKpvZc o`iF#z%Fp+TܤirpȡzHpZ' ь0e(|ZiI w=,zE3D o"[¦7`80 Me \K2yn۠>,#SO,p M;8b\4 <& %] #4q`W0$\!HWNitsڕu x3 lZx>6-AWuZp.cN| jywTkr510h<Pq28x#M@Ƙ%l:R] fvVFlSz=g; Z,'2e'TA3j@pLkap-)90 ׁ&RM?yjHMҏi#}KiOb`e~>az[3TNnL\*IsՆِfK5ԡts`%MSG!!h.#EqhaI鈥3Q#Y[hTp4xr$8ݬ: [BFv /#[u-ô4 W=0F3O HRasT2jFIOGߝNjq@aj+)s[e8Z*܅ƜJYok}!ptiW┰iHo%d Ш?0$= %ezёz zݫؖIQ*2 Nkl ,^h]Q 0-M] VL7͐MH088- 6ǯ^..ʍp^r :/#Eϵ kI w=@sͭU# k>-0tun3@y[VL9(72@8LKp׃&{Aj#5b^;SM?.G-&4Bc^h}ZM w=hK,ܡOdHM"F xc8cw EƑ4`4P!(A(A-ez`IB Fg nUMw(2$2AKXme~>azS]g."dx!har1^X4Tmr;LN&i %Yed;SZiI w=+ҟ7a,djXx6xH?qF?96yHp:сL.aM_ae{1^%%u0'bl4K-q2A=#7`t3#295\ 0-MU;PGz˲e%nGҒ.A[=9a&&aә*Q!! XZõz3; NJy+wl F7[8Rzfpq ;KzD߰8oɋK0:gLA 4yfZ8t W=V .pFEPe M?qLqJpYP7"v^} b :R 砖&ᮇ y "Ih/ (3ٷ v;O\{Hxj .cL>Yq!VRdRU=4I!ڏ;5aY<Z45ƏDtGiY֛r" 1/A`{\0AQv5bX>>LFW ](OiJQH}|'TOO -!V8ZO l x&.R7!/k-9~qݾ.F$4PkFlW~-/M/[~{eɑ[WU ,\njجj {")W+O>ZyKؔ_/}.gxrRe{̣pW]aP WڙTۯ+s?MGr :J w!y7˒w_=h* |n<3tv-JtAjOxoMR|vU! 6֮( H{O/-+VKK35TX]~)?&Ngc̆l0SkB|E49W='NJe㗣ZH,Th^ru E}b"$ bkŞ˳3kq"?+AA^yaN9$I [濲‘M>4\_WGH66ZN\̕H#51tZİrO 2Yбq?&11iO F51Pcb qYka҇M@*lH >24Fm*8v}Es%P``11*OYfUW?>?V]&DMWLX^vXQ}COV+}5ٵdd:*6Nr~vjg;=xvbgy#vWdČrMmYdzUn>TxܞZafyud_[=gt}Pu A7,'[~]`;3 (B@ U2`f,7h/ް+/xm;z$hzKiPNg@띍Uvn'Q2tV'$3v+]ѯ#P6&(%fEK/b QJVӦDfjA4FFZM$wŚhü+ k/,>a0ߦ~Lg֊4FcvhE'}rh|7ؗI~/Vn㢧DǰAx,*a#Nt+ L{eW/ ])6]K,پ{d[^\^u=]8"kc4ʪٕʥ j੠21(~}^4*ϯgua/l*uua%̃0;7\ >Amq{apҒ7~U ө&`ľc|췿 )tyC/|QBY"`t6\QC r7mkz4Z.Lߨwl`n!Byéqxb1[8]Zi.bF;9,64$GVͩF|K+ P lI"?[HpZ>zJ\5*ZXf I@}dTY  ?U nݰ?ܮTa bЮ14iŐ MZ1f}DЌ1>̌1]3ZH>1&.{ 7cfř1*iƘsqr_iƐe^$nK38U>6 1+媀0f5ÇY,ʋ>1Y]h6 83ifoi1s5bQ^VB3 #3vZߋG7sE@u[d|p 0r+KKSIufD{%$1'Nc rr]FvÍ\CXPv)=l:(FȆ1k` 2:n)Hj2mk,eokh1\Z+ʭ=wnk6tαQmgyު#ט$ƭ=rtȻTm-c+rB[\)mŒk'(eafԊ a ל=m7Y5] o\,G"C `fi>&Uw!!3&Uk-&=NqrK] ؙ%.v硑-Kcˤll[stZ0R$51cLh]H(J X13de+㶪LߵtTTE,Iuroܯܖ6!OzD< ̧Y|իrL徆Ll"\yh-(8ln3,;fX&^cp,) zBHpk ,CBƮ[Vq .7 ajf TIJ7F5馯 JӘIa9_0ra]ݍQ/=Dua 7coV~‡ա24Ya/|Y."u+x_Z%el7c5!cjnM h3Fnv{a6s)Wm17\-znQVp3Q/5L|7Š]XD {ݨ _F#ҢgCaBzbFfn<0r! @8ㅑ+qƨ(T\ Mćx}kE9hx}^oح7F$fʄ}40Bl/a8iy1Zx^,<"Vv[. >ƶY_:{ō6OS.%ׅ)^花ӘN腝".}cY.u`Y?=2؋U~m0o>}C| }H>聙uA90~i],d̬A[a#OoG; \dKB,sy"Ld\YNjxmI62VGY4dDxfawN3]Jp+:tDZE= %+YD4/աzJ>gMɭc BD"ڰ}ԴoL@[aǙ= :.DkK爬yqZ~NzvB tO+V2zӎ"kוux`eOjM=::h@+g{[tx-HFF)*@!#ͻ<&2z ~uJRnt)w<:ŏbrkڹz:f39Jƹ$17QbQVE\TH#nؾÓկB*w+m9 VZUι{ sk +`*%xb/抪w׮{:6zAxf$pv٭a#45ؖ8M$Ks^ÓOpH9:2fӎCsH,v$+btsbY^A8opnH|xHbnaWsfu*bːxIUYޠd8g⪇ X呕^YyB .LѬ<e r?lB_py#aKS$DbcKIwXB;Yr.bE"Z/*.Sra ,*ժkGِ,C#xBeuvcGiJNoöG~ ,zxۇ B7~ܘ&c6(Em+5ѽ=نScpҶbbI4n_Ai[gh{x9ri Ɂݫ: g NB=:AT'sS {`2 t>F*"<+L'0&;6rfƑ tLS%<̞̈hڢ>yyX%Rs}je,9q 2ڞCWyVt: 9쪸Cz&n zߏS Ynyc'l!ײ`& :\ 1H s]@-<\SCn.1?qa<Ӳw+{#r ӴPt.oϽN^a̦fo /k4sܟ>Psc=xܘ٘į/\#C<[ #d~csT׎|`o_i3㨻o \wqM+Hpc ڍƇx UՆY%TNV]lta=„@toLȁsR¹ {΍c?a}rN#vZacyj7\qƔ+b18N;#u.K⁑KWIi쐸S.\ %w'O2:83ZɲA-)O C6MQ/P?7S3^GLёy7mMmE^hzq&֊ī6ujLzNL?ߥ%h=IzQ:7;>HX?bg:uk.:"=PF2nzm$8:k MXe'spC&dvtDlJjK Ή ;9$+Bn'1АhvkwglU P#, 99|t N>1yƤ|QO]G\ J]$32Fִ +F? tdQGƤn2@?[ 0-M]4Dޝ%fv 6c6&e5t))MDkvF|`$tk`!\U0y8:@F l"utka!]0D #a+u峗O3n"9'@iU`]x]Ȭ$נZ8iiz<:]kT1hX(]J,Q:iMm8,1vv.>G]FP$'ms`&AJWQB=y"9:.7s Nk:aI1 sZ(!IrR @1 3jg.8x%'"$ℽ(vk%\x%Nsm2 [fF\:~dIdtq Y>aH͈47 \[U-wi"kpNJϒ{N3 bh2-#R!z$Nwt#pX2 ' ѐ-a ZaZO3j܅b@\yOW$y`>9]F p,佀ՠ+`ST͎u%ᯉ1v`Hw|^#Gu軰@?[0MU . fCpB4h_=Ҳ8~>G&E|BaśtL 2Zׂ%%f.~^bd"UW&w YO[eHHiO3=IlKߩ=}4W^D[@90)A?Ḉ'Gvt#% .s&Gw,˞6ӑS\N m{Oc7\t)C9i},>A-czʖvV֙Y|Ζԅ\yR㕛8[μ n#hK p2~>-ô4 W=8-qF:b >y]^9 vW.FF b\BB𜗑xiւ%%%f ~:%tI{T?MՂxz O֕ptӗ\f\/wdb%'4+tZKeJ 7 Nw( K0wOUpǐN 0N{M7C΁ؖ-#4 xsPKp駰; )l3Frk/m:,–2[8S52@s/$\xZ`甗=#I笧!"Ckqͦl3;eͨ6xsFLua0-ȱzM4xx^'Hѓ!ܕcX6 P.>]\ 0-)|[u8i"K$ ,=K2 @WB$,8Ϟz?-CqqGɨ" vMms zK0:DO+y.$\@ĜVU?h@Ʉ,4q.i9 I{pokaIUquC׉x+/C7JTDZ~[9]ŎDxM˜pZXs&Sa]ag"[G r!H'iDPݕijO]h vi#')u dtfXt FkeaP Ft\N$\p&hΙs[9Ef=gN(h!Cw`As_/ZAr]2-z)d >AӾ1!g!bi"P2azpxd =tprISb{A/F% X '<8\KJ Hi 9r~aG%ȰE)^UFpl F q$I<4cemkaeG=M t݇85د)q47d?.h-A0\.%(U'U*Dl7dluw6Mq4w'-b%-3[1 AhZiI w=ܩºedtdbQx}fc]Z#zdvEB  9LN>k.IKN2[;dN+(H-@g%Knta:܅lou `N8l{$dӛZ}t NZ8v];W.q!I5FӦ8\/ o[aft5^e'qޔp׃"xG)ITx(_p0I0:q1gLs&᪇JaZy@p#Hw/zt}J?(U89R4iKHZ]FnkaI#},Ųбݫv܎k\*qp6MƱqwήqpi3r g,Jpe{Ȧez|/xM}<L5>~<϶iWtѬ':RT/B=@}hMH h!  >1ZpˊK:tilLKLk"`d$q%7RM0%)Nj7:Ni 4#a^6MSZbC!f(G-!ded7DMUВzx_+pdY zNj/'C99xK0Zˠ iȔDVF4OkAגz60'imCtKE#l-ж'Gϓ 3iz|ӗ~KMz0N,3]9D 1gO )~I $%xմ/ֈ 9y]ȋ!)M?p\)7[\BꦟC rp&XP r?*9P5NrkRnO;)ҹ7My9џq^=ߛC<"fS LQ /q?eXx'kE[>ϳmi&! /n=fU;IhǦqp׃|v08rqSۉ{-380Pas.=%, jaI#1t雍D?D8M?kഝ–pς؊aZR]F蘙q&UG h6Z8<CKp"e#.!Eu W3l̸}}?" gOGE?&h-ks F2>>aZiizpՁ2Q )ZkM OO NWFYn6Th?2[M 0-)Rjo#2lwOHKoZi2%`-˰8LKJ6a̝A tp,˹i.K03y#ȫ^ mkƋô4 W=Xce0gMCNޣYQ|Pte鑙q\A aDy ͎mB퀠sW;GcL4 x>,%ȝl(pq>>_K1YQ'woBQ$Fc(#em%%&]u"X L/rq$4u`tGpmK=tlg \ 0-MUÉ+PD'C5] 5mӚ4H!ށ8iŁnvHWT!ĀH¢Is!iTW+ '0i@-h;HާTBƷ2@?[ 砖.]+<5yN$RG.ڍs*OkഖA dl; tċZt ? u}N3|"tDdNd %]i#Ane$ZZB[=A-M]t/XbG*=j"ϩoꦟ\>ӭI0eV$e!(]w;vYe>7$E޶ե'd7~>.iaZ%Yƴ 9L^W=<[e~!#1әd0~GFj[!v;$2RUiĪ}Zw9LoJ+*p u"L$(>pmV?#`峟ϓ 'Й}3}lu3VF8ICd8FOXKM(B jq35Mc>}U̴j]|.x ؍M7TxrD~Xtb#&S@^w8LKpu +׉Xo\ҩҎ drr$N$7v6Dy<\rwSg^A d]IX5'դSӅ%x 㭁1vzlC?ǟXu}IJ AB'"D?KED5H=be26$CycsLDi iK(˷P=>%K(k<%G2 Cѿꔄ! XG[<#0e^DmW iF1A$Jn*+5WeJ&h[RL5#Ep/C.3AY.JHE6!c嚾pIvdMonQ1ʩ4-IR2@:d\vMDMENOUA: zӫx, U2m +^1J ;qs7wGMx7ڹe2-ʱ; HDj#akJtzKḷQE\) Fݔ4GI9-vͬDpoew.A"w9bWyI9JyECqZO ރU$ޘ(ˣZ3'؋GDBv"@@g=l^-^|:}.mݷ4?7Op7k|e;b1/ש$X^ XW@d7c?Wº`/Vupҫޝ\'Ur1x-yNL;/ H~YcřHگ@ ėO}(rG8c5=LqykX"M+' ;ߥ(C bб}B^ʋ,] 7nkR/FEm@ _U-t[Kz-.;]x@­`jQ2]eVY~p^-$-v K**\ZPSҶ!f),ӍE\*k%(P bWZƳƒG?؃Xno" wK}/4\%7]*L}[4wԜ$ S%Z x̢7ͅ'_944yPrF4XtX{FK,4O8,~CNȾyj^IE=ym>f\nc7e' ꮒ1v0duis0r17FAWah6wa)a͂v0 Wl!;ľs->b%E~M?7Y]VNjXSaK 4N*Ec!(6Պ-˒O T!:-{((9e%ұ󮖹o< v=%ZDb> w,i vg'*}bLOLO -OŒzDlϾ%j`b٦#䇦Ū/߆ RTc UoϚT3)mޜuE'*D\B>0Pt07hϣ~˶ۊ)hG"FLTp{b=vj?P/7OMYѨFڭ}VI)u0PꁽTHzHMEX7ό:9mGSLQ"e"N}%?0P}>3o  G؇ .i]RU"fLTy=;|Kw<ϘFߵw]'HwpƻB.1=n;͌)+> HY^=Z}FC>:Oui;RH3'ndfaIA $b9ʬa>+&$NܸBWq9_RܳN]AZtXRw[Gf;Mڭ/~ڛpG*hJav(uH\wzL-hcSQUmlG7j* Ȧs~>N®`{_>,V+ תP"pop}]CX:B e;4_Zx\RqrN9=^fG?B7<9=N}Xj-F;!w_{"k-¶M+lȷZ'c icʑe`'u]Hie >g|Juc{slU`ظ5GWSQDB0Qͱ^qRͱ-W!EI5jW0T]uo~=hKjИIy]aG 0``Ӫazw&Hvy3@x@h$B2ue;B7O:l el0x,h F6o;j`yTt&"|˲s0e޷1?7{L"~ӽI1N)WK04J)),mmp"ޛ\97i<P_M[6a>Yezz!ǂЯj~6S؛^G3UBcvͷMRt+Co>x`.2SKe^B*Nӡ1ъi~w7o޴ q GU۞w}޴r3y!ߕ @д׾K$r)ScΡ1,Adxg؛KX<l&* iO3>}07 YcR}{kAUvݸ[3S:@Ȓ{s)-<ɞs&;p:BGBS){1͘te?Hڗ*qG9pI4A}to3y`j҆=XHPZ:8GȳY=.#э}G'4jm0?)_=ʅoy=7e*Yr6<7e1HXT+ G +{s]@PϠ1QiӸ|v_45?_+S z`2,w~ +g[ˇ8coJ:UJ95窷fvf8' <㘱ۏ.%q\:W Z7qG`H@'ŹrB|"1r0&;92NcqbS-':^Pye:ĉq MJ6Nna~<* Ȫr Hd$fe .-LZ}h>[i%Bi*Pv$gJ8KEg RN}2S Oٍz!$Jh&uPϯ k WsDu Xm4ٺoBqxP@T %p{:Ăq ö]ѻDfnJ ;| U>X"?.1ԫKxGTV6 `bwh'?h|yag ޽/O_7${BnAm>mpIcbm%;#_=iQW=P3_+֭ɓ(q l>}+C4XԱ浈`S ֬TBj. E6|m#[m/q.ay9\zgȻ~[''Y rm8H^$n<57TU>Y~HaέǏ38c\πHy&]?hGxێCBC!|M2XqJbVk@aHjI&lif $8H>ʡ!EDݮcU$U 3bhHcnPym7=dx0⦇x鵣؇R|ੵk'U#@ȖoV*[P*╵U,_TE65qnu%>;'&՞m_ @^Oq.v ||[GSS%v bHnk]$`5Gve,rxz׺G&˦¼їlx Ģ~elRo<×PsBA9d2mfmK@FVBDl' IVF 6E̗PucF̵,G9Q()!V^ 79 jg ]Hq"@i|{ĺ`5+dADCdH=G)%d8C‡ ߓumW_Um\չƒ\|e.xPeR>ZCD,,_jȟ|M;%ҫYShEnxY2CO1ȜhY2b6!#j's$nH@h*L ftı@.sc@|y4o\z gOqœGwmo?Ķ:,څ(c^KqVx\J3< 1F:K29/t{a.LnV31"6r/D d2yۄmP3/\uCcφ)p>0F[e ؊z <=)elnC쐷E^An9͢,`UNaK= ]fwaJ=Y Sy4 @S,iI=wKaI=ca8=BJ,T TlyB–zu5-P*yRCݡiK=ba9=ZDأwHڴvcԣ-`ٖzlR[*zDl^)KjU xDW"@'0y§7(U!#(2I &fObK~^9uLr*.ʏ,{MkTCFO\ Oݱic=|L{ݴMHq;71-MGS墎zbU;þ_**u*-<1P2m $[/]/GOTt-w\<1Q1dng?15[r?0 :;xOM=V,$ bzҌ^8P۩9i;v?jϷkc߆iz.D,e2y'3}cT<1QKn=0afboOMپC{G;UbԔQO災=@ȢZա hH0g?1RM省1ݪgL1Ř=*qN2Imz@D3BQNK9aa֒[ v'xQK-O T8a+.Hbbl(jl[!<7<`Ʊb?0Qy ocL+%=[9r|` 4{M O3gsh%9"H9[&?ޏ;/˞T3%z8cv>Ǜ5c[Z?75zXM@zT31Z#oCsOiEDgrB%l+\1qXr-z`oOo5n}h>w恽ޮH fwxV]遉Jw<0Qy9{~`o+]1]ӻtkF>0QZ:\+w>ӓ>to${b )I7_쑞uaEzM 㚟H\)dXc?v+j>' m%Ù/5ID}*MMkp5k"(bfLEO]6Rg D.~#ƄFE?źǵ{0ȶx}M H:uk!rbgvMtW$VAQ8eCOٞΩ__cAq/57k!Gw9hhRqHv)g9yOCSy@𶢏P0P}("Fy%tuM|0*'Qff0HT}l&NW#k]?|4кDPg4ğ3=Qlz$lw=āGU!iA2 ΋GEU ЂI*F+/y+8;($lv2sB1uPg(1 |J^B̕0q}ЦU%p #r i"*(BoV)[`gI>+a_~÷p4R'8jPG8vW aS.g@tHHGei7ā3>6cQck-&QgFss_4ȑTR$*{n+ۛj| ҂C/CW"bbgs&pa[8! 6A/3 7""F:@|wWp3\ ~1]qAqX B ళ\ccQFIy<-%¢xmmS2< tPY6}\#a:P[1NB"%oX|ʐHg?ʴ6|51& Sg2pS=>q93POC9.!ѭLV -[$0DɌlk ]e( D#u. g%a!*=1)GV4|nَj * 1%^kA4u/_tބ6QdJ8#) XawuXlYow5x+ pe+OFq :`5Fc||⏮bHeXV:{ !N}l ֽCd֧ԖGC08<&r<-<;caz}nƤ4$oߪ=lRT әǬvh,5:9.]["D9zfQp-gᛖ}T}ю@loVSU1"(YH >z&p W)ۙm襉 ne0vȑ.n@n#1%K3*^8_G ݖ@˃pfsMURUnpPчگ1 S(1ݮ0AiHm%!enFT Roˏh`0ڛl[ ;Q])Kcc0Xgcs$YH>FWP{|"llZ0Sjk("Gi<87SoU*"J oXz~1 &,4 5!';2 ACP`7Z$swvǢݽW_|Wf] FI7!yiꚟc Ac4u82Gtw] a4b[tV:KuՐK>Ŧ>8k dgͱ.|}1/LBBg^-|,;j" 0J`O)˜dTNԃگ11: m֑?E*г[:Lj[XUj("`jMr@⩏ʟc"c,83%(o@L=6JWr[60[9a.^_%&T1bQ XI'"g&ҴgAUc sR@I4q` ɩ((1xjWn R8/ѝ93`0ڧ P7P5FaʣQܿ 0jPR*8-Le Fx4)5FjKrA /SЬcڷ;(IP5LG^vQā($mp8}-F1JsxCF/\7|lsɒeujׄ 8{0PI!j>!A 9h=+Is"ʙns7 M5ܖ`7I9z.8d}4 c܅ڒ4A: YZ.Sy|#H#®~n6( 8d ?"8ڮG1Quڧo=IWG8)]p-_<+MPln,_szE<'~BV$(P[ Re eSr29=i_=E@pD7{__uΙ5鳃Aۊ}~M~bxl kLX`4 QQcZ/)ɑ%K^n C[p %;crx}MI/e("m<0mD݄DXA|mdWXǔ;(bs z ɁiA4ut[pcw\󕵖3``كF(1S}2_JZ! Ȣ8  [ ۧUVA4 Sj h,»A'']>9EVoΤ\nCf;akËߏ84i__cA4u:Joax\n梽ܢԐ}N_6nt"ĸr1$^YyӸ'ti &`)]5sjg\MAkqd.guw3S|2tzu@v Crh-ٶڦ(Ằ諶ONSlZԭ=I(qB=(;-^%59MׂA4{\]fRYW;"Fh, x2al#ՖyjRtǬl7;s۲4{chxxGIv3I5QK2֨-qZ\Pvm{ل0i}m(]Ad%9^✗{NLu:f6eMnqPgtUS.NS"l^mф.jB\2Թ~ϱiz]̱F6Dؘ),nʽ f0EȄlge.Ԕ*@c}={16_]/hSewcD8_Lɪ'IY' 7P5F1C)WWf<MYp*+C@T9~A#}BVl!5!eUQ"i$̜Gw9&B>uEϽ˩V0jV&"rulw^'yB'̢՜F7KQQE\jˤX@RU.vȦ .u("G)yPgjAG*3@{^pG>9Y5/b `y:؊ O3FMLc,bGVݽ%!ݬMzU[C H#@{pCmgX'ϙ:зv#=!pMb_'@h}X]6*.&/4 S(1sŸ5B:⚊Pl1fa9rg69գmy"NV\""|:ޘUTs7;Mlz(yyl2u'l4]V41`"tLwԊ I+ 4ő]zSVR&lW'@TcEP(ab:<+qQ}ȑ`lQ2S `(+-( ;`eROpRo6 ("-yH Dѳg?+> :RwEMQuLَD8Prpڡ#("FyHm3 tJUH~gK#ӷmUw)(Lv!Co K}08<mRڣMHWVtEGבgCPl9ѤLEcBr̼~tY oɝj yg w'Qߏ['>d&90PPO#9B_΁gw=#u;%w⩘hq_A``0vrҁ"8 ԅ11Zn5_ܝ% nk?SI(mel]=>'ԇG:9JsXQZrqʶx U|֫8.f C7,^d`[JI 1D]NA ǮiM V⨃uݫ/&RT@ ۻE3"GEӚ`n aՑ/n{6R8aRlmDP9tч۸£H 29лXQHt8aݒE R[Y;q<:aѾ7Ck|65j&#9Ds1#] Bu^T9B=vw@kSUac&1: ίL½,8h.ݎk=Z•5(t~ӃR}08<桧\N`*BBŪKjř5X >^_Yq@m<BP䠯 $QJh2 gXg˱#ujΖ,c.MS{Ӧ;{pر].Ԕ@c)}=@B. Um\Tv9@2x̀ ՞*,*6/J5~Xߪ"XY~IR ~ryt's //AT5R"R?ІyIZ8_Ir\Gj("Fy`n__e?z?#)>UD !*a?XsPGgM~q6'tO~;-Sx~#-JY0A>2RBufYJ0QYXr2RiF3՘@@0SmY thx?,rpO}`,?\fVNڜ2Gj~siY+(.\}}yЮ9&!74ݕrk Llx>+Y[Z1R_ak{Hj2J[amZ0RNbOT\]̞{Ԭ]};ޘǸSFmy?l~6鄴SMɚef1gY QI0oW >hŰ ȌZzmUMy|ҳt<w\ҍ>_>wV%8*kί@·>FSO YZ8T>!> u2pP^so Y"欬EN{q 3u] A]uy)UtUoCyQPZX}~فPpσE<! p9:J,\g [C9/=OܡC'|-/q ]3C?As W%jG \ʀ>ۦ*cь*\jvykZc GLuv#Ͻ@B@ʪbSc'Xo[ZdvY7ҋ?h뙎ЮU}޴qz滄dzy]0R*VB%pP-{6Fjd3 yW9J+YMJ p[SqN͟A; twUՇ=.xeǍƻbD%ix6^"͡UhNl>|<͐^qcH`H&c#ևZ0 JʤX1:|8р<6>aWhmI $Zǚ͋`{)7Կ`⭻4w eʦ{TGqm n +<%Xmׂ}c"LIkj48ӊ%Rmз+F& L3ս? 9Q T±P6ex_V쭧{19'T Ղb~Q=Ϊwf>2#թR<ܪsyXpaX!6# Yܺb<Wx| ]1 >TZyƑ%18##8.y {/z,Hܛn9Gb ca.4 $rOuztә'u`;NpᴻkNV)a8O1ܴћhޖQ ~1RcC(ФU@$ ]7JN L)#) tWT!W%yk6)6Gl`JlFwCCiYp:,1-97~q9>0q\\ql|G-߳S87 tHGm@ʢ!9.Z?LW} }51=}15'΄fժy \VcƁϡ0Cx̧e5/v՚D^ǼO׷vZ"|FGdz yTiD{T z4 f!MDs;9e6G.JC. @8_͆<7#zL]I.iVJc e}O}Vjv<-/j '-\mz|fBNLČa1N޽g'抑E(b DCI_brhFz,PpsH󘺥1D<7}v9 {kیb{ W q86޼#Cyd]_1S)5ޗ ^Ua+y\ b#l|wmq?!Qs,a7 &Z(:82т@3kokhU`YHN"ī*c'>9Cgi"g}DZjLES^=0Rr0 ZxHn{K|gޚ1}s0abT羟נ0SuO{`u`1vb[Ʀ^0?Rí끑PCZ]߭FM{1N㤍CY%ެD!^ xYU&[h㲫=0 |r/4M8U$ @8<6HH[tq抓qN{؈,)2.C^A}dN ōv- @HAo{iO&Y$sjhB4l۩z6?ף̚TbRdHjoi{ҪU#uiCE$ҦTղA*BY7& P/p'TRYXˬ7=p p;0RK3[Oy c4 p vv:jإwqȅ#} yLcI($ni[s Y 4kqw©I]݂R|oAsɡ8u&Ҍ ~Qnٵ88})ǭB1ٗCw0w!>#5Be4}d0 ZIMQ1.څVkx;ZJzVrzC"j݆H[ứ™:d 4+Lk]?"cZj1W9W%N۫?P4@-'cӺތJ% VXz #OOՏW*tw0~Fd@"4MC-ı*vx5ఎNvg7*Ffa;z:AIؐPJ"YT\ BDľV""Tw9ԧ@,iԓB-E2Ên鬙@$mGHKe ~5D8q+:o\O47 >ڐ rf~| [wqA1m_iCU9|-Uۻ8>${ؘ0?,d> "B)wG^*>\?M >ƪ*lDμ y*P̍Vrsk0꣗y>}=kqos փZr:ȕi7*S0[5}߁0dJ$Y YfɾS4ה0Nu$EbjxJrYln@␌8X|Z ϲ0!.낲 g 1|)eݧ|^@ ΃:6 +670CƱw)cds&?s[L~^h3b`Si;b0]&O]y WaZSs"U~$H\}{ vH'6{A<9b9N d {z ] v!yePVBe>M6Z+jHfͭ}8>mJODBCetV~hK2}|۔8"A Jk["= TasyD-No@l?v-`R|g*Z*oLTs\l3u5cF*Dt F pKƳWAb" UQ%CoWZdK+\UoY`u|++Ҋ꒫QG̊ѕH0;`o͚тH@ob =d‚J[UZ T_f+Ǧ6&W %I펕6aW6&T_:yS<Yuoqpk==#ھgS&Ϡ2@Ό~0W)'T輦>~}Q$ERx,Fo8؈4\0fh,%Ƞk_2/f2ɡ*SbF_(ba+x)] jYsqO[d1Ed f fpI%P5F1CvsqM Bq>Es>L헌znAqdrrȶ DaU}DM1Qu/99CF.6(ͷ6ڸ(ƌb0z)#kf,9ct|BG!MDGɕi'on*!]i'D:AqE"(bCsÎ .`U%KW6ד8Vc(gpmqQUm)rw wDtn-b)ו5S]-9>^_k>~}Q$E;8,3*'@{g};%_m:eUirBd%K`;* <~|2tU{S#DrmgTCtxRDNmrSn61& -[,iyG땚 >&XFTy)MQӰ_s8(&9}u#' )[KVpv1m A͂EP(2N`GBT Chpwj/- 'XNvy側b94G(£L<,DEd D$NBBǤKG}8Jk.d<XIa*;cQQE280fRX: NMYߕ7u%qu2&I>R 桁--/\ю%G˕iko7 (bf0O31yOSH6V~*dEvnz^3đD vP5__9ËBc[DZfH'͋veoK{PA$hH09ש__cIQ&eڏt9'm9hSBAh^Ijrإ)>Ԧ9$GUiA <9ہȧmr;7MoX"6JU__cI <4e1iQ&t),Pݝn)-y r6N*gj")ba(G 0N k$jv(nD7HMw/._& 9Śrg6r# c_澣7&3E]]6D죸:ERĸ2Fa{< H7-Z}bӉ/l2n*5:9.]J;ތ$Φ6];ͯj7*T%jcvaMDa.L7=$E8 N2i*b2d"(baW[-lÑbCҀ3v},/gR4C0R4Phc}+<(2W~(o>yd:~eG5}p-@BRCg5чگ1(2W8|:Ư{y$#j5I|!UU5'dZi9>~}QEỳz7&> \r$@@ f0H2]WW'w5I~D $Í˗›D= a훒@LG&KA:l7+ R}m3EyH%B [5tRLtRKItK !Ţl"*C78 51C˗Iҵ&Hқt4:xmMѭ >eLK~ m}˹P(2W=#C"'QPd)#Mu [ niPҤh?nj˦8TJ(D1F)yG\ia=(tPxNCGhpXegjn EyxWBšO d<̦,-2]blBĵ2% 9~yܚ#w]2=#ܐwnciVEp}8.|bcI <4;JmH1;-QAm#lo!5DŋM6("Fy2AKQڷĝm~~[(]T| f}H 29,Bi(W RA^ax] E;zğmWCFM]G1dsXRj-b%xbJl+uxjmmPlfV \.DRD3XfpMUxHl^vw6H KgWYln@i"up/a\\_SR~NS6P{fc<7e;_ilKY(rħn~lz}e5W.c~_1k0e>i?TeVd{ґ/b[h :[h݁c}2 qg:%%t=21ڡ](6%Kni D")TK{EP(2+:;9;"b^&b2a NV_Qir臔чگ1qe^(Ɗg)wс*:_{ê@Rt:.!F&TDv 5EyC PHDE CH1>ڶU>STӓCهB?8;E%ލEP(2;pa%~*[nש:̴(eMƓAOk""a=m*3sniF^6fCYnmQdkSCk#dBmwv"Fi<ҨV6R%aѤxco迬 qmVJLDٷqyܹo@c,F!V~Se{oRDžެeɋUwVۺ)<`0. HD|Y e.r ɫ{J< &6I>#_UGJ}gD@'u=k<‹XrسL+l8l.~}AE Yx;mlHD:!aDXCRBf`W("FyCTlq7"hW-2KQ),R6x}MHm59>~}Q$E28,HKtU=Pg6~,.϶M iU&j4eVaJEID::˰lb;;%/&BRvʫz|MFfyfHۢx!Ite6PƗ#ET0GCӀ-hq@rϧox& jScg@R8;HpvZQ<`{$E Ix}(1D6$Sh{]H>m1b9CU,Gk"(r΃s;*D(9%1`iDn=N{W"<ۧ^(B^_塛+bA#4e R-bVSIݶXdL&k>Զn3GyWv,+z^+6Fq+z=| ˳+z^XXcA4evϠDshi[cEՂr!;f2mlRn [DDӠa'ĶHӾrT<4X=<,-˼p15}^\L@O.L7quq6d,L=8)7Y\fj&ܫ{5wO+g"K(K $F꣍NN'$hDUp@R>ŠQev2.2U~@X(%Ǝ gDt7á<هڼBR(aueؼY0c>XS+֩{z5 rdg;PhIC2j+`kY3%<޴•P5&]4rm1o(st^M+ظbYoS\9YBw+Sn~ _ l˕hZ( !ۛ߼DBCW^k"(baG698l9캷U=y(ƾP.`f>pZ⣏{G9JsXaw("i v? qeE\m(}FXD"(bûlQNQRGn۶2ڴ^_J!vBn8")GepX^A9iOP/ DN%&il!)y)@4x092]=[ 3|LąO{lY9'/41CeKI[qE")búͪ{u n1l1fP.b. dS|xphȲ~QEyX^W"0EآF*巅$}8c ;?ڦ>#0("FyXԐJ D. QzmL]R=8d7䰳fCm'}Q:kqw~;g䲡DmKnSIY-8d"_}gEP(a|P#D@Bs#%;{HLqy,"ޒًCD\(4dLӪJ֣v@TǦ:ݎ-͢v4% hr,%5__cA @9Zuy7w<|1E +wk$ʀ Ѯ هگ1˯#qk*gh* ~Wh[R >luȮLGu9JsXaQ*rt؅3XpeKWF{jP8V$9؍#HGEP(2ww=n%Ҹ|؟:SAwje˙CwvAG%BrA <]{{Bj0L*hz[($y nGHH{__cI~}QbQC<2K V6yOH= {vpmaͼ=J.__cI6uͯ[Ă&R %LbNtj,G]CJ%M9q:rEcn͆::>ҞF\Zj&̺a{tFEP(wj.ȜW|-&"F6m%2q ) Nw@.I>YܣH(e<$)ٵLQ*D^G`g uOv䝈` Z jm9bq:̻gfOU!&A!Ŧ /ۯiA <<7B<[ 禺`+'cgDG}["(baG_6$&R6;Zj[ C9'jP?H+G1(4aP\ D 9DAK,voBCB4bCP$"ԇãHepXS(`{Jїy`2K}&``ᔉ4AcWP+b\?O!߻2;HߤFw#Qm뿏r@Niһ}mPĸaTuH )!DrBo71ܦS*;9D[}@qtv6cI3H1DQ1QGb1nu'~`i N}m1-9ST/0h/n^.9Ë;!ih>jIo!YUR:e>ۛ?D" 9:PxIp_Gw7\W g^sgu# (#%_8~,[zm??O 3v`JnWBw5azz&2s5yee D"U DD4f/=ID,}^0P9Qz?2YcXsgKNW}ҭxY9ƥdşf@uUH[b}n@.V\jDNVAFA>GC]Acj,8`) 0KܰcmkIJ'`ABZAW4pyWCA-fWIV.0?]f^kqD0<|;M<"t> ӶWM;tҀ(3YqhޝWw. u ?Wk`PLǟ(b&]y1]O&0Qt[ V{;[ˋsup)mq4xAj ~+:[":k szryR=ގx+@)«pcrc9oz~G8p!z8$6\2XVs_\zNOb';ê9V9x6U`״VBTk=- V*._?"9@W-z~Vnj#j>[w9WUu~x%zc{l@_;s('sAGb/D!ot(a[!R"j)z3 i V$T>EhBaOKʈ ݖ7 5/R@w:Tur^ۼf搡:bZN,'m]󎏛C 9YX =)`9Xي.g6!H_%7-Ce{4S7qr^7t+ySsGrr )|ᰶ:Gؓc̟'19G%Z,E;6ۡ"| 1E*T#~@o"^bOC/\DN]_N遁KF]A{bj|R'OSxݔ'7.`\]f9Ec[7)d=[3i+}?a|Pt|Ї%\slna7T^1\ "d#sQho3f4FS:-聽}sCB@\0-h:- h:A3A-gMVx#?҈=1P؇jӭ9]h򉁪iv{SQ3壌?0QQخ@P͘Fci9 NH;nCOXHx=fMy(㌽T(eqވ/!,rաe*RflkjX[ӲdMz7pW\~bo S`q_ ˽2&*DQӊRheR{E2Ռ_1.芁|!TS7mo+=S߱d[.9 r` 2| I  7)VI_a*Z/M[(?!Eo#ӛmKqFydNk^{uԽzkWc$W4vFu)/uF(/uV$u苚n(t.IZjxcD’yq_`c/(y}/¬UC ϳ.\Veg\0R̾wrCE9_,C1#pA|z[s:6|=ۙMy, PZo/7ꩥ= BpIV2o1e+WZ<Ӕﻖh.p^X$.RƩswGDy3 S<0<Ǹg{md3e4Q҂Y|:꿴j.>`O8Pu^+QKq50d GZzllU\z[<~7Mial0-^͛K<;8MW3κcWWԕnD\uʾiMwv=1pU;0M@Ox6z",ue |eaω/m67ӵ5V +=k)Yx :hnKN%ca@.>K'X0 sl,;OSYV]S ҟ2.  a y'0;ehw|6 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;sjtN!aNbd&u#m,oU)X#0,_OV\Lc*g|8\*(\=~^;f½{JvIJ)k }ڈJ;~םhиЄV h"?xhbϭ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|2s}ڲe*{%쾱6^u|*&+L#"]etW\>(,]eprhCGt2)Ng6y*qryG~SQ@=6/ܽ5q ʟ{ xc_]K[Um>ؓWtQ|NO U '?8u8?hKj]? q p) I' C+<н>akay^M*}:+e6̘KV$ӏ9Ja@y8X5ӟt% =c痍PK 1mRhz }cr4>&fM1ZIcHjWbtΧ'# J iwtV#Y&~[M}_cܵ"\J¸Ҍ5(SAJLw!_zcW>O4|%|Ç} qEĂUL49ZqaW9$AOGݿĥZeGO_U-A_2w7C|s 0[ڈd6٦ -L #Bnlw~ݰ O0 6ao9ϭ; :H.U<`(b Da:A" NfyvQmGhl,_= faEfFRg,qPdyzèGg0"oC~p:V_Ubh+C"fKa;g s~9 󺯠zUooߴȿpZ̈́?q]/]_8xq虂D)0'N^+$}_2C:LCAC[Ww_7ӋYP'M!>&p_2ŮA! N a)1G` ?pJɑWojĄ FT>QGBfM {ÒiBO :2Lp5;'O+[ypz 'U_8Qɬ(Vot0n]K/4vH/{L3*e VU~~ᔠE5OY&_8-R)m #. 篈ިAWpZ!n.8"V<踌W\x;DD<̄rΦ=pᥔM +f)΃jqWTD8Q,OapeX8ű?"0ظխu~42 'ɡ193 [~.{~~F0+"ܾp:|q+iƁ*n+~ S>p`[bڲ˧~c VH;xJ2LѱLqY#O77/)A*<9!D`^w0|R1-Bk<Nc .E}. fǫ!WaoɡH a@Ȑ!|͂3Cgq Ħ{40H5tLEl!` q GaOX1 a,zi.eX6|3u3J %[oBZEqW!, מC|B`m=5N߅tL[T6MG [A̞+6P5"E m_}uEt׶Gs 7*B"ܓ>vY]ŏN`F_8(|R~9;=&BUcd`özEJifBRb jSN#V1XxѨ!kJSmzgY3tĠ΁oл. {UGb+eH:L ~A8-tZU;:0khpJ "|3ؤuEO k <EVdWJ!9|sc*.0œZܨmL&TS"}31HR1(XC పD!~A2,83{FYl[NB93 [ٯ,4`MQ Ap{_hFC_)DRX5 V_Y k6u "RM,P [Dd# ?gp²̗4^؎MAMGEHjmlv^nwH !X{  Sx Q) %1.NW@Jf"'p\8Rh8v!~”=]Y.[q*~0Ua+VJPÄ7%*We( "$ )61>(ȚF/ ΈnMӀob`b`gĢ_<, bw8"D I&v1DJI\Staap/]2}8N+V]<} ߯!(BB3x@^7Vr.]G3,ꃨ ƌ÷Jn#/)Q$5*Lc\YqX51K.(28< 0Fvr#7nXFME!qqxM3N`0a&X&3280*6{:6.6:`]A~q`c'(DXd5yk{xssq:n1:hXU ?l WIa-dΞĜ:yž&h.DL[n$fӁ!#q! 0~NAh@,pSKhuu_}]DZ>%Em#K"68-T*2atE$Tٗ]zP!2%l['> ` aG0|Rs?>Ϩ*o >JT4oFp٘̎$!WaqoS,0xR$s> k a>np& o)Gdm$,߯( 8=B9$Eh_Sд0`V¬tVpqfYK X\/2$!*vu3 PgRt>Ggn^ t9Q9 2_'5*[&cE2,nGQ5۹pOG;:EW 䊌z/LLn;y,KW j\MEJY!3Xb^xpl 1a"(RJsG|2._ {b(F]i=3 Jװ>mIRE!a q c_%)BH3xNBf,WyM7#aMʰW+hbU[2HX#ܯİGr`I0,/@")hVJ؄jb`P; J R9n(1Jb%&#buIpcI(ʢ$S9a}!{σ5ωYy} 5ZUfIT1!Wa |Ɍ! I d YQbG.' _q"(|oXݢX jU.6{? Wɰh󌋮j>,E'YڤprrXcs"b)`1 ߯")Bу ^MN[3r)# ߼u0aP|qXcbqN,Rc֏YREH=uRazaԭnwF Kf^ 6 awa6ے*~W!c0xvT;SFxu*?!D!)C0912OOw% $$0EJ-œrXúZnf/{O\7)\(91 Z`À55X^z" y96Ԏ#bu(Vf00%):pW B f0B$Em-U[G 3#NE~rf}0HX#!/̮WЏ?& r kBavC]PM8T< y@&a n#_)B9`k-1QḬ̀f?Dq\ 0GS0PB*!"d Yk430'Da7ِ))yX"ˑZ5; $A h_Sa|O9kݻ:ׯr~feM|މ_ (B`BM}Hi)C'6a&İ`iI8qadWm!9Ph-W Hò(Uү .@N-߶FU[nX[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ɞЃ8ҀY+BSF[iad(]kZA_@{Ge$ީ৻&h wW}"#1|^k)AP5, ETEА,+5&,GIESI=9Td/9*×cR$ _?6,y7K:CzG;;$x-[h ap ś xc %BfC,"!K+.* ȓޒ f1%5Fib,a8Д{c9-)" y Avް,ՙ{SЩ8,A o,L84n5FseI!9|̓s&Ӥ1|$-aЙm#?o0_9q<2moPiYLMsߧޖcSWN)+xd,* ^#91 \-GX"9e1~L_qKβI@'\NAB0]`jH sG^pD\X`# 9 !4`5$|ܟj|StY",EH1<栚M %ƥȯ˫[f` hs'rHXc(LH MMts (JREHi_ZS+0 އ'2> ~|S]2)j&#º0 Z+ j1"쭤28n81,!\ A`s:/ Q߭؎aJ {ZÏ<Y=:}<0Hķ`XR"$ 9[! ia6 e&v56n:e**kulZbQurSwv)+0|R)sZjDN%PąͽT 8:ߙD'9$ۡQ$ή5`|"(BJ-!}jcqh0]^,Zu$J^cc&5.x m`잏%I`d]7E{7vf4(#!j=œ.\e}`WxR,'5RbƩ18Uc_)ERX_^Ֆ?_кKjcـ?뫣\T;@2ןNJ%`-US?__(8is!2R ^gbf*:?1Qf E5?{&\xxK^dRlGH?jƟEn¬b2翩37a*|ƢJLjib(LTV-JD>gI Wb&yOob_6CPw1?Mçi [hz͟H?_ l v?.wϮ{qc7_w"ZY5JdǢ vc:h]CvA SMbV :`/ꉡ3?a'"Dy|eyl)z 5Z:&CF؂Ühhz`€\r٫ F*zk9E;eUx)UI-sf딿sczkcz]*C%,&&8&*H1`a `ѻApa(Hr6l RTK>`փu`>_Y jAfڂg=0P<}fd󃁧kZ9iǴȹ=m9:cզc7m:u!fJL}Wmg.x 88;zуM?z0.F[d}J9\b>}^]44G.@^'Zjk⢶{bY?`t/?}P6bvZߪaٔ waӯE#E; AUq;C`ޝє~9>G/Psz9z=u$ݍu}6lsC]v)vMA’0o{fhwRfm{s_1+qa O>R^;燻u|wݝԵ޴qvqZ_,/^{?qeȱ%'-u9^6ٔLw=r'A_yN-x .sMH6e4R}0]4a`LM;pǎz:iih8>#_i[,~"8fe0&f ௏3W\'PyC*~~j&Ez>d-v (/izL <50y 0ǙQtޯǡsSAcG&>Fzڕ0qdqb d< :}h_€37ͣ~hާq-Il@sA`-&X[ߧ~qY{:gAGNpԞؚW(tk)i\.;eaN0);ߞw;4 7.Ӌ4X'0J1q!ݯ$v7x:ScaϪ< ~K*nh3"F=)?La@8sS8j™jٿ^H_8S+?W%D7A{~0H=L?prvM))RX<#|y_^}8ݗ]\o/GyԅE-ڤ!"4Y2ݠW&Lu8 ˫ˤu]s.&LSצ麼yt]K{oQ uT36M1ʄ5A~lStQa|˵t>qK)E? C'qQy|&6H 4&DSyGxR~t߇GAtQ@aFO]nWdyٛlرk1HPel~cX>m9i^Us` ni|W T qL/8}b/"i}bZSL綗+}^i}pi! M+pM+]H;JZn̶m-~wt|⏂̶K h1[_a]жjVّK =nye~Sp#B:i}ipfjJ!^B90\ThYGd& i<&l{AmxNѾmm}m%L/hWgۋmbHɖa{Cia{)ֈXZlrb۷ai}ka0[^4\fܽO) 1,a\_c!0kRq&!>Qz}Z+X;QA,N  #2sn:vY]Ӣ ==FSW6=6gVِip@E?rqok庱J#)NlT-Fęjٕ?qA\]~~zɧ~{'oQ~0}nU_8SܶczJ-wjZĦ̓}a[ɝLMTTX4ٍAd*l:R؜ZRv. mP*!^fmd _ wәvR ȧS(Ge_N ,A[# 5U>ƅJ Rљ6(SyeM~ry\ *t*56NvP k]rgZl=N۽,qcgqV|:q6^-M]sxae@a81uFo,ڡz`e^:3ȂՅP[}}>#EеLsz5⧶jȰ2'bsh"U7xh"FiayjWd G ~#I"& W?9?5!Syd +hnNi~h[uyaBjmAbache?ƒ}3 Ud$M\t-s$A5 ?ɴsĜ鵯u0䓙->řʭA\p#No!}+]FM_ ճ͟2n:}:?>^AGkv,y8O|ii״?^qظC.G:j6W}0F\]9+`XvиcQxLJ(|FAt3YrQ#F-wf^3-jP0l>!<'7 쀢x㜝(1`R^xk\Of7۟n~n }qgJǎ2UyٷKQԀmv`)]jb'w|Ez#lˬK{lS[/A>f٫+$ %o25srMbFjt<1#=+A ޘ/>$beўZ V9:ne(zv򜙜/P_T#rǴ u?bfmKb(lx?/uf 3 aY~$H[2v: 4demM]¿k4&+ALc)!Ov6Қ/4Yyg.Gx(T6F XhV uYb};0y1F|ފkd+O; Fɾ4‡{ތ?5_8S^GYvZV/%O:2'VhzȚxTn%j|H^W{ATlz'xюD34M@N6*8roEe{޺mG*TcD_8Rm JQ#HXWOlj-:Q~ 0o:"5L8O|m)fy _VU>kuW +bMJymNIz-9OSfE‘ZZqQzܞ83q r^RKjiNxsI=qEՐb Td@f15+Oh =bI=q:%”p_m~gY%}/6&|=;2_^iu󗦪4/'Ttsemz5ɾ++}Y[5SuߘMhZ6rUA5GdntP NI w-«_r牐")BJsUɘQLH̺ҿ 8Yb9/4=*]3( ޯ Bx9;#>J F8 =TA-y{TQ5أ1na"0|R)sf'wLb6FDZa}hG49jUK)sn*NR|4B)}^ Db͘~C(0ǠE cj}T(EU0Q:KaQkTN𭏼P׳`#orpCyB$El)ĤB9Ă s),Ý58t0 pō5)J)!ۍ"f05k.˂FZY10pa 3Fh8\2$eLYhɽ*޴՞*ofrh*_<0lJAI -E9Y) 8ypNx8&p S1. TZ'6b`#ܯm'F0|Rc _"b900pvRY-f CO.J(1s3AR< U> Kp{BfƺRU vwMBks>-1;w 4)h?<df2|1. 刔o:bT=(t-kU2|R sZ Eװ;)ňJZ8s>*1|Q<(V:ړŝ뢑 v]Er|BBE,4+v)Uq0|Em'ݹ1M߉aq "U !dpxc (Jc *1=$,&1j\ WB$eLYx!хcA'}*%z\(\1d oqILg[qh1{^ KЮbw5OZ֪ P٬ɰb'kE/8tMo/` | 1S;s%fEdDf )evIxm*,)haOH1`!6C{8 $ei­[aG)=;~隼7kXT19[[-GCjXcҰ,ERX𜇖B~aVxNF*o~=+f ίno ka3.[0H K桹>=aT +.pb+9ZM%A{vb;9`(D9 +̼Pĸ<ÙE|+xBtq0<`38 |b;e[|1 }K-K*Byhp|y75& E~|~}e< IBcᠠs=SnEF%3 gPY tA08|vav^"YVc[EHο0_:9fe3k-edY^t(W0 sXcB)"4y]3 Xn⾺U"6nxڠe$ByםW `18Y8\8&w^4 ٜ%(N^vN,?-ޏsHO?לT"~A|YiX w>p[%$8;0frK]=2s òsQ)kcݯ |p0E~_ԓϫkˑm0`{to&Hk M\ҁ£W}'3{< vf_,1C;88k! z A2,4Z;˵f0F/-~Ne ָk&R!a[0 -*RcgARQtF7jbd5H ИJ)r<ݔm[ fwwzxOP H k hYt6(ER9}7eP{0PX'D!ÔςJSR'!'hY$'{H?R\qXc]*$8EM!3 y"ߦ\9dZFbn*4Yքoϛx|l)싿`]%APsQ+1;p9iE;m~-[-e~xIޤQuْ-Ƿ^z*{(ˀRiq=I!`'Y6.ibu" 28<KA+Oa P?b0GBxTjð]:SX@<"i Q~p~c^ZEP wu0< K岕A"$y4wb[\[ F0b . z+x7|^\~|بw-~{<,;C%F98YLmԟsWOw2|fV]  @il!<qTe^cw0#n9ArII35.( 9g[aX`J)9|Cj.͔RKmM7&úCPx>A p rwSsu. PͦjQ9E(Ύ (2q01Bѭ*g\]jF(}/}PxUqx̃lS8hBd׳*g 5 ]}XQ>8!W"$TW!0|R1 N+{F_CaUm`yE۰x3cqwOw N2E0Eh_p),V e*0MAIBjX2׺:A$3`뵆0|R9`F0 i17Wt87fx*5iJϧ8yv% _K:2o\u,0vEgRxq010N@c1 IQ8! jx]i9a")DRXżceF*A`3ώՙf*A&EF%s OD0p0{0з>]ӓتmD`v^b~5;lPP^ F*߸@qÛ Nr1`>a"D IhD՝r0f┫j٢& Q?b0Q2!t:C)h6GIa)c:PzS}LclrzU3 IU, 8|Bj1y3*C($d2xBq+zY"g=3ڄ3F\-2bW=4i=z8GTnbm5A /W%h$3^Ps7H_-j>Wʋ?mˌ=7\latz5+s>mpd>TeGH09<}]>tJ%QZ׫jZ05S S@M18$8'1%Cr 8$EQH5̻GwЕbdESIH39M^9Dˊ !DRX0`eYdm~3XQ *O0Dc`-鉃aa1k͡c:f KPsϢ CQډC~JsTҰ&(Kɓ`@2HxsgagC#2hβ,L2,|MUQ)@ѣ-MmWT&{s\PrPĨBN/`ʪ02{BhP04"'E9)EP9+pE(O5\X-[X&o,_  -18NgKy|@BLYhfMϏ" l E1}73'nvs!K'"C(,urg-c{(5>4ZٿѠ6SȐ[e+Ѣ{'Ռ1߯"),erxC;^*.YZzWWqDh5|EMIO1 beUMSzUT7 60#eV8|c{Q(8$1Wa`c֋-_ y&ZZ،Q5[+orxö9/LS+JǤ%ǬՖREH&o4߯΋iܻ8 l2Ql_ /O Mwd1 I290sP$ )d\4:cK3B3sc|+[m3Ţ AƜ*1 IQ;9>GtJ?>ٮng7\?oYOqoGTpNG;,"l?Wd[?GbL>~Ψ#mmkH !O:HdߏLXU)*kVgpӞybc@Uk`XC#VZ#$0',DQXhhXkf 8<ƦJ3aEPlEp0185cVzWʮ0|RsC+` 9qNS% Ge*X똏΢ٙ *=jIB$<1mBHuJ֘aCcF|= SR@ȉaA"&0̹I92 m'I(bUsv&ł.Is7gU1098j +H28<ṱn`ڥêg_N;c[=¨L2@ר9DH08X )ЩW!tpxNS]b~-a+gwKe%Ÿ`{&! !upx3۹% ``AGR 61DMpT?3Ρ8e EsFpS|O6eS2dFgselHO 2`d`P#ܯD4:d70%"$<Sf9¨c37Q{Q'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 <2!`Ĭ<ÒJ!2)hVQf[N`.Ӑq(oG^'O ,҈nˏL|sJ@gW)b sӟ96l~]-eҙx֚'EHY7M4Q|Q[&ܰg BTN= xy+H  kka\6@cv;뽠 B~[?@V9 da@`Ur@!0'%)r<4Ѹ/0„FQn,(a6nIAQW:1+A5B$eLYxfAJPF>ՔsҞ|ㆽLXJ$轾ô _:;|ቘ(xK&ɧ+wx<<נtmZ1"5"põ5>83>6WX! gb&Ck80fH$U#1+SCYk[Xy.k42jv=hbOIL:)TԇKRROAah(tpB* δ$ÐU!%%~y/!YM3=dj ?G~a~U*!$5F; ht;jaEO94 Y lXAE+C?oDjDR #ίz f#$ا71#L*4=}ِV}|p k*{>qEE6x #c25QV&&de1qMtykm8nMYrx^X+>/w6:!5CЗG;cYFdu <w~< ŽLTScG slCrh0)=M|!H!Vi}-Aes ~1ϝ "Rnum_3*TO;ɾc8ՇSCK{31c(ԈõQ`!ˍKw\k$]jh Pz0~JЁ(^9[fJ2\p]v7M#ɤ"=@c 6)on>$ 9Sys *XYNH0$fXH7 5mf+@Xl;@ڼ91C(].l0HyH*hu9T({-5nS*8Pc?oEhD]᧪8R(-)xlBTRpp9 =CfQHH2<\paU߆dQ3q, >,& 5ȿ1<;6$k&,#1,EjDZjrc"Ӯ[%Ȥڰ tK2&uUCx0v fILq^Ø1EjDZkɧEYrj\ִGƅMOu+u`plm>ڿ1 @jDZj$:ߐZ%MxS*:)%~j'$4@690N{)X+JAW{ \ibJZ0& /.\f𩝋{ўK, vK:79")SL"T$&ɩDq3K”FCFGPoja sk * 4UE1:$nbۭN[ m:n<Tj`_MuIWn`J!5"p-…azhvҕu^&h^H׸8A;{4Tt<$f Z7{x@SpFPFdi:Tɩ2$*:CpUhQ Gʻ$ ZnFO yNx`SaD Iõ>w% ݊\y W u5)?H2dPp!#,Aא)X#SwE0yϮBկ7Y\J/l)̸+XTy1IR0hx{2~FYû:T& 6$.Z? veV< 1C‹:(xH0%,~b~ %'!YqR#0 "ȬZ*[9~^>Bq[iRU4ČQá6ux!:MƒYŒ,B#kMsf@YrP.B` BԻP69H% @ &/H )nL od,׎JfCHhrVZd;F aX8TZ*j>Br1O { !:?`ת !5"k;V8r'5`deo}$ ?)>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)e{!ыNCFOlǭ  ~2CLu N!42E{6&ϾYPs4s[oY76~Wah#0,"ԈZ A젍'YJD1:n/UITJ!b"$(=faG I XUb^p碌^'m{4^{ĆIШAX/8r0o#x )FflS*rfS%J ?aa)t17N98%q8H"%M?hfAD9klG2 '+R\⾙VI|00"$ь!,e>zt,!9᧰KGX1GfaT9f%~4 sAwP< tIfo &0` L'81ٸE01i"$(?Ft ti>}Tp\-y$Ȋ0SsUxvpF!b"%`6>-_Fig}38 }N!Bw:).mP T1LJ!05L:Ɠ 휲td*mR_<`> zq'?x}hXsw_weR2R(o',6~Үx[IOCV {]X)%0~æmpamN+߁unt e]>zAu}mNb{j'GiKÿ9}8c }WvwN*E_>o|jFV~1hU𪆦\hNp`6oh5Gj́!Q@uV^ZJo؈ _־֟?ߗr̻_Tmendstream endobj 604 0 obj << /Filter /FlateDecode /Length 1831 >> stream xYKs7 7^V!f$:6 ˲ԒRɥ \ڥԎ Π\O\n'\NKԍ0jr1OB#7|mvG՚fEBf܌74np7}ZV7ykM3$ӠqLs0P'wSVQ]NgO :]OWkt\:L: [ml#-Ѫ9(.<-$~s9|QHkquS,nJ/b@*7w!J6Jj~~˔|)Z8_vf{R M=T (&QyT`ڦ2ƆJmnpګ+eI0"Bs*@e\jTh/ۋ"2ATZ 󤍃UC1 U[-Mqjɗ%&Fknf8L {lu 0uHZ:0<Ek0suP"uic\Nj^fCVdU7@z_%C6O|g  Řktt} G>GSٴ BQ(i bUz94 8qd4J EfG< cDDPb?蔵J5]8 #Nv1R(.v=W"ƺ> stream x}Mmm2 K#T>\ؾ]ۃvKjY魶Ԋ{y-lw8{ . ox|[||(4>ROzO>_ѧkJoRy H߿E~Czׯ{{|7iZ|g yGjK}|uǧ@o?}~Lo~Epc~}Zk.9< R~Fx~񏿔ԟ%)s_fjCb7?~ڏWؿ\s_{h)Rsui2)ʘ!w:qYLq>KgmLF)}KK_iǧԞeDO?Klc6H}oĮJ+cv+ v+=!%HKyZ~&H02Bw,3FؖmIپ|2ѥ%j?fBl-OK"Pwm)̟xΑb{gC[[`; zB/I!i#=~w֧s o_?g(whDuNmhcu- [!RjI9)fJSK={la>0l L=Fk #Ob ,1PEhSWI|#O.4h`:>rdX=VtCDT%60Il )]4Ss`l`v{#GcЧA'N*ip1 eWZ8"nb4ֿ?g:/WpŞi-Ro\4y6rhM&R3Z*i_#t Xh|Α < " &yO[\N_B'Ye1T/' C'+;G)Zrڀ% GhVhIq`Kg;299݉ԄndpB#d3 CcG>f/t\1{m(Q( %Y#74P %;N?Hiy#[yҒKӐ:7Mo:9#q2Ķ_w/ĔOZPi?!s%zϤKmя ǵ,gF kSkGc!V<ϦX)t oGIp_} ^;di٤ |f7vR+ۿ Ci5&y&>:BA>+L <Q:!-0 k !rÄtRXo;FYd C)^j""]AE324 ERVX!jyQO`ZLB  |F(6Cr,ӉiQ(JB:#XAqCJIfjrUԝ]siv/˶ */**pH'=ܿNu;@<7RcK]"6YMuh2<n?|mnB>GM\/Ob6A(TL7)>PRAkR4XZA@А6HkOrK!!.)4" c jʟ+KB!!P/&q.B1">I[ҷej#11mwA81b֎0,[r i. صc rXeVǦ'GY*R}s%NYS)Oټ`KTbbOn"e?#e0/zT^:!S[c)j$ţi6%<*w)|3r&X ̚>5x.Y[r6)-1T 3U[l)i @cn zo'Q[ J:LhnLjfv%a (ZKq ^c,G+]j6RP/!بXJh5Ч 6Cll%Q$;A\v$?Td D/_Xg<`s7BfEga$Y"t5ZjJ4ۡ"(nvla] :R{Tzԩf<AnK',a%63z)r֌OO '0mV`kCV#ך- C(ITÙHfyU㰾`yr& ۪ vLmo>^H +&젧I]s7خh<ŅADKQvzDB sqR,Yo<2bvdo#F>a6R3JKa,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$Ŏ~]GXX;i c)lRMf.%k|:>/K2a?B,#` KB!S$`R[ c̬24axXF1tufb}L0њǴ]02-.&اGN10Q;c (xN GxX@R !T:XaS ŐЂ)"0)/Wˮ)sDžc 4V=Rnze&VjdJ0NDC(BRyN Rz;W!t-xX9,1-00R7bxh0a<4% =ZGT RXxtGy&uIo-`D4sbAK!y8]lXNF`^V} cM%0m;SxC 3iҚ%m@#m~m5МǠY#^:,iA%ZZa$|8)2,LMF$H6Hf)j 7ԗ.Y XN7z!}SZheBP"#t 鉵ݓR[=^Z RxЖnTZ޵b7 R8yVy1w%nK5^4 dٝR(v;a*1V [Rc*Vi'7gG07LpYtZ~@:CfAZŭ7zcQ2*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#gbJ|CmC @}ȮwouĀ*i\q&o9WIw*i+aHIb`9Y >u+ ѭ!"l$BRZy[1tUӕ W]f1V22`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@?hǮ0w+&R &3#%픁T wlKa^ڠAp y .MRDc"d.r4y2ab1K ymlI%S1Bҥ!V]#탲7li" Z:UXLAq:x^K=.؃ V,`&- a#j ~C I~`,̭r4b\չr2/^~ub./0 Ho&d0XenC,+=0-qRqcP7LۄkQ S-m]Y>WRcNA:~MZz0) Σvݍ%Xh`?DeRMMv]VAvc:ۺF`RD1ݰ `hu5`i/k&Nd~3.(U0yZ(R(hxmУ n٥ x.Ez_ uW=c{퉇WB\%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߳#aFp~G[fG̷w6Ba0280Te. pum \04FRq;3a,ŷ4x_yXjJ8! $Wµ,.򆱔p ̔6T*I>}ôU\mHo%eU g~.j\Ͻ?]CBu-r ]/V• ts@iXjH٠a*77A&H!ljie #I"9 *V| v.\lzT/a,ѽy.Sb%L8]su7Lc$LZ1>^0}c5{ nc8ynإq2o@udLaw-]@׋uM[NW7쒚.QR,eX- Y{iDv.X[=ʹRcj}M }Y+~eJvXʤ*@]-fhvRɳj]Kםa,-݇ nJA*J>ʠ<ҹ~m0KjяLG`1b?i1|^BE'I'o:W1{lY`?0P]&+^RO/{Cfo_o9⏜ds~ʫFΗ%o+6bP0mijsj##g]rro0Wa$@FI#&)x zoI[Qҟ;CRTzw6rb/JۏԊԉԊԉ"eFjj/m5R#+446~H ׏/E7!㽝W( ,G[/o>)vk;4.ᘆxgovЌD<`ίO(¹yB傲Flmzŷ\9' _'EA>:B*?'38Dendstream endobj 606 0 obj << /Filter /FlateDecode /Length 1892 >> stream xYK5_> F@8cfgv!ʿ+SJC,Ov}W޻N IW?ZU~M0A+}n.v_;ijg|wv!ֿZHnrwv}s"v1lMuQ8iBY׭-%vrs$Կ`ڄ믖4뜱fRD#|K6kӿc銖w_ؙ??._S 4'&kE pG5.rHVCNȽrL~cXrRJNulS*utX-nӚNYaדR$_3C^F/!9˕QQHom *fQAx.CoZ#(0$l-J@ U[Q28|70]6vyf|2U0i?Sf-Lr"(A0чSjL^Y-%/SGY&)$@p5# h鎴42e-Ǘlqɵ6ҍa$d>ǷJz$ށE X)L,d6T/6C`.dr,433XcfOl0N j_mqܚo!k ֔:: y܃aH,|dm%$9 VHsqTM@{i kIMKk|9D61LAUaFZ*râGz ɾp@sJ #_yl-OġǑrdni|xqQ (8@_Wq0ZBi/ w9)s\Y[̆4P3ͼLfͬ4ԛnXKffS:U+E}B2Vy@{K$vI&8i8}2mgɩE%AjmC< -ŎS01 eP8!.g ɅRRY!I'_Z'nsQrt7*Riz_.jmK2} By}ߵn_^[EQqU6/x.l>ђpᤎ%\"bVZgnE熰' #bGer,vxNKɘ\Ccl_L8^̍0 l&G c\-1x4>N66Mތ1V ] PԣمP`EOqZ!-C@cL>r]Sjc3`3ٻq<fqx8=TmhsJU\tTi2dA14ndsw*@ǫʂWg:m-y) 2EbۙC[)J"&AS2xm;Hi}('f/qWEAendstream endobj 607 0 obj << /Filter /FlateDecode /Length 346 >> stream xQ=O1 +<憆8gEbapeG[tCE*`{قwczs L(qr@fiZ hJ:9A7h" JOw[#=C}[gؕOKs =;4^Uabf>Ba"ȶo*L. zr>͙S  'uT}3>G']T?C>V-mщOmo)Gbg?KI@]3R_@%1$@"R%\ޚۅ >>2Zn(DF%QGyQ!ڻ1Йuj~sٙendstream endobj 608 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 497 >> stream xcd`ab`dd v 1207qH3a]7,)%+c_7s7Be``bdr-(-I-ROI-S,H-/0000jh201p2p0c/½߭~\hہ  pUwg${uCSuyfM6sVj,jlf~-'iUoVߌ.fvԚ .&={ݓ<+al{Z!~e?3~9hCgumcoVJݿ]rj3M6jr$yAyv;;ˣ)wO4eolkn6ye]sw-k]]S]Q?uDݳfL(o5ӫfVtwtwwtq< sbf PYendstream endobj 609 0 obj << /Type /XRef /Length 318 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 610 /ID [] >> stream xcb&F~0 $8J(!@66P:y1{4ӉJr` w4S~6(\0BFI)<BNQ{ J!Q\WL@&H 9fH1Dx <$ g&ش Rlv0,"E%@$w{`r/t˚].An`[vyͼ`lTl,5S qvX-ؖ`3_ٳ$0;DZ U@) 2 6:X%:C endstream endobj startxref 473581 %%EOF sn/inst/doc/pkg-overview.html0000644000176200001440000002355414150121605015733 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 the `unified skew-normal' (SUN)) family. For the skew-normal, the skew-t and the skew-Cauchy families, it also makes available 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 deals with related statistical methods.

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

The present document refers to version 2.0.0 of the package.

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 probability objects operate according to the S4 protocol. The 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:

  • skew-normal (SN): functions {d,p,q,r}sn for the univariate case, functions {d,p,r}msn for the multivariate case, where in both cases the ‘Extended skew-normal’ (ESN) variant form is included;

  • skew-t (ST): functions {d,p,q,r}st for the univariate case, functions {d,p,r}mst for the multivariate case;

  • skew-Cauchy (SC): functions {d,p,q,r}sc for the univariate case, functions {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 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 Centred Parameters (CP) can be accomplished using the function dp2cp, while function cp2dp performs the inverse transformation.

The SUN family is mostly targeted to the multivariate context, and this is reflected in the organization of the pertaining functions, although univariate SUN distributions are supported. Density, distribution function and random numbers are handled by {d,p,r}sun. Mean value, variance matrix and Mardia's measures of multivariate skewness and kurtosis are computed by sun{Mean,Vcov,Mardia}.

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.

Probability distribution objects: SEC families

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.

Probability distribution objects: SUN family

Function makeSUNdistr can be used to build a ‘SUN distribution’ object representing a member of the SUN parametric family. This object can be used for various operations such as plotting or extraction of moments and other summary quantities. Moreover there are several trasformation operations which can be performed on a SUN distribution object, or two such objects in some cases: computing a (multivariate) marginal distribution, a conditional distribution (on given values of some components or on one-sided intervals), an affine trasformation, a convolution (that is, the distribution of the sum of two independent variables), and joining two distributions under assumption of independence.

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.

The facilities for statistical work do not support the SUN family.

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/how_to_sample.pdf0000644000176200001440000034665114150121605015761 0ustar liggesusers%PDF-1.5 % 3 0 obj << /Length 2164 /Filter /FlateDecode >> stream xڍ]ܶ=b*buu> u$-a}nsΌڅe9rF=\&QRd8JjmdySqa\ߍwDHc28S(X*|QgMB}J;Ş;;7b '۹D Bi 2mmׯq#RU85!!; uU\ȣH"$q& ]Xg{r:0aP&"{8Ʊ)V,~1lB/qX'Z,Rik,?W{g;/ھjq 4cpg#ی-SR7MopwTJDi'oƁr :)K5i [I=4!<{ X;vo7a.X8\6Kxq# ')JacR@.R<>UhM8D8W( QۼЙe uZq!?E[wh>٥/ 9a!$7O|'F>w%PNniJHkcZÁfp fQ5S0@74S~k^d-TW~7r7Sݱ\%LDEe*g#qM{qߏw ZDYp]$ч;܌IZЄf(r.i& <vaJXǧ4( lYֵyRp/ Po!ekSL:}J)n]JF>"cx{ Yj9NB30 )A-4p&$X\,$@BF#0yiU`$.)X}BmMΆd:xoxj,YFR|X}z`2,KlሒରA]Av|9AaprZ\+я7,% sXTB} ,8t6\_>0qWi&~}{mgz]bOP{96e/D[d5{vl}π٪BO^=j9v] f5Xe!F.Ebi r@5zW;(\_aR"c4PPmZ#`vnlAt8ԣq+O:)VzF{k1DzjoWlz욆6g2s1XݔbT ݲg,e- +={GEB > stream xڭXߏ~KHW-Ц >\}-6YrD> %Gٻ+Ţ#r8W*YeK&U.c9_lW5vnEےXөkOQWVvi}i_2z4v~-{=u]ﶠ_U^~z*^RY;Y;z*zl;z6_?e#0-(08抣8%Y9츼i)?fOVt#n%ɫRje6^ǧ!\z.yet$I'7b80ݖm濠`g5Z5#ǰeVQV7mORS,2pJd +5,&ryZ)+vc`)&~6%K\M)dJ67kKwRI|pƁd:47t 8&e<䡔sV!8آq9/h WզE2luGREz'x|M(m1`4rȸE|x~Kit^)()zv퀌xK?uC ޹%!%1Ak61iZ<]4.髃Ari>EN La?$>sp.mhLXP#9XfFlkOS. O<{ npEd+Uk" piԨ$'tJ(y~ 3xn +갈nZ Ka/("݉k?Jq\lB鸚jTy`G>'6|&KNy`T읇P<,U"GXR0QaߵԇOTViX@B?/(3V&wD.c?,)e'L>c+Gp:PYY7a&;ZEt*QQ]n_Wq9Gu6Q?[yr}"cyЂz(D4pS uyVvT f_{4y>ӫ)إOIW Q2 ̾N1ۉp-ⷂ\ eΖp j˚U{pZfTIް_se*Xwc< Y<|wE]L]S2< j%ë7q>=}Ϡjpm9㡞9=lz/Z~ ;Ku+^\6/0UWX>b6Os FuE# 8rPGX-ZuD*/߯=zsfn'yG { 4!CS:}{A8}$B9;ӠS]+XwyD3g'{]$d8[m+UV @@< c`ms1};o*i˴$hwZYKxİK%qy2f1?>< >;5*U_cRNt; \J'۳Y^L#Oggy)_'̷y \yLb 䀲ߔX,b M[ƨ}:w7iRm+/(.y|UY)PmnbLRE9ũ 8L˛' endstream endobj 20 0 obj << /Length 2520 /Filter /FlateDecode >> stream xYYܸ~ha"3p16l‘8݄u9S*yb_Q}$ىςLnH]rw[tUiqD5PG{{W^bo`~/tW$^ej/kL7^ Gxi+;65d#/~%ySd4M?Fueg KӅލȸgo>yx] GaF3cBϿڇ~-*A 'jG&9pVmiMOCCmߚ ]3(.NWf _Mm%4!s{U)yiP\CoW;)hڙGޘOA s \sO Sn(A?gQ S7ț,'B TRQ@q@2K8H"\Y%X%PnaG*-V];C* *5d@7 ~u~AH>Vcݕ0~6u=r7cɋ;;\;ްF#aIq/C5oBgiOmZW:6l[+9F̀%K̞UH̦hop+#_Y]\q$k{10H$WA:ȱer Pop1-[; .^&2b?L-[mՇ6&b 4,mt&C.KiBGY\;^;C'BZ)FD%~&M$$<.;IG*|V>݆RE$}[Mg!sL:Z3mgz,U,[>@|Ug"4ϲ^ۮy+.֣oaXby3%fޯWq?P]ڲe'/ݑWLO(@}CT #b!i @݂Ԗ?-BŸ (S$fSN:9;! J$$1"`1S;g7p}!QQŔH}gse#=YALYPQLٱo./"k[J Ox3)^i:z 8@!)S 8 XP3҃ Ij F!'ڼ ,Xx󁮈!;Dg}BEe)cm qaCsfyd^T۬6ó*0j[r F*l z#aLRfҘSn0 T` Ĩ] `vFLڜ=0 3Wy~ RplÑV9Iu˪yߪםgZF0{l'"CJ! @M wc9XusOUy ^b#Sd~ `{DO}Br!ox771~KrwYH/Y^K*ځfhgXdr7 qCuHhz/ wTN.$@'t,5`rlJ&{3Iܲ32lSe\Xjz5<\Z@2}[f)p˯Y)+۠r )$sñɝsY3Rn]WSxǽm!s-jŸ*\לi&kZmNowv_X8î/ `?C0 =8h3 *ƌν K6o߭=*ǡƊpmx,ѹS]|]zwsd[.\0!qr^ \3*qEShYU䕧Q?0#F/1V2\3 |bcWfZrA "uݖ%cW ^hJ q.1J)t4*?Zw2!F$ 9LoDQI&e2m•>Q¡Uڷl5@8o iFtz <;~`u@a7M$*->?E:Xζ%v_.n9[`9pV!uO j i]I<;ةNX@zWf8'K|,}Q]LlXHuQlػbrݰdD0T5LmKuLCzo31gw4#_O2vN endstream endobj 23 0 obj << /Length 1197 /Filter /FlateDecode >> stream x}Vn6)"HJ6AE큖Dlbj/h8}3OۛE" .O+^bW>p~B YZzm]{KgYӜQ9z9I#{#l7J0VhmU'aag ɏ#M #,8'd8g~ I4Gyi0B$+ۙ\ "uԍG̠:|DŮ;:Xa]%8/S4ͼgoڌpSVXKrr ND& : Pկ/Uhyw6&QL|m6رt7ԌY$1ϋ/- #ɵIڢu?ޯ%OU݇9zui_d@t_2C3L߹hˆVZKr~ >@s6b5't{;Yz;jHQU+}ꚓ ]3 q熋!x] wҵ .*FEmHY/ ԭ|h S7N`4q6_zͭkC/+%u)C7YwuN%Ft:aB (JYK7c$!ÏoF<  6)&Z1Ho-p}j8rGbhRR0 8 M8TAWi4!̕8)} f!&<wcHY^E# 7}O*.Er&s,yY9_{#"עK8I>r sνt TpBqҼL,}(4qՈ]iW&4t`n.!{)54Yx VX^Cr7$y8֘G,zeV-_B2hȧ0l']L_;ӊƫ#:Ü{`> stream xڝvuXm>ݍ -%t*,", ! !)]!-% ]w{5393u,Habp#%huGW?OO+"Ȁ08~c46P.0p8X؃a +[G,`+@M $mo@A0db A`= utAp w."@K +Z]MN]ZNKKk%Em--9Z Q5@ZD`cpt` =O+PfisA"jۂ (QoXHQ$  C!:֎P' @ ks>.>>!N^%+Us tb[[t=ψ~*a38Z1xÉ@/EXVi&ȅY+?~ -Pn !:Nm^~g - xxcf8@Dm08Afr"&Q&B ;+A"# !_uq^'VbYp;X?n]ՁC2Vtۻ/wR$ A _G`< d [sA# g_8yyDfC,B rG'sn-Eue%-;ÿ4`ύ`zW" `ËpD|d7R9b= V:WP/{' PL!5A d3;hɦHrSrJ|GUZXSu_ۇ;HY.ikX×ùZۇtCyNЁ {^iRB8rI3炛b#_>jFePgך%i<}[BUTh(VZݡ4g>T T-Du7vri0rc'G@Zf,ƨt?z5b ̾S ݹdbFW'°M:O(;j"{,Oi]@Y+ zV|G(׾,yns9Q ҄UTHf%Qw%BpMJ4ٿ Z,J#5\[? )!rU /Ii%gWnӱ3Xg3>tGݧ2W/fLJ+DNr؟y}|wHM߲pvWPۿ7alr[ӳ1a]dIjJ+%~?duݵfAO3V`A]A0jۖ3Vyd,q.e~iHwdF:{CD_6,X6G"/~yﺯ^ .?&xH$Ds CՐ峖򩞅 )! DvNϒ#yD$ K"@XShыk4v̀ds1c 7>,TTC[(ط^W |p^dƦR1jFV4M3Ly*R'aRBPI WK}G-x(UYߧn_ټ=S9ȟ&i'Y?A2eoQ%qfOwWAztTSC5cS24Tcoq mͥ^2`אXWWiFz_7F9p\ARd"z5rz=B8T*;:l6R6->ֵ$0qJ :ܖ@HEmv$4Ub~AnO"EoQGrV,ۗj,+88Jm&T3Q<˳n~e|KGͽvf-FL(X'NIaNnCbX%!D-˕$)kS:w۞do-{GEz_?mQDEaIf%]ȏCuu֛dU^촪{?Nvy?E%UVF< l3b:WoS ;T|k񿒢/WT$?zzmM Ͼޑk_]bXKعg$@qzza^K[X;|B"%#KBuk&E2# i)L|>E4$gT\q}7^)zJqkuXZ鳑~!d!cP5#Fe qje?ԾEL@h`u8j.][,2蔿#$\Oe¯Bެ){g84YMkJʹ{Ag l;9~7tSZ9M>ΣƗ]"$ L8IT?L'vtۉP=c !77i9}7,uQT{Č'fZKh&m_ۡ&kxi͛/{Kd f{J΄&.F q>L psCSA˄KIUr .*rX՞~O UŻHh8)Ce5dp}Z'&Z[R 4^r$W 'ۿw|{m,įq>]-nT˒p҃%dW+n#-wsB}#TُɄj'E*l(7s*y mI;ve5Ez=F矱DԺ?ؐh^=~\ۨu(y-Zp\yrP3yL3 fsnq߰uFY10:ޤ~+Lw6e4˃҇g=7>  hpsw?gaI $[_m9I,'v#!OKBp"ǿ~Yn.Ů¥uȄ&AgZD‹DkT@]a%q1+,e[P߭!AxPNݨ`|["'>{O[75 N=;B짎RBq:x*X'E&<K1ﮨ2 \^>^..ȈbFuJk7-guYڑˢ_|I1w~ژ$XJ2Mدa%z%gݚPC褶dS'&]D bmΗ9 {9=NAfoh7hh"! j(`t[>֮fV 8}Ib-V}aqtJnN/V1(_'Y[Xy[WtEF -cW)'uDk &igK/#brYR'< Fyx'0JY(4U.b9ZRhSY'{v.]E:2t(ݤo,1eP#jvgz<@MAGYg<VNǜ/ gx BKp;y.T'RjhE!M6 M~zd09SVG B.;+B7U8l"bNɕfN[ߙ˰I2]f00e\{|Po}VXhZ{tl85\,*/ζYxW(زB4HiN]w(lRs?mN]Y09H({"4(N#꛴6}u[fJ7%Z\w"7\V厴RƯ<+ax'æ.@gQW:H)`T;/~ 4 ذ%/V]ڣުm?e*-[weHN:锅Z>_stbo.\GC /'jیӔ7td>iGo[X(]%lWTo3OM0wȉhGܓswЧuOɗZ3SmЎsd,ǷH>z$':k޹9G8S'G:R UG|uos+3&q;L39ow9ݮ=JEio &x}o&7|x8Ԓ?48ݭy&^._: ^Oxkҫ5H{RAe')$?G%jv:N4h./ àa,/~OIpq7R&▘ AM4 .,s.=˖ 4W"`DȁC{/Vdx%W*`2"g#UPD r~9̤5[OѨ7ˏޙuO7Mi&.D.Buи |2vңH 'l}^Bg)D2e׋QmG8]A:is7}cקK0[3׶A`_.5Y.^6B,9+p@H7qg<-+\f*Cx9vDze+sh} J[_xwE;NgQ8ًM=ܪa $5+yLoP&C >ͩ߅Ծ` xekK|ic(x,e[! ͽ&$I:(ת5 8=<Z>Ӂ Y:o+?I {<?ۊej[U! "ah+ 8$ث*s=K-ܳ~ˬ-}gd!$aF% wj LTPi\Ui>k<ϱZ{/lQ<=Q?64*9j,, Oд@k.Wrbu!'wuf#H^3qPxZSޯ):HO xtYBp%n" " EN:EFQm]DQvu'22&䌛؀)*-;4W8?Tc'a%H=';/]:&^?V@.Ok}:ULU@ R3ߪ%qʜﮣ_Y }ZOXIߕy^3TVeZ.t\:TF'FT聻pIւLv7)۷`&o*PjJaCiMHƯd4M.CJL7:9Ke&YuA\kHaD䓌wf{Po0ޭ@'2(}Y1.y<^$R9lX)QULhyOػh}J9umTdr ,/>Cc/2;ʟ#B.xt^87W0j -!8UjawakQ$S;Koe(NmZ E:QrnZ׃ŝddRz6?|rN/1 Vem%i{Oռ4tM]pRgY66o?(vu)x.Ѓ>LB6"^SG,Tm-;MTȞu_mNc%.$<⬾}_A(ch8mf.~Eh b<>So<~`:AE2jEMI1yBl?'銹eRh|hN:[g>JGJwDcLc fy*Wd.ƹK '* @aaǘ]51}ck.D4=F30}8-e|usw<1}?$騍4EA7!@lbBuL-{otEKA1UAddװf(t 5JDS,߽EMEqĭdy]N *0qd6͘ìm%#3l&݂hXhH->JdCe8Sy)KEJniOI\ÉRһ,tickg*m6#?++9v5զi*y>]G Ɇlժ0sn1 %U=TRv9eDi\p# g~D=1TC[ª[]M)昨JSn$%2\^uu; 5Ycbr=|_EdG^X0~[_?{^N^TLyZ~ / /T=4"tt8 H~Cp=/6hr>sin? .{iH=4"_f.mn/*n4*2M*?bґY:*N^o S[6M,7{_Zg%%.;7q(zSmCboL`2榄6CEaNQ8IlJkRC7{i(Jb_H؛φT߯ι'\OuA4g='wC#NH܌6jgTohtԘcVU31MRyYonET(ɨd3s^"~D!-e{9"jGjY`!{¼u)K?afѪ|:!7*OQ( 5sF9,!Ek7l+pߥ5~IKlR?q 8 >f<[ij,Y)$7fUk?Yo:5T+3Tlת;Z4ꎣXe$Lh3l8QO~P]1JgKx~e?r3NYrZb4<OMi鹄ԧ_Hz\_~[4;;?O'̜sBka4zU1 (7|s>bKԫDFIE9n^u .pc$r'kֹ> stream xڝePm-[pwנu]'Xsxo޽:55S}uZ-瑱$UR*lfosȌ@I)4vۉyN y\]>}mj@  ] dao`lpsp59[N)#@ dfd 3~" Er8Nn@3 Af@;' t1vg:*#@RQC\EA^\A ""-&.PRSQ9]܍̍M@>GOA.'#@d`2{'fK @ dgY?ή&VO?tq 9g do'20pF a;+#++Wn)-+o9.NRsϟJ2؛kS_O$)@1deaͿ\^H͏8;1۹~uNt?O, @t YY27~6t'SrXX>9Ow;t.mgnAO@.VF։`4G`Rwn_72J(~ro(QKcϪWc[GgM(;USHvJb+hr1|{u;3 d wY0ss+MMOGS7w&- 59 WO 1,o~]fFffO<Sx hd.+g_Y8,,ln6e9Y|6}",ۛITF<Ҹ;| (C ௮m25kIU Z4_n;FawlD*갅'q])< gH"vQD_)Fi;e|mArDs6,K*\E-uKyj$a|Ԁ>B>5_ˍL`Tse05fWqV-\ǥGl/߰qS(51>ءn{"7| .H|MжdഇVNgTº~ظu$aTM@`N>\p7҄Hb#akUaVAH.%8v^K⵿ɘx[1R3K&<& J_P ^49p+Ļ8BuOg Q&u8`H!T >4,|&34.…^H00Cdxp̾3̎4 dWY~3ϥ]B5TVj%hK(F(J$Z|P#c14 `)Q2*]%A[K\G:Q3Vž/6< HtJrfjK_Pސn` j#{'awqp:~^/as*Pv@b(؛w 8B&o*EFQxJXl=}e ͡,0v w\42J[tG#lhUG]qD_Qt!wYP檞ž`:.M,f:C?epL60-|[x 8B8&;Q9.FhvLE3a 5Wzo 7J 7R!]/!أ5,R@bQgh&v r|@ mB_ۑxs#CqȬh˱; f鵶2 LՕ~goEc)fջ+tap`ȕdغ(DY,s98*wq'x4a~TF~χ `Jo+VL 5| ~ʔs>_HPIk-.Xijc.V^|7#^vDP?bHI[Y~"&NsCf5NX]RG^5HݓaL L%8.Z!>,_D)OX-  mw-bQ.4.V[;1hVew %CptuB ݽ ^׆Uŀn4TɎ?Ή1",KBڇ3;wT~Oz>}WxX6 ʱ>F},  rϲ)Σ%oD۷aCcf̰^<^ga\Lsm7w5*FwihLekƬmq=D<ŮGRD8+hCG\2$mJA)q"?{Y&L^H `^$Q(NtlbgE%܎ ^GϜiػ^_0L6t髝զ}Ɗ~r] l=N-;MHc!-U`\I3RFBw% 9a{v_=kW'wvGLdTNTA2$I`yMtI8Q *p T =|A.=kos\-lsk %5E+XF{bڕ:ĕkkH)2S}jȐiW'ǫ֟~# i䛡;"C]TK㵛rGm򄻸ې%%(%GȄ!E)M@ թX6zм1D91yXj _qgDpxUo{4_X:(p@\(FUmdw.'"Q)Ҷ[AO+)c졽!阔l='ё3ך=X}Pw-ŹNÕXm\?.JaxP3d>w%<3{-w &8~XŦl%O_re:誉4]rX$"qf=5fZ$Q/b j%yV?8 *"ZLQZPg^Y5zx)Գب8AwkW$Ij|d|@~#O8CzΆryvtVL۷]긾~(\6_⾁J]D>؀ N$Ngz\S[%;Kh0E4 !pNa\3l{nz+L)[QM9J{:Zpp7\<]2e"Qש'㆚RP<1LY!rBu9|v5OLoA GƄ/oZHJΡǪUċ^*k6O)A:)'Ѳ2߷L!qH_ْ ;K:svCE$PoSmϫ|U!7,߷uSY|mf/Ё@0M.v#AulE/OOU.rxt4(pYu9PxvB=y1{JCűBSD;8tHgW(.ށ"3hG\Aչ=Fgk%rO?o{WрyٙP5xiAD1135<y݁"wq*vj<7hxewF7@=tAk@qi1F݋xՒ'lŷ2 g+,C6BIۏFȖ,+ P*T76ؔ>J2AWS).kĔjH}aq\>)`!*|~g]`_, ܣ0^k_f+]_ 7$&!H`؏ _0h?jڧ$IZD\j9TG{:6]W=qܢ6'X4_u5ffWL0<,g&CfwZvJ͟`i?1.ק^ni9N qeT݃:vVXgW-2 ?!@u\$ZZ~pr>YAVMXAмnw|QN F'UNM3Г>S gp La*hl V\k{Ut<+|E[aU2?hGE8J;sQ郯P_}ˣ k\1).*'!n\N]V򞨵,tO)/Q$>l\ dYtu'&c{D1 .vSv`Gf59G}5ĨE; F2V u ՞G71m 7l8◘ Ch'EO؏g©HeTӦ "H)?飝T}(o WNTLs|dI7PW+1tÜ#$܃+7X6 I1B[32$R*3Dj1տ/֕\D)GD%{drePV0w6 q 0ɑDIc(1@/@R)W/ir57:+M} NςߜDL8miT3 /dW YVjމ>\K.ED\!~S/wp͵cl$1XXɉbSIŕ"v&G\;r]lȌ6<Ė3iꂼ>eP2hɴbCzt[tUria;&QfyT'|a>'IJl pIM!9JW,ojݏgAE(Gn'zfqn3O_'XAtٱCn6w\sWBYPӍs_gד`vC׽ٛnPNŝWAV[O$#knF!ߠseS^֚4UI-R_M&Bv6ă.z69X+dݥyTQ,!RT(8kĤM3,g6HR x<!>R>E)}ͬR\~dZk{DD5+INk)6 mpabjԡ""ViI ץ%Ir`uv[Ң՞}WaꟈOcN+(" k'MbMgn7Cg<[Y22 8 !pb z<^D N[xz+1ꞧLˉ|,/΃?nJM$!FRvIcJ|Ҏ[E~ϟf }U"‘n%}8EC/'!#.D4Fb[ѕA?sk6Vr7-@$A\>!PSy[ 2h#0|SR'q9"R=grd$f6CqT"pTKARo{?$ FSH: Bw>(Һc0S!Z g%xYe:3+~L`&V`Yh0]ļF6xWAe+kЙGkz1Ld$ t 8 P'(\]p}̔%TB.g>jM>tMCk$g"Efc"^+#{Li]>C ])co3.9gG?R4ol)JU1;ax?}q"-!ڷZȭ ,R,nYZٕhBsYC̱x& J\Ņ{!a1bf:>WC gQ63ۈedtm_{cۻb\F!qũ#"N- _BV,u h+9+tO0i23D{נ0 TEcڐ@lkn5%S8ɏyPAHp{}b%,C6lvz_Ag3׭+%Aȡv8:cE9پ*;/U.Ѭ  NDPDr퇡Ez'2TopQ#=7)5m ƚ^\A\ y703(_k~*WlG [2 Տfہ׸ #^#56abUٖS5h=e@&`ڛtQ-ޅV0f[] { uc Ogؚ}+H&lгD=s>"q-uj~lʊ#]8%=h<C-cI{~W>n&?RF: {P~ kWs5$yF?@^3*NjJxGWQ(HI/xMՋ˂r4O&~؂_8BqO 3*dnӋj(gKR !ryI4'f/9r)Ŋ\F"<+l7ug +E]Ӌj z?)} `GC%T𞞺J+BB{E+*$2z@}/nׁdcj>QIL8G֯y^Y{:x~*;~|X0>~;xDLsνpFelugѯ<7K{eFxOH4dLJ3d]LŚqs,Pw`2ʈ]/+}uLR WunаB'%~ e_؏Ib_ޡr0z"M+>y!jRz1,B+딿[Q!"'zUo`8uQH*+$ovb tޔZ\J2CcR& SG_.3F!.u==p^U d/)Q:5'!ZJCڱŁ=[TLq@CW-SBP]Pw EnCLDc/\qd"s' ثM _}1w@qt<HP} >3^TYk[yF @ - Vzc+,Z!LN5@κ.=WX)PGRo3oȲ釻%{' K-6u%O`u{͟XA|flsVZmE_l4 i9jP&,PſOvbbtu2ي2(ɋ<pGxI,a39"k>{w#?:pϭFGt‡T.Mg$Gq% $sXܭA=ݍga*1BR Kq5q-k O ~SKc Iq:WHzGm]'7Ƥys&:ԁlKx>ҽ/ֻ3=xq ";;]4m@ߖy*ٚX}FJo[)!,*"ht<`( %tU)@oc7%N~CԀ0"[2賣Fֹ2_UL) VG-$G-@`y+&n 8}UHHG8<;Gܳoֱuqtߡ.5HzDg㚸:Xw1((NGSjItN+fpBqe࢖8\`(}0 XQEQu ϊDŽ:R4$ZnRV.="ӃRtn0I ikHUR)nv0.Kľ4}i#v-TOVr _V̖%VۃF',V\AZL!-3#ZBXωv*l4mPNePV*iKCzp 8"˽ɞw!*ׄ]b0!x|@]; ~ ꃜʰZbnJqpooުkwZOFy$8B_oXz &3(t-aGѻA[=κ Ӎ_*c v_iL" !%$KaClJ[/aT5Z/1y^gf#E&#O\{w-'h-"2݀C^eg` 1=_zK8$8^<$6.qOW  3k.2ۤ,yF84 x餘Q(m(Πިx&tkwu1x|i LE69`6qn 2j@CSLtdXnx/.@F9Ăx( 0ob&wKamuޓպA 'Ϯ|r/: o0h+QA<ZA g1գj IF%yÙSzɉ[djx P2pNٹTS,i+J>&Ҽ f5ElI?5`i&N~~[xk~g`G2&UL׷#}Wͮ8WafE%yS)K[rK>O V-L>e1k홧LHsn"d.d~mËRBցPf&c ύ_y}R`5E\sh3a|듎(vx~Y܎h&UEov,\=?J2L ú? ;N2s]L9u;hg?=UY:R1Tfq~X ճk,lfOT+U# oHo٣Tʾtt̶P :ӄS`r ~ˑAq"߲F{CɖW2/[7ϸ~Pswj.Â_cف_2AɁsߜ"rMϥLzG)Dou!u0Oy"Uɫ}{#/N0r_Kw/HB?ŒsLT327<r8,ꂅSwTʭAߩ`_cvGyO/1i Dj VIiR YuMnq+!+>,^L]I_qޓ3E3Xhx[m߸N Ķ/~ ]*Sgev1 wMokkJ5)\>{s٢?"#"sb[$#}7yt$v{@;Jk w(!~mfW[NHoW*#;KUxh8 WnMx'WbFW=p;`%`cB9E'3D]a3rk^蔩m9JhͼTr}ĖeQ/QmF E)VD(ߴf)Js|Uũqy/Xd25 Gⱥ [Kђ:UAVrgƢc⛕ߗP΢-+N^hj3dvw2L7̆z3^j5P[:{ <>㭎jOd|;^,t@[+Ș506]sdz[F loQyֽ9bIKK:U]]s5PVYF:ѭ))R *+sVfHP<0y8r6}<Fձ2%R'KO"8&Ƚcs6R-jnmhz};>Mt-8c҅Z|bEF9_PO q=|B0Hx$P:=)czcasF` 4ھwJۂLAWNCXLe#@)tڼ2;L; \s{LεA=mǖvq {,L^HL%M5.Vr"jihH9H7[E=xS?Ok\Gc~rE|\rӖF^w 3koH(-A blrDkOފ%l^Xr3?Q"x\F1Cd K(A1Y'U6/ fz4">9\/ayyRP$ tHP-RXs3mx>GFf8}AG^Vsި7+ԮF)A67, ڥ$.X!俿D\ d)I`xP.,"qoƛ C/xLXDgr_2\B`OQ 8 !@clږkoՄ:~ǙȢo9M}rg3p0KMÅ3%tavL}Sׂ6lqO@prwW@i:mW!b~jSB: D%Zԇl@˝b>oW d"]e(uUC%u'cgRPp@izqomhwpzRn+'}~2u0g8^cu%&Q\dmi:V@N|/B\GE"?"{iƥɴU?7?Wr0qnxdGi9ھGg|[C ֬wR_LZ{wᙦN¿:dȮsWpZ .ˤοBۨQ1:;7йC5!*xa? ,~}aC4 qn09:ta#XsDSe/jAeJO5H#!zї2rRWiujBR=sWj+jYMn>δ,X Y'tbՆCEQ`֥\#•rb?䏼Jh dڶJa{qMn3Mt3p,{I(F}x4ˉco-Dۼz8Z1+ 'ua HY?'}l/ꖰH0Y\!"V= ߏ֬DQxA|v{( }ԟx-,,OvjمjNQ0^uǕLf*\`ࣴ>4m$r'& Ϳ {@̫-_1ZO J1W aZl~hc6ֽ 6Ԯ6w5ϭ|Y՜{x[Xl2O()~tHf@uS_'l`[xa nwZaՍ~w:w1v>=#C`d킅SzWfMLf<i3SBH%c6oL[b=)B$|44wز^Yn10 kp8ǜڜZJ|mEjvrnTIb,S*]ލ%k((~b݀2&flD!P.bߓ~@+yb4zKo9tUHwt-A6 eAb?L[5SڛRGCC7yq;w;oLpɾ lFOҩs- ѕP_\_-ɦaF}lU? k6duWb\!y5 /WUAN Xck2$DVEָkNcON]ϗ}Іo0bnNGjE>2FlwB&ߤ.rB 5xnYߘcE9˼W"njz@-AYF<+{͖Vӗ9k[._&tx!f믑뇌7F+BSgq,њUy1B篰~&F lVԹ PP)Ҡ=\ vI \)s!J\tG}q6Ltkp:uJU*w 'loPW_)I8"vTSYas4l#9EB+P xN}[m)A+䠛:nsM7Ճ\2M#R_m"'[F|7tׂ>5XNԫ-03+^1̂<_:'0f;Bt|tjcgʨaj3zqRXJLbX~^ľyêF~Vy)W @QÜ}O.EEO n <&s–ό_|;5\pjkE3U%]tU )2d;"Y`P N 3-'EstagSznN =I;-@{﨣(f0l?lSU5/ldN),_ZDtTi%aU.lW8:Z! j*}`v[${Fy{=#baMDhnM:EnO FSk|B/on+q Gp^hϹ0[a8hkZ!ç=j%|d| ê8xQLX pnn>Ibn:T{wr#9xCg~/S 4(RPsN[ 1K6Ȟ略!ݓ'_޵d_0/@ڌŞ鱶5 Cǔqf&KzC\;map?X# r?nteJBCx# PQZde^1>6I-!9ey3)r kɷ/"k\u pr$< SQF@ CzE%Cgdʰ xz g5Jw(xcyiS^paN0q\b_3@X! w>Ҫ۫s"SYB:`%K[i{ P#U=Tü X7 /Í(rםn ٔ7ml±H# $FAQx:6;Vp ?щmX!A'R/[ HO)[_1#Cj+퀠Hz7''X"jwpD/ kMb8:jCJ6$CBt#Y@=8%Ϳ&:* hmDi;A?/0N endstream endobj 39 0 obj << /Length1 1468 /Length2 10276 /Length3 0 /Length 11268 /Filter /FlateDecode >> stream xڝuXT6 ]J 8tHww 10t)!]ҍtII7HH=癹f?k^4Y-A2+'&=$!R@H T\NA!n!^  -O'uvIG'O(7t!W=d pw=?@ 6$ HH.(uY%X-AhǶ8A`  fdȪHk(Kh454%rZp- 02+ 7/0`hXHN`8B` {GW8*\3utA!p`]\mApxp0(O ^9 `!c @!nrqqr -\2Г~?ۀ uOGF)U.pp$#(# /g#۟ @ #q7/O1/Ȁ.0&c\<\l6p ` o&O$\?&=xkL?s.r6/]\l։ Nt{,AV*0x ldqW:9JÀvGl. FGC //ET,lV@{$=׆X`HwsX99akG-]C[FNEҗbWNrS!O/+0 w GK0>uB-$$=ެ\\|V.n>xYy>e ;w $\sx#GxMa4\-I:{AEqnW١Q*Q֝Ư1;0r,jId2$7ja_Ivekz67Q-!2}s&PbNJhZc8vpOmEo1b^ϖxX>Yjm`>(|n<L<|}X1!%o첸wEF"e[S2(a%0J)n{͉_[n-r9]L/y txSwr鞣,DUq.5PwޚwRw}Rt(R>m N$!*^34c_ryS> 38웪o2 bƞ9n,l& ۱||* w*`w|qJ^x '& /ؠDDJ>W#^\󙣇 ({'v<%W \Q^eʼhJ6fïUK,/_C6+m?d` AJ( $qdƨOp0滞B:y-yMYf*N,%p )qkšO6*  c.3HAv;n-$3HFH]xesE;?{ 6?Ji'S݉AC<mb&2V]j{`m )r5##4'9ҢR{7nDnٕ/Ber+z׼sTZkth]ыjz7Zev7< H),;PKd1,0Wj^ybt)Q8,FY;|}1$ iAeTJ ǜtTk4^ (=} ]DR xʶ ourAm{u%JnqT8;x[5F(J6zrmg'EqC1Mn*/"Kφnx]F]HeB2HqHTrC>Iq`D1LZHݙ3W ! nc [.6e{]ؗX3ҩܹ|~R-%_R H7E|H4=&*YFNzEÃwX e6iv%a^1~\Iܤs|Vkj`@ K}K_jo%G+ ~~GQ˹yTH+.P%Bl!\,FsԊwN,'ihm:/$7{Cr7Q:3tɄT!9Ы}xÀn=LgCWL4 /1b#ʟ#(b#d[Cxd#=lvNdjmuEJv~ugW`x >|o COFvc.`O [6$شXHdNxVFȣ!fb) Q@mXV_tUN_X_@ΜSy2d!EJkYmzXbL\O࣫5C*OJ)#^4|wIInRׂ,cJ"m6r Un0ҍ tYj £}@Z*w-?([/Oez?;JFnvF{})7>HLW%~#s"Xeމwk'wqrRf:!'2tlNWz۰E3,[ {fK>ONY%:QXKb>e_ɧ8}S +1t>KPZf{Oc{oT<P=DUJu;ѯjPY )vNQ5W:$ CR+BO$坕ie-zDŶ -4YΔ&pOЋ@3\,D=gF rw;\yx-M$DT/"*;yXP1OWgE2cW^EA(}y3+i [7`Q!zVj>~ڻ b`{C3vm1YRwz9>0ޑjmpz\ 9ݯt.p=+ͧ.s4'bmET(j~Je:hf7FCy" ^DyA~Z}uD²_ m<< SBշJB0sٹrZ|Q!J0MM2|2zeN&_}6{t2c*x"JrBxp"]7mzC 6RrF 3aѡHaRhN1~2ayÅ ᨑ}U׋7g'|DEfaNIĶe8^ƩDPlj%/#qÏuH*N4,EyM2J~M9ݞ ppT~4 NV"{AB׉&q>ُ,D-5@-|ttQdp5# ³j'DFf,-\;$I`wpѢȝmms襧J:MW_d3+j/78tʃNr ˧شo%]2Ej?y*!7^Iv YɪUW:ƄaE"r(=;F }8P6X֊HQDۨv*⚸}c(Idؽzw<'4Ł%#2lI(HSa=-QlC !ZߥS-CGTѹ;-N{Z+ctY G:[ڃʟ[x+-ҟ(5oϔ$y!pe;|ԤՅMR*U6ӒU>ZV6}*m2 : G@2nCYw[,syz)1n%l/qY,UbR/jZ9Y;C| cT?R-'"yE%Ab>6H 4DHTq45A%o|xŴ+'@a8 ݆P}SN m l4&94E3-t~e&ȤG)>վ8&-cϦ*z_iJ'|a#qn3,ȩ}<9؝S7)Rkjȇc]Ƽ]qʙ21|^SFpN P]4-3XvP@SuNc\,wَX5{ob4kWțّX1(J ?Aڣ󙆁Kiw"DފQ# a$$+~݀'9C]gx<ۈZY7闻(U7hM7>wui䉴!K19M)ek4?3<58!:vodVׄ\kHʍC|-V\19W*+p"3|-8Q=\="9?JFN$[1f@;j[h/-:a(a:V|SBUb vmj6㴔g{SYATmiQn`9:ytUKoE,gRx.!U:b6.?kR/} !WCR]# Ӱ`}]̴U呻KN]Q~h#sBHUYuh5wإs~vyڹfYd(T'cӌD0nt7IL^~t.t?^~3K8h652J.7Ӥ*ÈK>;l#@f^ʋ_1%^E/2[CLd)ƌ,}\ΩS4_J:t)}ҕ 2z}';gdsǂ6#RhdχbL,AHnp,I|<߱ XxD0gnMC.@3_#,r.45ʝͽ?|e>ssE{MPU'ЧQz;΄!)ir/L~o<uY=إEc?lʙ߶;=GhǐM1HNuSW &GLҦjy 'g52@ؚr4l}#:OI=zK48+z/:8eM6Y?٬5C;wrV;'yo87$KmM$YUXFs6[QBgMwr+I/|P_GTX0OIdI/쭤sI!:@S]:yĒkK M'ի{{C'^v~F2a4R~e[7@jV}GJlCqYs2 @y. 3ժ󣪥4CDӦ_W5DKWGRH{YBC qf`jc.%ú>#Fa61uItK>#N;@XÆh#E}q+ۍĶICq{̎tDJP1r%N_XpbΆ>b3AKBgAvAY/V2>F}̘stlN5orGcaqy5~Sd~ixWFKM1bOp/`4s:\gQy,dCw[/f`uC/OFnuS6deuލNr{ܺZ1T\X(SHu G+G7YGc2b$ Ϗ> stream x}Vy< VYNEd"؉d',13){ZB,ٲTdk}Zy$H Pڄ]q5 DC?g#g&?iis R瓓حP5~:)Аnbh;Y,e,p޿^>ʩv=IӺ9:Eƾ-Ό`hM+gJ#YuX1ڼI;:5[t אb\<$/)n(u'攼X-;2}ZBWWK*ݳ)&*C[^poKa0:l8dE F Ŭ hRx?t TWSSy"9p^ąĠ\V3Hu=Tv7e%.QA;ÝbP=kݰ|j\jŀRQ3]7v+ILXWЖ+rTofA4( [ǻ$)RK: ϧA@|-1=׍lW9Yj+fjitn.H'pS.d2Mli>v߷J&^r\7sD9n芐Q AADwDe6dtJxHl;W33c3< c e5lݩ)!ORQw'G` ٛjw!4^8G6uN8^2Zʎ7`-So܃龜m;4MLғy#7Rm;BިP+@1t/em꒏rș翷|yJy^&ϝ Ϻy +~{)AYܸww>[F̙0u>nmOfKW[T[_/pa0P,1E yՆrKJ7ǸDs[7ئO"0/Mϱe^ھ|kQ0 =DRay)z/}q\M5>z6M2L1Rq8u_QUNLW'pnw{`Ǥ+¿R?PMu?ML-0ԋB-Ư2nqsH?[w0ύtdMxk;T /?R%,6KĶ^[|&XzTAofQd{r?So{%(V[7 |uNB)'L|#vo0$"TX{CyE;}172.S,ìtkTn x"K?rJ=Û_iyTU/ZjkK(4/^N_.~7r\QYٜ=v\恨/e1ϳ]Z EMp,׆!eC & }䬹 JwZIBkjAq=6_Mn qݫ4NA$ɪBV3oÇ,8ӯYD+zn93Hd^kqiBgOUBAwkV>|XWn,8J̔()ͻoj^B/ٗ$%K Lt "lkl/,=BC2Y2T,NZ܇`gߏ%(5^}cr1`ݕǭ=}#38·ZZ㻐aTO$GuªM,jcJTh&Ě,nrB;jȪݻPKW8+g 36WE|x$jʨϬWLl_U z&ih";QCI^wV8imgMuNP52|W8W僺Io3oD92%4G*PAW|\U0'3^9oyVnP#:8CQ]A ?)/fo@%芴,y?zC˭UPc\>(¨ WſK,_jނ2?ͧ/,Yn89E~/v K-B7܌&R뾖B#MbCs}DIyхZ endstream endobj 43 0 obj << /Length1 823 /Length2 1274 /Length3 0 /Length 1835 /Filter /FlateDecode >> stream xڍR{8OTRI/k1->2%䲚/}\4( J8hXvt-ڳ#Z4K2Zk;/Ξ}y|{17 P8 E`1gu|S űben%bb ! əu&,hJp(8O 8[ @kٯ\yD[,B[hiejELū!N0 >Gqhާ53=UCl G\'!/$9A p|Ο9`"Vg8~ ر0(H8֪U0ȓ 0 ~פ>0@0p PȔi{CHjI R{;)@"NPkum8, g1:A&Ue /a1!X*wk;F !)`ѳ]bH LB[C1C)["xySl'!l1_\+ xG &+ܞnuʃ*9ejiϫudM~r`6[3dM)\k_V٣艱-<i$kJ5,M{&)7ct1Q:oTf3zn_٨JJa6>{s!r=Krlc0,A/{cWI+v^;Z mHyJuU&o~DJum!Frl&j |YFrSą%|i"˘oGɪ@ٱC$.pwd,7'W/nέVW8+F{'f>CFhF + G_}On> stream x}wP\5.!Xd` A!8 w 9/v}ݽ{zO0ipI۸X\p.>n^1bɥ pt>{ydp Tmp ?OTWL@ N_fi  6yaLb|nuڀmx]l.>;{8՚(Sa@e3/nP$P {G5 CϜ-[Aݟ'[ڀ-.ݰ4BJ@=(/K-6<5\aCg@ݿe,s;h?`i qra`0w{q ;?SprRt~_*ߑ02yi Sxm4!pk{>kr'@.>^C` (O Oσ͘GX_ZN?AϷdu'PKwrִ@>E|V|8o |>?>_8ȸxq u Hkww0<ڿm[ȳ~`7kqZ9⦣)clbWO=0N1-Y򽣀 ݏU!&b^rO+k1" ($W8X@4NQixmy >Vٓt;"E110)MhDQ|ij9Mw@6OG)-i_,J"H|$i_st %oKy'^V "nC\XvγZdu}ngVON%^.N=oZIEkdʶ3A: be-??ؗ E5jh cYzv*$کZm@?Q+A: ]0P SUFY*yd5GK\w6z q@AH $5m7쨜TB;};6 9.εgH?2-kvRe|YuSm@.]f2 }?I@MK"lk<^OHOU|8%]K[R ޱ?-W4G~-w (c}i־")&5or@<#9,1pE/GJ |yzϏm~1[omzo$AE?\>^B ,p\I?˺Wuↈ[vxxss,Qck'5߯ڏ=ǡp-49K%2qLF/ZMS DcS{kIϦ /`5>P깬Tw+ FTHXì>'pUS՛F6i϶}J it n {I#_)[FSŶF&,WBXӷD7 諭F:5֝?pCùN>ͽO<5AER0& ``q_Ehkp^%/d=9m۪u9D%TFc US/pݔG4^z>qdחy@#򎁫寨芳ǶOj "3GWzh_R1܈9.Jdhzμo`p O3%whemd=&F 7/ObXVBQ7/b =?t`EK$aS`~?i y8R<+C8SV.n&sU[0ϵo;+uVQߪMi$VG$JZq6Ikq+H7eƿeQcM("`] L #QuDBnC.@?^}B*|R^:}8Ȱ2Th^jTeGG;(whuƄBhlK޶pēhr.-'v%YjmsĴZ_/qV2vkRK=kހ6@8vaI|dX.b\A#)fYIG) MbH' uS\/!N$ z׏z4O(aE tn(QЪ7GBlVqCٔ8oO$ p.ΧRdGx >@B`/Χ ?+ Whk1\؂\!28E1;zTA2 !\29 V۸g<ɤ%0Mnj5 }x =^C9?9ne#JW?OeoDrcJ [2̡ٺ~ !w%ڊt%2) XI}esu,c X Arrwx [#d[aX9ְ֨.NR"Uc6[N;5Gw!GeOTkA.-,VV|Ql6HnYݶL|l].c/;+ d Ӕ^\.J8<=żv?t1 0.`}+ӱ+ ʭ H E&N2PXG ~P,~_W"WAvBj"jI\;3)1Ґ\(s`;B5f's^a՞̑M<D+yL^Exl鯊lC4Wc&rVrWh )j;ʃGJ~%|SH}Hh}ZtO58z5@޿yi `jE߄U.qz r.AXɍTȮP+% wF8,mQCdFxw9Q$`cktksKԐnaq? ቃE.gtJI.\J4G*WӮ:Əld~ Y6%+s}V汒=Pi|s^>6ˊC9A_ 돝[f+c‽}`gKi혷_{]_Ŋ@j7#;ǞŻVj0%ыx79~ixX?%&޾+8zV@[$CLIqrՆ92\3nV\C]u_O,CEζN5@Hz7x3}yOܽ"rs%@cΛ0d1'cd}&̶'%Y\6&"z[i-kf+[o$S⁊AR kb*TBUS{?M7>i¤#Mk|CXٖtx3*P!g3d' >lEN0! jCگ)+}ո0Q V?> rWRwwlm\O9 IkNNLt l:~6ßc :moLo4iQ.E}ieP(NaC#Yi#F2b73+[V8L*I9)Piu];":ya{ E9&¬ϩs1ß~Hf -r.j$ghES1Gt(H.v7rS*Dې('N~ts7kB!n$wFmI?&qԉ m]\.ujBy(R.Ƚ\.}xk@ݩ :سkpn%ic6: hwjx 4M5oh[/>-V0Xi 7ovh^߱zd"%㽇s&2QYJ}"WsJȬa`I=ʍEi~"Dw@uعCj H֚)k4 ^)t/N݇I"0HU1\KtAbƹ߿ աsls }SN^y){Bh\0r*mgBHE%?,%j/`JK6Ap?o.Gg~)V3aDc[ _.ɽ]a ns=P3b4n+>3" aƧ wbE Յ2‡hFg$B pfv]M .] C۟㕕>/GW|m͖؊lb{tcoAl:BV5ZսXDH+MjkЌGªUnNUa^z B;B*N*1{?(cC|o&Fw=Iv;Qؚm79+|w R+:x1|]KSAȚK풩m2mPİ"2Lm9}ϐ\ʄ`3M#f:IZn헽tAӛ8 I[[[l{EKHDeJ.l|Mδ"vdg&ܯKv"K_V:@PcU_}z":F/uMx-t;9DUVl<,Wj2x>xG\Csc)-1p~Q{U0cZz5;2:(9aǸDKh~N. htwGĩA 7P!5ބv I} x DkzDA vgb^&d .E{"HG4Qkvs :_o.$}U nN?eT;jڑ,9w. L{S8wu3; ӭk% Egńֵi}-hD/kµ D1ӴwT/+"+uDb2Yl$x_rT&bkrOFUR0V{D>"ICFP97gVuӫUc=픿Nݖ.R[*h) EPG8/~B/{c82*##̸)zބDbtؘĘ8zG7K M5љO'b7nQ8Q9| æ$Hٛ$a2`š;XؙPz1=J8ǁ|W#oz-7Cmξ- H۶v])A;Z JB#+@AI}bг "U7;MZBoA Liߪߡu:OETdLg'4YCDn < dp$4&g 4J THgS4`Gb5`/ll ׻Z4%LoZ9; rG.&kV)A2?/&?dQnԽ ؗ>{@[$?s~$- 9Sl=wjйev2kvHgFkfdS(E .x}ZgZÜ?)T;GŒiJٽCDez"->ބqeߝ5#34R1TڀJN=j.LhA7<`(_m jXzSm=0<9vVڋju~qhRv^%J-zXu)>1h4r ܸJڶ̃=^dϰX1&%H(eWy%s^ݺ?1݄aSfIΒވf_vvA{Cz}js~B/Y6R"} V;'!NX{1^=7rZ !345;H.apTGPd5mײ9!xꀸ툣\3^`ɘM xe&uC)+|Uыl;S>n0^.aΡ%9ŗStzoxDGY ~|=}62rWR|$e_3unIGCj'x]Ш*1!%cCD2h]CXFw!YYŢ=k`=H]oas&hl&S_\1޾OS$.JHP t_!Wa&P$F!_/t8U].ԑ^,8m[f<$} Dy~i :IE$p;)6霄#UIb.[E#~W1!WCSLI(0 ܌|)YgH64n`$)C'4xJØ2|\c02Mԑ3͎9Q.Ť/_]SZ|m_?Q{m4 街maJ4y9F75š)rŊu9X[YlBU"f: dyɱ $ϗpy x_c^c,Ȗ_O _ŶMٿ!.5Vv!t}a˺˛E̷ 6B%~JcR$7CZ>9`$UseֈT߾, \rw *6^L;/9DqDh `Lq cP+Olyp*':2ВB¾-mr\S3 ,țr=}{b96kZ|:krܥ 0$4O䢥ᢩ6+G2+~Br 4G}}aqp\[X2阦gJx"Y-8odϦtiꃠe!5#_ AM-Y ” ﰅql77  |qۨ~*sT]Ehwmp\K$+TƲ Z,㧛HOf&tKR2oUv㓶c (܈@GzoMtN}YEh\(B*\2k@#4JɊV3bkd;z*Bk]LrX{jGLB\ ͳ^@ݾǼWS<&c!HX?X^͂(L '~{t;4nBVǵq4~ì%RګxKC+F/?Y䡎G.XMȶE(^7W]X=͖GW`U( .gsU1H1q )s[ 7{eS?W{4K߳ &qF֚oz/IS~w5[w.v#ޜIrGah7k仲m2lW9R(]amFYD[q$ZXˊF {8tBIo :s)2>>>24`UmkiЀ:ٱӑ Qe:f5$FEcǝ ^ D70k/Lk-ڨA\4'Lx,/7{vߟWV$6<eH~mHlЩ΃!{M]zA+RzWhe"{JyeCg,zl$oP_$T:`McQ S :)[PzYO}Fex5^uFN. 1تVǞ>h(p Zbhi܎">ɽ\P8ңO_V endstream endobj 47 0 obj << /Length1 1007 /Length2 1152 /Length3 0 /Length 1852 /Filter /FlateDecode >> stream x}SiXSgV *P? >,/B7@2uas,U>,E쎲s uZyɟ߹>p`љv E( Q`2)ɢ:K8%#llX6ek;%se%,&˒fXy>"!!՛J;c(@>ፓ`⌋TJ)5\PX$w"t!t("1bHD΁T JRHJԦ$E`8T's?IbW$P()C(T8o4USfQ|Bn$rC!$)c0Hΐ(j韚& }7q#Paԟ2~P |[GL vDn">( |:(8Š.F箔*a2?p j>1S _g?o>W̽ p ?"E12 J󏞊GťN 8̹ÿ! ,XMigVƖ#&OB#هRB(<ڣ8>1xV&YTmu_g3{"nz7yO.XlW3*:5#Z]EwMꟲ,Ru,&)N^֞ҟΥ}o*-&Nn;u-ol>lX2Ln~tg޸hb~C x,8]rPL<[]fu49dޯWj|#%mNޗڲB$evu7yt%k:Zʱ+WѠ\~W^w42. L֔1U٭_ YvWSQXbGUW) ş>'kiIW~Ŧ_YO꬯Y jAS]FFR^l`1m?WNz2B Q7takIӣ&w}]`]j:Ubz Α9q6P|xn$ yird$~X2{eg}p>:-ҽdEVOR7"sCޞ=yʕoKZ4𔜳}t#+S&֠K_-?zCyjZ}r-|QH?Ck %FתM9m[ 'S]绳n8U/⡪iAaSCiᢁ~_n4r{hԨr'ALg51tg.}{|wrA#mzkohVŨߜ gJ}e"STM}[&I.!o@Ya%+tZPZv .m~@e^dVK*ݮڱDzs>GC\UxymycYu[Hco_=+Na//k#` 3irpoOh$?qWj<ݮ2ic_A9=((|woIxm_{m*ױeJs_+eU' ZEFk8* 2=Lden$M_owNR!vg[}>$i{7x,0йD+ x7V <$aarMfSkFi8Z /t[us75j_M Q} endstream endobj 49 0 obj << /Length1 725 /Length2 31586 /Length3 0 /Length 32154 /Filter /FlateDecode >> stream xlxceݲmVkm۶e]mVwm۶.}q#^?9G9rXULPPScff01‘:]Ō]<M@`f011ÑD,,]TfVvV [w+SK?E@ 0D$T I=fbke 2ڻfVo@g;;Մ%⢌jc{3?.<?D&O?33`cofnM#}<a*Tvn@g/=AK5/C3-?'L]݀5yyʁxϫ9zi1Ki;-no`feoPuOcgV2W' ƮV]&ӿF%"Cg`03X|\S7ggM=L@'nm7:-Ox vvHvteFj ^ `&ЄrG8p<1CZJZeW\ap cgqy皹D3ɖw^'TΏ*cTe;au^Z-K O[2kZtm"^pCchYTxSxe-4)#_Gl+b۽3np3Hu*cCxP懲qx*Oqs;@P@:gCO=*~뉟7pwoZSS)*uR[f^.Cgn'o]vUiCg{clUx6p:WTYѻ J놙G=ĆY~ i_2I DAL񖂉H 7iBVTJQQ+֬avAs5&r _UT EDʴHϳ{FFEy_A`2m~>fIlBwʀ&)Ɒ;w㻯IaXA e3&뜐;ScJԪb0Yn3}L z ޼v14,Vh7{HK^a W3I$i@nLVwOJtNqYaOڜ0^M)8G#]ՈXh䭆lyj΅{N5vB;)2m8mڽ [G$;!+Nq5qg12k3)Nc` N gոw@n^]X~k[Bi>Yr3j{($}LWelLh}E.OٛY^/yWǞSAc 4P rcf$k<ᜤntYKzWQ蒭_>yr6uڒv1 U2@.˧0w;UvءՄQ"Y=l:km}NO"Rjڕ\dۋvAti6 'g::ZJUTD`&r<o4XyR,vP(i頲]b5P~رUX8'-ov1^q+nQUjQ=f<IܿNL;)7XUck^+- I̕bk߼n%Itrn퇈"hV^ 8jgv2E̐?U0L-k\xGVf9Qmf_>˒l)`'@9tq2s7|`-}@5Q><|p*^oJWIa؂25KRRAbԱ|p3Ju+JS9i2\w m?>ƨ1jݶ\N~vE6qRaD(m|=%-""Kҳϰr\~f((fⵧ .Km]xE3)wW0=tpC/Ka }**uO8":ڔ@qpЩ [A%!T.|-U\w3dt#>АlJٱG K 􇠬K} Ebk*xVy dj I݈?d"6Xt(I~<%$R j:B{uIbR~Q #o +sk?5#-_EҮE@|ԈSRj-ϗ Z0y^:+7MSR`rمHi]s9ˌ]4QEfm7h^ 1"2#z 6{'1m20uJucS W߆ |&s1Lc.nCx^MH'~Ka4:i#.!e=@k8xbӖ  cER1!ofm'ӟM垹M_zYlDYHs0o$(7ѷ_>G>dž:**jtVΪ WFvL}nU$Fk f<.N ~ ou}ŏtA\4jHm]߇f+DAz%;bu;N452 Q}D\ U7Q߀ޭ0{,*ǘn ^r ,S}` _"#+KdD-Xř:JF8JP_8ҿ>o&;b S`>koU0v*ěB+,EJI@fqKR`uoۖژ!c΍>Zкs+k՚gy -֨q4A}{P~NUm/u!qCE,sPŴޒص(蒙M1_)=|PFas!Fx,k tC)':֑\&)|)}p[I9W96w j;Dui^\1r]Uj=\i|tW!R9u+wmeǓySFn`Lìn^˧}z#[v3gAZPԯ}áFFCsT7׀[qmZ_姸c9 C{0nt߁ɘZةbf"g6Qmꈀ8jY!DPDH'.,-g.2g2  G/݂uByl=^PBUt)b'ϾKiwK}wO<(7$ftяљ0!  ;8,M+rgƷ#e06?j ,㲛"9"g}ҩ;()f&Jp4_B6 ?u}͓A UiuWX^h;g +1=Km,}-m}Cur&݄Q{yl8с&a" :SMYjp.F =xb C}ǫ"16 x:OBAgޠ'9b(pB9b$u2 ]kB,F&1읬u /-gC!K$wZtB217ٱYP|)YJj'{JQYwpO^m1$^%X l9cno!ʙ " D< ׮npXܰLiIcqV` ʊ-#b"g;36(_{nb\Nӏ3&| ^- 1шYu& ܃B?^.DHvM;4+`<0uiFu.W~Zd܄f*d)~}  b *'p sHGf:Pgi^+Ȇpu%v7~jX `LAЂn:?e[XtdtY9 ' \uh&zcx\!Y0;Gp۠:V憀]:M>_o!jVGCd.+cK r%b'5RqD0#M=2z;¤f8ywh:Hph% hGF^M>ўt .Rg(n e -:P}6Gv!W$Ҫ!- 97MM;J G,Ͳ߲iʬg2z_t2eSk_܈̠9z򷾕P_ JDO|tŁV?8+'X_=--k u}AԐN^鲲dfצBRoT76)s s7># B3jdqTuҎ7}G5Q4 QƀBP7z7k;k/0U$|Uς}uk e4쥒=S6^p &P6 !6w>#ŗJQve MkӺpTJיVi-HIw>8o\(YOm~3`k\.uO^SEU ˯BVi'm8\_Uǿ x 5<"C/=S%I 9vJ/}Rr33( E7z_ rgdtg7f~t/XQ >T}Wtlbzu=6Uq`9xN_k½RL7h&F?a'-ș HTϠݜ;gLIu\'K|1 ~1eo:#K sJ؁a`tD`Q #M 'O:x5o;1 oap3d}7d GaHٖ}h9<&]܊F43rËэb?"!5ANc/RW06p/F.o֕ΊգUt^ש{/,旝SxxM}FܱGƲ22a?Vޟz.Ү q*P^/X۷,C.!Mg <:dۗ=4Qe-WegJ(OHukl{\ďI Ue0i]@qA+y* 5Mx1 ۚg i̭#9AnRfГ!^M&ev Jl0X;0+1{ W-!ýI ~yƧÏ0kM?fѭZ;&168[%B n>K)7'M洈*'g`mZ񫟽>eaw)JFu~@!Jѹ0IT'E^LP M!CAm9|S"+4F3X"E݊^$ X"_$C#|wS-*^¹oW[qBkuPJ`"hRewsoe>Czu2lxsq r Y Z+2tZSsx{Rw*=)<*=y,qk'Oc?﯑:Nmy8bX+b3cv|%P"iH.j"n2Ci{,[tdY⚜'WdJ;bP[Gn5Z0UмI?Qi?()A.w`p'y%syIiMkc\6j0ga:BMh7/bEpvɇ/A!o&nxǸt@2z 惯B']DIK&Rŕjݐ+6G OU*RΖCld[ . "9p鵱OqԂ\pYTB!-}qqpl<ƏM.se{v^ma[qo *mH%{L<>Ns̋X}TANN`W" du58c1K?| xL]%O`Hn̶Ԡ8e2i,'&9{^oIrUbY9z dWzM md"D?:X_jp%9O5A}.e.{_TÕ[7nH#̊ߑqbu3ՎΠ5wE;|K,t;w0/πzj^$P=:.A/p!j6.qGNos n9 fVcujo>d.Q3y>WnkZd|vCf-Ʉ׬mrW[Cc-c2 Jsv`y# .JgDwzgGK3y*4#FQ.b4`Un 7@F> f"ui[LÍw܅sp<4փ6y&Bq"8jAI7"'{D**I8Js,Wo.|ׄ??7_$v3dV!P-ƳqIg8q }`;8b]Soɟ˖?cQێ0$6ZD+Drj㕻¥و#**̎ڡ♵.sRٽ @a pB,/VMQyo75k5 \8OiOZc Y:eiB .ZY>>_HB={ȁA /3P"-&,CEͯ6Y99KG$ ՚!o8,2B>/BtE1.ID3>J\ {aa 8׍l>rM; c0#zo*glwyADJAns[DcGj`J9cv ,^6PZvmٍ-,ZI,7a>>HylԤTcqZ>C=X&b~,VyjJLsTcs@'q$y.uz\.2y^[( A|GHBW[Թ-v֐"#Px s5k&fx)+%5 #Ǡ rsGTx6uV(5%HO!WWWó\ιolLH%th-Ȉol~i'K7!JYo/_{TBi2\{.0N52lys;By-#74a igo[@a6x#JeخS7m!#dVTSt/Jw5OmKIJ{ `"09T,9sK}wY^ߪ6Y>ӳbN|2lOB9WST'd?% \|C+(Wbj2C{EV:: iWqbv7Vn,DدxF.:&^J7 B5d@V9^A Ƥo5]((VAK$DDrEH'qNy뷚`;R}C .Jg?Y"=O*R&n+=5Ű?Kv3ě ûkVҺnt[Y[wZ՟om0&Eʑzm7CƎ}b_Yp4ܝE1vBH]WHNFn5ia-oP| Iαz4ĸQs.m*_rck]k@f-KnAz[41V_av^|=ɶ=N 15Z8Wm.u'g ߡD!!NYɞ./ۯ ek&YV|M#*`:hCRn#r^&[Zmﯸ+3cku{F.3`#F؂ZN,"Z%uuzRllT&͚Lmssvp0(8ɳ _T3˾7kg!$)qvGb49! \ $&;wͱ>B[: 7OqWS4{4ʠ1eW<վӳ#ri`}ϜŪKuj||Q#exSfLz_gC$ 8..iVy"ex\S pYaa3cr+h!dr<}3ϭs, :sg኷Ю Ӳ?>!-9Ʈ;L8ESաri^- :6bmU^N{nGy g|X$ZkОXH˫d#D5?XFb("7xZjGɥ8U~RԓJE{hX2@`Up+0gfv3:c8ߗ1OJ4A;ouK ru=52X/ɬ1<5 K &R{0`HKߝk%s-S)u!88 gciO::>sos/3B{dVg/Fwo۵r\ ~'{ܧY Я2,V-ZX^*C?&.JG0A~݇.تWZ 9= jJ!c,1x_NMA'fm8\t7j(Z睢;! rolq*9"$:(}鈒k<_m\ܶ=3^`"DIm(3Rɨr0c9zz[(0+M62nMA^_t֯^潵{g2kDP=8q7CggBHBf$!y\&9+zO-Wb h_]e&k[hfgz&zkN+%\t/|70;]lqRZ #T$5J7VW P`|ĪD?!˶#UaVL@v$i5X$Uf2si%T~cjU#'L[ <ɩ-T/GZMnj^$dg7~`J hfUh٨i64^֟RjQE7H]xAϧ뤓z4"^+:]2X*iɋ{&]Οt胀P/*=*itCPՉYO<WpnB!ѷ i糐K?GtZ)7й%c^x{ڦb)P]^w}IsD:a5NV_DɐFJ%).ݼQ` A˿lMj=G]jj;UK^\f`3 ]̛ H'wJ[9B۫C ]:Wn>Wqi sbhƮb 5ΤP)K8r=ImpI/`O,ex W$\+vSHdbq@7lig FVsNoNg[?#\*Zan@]),i53E˗"b* `?y 7~ e䞇8_S~#zֈM9V4k. b9՛]j!{r@iE:U .9c7s}8>V?z筙+ .#N[?e?P,55ot@ ,xBSҮY'/uV֒bVOWzn%n~%Z.~62=g1@V@dx K L/S%挶թA^ cZ}^lXLP߲jzi6^hNu*XIEﮋR SVpM9@ .,!6Q}}*+o"1Ǚ} [k2F?p&(/o9A\K̻6ƇAY&}gj WF;[&\zhBԀRV*Α  ]IGPf2~QM=,0&m!jq_Wq DNA،'3\B O?:r}#1YJJ-+]i+u[TzL)I!,!]8 4X.r7 EJc1%רԗ uM-qw84KnD' }w<D i7p;z4:,]BY]Q˜WЄ'_O rk䝋` eO~1Aac۷|BBu-[YXR ~ʻ<3)=?#x7!8wӒg-v}z1.iU"'O1Oe?p=7D8 :iIIc'dʞyL&@xdWB[HG%;X YR;}|elktҘrU-ť=ϫ>ꗷׄ̕\)q%0-1($fbR76E+q/\mJ|ߣI&~ӪC=&"Ya6+H/S2ZK:eS]݃J՚ebi^2hs੪Ynv-.EgF5:!?Yw 8i&a_ɭȸ>̪g_V@~%~WpIZwoV^Y[nb`8DWK/2τW1U㬶qMYO9ݙB`xl1-$Wchw4MVi"WZjdPg[j-U0sވP{0B'TrK"8!:㘙"s=;6k!$[\:q˴$~5j潘Oל 1DH2TAa%5Re1jE)S(6AJ %I}V80E,}aK#£ģ MAf [M˙9^%eFRAbuSG_i]!FW/r-cwú4ќ][3 g_X/V_IGTt~/f^YĦuGjs-k<̩kd*˘g~8KDG~1Ah9I˕/w~w[@3mWҮcQE{r7mqPw+>G/ACOzװ! 6 l6_}6>h'2?5=P0jji#bY1N)#Kt)Lz#W'.9#΃ʌŞ_+&"mwPuG,p`6 b8j;"DrXhFj?Fm<vvTE}p!Iӫ Tg S8wXi+JZ0,~{iW{c !c)]×Qri"4c r㜞:gh'4d{*0I VvET`:}_ʷz,"dfx$^o= ߉h7a+*8rYyfϠdm<}{Kآ) !=蠕=.pvGL==z"8yFY{ o: 5C\1œvT8KF 6^G4aB"Q"X_x5c]:.h`mS߰3Cl_ѶY9+X}ޟ\mܟx~DRVHs`~ݱVPu#䎒#ݗz f:ʩi?L Q֪k{]g D PA#&ܤ̒l)UhQ: b4`37)XXl5>g{c}jʶ"8Վ/9RKN@uV@zTZʣjoצkv$!sR؀Tqni.Ɩ&kS.xI˵9p|Nد=X^,H9njJsI3pz}ls]10]GR>NZ<DJϚFnP1S—jLe> sUL\6;pyju+mV#U \%H9؍Aq y˭^Thvsҏ/0X,`V'ǻ_;a zkI7%HժyqilQ^aF,MmXc+"t?[NM )Aϛkd4@@.DL!⪌.wMQp7^Ը bq ɘ<Aw%sڟg ̕~6',,):oOުh}uWӻe-{~T_k{h*T!׃ߊ⛤#ָ>66}9SRgNڊ%1+PuP K~-{ӊqZ1@yI6H[MCC0`HOOc>r)B8y B\?D< /vEx>`c?y`#]?XЕW=%«9ҾE1V/2ZAr/` eoe~iu2C~?ҭÉWM{负Ah0`Ch$6Vs4"/Vt ]hXcBH? 7L]!(Mi&FDFуjCa_M|7PZ>بS 6d=/fb]џ d<h!ls q`5|PQP%lj/)}.A€gzŠ@ Qf+r|f(tJ|&N".9 9XFÔ`WDk瀂b L%.OK?v"kCifbڇFf}xT( Jp8A"jWQj&"z{.J[3 ̫]?k$;sjqz"Sʮ x69 4k3~_kɥ36}fϜ~%y;Oh.^S:6~$ F.fj* +Գbv0˸d '2:Eq̱ީȺk');J]8o%k(ԾZ dnN`ͦoFVaBVBu_iY:&Utn^z+ŏ1E\ؾ@ kvWK| _0ƶÀuF-3-$~|pNOɇE'{SKubm&,+ۼ<+$#O≰dܣÊ 1ґ(f&W7"'?9E'~jXl)ҵ6P~. DdV 32|ۑ/Md/JIZ['?KqFܥ |.zyO$ $QɃO5IMC_>1cPWEyC18j45N5krrjO?K%]'0?|wQ`23svjDpDQɃXQ5-/UxbT͒^t/1Wr\dBAn;UyȇiZ6*k03A*Ӊ‡NLk}$䘦)y2z)K X&!GG— Ov[`ɦ3MVMwsysy|E45o!2z*T2ކ'o2BueUVz;4zzۻ]qd˦#ˀA?>*0J֌1yyVja~EBK 6txDDsARyjhNs3K$_O͐cLOdUTOcH1'Q ,? E櫓rᨀv+! l|ZG-)& O)쵮%}el5HDfk.ܑ?.!(s>ݕ@o:~jTu,4-\ۢօ#=&:cg(Ri5unq7OfTt3L\́zCEk"4p`1 ]:(1 ,{U 5 (K~2G6SL g WiW3tL·kp"\06كH췁3|0[Bi4gphsO,vJL>,MV`dRmIؚnov1x>M\ k뷣:拢o3Tԩ_/[TN݄G$$LgsnjMjuo R oGّ$ޥI@$!_c/,֕2RJ[3 p K#5.. uc*{ϔꩥ\ H;с)'EʌzFS7\VR޼|&j#JAä8gR|pLt%5 MgvDӝ0 \Br Q2'|ȸaxjU#8JE 2__o@ک8)iD^sfAQ4X]NO:E@I. k0z??#}XCC'MnCU7{mV eQa[͓K"L 0ˁRFK^[|˜KeqKX*$KI2S$bV-Ǭq5\;4՘ \;{s]XwTezwءN{ܟS4u1|N8Hlbө_hؗW50( X ŹUG{VLh.G8HGGOCۨAiȝ-V{aqaW^NXg[$z rd) lw~XJR!@ ayb5z}O %%dO8OHptC3tL5 *q"ݝk Mǚm%t$~'`v'\Lvj`QxGUuuCǬ=0w) "b+ql,0hw5adc׎s O>Pt83W`^efR|FŐN9\擣{U/E%r芇]`{e1OJ [:]ZBLHUhcT  gQ4li8z"s˩K-v6PSyhȻ;dLk-GXݶ@=H/L;I_C۱qN<5}vyujfdy`6_Rs0T>J&nj0u/tgdq.0&{\ XSh,M9L _^u}w)ԙ+ڳυγ>GDu!E~ve9@[=Q+>%j.6Ţ_>]Tbt%<=1UWg}p0L@<[l޶\tap#d+r9ǟ@Wc|fT@.~nvwV{>R*U4E>$A?1I0Z22f tH4k~I>J1u9O;0P= BQW!u*V(1St'<8 6Jz~=:6rbl7A]Sq1pM:f%v{k&I.-ľ/mamif%6.}9*&au,N0ui*\@68?a=,Z -ţPf[א; RtBy:LҼѳk.v\0iѝV̼_駛Pl{=jM!&LseY^GvE*s =]5q0< h` 7G]y":y(Į_ńgՋ[q\اr' a, &v)у% (l3󕙞M 6cDD L&J7]b9,I5lSDX2tn :DʼnJC6tYt@a7 l.juݲ[:yhVbt',gVi/3 &9r>tkH gk[O@o&{@iJ5B7X(E9e܏IF\\<9mfZ*Ysз^oئPwFF9a%A=7i#"}Zw1 "X: ўU=#V-oUW?[i9FѼ|^4 yGr-n3&UQE El x)ܯ40H- (,oVB rKkw ;聐7ҖLA Zѥ$)<_&C[Wq Еے41cfdSPH4: 0P\սc2EEu\ksS+MװO y, vϙF1 8Pt!3{% O**pxLt$̒R^19{ %pQo6.icDoZx8W:3(Bk:n' jwA&L RSu3*Bs=#~*P׈7K-vcH ʅ#Ќ.9,$Lh/|Fba"^jM&=maDʍٚj̋t?;xmW=(u7kEZ,1r =7)F<[#Sv7S3|"g &RKw\o;"(F퐎<ƚߩ8V^M/'ՕvnNh TD]ݹM t\]?4T 45|5ҡj(AV٨_!˾ n?jNufgG޾vŗ9$2Y U/wh0:M M:K[aG`]Y)nwG{5D9:8g(‚~ B+RqZ{n9_Rc_7G|UP u˃Sςq>.&|uxee2ԑB~g)ZZcUXo"N: OG57Ť?L0JULFg7m~KV"J~ lKlw NG bcC%sf_1᮹C{F~h!8E6pnRT })Է 00_v!i0q#7__YbTɄ)R+@U$?AyXT sf87* mZc[ G>5>LPK:\lhߕi'a4_`KH8 јZQ(hQ&7  iS ‘L,t ?$nNq ^x+Je)1ŀ Gg 2}D&4{]EAc[&VM4^o`S.-odhP!~%'t+(IN TVHq^"DmWRD݌BAas[RlRq)VsNGCP2E̸[Xs;¬ 56UE~If~~Cß}47l]b/pҜl2ڰvثn)%~ CKGkb|^$|jf4 ^j" 4x~WG׽zic |z-dNW̓ljoMFOQʱXGt78>Ѿf"Dۃɰ-JrSmʥl]0l@d ƥ<=632qe KSv"CpiW' ;"b-#^f|Xj-sCr{Zl"F~y(A嶎zl4g\% #9ː(J經읭Ɇٯ涍LQ UR'(}'zc.sW^q/ɣ@YdDCxOz@1G | cB*G{922Hs@F"nAyZ&-h|׼[Qƭǹ޻X~Jܴ'7^;9/cM?g]?bT[ǎ̭bM 8QԾ= M*}kY(8R Om%Aκ "s?IFk{Br|fe"i7l17nz7\~Y D6 z%-a{(%Xe:pe|+ňK#v/ c§qFW9R{-98pK[L= x:Щh޹R~):`NuìJ$W )VLn@AŚ#߹[F`\U+;d.sR*Bi,j=hl'G+H>zBx|ua="PR9VOQ1Щ9(Pܣf7}iPZ|H=rRbB ʒMnHZ"h쒾 \Wu0iS{@N Hâ@^ @ӆo$.tM\R. _"/Ԑ̄T˺Ռ& SR~]S4υ5ܑqM~r9ؽ,܌k34J#@V4 61یU:"-2צա]*d+`ól/+`BQ7t52S#OYB$J1lV@zU%'~x-7/.Ә'Wrc_#W-}X =r b.,VE>yX +ܪ f*h᝴t1t68Ic Ά?&=Uj}(9mCtu꜋$*~7 ƕmE}'x %S:^ ̦+1zf 1L7$'v`= 2-"32kb064-Fhj#Kkwwd+$@I=뺍|v DSF"b?yY|s=h^ҁk!JTੲ:|A984u qf8XiDk OLgv\^)r=2x/h(ЁA-ev6s٣ePrmEQ+F]mkD*G hMJ T37ק%Q>W6GPBPJlNdާ_p;VpXK1G<ݐh4>Wz1bȵJ]/o8Fهo/ǣAR<=X&Wf (A3`H|lanzR\Ԅ!Ӵ[OXx_.{DGEhƒdt25ɢd8}Z^~6M7]mGeI%^m+RzA &̨P}+l6Iefo9&?34. X*jv1_+}1Bkg&8cV5)ԯ;M;};<9حmV4ȷ+3=|ŒlX`#QtdR&ss_^jwBr-A{0[9N(,ls$ G`4Z1PX y EXxz3/\6﷒/sWG!ȋT$~ƕv<9;kT sA*elq[HOE놪hVIȋ*0+#\RB;(KCfX"27>Їm"#ce2,&.@K7rgT#c-RH spʞ!>XWSVAFC9דgn&%[bPj(x򹃅ϫ[tdYxS<~-k7uM#c(l~oq $B,z9 xJz:4 ƻ9+ ݮm(j'iCN3Ю#{~c53\D+M2rP?1,n4Mi8zhW7Uץu:KXF9%odGK`!KE馳@D.Cr, ʃ&CS{~b[Vo5qD67OŅa4WHҺXkVXOW ‚^,,~~j 7 ܄ `ٛ[W0!htDޜr&@Eި ޙ&Hs | V\'@4-b({wō9gӧO˃?m>NsIRRKdVReدmJQaք)sϜ mPkTc|GѼ-SC*+=uh^* df@={PJOHI3Lڵ WՒ6SI7X4dN >C7 \gI?;{9wr8 zSIԭBAO8?PB sը&K{\޴pDU6m.fBz]YxI Ѐ~Tsy uNO⬿rit9ޒS_gnDiXԤ'Ш𺲶>0kL-ȡ ip g2x]IL,d 7m:``s]c'rYX3;EeYǸfv1}d]驯[q1&Bd!NXa@5$fb[vSH`:j4qK*o PU3:Gt7i˿̻F6WkUrBT{܅6 %216װu fS-gLŌRt&*~F|[4NU AT&VcE},U2P-ʦ}{GfqRmYrM#gJ&Ue1Nl\w6Q @ld{ǘgJKEFA5ّآE` 7|=FRL6 .4.#OZ³gkbUr&EnE2q\}!b޼ #vFP/è"ʟڴpr4UV@כ{L03>ma P ꃪp\u ̦]~}!-=/ Hi oW^m'C8e.6'>(XY;X~#!%Ӆœj )xe^5nPg4e4wV$,[ftj VX7Bx0Gὡ_- ֜ + +$Bm`8~ rB UP!^(qImK'^Yʿiќ '; t)^no Zg0s} yc?B)uvdٌo)TY1s3Iз׹ACފ]m UTZw&Ҙ7?t@9D{|(yXm:`,OЖ$R}%+կO7aHuf5ydT5 X>|,#u*Z9ɪ ITX؉J$bZ!x "ڗ7*0vR pէ&Oሢu;%M {1"ux0^QE u'9q:\, ƧݡHPBaT/}zo4[ [}`QKBU0Hc\0%+gW u;bo04/4!lʱʨv拓-hl,j+:|%s] 3X|M.e١L7CC4 LO{l -RCվ@=ЬgiKe3C+H; && I/-hˊ+PjDvNLiY i[M!B6RSM MĝF@Vi#T1Ui X뼞"]?rA# DӲ9ص(Qc&R#6m/CK`uꁞ8tZb.fq}D: .uAn-9,^kׯ`ߜp󣪍c*]*@6m'-s|}F2/^H$( >#`nUoՄ7|Q>OcfglGYWNF}F-&T6^?r(lx,&'&Fh-}[mJ|O^T[>LLP@Cc/]p>Mt%xjbSᣘtwэfk} Zga<3o ԥ 2[qp"aJ&cS,."3iv;' ,Ku{_ @SA 8уa7 Ƀ)dd7/,:_>6".xEK g2;2YZbq]Ek!_ZWͯ#\]/ 0Ђ&ce( '*l6]$b_#+JC6 m }\m e{v;12D#l,!1 XQӁ&7E1gPc5vژ*eyY$F+jhٻZ/p^q9QfIY}1"N{nV5$>q &3xoTу|E`@Bdt3;S endstream endobj 51 0 obj << /Length1 725 /Length2 20096 /Length3 0 /Length 20653 /Filter /FlateDecode >> stream xlchM,l۶mk/۶m۶m˶mqorDeeYUbv&t \JbʌL  tPŽ&v"&\j&J&L@H =-̝ (($P60p$Ps02'quupurstHĄ܄ڄ@XN^CBY?&&.FF&N&vql-ɉl]M!fhgC #,(&'L *L,L``kL -O?h#g͎-k ߬,:(FFc #gC3 [(&akjGSr?Rv51!wq6q$36q%nD 5B1m?! '1 wcy vvt1OX?k#cblbr4gUl=g襕$ 535#PrGOG ;-o`/ve - " k--3#3 #Eߢ3n&w#;#`˴ _ѢJP}F[-D!scke|7C޽]"8ɩhpJ3pUL#Yۈ{猍@y)܋ZI2^?;kO(uȑ25`LkC o ׁ`nI1 +4 :OQp]@ih*Z񪒴N;GծT]ᇡ*DuIn4ҫ lֲvMSǵ$;Y#۩tHMIA9ز? }P"kll̄g;rPBP[i1kB~8z}-8DhN;gX NLH'x!~i nMy|%dt QuBky/c+PSjZrxLVr&3vYEo*-L rf7*R'56}(V'f;؁~L싃TD]p/kP anYOMZKG t<\3{G.ednP˨'jBuFam^3BWq!^MFSq 1RnJr_b[q+ m[&[[ay>!j7U0E.5$#Wo/iǔLkTĿD% +xk,Xjp݊yŗ|0."b"kr";jljAz!D}nn!v߾lUܫbTg#ԫkY+{XdO{̗Sg& \ʨ7E+-P1Ʊa>|۷V+xplO]uAGپj \nUp*ƙjK>íPX),LbeZLyӄj <rXTO4-&:6E&BpdS"0 JkSĉ+:t|Nէ+6M~N\g8l= Ƀ!_B\^ƪH)VhF3ณp Gj| 6z|V)LŞ2\f[q/49=v5aSc[IB`nC(gOœH3+CBʲkS}B xC4ZFL5Kza5G'iOΆ'V)~Un}&qVkp,M5Q@%FRS4m :~d~4Rgu)~;lJ+:4q. >d,,>uj)W{!k}w1씎4_*/ECՓȌ,TL/v5hmFt6Hn!T QM>M`H-RnXvp>Fi-TU4zpDp[ɦ:]c锠gcS=}d."O5D "MQ$ AuO1dqDĎw+OI:Oet!πO9r͞NVEPQ|#z{H &X k]IXDyjJ72a)2Gb V(wF#JqplڐMwsӁ:'o^k Wb /%{yzRo% suXxa5K*8(y<ªh# sfg0 1 r}c/T%aOeGsh@M}--sq9<"G{pt${RC`ٳVl\> IMtZ^th~ÃB\}"Bs!цrnGTenFQ1a͜,tMIJx+0دz#8i]EFt!=uc[xf)_QCP4nA~1#ϳ4t#.xc @I3؄oƏJH3Gt9A)tTLZ$jKҘtlOS'{ זSc;+"-jm^@1TmkI۶`pJrJu19#-~$+hǼmS}^7^N*G~ͧ06fӇL$5  R^RBh 4vk%?bA^w4p0(hRiqx8;!S9Sy!dd ]a/^/֕M#ÌCtsQ)0m>]yZPS*2Wk" Ц|Zfbh hh 3I x}I@ ^z$GLc5>[LUy ;4X%.J3\}5:-KG&ƽ1a V:I~Q撁\hҎU '>b{] YJ@J>0e[[؈Bh{rΝоcm`> 釐{ 4I2KVlY}!f)`zZ(%ZJV/fnCX #6mz6QϘ~>uzd1OGTM!`8{#TUsUIۭ0ph.W/32QD,5&2d`C` 4ln|ɣ.|ze}j -p]Dِ}*Z:o6wF27ZN"N6?Zpl-BwXÄ]wnV%[sC$|Hl[l1+U(bH )/plm2@FɮxM{A;( \C!~]q&`qյTWh?Gj^h׸;LҮkFuPPB {V\Zl!:&b*% TqK>79ovq 8=8qBs ڐ>YŸxg4C,G!O9qqnd{+j9/G'9]cҪESI}rl`U 1Dߐ9uA>@x3["$ tㄤ<}w?kL&v̥ 0}Dx޴kAU\^!;J]!(o?'pI}^߸`Vŏ ${f dnc1V%i;HRX_ N!h֘4 9WOD/n)?`F%1>{*dwLq˶6Їw0H fd ?-ƽrW!\.Uy*OEW|Fcvt\wɟ 2nZڇOB7>= ?Y i8a縵wz.jDx>Ď"=U D-l9V3D *)VI),Y'z@t4TJL[E$?(ֶqR_SdP Mͼ5Vˆ?«]{.r g8R욺.˨_\kD^Z∷ g sr3V~S,5 /C}/籼BFtvmK2LχdrU,mJFl0=]8$܋[1DFo$k(],3O9ؼuM506z31}pHvy0nn/4Y }ý@ΞxR:< N AY)oa?u4`ol IUVg4bUy7ds[ W)Y*Js[+C3Q|1bb%j_XT2V7ə{c m~xLp=G8O+6XEȷ?Lsl\=`EkOhz GƁ +Û]9<r`Fj8ꔐɧ bԪ lFաxӓTJl1*WnbP]AI#K W66\7ȅ?GnYGKH fId$@}}`jzŃu݊nmY}a2Cۆov_ڪiۊ]* 3̊ph9*/`D&A_?.Bv0`gFOPz^QKhN 厧je{Y:r-)r˰$KL̮0~Gu4Sڊ,-R2pزF.Œo5Eܺ^ezj)ry$]B .$lVjŊ󘷉l1gO uqVfkdpMtXe!`[bpZ"Kn 7!m8o[2|[T #e*v2 *V7IL`y,#$o[)*_T8؂+!;[!5n} ik;")s{6h"FxS̅R*FYiXۓ$g}xV'Rk% u )C6*y#6P'm?A0!3m|;}|Oyݴϼ7QL\Ԁܬd[xvB.r&ro,Y~k=~ nidtl@p]̕U"~,Irͽ)p{s_|;2c(z=  9Zb{r!q#[} Q7c[BQ׍d.9 ,Tm":sոdG8%+ՙ.7FÒ&C]<,lRFMrmцؚJ^DYFN D i8|XȧX/vo=>e b!~iٍ>^_k3,fJ[E_ ˴95iΡYOcRtb<FT@[ fdXۡ LL9grق?k%H(ix^b&O{S"]t94t`jÖbLI=V&㾓1T`h곒btK--pm-a-,&|p|&vՑ86(N<{}7J Ȭ88VpBݣ1'fp+ļiWmH 1x{>>cǜч#쥍߯!+]KK_h.R& 0F'x=;Fx&\l&Ϟ.V:tFQ=6H>0WB~P?[[t:Ym=LM*'T9e0ϻ ͟# )03yG,VI;#59\-vKk+س3޴>SPj,A{Bs30Nvz&t OF,Me̥X Pa(BbV~ZFĸvYc׋К>W巔po"Ŝ΅n{5UY=#pչ3\ɿ'N|ϗpich=o*dH?fr2VݏғR6zu| L P1,S)a)9 yM^`} l 1_Cla!`Tur r2;E}z@Q\SJngz[[Kf93 =lsQ!^J`6I\:qN4tk$ ]/7&ǃ< ȝ|nSi^يc0d;"52;O[(r7H1?4 {@.} ԰ܶGaGgN oT=6ДR鞽Xq4{* S(` " ;=a'bR]E)& Z[>z wb@Н$"|N)Hŵy2wjA"b2[v5[6}%Dy}@hz^Gc:(臯x#\2k=ǚX@EFih }sR䁵\+ybZFeA W] 'z{OG@B}8u~w1Vs2lu}gk&%=X8!WucSCyA.ѓ|7t>N%06> c#V [Bj]9{)P洩^xe]_.-Ѱ5KY}霒ZHh繏&NG-4_Хjӽr~Sb)/[?2=D#Q $Z&w^,'=UvPfq6ګEx"pm}0Qr̃? hqҧ\V >~??8̸Mc{XrrPC!Orŀq]$;NS /IŽXw?06Um*+>l ټJ9IqI'̭xbG'/4R n4MiKHz[%9\Z|SwjmŮX=C:;~ }Xj=?^>`8(N`T8t"t }CKi-7j\lF$#SQaYtl  [WbWmva-ҽUHM!Ounl{;z1h$^8~r <ջOd蝫pTBx! xt|`(jCg,$(Vq1'e5=zNAOpGN QMDQ ֕"8. [ K.SpS_1dsm*V83]Q1d3-'b ގ1'W~ݨ9 Ņ\ZLۭCssH!rY p zcmd0WsEMl˛ М!- H- *a 89V nײ{(WN&.6#(2Qn gfJq_ wNzx%]L㹯PL\|@= {w'vī?)rmh{mxϛnm,D˨_J-o0eY'ܟ.uE7#}o6ϾicRjac.]8 WyxZrEz0Vv{vc8X-AӄBM|[g&u5r+LwSj;uh2|@rSkZ7"MD_"jx!R&,Vp麥Oۘ7<co`˹2.DxR0ZU珧细;Z5v.~ҒyRJa#ִxaН=C|Ws)80WT}D8(CAaikC)g>]"w/[I LeQs|$Q tx:4K {< Z|wذz`Hxtm%3ȳ)NB83قˮg=%0Dj:wtplG`<^ [f#@t.a3 RTzM#c,lRfEK$4|]cFtjlzh)2)X2Q$ٱqJ3E, .f푙l;]aZ*g26/TKk"ǬrOD uu)xZl4_?}qb#o%T?i+C-Ǭ}2fO w' 57׿xA8J:HyPgpU7K{LUK[ZTx&Œʠ.Ԟ>>Z>l 0ӌDCTOg~1m`DZ9388,+\\2mq{-kέ4I%fiZ%;b:]zլ `0MZ's3$ӫZ|%%Ð̺~! _H=M.K |GlQ S};)c} 8l_C6ߍ.0t"h91m L9 2c5:'Q+4ƫʁ!+%l@/A2'@K(ZTow=BtYb*KF)BL${48gu# m`q [g3mq2qlmƉ~NЫ/`9:;')@w/Yz&Ĵ0 + IF$FU7v>@t/gT atFv-JO48HöPdX׻=4K}^8HwWE;YൊO#WǏLD.J[x]=ystZn:qPe\hu'lêlZ15*[(d l3x':>3/"rAU^Nҳ2C)_zdldu!ğ݂a˯%+ӽ*wަ,&Za=5S;I`ےdE`bfLWԬ8-2z"$k r5xk ]H١w+a⑼ҽu-p^~:U7Ϯ,<=mcҺEkuEd|Q}>k-D6Qء*CqUcJvUa83?tƿ/ˑR^9j^ ΐwj]kgZMJ}Ŕ2!(l e -Ӷ*6 ;mYe UOYu2m"h/34&6+h{9jlܸ/Źl Vcml#tݿ9zkoɑM]!,|Hz{ h@⒩4=#Ꚛ.Pӽ{%5==vu y#O G|&߀dUz9i: 7&S^\Fx/!z4p1:hu1}jq2MJqxh0Q.AҗD,B*f./G9fFL7 ̓0".21O#NPf5k2B&Rd~ء :!8J(Sv \*fq3arۍ裿xC+|Iғ- ݘa~N*e8.Ω6rKͫ{[3orK BU؍ T +fAUbNtM|_1l+h61Zy&}rgTzCk+g?L"^bu)21U9h:yŊNGT1aZu7]I()mYExۻ@ ~ߺe>!j?FƥA__!s!ꋲ Rmb !׮3C7ACY 6mmč<*E9t?-0h~</x;Q+Yp+_nG Fۃ.{_rMXue}22ێJRjYb;b{N$ϸ]5g{đ9ճOl[09s~ 2_;W(-_.<>?#:bWI< /̚㔣udJfp>k=|I7w6ze-JI+y{&W ~VkTZSхKZ! Q·o^ZE4]j:MԤ죥ߌ)y1w~-eaڵ#h^^-(`:T:n`t,-6DV^r=IS!iXa~IALs7R~sì7 Y:qlzgjV _y̑AQ*E :FߐAG.9A** 2z[AcT+rοKwBtWE|۩o"RNHHOjd  E䢔+$d.N.(cC|nf|&bO瞮y{\Ekpt ٲ7oP,‰B5$߶DT3__ cfx &lWVb'd\) :gjt;V󣠅e "a &2,w@c+$?,0+Ja,zI{AI. \sdJzծzNVPLq/'W 1gՒy~Lj?0C4(#Vw!2^Lͬ?=.戰r{ FOn`䴔 ½c9Z8TېA(ct;;|!D̂/ uYUd#eZnvpOPChCvmrG_P(FT%cE0v;eަV4,6phZ&Qݦ˛[ hܼ5 ǐSzXw+`C[߅:4([(}mę l!th'mأe.ۑuwnAr8By/KU j`{ʼn΂SaThh{.edUQIn{,^ʨKW<:S\\z{޶u)X!zy'` &7=r'Ɯx}.5eƫ5YڍA\! ih^ }#fAzTGl-aIxIϞnslcpz6=BkeFdy,qIvb; 1 .7<[ Y1@5MƍO((I5b`sc%TEOa ~UÇ=L2ј9VTZF4 W1|d+R߷uCt'(q^M>3,9a-rT0h:3uYD,%fbK*@uw Z@4vBɡ|5im8$W¦}odع\{;aMS[mUTM 2(04hZz,܁M)0jrVovG$$#Kj-%X_Do?CtI}s{7? VԢ96ZF'z8 ~M/'v T`۾Qߪ$Iz2~Ryn~ 8~m"jg&=RthPZij%tFZ%U8xclY#K Dri习!^s/Zލ+J«*ˆ.#u@so?nbO\zG: B;3RıdG33VDtͷcHG])'6jCgmW9;"5ڡr=௜[Lf*6f*9uN<*C>`M ./FIgc8ItSzäꇴVv)ئf#en, ¢W[jQ}J>ػR[!Rz]ĩ=Yr'mnXt6'7s1c\~}]|yUrɼ(Σ*UgY+!lt=jG[~7nfge>ӄ]0.l cJ w$J,Ty1(WtԭEPh},%ס20Dqﳺe6KT%*"8sڅ VI'pʍ2< k>@w(+6"gAfQ\˅Syi*JϨ,m.[&:ͪ@P^[~]U4m SPSjwua7.ЂC`;|h:W0qzߏn_UːN w$EeNhd~a#ׂ' $]<(BNvISj*Ĩ1c\U KL;?Ѽxֺ4;I摄ZQ"v@AKZ$P's[7ޠZg7ٳeUO kp"!MN1oҫo|'HF(IAԉ7l9=ٴ*VseY*o/G K{fIhG5,m3ZwJ4UH``,WR?;E|@D,;`&'Z< PR/_V1؏NJŒ-E(v i"><`!_:0j/X[yU&|rqx(śdJ>P׸ Dbh.ɨݐOWw[jhd #ߦB(DG}? sulͮf+ʞ&^0{x7xv rѕ tD5"6?^se<033'11j)=.ږEg. iV,wƞZ%op@H)&ff[{ |ݕ :CЏ%⬯vZ EWs'A4Ԧ,3!‰/x깊CӪr P/T5&wKP`j b_N)~ȶ)8F|XX4(=TTo<5jI olŮ[o%cm:Q3T1mҽߌR& > ? _.ڜ?wI%W1gN`JmVO[z>%{Ys9Vʿ{ dhHlPz,F8`)rWc "JraЃ("Lȗ h>`UN[d$1As(!rڕH?봛Y8S.PjEke},hq3Э4 ^ ~(G,&1sG#+wƸocD\Ĕ>[z) }rR1 qB4,Ea#b'IM|@ XtpJȒL*<+`ľM-G@;hu:p> ldH[rr%-@&hI&o2fR v)Up*aMp\fjVw3_B4^}DAi撗R 8,k Q\cC|ACuT 0̠17 Y_Hz޷cظ1F&hgYDP! !Di!zȿDg&2S+0-Aur1>{3X%o !%l[]#Z%cQDӒLrdEEu$hԎuY<_t6hm jd{QI[>Kv<>\Mz.SJdϫGu] g+tORp,X}M,xc۰koy]&oԪRv-zFqtnF_zf)8QvqG6{Z'Vqk&lDAVh2)EZFJN Njj[Gp/?F'93Ĩ,֚[ .!mOb[Eژ=/IAaGՊu9"('cDlpT ߫ c-y<m\/$1vf@l`'[Gs ԓrLT=һEsw3+S6}Mۇ$DnBx1KV66[[t^C~sCixĺ oH=xk] ZRP/O<Va/Bu(ҏM -_G.<`- [CL fdvdZ´·5Β~$Ovտa㙡E$17k j&`〜b ^8\,.-V^gR*5Y so;B;̈́4W S>^@!@kmvĉם:qE_U2sA*W?6CaToE&'EY_zNYHތm%ikCƄ[U 9I{s۽Upe@1ki:x0lm63YbeoR3́ jv6T}?9h4Sw %\(Hr=翅QaӲ6::coĵٔ<ثLCQ!(xד;ڏr̖gX8+<˜WDa lmhܛBZJȣOd4}ȱF9qjNC< έc7`ZK>qiKaRQݰ0[B@bebpBl FS_gjKz,U\8Q G颟=˝Uf@ګi!)T"{hl/eseyǶG24!j5y<2k@D)R //a%sG(9-VXҙp[! ؈PRJfkb) U v(Bl\جiѵuAko7C>w Kw-Fњ"s<60R6,AJö%EJv(':,oB3JpTgʒdcz?z/?c$z$ql[lQf܋{@/Ӭ^z朒8'R(x-XnG9N33BE~&QLJ`NRh|qw-$?"~CT<l݃?!f)8] ee{an:-b!9>r3a(<R'hE*v"+'C>M(}loJ:g5 KvUm'a|\4kt |hz*Kڐ:ߕpI2Tئ?hQ:6[bl?[ !yJaK+~51 ӈ;+m1*+Ⱦܞ $ KiO#}'on{oTh-QJ_&/]pWev &gh.l6P`7;&ϰZew_;#d[}WMA@:sob-cl{ uK~ wDN@A֗+U$.PkHnpH=h}t> endobj 11 0 obj << /Type /ObjStm /N 39 /First 292 /Length 2289 /Filter /FlateDecode >> stream xYnH}W.7 hL؎3XEKʢ#'_?DJcx_ljvW*Sm*&d3i41сL)la:0J:SIi|p1*DŽZbVsiPpό`F 3㱾aK\tD 2E<+5 bG˔eN`-0/0a;.+>Ef9"n\08C磆;G4 BޫW=~6gc6{V3 {8w|$Ӆ{v.pFRyǂ/Caneh/z gssWsɝjͩ[iDLE:㬼:+vXcnxٵ"P͕C8w΅pߎII%VT'ΕG~ 4?] ` >5Wcw'nJdԓ}K+hR4<4GMCg:Ѵ޹Q#2h&Pm%RRuPFE@/Z/զjVV嬮U?d7yq0fU>?!Lќz~i*=:6ߛ_Q% D]h\A6}z[_)olR\MG?3hn2!`A??cg_!5/)/y9-gE93>Ƴ<՟%_?kն]?N Z7t.E",]\LD۰6,{|C>@o[:` gaSonc7l>4uW1S@i̗h_W,ل rϫ~+< Kg0 <)jW,{Yى)GN[q~8J-\hc@R Hvu#9hW.kn'x:]0_ "gո.Qx}}e "o цk^ %܎3>(Uwhi.n=y沜|ݏ.V{v [\f|&.>ދOUy[d|t7f[X WH: ڷFZoaAfE&5ok< _N}$sg®]=3!NlNlThpʦI:$3NvKm mbtǙD[U̚Pf'YYihg6Mga7y!%^Nj)7#)zđNN~}[c؆"̑@*/1WK ܦ$S )sJ2CS?bC2TX-XBV@ ͧ {wYtٽ/[Fҿl^Xlz]|I[Ű-Y^c=,?f֊~ͬnj[e*mêi,#6вmd\Mc7ѦNr-vgQO&'k!0Qfbv7zwa[dve[]f&{RٴKA-2I=*z8wW~~M(뗞*]\#ۃ v^=O_Q* endstream endobj 55 0 obj << /Type /XRef /Index [0 56] /Size 56 /W [1 3 1] /Root 53 0 R /Info 54 0 R /ID [<41D2803453AC1156F0A7B52B5CA177A4> <41D2803453AC1156F0A7B52B5CA177A4>] /Length 164 /Filter /FlateDecode >> stream x˹ Ps0s $ K ! $!4M>owS@@b&F/bH/v7fS19%­- "OD'{'(HEEJG˷U8ug UxV-XƪCV] ogOqm endstream endobj startxref 117770 %%EOF sn/inst/doc/how_to_sample.pdf.asis0000644000176200001440000000017713647323114016716 0ustar liggesusers%\VignetteIndexEntry{How to sample from the SN and related distributions} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{PDF} sn/inst/doc/pkg_sn-intro.pdf.asis0000644000176200001440000000015713647330070016465 0ustar liggesusers%\VignetteIndexEntry{An introduction to the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{PDF} 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-overview.html.asis0000644000176200001440000000016113647330112016663 0ustar liggesusers%\VignetteIndexEntry{A brief overview of the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{HTML} sn/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/CITATION0000644000176200001440000000162714147750647013031 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$ and the {SUN} (version ", meta$Version, ").", sep=""), author = personList(as.person("A. Azzalini")), address = "Universit\\`a degli Studi di Padova, Italia", year = substr(meta$Date, 1, 4), note = "Home page: \\url{http://azzalini.stat.unipd.it/SN/}", url = "https://cran.r-project.org/package=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 and the SUN (version ", meta$Version, "). ", "URL http://azzalini.stat.unipd.it/SN/,https://cran.r-project.org/package=sn", sep="") )