sn/0000755000176200001440000000000015147273242010701 5ustar liggesuserssn/MD50000644000176200001440000001047315147273242011216 0ustar liggesusers94883357ab19cd1e9ff3532609447d4c *DESCRIPTION 42d9a34c5d6ffd09a331e70631541d8c *NAMESPACE cbc7ce50786b85045b62ac2da4313fed *R/sn-funct.R 3009f0e21f60d47efbd762347bd9855d *R/sn_S4.R 733da79ff2f3aae8d7dc1b3174e0b311 *R/sun.R 9a7d5a781042420c7cd86388264922bd *R/zzz.R 76e123f5dcc8dee07678412adc0a2a84 *build/partial.rdb 53db63fc4b07d4b2932157db2195eb5c *build/vignette.rds b5fd69db10d1357fb24187d800c4729a *data/ais.rda 0106155fee88cc48b1fd7906f5348598 *data/barolo.rda bb56831a5ca1a3a5c84315223e8e75e8 *data/frontier.rda 7a4539244fa6cac56948196b65646f70 *data/wines.rda 74230ca94e04793931d4cea94cfc854a *inst/CITATION 192feffc1c732c96def99bf626e23d64 *inst/NEWS.Rd 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 03eb8169badf132b38905d8b766cdbf6 *man/SUNdistr-base.Rd a82fd3e71d86a9ba943eb21e90ff661f *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 406db93cbff3f417aa2519b8bfb3a356 *man/coef.selm.Rd f9361d9091a1e5b06fa9583154ddfbe6 *man/conditionalSECdistr.Rd e0a06262f64758d7e0e5dd1d79c076f1 *man/confint.selm.Rd 382a5a2e5ac5cdc8e4a7bbb846a17a9f *man/convertCSN2SUNpar.Rd 2c17bed1c33a3986e8975d1bede73b7a *man/convertSN2SUNdistr.Rd 6c9c2122f74f9b44721b091773b01e8b *man/dmsn.Rd cb1c428a88d0617f21fe678137507a04 *man/dmst.Rd 70356d4c1c4845193ea211d88cb92d96 *man/dp2cp.Rd 383f5b2e2f8c8bc78646c26cd047f42b *man/dsc.Rd e3305ae04e970ec1b59696069ba862b3 *man/dsn.Rd 4fd09eb825352746b2ddf6b0f7389e2c *man/dst.Rd 1d22732a88a116f43d642f678d9e8270 *man/extractSECdistr.Rd 202daafbd8566b41ac1ca4fd28099afd *man/fitdistr.grouped-class.Rd 90259a45d748956702c8cca9e2781b6b *man/fitdistr.grouped.Rd 4139e67f0b045af5067bbd7b04e315a4 *man/fournum.Rd 8e9b88045386ec0467941a81e1e43a50 *man/frontier.Rd ee4d938eb24c34a13b2b80f12e2152a2 *man/galton_moors2alpha_nu.Rd c00453b3453010a35592338b44a189ed *man/makeSECdistr.Rd 3a8df06dafb8cbed76a7c4459c1abb39 *man/makeSUNdistr.Rd 0712ef8b01523502cd7d5b83efab3489 *man/matrix-op.Rd 6aebeb7c7478d128781d1a49b944311c *man/modeSECdistr.Rd 31e7fdcf2ed213bfa7845b1251adc4a6 *man/overview-sn.Rd 58f03da64127b119ccf056451c9bbe6a *man/plot.SECdistr.Rd 2db26cc29a967e52b477af60a9775e93 *man/plot.SUNdistr-method.Rd c3d2c70dad0d737120b6832103f12e32 *man/plot.fitdistr.grouped.Rd a3c44dc08cf3b3353116f3144f5bf915 *man/plot.selm.Rd 9cc380dc6481a5b2231cdea55efbf2a1 *man/pprodt2.Rd be992414e137c8155e93cf3a8acebfda *man/predict.selm.Rd 1c80ea2dc87fdb10c6071001412d04f3 *man/profile.selm.Rd 1850b6167389e4f2a645f6d537b43486 *man/residuals.selm.Rd cc3dc14383601c9fa0bf8d1196ed8049 *man/sd.Rd 7fcefc42f83b1679a8513980b6a74fbe *man/selm-class.Rd 1fe1ff00689e358a6f6501987628ef7b *man/selm.Rd dcc987cd35b7cf65c5a2eae3e22f13c9 *man/selm.fit.Rd 669280d0faa4e52de979f7af3ed2c0e3 *man/sn-package.Rd 076f880a91b013ab11e03d60c8287ef8 *man/sn-st.cumulants.Rd 75e35fa20488e666fdc608f36624fcbe *man/sn-st.info.Rd e8b7cb8f40d0b57990d14dae76c31228 *man/spread.grouped.Rd 43c750c59b5808a50437324ecc0f048d *man/st.prelimFit.Rd ac9e41daa309fce5cf5fc2f3f389880a *man/summary.SECdistr-class.Rd 1ee1fbb2f184afbd5d1dc9682d6b5d66 *man/summary.SECdistr.Rd 8d59ddc439d6455957e79fc5612fb114 *man/summary.SUNdistr-class.Rd 4862d1ff1e5b060fad4c98bbece3bf1c *man/summary.SUNdistr.Rd 2d6b8243ed2275acd353c5c3c7472440 *man/summary.selm.Rd 0062d1648a0dbd041973521fb86bdd51 *man/symm-modulated-distr.Rd c9013b421d93931e4ee5b7d1100e6d4b *man/wines.Rd 8e8132fcf5aee330d15242ba8fb0eddc *man/zeta.Rd 2b11e4c3e0e1a0832b3efd6814b0455b *vignettes/how_to_sample.pdf.asis bf0571487f0d01e9af5c5d36891271d6 *vignettes/pkg-overview.html.asis 5d3f468e91971ed3d8e7ce13a0656f09 *vignettes/pkg_sn-intro.pdf.asis sn/R/0000755000176200001440000000000015147260260011076 5ustar liggesuserssn/R/sn_S4.R0000644000176200001440000003631615147004675012226 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(!is(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(!is(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"), show.summary.selm) setMethod("show", signature(object="summary.mselm"), show.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("confint", signature(object="selm"), confint.selm) setMethod("predict", signature(object="selm"), predict.selm) setMethod("profile", signature(fitted="selm"), profile.selm) sn/R/zzz.R0000644000176200001440000000101014266747364012066 0ustar liggesusers.onAttach <- function(library, pkg) { # require("stats4") # require("methods") # require("mnormt") # require("numDeriv") if(interactive()) { # pkg <- Package("sn") meta <- packageDescription("sn") overview <- 'help("overview-sn")' packageStartupMessage( "Package 'sn', ", meta$Version, " (", meta$Date, "). \n", "Type 'help(SN)' and '", overview, "' for basic information.\n", "The package redefines function 'sd' but its usual working is unchanged.") } invisible() } sn/R/sn-funct.R0000644000176200001440000074574215147117435013006 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 } za <- cbind((x-xi)/omega, alpha) z <- za[,1] alpha <- za[,2] logN <- (-log(sqrt(2*pi)) -logb(omega) - z^2/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) out <- if(log) logPDF else exp(logPDF) names(out) <- names(x) return(out) } 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 0 } z <- (x-xi)/omega prob <- rep(NA, length(z)) plain <- is.finite(z) & (omega > 0) if(any(!plain)) { prob <- replace(prob, z==-Inf, 0) prob <- replace(prob, z==Inf, 1) prob <- replace(prob, is.na(z) | (omega <= 0), NA) } if(sum(plain) == 0) return(prob) na <- length(alpha) za <- matrix(cbind(z, alpha), ncol=2)[plain,,drop=FALSE] z <- za[,1] # z re-defined here nz <- length(z) if(missing(engine)) engine <- if(na == 1 & nz > 3 & all(z*za[,2] > -5) & (tau == 0)) "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 <- za[,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))) names(prob) <- names(x) replace(prob, plain, p) } # 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 } if(omega <= 0) stop("argument 'omega' (or dp[2]) must be positive") # 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(xi + omega * max.q) if(alpha == -Inf) return(xi + omega * min.q) } na <- is.na(p) | (p < 0) | (p > 1) zero <- (p == 0) one <- (p == 1) ok <- !(na | zero | one) q.all <- numeric(length(p)) names(q.all) <- names(p) q.all <- replace(q.all, na, NA) q.all <- replace(q.all, zero, -Inf) q.all <- replace(q.all, one, Inf) if(sum(ok) == 0) return(q.all) p <- p[ok] # can drop cases not-OK 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"') } 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 } Sign <- function(x) sign(x) + as.numeric(x==0) q <- as.numeric(xi + omega * Sign(alpha)* x) } else stop("unknown solver")} q.all[ok] <- q names(q.all) <- names(q) return(q.all) } 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") d <- length(dp0$alpha) if(d == 1) { dp1 <- unlist(dp0) dp1[2] <- sqrt(dp1[2]) y <- matrix(rsn(n, dp=dp1), ncol=1) } else { lot <- dp2cpMv(dp=dp0, family="SN", aux=TRUE) y <- matrix(rnorm(n*d), n, d) %*% chol(lot$aux$Psi) # N_d(0,Psi) if(dp0$tau == 0) truncN <- abs(rnorm(n)) else truncN <- qnorm(runif(n, min=pnorm(-dp0$tau), max=1)) truncN <- matrix(rep(truncN, d), ncol=d) delta <- lot$aux$delta z <- delta * t(truncN) + sqrt(1-delta^2) * t(y) y <- t(dp0$xi + lot$aux$omega * z) } attr(y, "family") <- "SN" attr(y, "parameters") <- dp0 return(y) } #--- dst <- function (x, xi=0, omega=1, alpha=0, nu=Inf, dp=NULL, log=FALSE) { if(!is.null(dp)) { if(!missing(alpha)) stop("You cannot set both the 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)) if (nu <= 0) stop("'nu' must be positive") za <- cbind((x-xi)/omega, omega, alpha) z <- za[,1] omega <- za[,2] alpha <- za[,3] ok <- (omega>0) pdf <- ifelse(ok, dt(z, df=nu, log=log), NaN) cdf <- ifelse(ok, pt(alpha*z*sqrt((nu+1)/(z^2+nu)), df=nu+1, log.p=log), NaN) out <- if(log) logb(2) + pdf + cdf -logb(omega) else 2 * pdf * cdf / omega names(out) <- names(x) return(out) } 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, lower.tail=TRUE, log.p=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(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 positive") dots <- list(...) dp.std <- c(0, 1, alpha, nu) delta <- alpha/sqrt(1+alpha^2) 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>5 | method != round(method)) stop("invalid 'method' value") if((method == 1 | method ==4) & !int.nu) stop("selected 'method' does not work for non-integer nu") z <- (x-xi)/omega pr <- rep(NA, length(z)) ok <- !(is.na(z) | (z==Inf) | (z==-Inf) | (omega<=0)) z <- z[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 (recursive formula, for integer nu) p. <- pst_int(z, 0, 1, alpha, nu) p <- if(lower.tail) p. else 1-p. p <- if(log.p) log(p) else p } else { p <- numeric(length(z)) for (i in seq_len(length(z))) { if(abs(z[i]) == Inf) p[i] <- (1 + sign(z[i]))/2 if(method==5 | method==0 & abs(z[i])> (30+1/sqrt(nu))) { lp <- st_tails(z[i], alpha, nu, lower.tail=lower.tail) # lp <- if(z[i]<0) lp else log(1-exp(lp)) # p[i] <- if(log.p) lp else exp(lp) p[i] <- if(log.p) {if(z[i]<0) lp else log(1-exp(lp))} else {if(z[i]<0) exp(lp) else 1-exp(lp)} } 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. <- if(inherits(out, "try-error")) NA else out ## p[i] <- if(lower.tail) p. else 1-p. ## p[i] <- if(log.p) log(p[i]) else max(0, min(1, p[i])) } else { # method = 2 or 3 # upper <- if(absalpha> 1) 5/absalpha + 25/(absalpha*nu) else 5+25/nu upper <- 10 + 50/nu abs.tol <- rel.tol <- .Machine$double.eps^0.25 if(!is.null(dots$rel.tol)) rel.tol <- dots$rel.tol if(!is.null(dots$abs.tol)) abs.tol <- dots$abs.tol 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]), rel.tol=rel.tol, abs.tol=abs.tol, dp=dp.std, stop.on.error=FALSE) p. <- p0 + sign(z[i]) * int$value ## p[i] <- if(lower.tail) p. else 1-p. ## p[i] <- if(log.p) log(p[i]) else max(0, min(1, p[i])) } else {# method 3 p. <- integrate(fp, 0, Inf, alpha, nu, z[i], rel.tol=rel.tol, abs.tol=abs.tol, stop.on.error=FALSE)$value ## p[i] <- if(lower.tail) p. else 1-p. ## p[i] <- if(log.p) log(p[i]) else max(0, min(1, p[i])) } } p[i] <- if(lower.tail) p. else 1-p. p[i] <- if(log.p) log(p[i]) else max(0, min(1, p[i])) }}}} pr[ok] <- p pr[x == Inf] <- if(log.p) 0 else 1 pr[x == -Inf] <- if(log.p) -Inf else 0 pr[omega <= 0] <- NaN names(pr) <- names(x) return(pr) } st_tails <- function(x, alpha, nu, lower.tail=TRUE, threshold=20) { # log-probabilities of ST tails, using Azzalini & Capitanio (2014, top p.122): # (upper prob if x>threshold, lower prob if x< -threshold, NA otherwise). if(length(alpha) > 1) stop("alpha must be a scalar value") if(length(nu) > 1) stop("nu must be a scalar value") pos <- (x > threshold) neg <- (x < -threshold) lp <- rep(NA, length(x)) # will collect log-probabilities if(alpha >= 0) { log.c <- (log(2) + lgamma((nu+1)/2) + (nu/2)*log(nu) + pt(c(-1,1)*alpha*sqrt(nu+1), nu+1, log.p=TRUE) -lgamma(nu/2) - 0.5*log(pi) ) lp <- replace(lp, neg, log.c[1] -log(nu)- nu*log(-x[neg])) # lower tail lp <- replace(lp, pos, log.c[2]-log(nu)- nu*log(x[pos])) # upper tail } else lp <- st_tails(-x, -alpha, nu) return(lp) } 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' is 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)) { # improves 'lower' when is too low, moving down from 'upper' 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) if(d == 1) y <- matrix(rst(n, xi, sqrt(Omega), alpha, nu), ncol=1) else { 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) dots <- list(...) 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(xi=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("[st.cp2dp] 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("[mst.cp2dp] starting dp values:", dp.marg, "\n") 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] outcome from optimization step\n") cat("opt$convergence:", opt$convergence, "\n") cat("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(!is(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(is.null(O.inv)) stop("Numerical problem in sn.infoMv, please report") 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() ) { if(trace) cat("[msn.mle] function is starting\n") 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) 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 <- (Omega + t(Omega))/2 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) if(trace) { cat("[msn.mle] function is completing\n") cat("message from ", opt.method, "(maybe empty):", opt$message,"\n") cat("final working parameters: " , format(opt$par), "\n") cat("log-likelihood:", format(logL, nsmall=2), "\n") } 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 Omega <- (Omega + t(Omega))/2 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","working parameters:\n"); 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 Omega <- (Omega + t(Omega))/2 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("[msn.dev.grad] 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(trace) cat("[st.mple] function is starting\n") 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) verbose <- as.numeric(trace)*2 if(trace) cat("st.mple running...") 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, verbose=verbose)$dp if(Mx == "M3") dp <- st.prelimFit(x, y, w, quick=NULL, verbose=verbose)$dp if(!is.null(fixed.nu)) dp <- dp[-length(dp)] if(symmetr) dp <- dp[-length(dp)] if(trace) cat("starting dp values obtained from st.prelimFit\n") } else{ if(length(dp) != (p+2-as.numeric(symmetr)+as.numeric(is.null(fixed.nu)))) stop("arg 'dp' has wrong length")} if(trace) cat("[st.mple] 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-consuming 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("[st.mple] function is completing") cat("message from", opt.method, "(maybe none):", opt$message, "\n") cat("estimates (dp):", format(dp), "\n") cat("log-likelihood:", format(logL, nsmall=2), "\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(trace) cat("[mst.mple] function is starting\n") 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) verbose <- as.numeric(trace)*2 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, verbose=verbose)$dp if(Mx == "M3") dp <- mst.prelimFit(x, y, quick=NULL, verbose=verbose)$dp if(trace) cat("starting dp values obtained from mst.prelimFit\n") } 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") } beta <- dp[[1]] Omega=dp[[2]] alpha <- if(symmetr) rep(0,d) else dp[[3]] nu <- if(!is.null(fixed.nu)) fixed.nu else dp[[4]] dp <- list(beta=beta, Omega=Omega, alpha=alpha, nu=nu) if (trace) cat("[mst.mple] starting values for 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 logL <- dev/(-2) param <- opt$par opt$method <- opt.method opt$called.by <- "mst.mple" 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) if (trace) { cat("[mst.mple] function is completing\n") cat("message from optimization routine (maybe empty):", opt$message, "\n") cat("(penalized) log-likelihood:", format(logL, nsmall=2), "\n") } list(call=match.call(), dp=dp, dp.complete=dp.complete, logL=logL, 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(trace) cat("[sn.mple] function is starting\n") 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 cp1 <- as.numeric(c(qr.coef(qr.x, y), s, gamma1)) dp1 <- cp2dp(cp1, family="SN") logL1 <- sum(dsn(y, x %*% dp1[1:p], dp1[p+1], dp1[p+2], log=TRUE)) sn.prelim <- st.prelimFit(x, y, verbose=as.numeric(trace), SN=TRUE) logL2 <- sn.prelim$logLik if(logL2 > logL1) {dp <- sn.prelim$dp; type <- 2} else {dp <- dp1; type <-1} cp <- dp2cp(dp, family="SN") if(trace) cat("[sn.mple] initial CP estimates, type", type, "=", format(cp), "\n") } 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("[sn.mple] function is closing\n") cat("message from optimizer", opt.method, "(maybe empty):", opt$message, "\n") cat("estimates (cp) =", format(cp), "\n") cat("(penalized) log-likelihood =", format(logL, nsmall=2), "\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() ) { if(trace) cat("[msn.mple] function is starting\n") 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, trace=trace)$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) } 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) if(trace) { if(trace) cat("[msn.mple] function is closing\n") cat("message from optimization routine (maybe empty):", opt$message,"\n") cat("(penalized) log-likelikood:", format(logL, nsmall=2), "\n") } 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("[msn.pdev] 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))) if(missing(probs) | is.null(probs)) probs <- c(0.25, 0.50, 0.75, 0.95) 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(!(is(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(x, ...) { obj <- x 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(obj,"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(obj) } show.summary.selm <- function(object) print.summary.selm(x=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(x, ...) { obj <- x 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(obj, "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(obj, "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) } invisible(obj) } show.summary.mselm <- function(object) print.summary.mselm(x=object) 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(!is(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-Bowley 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) cat("[galton_moors2alpha_nu]", 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(verbose > 0) cat("[galton_moors2alpha_nu] quick match:", format(out), "\n") if(quick) return(out) log.nu <- min(log.nu, 5) # avoid huge log.nu at start, especially Inf if(verbose > 1) cat("[galton_moors2alpha_nu] second step of (GaltonBowley, Moors) inversion") opt <- invert.GM(abs.galton, moors, abs(alpha), log.nu, verbose, abstol) if(verbose > 1) { cat("[galton_moors2alpha_nu] outcome from invert.GM") 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) } #--------- galton2alpha <- function(galton, move.in=TRUE) { max.GB <- 0.144292171 # 0.144292171045 deltaV <- c(seq(0, 0.9, by=0.1), 0.95, 0.99, 0.99999) alphaV <- deltaV/sqrt(1-deltaV^2) galtonV <- c(# Galton-Bowley values for SN distributions 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, max.GB) interp.alpha <- splinefun(galtonV, alphaV, method="hyman") alpha0 <- if(abs(galton) < max.GB) interp.alpha(abs(galton)) else { if(move.in) 10 else Inf} alpha <- sign(galton) * alpha0 return(alpha) } #--------- st.prelimFit <- function(x, y, w, quick=TRUE, verbose=0, max.nu=30, SN=FALSE) {# inserted in version 1.6-0 (2020-03-28); updated in v.2.1.0 y <- c(y) 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(rep(y, w), na.rm=TRUE) resid <- (y-beta) } else { beta.fit <- quantreg::rq.wfit(x, y, tau=0.5, weights=w, method="fn") # >= 2.1.3 beta <- coef(beta.fit) resid <- c(residuals(beta.fit)) } q.measures <- fournum(rep(resid, w)) if(is.null(quick)) { alpha <- 0 nu <- 10 } else { galton <- q.measures[3] moors <- q.measures[4] if(SN) { alpha <- galton2alpha(galton, move.in=TRUE) nu <- Inf } else { 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) } } if(verbose > 0) cat("[st.prelimFit] c(alpha, nu) = ", alpha, nu, "\n") 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)) if(SN) dp <- dp[-length(dp)] if(verbose > 1) cat("[st.prelimFit] c(dp, logL) = ", dp, logL, "\n") return(list(dp=dp, residuals=resid, logLik=logL)) } #---- mst.prelimFit <- function(x, y, w, quick=TRUE, verbose=0, max.nu=30, SN=FALSE) {# inserted in version 1.6-0 (2020-03-28), updated in version 2.1.0 matchMedian <- function(omega.bar, nu, obs.median) { if(any(abs(omega.bar) >= 1)) return(NA) pprodt2(obs.median, omega.bar, nu) - 0.5 } y <- data.matrix(y) 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, SN=SN) dp.marg[,j] <- fit$dp z[,j] <- fit$residuals/dp.marg[p+1,j] } omega <- as.vector(dp.marg[p+1,]) lambda <- c(dp.marg[p+2,]) delta <- lambda/sqrt(1 + lambda^2) nu <- median(dp.marg[p+3,]) # wd <- max(5, 1000/(nu + (.Machine$double.eps)^0.25)) if(d > 1) { 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 } 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 <- diag(omega, d) %*% Omega.star[1:d,1:d] %*% diag(omega, d) Omega <- force.symmetry(Omega) } else {# case d=1 Omega.star <- rbind(c(1, delta), c(delta,1)) Omega <- matrix(omega^2, 1, 1) k <- NA } 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) } #---------------------------------------------------------------------------- # 2022-07-21, introduce fitdistr.grouped and related methods fitdistr.grouped <- function (breaks, counts, family, weights, trace = FALSE, wpar = NULL) { if(!missing(weights)) {if(missing(counts)) counts <- weights else stop("you cannot set both counts and weights")} # (counts = weights) nf <- length(counts) if(any(counts < 0)) stop("negative counts") if(any(counts != round(counts))) stop("non-integer counts") if(any(is.na(c(breaks, counts)))) stop("NAs in breaks or counts") if(any(diff(breaks) <= 0)) stop("'breaks' not in increasing order") if(length(breaks) != (nf+1)) stop('mismatch of the input vector sizes') if(tolower(family) == "gaussian") family <- "normal" fam.rv <- c("normal", "logistic", "t", "Cauchy", "SN", "ST", "SC") # real-valued families fam.pv <- c("gamma", "Weibull") # positive-valued families fam <- c(fam.rv, fam.pv) fam.funct <- c("norm", "logis", "t", "cauchy", "sn", "st", "sc", "gamma", "weibull") family <- match.arg(family, fam, several.ok=FALSE) if((family %in% fam.pv) & any(breaks < 0)) stop('negative breaks') fam.npar <- c(2, 2, 3, 2, 3, 4, 3, 2, 2) which.fam <- which(family==fam)[1] family.bn <- fam.funct[which.fam] # family function basename npar <- fam.npar[which.fam] pos <- # TRUE for intrinsically-positive parameter components if(family %in% fam.pv) rep(TRUE, npar) else {if(family=='t') c(FALSE, TRUE, TRUE) else c(FALSE, TRUE, FALSE, TRUE)[1:npar]} br <- breaks width <- diff(br) if(is.infinite(breaks[1]) | is.infinite(breaks[nf+1])) { br <- c(br[2] - 3*width[2], br[2:nf], br[nf] + 3*width[nf-1]) if(family %in% fam.pv) br[1] <- max(br[1], 0) } if(is.null(wpar)) { # midpts <- (br[-1]+ br[-(nf+1)])/2 spread.x <- spread.grouped(br, counts, "centre") if(trace) cat("[fitdistr.grouped] obtaining initial working parameters:\n") if(family %in% c("SN", "ST", "SC")) { fit <- st.prelimFit(y=spread.x, max.nu=20, verbose=2*as.numeric(trace)) dp <- fit$dp wpar <- c(dp[1], log(dp[2]), dp[3]) if(family=="ST") wpar <- c(wpar, log(dp[4])) } else { m <- mean(spread.x) s <- sd(spread.x) wpar <- switch(family, "normal"= c(m, log(s)), "logistic"= c(m, log(sqrt(3)* s/pi)), "t" = c(m, log(s*sqrt(5/3)), log(5)), "Cauchy" = {mq <- mqCauchy(spread.x); c(mq[1], log(mq[2]))}, "gamma" = {a <- (m/s)^2; log(c(a, a/m))}, "Weibull"= log(mmWeibull(m, s)) ) } if(trace) cat("[fitdistr.grouped] initial working parameters:", format(wpar),"\n") } else {if(length(wpar) != npar) stop("wrong number of 'wpar' components")} breaks.full <- breaks counts.full <- counts id.orig <- rep(TRUE, length(counts)) if((family %in% fam.pv) & (breaks[1] > 0)) { breaks.full <- c(0, breaks) counts.full <- c(0, counts) id.orig <- c(FALSE, rep(TRUE, length(counts))) } if((family %in% fam.rv) & (breaks[1] > -Inf)) { breaks.full <- c(-Inf, breaks) counts.full <- c(0, counts) id.orig <- c(FALSE, rep(TRUE, length(counts))) } if(breaks[length(breaks)] < Inf) { breaks.full <- c(breaks.full, Inf) counts.full <- c(counts.full, 0) id.orig <- c(id.orig, FALSE) } # range(breaks.full) now spans the entire support of 'family' if(!(length(breaks.full) > npar)) stop("too few intervals for this family") opt <- optim(wpar, logL.grouped, method="Nelder-Mead", control=list(fnscale=-1), breaks = breaks.full, counts = counts.full, family=family, trace = trace, fitted=FALSE, hessian=TRUE) wpar <- opt$par dp <- ifelse(pos, exp(wpar), wpar) u <- ifelse(pos, 1/dp, 1) names(dp) <- { if(family == "t") c("location", "scale", "df") else formalArgs(paste("d", family.bn, sep=""))[2:(npar+1)] } logL <- logL.grouped(wpar, breaks.full, counts.full, family, fitted=TRUE) fitted <- attr(logL, "fitted") info <- diag(u) %*% (-opt$hessian) %*% diag(u) dimnames(info) <- list(names(dp), names(dp)) v <- try(solve(info)) vcov <- if(inherits(v, "try-error")) NULL else v input <- list(counts=counts, breaks=breaks, family=family, family.bn=family.bn, breaks.plot=br, breaks.full=breaks.full, id.orig=id.orig) structure( list(call=match.call(), family=family, logL=logL, param=dp, vcov=vcov, fitted=fitted, input=input, opt=opt), class="fitdistr.grouped") } # logL.grouped <- function(wpar, breaks, counts, family, trace = FALSE, fitted=FALSE) { br <- breaks[-c(1, length(breaks))] # assume outer breaks are support boundaries cdf <- switch(family, "normal" = pnorm(br, wpar[1], exp(wpar[2])), "logistic" = plogis(br, wpar[1], exp(wpar[2])), "t" = pt((br - wpar[1])/exp(wpar[2]), exp(wpar[3])), "Cauchy" = pcauchy(br, wpar[1], exp(wpar[2])), "SN" = psn(br, wpar[1], exp(wpar[2]), wpar[3]), "ST" = pst(br, wpar[1], exp(wpar[2]), wpar[3], exp(wpar[4])), "SC" = psc(br, wpar[1], exp(wpar[2]), wpar[3]), "gamma" = pgamma(br, exp(wpar[1]), exp(wpar[2])), "Weibull" = pweibull(br, exp(wpar[1]), exp(wpar[2])) ) prob <- pmax(diff(c(0, cdf, 1)), 0) n <- sum(counts) if(any(is.na(prob))) return(NA) logL <- try(dmultinom(counts, n, prob, log=TRUE)) if(inherits(logL, "try-error")) return(NA) if (trace) cat("[logL.grouped] (working parameters, logLik):", format(c(wpar, logL)),"\n") if(fitted) attr(logL, "fitted") <- prob * n logL } #--- coef.fitdistr.grouped <- function(object, ...) object$param vcov.fitdistr.grouped <- function(object, ...) object$vcov logLik.fitdistr.grouped <- function(object, ...) { logL <- object$logL attr(logL,"df") <- length(object$param) class(logL) <- "logLik" return(logL) } fitted.fitdistr.grouped <- function(object, full=FALSE, ...) if(full) object$fitted else object$fitted[object$input$id.orig] summary.fitdistr.grouped <- function(object, cor=FALSE, ...){ obj.name <- deparse(substitute(object)) cat(obj.name, "- fitted", object$family, "distribution from grouped data\n") param <- coef.fitdistr.grouped(object) vcov <- vcov.fitdistr.grouped(object) std.err <- sqrt(diag(vcov)) input <- object$input cat("number of observed counts:", length(input$counts), "\n") cat("number of full-range intervals:", length(input$breaks.full) -1 , "\n") cat("total number of observations:", sum(input$counts), "\n") logL <- object$logL cat("log-likelihood:", format(logL, nsmall=2), "\n") print(cbind(param, std.err, "z-value"=param/std.err)) if(cor) {cat("correlation matrix of the estimates:\n"); print(cov2cor(vcov))} invisible(list(param=param, std.err=std.err, vcov=vcov, logL=logL)) } print.fitdistr.grouped <- function(x, ...){ object <- x print(object$call) # cat("family:", object$family, "\n") cat("fitted parameters:", format(object$param, ...), "\n") cat("log-likelihood:", format(object$logL, nsmall=2), "\n") } #--- plot.fitdistr.grouped <- function(x, freq=FALSE, col="grey90", border="grey80", pdfcol="blue", main, sub=NULL, xlab, ylab, xlim, ylim, axes=TRUE, labels=FALSE, ...) { x.name <- deparse(substitute(x)) object <- x input <- object$input breaks <- if(all(is.finite(input$breaks))) input$breaks else { warning("Inf(s) in 'breaks' are replaced by constructed values") input$breaks.plot } widths <- diff(breaks) if(freq & var(widths) > 0 ) stop("Arguments not suitable for plot.histogram; rather use 'freq=FALSE'") width <- if(var(widths) == 0) widths[1] else NA dp <- object$param if(missing(xlim)) xlim <- range(pretty(breaks)) x <- seq(xlim[1], xlim[2], length=201) if(missing(main)) main <- paste( x.name, ": histogram and fitted", object$family, "family for grouped data") if(missing(xlab)) xlab <- "" if(missing(ylab)) ylab <- if(freq) "frequencies" else "density function" pdf <- if(input$family == "t") dt((x - dp[1])/dp[2], dp[3]) else { dp.char <- paste(paste("dp[", 1:length(dp), "]", sep=""), collapse=", ") pdf.char <- paste("d", input$family.bn, "(x, ", dp.char, ")", sep="") eval(parse(text=pdf.char)) } counts <- input$counts n <- sum(counts) rel.freq <- counts/(n*widths) if(missing(ylim)) ylim=c(0, max(rel.freq, pdf) * if(freq) n*width else 1) # see graphics:::plot.histogram, hist.default r <- structure(list(breaks = breaks, counts = counts, density = rel.freq, mids = NULL, xname = NULL), class = "histogram") plot(r, freq=freq, col = col, border = border, angle = NULL, density = NULL, main = main, sub=sub, xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, axes = axes, labels = NULL, ...) y <- if(freq) n*width*pdf else pdf lines(x, y, col=pdfcol) invisible(list(hist=r, x=x, y=y)) } #--- mmWeibull <- function(mu, sigma, ...) { # estimate Weibull parameters with the method of moments fn <- function(a, r2) gamma(1+2/a)/gamma(1+1/a)^2 -1 - r2 root <- uniroot(fn, interval=c(0.5, 5), extendInt="yes", r2=(sigma/mu)^2, ...) a <- root$root b <- sigma/sqrt(gamma(1+2/a) - gamma(1+1/a)^2) c(shape=a, scale=b) } #--- mqCauchy <- function(x, p=0.25) { # estimate Cauchy parameters from selected quantiles tiny <- 1/length(x) if((p <= tiny) | (p >= 0.5-tiny)) stop("unfeasible 'p'") probs <- c(p, 0.5, 1-p) qCauchy <- qcauchy(probs, 0, 1) q <- quantile(x, probs) s <- (q[3] - q[1])/(qCauchy[3] - qCauchy[1]) c(q[2], s) } #--- spread.grouped <- function(breaks, counts, shift="centre") { if(any(is.na(c(breaks, counts)))) stop("NA in breaks or counts") if(any(is.infinite(c(breaks, counts)))) stop("Inf in breaks or counts") if(any(counts != round(counts))) stop("non-integer counts") n <- length(counts) if(length(breaks) != (n+1)) stop("incompatible size of (breaks, counts)") shift <- match.arg(shift, c("left", "centre", "right"), several.ok=FALSE) step <- switch(shift, "left" = 0, "centre" = 0.5, "right" = 1) width <- diff(breaks) if(any(width <= 0)) stop("breaks not (strictly) increasing") x <- NULL for(j in 1:n) { x.j <- breaks[j]+ (seq_len(counts[j]) - 1 + step)*width[j]/counts[j] x <- c(x, x.j) } return(x) } sn/R/sun.R0000644000176200001440000011355515147257467012057 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(m > 20) {if(silent) return(rep(NA, n)) else stop("m exceeds the admissible size")} 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(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 distribution 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((d+m) > 20) {if(silent) return(rep(NA, n)) else stop("(d+m) exceeds the admissible size")} if (is.vector(xi)) xi <- outer(rep(1, n), as.vector(matrix(xi, 1, d))) if(ncol(x) != ncol(xi)) stop("mismatch of dimensions") 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") if(m > 20) {if(silent) return(NA) else stop("m exceeds the admissible size")} 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 > 20) {if(silent) return(NA) else stop("m exceeds the admissible size")} 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(!is(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(!is(object, "SUNdistr") & !is(object, "SECdistrMv")) stop("object of wrong class") if(is(object, "SECdistrMv")) { if(slot(object, "family") == "ESN") { message("This object is an 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(!is(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(!is(object1, "SUNdistr") | !is(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=".")) dimnames(Delta) <- list(compNames, HcompNames) xi <- dp1$xi + dp2$xi names(xi) <- compNames Omega <- Omega1 + Omega2 dimnames(Omega) <- list(compNames, compNames) tau <- c(dp1$tau, dp2$tau) names(tau) <- HcompNames Gamma <- blockDiag(dp1$Gamma, dp2$Gamma) dimnames(Gamma) <- list(HcompNames, HcompNames) dp <- list(xi=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(!is(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(!is(obj1, "SUNdistr")) obj1 <- convertSN2SUNdistr(obj1, silent=TRUE) if(is.null(obj1)) stop("object1 is neither a SUNdistr object nor adjustable") if(!is(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(!is(object, "SECdistrUv") & !is(object, "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(is(object, "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(is(object, "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, silent=FALSE, ...) {# Some moments and other characteristics values of a SUN distribution. # Computations are based on Proposition 1 and 2 of RAV&AA-2020 # This function is *not* exported in NAMESPACE. 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(m > 20) {if(silent) return(NA) else stop("m exceeds the admissible size")} 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(!is(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/vignettes/0000755000176200001440000000000015147260260012705 5ustar liggesuserssn/vignettes/pkg-overview.html.asis0000644000176200001440000000016113647330112017151 0ustar liggesusers%\VignetteIndexEntry{A brief overview of the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{HTML} sn/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/data/0000755000176200001440000000000015147260261011607 5ustar liggesuserssn/data/ais.rda0000644000176200001440000001350715147260261013061 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ǂhhhhhhYhYhYhYhYh9h9h9h9h9hG]-hτw?)?*{ܷ<U}ܩyQńwKNAQ+Fĵ?וV\cwoi\t*^cϵ|JQr@T G|1ݲq12+((*%½\t\giynП2H/dʅ쇱%z^p_߃OrS}E̯.|QQ%DtJ%q˗v k |db腼N%3Cv)D2N3Oqn~ћ@T~|?8C@?ߖkT^_~J?_F{ُ]?rNzP]. JTOQ&:K='٩~(Wଈ/f?9?ibٲ,gϖfɾP_2{3ܻ f$}`לN:Sy׼zGT,r̪E>ϖ_r==p9П?: US#TZ#:3wf[PiIZ&s`3'T:zE/ [/Jڳqٮg*Rk[,r&ZD_~DXv"-j7+o)Eo{a[5ߪvwUVɳD~% 2[qHrޓʷ^xgu|zjΨ9ͻGxX_x~( zxP%^'Ic|]ןǯ}/K΋>@$>szAzU;#$?׺f_H?gyAsViW,ɇptsAtJj<~hNHN~YvTzD ӆK? 9gywEJ >}^G S l//J?+@Zfi*_zO OW4D~K~!!y/N}E(o$PY~p] }Jl˕~>GYD?KK#eGǀюs?6K!)a[Pa#:!WGJX_\f~?ls#CNB?d.Uo|4Jj IKM}F/{_4?R%F_H2OqaG:]h=MmF-}3|WDC%ȿ<RzbߍQ;C(Cø. OH_Ec3R B&=Яz^(٪p3ʏ_VQG^8_OhoWSj77o'g9jo>IΎ<jDOqwCOr` }xG9p(3O==' y׏B9r0 8ϸ8r] e.rN|s֓g2;/i2Aot&C^s%4 4^i 0.k|<12.j|(`q5~ʅLYvaZ/>Ƶ_i׆iWB-?!7B T?IzϗKzg+_r"pCÙgx#n/u^b2{ͻ 'zy< >~'e>+b}+zPy <_cP^8I?Ot/G9}h?Х_@;ǮCS?!|y‘m^n2)>h[H9jYI^'yPR >uD9/oA^icA>֩a? bCCy֡}lǾ:}^vc?߯um}a7(\C PpzN_/:}/G{ qD/P/؏}OZAh7ye[} Ѽ0hnT݅v*ʕ2)o/ˁ<۵+CGa~ ݻ~"}b?DO][Gϣя'A<ؗ0ߐ>OWrFr߫_WU}*S>iI+3_ .IOsP:גT>Ԉ~r‘9x<+UJxE>GGK畞~[y3ѯyoϙ&;U:{ GʥUVOs>ɝz@i9?sN٩=UoÎ҇bG#vRϜ\yDW9k*Gջ>|[9ttҎOsUn3ᬹ ƕt#S?\2 zhU|x%:s,GދWUΓqz vQzQ[(' g_lmox}4XnR~ ^sti'zV-+_PS_EUC.YVx]=ߤyK"=t*^-Y-9Vs~ 97I[hW =8GzTEɠ6kO=i=zs7ϳ?MVNZ\Um#Wt6/nE駫#[%IGtsG;ހ{g6z rX'~aݴ47?g|#nahz="NK}+7ǭf"x\\o8yW+膸3<\ýpux Ƚsѡ>p'JO|/wFw&R{~spő 7_p?O~<4 ^I87c'is.#Dsy澊 n8I9GyIӟ=8týY[#p~SSƅwO'ӑ~9ν\r4;B~ͽ4_Or@_> x BW}|/x.o8w΍^8,qAE;^􀼟2cyϹ[p<|7\Ŀ/P;O;<8}4?g/?^/կrI iq?]}Q95>$}Zs{;q2rR7*vR+{Å_𜐾~$\$>??x?$qz"KIO,= C[r?Qxs=s#9(K9/7x`7=|ϓ=BNߋwz~Oɣ1z(G?(:ؓx /z~\:SҵOG=—?](Oypz+9) x}Ǯ]|IMc )h<lj>ѓ_Wq'!.qͮFa\O eB5Sw']ֹ%R<#7y%[b=.YwqrWO<7삻ˮX2w:u%; ?գWr+;}E!Nsv_Oa矰 %g/!yp3'į|0$ 77qxa]!ΖmG!C~_ޟa~'.^ ]\%.ǀ|V{nݿH<*_Ur1z?F4~һ>&TE&)8Lws;>쇸zwJ=5Zt'=OkƧ;U,ou0N/y)G 8WoW{FO!9wa5#}xqN9.I6k'v_o;-tnr=dy`kq"*vLxaU1?'^B/rB{Cěw_е>&^v1)jɛizi O { }=KyWijSU~OB~SwL^dpxr!yƫ/ga8n|/`|Ӹ8_xOi:⣱.%'|Wa)%>.$K|xW]#?I8K\.'GB";gA4xapBsE|\u~I\\;G'ZC<,C0o}׊8x=< prWy&Wα]z|o8/OW3vd?/sBp0 '8ݸ;o>~ATŮ웱;G87y~yo۝`_Wm >s|8_u|ICOq;>izHv;6|:J丸wEIOt|?=Zx_*?\`]*>ı xsrό#EHgvC&~C\H{ gHr]Il7~ gp~#.! @:!)k~}1nz}T9|-W!$'i#'z;7걟H;D.~Z`4qUn&ʏv"/7so]\maݭ> o!P~q\X88iqp/w]IN;UW=U:M;Yqx?ox9*OW,% ON}&d>w]jݾmۢscmMQ{c_~SN=h?߷弸~y˾W9?s;pߟMVI 7prDXov/6X/v~~)ۛ?ܯ{pKX{6+v tc};=VGlCr;w'J{;:,wgO@xi爵}GBGܳOÝj{I{~ǑTZ9vd,]؅z.N{q޶^/izXr&.Ccfӿr*wHxT+m'8WX\?:M8{X*?)8pv$]pvly'G_"WN'Vd|cjוS\;A.zN6׋\{"q^WzM}[fC'W͉[-js|Yg0Om_ j?9?s<2ʛU6ٴVlδZٛZY #ia$-0FHZI ¨0,* ¨0,eRQ2JYF)(eMYySFH[i #ma-0٤ɤEUҢJZTVj+o[m孶V[yFQcaX5FQcaX5FU{U{U{>8fWٔͦmfklvl&-*2eiYRuT%UgIYRT%UkIZRV9V9V9V97g jUҢJZTI*iQ%-EUEUeQUYTUUEUeQUYTUUEUu Ы}2--\Ӿuܕksn/data/barolo.rda0000644000176200001440000000306115147260261013555 0ustar liggesusersZKkW4APA 1!L0u ujv[M)mu*G袁 y )tBiuɒP{c݌LӀ'y37fb}Sg[Z h0F 9a42O)h|];tN5ScC)_dɆ]flw_C|.bVd4.K>*ktI~SJBnRpvʵH{2A|2,dٹ"ŎV}H|לfŶ4~a8?/}cGK:||1q#֫MhkUs}h#Vc`~m0Q̿^Cv}4[EEȒƘ8Hڗ8y x婋L,09PۏCj\>3Lo$]$Җ>X=1oT_a9CV0]㶚G GCc 3TWGӣ|ӺSKn =/~_W!{ٹwsm5ɾ[E먭=8%[ͫ KB)RpfKc䗸]C>:R].>b=qZ^6zl~nx#8ނېs] ,5Qcy9VF74R&uW]Zyz6Q`W gzA7_g2oyo3Ln*e66grQ6fav3꾊A8pG5z4z{X{_i3k+?}켏 jA?{Ճ_Ǩ!ȏ�aM^G=QW/<>n2YiyԭN.<!8Go<ӣ|ݧ#?aš|OfUW=~|35}+MދO+VfGG@3}ьWӉD2Hc|rsz|9A_l4j^YA@B>ne1o[J yLSgmiK%jG&{JWM'sn/data/frontier.rda0000644000176200001440000000072015147260261014126 0ustar liggesusers r0b```b`aeb`b2Y# 'H++L-~[o.'߷e?{ƁYTՍ{km^_WBs.N{yׁ#mLg}뾲[,#vNYgjb`5 Ohʷm> 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/pkg-overview.html.asis0000644000176200001440000000016113647330112016663 0ustar liggesusers%\VignetteIndexEntry{A brief overview of the package 'sn'} %\VignetteEngine{R.rsp::asis} %\VignetteKeyword{HTML} 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/R.css0000644000176200001440000000244713053257662013347 0ustar liggesusersbody { background: white; color: black; } a:link { background: white; color: blue; } a:visited { background: white; color: rgb(50%, 0%, 50%); } h1 { background: white; color: rgb(55%, 55%, 55%); font-family: monospace; font-size: x-large; text-align: center; } h2 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-size: large; text-align: center; } h3 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-size: large; } h4 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-style: italic; font-size: large; } h5 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; } h6 { background: white; color: rgb(40%, 40%, 40%); font-family: monospace; font-style: italic; } img.toplogo { vertical-align: middle; } img.arrow { width: 30px; height: 30px; border: 0; } span.acronym { font-size: small; } span.env { font-family: monospace; } span.file { font-family: monospace; } span.option{ font-family: monospace; } span.pkg { font-weight: bold; } span.samp{ font-family: monospace; } div.vignettes a:hover { background: rgb(85%, 85%, 85%); } sn/inst/doc/pkg_sn-intro.pdf0000644000176200001440000163607615147260260015547 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[oＦZ;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|８<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 ６: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 ｆ0B$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_vｆ{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.html0000644000176200001440000002355415147260260015743 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.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/NEWS.Rd0000644000176200001440000003527015147260244012726 0ustar liggesusers\name{NEWS} \title{News for Package \sQuote{sn}} \encoding{UTF-8} %-------------------------------------------- \section{Changes in sn version 2.1.3 (2026-02-24)}{ \itemize{ \item In \code{msn.mle} and its auxiliary functions, exact symmetry of the estimated \code{Omega} matrix is being forced, to avoid a numerical issue arising in particular instances. \item Working of the \code{show} method for \code{selm} and \code{mselm} classes has been reinstated. This had effectively been inhibited in a previous version of \pkg{sn} by unfortunate re-definitions of the methods. \item In function \code{st.prelimFit}, the call to \code{quantreg::rq.wfit} now has \code{method="fn"} to reduce the chance of warning messages \dQuote{Solution may be nonunique}. \item Fixed a minor bug in \code{convolutionSUNdistr}. \item Various scattered improvements in the documentation. } } \section{Changes in sn version 2.1.2 (2026-01-24)}{ \itemize{ \item Fixed a bug which affected usage of \code{...} in \code{pst} and \code{qst}, and improved documentation of these functions. \item Improved documentation in \code{"SUNdistr-base"}. } } \section{Changes in sn version 2.1.1 (2023-04-04)}{ \itemize{ \item Coding of \code{pst} is improved for extreme \code{x} arguments by employing asymptotic expressions of tail probabilites. As an implication, this change improves the working of \code{qst}. Also, new arguments \code{lower.tail} and \code{log.p} are added. \item Checking on the dimensionality \code{(d,m)} of calls to \code{{d,p}sun, sunMean, sunVcov, sunMardia} takes place before a call to a function of \pkg{mnormt} is issued. If the maximal dimensionality is exceeded, either a \code{stop} is generated, or \code{NA}s are returned, depending on the value of the \code{silent} argument. \item Fixed bugs affecting calls to \code{psn, pst} when \code{length(x)} was shorter than the length of the parameters (among \code{xi, omega, alpha}). } } \section{Changes in sn version 2.1.0 (2022-07-30)}{ \itemize{ \item New function \code{fitdistr.grouped}, with pertaining class and methods. \item More informative messages are issued when \code{trace=TRUE}, at several places. \item An experimental way for initializing the parameters of \code{sn.mple} fitting is introduced; it only takes effect when it improves over the existing scheme. \item Some adjustments in the documenation on request of the CRAN group. \item Fixed a bug affecting \code{st.prelimFit} when the argument \code{w} was used. \item The NEWS file is now in Rd format. } } \section{Changes in sn version 2.0.2 (2022-03-07)}{ \itemize{ \item Calling \code{rmsn, rmst, rmsc} with parameters for distributions with dimension \code{1} now works. \item The same feature applies to \code{mst.prelimFit} with one column matrix \code{y}. \item In \code{psn}, improved handling of non-finite \code{x} values \code{(NA, NaN, Inf)}, which led to crashes; also, streamlined coding of \code{qsn}. \item Minor fixes in the documentation of zeta and qsn; improved wording elsewhere. } } \section{Changes in sn version 2.0.1 (2021-11-26)}{ \itemize{ \item Change of the tuning arguments when \code{numDeriv::hessian} is called, to improve computation of the information matrix following a ST model fitting. \item Fixed bug which in some cases prevented the use of the 'start' argument. \item Re-organization of some internal functions computing SUN summary quantities. \item Improved documentation for \code{selm, selm.fit} and \code{SUNdistr-base}. } } \section{Changes in sn version 2.0.0 (2021-03-28)}{ \itemize{ \item Support for the SUN family 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 \code{SUNdistr}. For mode (i), the functions \code{{d,p,r}sun, sun{Mean,Vcov,Mardia}} are provided. For mode (ii), there are \code{{make, marginal, conditional, affineTrans, join, convolution, summary}SUNdistr}, and related S4 methods. \item Additional facilities include \code{convertSN2SUNdistr}, \code{convertCSN2SUNpar} and two matrix operations (\code{tr} and \code{blockDiag}). \item Fixed a bug in \code{plot.SECdistr} affecting the plot of a subset of the variables. } } \section{Changes in sn version 1.6-2 (2020-05-26)}{ \itemize{ \item Fixed wrong computation of standard errors when a multivariate ST model was fitted with the constraint alpha=0; similar fix of function confint. \item Change of the algorithm used in rsn: the additive representation is now used both fo r 0 and for non-0 values of tau. \item Use of the vignette builder R.rsp. } } \section{Changes in sn version 1.6-1 (2020-04-01)}{ \itemize{ \item Some minor changes in the selm function documentation. } } \section{Changes in sn version 1.6-0 (2020-03-28)}{ \itemize{ \item 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. \item In st.prelimFit, the package quantreg is employed for preliminary linear predictor estimation. \item Related new functions of more general interest are: fournum, pprodn2, pprodt2, qprodt2. \item Additional facts: an improved version of function profile.selm. \item Improved coding of some internal functions. } } \section{Changes in sn version 1.5-5 (2020-01-30)}{ \itemize{ \item In sn.infoMv, new argument at.MLE is introduced. \item Arguments of selm are updated to match changes in R. \item Fix a bug in dsn when called with a non-scalar argument alpha. \item Changed internal checks on 'try' output, to accomplish R changes. } } \section{Changes in sn version 1.5-4 (2019-05-09)}{ \itemize{ \item 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). \item For plotting of a multivariate SECdistr when 'range' is not supplied and 'data' is non-NULL, calculation of the plotting range has been modified. \item Proper handling of the 'name' argument of marginalSECdistr when the result is a univariate distribution. } } \section{Changes in sn version 1.5-3 (2018-11-08)}{ \itemize{ \item In pst, improved implementation of Method 2; slight modification of the automatic selection method when 'method=0'. \item Internal function qst_bounds introduced for better initial bracketing of ST quantiles; improved qst coding. \item In profile.selm the selected parameter area does no longer need to include the MLE/MPLE point. \item In sn.infoMv removed bugs in the stage of parameter parsing, which prevented computing the expected information matrix. \item In internal functions st.pdev.gh and mst.pdev.grad, improved computation of 'nu' component of logLik gradient, yielding faster fitting of ST models. \item Improved handling of arguments of sn.infoMv. \item Improved documentation of modeSECdistr and coding of modeSECdistrMv. } } \section{Changes in sn version 1.5-2 (2018-04-24)}{ \itemize{ \item Improved checking of input arguments to lower level fitting procedures (those below selm) and improved handling for those of pst. \item Fixed improper handling when not positive-definite information in st.infoUv occurs, pointed out by the CRAN group. } } \section{Changes in sn version 1.5-1 (2017-11-22)}{ \itemize{ \item More extensive documentation: - addition of 'overview' entry in standard documentation; - in directory 'doc', inclusion of a PDF file providing a tutorial introduction to the package; - additions and improvements at various places in Rd files. \item Fix a minor bug in sn.infoUv causing crash when the DP information matrix is not invertible. \item Improved numerical inversion of st.cp2dp in extreme situations. } } \section{Changes in sn version 1.5-0 (2017-02-09)}{ \itemize{ \item Tools for user-defined symmetry-modulated (AKA skew-symmetric) distributions are introduced: \{d,r\}[m]SymmModulated and its bivariate density plotting. \item Fixed a bug in dsn affecting the cases (a) x=Inf, alpha=0, and (b) omega<=0. } } \section{Changes in sn version 1.4-0 (2016-06-30)}{ \itemize{ \item Introduce methods confint and predict for selm-class objects. \item Fix bug in rmst causing some dependence among subsequent samples. \item Fix bug of modeSECdistrMv affecting certain ST cases. \item Now plot.SECdistrBv allows to overlap plots. \item Improved naming of output. \item profile.selm can now be called with vector(s) param.values of length 1. } } \section{Changes in sn version 1.3-0 (2015-11-11)}{ \itemize{ \item Method profile.selm is introduced. \item The object returned by plot.SECdistrMv now includes the coordinates of the contour curves. \item Fixed a bug affecting rmsn when called using dp=, also dp[[1]] is named beta instead of xi. } } \section{Changes in sn version 1.2-5 (2015-09-25)}{ \itemize{ \item Not released } } \section{Changes in sn version 1.2-4 (2015-08-25)}{ \itemize{ \item Output of plot.SECdistr is better structured and documented. \item In pmst, handling of case nu=Inf required a fix. \item Corrected a bug of internal function msn.dp2dp when called with aux=TRUE and d=1; this affected rmsn and rmst if d=1. } } \section{Changes in sn version 1.2-3 (2015-07-14)}{ \itemize{ \item Fixed a bug in evaluation of the feasible CP parameter space of univariate ST. \item Fixed a bug which crashed pmst when called with fractional degrees of freedom. \item Functions dmsn, pmsn and dmst now expand a single value supplied as 'xi' into a vector or matrix of suitable dimension. } } \section{Changes in sn version 1.2-2 (2015-06-05)}{ \itemize{ \item Fixed a bug in extractSECdistr from mselm-class objects. \item Fixed a bug that prevented calling low level fitting functions with non-null 'penalty' argument. \item Improved documentation of selm.fit and related functions. } } \section{Changes in sn version 1.2-1 (2015-04-28)}{ \itemize{ \item Optimization parameters are now passed from selm to sn.mple and st.mple as indicated in the documentation. \item Plotting of selm-class and mselm-class objects avoids clash of par('cex') parameters. \item Computation of sn.infoMv now takes into account whether method="MPLE" was used at the estimation stage. } } \section{Changes in sn version 1.2-0 (2015-03-24)}{ \itemize{ \item Created new functions extractSECdistr and modeSECdistr. \item New methods mean and sd for class SECdistrUv, and new methods mean and vcov for class SECdistrMv. \item Computation of qst switches to qsn if nu>1e4, instead of nu=Inf as before. \item Fixed a bug in st.pdev.hessian (correction in args sequence). \item Improved detection of singular distributions in selm output. \item Improved handling of component names of SECdistr. } } \section{Changes in sn version 1.1-2 (2014-11-30)}{ \itemize{ \item Fixed a bug affecting plotting of mselm objects under certain circumstances. \item Fixed a bug affecting function selm when the weights argument contained 0's. \item Improved coding in some functions. \item More functions are exported and their documentation is added. } } \section{Changes in sn version 1.1-1 (2014-10-30)}{ \itemize{ \item Function qsn has an additional argument 'solver'. \item Functions pmsn and pmst can now be called with argument 'xi' of matrix type. \item More functions are now exported in NAMESPACE. \item Fixed a bug about selm.control argument of selm.fit. \item Improved documentation of various functions. } } \section{Changes in sn version 1.1-0 (2014-08-06)}{ \itemize{ \item Main few feature is the possibility to set the constraint alpha=0 in function selm and in lower level fitting functions. \item 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. \item More detailed documentation of pst and other functions and methods. } } \section{Changes in sn version 1.0-0 (2014-01-06)}{ \itemize{ \item 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. \item The key new functions are selm and makeSECdistr, with various related functions and methods. \item S4 methods are adopted. \item Many existing functions are updated, a few are dropped. \item See help(SN) for more information. \item (Development of "version 1" was started in June 2007.) } } \section{Changes in sn version 0.4-18 (2013-05-01)}{ \itemize{ \item Various minor adjustments, many of them to fulfill CRAN programming standards. } } \section{Changes in sn version 0.4-0 (2006-04-11)}{ Several changes and additions are included: \itemize{ \item many routines allow use of composite parameter 'dp'; \item multivariate normal and t probabilities are now computed by 'mnormt'; \item use of NAMESPACE introduced; \item some more routines introduced, eg. st.cumulants.inversion; \item various fixes/improvements in documentation. } } \section{Changes in sn version 0.3-5 (2006-01-16)}{ \itemize{ \item Added some new functions (these include msn.affine, sn.mmle, sn.Einfo, sn.mle.grouped), fix various errors, and other improvements (eg. improved pst). } } \section{Changes in sn version 0.3-0 (2002-06-15)}{ \itemize{ \item The main change is the addition of routines for (multivariate) skew-t distribution; also some other routines, e.g. mle for grouped data } } \section{Changes in sn version 0.2-2 (2002-01-05)}{ \itemize{ \item Fix error in sn.dev.gh, improved qsn } } \section{Changes in sn version 0.2-0 (1998-10-31)}{ \itemize{ \item This is the first public release and distribution, originally from \url{http://azzalini.stat.unipd.it} in October 1998, shortly afterwards from \acronym{CRAN}. } } sn/build/0000755000176200001440000000000015147260260011774 5ustar liggesuserssn/build/vignette.rds0000644000176200001440000000050715147260260014335 0ustar liggesusersmRMk@]hPH{h"B?(Nt1 nbCvf7oG①Ϸ?G~ xyddi%f,ڡf5;T;y6irX4bąQ_zj09 L_  j(.?d\j3PaŽ (`eѣlPO'nЯ/\HAxL<[LkWltxGWmAStOq)OeCz f({G̥QW