ordinal/0000755000176200001440000000000015130436352011704 5ustar liggesusersordinal/tests/0000755000176200001440000000000015125475162013054 5ustar liggesusersordinal/tests/test.clm.predict.R0000644000176200001440000001376615125475162016376 0ustar liggesuserslibrary(ordinal) ## source("test.clm.predict.R") ## library(devtools) ## r2path <- "/Users/rhbc/Documents/Rpackages/ordinal/pkg/ordinal" ## clean_dll(pkg = r2path) ## load_all(r2path) cy <- with(wine, which(temp == "cold" & contact == "yes")) options("contrasts" = c("contr.treatment", "contr.poly")) getOption("contrasts") ## Example model wine1.clm <- clm(rating ~ temp*contact, subset = -cy, data = wine) summary(wine1.clm) names(wine1.clm) wine.clm <- clm(rating~temp*contact, data=wine) summary(wine.clm) names(wine.clm) ## Make sure the same elements are present with a rank deficient model ## fit: stopifnot(all(names(wine1.clm) == names(wine.clm))) ## With treatment contrasts: options("contrasts" = c("contr.treatment", "contr.poly")) wine.clm <- clm(rating~temp*contact, data=wine) coef(summary(wine.clm)) head(model.matrix(wine.clm)$X) wine.clm$contrasts head(pred1 <- predict(wine.clm)$fit) ## With sum contrasts: options("contrasts" = c("contr.sum", "contr.poly")) wine.clm <- clm(rating~temp*contact, data=wine) coef(summary(wine.clm)) head(model.matrix(wine.clm)$X) wine.clm$contrasts head(pred2 <- predict(wine.clm)$fit) ## Mixture of sum and treatment contrasts: options("contrasts" = c("contr.treatment", "contr.poly")) wine.clm <- clm(rating~temp*contact, data=wine, contrasts=list(temp="contr.sum")) coef(summary(wine.clm)) head(model.matrix(wine.clm)$X) wine.clm$contrasts head(pred3 <- predict(wine.clm)$fit) stopifnot(isTRUE(all.equal(pred1, pred2))) stopifnot(isTRUE(all.equal(pred1, pred3))) ################################# ### Now for a rank deficient fit: ################################# cy <- with(wine, which(temp == "cold" & contact == "yes")) options("contrasts" = c("contr.treatment", "contr.poly")) wine1.clm <- clm(rating ~ temp*contact, subset = -cy, data = wine) coef(summary(wine1.clm)) attributes(model.matrix(wine1.clm)$X)$contrasts wine1.clm$contrasts head(pred4 <- predict(wine1.clm)$fit) options("contrasts" = c("contr.sum", "contr.poly")) wine1.clm <- clm(rating ~ temp*contact, subset = -cy, data = wine) attributes(model.matrix(wine1.clm)$X)$contrasts options("contrasts" = c("contr.treatment", "contr.poly")) attributes(model.matrix(wine1.clm)$X)$contrasts ## Notice that the contrasts change in the attributes of the fit!!! coef(summary(wine1.clm)) wine1.clm$contrasts head(pred5 <- predict(wine1.clm)$fit) head(cbind(pred4, pred5)) stopifnot(isTRUE(all.equal(pred4, pred5))) options("contrasts" = c("contr.treatment", "contr.poly")) wine1.clm <- clm(rating ~ temp*contact, subset = -cy, data = wine, contrasts=list(temp="contr.sum")) coef(summary(wine1.clm)) head(model.matrix(wine1.clm)$X) attributes(model.matrix(wine1.clm)$X)$contrasts wine1.clm$contrasts head(pred6 <- predict(wine1.clm)$fit) head(cbind(pred4, pred5, pred6)) stopifnot(isTRUE(all.equal(pred4, pred6))) ################################################################## ## Compare equality of fitted values for models with different contrasts: options("contrasts" = c("contr.treatment", "contr.poly")) fm1 <- clm(rating ~ temp + contact, data=wine) fitted(fm1) options("contrasts" = c("contr.sum", "contr.poly")) fm2 <- clm(rating ~ temp + contact, data=wine) fitted(fm2) options("contrasts" = c("contr.treatment", "contr.poly")) fm3 <- clm(rating ~ temp + contact, data=wine, contrasts=list(contact="contr.sum")) fitted(fm3) stopifnot(isTRUE(all.equal(fitted(fm1), fitted(fm2)))) stopifnot(isTRUE(all.equal(fitted(fm1), fitted(fm3)))) ################################################################## ## Compare equality of fitted values for models with different ## contrasts in face of aliased coefficients: options("contrasts" = c("contr.treatment", "contr.poly")) cy <- with(wine, which(temp == "cold" & contact == "yes")) Wine <- subset(wine, subset=!(temp == "cold" & contact == "yes")) fm1 <- clm(rating ~ temp + contact, data=Wine) options("contrasts" = c("contr.sum", "contr.poly")) fm2 <- clm(rating ~ temp + contact, data=Wine) options("contrasts" = c("contr.treatment", "contr.poly")) fm3 <- clm(rating ~ temp + contact, data=Wine, contrasts=list(contact="contr.sum")) stopifnot(isTRUE(all.equal(fitted(fm1), fitted(fm2)))) stopifnot(isTRUE(all.equal(fitted(fm1), fitted(fm3)))) stopifnot(isTRUE(all.equal(predict(fm1)$fit, predict(fm2)$fit))) stopifnot(isTRUE(all.equal(predict(fm1)$fit, predict(fm3)$fit))) ################################# ## Does this also happen if the wine data has changed? options("contrasts" = c("contr.treatment", "contr.poly")) Wine <- subset(wine, subset=!(temp == "cold" & contact == "yes")) fm1 <- clm(rating ~ temp + contact, data=Wine) fit1 <- fitted(fm1) pred1 <- predict(fm1)$fit Wine <- wine pred2 <- predict(fm1)$fit stopifnot(isTRUE(all.equal(fit1, pred1))) stopifnot(isTRUE(all.equal(fit1, pred2))) ## What if weights, say, is an expression? ## Notice that updating the model object changes it: set.seed(123) fm1 <- clm(rating ~ temp + contact, data=wine, weights=runif(nrow(wine), .5, 1.5)) fm2 <- update(fm1) stopifnot(isTRUE(all.equal(fitted(fm1), predict(fm1)$fit))) stopifnot(!isTRUE(all.equal(fitted(fm1), fitted(fm2)))) ################################# ## Test equality of fits and predictions of models with: ## 'x + I(x^2)' and 'poly(x, 2)': ## December 25th 2014, RHBC. data(wine) set.seed(1) x <- rnorm(nrow(wine), sd=2) + as.numeric(wine$rating) range(x) ## Comparison of 'x + I(x^2)' and 'poly(x, 2)': fm3 <- clm(rating ~ temp + x + I(x^2), data=wine) fm4 <- clm(rating ~ temp + poly(x, 2), data=wine) ## Same model fits, but different parameterizations: stopifnot( !isTRUE(all.equal(coef(fm3), coef(fm4), check.names=FALSE)) ) stopifnot(isTRUE(all.equal(logLik(fm3), logLik(fm4)))) newData <- expand.grid(temp = levels(wine$temp), x=seq(-1, 7, 3)) predict(fm3, newdata=newData)$fit predict(fm4, newdata=newData)$fit stopifnot(isTRUE(all.equal(fitted(fm3), fitted(fm4)))) stopifnot(isTRUE( all.equal(predict(fm3, newdata=newData)$fit, predict(fm4, newdata=newData)$fit))) ################################# ordinal/tests/clm.formula.R0000644000176200001440000001126415125475162015422 0ustar liggesuserslibrary(ordinal) ## library(devtools) ## r2path <- "/Users/rhbc/Documents/Rpackages/ordinal/pkg/ordinal" ## clean_dll(pkg = r2path) ## load_all(r2path) ################################# ## Appropriate evaluation of formulas: ## These fail and give appropriate error messages: ## fm1 <- clm(rating ~ contact, scale=temp, data=wine) ## fm1 <- clm(rating ~ contact, scale=~Temp, data=wine) ## fm1 <- clm(rating ~ contact, scale="temp", data=wine) ## sca <- "temp" ## fm1 <- clm(rating ~ contact, scale=sca, data=wine) ## sca <- as.formula(sca) ## sca <- as.formula(temp) ## sca <- with(wine, as.formula(temp)) ## These all work as intended with no warnings or errors: fm1 <- clm(rating ~ contact, scale="~temp", data=wine) fm1 <- clm(rating ~ contact, scale=~temp, data=wine) sca <- "~temp" fm1 <- clm(rating ~ contact, scale=sca, data=wine) sca <- as.formula("~temp") fm1 <- clm(rating ~ contact, scale=sca, data=wine) fm1 <- clm(rating ~ contact, scale=as.formula(~temp), data=wine) fm1 <- clm(rating ~ contact, scale=as.formula("~temp"), data=wine) ################################# ## can evaluate if 'formula' is a character: f <- "rating ~ contact + temp" clm(f, data=wine) clm(as.formula(f), data=wine) ################################# ### finding variables in the environment of the formula: makeform <- function() { f1 <- as.formula(rating ~ temp + contact) rating <- wine$rating temp <- wine$temp contact <- wine$contact f1 } ## 'makeform' makes are formula object in the environment of the ## function makeform: f1 <- makeform() f1 # print class(f1) ## If we give the data, we can evaluate the model: fm1 <- clm(f1, data=wine) ## We can also evaluate the model because the data are available in ## the environment associated with the formula: fm1 <- clm(f1) ## For instance, the 'rating' variable is not found in the Global ## environment; we have to evaluate the 'name' of 'rating' in the ## appropriate environment: (try(rating, silent=TRUE)) eval(as.name("rating"), envir=environment(f1)) ## If instead we generate the formula in the Global environment where ## the variables are not found, we cannot evaluate the model: f2 <- as.formula(rating ~ temp + contact) (try(fm2 <- clm(f2), silent=TRUE)) environment(f2) <- environment(f1) fm2 <- clm(f2) ################################# ## Use of formula-objects in location, scale and nominal: ## Bug-report from Lluís Marco Almagro ## 5 May 2010 17:58 f <- formula(rating ~ temp) fs <- formula( ~ contact) m2 <- clm(f, scale = fs, data = wine) summary(m2) ################################# ## Other ways to construct formulas: set.seed(12345) y <- factor(sample(1:4,20,replace=TRUE)) x <- rnorm(20) data <- data.frame(y=y,x=x) rm(x, y) fit <- clm(data$y ~ data$x) fit fit <- clm(data[,1] ~ data[,2]) fit ## This previously failed, but now works: fit <- clm(data$y ~ data$x, ~data$x) fit ################################# ## Evaluation within other functions: ## date: January 18th 2012. ## ## The problem was raised by Stefan Herzog (stefan.herzog@unibas.ch) ## January 12th 2012 in trying to make clm work with glmulti. fun.clm <- function(formula, data) ### This only works because clm via eclm.model.frame is careful to ### evaluate the 'formula' in the parent environment such it is not the ### character "formula" that is attempted evaluated. clm(formula, data = data) fun2.clm <- function(formula, data, weights, subset) { ### This should be the safe way to ensure evaluation of clm in the ### right environment. mc <- match.call() mc[[1]] <- as.name("clm") eval.parent(mc) } fun.clm(rating ~ temp + contact, data=wine) ## works fun2.clm(rating ~ temp + contact, data=wine) ## works form1 <- "rating ~ temp + contact" fun.clm(form1, data=wine) ## works fun2.clm(form1, data=wine) ## works form2 <- formula(rating ~ temp + contact) fun.clm(form2, data=wine) ## works fun2.clm(form2, data=wine) ## works ## Notice that clm is not able to get the name of the data (wine) ## correct when using fun.clm. ################################# ## Evaluation of long formulas: no line breaking in getFullForm: data(soup, package="ordinal") rhs <- paste(names(soup)[c(3, 5:12)], collapse=" + ") Location <- as.formula(paste("SURENESS ~ ", rhs, sep=" ")) Scale <- as.formula("~ PROD") fm5 <- clm(Location, scale=Scale, data=soup) summary(fm5) ################################# ## Check that "."-notation works in formula: ## December 25th 2014, RHBC data(wine) wine2 <- wine[c("rating", "contact", "temp")] str(wine2) fm0 <- clm(rating ~ ., data=wine2) fm1 <- clm(rating ~ contact + temp, data=wine2) keep <- c("coefficients", "logLik", "info") fun <- function(x, y) stopifnot(isTRUE(all.equal(x, y))) mapply(fun, fm0[keep], fm1[keep]) ################################# ordinal/tests/test.clm.model.matrix.R0000644000176200001440000001104215125475162017330 0ustar liggesuserslibrary(ordinal) ## source("test.clm.model.matrix.R") ## library(devtools) ## r2path <- "/Users/rhbc/Documents/Rpackages/ordinal/pkg/ordinal" ## clean_dll(pkg = r2path) ## load_all(r2path) ## Check that get_clmDesign works in standard setting: fm1 <- clm(rating ~ temp, scale=~contact, nominal=~contact, data=wine) contr <- c(fm1$contrasts, fm1$S.contrasts, fm1$nom.contrasts) XX <- ordinal:::get_clmDesign(fm1$model, terms(fm1, "all"), contrasts=contr) XX2 <- update(fm1, method="design") (keep <- intersect(names(XX), names(XX2))) (test <- mapply(function(x, y) isTRUE(all.equal(x, y)), XX[keep], XX2[keep])) stopifnot(all(test)) ## Check that get_clmDesign works with singular fit and NAs: cy <- with(wine, which(temp == "cold" & contact == "yes")) wine2 <- subset(wine, subset=(!1:nrow(wine) %in% cy)) wine2[c(9, 15, 46), "rating"] <- NA fm1 <- clm(rating ~ temp, scale=~contact, nominal=~contact, data=wine2) contr <- c(fm1$contrasts, fm1$S.contrasts, fm1$nom.contrasts) XX <- ordinal:::get_clmDesign(fm1$model, terms(fm1, "all"), contrasts=contr) XX2 <- update(fm1, method="design") (keep <- intersect(names(XX), names(XX2))) (test <- mapply(function(x, y) isTRUE(all.equal(x, y)), XX[keep], XX2[keep])) stopifnot(all(test)) ## In this situation update and get_clmRho give the same results: wine2 <- wine fm1 <- clm(rating ~ temp + contact, data=wine2) ## OK rho1 <- ordinal:::get_clmRho.clm(fm1) l1 <- as.list(rho1) l2 <- as.list(update(fm1, doFit=FALSE)) (test <- mapply(function(x, y) isTRUE(all.equal(x, y)), l1, l2[names(l1)])) stopifnot(all(test)) ## If we modify the data (or other subset, weights, formulae, etc.) ## used in the model call, the results from update no longer correspond ## to the elements of the fitted model object. get_clmRho gets it ## right on the other hand: wine2[10:13, "rating"] <- NA l3 <- as.list(ordinal:::get_clmRho.clm(fm1)) l4 <- as.list(update(fm1, doFit=FALSE)) (test <- mapply(function(x, y) isTRUE(all.equal(x, y)), l1, l3)) stopifnot(all(test)) ## same (test <- mapply(function(x, y) isTRUE(all.equal(x, y)), l3, l4[names(l3)])) stopifnot(sum(!test) == 8) ## not all the same anymore! ## In conclusion l1, l2, and l3 are identical. l4 is different. ################################# ## Test that checkContrasts give appropriate warnings: contr <- c(temp="contr.sum", contact="contr.sum") fm1 <- clm(rating ~ temp + contact, scale=~contact, data=wine) ## OK fm1 <- clm(rating ~ temp + contact, scale=~contact, data=wine, contrasts=contr) ## OK fm1 <- clm(rating ~ temp, scale=~contact, data=wine, contrasts=contr) ## OK ## These should give warnings: fm1 <- clm(rating ~ temp, contrasts=c(contact="contr.sum"), data=wine) fm1 <- clm(rating ~ temp, contrasts=contr, data=wine) fm1 <- clm(rating ~ 1, scale=~contact, contrasts=c(temp="contr.sum"), data=wine) fm1 <- clm(rating ~ 1, scale=~contact, contrasts=list(temp="contr.sum"), data=wine) fm0 <- clm(rating ~ temp + contact, scale=~contact, data=wine) ordinal:::checkContrasts(fm0$S.terms, fm0$contrasts) ordinal:::checkContrasts(fm0$S.terms, fm0$S.contrasts) ordinal:::checkContrasts(fm0$terms, fm0$contrasts) ordinal:::checkContrasts(fm0$terms, fm0$S.contrasts) ################################# ## Check that clm and model.matrix respects contrast settings: options("contrasts" = c("contr.treatment", "contr.poly")) fm0 <- clm(rating ~ temp + contact, data=wine) options("contrasts" = c("contr.sum", "contr.poly")) fm1 <- clm(rating ~ temp + contact, data=wine) stopifnot(all(model.matrix(fm0)$X[, 2] %in% c(0, 1))) stopifnot(all(model.matrix(fm1)$X[, 2] %in% c(1, -1))) ################################# ## Check that model.matrix results do not depend on global contrast ## setting: options("contrasts" = c("contr.sum", "contr.poly")) fm0 <- clm(rating ~ temp + contact, scale=~contact, data=wine) MM <- model.matrix(fm0) options("contrasts" = c("contr.treatment", "contr.poly")) MM2 <- model.matrix(fm0) for(x in MM) print(head(x)) for(x in MM2) print(head(x)) stopifnot(all(mapply(all.equal, MM, MM2))) ################################# ## This gave a warning before getContrasts was implemented: fm0 <- clm(rating ~ temp + contact, scale=~contact, data=wine) MM <- model.matrix(fm0) ## > fm0 <- clm(rating ~ temp + contact, scale=~contact, data=wine) ## > MM <- model.matrix(fm0) ## Warning message: ## In model.matrix.default(res$S.terms, data = fullmf, contrasts.arg = getContrasts(res$S.terms, : ## variable 'temp' is absent, its contrast will be ignored for(x in MM) print(head(x)) ordinal/tests/test.sign.R0000644000176200001440000000610315125475162015115 0ustar liggesusers# test.sign.R # Test the use of sign.location and sign.nominal in clm.control(): library(ordinal) fm1 <- clm(rating ~ temp + contact, data=wine) fm2 <- clm(rating ~ temp + contact, data=wine, sign.location="positive") # dput(names(fm1)) keep <- c("aliased", "alpha", "cond.H", "contrasts", "convergence", "df.residual", "edf", "fitted.values", "formula", "formulas", "gradient", "info", "link", "logLik", "maxGradient", "message", "model", "n", "niter", "nobs", "start", "terms", "Theta", "threshold", "tJac", "xlevels", "y", "y.levels") check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep]) stopifnot(all(check)) stopifnot(isTRUE(all.equal( fm1$beta, - fm2$beta ))) fm1 <- clm(rating ~ temp, nominal=~ contact, data=wine) fm2 <- clm(rating ~ temp, nominal=~ contact, data=wine, sign.nominal="negative") keep <- c("aliased", "beta", "cond.H", "contrasts", "convergence", "df.residual", "edf", "fitted.values", "formula", "formulas", "gradient", "info", "link", "logLik", "maxGradient", "message", "model", "n", "niter", "nobs", "start", "terms", "Theta", "threshold", "tJac", "xlevels", "y", "y.levels") # check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1, fm2) check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep]) stopifnot(all(check)) stopifnot(isTRUE(all.equal( fm1$alpha[5:8], -fm2$alpha[5:8] ))) fm1 <- clm(rating ~ temp, nominal=~ contact, data=wine) fm2 <- clm(rating ~ temp, nominal=~ contact, data=wine, sign.nominal="negative", sign.location="positive") keep <- c("aliased", "cond.H", "contrasts", "convergence", "df.residual", "edf", "fitted.values", "formula", "formulas", "gradient", "info", "link", "logLik", "maxGradient", "message", "model", "n", "niter", "nobs", "start", "terms", "Theta", "threshold", "tJac", "xlevels", "y", "y.levels") # check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1, fm2) check <- mapply(function(x, y) isTRUE(all.equal(x, y)), fm1[keep], fm2[keep]) stopifnot(all(check)) stopifnot( isTRUE(all.equal(fm1$alpha[5:8], -fm2$alpha[5:8])), isTRUE(all.equal(fm1$beta, -fm2$beta)) ) # Check predict method: newData <- with(wine, expand.grid(temp=levels(temp), contact=levels(contact))) (p1 <- predict(fm1, newdata=newData)) (p2 <- predict(fm2, newdata=newData)) stopifnot(isTRUE(all.equal(p1, p2))) stopifnot(isTRUE( all.equal(predict(fm1, newdata=wine, se=TRUE, interval=TRUE), predict(fm2, newdata=wine, se=TRUE, interval=TRUE)) )) # Check profile and confint methods: confint.default(fm1) confint.default(fm2) stopifnot( isTRUE(all.equal(confint(fm1), -confint(fm2)[, 2:1, drop=FALSE], check.attributes=FALSE)) ) fm1 <- clm(rating ~ temp + contact, data=wine) fm2 <- clm(rating ~ temp + contact, data=wine, sign.location="positive") pr1 <- profile(fm1) pr2 <- profile(fm2) stopifnot( isTRUE(all.equal(confint(fm1), - confint(fm2)[, 2:1], check.attributes=FALSE)) ) ordinal/tests/testCLM.R0000644000176200001440000002021015125475162014505 0ustar liggesuserslibrary(ordinal) options(contrasts = c("contr.treatment", "contr.poly")) ## library(devtools) ## r2path <- "/Users/rhbc/Documents/Rpackages/ordinal/pkg/ordinal" ## clean_dll(pkg = r2path) ## load_all(r2path) ## More manageable data set: data(soup, package="ordinal") (tab26 <- with(soup, table("Product" = PROD, "Response" = SURENESS))) dimnames(tab26)[[2]] <- c("Sure", "Not Sure", "Guess", "Guess", "Not Sure", "Sure") dat26 <- expand.grid(sureness = as.factor(1:6), prod = c("Ref", "Test")) dat26$wghts <- c(t(tab26)) m1 <- clm(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logit") ## print, summary, vcov, logLik, AIC: m1 summary(m1) vcov(m1) logLik(m1) ll.m1 <- structure(-2687.74456343981, df = 7L, nobs = 1847, class = "logLik") stopifnot(all.equal(logLik(m1), ll.m1)) AIC(m1) coef(m1) cm1 <- c(-1.49125702755587, -0.45218462707814, -0.107208315524318, 0.163365282774162, 0.88291347877514, 1.29587762626394, 0.147986162902775) stopifnot(all.equal(as.vector(coef(m1)), cm1)) coef(summary(m1)) csm1 <- structure(c(-1.49125702755587, -0.45218462707814, -0.107208315524318, 0.163365282774162, 0.88291347877514, 1.29587762626394, 0.147986162902775, 0.0921506468161812, 0.0718240681909781, 0.069954084652323, 0.0702546879687391, 0.0795708692869622, 0.119032405993894, 0.065104213008022, -16.1828167145758, -6.2957256316336, -1.53255261729392, 2.32532927691394, 11.0959385851501, 10.8867632762999, 2.27306584421104, 6.66732036748908e-59, 3.05965144996025e-10, 0.125386123756898, 0.0200543599621069, 1.31274723412040e-28, 1.33293711602276e-27, 0.0230222123418036), .Dim = c(7L, 4L), .Dimnames = list( c("1|2", "2|3", "3|4", "4|5", "5|6", "prodTest", "prodTest" ), c("Estimate", "Std. Error", "z value", "Pr(>|z|)"))) stopifnot(all.equal(coef(summary(m1)), csm1)) ## link functions: m2 <- update(m1, link = "probit") m3 <- update(m1, link = "cloglog") m4 <- update(m1, link = "loglog") m5 <- update(m1, link = "cauchit", start = coef(m1)) ## m6 <- update(m1, link = "Aranda-Ordaz", lambda = 1) ## m7 <- update(m1, link = "Aranda-Ordaz") ## m8 <- update(m1, link = "log-gamma", lambda = 1) ## m9 <- update(m1, link = "log-gamma") ## nominal effects: mN1 <- clm(sureness ~ 1, nominal = ~ prod, data = dat26, weights = wghts) anova(m1, mN1) ## optimizer / method: update(m1, scale = ~ 1, method = "Newton") update(m1, scale = ~ 1, method = "ucminf") update(m1, scale = ~ 1, method = "nlminb") update(m1, scale = ~ 1, method = "optim") update(m1, scale = ~ 1, method = "model.frame") update(m1, ~.-prod, scale = ~ 1, nominal = ~ prod, method = "model.frame") ## threshold functions mT1 <- update(m1, threshold = "symmetric") mT2 <- update(m1, threshold = "equidistant") anova(m1, mT1, mT2) ## Extend example from polr in package MASS: ## Fit model from polr example: if(require(MASS)) { fm1 <- clm(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) fm1 summary(fm1) ## With probit link: summary(update(fm1, link = "probit")) ## Allow scale to depend on Cont-variable summary(fm2 <- update(fm1, scale =~ Cont)) summary(fm3 <- update(fm1, location =~.-Cont, nominal =~ Cont)) summary(fm4 <- update(fm2, location =~.-Cont, nominal =~ Cont)) anova(fm1, fm2, fm3, fm4) ## which seems to improve the fit } ################################# ## Better handling of ill-defined variance-covariance matrix of the ## parameters in summary methods for clm and clmm objects: dat26.2 <- data.frame(sureness = as.factor(1:12), prod = rep(c("One", "Two", "Three"),each=4)) fm1 <- clm(sureness ~ prod, ~prod, data = dat26.2) fm1 summary(fm1) summary(fm1, corr = 1) ## fm1$Hessian ## sl1 <- slice(fm1, 13) ## fitted(fm1) ## convergence(fm1) ## eigen(fm1$Hessian)$values ## sqrt(diag(solve(fm1$Hessian))) ## sqrt(diag(ginv(fm1$Hessian))) ################################# ## Missing values: ## Bug-report from Jonathan Williams ## , 18 March 2010 12:42 data(soup, package = "ordinal") soup$SURENESS[10] <- NA c1a <- clm(ordered(SURENESS)~PROD, data=soup); summary(c1a) c2a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup) summary(c2a) c3a <- clm(ordered(SURENESS)~1, scale = ~PROD, data=soup) summary(c3a) data(soup, package = "ordinal") soup$PROD[1] <- NA c1a <- clm(ordered(SURENESS)~PROD, data=soup) summary(c1a) c2a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup) summary(c2a) c3a <- clm(ordered(SURENESS)~1, scale = ~PROD, data=soup) summary(c3a) soup$SURENESS[10] <- NA c1a <- clm(ordered(SURENESS)~PROD, data=soup) summary(c1a) c2a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup) summary(c2a) c3a <- clm(ordered(SURENESS)~1, scale = ~PROD, data=soup) summary(c3a) ## na.actions: c4a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup, na.action=na.omit) summary(c4a) tC1 <- try(clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup, na.action=na.fail), silent = TRUE) stopifnot(inherits(tC1, "try-error")) c4a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup, na.action=na.exclude) summary(c4a) tC2 <- try(clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup, na.action=na.pass), silent = TRUE) stopifnot(inherits(tC2, "try-error")) ## Subset: data(soup, package="ordinal") c4a <- clm(ordered(SURENESS)~PROD, scale = ~PROD, data=soup, subset = 1:100) c4a <- clm(ordered(SURENESS)~1, scale = ~PROD, data=soup, subset = 1:100) c4a <- clm(ordered(SURENESS)~PROD, data=soup, subset = 1:100) c4a <- clm(ordered(SURENESS)~1, data=soup, subset = 1:100) ## Offset: data(soup, package = "ordinal") set.seed(290980) offs <- runif(nrow(soup)) c4a <- clm(ordered(SURENESS)~PROD + offset(offs), scale = ~PROD, data=soup, subset = 1:100) summary(c4a) c4a <- clm(ordered(SURENESS)~PROD + offset(offs), scale = ~PROD + offset(offs), data=soup, subset = 1:100) summary(c4a) off2 <- offs c4a <- clm(ordered(SURENESS)~PROD + offset(offs), scale = ~PROD + offset(off2), data=soup, subset = 1:100) summary(c4a) c4a <- clm(ordered(SURENESS)~PROD, scale = ~PROD + offset(offs), data=soup, subset = 1:100) summary(c4a) ## data as matrix: dat26M <- as.matrix(dat26) m1 <- clm(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logit") summary(m1) ## data in enclosing environment: attach(soup) m1 <- clm(SURENESS ~ PROD, scale = ~PROD) summary(m1) detach(soup) ################################################################## ### Parameter estimates were not correct with large scale effects due ### to end cut-points being \pm 100. This is not enough for ### location-scale model, but seems to be for location only models. ### Bug report from Ioannis Kosmidis : ### A 2x3 contigency table that will give a large estimated value of ### zeta x <- rep(0:1, each = 3) response <- factor(rep(c(1, 2, 3), times = 2)) freq <- c(1, 11, 1, 13, 1, 14) totals <- rep(tapply(freq, x, sum), each = 3) Dat <- data.frame(response, x, freq) ### Fitting a cumulative link model with dispersion effects modClm <- clm(response ~ x, scale = ~ x, weights = freq, data = Dat, control = clm.control(grtol = 1e-10, convTol = 1e-10)) summary(modClm) ### The maximized log-likelihood for this saturated model should be sum(freq*log(freq/totals)) # > sum(freq*log(freq/totals)) # [1] -29.97808 ### but apparently clm fails to maximixe the log-likelihood modClm$logLik # > modClm$logLik # [1] -30.44452 stopifnot(isTRUE(all.equal(sum(freq*log(freq/totals)), modClm$logLik))) ### The estimates reported by clm are coef(modClm) coef.res <- structure(c(-2.48490664104217, 2.48490665578163, 2.48490659188594, 3.54758796387530), .Names = c("1|2", "2|3", "x", "x")) stopifnot(isTRUE(all.equal(coef.res, coef(modClm)))) # > modClm$coefficients # 1|2 2|3 x x # -2.297718 2.297038 1.239023 2.834285 ### while they should be (from my own software) # 1|2 2|3 x disp.x #-2.484907 2.484907 2.484907 3.547588 convergence(modClm) ################################################################## ordinal/tests/confint.R0000755000176200001440000000344015125475162014643 0ustar liggesusers################################# ## test profile and confint methods: library(ordinal) data(wine) fm1 <- clm(rating ~ contact + temp, data = wine) summary(fm1) ## profile.clm and confint.clm: pr1 <- profile(fm1) confint(pr1) pr1 <- profile(fm1, which.beta = 1:2) confint(pr1) pr1 <- profile(fm1, which.beta = 2:1) confint(pr1) pr1 <- profile(fm1, which.beta = 1) confint(pr1) pr1 <- profile(fm1, which.beta = 2) confint(pr1) pr1 <- try(profile(fm1, which.beta = 0), silent = TRUE) ## error pr1 <- try(profile(fm1, which.beta = "no.par"), silent = TRUE) ## error pr1 <- try(profile(fm1, which.beta = -1), silent = TRUE) ## error pr1 <- profile(fm1, which.beta = "tempwarm") confint(pr1) pr1 <- profile(fm1, alpha = 0.1) confint(pr1) ## should give NA in this case? pr1 <- profile(fm1, max.steps = 9) pr1 <- profile(fm1, step.warn = 7) pr1 <- profile(fm1, nsteps = 6) pr1 <- profile(fm1, trace = 1) pr1 <- profile(fm1, control = list(gradTol = .1)) confint(pr1) ## not at all unreliable... ## single regression coef setting: fm2 <- clm(rating ~ contact, data = wine) summary(fm2) pr2 <- profile(fm2) confint(pr2) ## confint.clm: confint(fm1) confint(fm1, 2) confint(fm1, 1) confint(fm1, "tempwarm") confint(fm1, type = "profile") confint(fm1, type = "Wald") confint(fm1, 2, type = "Wald") confint(fm1, level = 0.5) confint(fm1, level = 1 - 1e-6) confint(fm1, level = 1 - 1e-10) ## extreme, but it works confint(fm1, trace = 1) ## plot.profile: pr1 <- profile(fm1, which.beta=1:2, alpha = 1e-3) par(mfrow = c(1,2)) plot(pr1) plot(pr1, 1) plot(pr1, "contactyes") plot(pr1, level = .97) plot(pr1, Log = TRUE) plot(pr1, relative = FALSE) plot(pr1, root = TRUE) plot(pr1, approx = TRUE) plot(pr1, n=10) plot(pr1, ylim = c(0,2)) plot(pr1, las = 1) plot(pr2) ordinal/tests/anova.R0000755000176200001440000000111215125475162014301 0ustar liggesuserslibrary(ordinal) data(wine) fm1 <- clm(rating ~ temp, data=wine) fmm1 <- clmm(rating ~ temp + (1|judge), data=wine) ## These now give identical printed results: ## Previously the printed model names were messed up when anova.clmm ## were called. anova(fm1, fmm1) anova(fmm1, fm1) ## Testing if 'test' and 'type' arguments are ignored properly: fm1 <- clm(rating ~ temp + contact, data=wine) fm2 <- clm(rating ~ temp, data=wine) anova(fm1, fm2, test="Chi") anova(fm1, fm2, type="Chi") anova(fm1, fm2) ## calling anova.clmm anova(fmm1, fm1, test="Chi") anova(fmm1, fm1, type="Chi") ordinal/tests/test.clm.Theta.R0000644000176200001440000001201015125475162015766 0ustar liggesuserslibrary(ordinal) ################################# ## 1 categorical variable in nominal: fm <- clm(rating ~ temp, nominal=~contact, data=wine) fm$Theta fm$alpha.mat ## Threshold effects: fm <- clm(rating ~ temp, nominal=~contact, data=wine, threshold="symmetric") fm$Theta fm$alpha.mat fm <- clm(rating ~ temp, nominal=~contact, data=wine, threshold="equidistant") fm$Theta fm$alpha.mat ## Singular fit is still ok (with a warning, though) fm <- clm(rating ~ contact, nominal=~temp, data=wine) fm$alpha.mat fm$Theta ################################# ## 1 continuous variable: set.seed(123) x <- rnorm(nrow(wine), sd=1) fm <- clm(rating ~ temp, nominal=~ x, data=wine) fm$alpha.mat fm$Theta fm <- clm(rating ~ temp, nominal=~ poly(x, 2), data=wine) fm$alpha.mat fm$Theta ################################# ## 1 categorical + 1 continuous variable: set.seed(123) x <- rnorm(nrow(wine), sd=1) fm <- clm(rating ~ temp, nominal=~contact + x, data=wine) fm$alpha.mat fm$Theta fm <- clm(rating ~ temp, nominal=~contact + x, data=wine, threshold="symmetric") fm$alpha.mat fm$Theta ################################# ### NOTE: To get the by-threshold nominal effects of continuous terms ## use: with(fm, t(apply(alpha.mat, 1, function(th) tJac %*% th))) ################################# ## Interactions: fm <- clm(rating ~ temp, nominal=~contact:x, data=wine) fm$alpha.mat fm$Theta fm <- clm(rating ~ temp, nominal=~contact+x+contact:x, data=wine) fm$alpha.mat fm$Theta fm <- clm(rating ~ temp, nominal=~contact*x, data=wine) fm$alpha.mat fm$Theta ## polynomial terms: fm <- clm(rating ~ temp, nominal=~contact + poly(x, 2), data=wine) fm$alpha.mat fm$Theta ## logical variables: (treated like numeric variables) wine$Con <- as.character(wine$contact) == "yes" fm <- clm(rating ~ temp, nominal=~Con, data=wine) fm$Theta fm$alpha.mat wine$Con.num <- 1 * wine$Con fm <- clm(rating ~ temp, nominal=~Con.num, data=wine) fm$Theta fm$alpha.mat ################################# ## Two continuous variables: set.seed(321) y <- rnorm(nrow(wine), sd=1) fm1 <- clm(rating ~ temp, nominal=~y + x, data=wine) fm1$alpha.mat fm1$Theta ## summary(fm1) ################################# ## 1 categorical + 2 continuous variables: fm1 <- clm(rating ~ temp, nominal=~y + contact + x, data=wine) fm1$alpha.mat fm1$Theta fm1 <- clm(rating ~ temp, nominal=~contact + x + contact:x + y, data=wine) summary(fm1) fm1$Theta fm1$alpha.mat fm1 <- clm(rating ~ temp, nominal=~contact*x + y, data=wine) fm1$Theta fm1$alpha.mat t(fm1$alpha.mat) fm1 ################################# ## ordered factors (behaves like numerical variables): data(soup, package="ordinal") fm2 <- clm(SURENESS ~ 1, nominal=~PRODID + DAY, data=soup) fm2$Theta fm2$alpha.mat prodid <- factor(soup$PRODID, ordered=TRUE) fm2 <- clm(SURENESS ~ 1, nominal=~prodid + DAY, data=soup) fm2$alpha.mat fm2$Theta fm2 <- clm(SURENESS ~ 1, nominal=~prodid, data=soup) fm2$alpha.mat fm2$Theta ################################# ## Aliased Coefficients: ## ## Example where the interaction in the nominal effects is aliased (by ## design). Here the two Theta matrices coincide. The alpha.mat ## matrices are similar except one has an extra row with NAs: soup2 <- soup levels(soup2$DAY) levels(soup2$GENDER) xx <- with(soup2, DAY == "2" & GENDER == "Female") ## Model with additive nominal effects: fm8 <- clm(SURENESS ~ PRODID, nominal= ~ DAY + GENDER, data=soup2, subset=!xx) fm8$alpha.mat fm8$Theta ## Model with non-additive, but aliased nominal effects: fm9 <- clm(SURENESS ~ PRODID, nominal= ~ DAY * GENDER, data=soup2, subset=!xx) fm9$alpha.mat fm9$Theta stopEqual <- function(x, y, ca=FALSE) stopifnot(isTRUE(all.equal(x, y, check.attributes=ca))) stopEqual(fm8$alpha.mat, fm9$alpha.mat[1:3, ]) stopEqual(fm8$Theta, fm9$Theta) stopEqual(logLik(fm8), logLik(fm9)) ################################# ## Weights: set.seed(12345) wts <- runif(nrow(soup)) fm2 <- clm(SURENESS ~ 1, nominal=~SOUPTYPE + DAY, data=soup, weights=wts) fm2$Theta ## Offset (correctly gives and error) fm2 <- try(clm(SURENESS ~ 1, nominal=~SOUPTYPE + DAY + offset(wts), data=soup), silent=TRUE) stopifnot(inherits(fm2, "try-error")) ################################# ### Other (misc) examples: fm2 <- clm(SURENESS ~ 1, nominal=~SOUPTYPE + DAY, data=soup) fm2$Theta fm2 fm2 <- clm(SURENESS ~ 1, nominal=~SOUPTYPE * DAY, data=soup) fm2$Theta fm2 fm2$alpha.mat fm2 <- clm(SURENESS ~ 1, nominal=~SOUPTYPE * DAY, data=soup, threshold="symmetric") fm2$Theta fm2$alpha.mat ################################# ### Check correctness of Theta matrix when intercept is removed in ### nominal formula: ### December 25th 2014, RHBC fm1 <- clm(rating ~ temp, nominal=~contact-1, data=wine) fm2 <- clm(rating ~ temp, nominal=~contact, data=wine) stopifnot(isTRUE(all.equal(fm1$Theta, fm2$Theta))) stopifnot(isTRUE(all.equal(fm1$logLik, fm2$logLik))) wine2 <- wine wine2$contact <- relevel(wine2$contact, "yes") fm3 <- clm(rating ~ temp, nominal=~contact, data=wine2) stopifnot(isTRUE(all.equal(coef(fm1, na.rm=TRUE), coef(fm3)))) ################################# ordinal/tests/test.clm.flex.link.R0000644000176200001440000000523015125475162016621 0ustar liggesusers# test.clm.flex.link.R library(ordinal) fm <- clm(rating ~ contact + temp, data=wine, link="log-gamma") fm summary(fm) vcov(fm) logLik(fm) extractAIC(fm) fm2 <- update(fm, link="probit") anova(fm, fm2) head(model.matrix(fm)$X) head(model.frame(fm)) coef(fm) coef(summary(fm)) nobs(fm) terms(fm) # profile(fm) # not implemented confint(fm) predict(fm, se=TRUE, interval = TRUE) predict(fm, type="class") newData <- expand.grid(temp = c("cold", "warm"), contact = c("no", "yes")) ## Predicted probabilities in all five response categories for each of ## the four cases in newData: predict(fm, newdata=newData, type="prob") predict(fm, newdata=newData, type="class") predict(fm, newdata=newData, type="prob", se.fit = TRUE, interval = TRUE) ## Aranda-Ordaz link: fm <- clm(rating ~ contact + temp, data=wine, link="Aranda-Ordaz") fm summary(fm) vcov(fm) logLik(fm) extractAIC(fm) fm2 <- update(fm, link="logit") anova(fm, fm2) head(model.matrix(fm)$X) head(model.frame(fm)) coef(fm) coef(summary(fm)) nobs(fm) terms(fm) # profile(fm) # not implemented confint(fm) predict(fm, se=TRUE, interval = TRUE) predict(fm, type="class") newData <- expand.grid(temp = c("cold", "warm"), contact = c("no", "yes")) ## Predicted probabilities in all five response categories for each of ## the four cases in newData: predict(fm, newdata=newData, type="prob") predict(fm, newdata=newData, type="class") predict(fm, newdata=newData, type="prob", se.fit = TRUE, interval = TRUE) ######################################################################## ### Models with scale + flex link (or cauchit link) ######################################################################## fm <- clm(SURENESS ~ PRODID, scale=~PROD, data = soup, link="Aranda-Ordaz") summary(fm) fm <- clm(SURENESS ~ PRODID, scale=~PROD, data = soup, link="log-gamma") summary(fm) fm <- clm(SURENESS ~ PRODID, scale=~PROD, data = soup, link="cauchit") summary(fm) ######################################################################## ### clm.fit ######################################################################## ## Example with log-gamma: fm1 <- clm(rating ~ contact + temp, data=wine, link="log-gamma") summary(fm1) ## get the model frame containing y and X: mf1 <- update(fm1, method="design") names(mf1) res <- clm.fit(mf1$y, mf1$X, link="log-gamma") ## invoking the factor method coef(res) stopifnot(all.equal(coef(res), coef(fm1))) ## Example with Aranda-Ordaz: fm1 <- clm(rating ~ contact + temp, data=wine, link="Aranda-Ordaz") mf1 <- update(fm1, method="design") res <- clm.fit(mf1$y, mf1$X, link="Aranda") ## invoking the factor method stopifnot(all.equal(coef(res), coef(fm1))) ordinal/tests/clmm.formula.R0000755000176200001440000001231115125475162015574 0ustar liggesuserslibrary(ordinal) data(wine) ################################# ## Appropriate evaluation of formulas: ## These all work as intended with no warnings or errors: fm1 <- clmm(rating ~ contact + (1|judge), data=wine) fm1 fm1 <- clmm("rating ~ contact + (1|judge)", data=wine) fm1 fm1 <- clmm(as.formula("rating ~ contact + (1|judge)"), data=wine) fm1 fm1 <- clmm(as.formula(rating ~ contact + (1|judge)), data=wine) fm1 ################################# ### finding variables in the environment of the formula: makeform <- function() { f1 <- as.formula(rating ~ temp + contact + (1|judge)) rating <- wine$rating temp <- wine$temp contact <- wine$contact judge <- wine$judge f1 } ## 'makeform' makes are formula object in the environment of the ## function makeform: f1 <- makeform() f1 # print class(f1) ## If we give the data, we can evaluate the model: fm1 <- clmm(f1, data=wine) ## We can also evaluate the model because the data are available in ## the environment associated with the formula: fm1 <- clmm(f1) ## For instance, the 'rating' variable is not found in the Global ## environment; we have to evaluate the 'name' of 'rating' in the ## appropriate environment: (try(rating, silent=TRUE)) eval(as.name("rating"), envir=environment(f1)) ## If instead we generate the formula in the Global environment where ## the variables are not found, we cannot evaluate the model: f2 <- as.formula(rating ~ temp + contact + (1|judge)) (try(fm2 <- clmm(f2), silent=TRUE)) environment(f2) <- environment(f1) fm2 <- clmm(f2) ################################# ## Use of formula-objects f <- formula(rating ~ temp + contact + (1|judge)) m2 <- clmm(f, data = wine) summary(m2) ################################# ## Other ways to construct formulas: set.seed(12345) y <- factor(sample(1:4,20,replace=TRUE)) x <- rnorm(20) b <- gl(5, 4, labels=letters[1:5]) data <- data.frame(y=y, x=x, b=b) rm(x, y, b) clmm(y ~ x + (1|b), data=data) fit <- clmm(data$y ~ data$x + (1|data$b)) fit fit <- clmm(data[, 1] ~ data[, 2] + (1|data[, 3])) fit ################################# ## Evaluation within other functions: ## date: January 18th 2012. ## ## The problem was raised by Stefan Herzog (stefan.herzog@unibas.ch) ## January 12th 2012 in trying to make clmm work with glmulti. fun.clmm <- function(formula, data) ### This only works because clmm via eclmm.model.frame is careful to ### evaluate the 'formula' in the parent environment such it is not the ### character "formula" that is attempted evaluated. clmm(formula, data = data) fun2.clmm <- function(formula, data, weights, subset) { ### This should be the safe way to ensure evaluation of clmm in the ### right environment. mc <- match.call() mc[[1]] <- as.name("clmm") eval.parent(mc) } fun.clmm(rating ~ temp + contact + (1|judge), data=wine) ## works fun2.clmm(rating ~ temp + contact + (1|judge), data=wine) ## works form1 <- "rating ~ temp + contact + (1|judge)" fun.clmm(form1, data=wine) ## works fun2.clmm(form1, data=wine) ## works form2 <- formula(rating ~ temp + contact + (1|judge)) fun.clmm(form2, data=wine) ## works fun2.clmm(form2, data=wine) ## works ## Notice that clmm is not able to get the name of the data (wine) ## correct when using fun.clmm. ################################# ## ## Example 2: using clmm function ## # ## ## Now I want to consider judge as a random effect to account for ## ## grouping structure of data ## mod2 <- clmm(rating ~ temp + contact + (1|judge), data=wine) ## ## ##Again, I started by using my own code to run all potential models: ## ## put names of all your variables in this vector: ## vl2 <- c("temp", "contact") ## ## generate list of possible combinations of variables: ## combos2 <- NULL ## for(i in 1:length(vl2)) { ## combos2 <- c(combos2, combn(vl2, i, simplify = F)) ## } ## ## create formulae and run models one by one, saving them as model1, ## ## model2 etc... ## for (i in 1:length(combos2)) { ## vs2 <- paste(combos2[[i]], collapse=" + ") ## f2 <- formula(paste("rating ~ ", vs2, "+(1|judge)", sep="")) ## print(f2) ## assign(paste("model", i, sep=""), clmm(f2, data=wine)) ## } ## summary(model1) # etc ## summary(model2) # etc ## summary(model3) # etc ## ## models <- vector("list", length(combos2)) ## for(i in 1:length(combos2)) { ## vs2 <- paste(combos2[[i]], collapse=" + ") ## f2 <- formula(paste("rating ~ ", vs2, "+(1|judge)", sep="")) ## print(f2) ## models[[i]] <- clmm(f2, data=wine) ## ## assign(paste("model", i, sep=""), clmm(f2, data=wine)) ## } ## ## ## Coefficients, AIC and BIC: ## lapply(models, function(m) coef(summary(m))) ## lapply(models, AIC) ## lapply(models, BIC) ## ## ## library(MuMIn) ## ## dd2 <- dredge(mod2) ## does not work ## ## ?dredge ## ## traceback() ## ## mod2$formula ## ## terms(as.formula(formula(mod2))) ## ## ## ## library(lme4) ## ## fmm1 <- lmer(response ~ temp + contact + (1|judge), data=wine) ## ## fmm1 ## ## terms(as.formula(lme4:::formula(fmm1))) ## ## terms(as.formula(formula(fmm1))) ordinal/tests/test.clm.single.anova.R0000644000176200001440000000342215125475162017314 0ustar liggesusers# test.clm.single.anova.R library(ordinal) # WRE says "using if(requireNamespace("pkgname")) is preferred, if possible." # even in tests: assertError <- function(expr, ...) if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible() assertWarning <- function(expr, ...) if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible() fm <- clm(rating ~ temp * contact, scale=~contact, data=wine) anova(fm, type="I") anova(fm, type="II") anova(fm, type="III") anova(fm, type=1) anova(fm, type=2) anova(fm, type=3) anova(fm, type="1") anova(fm, type="2") anova(fm, type="3") anova(fm, type="marginal") # Nominal effects: fm <- clm(rating ~ temp, nominal=~contact, data=wine) anova(fm) # Flexible links: fm1 <- clm(rating ~ temp + contact, link="log-gamma", data=wine) anova(fm1, type=1) anova(fm1, type=2) anova(fm1, type=3) # Equivalence of tests irrespective of contrasts: fm1 <- clm(SURENESS ~ PRODID * SOUPFREQ, data=soup) # summary(fm1) (an1 <- anova(fm1, type=3)) fm2 <- clm(SURENESS ~ PRODID * SOUPFREQ, data=soup, contrasts = list(SOUPFREQ = "contr.sum", PRODID = "contr.SAS")) # summary(fm2) anova(fm1, fm2) (an2 <- anova(fm2, type=3)) stopifnot( isTRUE(all.equal(an1, an2, check.attributes=FALSE)) ) # Aliased coefficients: fm1 <- clm(SURENESS ~ PRODID * DAY, data=soup) anova(fm1, type=1) anova(fm1, type=2) anova(fm1, type=3) # Aliased term (due to nominal effects): fm <- clm(rating ~ temp * contact, nominal=~contact, data=wine) anova(fm, type=1) anova(fm, type=2) anova(fm, type=3) # model with all NA in vcov(object): fm <- clm(rating ~ temp * contact, nominal=~contact, scale=~contact, data=wine) assertError(anova(fm, type=1)) # error assertError(anova(fm, type=2)) # error assertError(anova(fm, type=3)) # error all(is.na(vcov(fm))) ordinal/tests/nominal.test.R0000644000176200001440000000413415125475162015614 0ustar liggesuserslibrary(ordinal) if(require(MASS)) { fm1 <- clm(Sat ~ Infl + Type + Cont, data=housing, weights=Freq) scale_test(fm1) nominal_test(fm1) fm2 <- update(fm1, scale=~Cont) scale_test(fm2) nominal_test(fm2) fm3 <- update(fm1, nominal=~ Cont) fm3$Theta anova(fm2, fm3) fm3$alpha.mat summary(fm3) } ################################# ### Testing nominal_test and scale_test: fm1 <- clm(rating ~ temp * contact, data=wine) ## names(fm1) fm2 <- clm(rating ~ temp * contact, data=wine, nominal=~contact) (an <- anova(fm1, fm2)) (nm <- nominal_test(fm1)) stopifnot(isTRUE(all.equal(an[2, 6], nm["contact", 5]))) fm2 <- clm(rating ~ temp * contact, data=wine, scale=~contact) (an <- anova(fm1, fm2)) (sc <- scale_test(fm1)) stopifnot(isTRUE(all.equal(an[2, 6], sc["contact", "Pr(>Chi)"]))) fm1 <- clm(rating ~ temp + contact, nominal=~temp + contact, data=wine) fm1 try(nominal_test(fm1), silent=TRUE)[1] ## gives error OK scale_test(fm1) fm1 <- clm(rating ~ temp + contact, scale=~temp + contact, data=wine) fm1 try(scale_test(fm1), silent=TRUE)[1] ## gives error OK nominal_test(fm1) ## Using weights: set.seed(123454321) wt <- runif(nrow(wine)) fm1 <- clm(rating ~ temp * contact, data=wine, weigths=wt) nominal_test(fm1) scale_test(fm1) ## No nominal test for judge since that model is not identifiable: fm1 <- clm(rating ~ judge + temp + contact, data=wine) nominal_test(fm1) scale_test(fm1) fm1 <- clm(rating ~ judge + temp, nominal=~contact, data=wine) nominal_test(fm1) summary(fm1) ## A continuous variable: set.seed(123454321) x <- rnorm(nrow(wine), sd=1) fm <- clm(rating ~ temp, nominal=~contact * x, data=wine) nominal_test(fm) scale_test(fm) fm <- clm(rating ~ temp + x, nominal=~contact, data=wine) nominal_test(fm) scale_test(fm) ## poly: fm <- clm(rating ~ temp + poly(x, 2), nominal=~contact, data=wine) nominal_test(fm) scale_test(fm) ## another combination: fm1 <- clm(SURENESS ~ PRODID + DAY + SOUPTYPE + SOUPFREQ, scale=~PROD, nominal=~ DAY*GENDER, data=soup) fm1 nominal_test(fm1) scale_test(fm1) ################################# ordinal/tests/test0weights.R0000644000176200001440000000431515125475162015634 0ustar liggesuserslibrary(ordinal) options(contrasts = c("contr.treatment", "contr.poly")) ## library(devtools) ## r2path <- "/Users/rhbc/Documents/Rpackages/ordinal/pkg/ordinal" ## clean_dll(pkg = r2path) ## load_all(r2path) ## one zero weight: data(wine, package="ordinal") wts <- rep(1, nrow(wine)) wine$rating wts[1] <- 0 fm1 <- clm(rating ~ contact + temp, data=wine, weights=wts) fm1 fm1$n ## 72 fm1$nobs ## 71 confint(fm1) plot(profile(fm1)) plot(slice(fm1), 5) convergence(fm1) drop1(fm1, test="Chi") add1(fm1, scope=~.^2, test="Chi") ## clm_anova(fm1) pred <- predict(fm1, newdata=wine) ## OK step.fm1 <- step(fm1, trace=0) fitted(fm1) dim(model.matrix(fm1)$X) dim(model.matrix(fm1, "B")$B1) mf <- update(fm1, method="model.frame") str(mf) wts <- mf$wts dim(model.matrix(fm1)$X[wts > 0, , drop=FALSE]) fm1b <- clm(rating ~ temp, scale=~contact, data=wine, weights=wts) summary(fm1b) pr <- profile(fm1b) confint(pr) plot(pr, 1) fm1c <- clm(rating ~ temp, nominal=~contact, data=wine, weights=wts) summary(fm1c) pr <- profile(fm1c) confint(pr) plot(pr, 1) ## nominal.test(fm1) ## scale.test(fm1) ## zero out an entire response category: wts2 <- 1 * with(wine, rating != "2") fm2 <- clm(rating ~ contact + temp, data=wine, weights=wts2) fm2 fm2$n ## 72 fm2$nobs ## 50 ## Dimension of X and B1, B2 differ: dim(model.matrix(fm2)$X) dim(model.matrix(fm2, "B")$B1) ## Cannot directly evaluate predictions on the original data: try(predict(fm2, newdata=wine), silent=TRUE)[1] confint(fm2) profile(fm2) plot(slice(fm2), 5) step.fm2 <- step(fm2, trace=0) fitted(fm2) ## Scale and nominal effects: fm2b <- clm(rating ~ temp, scale=~contact, data=wine, weights=wts2) summary(fm2b) pr <- profile(fm2b) confint(pr) plot(pr, 1) fm2c <- clm(rating ~ temp, nominal=~contact, data=wine, weights=wts2) summary(fm2c) pr <- profile(fm2c) confint(pr) plot(pr, 1) pred <- predict(fm2c, newdata=wine[!names(wine) %in% "rating"]) pred <- predict(fm2b, newdata=wine[!names(wine) %in% "rating"]) ## nominal.test(fm2) ## scale.test(fm2) ## Different data sets (error): try(anova(fm1, fm2), silent=TRUE)[1] ## OK ## Test clm.fit: wts2 <- 1 * with(wine, rating != "2") mf2 <- update(fm2, method="design") fm3 <- with(mf2, clm.fit(y, X, weights=wts)) ################################# ordinal/tests/testAnova.clm2.R0000644000176200001440000000272415125475162016004 0ustar liggesuserslibrary(ordinal) options(contrasts = c("contr.treatment", "contr.poly")) ## More manageable data set: (tab26 <- with(soup, table("Product" = PROD, "Response" = SURENESS))) dimnames(tab26)[[2]] <- c("Sure", "Not Sure", "Guess", "Guess", "Not Sure", "Sure") dat26 <- expand.grid(sureness = as.factor(1:6), prod = c("Ref", "Test")) dat26$wghts <- c(t(tab26)) m1 <- clm(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logit") ## anova m2 <- update(m1, scale = ~1) anova(m1, m2) mN1 <- clm(sureness ~ 1, nominal = ~prod, data = dat26, link = "logit") anova(m1, mN1) anova(m1, m2, mN1) ## dropterm if(require(MASS)) { dropterm(m1, test = "Chi") mB1 <- clm(SURENESS ~ PROD + GENDER + SOUPTYPE, scale = ~ COLD, data = soup, link = "probit") dropterm(mB1, test = "Chi") # or ## addterm addterm(mB1, scope = ~.^2, test = "Chi") ## addterm(mB1, scope = ~ . + AGEGROUP + SOUPFREQ, ## test = "Chi", which = "location") ## addterm(mB1, scope = ~ . + GENDER + SOUPTYPE, ## test = "Chi", which = "scale") ## Fit model from polr example: ## data(housing, package = "MASS") fm1 <- clm(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) ## addterm(fm1, ~ Infl + Type + Cont, test= "Chisq", which = "scale") dropterm(fm1, test = "Chisq") fm2 <- update(fm1, scale =~ Cont) fm3 <- update(fm1, formula =~.-Cont, nominal =~ Cont) anova(fm1, fm2, fm3) } ordinal/tests/clmm.methods.R0000644000176200001440000000204515125475162015572 0ustar liggesuserslibrary(ordinal) data(wine) ################################# ## model.matrix method for clmm-objects: fmm1 <- clmm(rating ~ contact + temp + (1|judge), data=wine) mm <- model.matrix(fmm1) stopifnot(inherits(mm, "matrix"), dim(mm) == c(72, 3)) ################################# ## anova.clmm works even if formula does not have an environment: fmm1 <- clmm(rating ~ temp * contact + (1|judge), data = wine) fmm2 <- clmm(rating ~ temp + contact + (1|judge), data = wine) environment(fmm1$formula) <- NULL environment(fmm2$formula) <- NULL anova(fmm1, fmm2) ################################# ## Test that ranef, condVar and VarCorr work as they are supposed to whether or ## not nlme and lme4 are loaded: fm <- clmm(rating ~ temp + contact + (1|judge), data = wine) fm ranef(fm) VarCorr(fm) condVar(fm) summary(fm) library(nlme) ranef(fm) VarCorr(fm) condVar(fm) library(lme4) ranef(fm) VarCorr(fm) condVar(fm) fm1 <- lmer(Reaction ~ Days + (Days | Subject), data=sleepstudy) ranef(fm1) VarCorr(fm1) ranef(fm) VarCorr(fm) condVar(fm) summary(fm) ordinal/tests/test.general.R0000644000176200001440000000010515125475162015566 0ustar liggesusers txt <- citation("ordinal") stopifnot(as.logical(grep("year", txt))) ordinal/tests/clmm.control.R0000755000176200001440000000227115125475162015613 0ustar liggesuserslibrary(ordinal) data(wine) ### 3 options for specifying control arguments: ## 1) control is a simple list, e.g. list(trace=-1) ## 2) control is a call to clmm.control ## 3) control is an empty list; list() ## all in combination with extra control arguments. ordinal:::getCtrlArgs(clmm.control(), list(maxIter=200)) ordinal:::getCtrlArgs(list(), list(maxIter=200)) ordinal:::getCtrlArgs(list(), list(trace=-1)) ordinal:::getCtrlArgs(list(), list(trace=1)) ordinal:::getCtrlArgs(list(), list()) ordinal:::getCtrlArgs(list(maxIter=2), list()) ordinal:::getCtrlArgs(clmm.control(), list()) ordinal:::getCtrlArgs(clmm.control(maxIter=100), list(maxIter=200)) ordinal:::getCtrlArgs(clmm.control(maxIter=100), list(maxIter=200)) ordinal:::getCtrlArgs(clmm.control(), list(trace=1)) ordinal:::getCtrlArgs(clmm.control(), list(trace=-1)) ordinal:::getCtrlArgs(clmm.control(trace=1), list()) ordinal:::getCtrlArgs(clmm.control(trace=-1), list()) ordinal:::getCtrlArgs(clmm.control(trace=0), list()) ## Don't specify trace twice - surprising behavior might occur: ordinal:::getCtrlArgs(clmm.control(trace=1), list(trace=-1)) ordinal:::getCtrlArgs(clmm.control(trace=-1), list(trace=1)) ordinal/tests/test.clm.convergence.R0000644000176200001440000000343315125475162017230 0ustar liggesuserslibrary(ordinal) ## Testing that errors in chol() are caught soon enough: cy <- with(wine, which(temp == "cold" & contact == "yes")) wine2 <- subset(wine, subset=(!1:nrow(wine) %in% cy)) wine2[c(9, 15, 46), "rating"] <- NA fm1 <- clm(rating ~ temp, scale=~contact, nominal=~contact, data=wine2) fm1 <- try(clm(rating ~ temp, scale=~contact, nominal=~contact, data=wine2, control=list(gradTol=1e-12)), silent=TRUE) fm2 <- try(clm(rating ~ temp, scale=~contact, nominal=~contact, data=wine2, control=list(gradTol=1e-15)), silent=TRUE) ## These gave errors in version 2014.11-12. stopifnot(!inherits(fm1, "try-error")) stopifnot(!inherits(fm2, "try-error")) summary(fm1) summary(fm2) ## Error in convergence.clm() due to bad evaluation of model ## environment with update(object, doFit=FALSE): wine3 <- wine set.seed(1234) wts <- runif(nrow(wine3), 0, 2) fm3 <- clm(rating ~ temp + contact, data=wine3, weights=wts) c0 <- convergence(fm3) set.seed(1234) fm3 <- clm(rating ~ temp + contact, data=wine3, weights=runif(nrow(wine3), 0, 2)) c1 <- convergence(fm3) c0$info$logLik.Error c1$info$logLik.Error all.equal(c0$info$logLik.Error, c1$info$logLik.Error) ## In version 2014.11-14: ## > wine3 <- wine ## > set.seed(1234) ## > wts <- runif(nrow(wine3), 0, 2) ## > fm3 <- clm(rating ~ temp + contact, data=wine3, ## + weights=wts) ## > c0 <- convergence(fm3) ## > set.seed(1234) ## > fm3 <- clm(rating ~ temp + contact, data=wine3, ## + weights=runif(nrow(wine3), 0, 2)) ## > c1 <- convergence(fm3) ## > c0$info$logLik.Error ## [1] "<1e-10" ## > c1$info$logLik.Error ## [1] "4.80e+00" ## > all.equal(c0$info$logLik.Error, c1$info$logLik.Error) ## [1] "1 string mismatch" stopifnot(c0$info$logLik.Error == c1$info$logLik.Error) ordinal/tests/clm.fit.R0000644000176200001440000000223615125475162014536 0ustar liggesuserslibrary(ordinal) data(wine) ## clm.fit with nominal and scale effects: ## get simple model: fm1 <- clm(rating ~ temp, scale=~temp, nominal=~ contact, data=wine, method="design") str(fm1, give.attr=FALSE) fm1$control$method <- "Newton" res <- clm.fit(fm1) names(res) res$Theta ## construct some weights and offsets: set.seed(1) off1 <- runif(length(fm1$y)) set.seed(1) off2 <- rnorm(length(fm1$y)) set.seed(1) wet <- runif(length(fm1$y)) ## Fit various models: fit <- clm.fit(fm1$y, fm1$X, fm1$S, fm1$NOM, weights=wet) Coef <- c(-0.905224120279548, 1.31043498891987, 3.34235590523008, 4.52389661722693, -3.03954652971192, -1.56922389038976, -1.75662549320839, -1.16845464236365, 2.52988580848393, -0.0261457032829033) stopifnot(all.equal(coef(fit), Coef, check.attributes=FALSE, tol=1e-6)) str(fit) fit <- clm.fit(fm1$y, fm1$X, fm1$S, fm1$NOM, offset=off1) str(fit) fit <- clm.fit(fm1$y, fm1$X, fm1$S, fm1$NOM, offset=off1, S.offset=off2) str(fit) fit <- clm.fit(fm1$y, fm1$X, fm1$S) str(fit) fit <- clm.fit(fm1$y, fm1$X) str(fit) fit <- clm.fit(fm1$y) coef(fit) str(fit) ## Remember: compare with corresponding .Rout file ordinal/tests/test.makeThresholds.R0000644000176200001440000000115115125475162017130 0ustar liggesusers# test.makeThresholds.R library(ordinal) # Prvious bug which is now fixed: res <- ordinal:::makeThresholds(letters[1:3], "symmetric") stopifnot(length(res$alpha.names) == res$nalpha) # length(res$alpha.names) used to be 4 # Real data example: wine <- within(wine, { rating_comb3b <- rating levels(rating_comb3b) <- c("1-2", "1-2", "3", "4-5", "4-5") }) wine$rating_comb3b[1] <- "4-5" # Need to remove the zero here to avoid inf MLE ftable(rating_comb3b ~ temp + contact, data=wine) fm.comb3_c <- clm(rating_comb3b ~ contact, #scale=~contact, threshold = "symmetric", data=wine) # no error ordinal/tests/testthat/0000755000176200001440000000000015125475162014714 5ustar liggesusersordinal/tests/testthat/test-utils.R0000644000176200001440000000105315125475162017153 0ustar liggesusers context("testing namedList") a <- 1 b <- 2 c <- 3 d <- list(e=2, f=factor(letters[rep(1:2, 2)])) g <- matrix(runif(9), 3) h <- NULL test_that("namedList returns a named list", { res <- namedList(a, b, c) expect_equal(names(res), c("a", "b", "c")) expect_equivalent(res, list(a, b, c)) res <- namedList(a, b, c, d, g) expect_equal(names(res), c("a", "b", "c", "d", "g")) expect_equivalent(res, list(a, b, c, d, g)) res <- namedList(a, h) expect_equal(names(res), c("a", "h")) expect_equivalent(res, list(a, h)) }) ordinal/tests/testthat/test-clm.R0000644000176200001440000000576415125475162016603 0ustar liggesusers context("Appropriate error and warning messages from clm()") test_that("formula is specified in clm", { expect_error(clm(nominal=~contact, data=wine), "Model needs a formula") expect_error(clm(scale=~contact, data=wine), "Model needs a formula") expect_error(clm(), "Model needs a formula") }) test_that("response is not in scale or nominal", { ## No response in formula: expect_error( fm <- clm(~ temp + contact, data=wine) , "'formula' needs a response") ## response in scale: expect_error( fm <- clm(rating ~ temp, scale=rating ~ contact, data=wine) , "response not allowed in 'scale'") expect_error( fm <- clm(rating ~ temp, nominal=rating ~ contact, data=wine) , "response not allowed in 'nominal'") wine2 <- wine wine2$rate <- as.numeric(as.character(wine2$rating)) expect_error( fm <- clm(rate ~ temp + contact, data=wine2) , "response in 'formula' needs to be a factor") }) test_that("offset is allowed in formula, but not in scale and nominal", { wine2 <- wine set.seed(1) wine2$off <- runif(nrow(wine)) ## offset in formula is fine: expect_is( clm(rating ~ temp + contact + offset(off), data=wine2) , "clm") expect_is( clm(rating ~ offset(off), nominal=~contact, data=wine2) , "clm") ## no other terms in formula. ## offset in scale is also fine: expect_is( clm(rating ~ temp, scale=~contact + offset(off), data=wine2) , "clm") expect_is( clm(rating ~ contact + temp, scale=~offset(off), data=wine2) , "clm") ## no other terms in scale. ## offset as argument is not allowed: expect_error( clm(rating ~ temp + contact, offset=off, data=wine2) , "offset argument not allowed: specify 'offset' in formula or scale arguments instead") ## offset in nominal is not allowed: expect_error( clm(rating ~ temp, nominal=~contact + offset(off), data=wine2) , "offset not allowed in 'nominal'") expect_error( clm(rating ~ temp, nominal=~1 + offset(off), data=wine2) , "offset not allowed in 'nominal'") }) test_that("Intercept is needed and assumed", { expect_is( fm <- clm(rating ~ 1, data=wine) , "clm") expect_warning( fm <- clm(rating ~ -1 + temp, data=wine) , "an intercept is needed and assumed in 'formula'") expect_warning( fm <- clm(rating ~ 0 + temp, data=wine) , "an intercept is needed and assumed in 'formula'") expect_warning( fm <- clm(rating ~ 0, data=wine) , "an intercept is needed and assumed in 'formula'") ## and similar with scale (+nominal) }) wine4 <- wine wine4 <- within(wine4, temp2 <- 1e4*as.integer(temp)) test_that("convergence messsages are printed when there are >1 codes", { expect_warning( fm1 <- clm(rating ~ temp2 + contact, data=wine4) , "very large eigenvalue") }) ## test_that("", { ## ## }) ordinal/tests/testthat/test-contrasts.R0000644000176200001440000000504115125475162020034 0ustar liggesuserscontext("Contrast specification") test_that("clm gives contrast warnings when it should", { ## No warnings: ## Different combinations of terms i various formulae. Note that the ## contrasts apply to e.g. 'contact' in both 'formula' and 'scale': contr <- c(temp="contr.sum", contact="contr.sum") expect_false(givesWarnings( fm1 <- clm(rating ~ temp + contact, scale=~contact, data=wine) ## OK )) # expect_false(givesWarnings( # fm1 <- clm(rating ~ temp + contact, scale=~contact, data=wine, # contrasts=contr) ## OK # )) # expect_false(givesWarnings( # fm1 <- clm(rating ~ temp, scale=~contact, data=wine, # contrasts=contr) ## OK # )) # expect_false(givesWarnings( # fm1 <- clm(rating ~ temp, nominal=~contact, data=wine, # contrasts=contr) ## OK # )) # expect_false(givesWarnings( # fm1 <- clm(rating~1, scale=~temp, nominal=~contact, data=wine, # contrasts=contr) ## OK # )) ## These should give warnings: ## A warning is given if a variable is not present in any of the ## formulae: expect_warning( fm <- clm(rating ~ temp, contrasts=c(contact="contr.sum"), data=wine) , "variable 'contact' is absent: its contrasts will be ignored") expect_warning( fm <- clm(rating ~ temp, contrasts=contr, data=wine) , "variable 'contact' is absent: its contrasts will be ignored") expect_warning( fm <- clm(rating ~ 1, scale=~contact, contrasts=c(temp="contr.sum"), data=wine) , "variable 'temp' is absent: its contrasts will be ignored") expect_warning( fm <- clm(rating ~ 1, scale=~contact, contrasts=list(temp="contr.sum"), data=wine) , "variable 'temp' is absent: its contrasts will be ignored") }) test_that("checkContrasts gives when it should", { ## No warnings: fm0 <- clm(rating ~ temp + contact, scale=~contact, data=wine) expect_false( givesWarnings(checkContrasts(fm0$S.terms, fm0$S.contrasts)) ) expect_false( givesWarnings(checkContrasts(fm0$terms, fm0$contrasts)) ) expect_false( givesWarnings(checkContrasts(fm0$terms, fm0$S.contrasts)) ) expect_false( givesWarnings(checkContrasts(fm0$terms, fm0$S.contrasts)) ) ## Warning: expect_warning( checkContrasts(fm0$S.terms, fm0$contrasts) , "variable 'temp' is absent: its contrasts will be ignored") }) ordinal/tests/testthat/test-misc.R0000644000176200001440000000024115125475162016744 0ustar liggesuserscontext("Test of general functionality") test_that("citation reports year", { txt <- citation("ordinal") expect_true(as.logical(grep("year", txt))) }) ordinal/tests/testthat/test-clm-formula.R0000644000176200001440000001557615125475162020250 0ustar liggesuserscontext("Appropriate evaluation of formulae in clm()") ## These fail and give appropriate error messages: test_that("standard formulae are interpreted correctly/give right error messages", { expect_error( fm1 <- clm(rating ~ contact, scale=temp, data=wine) , "object 'temp' not found") expect_error( fm1 <- clm(rating ~ contact, scale=~Temp, data=wine) , "object 'Temp' not found") expect_error( fm1 <- clm(rating ~ contact, scale="temp", data=wine) , "unable to interpret 'formula', 'scale' or 'nominal'") sca <- "temp" expect_error( fm1 <- clm(rating ~ contact, scale=sca, data=wine) , "unable to interpret 'formula', 'scale' or 'nominal'") ## sca <- as.formula(sca) ## sca <- as.formula(temp) ## sca <- with(wine, as.formula(temp)) ## These all work as intended with no warnings or errors: fm1 <- clm(rating ~ contact, scale="~temp", data=wine) fm2 <- clm(rating ~ contact, scale=~temp, data=wine) sca <- "~temp" fm3 <- clm(rating ~ contact, scale=sca, data=wine) sca <- as.formula("~temp") fm4 <- clm(rating ~ contact, scale=sca, data=wine) fm5 <- clm(rating ~ contact, scale=as.formula(~temp), data=wine) fm6 <- clm(rating ~ contact, scale=as.formula("~temp"), data=wine) ## Test that they are all clm objects: for(txt in paste0("fm", 1:6)) expect_is(eval(parse(text=txt)), "clm") ################################# ## can evaluate if 'formula' is a character: f <- "rating ~ contact + temp" expect_is(clm(f, data=wine), "clm") expect_is(clm(as.formula(f), data=wine), "clm") ################################# }) test_that("variables are found in the right environments", { ## finding variables in the environment of the formula: makeform <- function() { f1 <- as.formula(rating ~ temp + contact) rating <- wine$rating temp <- wine$temp contact <- wine$contact f1 } ## 'makeform' makes are formula object in the environment of the ## function makeform: f1 <- makeform() f1 # print expect_is(f1, "formula") ## If we give the data, we can evaluate the model: expect_is(fm1 <- clm(f1, data=wine), "clm") ## We can also evaluate the model because the data are available in ## the environment associated with the formula: expect_is(fm1 <- clm(f1), "clm") ## For instance, the 'rating' variable is not found in the Global ## environment; we have to evaluate the 'name' of 'rating' in the ## appropriate environment: (try(rating, silent=TRUE)) expect_error( rating , "'rating' not found") expect_is( eval(as.name("rating"), envir=environment(f1)) , "factor") ## If instead we generate the formula in the Global environment where ## the variables are not found, we cannot evaluate the model: f2 <- as.formula(rating ~ temp + contact) expect_error( fm2 <- clm(f2) ) ## Setting the appropriate environment of the formula restores the ## ability to evaluate the model: environment(f2) <- environment(f1) expect_is( fm2 <- clm(f2) , "clm") ################################# ## Use of formula-objects in location, scale and nominal: ## Bug-report from LluĂ­s Marco Almagro ## 5 May 2010 17:58 f <- formula(rating ~ temp) fs <- formula( ~ contact) expect_is( m2 <- clm(f, scale = fs, data = wine) , "clm") }) test_that("data indexing works in formulae", { ################################# ## Other ways to construct formulas: set.seed(12345) y <- factor(sample(1:4,20,replace=TRUE)) x <- rnorm(20) data <- data.frame(y=y,x=x) rm(x, y) expect_is( fit <- clm(data$y ~ data$x) , "clm") expect_is( fit <- clm(data[,1] ~ data[,2]) , "clm") ## This previously failed, but now works: expect_is( fit <- clm(data$y ~ data$x, ~data$x) , "clm") }) test_that("clm may be invoked within functions", { ################################# ## Evaluation within other functions: ## date: January 18th 2012. ## ## The problem was raised by Stefan Herzog (stefan.herzog@unibas.ch) ## January 12th 2012 in trying to make clm work with glmulti. fun.clm <- function(formula, data) ### This only works because clm via eclm.model.frame is careful to ### evaluate the 'formula' in the parent environment such it is not the ### character "formula" that is attempted evaluated. clm(formula, data = data) fun2.clm <- function(formula, data, weights, subset) { ### This should be the safe way to ensure evaluation of clm in the ### right environment. mc <- match.call() mc[[1]] <- as.name("clm") eval.parent(mc) } expect_is( fun.clm(rating ~ temp + contact, data=wine) ## works , "clm") expect_is( fun2.clm(rating ~ temp + contact, data=wine) ## works , "clm") form1 <- "rating ~ temp + contact" expect_is( fun.clm(form1, data=wine) ## works , "clm") expect_is( fun2.clm(form1, data=wine) ## works , "clm") form2 <- formula(rating ~ temp + contact) expect_is( fm1 <- fun.clm(form2, data=wine) ## works , "clm") expect_is( fm2 <- fun2.clm(form2, data=wine) ## works , "clm") ## Notice that clm is not able to get the name of the data (wine) ## correct when using fun.clm: expect_true(deparse(fm1$call$data) == "data") expect_true(deparse(fm2$call$data) == "wine") }) test_that("no line breacking in long formulae", { ################################# ## Evaluation of long formulas: no line breaking in getFullForm: rhs <- paste(names(soup)[c(3, 5:12)], collapse=" + ") Location <- as.formula(paste("SURENESS ~ ", rhs, sep=" ")) Scale <- as.formula("~ PROD") expect_is( fm5 <- clm(Location, scale=Scale, data=soup) , "clm") }) test_that("'.'-notation works in formula", { ################################# ## Check that "."-notation works in formula: ## December 25th 2014, RHBC data(wine) wine2 <- wine[c("rating", "contact", "temp")] ## str(wine2) fm0 <- clm(rating ~ ., data=wine2) fm1 <- clm(rating ~ contact + temp, data=wine2) keep <- c("coefficients", "logLik", "info") fun <- function(x, y) stopifnot(isTRUE(all.equal(x, y))) mapply(fun, fm0[keep], fm1[keep]) fun <- function(x, y) {expect_equal(x, y); invisible()} mapply(fun, fm0[keep], fm1[keep]) ################################# }) test_that("long formulae work in clmm", { # Long formulae also work: wine2 <- wine names(wine2) <- lapply(names(wine), paste0, "_quite_long") expect_warning( mm <- clmm(rating_quite_long ~ temp_quite_long + contact_quite_long + (1|judge_quite_long), data = wine2) , regexp = NA) }) ordinal/tests/testthat/test-clm-profile.R0000644000176200001440000000046515125475162020232 0ustar liggesuserscontext("Testing error message from profile.clm") expect_warning( fm2 <- clm(rating ~ contact, scale=~contact, nominal=~contact, data=wine) , "\\(1\\) Hessian is numerically singular") expect_error(profile(fm2) , "Cannot get profile when vcov\\(fitted\\) contains NAs") ordinal/tests/testthat/test-clm-predict.R0000644000176200001440000000065615125475162020226 0ustar liggesuserscontext("Test that clm.predict gives warnings if prevars is absent") fm1 <- clm(rating ~ temp + contact, data=wine) newData <- expand.grid(temp=levels(wine$temp), contact=levels(wine$contact)) expect_false(givesWarnings( predict(fm1, newdata=newData) )) attr(fm1$terms, "predvars") <- NULL expect_warning( predict(fm1, newdata=newData) , "terms object does not have a predvars attribute") ordinal/tests/testthat/test-clmm-checkRanef.R0000644000176200001440000000214715125475162020777 0ustar liggesuserscontext("Testing error-warning-message from clmm via checkRanef") ## Make example with more random effects than observations: wine$fake <- factor(c(1:65, 1:65)[1:nrow(wine)]) wine$fakeToo <- factor(1:nrow(wine)) ## Check warning, error and 'message' messages: expect_warning( fmm2 <- clmm(rating ~ temp + contact + (1|judge) + (1|fake), data=wine) , "no. random effects") expect_warning( fmm2 <- clmm(rating ~ temp + contact + (1|judge) + (1|fake), data=wine, checkRanef="warn") , "no. random effects") expect_error( fmm2 <- clmm(rating ~ temp + contact + (1|judge) + (1|fake), data=wine, checkRanef="error") , "no. random effects") expect_message( fmm2 <- clmm(rating ~ temp + contact + (1|judge) + (1|fake), data=wine, checkRanef="message") , "no. random effects") expect_error( fmm2 <- clmm(rating ~ temp + contact + (1|fakeToo), data=wine, checkRanef="error") , "no. random effects") expect_error( fmm2 <- clmm(rating ~ temp + contact + (1|judge) + (1|fakeToo), data=wine, checkRanef="error") , "no. random effects") ordinal/tests/ranef.loading.R0000644000176200001440000000032115125475162015702 0ustar liggesusers# check that ranef and VarCorr work even after loading ordinal: library(lme4) fm1 <- lmer(Reaction ~ Days + (Days | Subject), data=sleepstudy) ranef(fm1) VarCorr(fm1) library(ordinal) ranef(fm1) VarCorr(fm1) ordinal/tests/test-all.R0000644000176200001440000000011115125475162014715 0ustar liggesusers if(require(testthat) && require(ordinal)) { test_check("ordinal") } ordinal/tests/test.clm.profile.R0000644000176200001440000000264515125475162016376 0ustar liggesuserslibrary(ordinal) ## Testing that the profile remains the same - that the model object ## is not 'distorted' by update(object/fitted, doFit=FALSE) set.seed(1234) wts <- runif(nrow(wine), 0, 2) fm3 <- clm(rating ~ temp + contact, data=wine, weights=wts) pr <- profile(fm3) set.seed(1234) fm3 <- clm(rating ~ temp + contact, data=wine, weights=runif(nrow(wine), 0, 2)) pr3 <- profile(fm3) ## > set.seed(1234) ## > fm3 <- clm(rating ~ temp + contact, data=wine, ## + weights=runif(nrow(wine), 0, 2)) ## > pr3 <- profile(fm3) ## Warning messages: ## 1: In profile.clm.beta(fitted, which.beta, alpha, max.steps, nsteps, : ## profile may be unreliable for tempwarm because only 1 ## steps were taken down ## 2: In profile.clm.beta(fitted, which.beta, alpha, max.steps, nsteps, : ## profile may be unreliable for tempwarm because only 1 ## steps were taken up ## 3: In profile.clm.beta(fitted, which.beta, alpha, max.steps, nsteps, : ## profile may be unreliable for contactyes because only 1 ## steps were taken down ## 4: In profile.clm.beta(fitted, which.beta, alpha, max.steps, nsteps, : ## profile may be unreliable for contactyes because only 1 ## steps were taken up ## stopifnot(isTRUE(all.equal(pr, pr3, check.attributes=FALSE))) stopifnot( isTRUE(all.equal(pr$tempwarm[, "lroot"], pr3$tempwarm[, "lroot"])), isTRUE(all.equal(pr$contactyes[, "lroot"], pr3$contactyes[, "lroot"]))) ordinal/tests/clmm.R0000755000176200001440000000230015125475162014125 0ustar liggesuserslibrary(ordinal) data(wine) ################################# ## Estimation with a single simple RE term: ## Laplace: fmm1 <- clmm(rating ~ contact + temp + (1|judge), data=wine) summary(fmm1) ## GHQ: fmm.ghq <- clmm(rating ~ contact + temp + (1|judge), data=wine, nAGQ=-10) summary(fmm.ghq) ## AGQ: fmm.agq <- clmm(rating ~ contact + temp + (1|judge), data=wine, nAGQ=10) summary(fmm.agq) ## tests: ## Notice warning about Laplace with multiple REs when nAGQ != 1: fmm1 <- try(clmm(rating ~ contact + temp + (1|judge) + (1|bottle), data=wine, nAGQ=10)) stopifnot(inherits(fmm1, "try-error")) ################################# ## Estimation with several RE terms: data(soup, package="ordinal") fmm <- clmm(SURENESS ~ PROD + (1|RESP) + (1|PROD:RESP), data=soup, threshold="equidistant") summary(fmm) ################################# ## Estimation with implicit intercept: fm1 <- clmm(rating ~ 1 + (1|judge), data = wine) fm2 <- clmm(rating ~ (1|judge), data = wine) fm3 <- clmm(rating ~ 0 + (1|judge), data = wine) stopifnot(isTRUE(all.equal(coef(fm1), coef(fm2), tolerance=1e-5)), isTRUE(all.equal(coef(fm1), coef(fm3), tolerance=1e-5))) ordinal/MD50000644000176200001440000001435415130436352012223 0ustar liggesuserse320156091bc58f1598d88d13e50d24e *DESCRIPTION fab14f3ebbce21059b058fcdff557092 *LICENCE.note a2437fe61640a0e31060e6a16a28d50e *NAMESPACE 538d7108bbb56f8c24e086c2adf0cb21 *NEWS f42ea04dfdac9b49baeb71519cbf31f0 *R/AO.R 2ef9874c17d21c49d69b36e50e54d10b *R/clm.R a6eff1c021473170935a22a38b4e80d3 *R/clm.Thetamat.R badbf7064371541b31c31c1af994c56b *R/clm.anova.R d07ec5b689c770cb18d03ec2699b830b *R/clm.fit.R 32978c28016b33f8beb7125ab5e54d06 *R/clm.fitter.R edb1cb0c65e11cc3f0ec91844218584a *R/clm.frames.R 32851f8f8da9aef84c7867811306fc4c *R/clm.methods.R 3b82fc97c164bfa1b036b6193de9f8cb *R/clm.nominal_test.R c71860ba09402aaa03510f42036f4b69 *R/clm.predict.R e14bca1cfaf65687f3d42c97389161f4 *R/clm.profile.R 1cfeb713c2355f6898f955291657b02c *R/clm.simple.R 4a3a13f776f7ad5f726ad8618d6c99a6 *R/clm.slice.R c9669d06a76b7355410af1ecbc509a94 *R/clm.slice2D.R 750376a36b9a5cc2f9b7ac7360b27738 *R/clm.start.R 20dcf47ea441c518f1a4a0be6e033eab *R/clm2.R b177b69192c0d0670c0025f130d634e7 *R/clmm.R 649c5e5cc9de2fc6d3b7a6dd0966f65f *R/clmm.formula.R a10738ec62c50fbd50e31b45ef81fa1e *R/clmm.methods.R 3c87d8854600d5c2c42b8e8622b30dc6 *R/clmm.ranef.R 836fe4f00654b7270b3422500fab6bc0 *R/clmm.ssr.R 652bb67e79403ee5e0d60a0ae15b43ac *R/clmm.start.R 4393c05574f6b3da096caa899b1a4f1c *R/clmm2.R cb30af2291acb9e7d88c186dd7786e39 *R/clmm2.utils.R 4c4453005867cd1c275f2cb808669bf2 *R/contrast_utils.R b35f8f6bbc526cfeed76ccc27cf6ce9c *R/control.R 8e1ac444746725840ed0df3c20c93f5a *R/convergence.R 6aae7e07c6aa3b7e6229b4e6be6f6a04 *R/derivatives.R 370d0f7e757d1e50b36c3ac4a146877c *R/drop.coef.R c781ab13bac51d69118bf1fc71af40e6 *R/gdist.R 1e2ad32a473d3885c9a29856fcc459f9 *R/gumbel.R 93f1b731738f88994066216cd3171db8 *R/lgamma.R e62866b2dc5ff7dee7ce0c49ce2fd8d4 *R/terms_utils.R 1fcd9edcb1ffc050fafbcaca9361888a *R/utils.R b5538aafcb4d764e2ce703d0c52f4184 *R/warning_functions.R 1d9c91f020d9e212d6c2b31002a59e3c *build/vignette.rds 63eb28b797efedb31ad1f5db75ddfa0b *data/income.rda de5d075c95248681323ce9e571e7d0a2 *data/soup.rda 50b83b93508e5c5a9085d5204cb9ff09 *data/wine.rda 1be7339c91cffb680625234dd051b237 *inst/CITATION 8c21b32e9c1060be6d9ce0121f509023 *inst/doc/clm_article.R 3b95d1c41a81b2b8c4721c378598f30c *inst/doc/clm_article.Rnw 1c3191006611c2146b03e7df8edb4833 *inst/doc/clm_article.pdf 64aaa511c3b4dc72b6c004106553bf97 *inst/doc/clmm2_tutorial.R ddde6e9af6699c2d9c11002d12e3049e *inst/doc/clmm2_tutorial.Rnw cd2042090fe45c21020446504e2c65af *inst/doc/clmm2_tutorial.pdf bd8055e0c9cc16fdf95f9caebc942c53 *man/VarCorr.Rd a0edf4b1d55157b597efc9c7f7a06f2e *man/addtermOld.Rd fbbfa8a549ecc09ad66aa0e00d1f6d1b *man/anovaOld.Rd 3164cecae2b46ea51b10c5e4c086a9f2 *man/clm.Rd eef6dbcf3a110b0221075d694991a70d *man/clm.anova.Rd e9ab135b857095344d63f5b3695dac45 *man/clm.control.Rd aeedb960b5d0cd91648b2f43261c0010 *man/clm.controlOld.Rd 6b5c14c006fbfe9634616757bf287b9f *man/clm.fit.Rd 02cc7944a1cc6a14870e5c1ba33bd0ae *man/clmOld.Rd 5529ca85369ae94713f65470336e6e20 *man/clmm.Rd 861db001a071e534dc5021120bb62124 *man/clmm.control.Rd 3095fd227ece61f6b6a099d5de003313 *man/clmm.controlOld.Rd d8b5a448143a0da1495756ea2c48ab44 *man/clmmOld.Rd a03c75733972348ddd5f505dc472c26b *man/confint.clm.Rd 50c7e6ec194e8af3bfccca5e3e4e61fb *man/confint.clmmOld.Rd 3d881bc96a9fd9a56c4cd1451c708a7f *man/confintOld.Rd 8e1dcaa797916a35a9de4f1413dee029 *man/convergence.clm.Rd cb5e6dd9111063de64f3643568674fc4 *man/dropCoef.Rd 650996c7b48d859ae5e5ac751dfeaca2 *man/gfun.Rd 4d87ff9fa6c1729a7ad52be5c3f7a16f *man/gumbel.Rd 7f719c8b1d0ede27f15c1fa9cd3aedea *man/income.Rd 5ebc7da192ca06d173b2694853352e9e *man/lgamma.Rd 51b4cdc005b1c26b5d23d04197965c8f *man/nominal.test.Rd 3875373537f4f0d974091bb9a58fff40 *man/ordinal-package.Rd 1f050e8e469290a5c6c9c07e3ae08a29 *man/predict.Rd 731499033e04d0f739cad2d0ad13b9c1 *man/predictOld.Rd 37b2ed10c518b0e95c9b64e211929bab *man/ranef.Rd ffeacc4ef5eb2b97d794c89afdb5c59c *man/slice.clm.Rd 2c66bfbfde8422891b1ca4359c858dc6 *man/soup.Rd 41562a0c8389e5fe01af70802a3e995f *man/updateOld.Rd 079335e2cb6d006b7040c330f4aabd59 *man/wine.Rd 1c9f04e9c1d693a1edba7c821a5897aa *src/get_fitted.c 47701dd6e160c7c084e5012867b97702 *src/init.c f4bdbadce2c329a2162038a1b2a98c38 *src/links.c 6345916ff821b4cc69e7d81fcb1ff4a8 *src/links.h 2027783cb94e79ce75bd4e5bd4a2ab52 *src/utilityFuns.c 735d1e1f085ffaaacf1a7628930adc64 *tests/anova.R 89bb425a86eefa6d518534ba2bebffe9 *tests/clm.fit.R 7cf9e5abc7360d67304ac97cb1f4bbad *tests/clm.formula.R ae0d8a60e17d3ebb5a6863f5f1d13dd7 *tests/clmm.R 9ed01ea5d1feb4f302de5a957e195a3b *tests/clmm.control.R cadfa40f297ae2ad3013b99470d73116 *tests/clmm.formula.R f72fcd80cfeff92cb86b987d4a829c9d *tests/clmm.methods.R bb53b627bd127be25140ca9b18cd7570 *tests/confint.R d8267669e5b9c3ab305c6036f1c8d623 *tests/nominal.test.R c0a7ea9adb79f1a72f794d68c0b2a8e3 *tests/ranef.loading.R d1a9b3c673dfe17f1579cb8527af60d3 *tests/test-all.R 16a2a63ab5214f0a105692aedc0c8fc6 *tests/test.clm.Theta.R d4e39c9cbf18fb828ee6abde86063820 *tests/test.clm.convergence.R bbb3efe198444977cfe15200a2f73aa2 *tests/test.clm.flex.link.R 972645dadf3c58dda8dfba40191406f0 *tests/test.clm.model.matrix.R 65465ddc9177b9ef5e0c1eb7ed83bb39 *tests/test.clm.predict.R b237b3a6173025bf72810002e9e0b195 *tests/test.clm.profile.R e91f920a51deaa7c84a7d75f9220486a *tests/test.clm.single.anova.R b666a698afa2ebefbc12b52358969a05 *tests/test.general.R 6faea911a5b2575b5acb57087c697201 *tests/test.makeThresholds.R 434ae1cd4de96ac0d2ac54db684ac7d5 *tests/test.sign.R 0452a68e5a919248553360c9622eb926 *tests/test0weights.R dd771457105e82780b335f6ced52e736 *tests/testAnova.clm2.R ca67691eee70bdd41b3ae5c71f5b61e6 *tests/testCLM.R d1d0e84d5901ddf008e6cbb22e2ce003 *tests/testthat/test-clm-formula.R 5a26fb2b90f90bd574da4ed0758abfe4 *tests/testthat/test-clm-predict.R ff1d040fe6da8b6ffe3e26b2546aa27d *tests/testthat/test-clm-profile.R ebafc7b387677f70bec2496a120051a4 *tests/testthat/test-clm.R 0263b906dbd4420343b72f0b9316ea73 *tests/testthat/test-clmm-checkRanef.R a9c6572a4ca505408b5ee7204021b905 *tests/testthat/test-contrasts.R 49fd8f2e430e2be16217acbc1008a209 *tests/testthat/test-misc.R 234b3c903ae3e070034dff21ff97de82 *tests/testthat/test-utils.R 3b95d1c41a81b2b8c4721c378598f30c *vignettes/clm_article.Rnw 62d49a41b751923b62083f2d21bbcce0 *vignettes/clm_article_refs.bib ddde6e9af6699c2d9c11002d12e3049e *vignettes/clmm2_tutorial.Rnw 0a6147c5118e35024e22eb7dafbf4bc2 *vignettes/ordinal.bib ordinal/R/0000755000176200001440000000000015125475162012113 5ustar liggesusersordinal/R/terms_utils.R0000644000176200001440000001771015127777530014624 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# # terms_utils.R - utilities for computing on terms objects and friends # ------- Contents: -------- # # --- utility functions: --- # # term2colX # need_yates # no_yates # numeric_terms # get_model_matrix # get_contrast_coding # get_min_data # get_var_list # get_fac_list # get_num_list # get_pairs # get_trts # ############################################## ######## term2colX() ############################################## term2colX <- function(terms, X) { # Compute map from terms to columns in X using the assign attribute of X. # Returns a list with one element for each term containing indices of columns # in X belonging to that term. if(is.null(asgn <- attr(X, "assign"))) stop("Invalid design matrix:", "design matrix 'X' should have a non-null 'assign' attribute", call. = FALSE) term_names <- attr(terms, "term.labels") has_intercept <- attr(terms, "intercept") > 0 col_terms <- if(has_intercept) c("(Intercept)", term_names)[asgn + 1] else term_names[asgn[asgn > 0]] if(!length(col_terms) == ncol(X)) # should never happen. stop("An error happended when mapping terms to columns of X") # get names of terms (including aliased terms) nm <- union(unique(col_terms), term_names) res <- lapply(setNames(as.list(nm), nm), function(x) numeric(0L)) map <- split(seq_along(col_terms), col_terms) res[names(map)] <- map res[nm] # order appropriately } ############################################## ######## need_yates() ############################################## need_yates <- function(model) { ## Do not need yates for: ## - continuous variables ## - factors that are not contained in other factors ## Need yates for all other terms, i.e. terms which are: ## - contained in other terms, AND ## - which are not numeric/continuous term_names <- attr(terms(model), "term.labels") cont <- containment(model) is_contained <- names(cont[sapply(cont, function(x) length(x) > 0)]) nmt <- numeric_terms(model) num_terms <- names(nmt[nmt]) term_names[!term_names %in% num_terms & term_names %in% is_contained] } ############################################## ######## no_yates() ############################################## no_yates <- function(model) { setdiff(attr(terms(model), "term.labels"), need_yates(model)) } ############################################## ######## numeric_terms() ############################################## #' @importFrom stats delete.response terms numeric_terms <- function(model) { ## Determines for all terms (not just all variables) if the 'dataClass' ## is numeric ## (interactions involving one or more numerics variables are numeric). Terms <- delete.response(terms(model)) all_vars <- all.vars(attr(Terms, "variables")) data_classes <- attr(terms(model, fixed.only=FALSE), "dataClasses") var_class <- data_classes[names(data_classes) %in% all_vars] factor_vars <- names(var_class[var_class %in% c("factor", "ordered")]) num_vars <- setdiff(all_vars, factor_vars) term_names <- attr(terms(model), "term.labels") # term_names <- setNames(as.list(term_names), term_names) sapply(term_names, function(term) { vars <- unlist(strsplit(term, ":")) any(vars %in% num_vars) }) } ############################################## ######## get_model_matrix() ############################################## #' Extract or remake model matrix from model #' #' Extract or remake model matrix from model and potentially change the #' contrast coding #' #' @param model an \code{lm} or \code{lmerMod} model object. #' @param type extract or remake model matrix? #' @param contrasts contrasts settings. These may be restored to those in the #' model or they may be changed. If a length one character vector (e.g. #' \code{"contr.SAS"}) this is applied to all factors in the model, but it can #' also be a list naming factors for which the contrasts should be set as specified. #' #' @return the model (or 'design') matrix. #' @keywords internal #' @author Rune Haubo B Christensen get_model_matrix <- function(model, type=c("extract", "remake"), contrasts="restore") { type <- match.arg(type) # stopifnot(inherits(model, "lm") || inherits(model, "lmerMod")) if(type == "extract") return(model_matrix(model)) # Set appropriate contrasts: Contrasts <- get_contrast_coding(model, contrasts=contrasts) model.matrix(terms(model), data=model.frame(model), contrasts.arg = Contrasts) } ############################################## ######## get_contrast_coding() ############################################## get_contrast_coding <- function(model, contrasts="restore") { # Compute a list of contrasts for all factors in model Contrasts <- contrasts if(length(contrasts) == 1 && is.character(contrasts) && contrasts == "restore") { Contrasts <- attr(model_matrix(model), "contrasts") } else if(length(contrasts) == 1 && is.character(contrasts) && contrasts != "restore") { Contrasts <- .getXlevels(terms(model), model.frame(model)) Contrasts[] <- contrasts Contrasts } Contrasts } #' # #' get_min_data <- function(model, FUN=mean) #' # Get a minimum complete model.frame based on the variables in the model #' do.call(expand.grid, get_var_list(model, FUN=FUN)) #' #' get_var_list <- function(model, FUN=mean) #' # Extract a named list of variables in the model containing the levels of #' # factors and the mean value of numeric variables #' c(get_fac_list(model), get_num_list(model, FUN=FUN)) #' #' #' @importFrom stats .getXlevels #' get_fac_list <- function(model) { #' # Extract a named list of factor levels for each factor in the model #' res <- .getXlevels(Terms=terms(model), m=model.frame(model)) #' if(is.null(res)) list() else res #' } #' #' get_num_list <- function(model, FUN=mean) { # FUN=function(x) mean(x, na.rm=TRUE)) { #' # Extract named list of mean/FUN values of numeric variables in model #' deparse2 <- function(x) paste(safeDeparse(x), collapse = " ") #' Terms <- terms(model) #' mf <- model.frame(model) #' xvars <- sapply(attr(Terms, "variables"), deparse2)[-1L] #' if((yvar <- attr(Terms, "response")) > 0) #' xvars <- xvars[-yvar] #' if(!length(xvars)) return(list()) #' xlev <- lapply(mf[xvars], function(x) { #' if (is.numeric(x)) FUN(x) else NULL #' }) #' res <- xlev[!vapply(xlev, is.null, NA)] #' if(is.null(res)) list() else res #' } #' #' #' @importFrom utils combn #' get_pairs <- function(levs) { #' stopifnot(is.character(levs), length(levs) > 1) #' combs <- combn(seq_along(levs), 2) #' ind <- seq_len(ncombs <- ncol(combs)) #' A <- as.data.frame(array(0, dim=c(length(levs), ncombs))) #' dimnames(A) <- list(levs, paste(levs[combs[1, ]], levs[combs[2, ]], sep=" - ")) #' A[cbind(combs[1, ], ind)] <- 1 #' A[cbind(combs[2, ], ind)] <- -1 #' A #' } #' #' get_trts <- function(levs) { #' nlevs <- length(levs) #' ans <- t(cbind(-1, diag(nlevs - 1))) #' rownames(ans) <- levs #' colnames(ans) <- paste(levs[-1], levs[1], sep=" - ") #' ans #' } # get_trts(letters[1:5]) # get_pairs(letters[1:5]) ordinal/R/clmm.ssr.R0000644000176200001440000002421515127777530014006 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions for fitting CLMMs with a single simple random-effects ## term (ssr). rho.clm2clmm.ssr <- function(rho, retrms, ctrl) ### Version of rho.clm2clmm that is set up to use the C ### implementations of Laplace, AGQ and GHQ for a single random ### effect. { gfList <- retrms$gfList rho$grFac <- gfList[[1]] rho$ctrl <- ctrl rho$sigma <- rep(1, nrow(rho$B1)) rho$lambda <- 0 rho$nlev <- as.vector(sapply(gfList, nlevels)) rho$random.names <- sapply(gfList, levels) rho$tau.names <- names(gfList) rho$nrandom <- sum(rho$nlev) ## no. random effects rho$Niter <- 0L rho$neval <- 0L rho$u <- rho$uStart <- rep(0, rho$nrandom) rho$linkInt <- switch(rho$link, logit = 1L, probit = 2L, cloglog = 3L, loglog = 4L, cauchit = 5L) rho$ST <- lapply(retrms$retrms, `[[`, "ST") } ## set.AGQ <- function(rho, nAGQ) { ## rho$nAGQ <- nAGQ ## if(nAGQ %in% c(0L, 1L)) return(invisible()) ## ghq <- gauss.hermite(abs(nAGQ)) ## rho$ghqns <- ghq$nodes ## rho$ghqws <- ## if(nAGQ > 0) ghq$weights ## AGQ ## else log(ghq$weights) + (ghq$nodes^2)/2 ## GHQ ## } clmm.fit.ssr <- function(rho, control = list(), method=c("nlminb", "ucminf"), Hess = FALSE) ### Fit a clmm with a single simple random effects term using AGQ, GHQ ### or Laplace. { optim.error <- function(fit, method) if(inherits(fit, "try-error")) stop("optimizer ", method, " terminated with an error", call.=FALSE) ### OPTION: Could have an argument c(warn, fail, ignore) to optionally ### return the fitted model despite the optimizer failing. method <- match.arg(method) ## Set appropriate objective function: obj.fun <- if(rho$nAGQ < 0) getNGHQ.ssr else if(rho$nAGQ > 1) getNAGQ.ssr else getNLA.ssr ## nAGQ %in% c(0, 1) init.val <- obj.fun(rho, rho$par) if(!is.finite(init.val)) stop(gettextf("non-finite likelihood at starting value (%g)", init.val), call.=FALSE) ## Fit the model: if(method == "ucminf") { fit <- try(ucminf(rho$par, function(par) obj.fun(rho, par), control = control), silent=TRUE) ## Check if optimizer converged without error: optim.error(fit, method) ## Save return value: value <- fit$value } else if(method == "nlminb") { ## hack to remove ucminf control settings: keep <- !names(control) %in% c("grad", "grtol") control <- if(length(keep)) control[keep] else list() fit <- try(nlminb(rho$par, function(par) obj.fun(rho, par), control = control), silent=TRUE) ## Check if optimizer converged without error: optim.error(fit, method) ## Save return value: value <- fit$objective } else stop("unkown optimization method: ", method) ## Extract parameters from optimizer results: rho$par <- fit$par ## Ensure random mode estimation at optimum: nllBase.uC(rho) update.uC(rho) rho$ST <- par2ST(rho$tau, rho$ST) names(rho$ST) <- names(rho$dims$nlev.re) ## Format ranef modes and condVar: ranef <- rho$u * rho$tau condVar <- 1/rho$D * rho$tau^2 ## names(ranef) <- names(condVar) <- rho$random.names ## ranef <- list(ranef) ## condVar <- list(condVar) ## names(ranef) <- names(condVar) <- rho$tau.names ## Prepare list of results: res <- list(coefficients = fit$par[1:rho$dims$nfepar], ST = rho$ST, optRes = fit, logLik = -value, fitted.values = rho$fitted, ranef = ranef, condVar = condVar, dims = rho$dims, u = rho$u) ## Add gradient vector and optionally Hessian matrix: ## bound <- as.logical(paratBoundary2(rho)) ## optpar <- fit$par[!bound] if(Hess) { ## gH <- deriv12(function(par) obj.fun(rho, par, which=!bound), gH <- deriv12(function(par) obj.fun(rho, par), x=fit$par) res$gradient <- gH$gradient res$Hessian <- gH$Hessian } else { ## res$gradient <- grad.ctr(function(par) getNLA(rho, par, which=!bound), res$gradient <- grad.ctr(function(par) obj.fun(rho, par), x=fit$par) } ## Setting Niter and neval after gradient and Hessian evaluations: res$Niter <- rho$Niter res$neval <- rho$neval return(res) } getNGHQ.ssr <- function(rho, par) { ### negative log-likelihood by standard Gauss-Hermite quadrature ### implemented in C: if(!missing(par)) { rho$par <- par if(any(!is.finite(par))) stop(gettextf(paste(c("Non-finite parameters occured:", formatC(par, format="g")), collapse=" "))) } rho$neval <- rho$neval + 1L nllBase.uC(rho) ## Update tau, eta1Fix and eta2Fix with(rho, { .C("getNGHQ_C", nll = double(1), as.integer(grFac), as.double(tau), as.double(eta1Fix), as.double(eta2Fix), as.double(o1), as.double(o2), as.double(sigma), as.double(wts), length(sigma), length(uStart), as.double(ghqns), as.double(ghqws), as.integer(abs(nAGQ)), as.integer(linkInt), as.double(ghqns * tau), as.double(lambda))$nll }) } getNAGQ.ssr <- function(rho, par) { ### negative log-likelihood by adaptive Gauss-Hermite quadrature ### implemented in C: if(!missing(par)) { rho$par <- par if(any(!is.finite(par))) stop(gettextf(paste(c("Non-finite parameters occured:", formatC(par, format="g")), collapse=" "))) } rho$neval <- rho$neval + 1L if(!update.uC(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) with(rho, { .C("getNAGQ", nll = double(1), as.integer(grFac), as.double(tau), as.double(eta1Fix), as.double(eta2Fix), as.double(o1), as.double(o2), as.double(sigma), as.double(wts), length(sigma), length(uStart), as.double(ghqns), as.double(log(ghqws)), as.double(ghqns^2), as.double(u), as.double(D), as.integer(abs(nAGQ)), as.integer(linkInt), as.double(lambda))$nll }) } getNLA.ssr <- function(rho, par) { ### negative log-likelihood by the Laplace approximation ### (with update.u2 in C or R): if(!missing(par)) { rho$par <- par if(any(!is.finite(par))) stop(gettextf(paste(c("Non-finite parameters occured:", formatC(par, format="g")), collapse=" "))) } rho$neval <- rho$neval + 1L if(!update.uC(rho)) return(Inf) if(any(rho$D <= 0)) return(Inf) logDetD <- sum(log(rho$D)) rho$negLogLik - rho$nrandom*log(2*pi)/2 + logDetD/2 } nllBase.uC <- function(rho) { ### updates tau, eta1Fix and eta2Fix given new parameter values with(rho, { tau <- exp(par[nalpha + nbeta + 1:ntau]) eta1Fix <- drop(B1 %*% par[1:(nalpha + nbeta)]) eta2Fix <- drop(B2 %*% par[1:(nalpha + nbeta)]) }) return(invisible()) } update.uC <- function(rho) { ### C-implementation of NR-algorithm. nllBase.uC(rho) ## update: tau, eta1Fix, eta2Fix fit <- with(rho, { .C("NRalgv3", as.integer(ctrl$trace), as.integer(ctrl$maxIter), as.double(ctrl$gradTol), as.integer(ctrl$maxLineIter), as.integer(grFac), ## OBS as.double(tau), # stDev as.double(o1), as.double(o2), as.double(eta1Fix), as.double(eta2Fix), as.double(sigma), ## rep(1, n) as.integer(linkInt), ## as.double(wts), ## pre. weights u = as.double(uStart), fitted = as.double(fitted), ## pre. pr funValue = double(1), gradValues = as.double(uStart), hessValues = as.double(rep(1, length(uStart))), length(fitted), length(uStart), maxGrad = double(1), conv = 0L, as.double(lambda), ## Niter = as.integer(Niter) ## OBS )[c("u", "fitted", "funValue", "gradValues", "hessValues", "maxGrad", "conv", "Niter")] }) ## Get message: message <- switch(as.character(fit$conv), "1" = "max|gradient| < tol, so current iterate is probably solution", "0" = "Non finite negative log-likelihood", "-1" = "iteration limit reached when updating the random effects", "-2" = "step factor reduced below minimum when updating the random effects") ## Check for convergence and report warning/error: if(rho$ctrl$trace > 0 && fit$conv == 1) cat("\nOptimizer converged! ", "max|grad|:", fit$maxGrad, message, fill = TRUE) if(fit$conv != 1 && rho$ctrl$innerCtrl == "warnOnly") warning(message, "\n at iteration ", rho$Niter) else if(fit$conv != 1 && rho$ctrl$innerCtrl == "giveError") stop(message, "\n at iteration ", rho$Niter) ## Store values and return: rho$Niter <- fit$Niter rho$fitted <- fit$fitted rho$u <- fit$u rho$D <- fit$hessValues rho$gradient <- fit$gradValues if(!is.finite(rho$negLogLik <- fit$funValue)) return(FALSE) return(TRUE) } ordinal/R/clm.Thetamat.R0000644000176200001440000001223515127777530014570 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions (getThetamat) to compute a table of threshold ## coefficients from model fits (clm()s) with nominal effects. getThetamat <- function(terms, alpha, assign, contrasts, tJac, xlevels, sign.nominal) ### Compute matrix of thresholds for all combinations of levels of ### factors in the nominal formula. ### ### Input: ### terms: nominal terms object ### alpha: vector of threshold parameters ### assign: attr(NOM, "assign"), where NOM is the design matrix for ### the nominal effects ### contrasts: list of contrasts for the nominal effects ### tJac: threshold Jacobian with appropriate dimnames. ### xlevels: names of levels of factors among the nominal effects. ### sign.nominal: "positive" or "negative" ### ### Output: ### Theta: data.frame of thresholds ### mf.basic: if nrow(Theta) > 1 a data.frame with factors in columns ### and all combinations of the factor levels in rows. { ## Make matrix of thresholds; Theta: Theta <- matrix(alpha, ncol=ncol(tJac), byrow=TRUE) ## Matrix with variables-by-terms: factor.table <- attr(terms, "factors") all.varnm <- rownames(factor.table) ### NOTE: need to index with all.varnm not to include (weights) and ### possibly other stuff. var.classes <- attr(terms, "dataClasses")[all.varnm] numeric.var <- which(var.classes != "factor") ### NOTE: Logical variables are treated as numeric variables. numeric.terms <- factor.terms <- numeric(0) if(length(factor.table)) { ## Terms associated with numerical variables: numeric.terms <- which(colSums(factor.table[numeric.var, , drop=FALSE]) > 0) ## Terms only involving factor variables: factor.terms <- which(colSums(factor.table[numeric.var, , drop=FALSE]) == 0) } ## Remove rows in Theta for numeric variables: if(length(numeric.terms)) { ### NOTE: ncol(NOM) == length(asgn) == nrow(Theta) ### length(attr(terms, "term.labels")) == ncol(factor.table) ### NOTE: length(var.classes) == nrow(factor.table) numeric.rows <- which(assign %in% numeric.terms) Theta <- Theta[-numeric.rows, , drop=FALSE] ## Drop terms so the design matrix, X for the factors does not ## include numeric variables: if(length(factor.terms)) terms <- drop.terms(terms, dropx=numeric.terms, keep.response=FALSE) } ## if some nominal effects are factors: if(length(factor.terms)) { ## get xlevels for factors, not ordered (factors) factor.var <- which(var.classes == "factor") factor.varnm <- names(var.classes)[factor.var] xlev <- xlevels[factor.varnm] ## minimal complete model frame: mf.basic <- do.call(expand.grid, xlev) ## minimal complete design matrix: X <- model.matrix(terms, data=mf.basic, contrasts=contrasts[factor.varnm]) ### NOTE: get_clmDesign adds an intercept if its not there, so we need ### to do that as well here. Otherwise 'X[, keep, drop=FALSE]' will ### fail: if(!"(Intercept)" %in% colnames(X)) X <- cbind("(Intercept)" = rep(1, nrow(X)), X) if(sign.nominal == "negative") X[, -1] <- -X[, -1] ### NOTE: There are no contrasts for numerical variables, but there ### may be for ordered factors. ## From threshold parameters to thresholds: ### NOTE: some rows of Theta may contain NAs due to rank deficiency of ### the NOM design matrix. keep <- apply(Theta, 1, function(x) sum(is.na(x)) == 0) ## Theta <- apply(Theta, 2, function(th) X %*% th) tmp <- lapply(1:ncol(Theta), function(i) { X[, keep, drop=FALSE] %*% Theta[keep, i] }) Theta <- do.call(cbind, tmp) } ## Adjust each row in Theta for threshold functions: tmp <- lapply(seq_len(nrow(Theta)), function(i) c(tJac %*% Theta[i, ])) Theta <- do.call(rbind, tmp) ### NOTE: apply returns a vector and not a matrix when ncol(Theta) == ### 1, so we need to avoid it here. ## Theta <- t(apply(Theta, 1, function(th) tJac %*% th)) colnames(Theta) <- rownames(tJac) res <- list(Theta = as.data.frame(Theta)) ## add factor information if any: if(NROW(Theta) > 1) res$mf.basic <- mf.basic ## return: res } ordinal/R/contrast_utils.R0000644000176200001440000002575615127777530015340 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# # contrast-utils.R - utility functions for contrasts, terms and anova # -------- Contents: -------- # # containment # term_contain # relatives # doolittle # ensure_full_rank # get_rdX # extract_contrasts_type3 ############################################## ######## containment() ############################################## containment <- function(object) { # lm or merMod # For all terms 'T' in object compute the terms # Return a list: # for each term 'T' a vector of terms that contain 'T'. terms <- terms(object) data_classes <- attr(terms(object), "dataClasses") # Note: need fixed.only for merMod objects to get dataClasses term_names <- attr(terms, "term.labels") factor_mat <- attr(terms, "factors") lapply(setNames(term_names, term_names), function(term) { term_names[term_contain(term, factor_mat, data_classes, term_names)] }) } ############################################## ######## term_contain() ############################################## #' Determine which Terms Contain a Term #' #' The definition of \emph{containment} follows from the SAS documentation on #' "The Four Types of Estimable Functions". #' #' Containment is defined for two model terms, say, F1 and F2 as: #' F1 is contained in F2 (F2 contains F1) if #' \enumerate{ #' \item F1 and F2 involve the same continuous variables (if any) #' \item F2 involve more factors than F1 #' \item All factors in F1 (if any) are part of F2 #' } #' The intercept, though not really a model term, is defined by SAS to be #' contained in all factor terms, but it is not contained in any #' effect involving a continuous variable. #' #' @param term character; name of a model term and one of \code{term_names}. #' @param factors the result of \code{attr(terms_object, "factors")}. #' @param dataClasses the result of #' \code{attr(terms(model, fixed.only=FALSE), "dataClasses")}. Note that #' \code{fixed.only=FALSE} is only needed for \code{merMod} objects, but does #' no harm for \code{lm} objects. #' @param term_names the result of \code{attr(terms_object, "term.labels")}. #' #' @return a logical vector indicating for each term in \code{term_names} if #' it contains \code{term}. #' @importFrom stats setNames #' @keywords internal term_contain <- function(term, factors, dataClasses, term_names) { get_vars <- function(term) # Extract vector of names of all variables in a term rownames(factors)[factors[, term] == 1] contain <- function(F1, F2) { # Returns TRUE if F1 is contained in F2 (i.e. if F2 contains F1) # F1, F2: Names of terms, i.e. attr(terms_object, "term.labels") all(vars[[F1]] %in% vars[[F2]]) && # all variables in F1 are also in F2 length(setdiff(vars[[F2]], vars[[F1]])) > 0L && # F2 involve more variables than F1 setequal(numerics[[F1]], numerics[[F2]]) # F1 and F2 involve the same covariates (if any) } # Get (named) list of all variables in terms: vars <- lapply(setNames(term_names, term_names), get_vars) # Get (named) list of all _numeric_ variables in all terms: numerics <- lapply(vars, function(varnms) varnms[which(dataClasses[varnms] == "numeric")]) # Check if 'term' is contained in each model term: sapply(term_names, function(term_nm) contain(term, term_nm)) } ############################################## ######## doolittle() ############################################## #' Doolittle Decomposition #' #' @param x a numeric square matrix with at least 2 columns/rows. #' @param eps numerical tolerance on the whether to normalize with components #' in \code{L} with the diagonal elements of \code{U}. #' #' @return a list with two matrices of the same dimension as \code{x}: #' \item{L}{lower-left unit-triangular matrix} #' \item{U}{upper-right triangular matrix (\emph{not} unit-triangular)} #' #' @keywords internal doolittle <- function(x, eps = 1e-6) { if(!is.matrix(x) || ncol(x) != nrow(x) || !is.numeric(x)) stop("argument 'x' should be a numeric square matrix") stopifnot(ncol(x) > 1L) n <- nrow(x) L <- U <- matrix(0, nrow=n, ncol=n) diag(L) <- rep(1, n) for(i in 1:n) { ip1 <- i + 1 im1 <- i - 1 for(j in 1:n) { U[i,j] <- x[i,j] if (im1 > 0) { for(k in 1:im1) { U[i,j] <- U[i,j] - L[i,k] * U[k,j] } } } if ( ip1 <= n ) { for ( j in ip1:n ) { L[j,i] <- x[j,i] if ( im1 > 0 ) { for ( k in 1:im1 ) { L[j,i] <- L[j,i] - L[j,k] * U[k,i] } } L[j, i] <- if(abs(U[i, i]) < eps) 0 else L[j,i] / U[i,i] } } } L[abs(L) < eps] <- 0 U[abs(U) < eps] <- 0 list( L=L, U=U ) } ############################################## ######## ensure_full_rank() ############################################## #' Ensure a Design Matrix has Full (Column) Rank #' #' Determine and drop redundant columns using the \code{\link{qr}} #' decomposition. #' #' @param X a design matrix as produced by \code{model.matrix}. #' @param tol \code{qr} tolerance. #' @param silent throw message if columns are dropped from \code{X}? Default #' is \code{FALSE}. #' @param test.ans Test if the resulting/returned matrix has full rank? Default #' is \code{FALSE}. #' #' @return A design matrix in which redundant columns are dropped #' @keywords internal ensure_full_rank <- function(X, tol = 1e-7, silent = FALSE, test.ans = FALSE) { ### works if ncol(X) >= 0 and nrow(X) >= 0 ## test and match arguments: stopifnot(is.matrix(X)) silent <- as.logical(silent)[1] ## perform the qr-decomposition of X using LINPACK methods: qr.X <- qr(X, tol = tol, LAPACK = FALSE) if(qr.X$rank == ncol(X)) { ## return X if X has full column rank return(X) } if(!silent) ## message the no. dropped columns: message(gettextf("Design is column rank deficient so dropping %d coef", ncol(X) - qr.X$rank)) ## return the columns correponding to the first qr.x$rank pivot ## elements of X: keep <- with(qr.X, pivot[seq_len(rank)]) newX <- X[, keep, drop = FALSE] sel <- with(qr.X, pivot[-seq_len(rank)]) ## Copy old attributes: if(!is.null(contr <- attr(X, "contrasts"))) attr(newX, "contrasts") <- contr if(!is.null(asgn <- attr(X, "assign"))) attr(newX, "assign") <- asgn[-sel] ## did we succeed? stop-if-not: if(test.ans && qr.X$rank != qr(newX)$rank) stop(gettextf("Determination of full column rank design matrix failed"), call. = FALSE) return(newX) } ############################################## ######## get_rdX() ############################################## #' Compute the 'Full' Rank-Deficient Design Matrix #' #' #' @param model a model object; lmerMod or lmerModLmerTest. #' @param do.warn throw a message if there is no data for some factor #' combinations. #' #' @return the rank-deficien design matrix #' @author Rune Haubo B. Christensen #' @keywords internal #' #' @importFrom stats as.formula model.frame terms model.matrix get_rdX <- function(model, do.warn=TRUE) { # Compute rank-deficient design-matrix X usign contr.treatment coding. # # model: terms(model), model.frame(model), fixef(model) Terms <- terms(model, fixed.only=TRUE) term_names <- attr(Terms, "term.labels") df <- model.frame(model) # Compute rank-deficient (full) design-matrix, X: rdXi <- if(length(term_names)) lapply(term_names, function(trm) { form <- as.formula(paste0("~ 0 + ", trm)) model.matrix(form, data=df) # no contrast arg }) else list(model.matrix(~ 1, data=df)[, -1, drop=FALSE]) rdX <- do.call(cbind, rdXi) param_names <- unlist(lapply(rdXi, colnames)) # Potentially add intercept: has_intercept <- attr(Terms, "intercept") != 0 if(has_intercept) { rdX <- cbind('(Intercept)'=rep(1, nrow(rdX)), rdX) param_names <- c("(Intercept)", param_names) } colnames(rdX) <- param_names # Warn/message if there are cells without data: is_zero <- which(colSums(rdX) == 0) if(do.warn && length(is_zero)) { txt <- sprintf("Missing cells for: %s. ", paste(param_names[is_zero], collapse = ", ")) # warning(paste(txt, "\nInterpret type III hypotheses with care."), call.=FALSE) message(paste(txt, "\nInterpret type III hypotheses with care.")) } rdX } ############################################## ######## extract_contrasts_type3 ############################################## #' @importFrom MASS ginv #' @importFrom stats terms resid lm.fit extract_contrasts_type3 <- function(model, X=NULL) { # Computes contrasts for type III tests with reference to treatment contrast coding # X: Optional full rank design matrix in contr.treatment coding Terms <- terms(model) term_names <- attr(Terms, "term.labels") if(is.null(X)) { X <- get_model_matrix(model, type="remake", contrasts="contr.treatment") X <- ensure_full_rank(X) } # Get 'complete' design matrix: rdX <- get_rdX(model, do.warn = TRUE) # treatment contrasts # cols for aliased coefs should be removed in X; not in rdX. # This makes ginv(X) unique! L <- zapsmall(t(MASS::ginv(X) %*% rdX)) # basic contrast matrix dimnames(L) <- list(colnames(rdX), colnames(X)) # Orthogonalize contrasts for terms which are contained in other terms: map <- term2colX(Terms, X) is_contained <- containment(model) # Orthogonalize higher order terms before lower order terms: terms_order <- attr(Terms, "order") orthog_order <- term_names[order(terms_order, decreasing = TRUE)] # Only orthogonalize terms with columns in X: keep <- names(which(sapply(map[orthog_order], length) > 0)) for(term in keep) { # term <- keep[2] # if term is contained in other terms: if(length(contains <- is_contained[[term]]) > 0) { # orthogonalize cols in L for 'term' wrt. cols that contain 'term': L[, map[[term]]] <- zapsmall(resid(lm.fit(x=L[, unlist(map[contains]), drop=FALSE], y=L[, map[[term]], drop=FALSE]))) } } # Keep rows in L corresponding to model coefficients: L <- L[colnames(X), , drop=FALSE] # Extract list of contrast matrices from L - one for each term: Llist <- lapply(map[term_names], function(term) t(L[, term, drop=FALSE])) # Keep and return all non-zero rows: lapply(Llist, function(L) L[rowSums(abs(L)) > 1e-8, , drop=FALSE]) } ordinal/R/clm.slice2D.R0000644000176200001440000002060215127777530014303 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# slice2D <- function(object, ...) { UseMethod("slice2D") } slice2D.clm <- function(object, parm=seq_along(par), lambda=3, grid=20, ...) { ## argument matching and testing: stopifnot(is.numeric(lambda) && lambda > 0) stopifnot(is.numeric(grid) && grid >= 1) grid <- as.integer(round(grid)) par <- coef(object, na.rm=TRUE) par.names <- names(par) stopifnot(length(parm) == length(unique(parm))) if(is.character(parm)) parm <- match(parm, par.names, nomatch = 0) if(!all(parm %in% seq_along(par))) stop("invalid 'parm' argument") stopifnot(length(parm) >= 2L) parm <- as.integer(parm) nparm <- length(parm) ## parm is an integer vector indexing non-aliased coef. ml <- object$logLik parm.names <- par.names[parm] mle <- par[parm] ## get environment corresponding to object: env <- get_clmRho(object) ## env <- update(object, doFit=FALSE) names(par) <- NULL env$par <- as.vector(par) ## set env$par to mle stopifnot(isTRUE(all.equal(env$clm.nll(env), -object$logLik))) ## generate sequence of parameters at which to compute the ## log-likelihood: curv <- sqrt(1/diag(object$Hessian)) ## curvature in nll wrt. par par.range <- par + curv %o% (c(-1, 1) * lambda) ## All pairwise combinations: pairs <- t(combn(seq_len(nparm), 2)) ncombn <- nrow(pairs) ### Allow for sequential paired comparisons? par.seq <- lapply(parm, function(ind) { seq(par.range[ind, 1], par.range[ind, 2], length = grid) }) names(par.seq) <- par.names zlist <- vector(mode="list", length=ncombn) names(zlist) <- paste(par.names[pairs[, 1]], par.names[pairs[, 2]], sep=".") for(k in 1:ncombn) { i <- pairs[k, 1] j <- pairs[k, 2] xx <- expand.grid(x=par.seq[[i]], y=par.seq[[j]]) ## Set parameter values to MLEs: env$par <- par ## Compute log-likelihood over entire grid: z <- apply(xx, 1, function(x) { env$par[c(i, j)] <- as.vector(x); env$clm.nll(env) }) ## Store log-likelihood values in a matrix: zlist[[k]] <- matrix(z, ncol=grid) } res <- list(zlist=zlist, par.seq=par.seq, par.range=par.range, pairs=pairs, original.fit=object, mle=mle) class(res) <- c("slice2D.clm") res } safe.as.int <- function(x) as.integer(round(x)) plot.slice2D.clm <- function(x, parm = seq_along(orig.par), ## How to specify default values ## of parm? plot.mle = TRUE, ask = prod(par("mfcol")) < nrow(pairs) && dev.interactive(), ...) ### parm: a character vector or integer vector of length >= 2 with ### those par-combinations to make contour plots. { ## stopifnot(all parm in names(par.seq)) orig.par <- coef(x$original.fit, na.rm=TRUE) ### More parm stuff here... stopifnot(is.numeric(parm) && length(parm) >= 2L) parm <- as.integer(round(parm)) par.names <- names(orig.par) ## of <- attr(x, "original.fit") ## par <- coef(of) ## ml <- of$logLik keep <- (x$pairs[, 1] %in% parm) & (x$pairs[, 2] %in% parm) pairs <- x$pairs[keep, , drop=FALSE] stopifnot(length(pairs) >= 2) if(ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } ## Plotting the contours: for(k in seq_len(nrow(pairs))) { i <- pairs[k, 1] j <- pairs[k, 2] contour(x$par.seq[[i]], x$par.seq[[j]], x$zlist[[k]], xlab = par.names[i], ylab = par.names[j]) points(orig.par[i], orig.par[j], pch = 4, col = "red", lwd = 2) } return(invisible()) } sliceg.clm <- function(object, parm = seq_along(par), lambda = 3, grid = 1e2, quad.approx = TRUE, ...) { ## argument matching and testing: stopifnot(is.numeric(lambda) && lambda > 0) stopifnot(is.numeric(grid) && grid >= 1) grid <- as.integer(round(grid)) par <- coef(object, na.rm=TRUE) par.names <- names(par) npar <- length(par) stopifnot(length(parm) == length(unique(parm))) if(is.character(parm)) parm <- match(parm, par.names, nomatch = 0) ### disallow character argument due to ambiguity? if(!all(parm %in% seq_along(par))) stop("invalid 'parm' argument") stopifnot(length(parm) > 0) parm <- as.integer(round(parm)) ## parm is an integer vector indexing non-aliased coef. ml <- object$logLik parm.names <- par.names[parm] ## get environment corresponding to object: rho <- get_clmRho(object) ## rho <- update(object, doFit = FALSE) names(par) <- NULL rho$par <- par ## set rho$par to mle stopifnot(isTRUE(all.equal(rho$clm.nll(rho), -object$logLik))) ## generate sequence of parameters at which to compute the ## log-likelihood: curv <- sqrt(1/diag(object$Hessian)) ## curvature in nll wrt. par par.range <- par + curv %o% c(-lambda, lambda) ## par.seq - list of length npar with a sequence of values for each ## parameter : par.seq <- lapply(parm, function(ind) { seq(par.range[ind, 1], par.range[ind, 2], length = grid) }) ## compute relative logLik for all par.seq for each par: logLik <- lapply(seq_along(parm), function(i) { # for each par rho$par <- par ## reset par values to MLE sapply(par.seq[[ i ]], function(par.val) { # for each par.seq value rho$par[ parm[i] ] <- par.val rho$clm.nll(rho) rho$clm.grad(rho)[ parm[i] ] }) }) ## collect parameter sequences and relative logLik in a list of ## data.frames: res <- lapply(seq_along(parm), function(i) { structure(data.frame(par.seq[[ i ]], logLik[[ i ]]), ## names = c(parm.names[i], "logLik")) names = c(parm.names[i], "gradient")) }) ## set attributes: names(res) <- parm.names attr(res, "original.fit") <- object attr(res, "mle") <- par[parm] ## class(res) <- "slice.clm" class(res) <- "sliceg.clm" ## if(!quad.approx) return(res) ## ## compute quadratic approx to *positive* logLik: ## Quad <- function(par, mle, curv) ## -((mle - par)^2 / curv^2 / 2) ## for(i in seq_along(parm)) ## res[[ i ]]$quad <- ## Quad(par.seq[[ i ]], par[ parm[i] ], curv[ parm[i] ]) return(res) } plot.sliceg.clm <- function(x, parm = seq_along(x), type = c("quadratic", "linear"), plot.mle = TRUE, ask = prod(par("mfcol")) < length(parm) && dev.interactive(), ...) { ## Initiala argument matching and testing: type <- match.arg(type) stopifnot(is.numeric(parm)) parm <- as.integer(round(parm)) of <- attr(x, "original.fit") par <- coef(of) ml <- of$logLik ## take the signed sqrt of nll and quad: ## if(type == "linear") { ## sgn.sqrt <- function(par, mle, logLik) ## (2 * (par > mle) - 1) * sqrt(-logLik) ## mle <- coef(attr(x, "original.fit")) ## for(i in parm) { ## x[[i]]$logLik <- sgn.sqrt(x[[i]][1], mle[i], x[[i]]$logLik) ## if(!is.null(x[[i]]$quad)) ## x[[i]]$quad <- sgn.sqrt(x[[i]][1], mle[i], x[[i]]$quad) ## } ## ylab <- "Signed log-likelihood root" ## } ## else ## ylab <- "Relative log-likelihood" ylab <- "Gradient" if(ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } ## actual plotting: for(i in parm) { z <- x[[i]] plot(z[1:2], type = "l", ylab=ylab, ...) if(!is.null(z$quad)) lines(z[[1]], z[[3]], lty = 2) if(plot.mle && type == "quadratic") ## abline(v = par[i]) abline(v = attr(x, "mle")[i]) ## abline(v = par[names(x)[i]]) } return(invisible()) } ordinal/R/derivatives.R0000644000176200001440000001312615127777530014574 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions for finite difference computations of derivatives ## (gradient and Hessian) of user-specified functions. deriv12 <- function(fun, x, delta=1e-4, fx=NULL, ...) { ### Compute gradient and Hessian at the same time (to save computing ### time) nx <- length(x) fx <- if(!is.null(fx)) fx else fun(x, ...) stopifnot(length(fx) == 1) H <- array(NA, dim=c(nx, nx)) g <- numeric(nx) for(j in 1:nx) { ## Diagonal elements: xadd <- xsub <- x xadd[j] <- x[j] + delta xsub[j] <- x[j] - delta fadd <- fun(xadd, ...) fsub <- fun(xsub, ...) H[j, j] <- (fadd - 2 * fx + fsub) / delta^2 g[j] <- (fadd - fsub) / (2 * delta) ## Off diagonal elements: for(i in 1:nx) { if(i >= j) break ## Compute upper triangular elements: xaa <- xas <- xsa <- xss <- x xaa[c(i, j)] <- x[c(i, j)] + c(delta, delta) xas[c(i, j)] <- x[c(i, j)] + c(delta, -delta) xsa[c(i, j)] <- x[c(i, j)] + c(-delta, delta) xss[c(i, j)] <- x[c(i, j)] - c(delta, delta) H[i, j] <- H[j, i] <- (fun(xaa, ...) - fun(xas, ...) - fun(xsa, ...) + fun(xss, ...)) / (4 * delta^2) } } list(gradient = g, Hessian = H) } myhess <- function(fun, x, fx=NULL, delta=1e-4, ...) { nx <- length(x) fx <- if(!is.null(fx)) fx else fun(x, ...) stopifnot(length(fx) == 1) H <- array(NA, dim=c(nx, nx)) for(j in 1:nx) { ## Diagonal elements: xadd <- xsub <- x xadd[j] <- x[j] + delta xsub[j] <- x[j] - delta H[j, j] <- (fun(xadd, ...) - 2 * fx + fun(xsub, ...)) / delta^2 ## Upper triangular (off diagonal) elements: for(i in 1:nx) { if(i >= j) break xaa <- xas <- xsa <- xss <- x xaa[c(i, j)] <- x[c(i, j)] + c(delta, delta) xas[c(i, j)] <- x[c(i, j)] + c(delta, -delta) xsa[c(i, j)] <- x[c(i, j)] + c(-delta, delta) xss[c(i, j)] <- x[c(i, j)] - c(delta, delta) H[j, i] <- H[i, j] <- (fun(xaa, ...) - fun(xas, ...) - fun(xsa, ...) + fun(xss, ...)) / (4 * delta^2) } } H } mygrad <- function(fun, x, delta = 1e-4, method = c("central", "forward", "backward"), ...) { method <- match.arg(method) nx <- length(x) if(method %in% c("central", "forward")) { Xadd <- matrix(rep(x, nx), nrow=nx, byrow=TRUE) + diag(delta, nx) fadd <- apply(Xadd, 1, fun, ...) } if(method %in% c("central", "backward")) { Xsub <- matrix(rep(x, nx), nrow=nx, byrow=TRUE) - diag(delta, nx) fsub <- apply(Xsub, 1, fun, ...) ## eval.parent perhaps? } res <- switch(method, "forward" = (fadd - fun(x, ...)) / delta, "backward" = (fun(x, ...) - fsub) / delta, "central" = (fadd - fsub) / (2 * delta) ) res } grad.ctr3 <- function(fun, x, delta=1e-4, ...) { nx <- length(x) Xadd <- matrix(rep(x, nx), nrow=nx, byrow=TRUE) + diag(delta, nx) Xsub <- matrix(rep(x, nx), nrow=nx, byrow=TRUE) - diag(delta, nx) fadd <- apply(Xadd, 1, fun, ...) fsub <- apply(Xsub, 1, fun, ...) ## eval.parent perhaps? (fadd - fsub) / (2 * delta) } grad.ctr2 <- function(fun, x, delta=1e-4, ...) { ans <- x for(i in seq_along(x)) { xadd <- xsub <- x xadd[i] <- x[i] + delta xsub[i] <- x[i] - delta ans[i] <- (fun(xadd, ...) - fun(xsub, ...)) / (2 * delta) } ans } grad.ctr <- function(fun, x, delta=1e-4, ...) { sapply(seq_along(x), function(i) { xadd <- xsub <- x xadd[i] <- x[i] + delta xsub[i] <- x[i] - delta (fun(xadd, ...) - fun(xsub, ...)) / (2 * delta) }) } grad <- grad.ctr grad.ctr4 <- function(fun, x, delta=1e-4, ...) { ### - checking finiteness of x and fun-values ### - taking care to avoid floating point errors ### - not using h=x*delta rather than h=delta (important for small or ### large x?) if(!all(is.finite(x))) stop("Cannot compute gradient: non-finite argument") ans <- x ## return values for(i in seq_along(x)) { xadd <- xsub <- x ## reset fun arguments xadd[i] <- x[i] + delta xsub[i] <- x[i] - delta ans[i] <- (fun(xadd, ...) - fun(xsub, ...)) / (xadd[i] - xsub[i]) ### NOTE: xadd[i] - xsub[i] != 2*delta with floating point arithmetic. } if(!all(is.finite(ans))) { warning("cannot compute gradient: non-finite function values occured") ans[!is.finite(ans)] <- Inf } ans } ordinal/R/clm.anova.R0000644000176200001440000002723115127777530014127 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# # clm.anova.R single_anova <- function(object, type = c("III", "II", "I", "3", "2", "1", "marginal", "2b")) { type <- type[1L] if(!is.character(type)) type <- as.character(type) type <- match.arg(type) if(type %in% c("I", "II", "III")) type <- as.character(as.integer(as.roman(type))) if(any(is.na(vcov(object)))) stop("anova table not available with non-finite values in vcov(object)") # Get list of contrast matrices (L) - one for each model term: L_list <- if(type == "1") { get_contrasts_type1(object) } else if(type == "2") { get_contrasts_type2_unfolded(object) } else if(type == "2b") { get_contrasts_type2(object) } else if(type == "3") { get_contrasts_type3(object) } else if(type == "marginal") { get_contrasts_marginal(object) } else { stop("'type' not recognized") } # Add cols to L for alpha, zeta and lambda params: L_list <- adjust_contrast_for_param(object, L_list) # Get F-test for each term and collect in table: table <- rbindall(lapply(L_list, function(L) contestMD(object, L))) # Format ANOVA table and return: if(length(nm <- setdiff(names(L_list), rownames(table)))) { tab <- array(NA_real_, dim=c(length(nm), ncol(table)), dimnames = list(nm, colnames(table))) table <- rbind(table, tab)[names(L_list), ] } # Format 'type': type <- if(type == "marginal") { "Marginal" } else if(grepl("b|c", type)) { alph <- gsub("[0-9]", "", type) paste0("Type ", as.roman(as.integer(gsub("b|c", "", type))), alph) } else paste("Type", as.roman(as.integer(type))) attr(table, "heading") <- paste(type, "Analysis of Deviance Table with Wald chi-square tests\n") attr(table, "hypotheses") <- L_list class(table) <- c("anova", "data.frame") table } adjust_contrast_for_param <- function(model, L) { nalpha <- length(model$alpha) nzeta <- if(is.null(model$zeta)) 0L else length(model$zeta) nlambda <- if(is.null(model$lambda)) 0L else length(model$lambda) nextra <- nzeta + nlambda # pre and post add extra cols to L: add <- function(L) { pre <- array(0, dim=c(nrow(L), nalpha)) post <- array(0, dim=c(nrow(L), nextra)) cbind(pre, L[, -1L, drop=FALSE], post) } if(!is.list(L)) add(L) else lapply(L, add) } model_matrix <- function(object, ...) { if(!inherits(object, "clm")) return(model.matrix(object, ...)) X <- model.matrix(object)$X if(!any(object$aliased$beta)) return(X) remove <- c(FALSE, object$aliased$beta) newX <- X[, !remove, drop=FALSE] attr(newX, "assign") <- attr(X, "assign")[!remove] contr <- attr(X, "contrasts") if(!is.null(contr)) attr(newX, "contrasts") <- contr newX } contestMD <- function(model, L, rhs=0, eps=sqrt(.Machine$double.eps), ...) { mk_Qtable <- function(Qvalue, df) { pvalue <- pchisq(q=Qvalue, df=df, lower.tail=FALSE) data.frame("Df"=df, "Chisq"=Qvalue, "Pr(>Chisq)"=pvalue, check.names = FALSE) } if(!is.matrix(L)) L <- matrix(L, ncol=length(L)) stopifnot(is.matrix(L), is.numeric(L), ncol(L) == length(coef(model, na.rm=TRUE))) if(length(rhs) == 1L) rhs <- rep(rhs, nrow(L)) stopifnot(is.numeric(rhs), length(rhs) == nrow(L)) if(nrow(L) == 0L) { # May happen if there are no fixed effects x <- numeric(0L) return(mk_Qtable(x, x)) } if(any(is.na(L))) return(mk_Qtable(NA_real_, NA_real_)) beta <- coef(model, na.rm=TRUE) vcov_beta <- vcov(model) # Adjust beta for rhs: if(!all(rhs == 0)) beta <- beta - drop(MASS::ginv(L) %*% rhs) # Compute Var(L beta) and eigen-decompose: VLbeta <- L %*% vcov_beta %*% t(L) # Var(contrast) = Var(Lbeta) eig_VLbeta <- eigen(VLbeta) P <- eig_VLbeta$vectors d <- eig_VLbeta$values tol <- max(eps * d[1], 0) pos <- d > tol q <- sum(pos) # rank(VLbeta) if(q < nrow(L) && !all(rhs == 0)) warning("Contrast is rank deficient and test may be affected") if(q <= 0) { # shouldn't happen if L is a proper contrast x <- numeric(0L) return(mk_Qtable(x, x)) } PtL <- crossprod(P, L)[1:q, ] # Compute t-squared values and Q-value: t2 <- drop(PtL %*% beta)^2 / d[1:q] Qvalue <- sum(t2) mk_Qtable(Qvalue, df=q) } ############################################## ######## get_contrasts_type3 ############################################## get_contrasts_type3 <- function(model, which=NULL) { term_names <- attr(terms(model), "term.labels") # Extract original design matrix: Xorig <- model_matrix(model) # Assumes Xorig is full (column) rank if(is.null(which)) { which <- term_names # If model has at most one term return Type I contrasts: if(ncol(Xorig) <= 1L || length(term_names) <= 1L) return(get_contrasts_type1(model)) } else stopifnot(is.character(which), all(which %in% term_names)) # Extract contrast coding in Xorig: codings <- unlist(attr(Xorig, "contrast")) # If only treatment contrasts are used we can just return the type 3 # contrasts for contr.treatment coding: if(length(codings) > 0 && all(is.character(codings)) && all(codings %in% c("contr.treatment"))) return(extract_contrasts_type3(model, X=Xorig)) # otherwise we need to map the type III contrasts to whatever contrast # coding was used: X <- get_model_matrix(model, type="remake", contrasts="contr.treatment") # Ensure that X is full (column) rank: X <- ensure_full_rank(X, silent=TRUE, test.ans=FALSE) # Extract contrasts assuming contr.treatment coding: type3ctr <- extract_contrasts_type3(model, X=X) map <- zapsmall(ginv(X) %*% Xorig) # Maps between contrast codings rownames(map) <- colnames(X) lapply(type3ctr[which], function(L) L %*% map) } ############################################## ######## get_contrasts_type1 ############################################## get_contrasts_type1 <- function(model) { terms <- terms(model) X <- model_matrix(model) nalpha <- length(model$alpha) p <- ncol(X) if(p == 0L) return(list(matrix(numeric(0L), nrow=0L))) # no fixef if(p == 1L && attr(terms, "intercept")) # intercept-only model return(list(matrix(numeric(0L), ncol=nalpha))) # Compute 'normalized' doolittle factorization of XtX: L <- if(p == 1L) matrix(1L) else t(doolittle(crossprod(X))$L) dimnames(L) <- list(colnames(X), colnames(X)) # Determine which rows of L belong to which term: ind.list <- term2colX(terms, X)[attr(terms, "term.labels")] lapply(ind.list, function(rows) L[rows, , drop=FALSE]) } ############################################## ######## get_contrasts_type2_unfolded ############################################## get_contrasts_type2_unfolded <- function(model, which=NULL) { # Computes the 'genuine type II contrast' for all terms that are # contained in other terms. For all terms which are not contained in other # terms, the simple marginal contrast is computed. X <- model_matrix(model) Terms <- terms(model) term_names <- attr(Terms, "term.labels") if(is.null(which)) { which <- term_names # If model has at most one term return Type I contrasts: if(ncol(X) <= 1L || length(term_names) <= 1L) return(get_contrasts_type1(model)) } else stopifnot(is.character(which), all(which %in% term_names)) is_contained <- containment(model) do_marginal <- names(is_contained)[sapply(is_contained, length) == 0L] do_type2 <- setdiff(term_names, do_marginal) if(!length(do_marginal)) list() else Llist <- get_contrasts_marginal(model, which=do_marginal) if(length(do_type2)) Llist <- c(Llist, get_contrasts_type2(model, which=do_type2)) Llist[term_names] } ############################################## ######## get_contrasts_type2 ############################################## get_contrasts_type2 <- function(model, which=NULL) { # Computes the type 2 contrasts - either for all terms or for those # included in 'which' (a chr vector naming model terms). # returns a list X <- model_matrix(model) nalpha <- length(model$alpha) terms <- terms(model) data_classes <- attr(terms(model), "dataClasses") if(is.null(asgn <- attr(X, "assign"))) stop("design matrix 'X' should have a non-null 'assign' attribute") term_names <- attr(terms, "term.labels") if(is.null(which)) { which <- term_names # If model has at most one term return Type I contrasts: if(ncol(X) <= 1L || length(term_names) <= 1L) return(get_contrasts_type1(model)) } else stopifnot(is.character(which), all(which %in% term_names)) which <- setNames(as.list(which), which) # Compute containment: is_contained <- containment(model) # Compute term asignment list: map from terms to columns in X has_intercept <- attr(terms, "intercept") > 0 col_terms <- if(has_intercept) c("(Intercept)", term_names)[asgn + 1] else term_names[asgn[asgn > 0]] if(!length(col_terms) == ncol(X)) # should never happen. stop("An error happended when computing Type II contrasts") term2colX <- split(seq_along(col_terms), col_terms)[unique(col_terms)] # Compute contrast for each term - return as named list: lapply(which, function(term) { # Reorder the cols in X to [, unrelated_to_term, term, contained_in_term] cols_term <- unlist(term2colX[c(term, is_contained[[term]])]) Xnew <- cbind(X[, -cols_term, drop=FALSE], X[, cols_term, drop=FALSE]) # Compute order of terms in Xnew: newXcol_terms <- c(col_terms[-cols_term], col_terms[cols_term]) # Compute Type I contrasts for the reordered X: Lc <- t(doolittle(crossprod(Xnew))$L) dimnames(Lc) <- list(colnames(Xnew), colnames(Xnew)) # Extract rows for term and get original order of columns: Lc[newXcol_terms == term, colnames(X), drop=FALSE] }) } ############################################## ######## get_contrasts_marginal ############################################## #' @importFrom stats model.matrix terms get_contrasts_marginal <- function(model, which=NULL) { # Computes marginal contrasts. # # No tests of conformity with coefficients are implemented # # returns a list X <- model_matrix(model) terms <- terms(model) term_names <- attr(terms, "term.labels") if(is.null(which)) { which <- term_names # If model has at most one term return Type I contrasts: if(ncol(X) <= 1L || length(term_names) <= 1L) return(get_contrasts_type1(model)) } else stopifnot(is.character(which), all(which %in% term_names)) # Compute map from terms to columns in X and contrasts matrix term2colX <- term2colX(terms, X) L <- structure(diag(ncol(X)), dimnames = list(colnames(X), colnames(X))) # Extract contrast for each term - return as named list: which <- setNames(as.list(which), which) lapply(which, function(term) { L[term2colX[[term]], , drop=FALSE] }) } ############################################## ######## rbindall ############################################## rbindall <- function(...) do.call(rbind, ...) cbindall <- function(...) do.call(cbind, ...) ordinal/R/convergence.R0000644000176200001440000002563115127777530014551 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions to assess and check convergence of CLMs. Some ## functions/methods are exported and some are used internally in ## clm(). convergence <- function(object, ...) { UseMethod("convergence") } convergence.clm <- function(object, digits = max(3, getOption("digits") - 3), tol = sqrt(.Machine$double.eps), ...) ### Results: data.frame with columns: ### Estimate ### Std. Error ### Gradient - gradient of the coefficients at optimizer termination ### Error - the signed error in the coefficients at termination ### Rel. Error - the relative error in the coefficeints at termination ### ### The (signed) Error is determined as the Newton step, so this is ### only valid close to the optimum where the likelihood function is ### quadratic. ### ### The relative error equals step/Estimate. { ## get info table and coef-table: info <- object$info[c("nobs", "logLik", "niter", "max.grad", "cond.H")] ## Initialize coef-table with NAs: coefs <- coef(object, na.rm=TRUE) g <- object$gradient H <- object$Hessian tab <- matrix(NA_real_, nrow=length(coefs), ncol=6L, dimnames=list(names(coef(object, na.rm=TRUE)), c("Estimate", "Std.Err", "Gradient", "Error", "Cor.Dec", "Sig.Dig"))) tab[, c(1L, 3L)] <- cbind(coefs, g) res <- list(info=info, coefficients=tab, original.fit=object) class(res) <- "convergence.clm" if(!all(is.finite(H))) { warning("non-finite values in Hessian: illegitimate model fit") return(res) } ## Get eigen values of Hessian: res$eigen.values <- e.val <- eigen(H, symmetric=TRUE, only.values=TRUE)$values ## Compute Cholesky factor of Hessian: ch <- try(chol(H), silent=TRUE) if(any(abs(e.val) <= tol) || inherits(ch, "try-error")) { return(res) } ## Hessian is positive definite: ## Compute approximate error in the coefficients: step <- c(backsolve(ch, backsolve(ch, g, transpose=TRUE))) if(max(abs(step)) > 1e-2) warning("convergence assessment may be unreliable ", "due to large numerical error") ## Compute approximate error in the log-likelihood function: env <- get_clmRho(object) ## Note: safer to get env this way. ## env <- update(object, doFit=FALSE) env$par <- coef(object, na.rm=TRUE) - step new.logLik <- -env$clm.nll(env) new.max.grad <- max(abs(env$clm.grad(env))) if(new.max.grad > max(abs(g)) && max(abs(step)) > tol) warning("Convergence assessment may be unreliable: ", "please assess the likelihood with slice()") ### NOTE: we only warn if step is larger than a tolerance, since if ### step \sim 1e-16, the max(abs(grad)) may increase though stay ### essentially zero. logLik.err <- object$logLik - new.logLik err <- format.pval(logLik.err, digits=2, eps=1e-10) if(!length(grep("<", err))) err <- formatC(as.numeric(err), digits=2, format="e") res$info$logLik.Error <- err ## Fill in the coef-table: se <- sqrt(diag(chol2inv(ch))) res$coefficients[, c(2, 4:6)] <- cbind(se, step, cor.dec(step), signif.digits(coefs, step)) res } print.convergence.clm <- function(x, digits = max(3, getOption("digits") - 3), ...) { ## Prepare for printing: print(x$info, row.names=FALSE, right=FALSE) cat("\n") tab.print <- coef(x) for(i in 1:2) tab.print[,i] <- format(c(coef(x)[,i]), digits=digits) for(i in 3:4) tab.print[,i] <- format(c(coef(x)[,i]), digits=max(1, digits - 1)) print(tab.print, quote=FALSE, right=TRUE, ...) ## Print eigen values: cat("\nEigen values of Hessian:\n") cat(format(x$eigen.values, digits=digits), "\n") conv <- x$original.fit$convergence cat("\nConvergence message from clm:\n") for(i in seq_along(conv$code)) { Text <- paste("(", conv$code[i], ") ", conv$messages[i], sep="") cat(Text, "\n") } if(!is.null(alg.text <- conv$alg.message)) cat(paste("In addition:", alg.text), "\n") cat("\n") ## for(i in seq_along(conv$code)) { ## cat("Code: Message:\n", fill=TRUE) ## cat(conv$code[i], " ", conv$message[i], "\n", fill=TRUE) ## } ## if(!is.null(alg.text <- conv$alg.message)) { ## cat("\nIn addition: ", alg.text, "\n\n", fill=TRUE) ## } return(invisible(x)) } cor.dec <- function(error) { ### computes the no. correct decimals in a number if 'error' is the ### error in the number. ### The function is vectorized. xx <- -log10(abs(error)) lead <- floor(xx) res <- ifelse(xx < lead - log10(.5), lead-1, lead) res[abs(error) >= .05] <- 0 as.integer(round(res)) } signif.digits <- function(value, error) { ### Determines the number of significant digits in 'value' if the ### absolute error in 'value' is 'error'. ### The function is vectorized. res <- cor.dec(error) + ceiling(log10(abs(value))) res[res < 0] <- 0 as.integer(round(res)) } conv.check <- function(fit, control=NULL, Theta.ok=NULL, tol=sqrt(.Machine$double.eps), ...) ## function(gr, Hess, conv, method, gradTol, relTol, ## tol=sqrt(.Machine$double.eps), ...) ### Compute variance-covariance matrix and check convergence along the ### way. ### fit: clm-object or the result of clm_fit_NR() | gradient, Hessian, ### (control), convergence ### control: (tol), (method), gradTol, relTol ### ### Return: list with elements ### vcov, conv, cond.H, messages and { if(missing(control)) control <- fit$control if(is.null(control)) stop("'control' not supplied - cannot check convergence") if(!is.null(control$tol)) tol <- control$tol if(tol < 0) stop(gettextf("numerical tolerance is %g, expecting non-negative value", tol), call.=FALSE) ### OPTION: test this. H <- fit$Hessian g <- fit$gradient max.grad <- max(abs(g)) cov <- array(NA_real_, dim=dim(H), dimnames=dimnames(H)) cond.H <- NA_real_ res <- list(vcov=cov, code=integer(0L), cond.H=cond.H, messages=character(0L)) class(res) <- "conv.check" if(is.list(code <- fit$convergence)) code <- code[[1L]] mess <- switch(as.character(code), "0" = "Absolute and relative convergence criteria were met", "1" = "Absolute convergence criterion was met, but relative criterion was not met", "2" = "iteration limit reached", "3" = "step factor reduced below minimum", "4" = "maximum number of consecutive Newton modifications reached") if(control$method != "Newton") mess <- NULL ### OPTION: get proper convergence message from optim, nlminb, ucminf etc. res <- c(res, alg.message=mess) ## } evd <- eigen(H, symmetric=TRUE, only.values=TRUE)$values negative <- sum(evd < -tol) if(negative) { res$code <- -2L res$messages <- gettextf(paste("Model failed to converge:", "degenerate Hessian with %d negative eigenvalues"), negative) return(res) } ## Add condition number to res: res$cond.H <- max(evd) / min(evd) ## Compute Newton step: ch <- try(chol(H), silent=TRUE) if(max.grad > control$gradTol) { res$code <- -1L res$messages <- gettextf("Model failed to converge with max|grad| = %g (tol = %g)", max.grad, control$gradTol) ## Compute var-cov: vcov <- try(chol2inv(ch), silent=TRUE) if(!inherits(vcov, "try-error")) res$vcov[] <- vcov return(res) } if(!is.null(Theta.ok) && !Theta.ok) { res$code <- -3L res$messages <- "not all thresholds are increasing: fit is invalid" ## Compute var-cov: vcov <- try(chol2inv(ch), silent=TRUE) if(!inherits(vcov, "try-error")) res$vcov[] <- vcov return(res) } zero <- sum(abs(evd) < tol) if(zero || inherits(ch, "try-error")) { res$code <- 1L res$messages <- "Hessian is numerically singular: parameters are not uniquely determined" return(res) } ### NOTE: Only do the following if 'ch <- try(chol(H), silent=TRUE)' ### actually succedded: step <- c(backsolve(ch, backsolve(ch, g, transpose=TRUE))) ## Compute var-cov: res$vcov[] <- chol2inv(ch) ### NOTE: we want res$vcov to be present in all of the situations ### below. if(max(abs(step)) > control$relTol) { res$code <- c(res$code, 1L) corDec <- as.integer(min(cor.dec(step))) res$messages <- c(res$messages, gettextf("some parameters may have only %d correct decimals", corDec)) } if(max(evd) * tol > 1) { res$code <- c(res$code, 2L) res$messages <- c(res$messages, paste("Model is nearly unidentifiable: ", "very large eigenvalue", "\n - Rescale variables?", sep="")) } if((min(evd) / max(evd)) < tol) { res$code <- c(res$code, 3L) if(!5L %in% res$code) { res$messages <- c(res$messages, paste("Model is nearly unidentifiable: ", "large eigenvalue ratio", "\n - Rescale variables?", sep="")) } } if(!length(res$code)) { res$code <- 0L res$messages <- "successful convergence" } res } cov.conv <- conv.check ### OPTION: let convergence() print convergence info from clm using ### print.conv.check print.conv.check <- function(x, action=c("warn", "silent", "stop", "message"), ...) { action <- match.arg(action) if(x$code[1L] == 0L || action == "silent") return(invisible()) Text <- paste("(", x$code[1L], ") ", x$messages[1L], sep="") if(!is.null(alg.text <- x$alg.message)) Text <- paste(Text, "\nIn addition:", alg.text) switch(action, "stop" = stop(Text, call.=FALSE), "warn" = warning(Text, call.=FALSE), "message" = message(Text)) } ordinal/R/clm.R0000644000176200001440000001366515127777530013032 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## The main clm function and some auxiliary functions to generate the ## model frame and handle the model environment. checkArgs.clm <- function(mc) { nm <- names(as.list(mc)) if(!"formula" %in% nm) stop("Model needs a formula", call.=FALSE) if("offset" %in% nm) stop("offset argument not allowed: ", "specify 'offset' in formula or scale arguments instead") invisible() } clm <- function(formula, scale, nominal, data, weights, start, subset, doFit = TRUE, na.action, contrasts, model = TRUE, control = list(), link = c("logit", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) { mc <- match.call(expand.dots = FALSE) link <- match.arg(link) threshold <- match.arg(threshold) if(missing(contrasts)) contrasts <- NULL if(missing(start)) start <- NULL checkArgs.clm(mc=match.call()) ## set control parameters: ## getControl.clm control <- do.call(clm.control, c(control, list(...))) ## Extract and process formulas: call.envir <- parent.frame(n=1) formulas <- get_clmFormulas(mc, call.envir) ## Get full model.frame and terms.objects: fullmf <- get_clm.mf(mc, formulas$fullForm, attr(formulas, "envir"), call.envir) if(control$method == "model.frame") return(fullmf) terms.list <- if(any(c("scale", "nominal") %in% names(formulas))) get_clmTerms(mc, formulas, call.envir) else list(formula=terms(fullmf)) ## Get y, X, weights, off etc.: design <- get_clmDesign(fullmf, terms.list, contrasts) lst <- namedList(doFit, control, link, threshold, start, formulas) if(control$method == "design") return(c(design, lst)) ## Get clm.struct: design <- c(design, makeThresholds(design$y.levels, threshold)) design <- drop.cols(design, silent=TRUE, drop.scale=FALSE) clm.struct <- c(design, lst) ## Fit model, check convergence, or return a model environment: fit <- clm.fit.default(clm.struct) if(doFit == FALSE) return(fit) ## Format output, prepare result: keep <- c("terms", "contrasts", "xlevels", # formula "S.terms", "S.contrasts", "S.xlevels", # scale "nom.terms", "nom.contrasts", "nom.xlevels", # nominal "na.action", "y", "y.levels", "control", "link", "threshold", "start", "formulas") res <- c(fit, clm.struct[match(keep, names(clm.struct), 0L)], list(formula=lst$formulas$formula, call=match.call())) ## res$tJac <- format_tJac(res$tJac, res$y.levels, clm.struct$alpha.names) res$info=get_clmInfoTab(res) if(model) res$model <- fullmf res <- res[sort(names(res))] class(res) <- "clm" res } clm.newRho <- function(parent=parent.frame(), y, X, NOM=NULL, S=NULL, weights, offset, S.offset=NULL, tJac, control=clm.control(), ...) ### Setting variables in rho: B1, B2, o1, o2, weights. { ## Make B1, B2, o1, o2 based on y, X and tJac: keep <- weights > 0 y[!keep] <- NA y <- droplevels(y) ntheta <- nlevels(y) - 1 y <- c(unclass(y)) y[is.na(y)] <- 0 n <- sum(keep) B2 <- 1 * (col(matrix(0, nrow(X), ntheta + 1)) == y) o1 <- c(1e5 * B2[keep, ntheta + 1]) - offset[keep] o2 <- c(-1e5 * B2[keep, 1]) - offset[keep] B1 <- B2[keep, -(ntheta + 1), drop = FALSE] B2 <- B2[keep, -1, drop = FALSE] ## adjust B1 and B2 for structured thresholds: B1 <- B1 %*% tJac B2 <- B2 %*% tJac ## update B1 and B2 with nominal effects: if(!is.null(NOM) && ncol(NOM) > 1) { ## if !is.null(NOM) and NOM is more than an intercept: if(control$sign.nominal == "negative") NOM[, -1] <- -NOM[, -1] LL1 <- lapply(1:ncol(NOM), function(x) B1 * NOM[keep, x]) B1 <- do.call(cbind, LL1) LL2 <- lapply(1:ncol(NOM), function(x) B2 * NOM[keep, x]) B2 <- do.call(cbind, LL2) } ## update B1 and B2 with location effects (X): nbeta <- ncol(X) - 1 if(nbeta > 0) { if(control$sign.location == "negative") X <- -X B1 <- cbind(B1, X[keep, -1, drop = FALSE]) B2 <- cbind(B2, X[keep, -1, drop = FALSE]) } dimnames(B1) <- NULL dimnames(B2) <- NULL n.psi <- ncol(B1) ## no. linear model parameters ## there may be scale offset without scale predictors: sigma <- Soff <- if(is.null(S.offset)) rep(1, n) else exp(S.offset[keep]) ## save scale model matrix: k <- 0 if(!is.null(S)) { S <- S[keep, -1, drop=FALSE] dimnames(S) <- NULL k <- ncol(S) ## no. scale parameters } has.scale <- ## TRUE if scale has to be considered. (!is.null(S) || any(S.offset != 0)) ## initialize fitted values and weights: fitted <- numeric(length = n) wts <- weights[keep] lst <- namedList(B1, B2, o1, o2, n.psi, S, Soff, k, sigma, has.scale, fitted, wts, clm.nll, clm.grad, clm.hess) list2env(x=lst, parent=parent) } ordinal/R/warning_functions.R0000644000176200001440000000252415127777530016004 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# givesWarnings <- function(expr) countWarnings(expr) > 0L countWarnings <- function(expr) { .number_of_warnings <- 0L frame_number <- sys.nframe() ans <- withCallingHandlers(expr, warning = function(w) { assign(".number_of_warnings", .number_of_warnings + 1L, envir = sys.frame(frame_number)) invokeRestart("muffleWarning") }) .number_of_warnings } ordinal/R/drop.coef.R0000644000176200001440000001506515127777530014132 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions that can drop columns from rank-deficient design ## matrices. One is exported and others used internally. drop.coef <- function(X, silent = FALSE) ### works if ncol(X) >= 0 and nrow(X) >= 0 { ## test and match arguments: stopifnot(is.matrix(X)) silent <- as.logical(silent)[1] ## perform the qr-decomposition of X using LINPACK methods: qr.X <- qr(X, tol = 1e-7, LAPACK = FALSE) if(qr.X$rank == ncol(X)) return(X) ## return X if X has full column rank if(!silent) ## message the no. dropped columns: message(gettextf("design is column rank deficient so dropping %d coef", ncol(X) - qr.X$rank)) ## return the columns correponding to the first qr.x$rank pivot ## elements of X: newX <- X[, qr.X$pivot[1:qr.X$rank], drop = FALSE] ## did we succeed? stop-if-not: if(qr.X$rank != qr(newX)$rank) stop(gettextf("determination of full column rank design matrix failed"), call. = FALSE) return(newX) } drop.coef2 <- function(X, tol = 1e-7, silent = FALSE, test.ans = FALSE) ### works if ncol(X) >= 0 and nrow(X) >= 0 { ## test and match arguments: stopifnot(is.matrix(X)) silent <- as.logical(silent)[1] aliased <- rep.int(0, ncol(X)) ## perform the qr-decomposition of X using LINPACK methods: qr.X <- qr(X, tol = tol, LAPACK = FALSE) if(qr.X$rank == ncol(X)) { ## return X if X has full column rank attr(X, "aliased") <- aliased attr(X, "orig.colnames") <- colnames(X) return(X) } if(!silent) ## message the no. dropped columns: message(gettextf("design is column rank deficient so dropping %d coef", ncol(X) - qr.X$rank)) ## return the columns correponding to the first qr.x$rank pivot ## elements of X: newX <- X[, qr.X$pivot[1:qr.X$rank], drop = FALSE] sel <- qr.X$pivot[-(1:qr.X$rank)] aliased[sel] <- 1 attr(newX, "aliased") <- aliased attr(newX, "orig.colnames") <- colnames(X) ## Copy old attributes: attributes(newX)$contrasts <- attributes(X)$contrasts attr(newX, "assign") <- attr(X, "assign")[-sel] ## did we succeed? stop-if-not: if(test.ans && qr.X$rank != qr(newX)$rank) stop(gettextf("determination of full column rank design matrix failed"), call. = FALSE) return(newX) } drop.cols <- function(mf, silent = FALSE, drop.scale=TRUE) ### drop columns from X and possibly NOM and S to ensure full column ### rank. ### mf - list with X and possibly NOM and S design matrices. Includes ### alpha.names ### ### returns: updated version of mf. { nalpha <- length(mf$alpha.names) ## X is assumed to contain an intercept at this point: Xint <- match("(Intercept)", colnames(mf$X), nomatch = 0) if(Xint <= 0) { mf$X <- cbind("(Intercept)" = rep(1, nrow(mf$X)), mf$X) warning("an intercept is needed and assumed") } ## intercept in X is guaranteed. if(!is.null(mf[["NOM"]])){ ## store coef names: mf$coef.names <- list() mf$coef.names$alpha <- paste(rep(mf$alpha.names, ncol(mf$NOM)), ".", rep(colnames(mf$NOM), each=nalpha), sep="") mf$coef.names$beta <- colnames(mf$X)[-1] ## drop columns from NOM: mf$NOM <- drop.coef2(mf$NOM, silent=silent) ## drop columns from X: NOMX <- drop.coef2(cbind(mf$NOM, mf$X[,-1, drop=FALSE]), silent=silent) ## extract and store X: mf$X <- cbind("(Intercept)" = rep(1, nrow(mf$X)), NOMX[,-seq_len(ncol(mf$NOM)), drop=FALSE]) ## store alias information: mf$aliased <- list(alpha = rep(attr(mf$NOM, "aliased"), each=nalpha)) mf$aliased$beta <- attr(NOMX, "aliased")[-seq_len(ncol(mf$NOM))] if(drop.scale && !is.null(mf[["S"]])) { mf$coef.names$zeta <- colnames(mf$S)[-1] ## drop columns from S: NOMS <- drop.coef2(cbind(mf$NOM, mf$S[,-1, drop=FALSE]), silent=silent) ## extract and store S: mf$S <- cbind("(Intercept)" = rep(1, nrow(mf$S)), NOMS[,-seq_len(ncol(mf$NOM)), drop=FALSE]) mf$aliased$zeta <- attr(NOMS, "aliased")[-seq_len(ncol(mf$NOM))] } else if(!is.null(mf[["S"]])) { Sint <- match("(Intercept)", colnames(mf$S), nomatch = 0) if(Sint <= 0) { mf$S <- cbind("(Intercept)" = rep(1, nrow(mf$S)), mf$S) warning("an intercept is needed and assumed in 'scale'", call.=FALSE) } ## intercept in S is guaranteed. mf$coef.names$zeta <- colnames(mf$S)[-1] mf$S <- drop.coef2(mf$S, silent=silent) mf$aliased$zeta <- attr(mf$S, "aliased")[-1] } return(mf) } ## end !is.null(mf[["NOM"]]) ## drop columns from X assuming an intercept: mf$coef.names <- list(alpha = mf$alpha.names, beta = colnames(mf$X)[-1]) mf$X <- drop.coef2(mf$X, silent=silent) mf$aliased <- list(alpha = rep(0, nalpha), beta = attr(mf$X, "aliased")[-1]) ## drop columns from S if relevant: if(!is.null(mf[["S"]])) { Sint <- match("(Intercept)", colnames(mf$S), nomatch = 0) if(Sint <= 0) { mf$S <- cbind("(Intercept)" = rep(1, nrow(mf$S)), mf$S) warning("an intercept is needed and assumed in 'scale'", call.=FALSE) } ## intercept in S is guaranteed. mf$coef.names$zeta <- colnames(mf$S)[-1] mf$S <- drop.coef2(mf$S, silent=silent) mf$aliased$zeta <- attr(mf$S, "aliased")[-1] } return(mf) } ordinal/R/clmm.formula.R0000644000176200001440000001012015127777530014632 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions to process lmer-style mixed-model formulae. These ## functions are borrowed from the lme4 package but have later been ## modified. findbars <- function(term) ### Return the pairs of expressions that separated by vertical bars { if (is.name(term) || !is.language(term)) return(NULL) if (term[[1]] == as.name("(")) return(findbars(term[[2]])) if (!is.call(term)) stop("term must be of class call") if (term[[1]] == as.name('|')) return(term) if (length(term) == 2) return(findbars(term[[2]])) c(findbars(term[[2]]), findbars(term[[3]])) } nobars <- function(term) ### term - usually the third element of a formula object: formula[[3]] ### returns a list of terms ### Return the formula omitting the pairs of expressions that are ### separated by vertical bars { if (!('|' %in% all.names(term))) return(term) if (is.call(term) && term[[1]] == as.name('|')) return(NULL) if (length(term) == 2) { nb <- nobars(term[[2]]) if (is.null(nb)) return(NULL) term[[2]] <- nb return(term) } nb2 <- nobars(term[[2]]) nb3 <- nobars(term[[3]]) if (is.null(nb2)) return(nb3) if (is.null(nb3)) return(nb2) term[[2]] <- nb2 term[[3]] <- nb3 term } subbars <- function(term) ### Substitute the '+' function for the '|' function { if (is.name(term) || !is.language(term)) return(term) if (length(term) == 2) { term[[2]] <- subbars(term[[2]]) return(term) } stopifnot(length(term) >= 3) if (is.call(term) && term[[1]] == as.name('|')) term[[1]] <- as.name('+') for (j in 2:length(term)) term[[j]] <- subbars(term[[j]]) term } subnms <- function(term, nlist) ### Substitute any names from nlist in term with 1 { if (!is.language(term)) return(term) if (is.name(term)) { if (any(unlist(lapply(nlist, get("=="), term)))) return(1) return(term) } stopifnot(length(term) >= 2) for (j in 2:length(term)) term[[j]] <- subnms(term[[j]], nlist) term } slashTerms <- function(x) ### Return the list of '/'-separated terms in an expression that ### contains slashes { if (!("/" %in% all.names(x))) return(x) if (x[[1]] != as.name("/")) stop("unparseable formula for grouping factor") list(slashTerms(x[[2]]), slashTerms(x[[3]])) } makeInteraction <- function(x) ### from a list of length 2 return recursive interaction terms { if (length(x) < 2) return(x) trm1 <- makeInteraction(x[[1]]) trm11 <- if(is.list(trm1)) trm1[[1]] else trm1 list(substitute(foo:bar, list(foo=x[[2]], bar = trm11)), trm1) } expandSlash <- function(bb) ### expand any slashes in the grouping factors returned by findbars { if (!is.list(bb)) return(expandSlash(list(bb))) ## I really do mean lapply(unlist(... - unlist returns a ## flattened list in this case unlist(lapply(bb, function(x) { if (length(x) > 2 && is.list(trms <- slashTerms(x[[3]]))) return(lapply(unlist(makeInteraction(trms)), function(trm) substitute(foo|bar, list(foo = x[[2]], bar = trm)))) x })) } ordinal/R/lgamma.R0000644000176200001440000000515715127777530013512 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## [pdg]lgamma functions for the log-gamma distribution [lgamma]. ## Here glgamma is the gradient of the density function, dlgamma. ## The log-gamma distribution is ## used as a flexible link function in clm2() and clmm2(). plgamma <- function(q, lambda, lower.tail = TRUE) .C("plgamma_C", q = as.double(q), length(q), as.double(lambda[1]), as.integer(lower.tail[1]), NAOK = TRUE)$q plgammaR <- function(eta, lambda, lower.tail = TRUE) { q <- lambda v <- q^(-2) * exp(q * eta) if(q < 0) p <- 1 - pgamma(v, q^(-2)) if(q > 0) p <- pgamma(v, q^(-2)) if(isTRUE(all.equal(0, q, tolerance = 1e-6))) p <- pnorm(eta) if(!lower.tail) 1 - p else p } dlgamma <- function(x, lambda, log = FALSE) { stopifnot(length(lambda) == 1 && length(log) == 1) .C("dlgamma_C", x = as.double(x), length(x), as.double(lambda), as.integer(log), NAOK = TRUE)$x } dlgammaR <- function(x, lambda, log = FALSE) { q <- lambda q.2 <- q^(-2) qx <- q * x log.d <- log(abs(q)) + q.2 * log(q.2) - lgamma(q.2) + q.2 * (qx - exp(qx)) if (!log) exp(log.d) else log.d } glgamma <- function(x, lambda) { stopifnot(length(lambda) == 1) .C("glgamma_C", x = as.double(x), length(x), as.double(lambda[1]), NAOK = TRUE)$x } glgammaR <- function(x, lambda) { stopifnot(length(lambda) == 1) (1 - exp(lambda * x))/lambda * dlgamma(x, lambda) } glgammaR2 <- function(x, lambda) { stopifnot(length(lambda == 1)) if(lambda == 0) return(gnorm(x)) y <- dlgamma(x, lambda) y[!is.na(y) && y > 0] <- y * (1 - exp(lambda * x)) return(y) } ordinal/R/AO.R0000644000176200001440000000475015127777530012551 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## [pdg]AO functions for the Aranda-Ordaz distribution. Here gAO is ## the gradient of the density function, dAO. The AO distribution is ## used as a flexible link function in clm2() and clmm2(). pAOR <- function(q, lambda, lower.tail = TRUE) { if(lambda < 1e-6) stop("'lambda' has to be positive. lambda = ", lambda, " was supplied") p <- 1 - (lambda * exp(q) + 1)^(-1/lambda) if(!lower.tail) 1 - p else p } pAO <- function(q, lambda, lower.tail = TRUE) .C("pAO_C", q = as.double(q), length(q), as.double(lambda[1]), as.integer(lower.tail), NAOK = TRUE)$q dAOR <- function(eta, lambda, log = FALSE) { ### exp(eta) * (lambda * exp(eta) + 1)^(-1-1/lambda) stopifnot(length(lambda) == 1 && length(log) == 1) if(lambda < 1e-6) stop("'lambda' has to be positive. lambda = ", lambda, " was supplied") log.d <- eta - (1 + 1/lambda) * log(lambda * exp(eta) + 1) if(!log) exp(log.d) else log.d } dAO <- function(eta, lambda, log = FALSE) { stopifnot(length(lambda) == 1 && length(log) == 1) .C("dAO_C", eta = as.double(eta), length(eta), as.double(lambda), as.integer(log), NAOK = TRUE)$eta } gAOR <- function(eta, lambda) { stopifnot(length(lambda) == 1) lex <- lambda * exp(eta) dAO(eta, lambda) * (1 - (1 + 1/lambda) * lex/(1 + lex)) } gAO <- function(eta, lambda) { stopifnot(length(lambda) == 1) .C("gAO_C", eta = as.double(eta), length(eta), as.double(lambda[1]), NAOK = TRUE)$eta } ordinal/R/clmm.start.R0000644000176200001440000000254015127777530014331 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions to compute starting values for clmm()s. clmm.start <- function(frames, link, threshold) { ## get starting values from clm: fit <- with(frames, clm.fit(y=y, X=X, weights=wts, offset=off, link=link, threshold=threshold)) ## initialize variance parameters to zero: start <- c(fit$par, rep(0, length(frames$grList))) return(start) } ordinal/R/clmm2.utils.R0000755000176200001440000003276415127777530014434 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Utility functions for fitting CLMMs with clmm2(). ### OPTION: Could make use of getFittedC throughout this file... .negLogLikMfastR <- function(rho) { ## negative log-likelihood ### .negLogLikMfast in R with(rho, { o21 <- u[grFac] * stDev o11 <- o1 - o21 o21 <- o2 - o21 eta1 <- (eta1Fix + o11)/sigma eta2 <- (eta2Fix + o21)/sigma pr <- if(nlambda) pfun(eta1, lambda) - pfun(eta2, lambda) else pfun(eta1) - pfun(eta2) if(any(is.na(pr)) || any(pr <= 0)) nll <- Inf else nll <- -sum(weights * log(pr)) - sum(dnorm(x=u, mean=0, sd=1, log=TRUE)) nll }) } .negLogLikM <- function(rho) { ## negative log-likelihood with(rho, { if(estimStDev) stDev <- exp(par[p+nxi+k+estimLambda+ 1:s]) o21 <- u[grFac] * stDev o11 <- o1 - o21 o21 <- o2 - o21 if(estimLambda > 0) lambda <- par[nxi + p + k + 1:estimLambda] sigma <- if(k > 0) expSoffset * exp(drop(Z %*% par[nxi+p + 1:k])) else expSoffset eta1Fix <- drop(B1 %*% par[1:(nxi + p)]) eta2Fix <- drop(B2 %*% par[1:(nxi + p)]) eta1 <- (eta1Fix + o11)/sigma eta2 <- (eta2Fix + o21)/sigma pr <- if(nlambda) pfun(eta1, lambda) - pfun(eta2, lambda) else pfun(eta1) - pfun(eta2) if(any(is.na(pr)) || any(pr <= 0)) nll <- Inf else nll <- -sum(weights * log(pr)) - sum(dnorm(x=u, mean=0, sd=1, log=TRUE)) nll }) } .gradM <- function(rho) { ## gradient of the negative log-likelihood with(rho, { if(nlambda) { p1 <- dfun(eta1, lambda) p2 <- dfun(eta2, lambda) } else { p1 <- dfun(eta1) p2 <- dfun(eta2) } wtprSig <- weights/pr/sigma .C("gradC", as.double(stDev), as.double(p1), as.double(p2), as.double(wtprSig), as.integer(grFac), length(wtprSig), u = as.double(u), length(u))$u ## tapply(stDev * wtprSig * (p1 - p2), grFac, sum) + u }) } .gradC <- function(rho) { tmp <- with(rho, { .C("grad_C", as.double(stDev), p1 = double(length(pr)), p2 = double(length(pr)), as.double(pr), as.double(weights), as.double(sigma), wtprSig = double(length(pr)), as.double(eta1), as.double(eta2), gradValues = double(length(u)), as.double(u), as.integer(grFac), length(pr), length(u), as.double(lambda), as.integer(linkInt))[c("p1", "p2", "wtprSig", "gradValues")] }) rho$wtprSig <- tmp$wtprSig rho$p1 <- tmp$p1 rho$p2 <- tmp$p2 tmp$gradValues } .hessC <- function(rho) { with(rho, { .C("hess", as.double(stDev), as.double(p1), as.double(p2), as.double(pr), as.double(wtprSig), as.double(eta1), as.double(eta2), as.integer(linkInt), as.integer(grFac), length(pr), hessValues = double(length(u)), as.double(lambda), length(u))$hessValues }) } .hessianM <- function(rho) ## hessian of the negative log-likelihood with(rho,{ if(nlambda) { g1 <- gfun(eta1, lambda) g2 <- gfun(eta2, lambda) } else { g1 <- gfun(eta1) g2 <- gfun(eta2) } .C("hessC", as.double(stDev), as.double(p1), as.double(p2), as.double(pr), as.double(g1), as.double(g2), as.double(wtprSig), as.integer(grFac), length(pr), z = double(length(u)), length(u))$z ## tapply(((p1 - p2)^2 / pr - g1 + g2) * wtprSig, grFac, sum) * ## stDev^2 + 1 }) update.u2.v2 <- function(rho) { ### second version: C-implementation of NR-algorithm. .negLogLikBase(rho) ## update: par, stDev, eta1Fix, eta2Fix eta2Fix, sigma fit <- with(rho, .C("NRalg", as.integer(ctrl$trace), as.integer(ctrl$maxIter), as.double(ctrl$gradTol), as.integer(ctrl$maxLineIter), as.integer(grFac), as.double(stDev), as.double(o1), as.double(o2), as.double(eta1Fix), as.double(eta2Fix), as.double(eta1), as.double(eta2), as.double(sigma), as.integer(linkInt), as.double(weights), u = as.double(uStart), pr = as.double(pr), funValue = as.double(nll), gradValues = as.double(uStart), hessValues = as.double(uStart), length(pr), length(uStart), maxGrad = double(1), conv = 0L, double(length(pr)), # p1 double(length(pr)), # p2 double(length(pr)), # wtprSig as.double(lambda), Niter = as.integer(Niter) )[c("u", "pr", "funValue", "gradValues", "hessValues", "maxGrad", "conv", "Niter")] ) ## Get message: message <- switch(as.character(fit$conv), "1" = "max|gradient| < tol, so current iterate is probably solution", "0" = "Non finite negative log-likelihood", "-1" = "iteration limit reached when updating the random effects", "-2" = "step factor reduced below minimum when updating the random effects") ## check for convergence and report warning/error: if(rho$ctrl$trace > 0 && fit$conv == 1) cat("\nOptimizer converged! ", "max|grad|:", fit$maxGrad, message, fill = TRUE) if(fit$conv != 1 && rho$ctrl$innerCtrl == "warnOnly") warning(message, "\n at iteration ", rho$Niter) else if(fit$conv != 1 && rho$ctrl$innerCtrl == "giveError") stop(message, "\n at iteration ", rho$Niter) ## Store values and return: rho$Niter <- fit$Niter rho$u <- fit$u rho$D <- fit$hessValue rho$gradient <- fit$gradValue if(!is.finite(rho$negLogLik <- fit$funValue)) return(FALSE) return(TRUE) } update.u2 <- function(rho) { stepFactor <- 1 innerIter <- 0 rho$u <- rho$uStart rho$negLogLik <- .negLogLikM(rho) if(!is.finite(rho$negLogLik)) return(FALSE) rho$gradient <- .gradC(rho) maxGrad <- max(abs(rho$gradient)) conv <- -1 ## Convergence flag message <- "iteration limit reached when updating the random effects" if(rho$ctrl$trace > 0) Trace(iter=0, stepFactor, rho$negLogLik, maxGrad, rho$u, first=TRUE) ## Newton-Raphson algorithm: for(i in 1:rho$ctrl$maxIter) { if(maxGrad < rho$ctrl$gradTol) { message <- "max|gradient| < tol, so current iterate is probably solution" if(rho$ctrl$trace > 0) cat("\nOptimizer converged! ", "max|grad|:", maxGrad, message, fill = TRUE) conv <- 0 break } rho$D <- .hessC(rho) ## rho$D <- .hessianM(rho) step <- rho$gradient / rho$D rho$u <- rho$u - stepFactor * step negLogLikTry <- .negLogLikMfast(rho) lineIter <- 0 ## simple line search, i.e. step halfing: while(negLogLikTry > rho$negLogLik) { stepFactor <- stepFactor/2 rho$u <- rho$u + stepFactor * step negLogLikTry <- .negLogLikMfast(rho) lineIter <- lineIter + 1 if(rho$ctrl$trace > 0) Trace(i+innerIter, stepFactor, rho$negLogLik, maxGrad, rho$u, first=FALSE) if(lineIter > rho$ctrl$maxLineIter){ message <- "step factor reduced below minimum when updating the random effects" conv <- 1 break } innerIter <- innerIter + 1 } rho$negLogLik <- negLogLikTry rho$gradient <- .gradC(rho) maxGrad <- max(abs(rho$gradient)) if(rho$ctrl$trace > 0) Trace(i+innerIter, stepFactor, rho$negLogLik, maxGrad, rho$u, first=FALSE) stepFactor <- min(1, 2 * stepFactor) } if(conv != 0 && rho$ctrl$innerCtrl == "warnOnly") { warning(message, "\n at iteration ", rho$Niter) utils::flush.console() } else if(conv != 0 && rho$ctrl$innerCtrl == "giveError") stop(message, "\n at iteration ", rho$Niter) rho$Niter <- rho$Niter + i rho$D <- .hessC(rho) if(!is.finite(rho$negLogLik)) return(FALSE) else return(TRUE) } .hessMinC <- function(rho) { with(rho,{ if(nlambda) { g1 <- gfun(eta1, lambda) g2 <- gfun(eta2, lambda) } else { g1 <- gfun(eta1) g2 <- gfun(eta2) } .C("hessC", as.double(stDev), as.double(p1), as.double(p2), as.double(pr), as.double(g1), as.double(g2), as.double(wtprSig), as.integer(grFac), length(pr), z = double(length(u)), length(u))$z }) } .gradMinC <- function(stDev, p1, p2, wtprSig, grFac, u) .C("gradC", as.double(stDev), as.double(p1), as.double(p2), as.double(wtprSig), as.integer(unclass(grFac)), as.integer(length(wtprSig)), u = as.double(u), as.integer(length(u)))$u .gradMinC <- function(rho) { with(rho, { if(nlambda) { p1 <- dfun(eta1, lambda) p2 <- dfun(eta2, lambda) } else { p1 <- dfun(eta1) p2 <- dfun(eta2) } wtprSig <- weights/pr/sigma .C("gradC", as.double(stDev), as.double(p1), as.double(p2), as.double(wtprSig), as.integer(grFac), length(wtprSig), u = as.double(u), length(u))$u }) } grFacSumC <- function(x, grFac, u) .C("grFacSum_C", as.double(x), as.integer(grFac), as.integer(length(x)), u = as.double(u), as.integer(length(u)))$u grFacSum <- function(x, grFac, n.x, u, n.u) { ## i, j, z z <- 0 for (i in 1:n.u) { for (j in 1:n.x) if(grFac[j] == i) z <- z + x[j] u[i] <- z + u[i] z <- 0 } u } getNAGQ2 <- function(rho, par) { ### Not in use if(!missing(par)) rho$par <- par if(!update.u2(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) with(rho, { K <- sqrt(2/D) agqws <- K %*% t(ghqws) agqns <- apply(K %*% t(ghqns), 2, function(x) x + u) ranNew <- apply(agqns, 2, function(x) x[grFac] * stDev) eta1Tmp <- (eta1Fix + o1 - ranNew) / sigma eta2Tmp <- (eta2Fix + o2 - ranNew) / sigma if(nlambda) ## PRnn <- (pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))^weights ## This is likely a computationally more safe solution: PRnn <- exp(weights * log(pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))) else ## PRnn <- (pfun(eta1Tmp) - pfun(eta2Tmp))^weights PRnn <- exp(weights * log(pfun(eta1Tmp) - pfun(eta2Tmp))) for(i in 1:r) ## PRrn[i,] <- apply(PRnn[grFac == i, ], 2, prod) PRrn[i,] <- apply(PRnn[grFac == i, ,drop = FALSE], 2, prod) PRrn <- PRrn * agqws * dnorm(x=agqns, mean=0, sd=1) ### OPTION: Could this be optimized by essentially computing dnorm 'by hand'? }) -sum(log(rowSums(rho$PRrn))) } getNGHQ <- function(rho, par) { ### Not in use if(!missing(par)) rho$par <- par .negLogLikM(rho) ## Update lambda, stDev, sigma and eta*Fix with(rho, { eta1Tmp <- (eta1Fix + o1 - ranNew * stDev) / sigma eta2Tmp <- (eta2Fix + o2 - ranNew * stDev) / sigma if(nlambda) PRnn <- exp(weights * log(pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))) else PRnn <- exp(weights * log(pfun(eta1Tmp) - pfun(eta2Tmp))) for(i in 1:r) PRrn[i,] <- apply(PRnn[grFac == i, ,drop = FALSE], 2, prod) PRrn <- PRrn * agqws * dnorm(x=agqns, mean=0, sd=1) }) -sum(log(rowSums(rho$PRrn))) } ordinal/R/clm.start.R0000644000176200001440000001175715127777530014166 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions to compute starting values for CLMs in clm(). set.start <- function(rho, start=NULL, get.start=TRUE, threshold, link, frames) { ## set starting values for the parameters: nScol <- if(is.null(frames[["S"]])) 0 else ncol(frames[["S"]]) # no cols in S nSpar <- pmax(0, nScol - 1) # no Scale parameters if(get.start) { start <- ## not 'starting' scale effects: clm.start(y.levels=frames$y.levels, threshold=threshold, X=frames$X, NOM=frames$NOM, has.intercept=TRUE) if(nSpar > 0 || # NCOL(frames[["S"]]) > 1 link == "cauchit" || length(rho$lambda)) { ### NOTE: only special start if nSpar > 0 (no reason for ### special start if scale is only offset and no predictors). ### NOTE: start cauchit models at the probit estimates if start is not ### supplied: ### NOTE: start models with lambda at model with probit link rho$par <- start if(link %in% c("Aranda-Ordaz", "log-gamma", "cauchit")) { setLinks(rho, link="probit") } else { setLinks(rho, link) } tempk <- rho$k rho$k <- 0 ## increased gradTol and relTol: fit <- try(clm_fit_NR(rho, control=list(gradTol=1e-3, relTol=1e-3)), silent=TRUE) if(inherits(fit, "try-error")) stop("Failed to find suitable starting values: please supply some", call.=FALSE) start <- c(fit$par, rep(0, nSpar)) if(length(rho$lambda) > 0) start <- c(start, rho$lambda) attr(start, "start.iter") <- fit$niter rho$k <- tempk setLinks(rho, link) # reset link in rho } } ## test start: stopifnot(is.numeric(start)) length.start <- ncol(rho$B1) + nSpar + length(rho$lambda) if(length(start) != length.start) stop(gettextf("length of start is %d should equal %d", length(start), length.start), call.=FALSE) return(start) } start.threshold <- function(y.levels, threshold = c("flexible", "symmetric", "symmetric2", "equidistant")) ### args: ### y.levels - levels of the model response, at least of length two ### threshold - threshold structure, character. { ## match and test arguments: threshold <- match.arg(threshold) ny.levels <- length(y.levels) ntheta <- ny.levels - 1L if(threshold %in% c("symmetric", "symmetric2", "equidistant") && ny.levels < 3) stop(gettextf("symmetric and equidistant thresholds are only meaningful for responses with 3 or more levels")) ## default starting values: start <- qlogis((1:ntheta) / (ntheta + 1) ) # just a guess ## adjusting for threshold functions: if(threshold == "symmetric" && ntheta %% 2) { ## ntheta odd >= 3 nalpha <- (ntheta + 1) / 2 start <- c(start[nalpha], diff(start[nalpha:ntheta])) ## works for ## ntheta >= 1 } if(threshold == "symmetric" && !ntheta %% 2) {## ntheta even >= 4 nalpha <- (ntheta + 2) / 2 start <- c(start[c(nalpha - 1, nalpha)], diff(start[nalpha:ntheta])) ## works for ntheta >= 2 } if(threshold == "symmetric2" && ntheta %% 2) { ## ntheta odd >= 3 nalpha <- (ntheta + 3) / 2 start <- start[nalpha:ntheta] ## works for ntheta >= 3 } if(threshold == "symmetric2" && !ntheta %% 2) {## ntheta even >= 4 nalpha <- (ntheta + 2) / 2 start <- start[nalpha:ntheta] ## works for ntheta >= 2 } if(threshold == "equidistant") start <- c(start[1], mean(diff(start))) ## return starting values for the threshold parameters: return(as.vector(start)) } start.beta <- function(X, has.intercept = TRUE) return(rep(0, ncol(X) - has.intercept)) ## clm.start <- function(y.levels, threshold, X, has.intercept = TRUE) ## return(c(start.threshold(y.levels, threshold), ## start.beta(X, has.intercept))) clm.start <- function(y.levels, threshold, X, NOM=NULL, S=NULL, has.intercept=TRUE) { st <- start.threshold(y.levels, threshold) if(!is.null(NOM) && ncol(NOM) > 1) st <- c(st, rep(rep(0, length(st)), ncol(NOM)-1)) start <- c(st, start.beta(X, has.intercept)) if(!is.null(S) && ncol(S) > 1) start <- c(start, rep(0, ncol(S) - 1)) start } ordinal/R/clmm.methods.R0000644000176200001440000002434315127777530014644 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Implementation of various methods for clmm objects. formatVC <- function(varc, digits = max(3, getOption("digits") - 2)) ### "format()" the 'VarCorr' matrix of the random effects -- for ### show()ing ### Borrowed from lme4/R/lmer.R with minor modifications. { recorr <- lapply(varc, attr, "correlation") reStdDev <- lapply(varc, attr, "stddev") reLens <- unlist(lapply(reStdDev, length)) nr <- sum(reLens) reMat <- array('', c(nr, 4), list(rep.int('', nr), c("Groups", "Name", "Variance", "Std.Dev."))) reMat[1+cumsum(reLens)-reLens, 1] <- names(reLens) reMat[,2] <- unlist(lapply(varc, colnames)) reMat[,3] <- format(unlist(reStdDev)^2, digits = digits) reMat[,4] <- format(unlist(reStdDev), digits = digits) if(any(reLens > 1)) { maxlen <- max(reLens) corr <- do.call("rbind", lapply(recorr, function(x, maxlen) { if(is.null(x)) return("") x <- as(x, "matrix") cc <- format(round(x, 3), nsmall = 3) cc[!lower.tri(cc)] <- "" nr <- dim(cc)[1] if (nr >= maxlen) return(cc) cbind(cc, matrix("", nr, maxlen-nr)) }, maxlen)) colnames(corr) <- c("Corr", rep.int("", maxlen - 1)) cbind(reMat, corr) } else reMat } varcov <- function(object, format=FALSE, digits=max(3, getOption("digits") - 2), ...) ### VarCorr method for model environments - should be the same for ### fitted model objects. { ## Compute variance-covariance matrices of the random effects. res <- lapply(object$ST, function(st) { ## Variance-covariance matrix for the random effects: VC <- tcrossprod(st) ## Standard deviations: stddev <- sqrt(diag(VC)) corr <- t(VC / stddev)/stddev attr(VC, "stddev") <- stddev ## correlation: if(NCOL(st) > 1) { diag(corr) <- 1 attr(VC, "correlation") <- corr } VC }) names(res) <- names(object$dims$nlev.re) if(format) noquote(formatVC(res, digits=digits)) else res } # VarCorr <- function(x, ...) UseMethod("VarCorr") VarCorr.clmm <- function(x, ...) varcov(x, ...) print.clmm <- function(x, digits = max(3, getOption("digits") - 3), ...) { if(x$nAGQ >= 2) cat(paste("Cumulative Link Mixed Model fitted with the adaptive", "Gauss-Hermite \nquadrature approximation with", x$nAGQ ,"quadrature points"), "\n\n") else if(x$nAGQ <= -1) cat(paste("Cumulative Link Mixed Model fitted with the", "Gauss-Hermite \nquadrature approximation with", abs(x$nAGQ) ,"quadrature points"), "\n\n") else cat("Cumulative Link Mixed Model fitted with the Laplace approximation\n", fill=TRUE) cat("formula:", deparse(x$formula), fill=TRUE) if(!is.null(data.name <- x$call$data)) cat("data: ", deparse(data.name), fill=TRUE) if(!is.null(x$call$subset)) cat("subset: ", deparse(x$call$subset), fill=TRUE) cat("\n") print(x$info, row.names=FALSE, right=FALSE) cat("\nRandom effects:\n") print(formatVC(varcov(x), digits=digits), quote=FALSE, ...) nlev.char <- paste(names(x$dims$nlev.gf), " ", x$dims$nlev.gf, sep="", collapse=", ") cat("Number of groups: ", nlev.char, "\n") if(length(x$beta)) { cat("\nCoefficients:\n") print(x$beta, digits=digits, ...) } else { cat("\nNo Coefficients\n") } if(length(x$alpha) > 0) { cat("\nThresholds:\n") print(x$alpha, digits=digits, ...) } if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") return(invisible(x)) } vcov.clmm <- function(object, ...) vcov.clm(object, method="Cholesky") summary.clmm <- function(object, correlation = FALSE, ...) { if(is.null(object$Hessian)) stop("Model needs to be fitted with Hess = TRUE") nfepar <- object$dims$nfepar coef <- matrix(0, nfepar, 4, dimnames = list(names(object$coefficients[1:nfepar]), c("Estimate", "Std. Error", "z value", "Pr(>|z|)"))) coef[, 1] <- object$coefficients[1:nfepar] vc <- try(vcov(object), silent = TRUE) if(inherits(vc, "try-error")) { warning("Variance-covariance matrix of the parameters is not defined") coef[, 2:4] <- NaN if(correlation) warning("Correlation matrix is unavailable") object$condHess <- NaN } else { coef[, 2] <- sd <- sqrt(diag(vc)[1:nfepar]) ## Cond is Inf if Hessian contains NaNs: object$condHess <- if(any(is.na(object$Hessian))) Inf else with(eigen(object$Hessian, only.values = TRUE), abs(max(values) / min(values))) coef[, 3] <- coef[, 1]/coef[, 2] coef[, 4] <- 2 * pnorm(abs(coef[, 3]), lower.tail=FALSE) if(correlation) ## { ## sd <- sqrt(diag(vc)) object$correlation <- cov2cor(vc) ## (vc / sd) / rep(sd, rep(object$edf, object$edf)) } object$info$cond.H <- formatC(object$condHess, digits=1, format="e") object$coefficients <- coef class(object) <- "summary.clmm" return(object) } print.summary.clmm <- function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) { if(x$nAGQ >= 2) cat(paste("Cumulative Link Mixed Model fitted with the adaptive", "Gauss-Hermite \nquadrature approximation with", x$nAGQ ,"quadrature points"), "\n\n") else if(x$nAGQ <= -1) cat(paste("Cumulative Link Mixed Model fitted with the", "Gauss-Hermite \nquadrature approximation with", abs(x$nAGQ) ,"quadrature points"), "\n\n") else cat("Cumulative Link Mixed Model fitted with the Laplace approximation\n", fill=TRUE) cat("formula:", deparse(x$formula), fill=TRUE) if(!is.null(data.name <- x$call$data)) cat("data: ", deparse(data.name), fill=TRUE) if(!is.null(x$call$subset)) cat("subset: ", deparse(x$call$subset), fill=TRUE) cat("\n") print(x$info, row.names=FALSE, right=FALSE) cat("\nRandom effects:\n") print(formatVC(varcov(x), digits=digits), quote=FALSE, ...) nlev.char <- paste(names(x$dims$nlev.gf), " ", x$dims$nlev.gf, sep="", collapse=", ") cat("Number of groups: ", nlev.char, "\n") nbeta <- length(x$beta) nalpha <- length(x$alpha) if(nbeta > 0) { cat("\nCoefficients:\n") printCoefmat(x$coefficients[nalpha + 1:nbeta, , drop=FALSE], digits=digits, signif.stars=signif.stars, has.Pvalue=TRUE, ...) } else { cat("\nNo Coefficients\n") } if(nalpha > 0) { ## always true cat("\nThreshold coefficients:\n") printCoefmat(x$coefficients[seq_len(nalpha), -4, drop=FALSE], digits=digits, has.Pvalue=FALSE, signif.stars=FALSE, ...) } if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") if(!is.null(correl <- x$correlation)) { cat("\nCorrelation of Coefficients:\n") ll <- lower.tri(correl) correl[ll] <- format(round(correl[ll], digits)) correl[!ll] <- "" print(correl[-1, -ncol(correl)], quote = FALSE, ...) } return(invisible(x)) } logLik.clmm <- function(object, ...) structure(object$logLik, df = object$edf, class = "logLik") extractAIC.clmm <- function(fit, scale = 0, k = 2, ...) { edf <- fit$edf c(edf, -2*fit$logLik + k * edf) } nobs.clmm <- function(object, ...) object$dims$nobs edf.clmm <- function(object, ...) object$dims$edf ## anova.clmm <- function(object, ...) ## anova.clm(object, ...) anova.clmm <- function(object, ...) { ### This essentially calls anova.clm(object, ...), but the names of ### the models were not displayed correctly in the printed output ### unless the following dodge is enforced. mc <- match.call() args <- as.list(mc) Call <- as.call(c(list(quote(anova.clm)), args[-1])) ff <- environment(formula(object)) pf <- parent.frame() ## save parent frame in case we need it sf <- sys.frames()[[1]] ff2 <- environment(object) res <- tryCatch(eval(Call, envir=pf), error=function(e) { tryCatch(eval(Call, envir=ff), error=function(e) { tryCatch(eval(Call, envir=ff2), error=function(e) { tryCatch(eval(Call, envir=sf), error=function(e) { "error" })})})}) if((is.character(res) && res == "error")) stop("Unable to evaluate models.") res } logLik.clmm <- function(object, ...) structure(object$logLik, df = object$edf, class = "logLik") extractAIC.clmm <- function(fit, scale = 0, k = 2, ...) { edf <- fit$edf c(edf, -2*fit$logLik + k * edf) } model.matrix.clmm <- function(object, type = c("design", "B"), ...) { type <- match.arg(type) mf <- try(model.frame(object), silent=TRUE) if(inherits(mf, "try-error")) stop("Cannot extract model.matrix: refit model with 'model=TRUE'?") if(type == "design") { Terms <- terms(object) ans <- model.matrix(Terms, mf) } else { ## if type == "B": stop("type = 'B' not yet implemented") } return(ans) } ordinal/R/clm.slice.R0000644000176200001440000001603015127777530014115 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Methods to compute and plot likelihood-slices for clm objects. slice <- function(object, ...) { UseMethod("slice") } slice.clm <- function(object, parm = seq_along(par), lambda = 3, grid = 1e2, quad.approx = TRUE, ...) { ## argument matching and testing: stopifnot(is.numeric(lambda) && lambda > 0) stopifnot(is.numeric(grid) && grid >= 1) grid <- as.integer(round(grid)) par <- coef(object, na.rm=TRUE) par.names <- names(par) npar <- length(par) stopifnot(length(parm) == length(unique(parm))) if(is.character(parm)) parm <- match(parm, par.names, nomatch = 0) ### disallow character argument due to ambiguity? if(!all(parm %in% seq_along(par))) stop("invalid 'parm' argument") stopifnot(length(parm) > 0) parm <- as.integer(round(parm)) ## parm is an integer vector indexing non-aliased coef. ml <- object$logLik parm.names <- par.names[parm] ## get environment corresponding to object: rho <- get_clmRho(object) ## rho <- update(object, doFit = FALSE) names(par) <- NULL rho$par <- par ## set rho$par to mle stopifnot(isTRUE(all.equal(rho$clm.nll(rho), -object$logLik))) ## generate sequence of parameters at which to compute the ## log-likelihood: curv <- sqrt(1/diag(object$Hessian)) ## curvature in nll wrt. par par.range <- par + curv %o% c(-lambda, lambda) ## par.seq - list of length npar with a sequence of values for each ## parameter : par.seq <- lapply(parm, function(ind) { seq(par.range[ind, 1], par.range[ind, 2], length = grid) }) ## compute relative logLik for all par.seq for each par: logLik <- lapply(seq_along(parm), function(i) { # for each par rho$par <- par ## reset par values to MLE sapply(par.seq[[ i ]], function(par.val) { # for each par.seq value rho$par[ parm[i] ] <- par.val -rho$clm.nll(rho) - ml ## relative logLik }) }) ## collect parameter sequences and relative logLik in a list of ## data.frames: res <- lapply(seq_along(parm), function(i) { structure(data.frame(par.seq[[ i ]], logLik[[ i ]]), names = c(parm.names[i], "logLik")) }) ## set attributes: names(res) <- parm.names attr(res, "original.fit") <- object attr(res, "mle") <- par[parm] class(res) <- "slice.clm" if(!quad.approx) return(res) ## compute quadratic approx to *positive* logLik: Quad <- function(par, mle, curv) -((mle - par)^2 / curv^2 / 2) for(i in seq_along(parm)) res[[ i ]]$quad <- Quad(par.seq[[ i ]], par[ parm[i] ], curv[ parm[i] ]) return(res) } plot.slice.clm <- function(x, parm = seq_along(x), type = c("quadratic", "linear"), plot.mle = TRUE, ask = prod(par("mfcol")) < length(parm) && dev.interactive(), ...) { ## Initiala argument matching and testing: type <- match.arg(type) stopifnot(is.numeric(parm)) parm <- as.integer(round(parm)) of <- attr(x, "original.fit") par <- coef(of) ml <- of$logLik ## take the signed sqrt of nll and quad: if(type == "linear") { sgn.sqrt <- function(par, mle, logLik) (2 * (par > mle) - 1) * sqrt(-logLik) mle <- coef(attr(x, "original.fit")) for(i in parm) { x[[i]]$logLik <- sgn.sqrt(x[[i]][1], mle[i], x[[i]]$logLik) if(!is.null(x[[i]]$quad)) x[[i]]$quad <- sgn.sqrt(x[[i]][1], mle[i], x[[i]]$quad) } ylab <- "Signed log-likelihood root" } else ylab <- "Relative log-likelihood" if(ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } ## actual plotting: for(i in parm) { z <- x[[i]] plot(z[1:2], type = "l", ylab=ylab, ...) if(!is.null(z$quad)) lines(z[[1]], z[[3]], lty = 2) if(plot.mle && type == "quadratic") ## abline(v = par[i]) abline(v = attr(x, "mle")[i]) ## abline(v = par[names(x)[i]]) } return(invisible()) } ## slice.clm <- ## function(object, parm = seq_along(par), lambda = 3, grid = 1e2, ## quad.approx = TRUE, ...) ## { ## ## argument matching and testing: ## stopifnot(is.numeric(lambda) && lambda > 0) ## stopifnot(is.numeric(grid) && grid >= 1) ## grid <- as.integer(grid) ## par <- coef(object) ## par.names <- names(par) ## npar <- length(par) ## stopifnot(length(parm) == length(unique(parm))) ## if(is.character(parm)) ## parm <- match(parm, par.names, nomatch = 0) ## if(!all(parm %in% seq_along(par))) ## stop("invalid 'parm' argument") ## stopifnot(length(parm) > 0) ## parm <- as.integer(parm) ## ml <- object$logLik ## parm.names <- par.names[parm] ## ## ## get environment corresponding to object: ## rho <- update(object, doFit = FALSE) ## names(par) <- NULL ## rho$par <- par ## set rho$par to mle ## stopifnot(isTRUE(all.equal(rho$clm.nll(rho), -object$logLik))) ## ## ## generate sequence of parameters at which to compute the ## ## log-likelihood: ## curv <- sqrt(1/diag(object$Hess)) ## curvature in nll wrt. par ## par.range <- par + curv %o% c(-lambda, lambda) ## ## par.seq - list of length npar: ## par.seq <- sapply(parm, function(ind) { ## seq(par.range[ind, 1], par.range[ind, 2], length = grid) }, ## simplify = FALSE) ## ## compute relative logLik for all par.seq for each par: ## logLik <- lapply(seq_along(parm), function(i) { # for each par ## rho$par <- par ## reset par values to MLE ## sapply(par.seq[[ i ]], function(par.val) { # for each val ## rho$par[ parm[i] ] <- par.val ## -rho$clm.nll(rho) - ml ## relative logLik ## }) ## }) ## ## ## collect results in a list of data.frames: ## res <- lapply(seq_along(parm), function(i) { ## structure(data.frame(par.seq[[ i ]], logLik[[ i ]]), ## names = c(parm.names[i], "logLik")) ## }) ## ## ## set attributes: ## names(res) <- parm.names ## attr(res, "original.fit") <- object ## class(res) <- "slice.clm" ## ## if(!quad.approx) return(res) ## ## compute quadratic approx to *positive* logLik: ## Quad <- function(par, mle, curv) ## -((mle - par)^2 / curv^2 / 2) ## for(i in seq_along(parm)) ## res[[ i ]]$quad <- ## Quad(par.seq[[ i ]], par[ parm[i] ], curv[ parm[i] ]) ## ## return(res) ## } ordinal/R/gdist.R0000644000176200001440000000414415127777530013361 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Gradients of densities of common distribution functions on the form ## g[dist], where "dist" can be one of "logis", "norm", and ## "cauchy". These functions are used in Newton-Raphson algorithms ## when fitting CLMs and CLMMs in clm(), clm2(), clmm() and ## clmm2(). Similar gradients are implemented for the gumbel, ## log-gamma, and Aranda-Ordaz distributions. glogis <- function(x) ### gradient of dlogis .C("glogis_C", x = as.double(x), length(x), NAOK = TRUE)$x gnorm <- function(x) ### gradient of dnorm(x) wrt. x .C("gnorm_C", x = as.double(x), length(x), NAOK = TRUE)$x gcauchy <- function(x) ### gradient of dcauchy(x) wrt. x .C("gcauchy_C", x = as.double(x), length(x), NAOK = TRUE)$x glogisR <- function(x) { ### glogis in R res <- rep(0, length(x)) isFinite <- !is.infinite(x) x <- x[isFinite] isNegative <- x < 0 q <- exp(-abs(x)) q <- 2*q^2*(1 + q)^-3 - q*(1 + q)^-2 q[isNegative] <- -q[isNegative] res[isFinite] <- q res } gnormR <- function(x) ### gnorm in R -x * dnorm(x) gcauchyR <- function(x) ### gcauchy(x) in R -2*x/pi*(1+x^2)^-2 ordinal/R/clm.simple.R0000644000176200001440000001323415127777530014312 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## A implementation of simple CLMs (simple_clm), i.e., CLMs without ## scale and nominal effects. simple_clm <- function(formula, data, weights, start, subset, offset, doFit = TRUE, na.action, contrasts, model = TRUE, control = list(), link = c("logit", "probit", "cloglog", "loglog"), threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) { ## Initial argument matching and testing: mc <- match.call(expand.dots = FALSE) link <- match.arg(link) threshold <- match.arg(threshold) ## check for presence of formula: if(missing(formula)) stop("Model needs a formula") if(missing(contrasts)) contrasts <- NULL ## set control parameters: control <- do.call(clm.control, c(control, list(...))) ## Compute: y, X, wts, off, mf: if (missing(data)) data <- environment(formula) mf <- match.call(expand.dots = FALSE) m <- match(c("formula", "data", "subset", "weights", "na.action", "offset"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") mf <- eval(mf, parent.frame()) ## Return model.frame? if(control$method == "model.frame") return(mf) y <- model.response(mf, "any") ## any storage mode if(!is.factor(y)) stop("response needs to be a factor", call.=FALSE) ## design matrix: mt <- attr(mf, "terms") X <- if (!is.empty.model(mt)) model.matrix(mt, mf, contrasts) else cbind("(Intercept)" = rep(1, NROW(y))) ## Test for intercept in X: Xint <- match("(Intercept)", colnames(X), nomatch = 0) if(Xint <= 0) { X <- cbind("(Intercept)" = rep(1, NROW(y)), X) warning("an intercept is needed and assumed in 'formula'", call.=FALSE) } ## intercept in X is guaranteed. wts <- getWeights(mf) off <- getOffsetStd(mf) ylevels <- levels(droplevels(y[wts > 0])) frames <- list(y=y, ylevels=ylevels, X=X) ## Compute the transpose of the Jacobian for the threshold function, ## tJac and the names of the threshold parameters, alpha.names: frames <- c(frames, makeThresholds(ylevels, threshold)) ## test for column rank deficiency in design matrices: frames <- drop.cols(frames, silent=TRUE) ## Set envir rho with variables: B1, B2, o1, o2, wts, fitted: rho <- clm.newRho(parent.frame(), y=frames$y, X=frames$X, NOM=NULL, S=NULL, weights=wts, offset=off, S.offset=NULL, tJac=frames$tJac, control=control) ## Set starting values for the parameters: start <- set.start(rho, start=start, get.start=missing(start), threshold=threshold, link=link, frames=frames) rho$par <- as.vector(start) ## remove attributes ## Set pfun, dfun and gfun in rho: setLinks(rho, link) ## Possibly return the environment rho without fitting: if(!doFit) return(rho) ## Fit the clm: if(control$method == "Newton") fit <- clm_fit_NR(rho, control) else fit <- clm_fit_optim(rho, control$method, control$ctrl) ### NOTE: we could add arg non.conv = c("error", "warn", "message") to ### allow non-converged fits to be returned. ## Modify and return results: res <- clm.finalize(fit, weights=wts, coef.names=frames$coef.names, aliased=frames$aliased) res$control <- control res$link <- link res$start <- start if(control$method == "Newton" && !is.null(start.iter <- attr(start, "start.iter"))) res$niter <- res$niter + start.iter res$threshold <- threshold res$call <- match.call() res$contrasts <- attr(frames$X, "contrasts") res$na.action <- attr(mf, "na.action") res$terms <- mt res$xlevels <- .getXlevels(mt, mf) res$tJac <- frames$tJac res$y.levels <- frames$ylevels ## Check convergence: conv <- conv.check(res, Theta.ok=TRUE, tol=control$tol) print.conv.check(conv, action=control$convergence) ## print convergence message res$vcov <- conv$vcov res$cond.H <- conv$cond.H res$convergence <- conv[!names(conv) %in% c("vcov", "cond.H")] res$info <- with(res, { data.frame("link" = link, "threshold" = threshold, "nobs" = nobs, "logLik" = formatC(logLik, digits=2, format="f"), "AIC" = formatC(-2*logLik + 2*edf, digits=2, format="f"), "niter" = paste(niter[1], "(", niter[2], ")", sep=""), ### NOTE: iterations to get starting values for scale models *are* ### included here. "max.grad" = formatC(maxGradient, digits=2, format="e") ## BIC is not part of output since it is not clear what ## the no. observations are. ) }) class(res) <- "clm" ## add model.frame to results list? if(model) res$model <- mf return(res) } ordinal/R/control.R0000644000176200001440000000703015127777530013724 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions that set control parameters for clm() and clmm(). clm.control <- function(method = c("Newton", "model.frame", "design", "ucminf", "nlminb", "optim"), sign.location = c("negative", "positive"), sign.nominal = c("positive", "negative"), ..., trace = 0L, maxIter = 100L, gradTol = 1e-6, maxLineIter = 15L, relTol = 1e-6, tol = sqrt(.Machine$double.eps), maxModIter = 5L, convergence=c("warn", "silent", "stop", "message")) { method <- match.arg(method) convergence <- match.arg(convergence) sign.location <- match.arg(sign.location) sign.nominal <- match.arg(sign.nominal) if(!all(is.numeric(c(maxIter, gradTol, maxLineIter, relTol, tol, maxModIter)))) stop("maxIter, gradTol, relTol, tol, maxModIter and maxLineIter should all be numeric") ctrl <- list(method = method, sign.location = sign.location, sign.nominal = sign.nominal, convergence = convergence, trace = as.integer(trace), maxIter = as.integer(maxIter), gradTol = as.numeric(gradTol), relTol = as.numeric(relTol), tol = as.numeric(tol), maxLineIter = as.integer(maxLineIter), maxModIter = as.integer(maxModIter)) if(method %in% c("ucminf", "nlminb", "optim")) ctrl$ctrl <- list(trace = as.integer(abs(trace)), ...) return(ctrl) } clmm.control <- function(method = c("nlminb", "ucminf", "model.frame"), ..., trace = 0, maxIter = 50, gradTol = 1e-4, maxLineIter = 50, useMatrix = FALSE, innerCtrl = c("warnOnly", "noWarn", "giveError"), checkRanef = c("warn", "error", "message")) { method <- match.arg(method) innerCtrl <- match.arg(innerCtrl) checkRanef <- match.arg(checkRanef) useMatrix <- as.logical(useMatrix) stopifnot(is.logical(useMatrix)) ctrl <- list(trace=if(trace < 0) 1 else 0, maxIter=maxIter, gradTol=gradTol, maxLineIter=maxLineIter, innerCtrl=innerCtrl) optCtrl <- list(trace = abs(trace), ...) if(!is.numeric(unlist(ctrl[-5]))) stop("maxIter, gradTol, maxLineIter and trace should all be numeric") if(any(ctrl[-c(1, 5)] <= 0)) stop("maxIter, gradTol and maxLineIter have to be > 0") if(method == "ucminf" && !"grtol" %in% names(optCtrl)) optCtrl$grtol <- 1e-5 if(method == "ucminf" && !"grad" %in% names(optCtrl)) optCtrl$grad <- "central" namedList(method, useMatrix, ctrl, optCtrl, checkRanef) } ordinal/R/clm.profile.R0000644000176200001440000007336715127777530014476 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## profile and confint methods for clm objects. profile.clm <- function(fitted, which.beta = seq_len(nbeta), which.zeta = seq_len(nzeta), alpha = 0.001, max.steps = 50, nsteps = 8, trace = FALSE, step.warn = 5, control = list(), ...) { ### match and tests arguments and dispatch to .zeta and .beta ### functions for the actual profiling. ### which.[beta, zeta] - numeric or character vectors. ### Works for models with nominal and scale effects and for any number ### of aliased coefs. ## match and test arguments: if(fitted$link %in% c("Aranda-Ordaz", "log-gamma")) stop("Profiling not implemented for models with flexible link function") if(any(is.na(diag(vcov(fitted))))) stop("Cannot get profile when vcov(fitted) contains NAs", call.=FALSE) stopifnot(is.numeric(alpha) && length(alpha) == 1 && alpha > 0 && alpha < 1) stopifnot(round(max.steps) > round(nsteps)) stopifnot(round(nsteps) > round(step.warn)) stopifnot(round(nsteps) > 0 && round(step.warn) >= 0) max.steps <- round(max.steps) nsteps <- round(nsteps) step.warn <- round(step.warn) trace <- as.logical(trace)[1] ### BETA: beta.names <- names(fitted$beta) ## possible beta nbeta <- length(fitted$beta) if(is.character(which.beta)) which.beta <- match(which.beta, beta.names, nomatch = 0) ## which.beta is a numeric vector if(!all(which.beta %in% seq_len(nbeta))) stop("invalid 'parm' argument") ### ZETA: zeta.names <- names(fitted$zeta) ## possible zeta nzeta <- length(fitted$zeta) if(is.character(which.zeta)) which.zeta <- match(which.zeta, zeta.names, nomatch = 0) ## which.zeta is a numeric vector if(!all(which.zeta %in% seq_len(nzeta))) stop("invalid 'parm' argument") ## the actual profiling for beta and zeta par: prof.beta <- if(nbeta) profile.clm.beta(fitted, which.beta, alpha, max.steps, nsteps, trace, step.warn, control, ...) else NULL prof.zeta <- if(nzeta) profile.clm.zeta(fitted, which.zeta, alpha, max.steps, nsteps, trace, step.warn, control, ...) else NULL ## collect and return results: val <- structure(c(prof.beta, prof.zeta), original.fit = fitted) class(val) <- c("profile.clm") return(val) } profile.clm.beta <- function(fitted, which.beta, alpha = 0.001, max.steps = 50, nsteps = 8, trace = FALSE, step.warn = 5, control = list(), ...) ### which.beta is assumed to be a numeric vector { lroot.max <- qnorm(1 - alpha/2) delta = lroot.max/nsteps nbeta <- length(fitted$beta) beta.names <- names(fitted$beta) nalpha <- length(fitted$alpha) orig.par <- c(fitted$alpha, fitted$beta) if(!is.null(zeta <- fitted$zeta)) { names(zeta) <- paste("sca", names(fitted$zeta), sep=".") orig.par <- c(orig.par, zeta) } if(!is.null(lambda <- fitted$lambda)) { orig.par <- c(orig.par, lambda) } ### NOTE: we need to update zeta.names to make names(orig.par) ### unique. This is needed to correctly construct the resulting ### par.vals matrix and to extract from it again. std.err <- coef(summary(fitted))[nalpha + 1:nbeta, "Std. Error"] if(any(is.na(std.err))) stop("Cannot profile model where standard errors are NA", call.=FALSE) ## results list: prof.list <- vector("list", length = length(which.beta)) names(prof.list) <- beta.names[which.beta] ## get model matrices and model environment: ### NOTE: Fixing the fragile update approach: ## mf <- update(fitted, method = "model.frame") ## Need to subset by wts to make nrow(X) == nrow(B1) ## X <- with(mf, X[wts > 0, , drop=FALSE]) ## containing alias cols wts <- getWeights(model.frame(fitted)) X <- model.matrix(fitted)$X[wts > 0, , drop=FALSE] if(fitted$control$sign.location == "positive") X <- -X rho <- get_clmRho(fitted) ## rho <- update(fitted, doFit = FALSE) orig <- as.list(rho)[c("B1", "B2", "o1", "o2")] rho$n.psi <- rho$n.psi - 1 ## needed for models with scale nalpha.clean <- sum(!fitted$aliased$alpha) par.clean <- orig.par[!is.na(orig.par)] ## which of which.beta are NA: alias.wb <- fitted$aliased$beta[which.beta] ## For each which.beta move up or down, fit the model and store the ## signed likelihood root statistic and parameter values: for(wb in which.beta) { if(alias.wb[wb == which.beta]) next ## ignore aliased coef rem <- nalpha.clean + (which.beta - cumsum(alias.wb))[wb == which.beta] par.wb <- matrix(coef(fitted), nrow = 1) ## MLE wb.name <- beta.names[wb] lroot.wb <- 0 ## lroot at MLE ## set variables in fitting environment: rho$B1 <- orig$B1[, -rem, drop=FALSE] rho$B2 <- orig$B2[, -rem, drop=FALSE] for(direction in c(-1, 1)) { ## move down or up if(trace) { message("\nParameter: ", wb.name, c(" down", " up")[(direction + 1)/2 + 1]) utils::flush.console() } ## reset starting values: rho$par <- par.clean[-rem] for(step in seq_len(max.steps)) { ## increment beta.i, offset and refit model without wb parameter: beta.i <- fitted$beta[wb] + direction * step * delta * std.err[wb] new.off <- X[, 1+wb, drop=TRUE] * beta.i rho$o1 <- orig$o1 - new.off rho$o2 <- orig$o2 - new.off fit <- clm_fit_NR(rho, control) ## save likelihood root statistic: lroot <- -direction * sqrt(2*(fitted$logLik - fit$logLik)) ## save lroot and pararameter values: lroot.wb <- c(lroot.wb, lroot) temp.par <- orig.par temp.par[names(fit$par)] <- fit$par temp.par[wb.name] <- beta.i par.wb <- rbind(par.wb, temp.par) ## break for loop if profile is far enough: if(abs(lroot) > lroot.max) break } ## end 'step in seq_len(max.steps)' ## test that lroot.max is reached and enough steps are taken: if(abs(lroot) < lroot.max) warning("profile may be unreliable for ", wb.name, " because lroot.max was not reached for ", wb, c(" down", " up")[(direction + 1)/2 + 1]) if(step <= step.warn) warning("profile may be unreliable for ", wb.name, " because only ", step, "\n steps were taken ", c("down", "up")[(direction + 1)/2 + 1]) } ## end 'direction in c(-1, 1)' ## order lroot and par values and collect in a data.frame: lroot.order <- order(lroot.wb, decreasing = TRUE) prof.list[[wb.name]] <- structure(data.frame(lroot.wb[lroot.order]), names = "lroot") prof.list[[wb.name]]$par.vals <- par.wb[lroot.order, ] if(!all(diff(par.wb[lroot.order, wb.name]) > 0)) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for ", wb.name) } ## end 'wb in which.beta' prof.list } profile.clm.zeta <- function(fitted, which.zeta, alpha = 0.001, max.steps = 50, nsteps = 8, trace = FALSE, step.warn = 5, control = list(), ...) ### which.zeta is assumed to be a numeric vector { lroot.max <- qnorm(1 - alpha/2) delta = lroot.max/nsteps nzeta <- length(fitted$zeta) nbeta <- length(fitted$beta) zeta <- fitted$zeta names(zeta) <- zeta.names <- paste("sca", names(fitted$zeta), sep=".") ### NOTE: we need to update zeta.names to make names(orig.par) ### unique. This is needed to correctly construct the resulting ### par.vals matrix and to extract from it again. orig.par <- c(fitted$alpha, fitted$beta, zeta) nalpha <- length(fitted$alpha) std.err <- coef(summary(fitted))[nalpha+nbeta+1:nzeta, "Std. Error"] if(any(is.na(std.err))) stop("Cannot profile model where standard errors are NA", call.=FALSE) ## results list: prof.list <- vector("list", length = length(which.zeta)) names(prof.list) <- names(zeta)[which.zeta] ## get model environment: rho <- get_clmRho(fitted) ## rho <- update(fitted, doFit = FALSE) S <- rho$S ## S without intercept Soff <- rho$Soff rho$k <- max(0, rho$k - 1) ab <- c(fitted$alpha, fitted$beta) ab.clean <- ab[!is.na(ab)] zeta.clean <- zeta[!fitted$aliased$zeta] ## which of which.zeta are NA: alias.wz <- fitted$aliased$zeta[which.zeta] ## For each which.zeta move up or down, fit the model and store the ## signed likelihood root statistic and parameter values: for(wz in which.zeta) { if(alias.wz[wz]) next ## ignore aliased coef ## rem: which columns of S to remove rem <- (which.zeta - cumsum(alias.wz))[wz] par.wz <- matrix(coef(fitted), nrow = 1) ## MLE wz.name <- zeta.names[wz] lroot.wz <- 0 ## lroot at MLE ## set variables in fitting environment: rho$S <- S[, -rem, drop=FALSE] for(direction in c(-1, 1)) { ## move down or up if(trace) { message("\nParameter: ", wz.name, c(" down", " up")[(direction + 1)/2 + 1]) utils::flush.console() } ## reset starting values: rho$par <- c(ab.clean, zeta.clean[-rem]) ## rho$par <- coef(fitted, na.rm = TRUE)[-rem] for(step in seq_len(max.steps)) { ## increment zeta.i, offset and refit model without wz parameter: zeta.i <- zeta[wz] + direction * step * delta * std.err[wz] rho$Soff <- rho$sigma <- Soff * exp(S[, wz, drop=TRUE] * zeta.i) ### NOTE: Need to update sigma in addition to Soff since otherwise ### sigma isn't updated when k=0 (single scale par) fit <- clm_fit_NR(rho, control) ## save likelihood root statistic: lroot <- -direction * sqrt(2*(fitted$logLik - fit$logLik)) ## save lroot and pararameter values: lroot.wz <- c(lroot.wz, lroot) temp.par <- orig.par temp.par[names(fit$par)] <- fit$par temp.par[wz.name] <- zeta.i par.wz <- rbind(par.wz, temp.par) ## break for loop if profile is far enough: if(abs(lroot) > lroot.max) break } ## end 'step in seq_len(max.steps)' ## test that lroot.max is reached and enough steps are taken: if(abs(lroot) < lroot.max) warning("profile may be unreliable for ", wz.name, " because qnorm(1 - alpha/2) was not reached when profiling ", c(" down", " up")[(direction + 1)/2 + 1]) if(step <= step.warn) warning("profile may be unreliable for ", wz.name, " because only ", step, "\n steps were taken ", c("down", "up")[(direction + 1)/2 + 1]) } ## end 'direction in c(-1, 1)' ## order lroot and par values and collect in a data.frame: ## lroot.order <- order(lroot.wz, decreasing = TRUE) lroot.order <- order(par.wz[, wz.name], decreasing = FALSE) ### NOTE: Need to change how values are ordered here. We should order ### with par.wz[, wz.name] instead of lroot.wz since if lroot.wz is ### flat, the order may be incorrect. prof.list[[wz.name]] <- structure(data.frame(lroot.wz[lroot.order]), names = "lroot") prof.list[[wz.name]]$par.vals <- par.wz[lroot.order, ] if(!all(diff(lroot.wz[lroot.order]) <= sqrt(.Machine$double.eps))) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for ", wz.name) } ## end 'wz in which.zeta' prof.list } ## profile.sclm <- ## using clm.fit.env() ## function(fitted, which.beta = seq_len(nbeta), alpha = 0.001, ## max.steps = 50, nsteps = 8, trace = FALSE, ## step.warn = 5, control = list(), ...) ## ### NOTE: seq_len(nbeta) works for nbeta = 0: numeric(0), while ## ### 1:nbeta gives c(1, 0). ## ## ### This is almost a copy of profile.clm2, which use clm.fit rather ## ### than clm.fit.env. The current implementation is the fastest, but ## ### possibly less readable. ## { ## ## match and test arguments: ## stopifnot(is.numeric(alpha) && length(alpha) == 1 && ## alpha > 0 && alpha < 1) ## stopifnot(round(max.steps) > round(nsteps)) ## stopifnot(round(nsteps) > round(step.warn)) ## stopifnot(round(nsteps) > 0 && round(step.warn) >= 0) ## max.steps <- round(max.steps) ## nsteps <- round(nsteps) ## step.warn <- round(step.warn) ## trace <- as.logical(trace)[1] ## ## possible parameters on which to profile (including aliased coef): ## beta.names <- names(fitted$beta) ## nbeta <- length(fitted$beta) ## if(is.character(which.beta)) ## which.beta <- match(which.beta, beta.names, nomatch = 0) ## ## which.beta is a numeric vector ## if(!all(which.beta %in% seq_len(nbeta))) ## stop("invalid 'parm' argument") ## stopifnot(length(which.beta) > 0) ## std.err <- coef(summary(fitted))[-(1:length(fitted$alpha)), ## "Std. Error"] ## ## profile limit: ## lroot.max <- qnorm(1 - alpha/2) ## ## profile step length: ## delta <- lroot.max / nsteps ## ## results list: ## prof.list <- vector("list", length = length(which.beta)) ## names(prof.list) <- beta.names[which.beta] ## ## get model.frame: ## X <- update(fitted, method = "model.frame")$X ## containing alias cols ## rho <- update(fitted, doFit = FALSE) ## orig <- as.list(rho)[c("B1", "B2", "o1", "o2")] ## rho$n.psi <- rho$n.psi - 1 ## nalpha.clean <- sum(!fitted$aliased$alpha) ## ## which of which.beta are NA: ## alias.wb <- fitted$aliased$beta[which.beta] ## ## For each which.beta move up or down, fit the model and store the ## ## signed likelihood root statistic and parameter values: ## for(wb in which.beta) { ## if(alias.wb[wb]) next ## ignore aliased coef ## rem <- nalpha.clean + (which.beta - cumsum(alias.wb))[wb] ## par.wb <- matrix(coef(fitted), nrow = 1) ## MLE ## wb.name <- beta.names[wb] ## lroot.wb <- 0 ## lroot at MLE ## ## set variables in fitting environment: ## rho$B1 <- orig$B1[, -rem, drop=FALSE] ## rho$B2 <- orig$B2[, -rem, drop=FALSE] ## for(direction in c(-1, 1)) { ## move down or up ## if(trace) { ## message("\nParameter: ", wb.name, ## c(" down", " up")[(direction + 1)/2 + 1]) ## utils::flush.console() ## } ## ## reset starting values: ## rho$par <- coef(fitted, na.rm = TRUE)[-rem] ## ## rho$par <- orig.par[-wb.name] ## for(step in seq_len(max.steps)) { ## ## increment beta.i, offset and refit model without wb parameter: ## beta.i <- fitted$beta[wb] + ## direction * step * delta * std.err[wb] ## new.off <- X[, 1+wb, drop=TRUE] * beta.i ## rho$o1 <- orig$o1 - new.off ## rho$o2 <- orig$o2 - new.off ## fit <- clm.fit.env(rho, control) ## ## save likelihood root statistic: ## lroot <- -direction * sqrt(2*(fitted$logLik - fit$logLik)) ## ## save lroot and pararameter values: ## lroot.wb <- c(lroot.wb, lroot) ## temp.par <- coef(fitted) ## temp.par[names(fit$par)] <- fit$par ## temp.par[wb.name] <- beta.i ## par.wb <- rbind(par.wb, temp.par) ## ## break for loop if profile is far enough: ## if(abs(lroot) > lroot.max) break ## } ## end 'step in seq_len(max.steps)' ## ## test that lroot.max is reached and enough steps are taken: ## if(abs(lroot) < lroot.max) ## warning("profile may be unreliable for ", wb.name, ## " because lroot.max was not reached for ", ## wb, c(" down", " up")[(direction + 1)/2 + 1]) ## if(step <= step.warn) ## warning("profile may be unreliable for ", wb.name, ## " because only ", step, "\n steps were taken ", ## c("down", "up")[(direction + 1)/2 + 1]) ## } ## end 'direction in c(-1, 1)' ## ## order lroot and par. values and collect in a data.frame: ## lroot.order <- order(lroot.wb, decreasing = TRUE) ## prof.list[[wb.name]] <- ## structure(data.frame(lroot.wb[lroot.order]), names = "lroot") ## prof.list[[wb.name]]$par.vals <- par.wb[lroot.order, ] ## ## if(!all(diff(par.wb[lroot.order, wb.name]) > 0)) ## warning("likelihood is not monotonically decreasing from maximum,\n", ## " so profile may be unreliable for ", wb.name) ## } ## end 'wb in which.beta' ## val <- structure(prof.list, original.fit = fitted) ## class(val) <- c("profile.clm") ## return(val) ## } format.perc <- function(probs, digits) ### function lifted from stats:::format.perc to avoid using ':::' paste(format(100 * probs, trim = TRUE, scientific = FALSE, digits = digits), "%") confint.clm <- function(object, parm, level = 0.95, type = c("profile", "Wald"), trace = FALSE, ...) ### parm argument is ignored - use confint.profile for finer control. { ## match and test arguments type <- match.arg(type) if(object$link %in% c("Aranda-Ordaz", "log-gamma") && type == "profile") { message(paste("Profile intervals not available for models with flexible", "link function:\n reporting Wald intervals instead")) type <- "Wald" } stopifnot(is.numeric(level) && length(level) == 1 && level > 0 && level < 1) trace <- as.logical(trace)[1] if(!(missing(parm) || is.null(parm))) message("argument 'parm' ignored") ## Wald CI: if(type == "Wald") { a <- (1 - level)/2 a <- c(a, 1 - a) pct <- format.perc(a, 3) fac <- qnorm(a) coefs <- coef(object) ses <- coef(summary(object))[, 2] ci <- array(NA, dim = c(length(coefs), 2L), dimnames = list(names(coefs), pct)) ci[] <- coefs + ses %o% fac return(ci) } ## profile likelhood CI: if(trace) { message("Wait for profiling to be done...") utils::flush.console() } ## get profile: object <- profile(object, alpha = (1 - level)/4, trace = trace, ...) ## get and return CIs: confint(object, level = level, ...) } ## confint.clm <- ## function(object, parm = seq_len(npar), level = 0.95, ## type = c("profile", "Wald"), trace = FALSE, ...) ## ### parm: a 2-list with beta and zeta? ## ### or args which.beta, which.zeta while parm is redundant? ## ## ### make waldci.clm(object, which.alpha, which.beta, which.zeta, level ## ### = 0.95) ?? ## { ## ## match and test arguments ## type <- match.arg(type) ## stopifnot(is.numeric(level) && length(level) == 1 && ## level > 0 && level < 1) ## trace <- as.logical(trace)[1] ## mle <- object$beta ## if(!is.null(zeta <- object$zeta)) { ## names(zeta) <- paste("sca", names(zeta), sep=".") ## mle <- c(mle, zeta) ## } ## npar <- length(mle) ## beta.names <- names(mle) ## if(is.character(parm)) stop("parm should be numeric") ## ## parm <- match(parm, names(c(object$beta, object$zeta))), nomatch = 0) ## if(!all(parm %in% seq_len(npar))) stop("invalid 'parm' argument") ## stopifnot(length(parm) > 0) ## ## Wald CI: ## if(type == "Wald") ## return(waldci.clm(object, parm, level)) ## ## return(confint.default(object = object, parm = beta.names[parm], ## ## level = level)) ## ## profile likelhood CI: ## if(trace) { ## message("Waiting for profiling to be done...") ## utils::flush.console() ## } ## ## get profile: ## ### Edit these calls: ## object <- profile(object, which.beta = beta.names[parm], ## alpha = (1 - level)/4, trace = trace, ...) ## ## get and return CIs: ## confint(object, parm = beta.names[parm], level = level, ...) ## } confint.profile.clm <- function(object, parm = seq_len(nprofiles), level = 0.95, ...) ### parm index elements of object (the list of profiles) ### each par.vals matrix of each profile will have ### sum(!unlist(of$aliased)) columns. { ## match and test arguments: stopifnot(is.numeric(level) && length(level) == 1 && level > 0 && level < 1) of <- attr(object, "original.fit") prof.names <- names(object) nprofiles <- length(prof.names) if(is.character(parm)) ### Allow character here? parm <- match(parm, prof.names, nomatch = 0) if(!all(parm %in% seq_len(nprofiles))) stop("invalid 'parm' argument") stopifnot(length(parm) > 0) ## prepare CI: a <- (1-level)/2 a <- c(a, 1-a) pct <- paste(round(100*a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(prof.names[parm], pct)) cutoff <- qnorm(a) ## compute CI from spline interpolation of the likelihood profile: for(pr.name in prof.names[parm]) { if(is.null(pro <- object[[ pr.name ]])) next sp <- spline(x = pro[, "par.vals"][, pr.name], y = pro[, 1]) ## OBS ci[pr.name, ] <- approx(sp$y, sp$x, xout = rev(cutoff))$y } ## do not drop(ci) because rownames are lost for single coef cases: return(ci) } plot.profile.clm <- function(x, which.par = seq_len(nprofiles), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, root = FALSE, fig = TRUE, approx = root, n = 1e3, ask = prod(par("mfcol")) < length(which.par) && dev.interactive(), ..., ylim = NULL) { ## match and test arguments: stopifnot(is.numeric(level) && all(level > 0) && all(level < 1)) stopifnot(n == round(n) && n > 0) Log <- as.logical(Log)[1] relative <- as.logical(relative)[1] root <- as.logical(root)[1] fig <- as.logical(fig)[1] approx <- as.logical(approx)[1] of <- attr(x, "original.fit") mle <- of$beta if(!is.null(zeta <- of$zeta)) { names(zeta) <- paste("sca", names(zeta), sep=".") mle <- c(mle, zeta) } prof.names <- names(x) nprofiles <- length(prof.names) if(is.character(which.par)) which.par <- match(which.par, prof.names, nomatch = 0) if(!all(which.par %in% seq_len(nprofiles))) stop("invalid 'which.par' argument") stopifnot(length(which.par) > 0) ML <- of$logLik ## prepare return value: which.names <- prof.names[which.par] spline.list <- vector("list", length(which.par)) names(spline.list) <- which.names if(approx) { std.err <- coef(summary(of))[-(1:length(of$alpha)), 2] names(std.err) <- names(mle) } ## aks before "over writing" the plot? if(ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } ## for each pm make the appropriate plot: for(pr.name in prof.names[which.par]) { ## confidence limits: lim <- sapply(level, function(x) exp(-qchisq(x, df=1)/2) ) if(is.null(pro <- x[[ pr.name ]])) next sp <- spline(x=pro[, "par.vals"][, pr.name], y=pro[, 1], n=n) if(approx) y.approx <- (mle[pr.name] - sp$x) / std.err[pr.name] if(root) { ylab <- "profile trace" lim <- c(-1, 1) %o% sqrt(-2 * log(lim)) sp$y <- -sp$y if(approx) y.approx <- -y.approx } else { ## !root: sp$y <- -sp$y^2/2 if(approx) y.approx <- -y.approx^2/2 if(relative && !Log) { sp$y <- exp(sp$y) if(approx) y.approx <- exp(y.approx) ylab <- "Relative profile likelihood" if(missing(ylim)) ylim <- c(0, 1) } if(relative && Log) { ylab <- "Relative profile log-likelihood" lim <- log(lim) } if(!relative && Log) { sp$y <- sp$y + ML if(approx) y.approx <- y.approx + ML ylab <- "Profile log-likelihood" lim <- ML + log(lim) } if(!relative && !Log) { sp$y <- exp(sp$y + ML) if(approx) y.approx <- exp(y.approx + ML) ylab <- "Profile likelihood" lim <- exp(ML + log(lim)) } } spline.list[[ pr.name ]] <- sp if(fig) { ## do the plotting: plot(sp$x, sp$y, type = "l", ylim = ylim, xlab = pr.name, ylab = ylab, ...) abline(h = lim) if(approx) lines(sp$x, y.approx, lty = 2) if(root) points(mle[pr.name], 0, pch = 3) } } attr(spline.list, "limits") <- lim invisible(spline.list) } profileAlt.clm <- ## using clm.fit() function(fitted, which.beta = seq_len(nbeta), alpha = 0.01, max.steps = 50, nsteps = 8, trace = FALSE, step.warn = 5, control = list(), ...) ### NOTE: seq_len(nbeta) works for nbeta = 0: numeric(0), while ### 1:nbeta gives c(1, 0). ### args: ### alpha - The likelihood is profiled in the 100*(1-alpha)% ### confidence region as determined by the profile likelihood ### max.steps - the maximum number of profile steps in each direction ### nsteps - the approximate no. steps determined by the quadratic ### approximation to the log-likelihood function ### trace - if trace > 0 information of progress is printed ### step.warn - a warning is issued if the profile in each direction ### contains less than step.warn steps (due to lack of precision). { ## match and test arguments: stopifnot(is.numeric(alpha) && length(alpha) == 1 && alpha > 0 && alpha < 1) stopifnot(round(max.steps) > round(nsteps)) stopifnot(round(nsteps) > round(step.warn)) stopifnot(round(nsteps) > 0 && round(step.warn) >= 0) max.steps <- round(max.steps) nsteps <- round(nsteps) step.warn <- round(step.warn) trace <- as.logical(trace)[1] beta.names <- names(fitted$beta) nbeta <- length(fitted$beta) if(is.character(which.beta)) which.beta <- match(which.beta, beta.names, nomatch = 0) if(!all(which.beta %in% seq_len(nbeta))) stop("invalid 'parm' argument") stopifnot(length(which.beta) > 0) ## Extract various things from the original fit: orig.par <- coef(fitted) ## c(alpha, beta) beta0 <- fitted$beta ## regression coef. nalpha <- length(fitted$alpha) ## no. threshold coef. nbeta <- length(beta0) beta.names <- names(beta0) orig.logLik <- fitted$logLik std.err <- coef(summary(fitted))[-(1:nalpha), "Std. Error"] link <- fitted$link threshold <- fitted$threshold ## profile limit: lroot.max <- qnorm(1 - alpha/2) ## profile step length: delta <- lroot.max / nsteps ## results list: prof.list <- vector("list", length = length(which.beta)) names(prof.list) <- beta.names[which.beta] ## get model.frame: ### NOTE: Attempting the following fix for a safer extraction of ### model-design-objects: ## mf <- update(fitted, method = "model.frame") contr <- c(fitted$contrasts, fitted$S.contrasts, fitted$nom.contrasts) mf <- get_clmDesign(fitted$model, fitted$terms.list, contr) y <- mf$y X <- mf$X wts <- mf$wts orig.off <- mf$off ## For each which.beta move up or down, fit the model and store the ## signed likelihood root statistic and parameter values: for(wb in which.beta) { par.wb <- matrix(orig.par, nrow = 1) ## MLE wb.name <- beta.names[wb] lroot.wb <- 0 ## lroot at MLE X.wb <- X[, -(1+wb), drop=FALSE] for(direction in c(-1, 1)) { ## move down or up if(trace) { message("\nParameter: ", wb.name, c(" down", " up")[(direction + 1)/2 + 1]) utils::flush.console() } ## (re)set starting values: start <- orig.par[-(nalpha + wb)] for(step in seq_len(max.steps)) { ## increment offset and refit model without wb parameter: beta.i <- beta0[wb] + direction * step * delta * std.err[wb] new.off <- orig.off + X[, 1+wb, drop=TRUE] * beta.i fit <- clm.fit(y=y, X=X.wb, weights=wts, offset=new.off, control=control, start=start, link=link, threshold=threshold) ## save likelihood root statistic: lroot <- -direction * sqrt(2*(fitted$logLik - fit$logLik)) ## save lroot and pararameter values: lroot.wb <- c(lroot.wb, lroot) temp.par <- orig.par temp.par[names(fit$par)] <- fit$par temp.par[wb.name] <- beta.i par.wb <- rbind(par.wb, temp.par) ## update starting values: start <- fit$par ## break for loop if profile is far enough: if(abs(lroot) > lroot.max) break } ## end 'step in seq_len(max.steps)' ## test that lroot.max is reached and enough steps are taken: if(abs(lroot) < lroot.max) warning("profile may be unreliable for ", wb.name, " because lroot.max was not reached for ", wb, c(" down", " up")[(direction + 1)/2 + 1]) if(step <= step.warn) warning("profile may be unreliable for ", wb.name, " because only ", step, "\n steps were taken ", c("down", "up")[(direction + 1)/2 + 1]) } ## end 'direction in c(-1, 1)' ## order lroot and par. values and collect in a data.frame: lroot.order <- order(lroot.wb, decreasing = TRUE) prof.list[[wb.name]] <- structure(data.frame(lroot.wb[lroot.order]), names = "lroot") prof.list[[wb.name]]$par.vals <- par.wb[lroot.order, ] if(!all(diff(par.wb[lroot.order, wb.name]) > 0)) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for ", wb.name) } ## end 'wb in which.beta' val <- structure(prof.list, original.fit = fitted) class(val) <- c("profile.clm") return(val) } ordinal/R/clm.fitter.R0000644000176200001440000003746015127777530014325 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Functions to fit/estimate CLMs (clm_fit_NR, clm_fit_optim) and ## functions implementing the negative log-likelihood, its gradient ## and hessian (.nll, .grad, .hess). These functions are rarely to be ## called directly from outside the package. clm_fit_NR <- function(rho, control = list()) ### The main work horse: Where the actual fitting of the clm goes on. ### Fitting the clm via modified Newton-Raphson with step halving. ### -------- Assumes the existence of the following functions: ### clm.nll - negative log-likelihood ### clm.grad - gradient of nll wrt. par ### clm.hess - hessian of nll wrt. par ### Trace - for trace information { control <- do.call(clm.control, control) stepFactor <- 1 innerIter <- modif.iter <- abs.iter <- 0L conv <- 2L ## Convergence flag (iteration limit reached) nll <- rho$clm.nll(rho) if(!is.finite(nll)) stop("Non-finite log-likelihood at starting value") ## do.newton <- ## rel.conv <- FALSE ## stephalf <- TRUE ## Newton-Raphson algorithm: for(i in 1:(control$maxIter + 1L)) { gradient <- rho$clm.grad(rho) maxGrad <- max(abs(gradient)) if(control$trace > 0) { Trace(iter=i+innerIter-1, stepFactor, nll, maxGrad, rho$par, first=(i==1)) if(control$trace > 1 && i > 1) { cat("\tgrad: ") cat(paste(formatC(gradient, digits=3, format="e"))) cat("\n\tstep: ") cat(paste(formatC(-step, digits=3, format="e"))) cat("\n\teigen: ") cat(paste(formatC(eigen(hessian, symmetric=TRUE, only.values=TRUE)$values, digits=3, format="e"))) cat("\n") } } abs.conv <- (maxGrad < control$gradTol) if(abs.conv) abs.iter <- abs.iter + 1L hessian <- rho$clm.hess(rho) ## Compute cholesky factor of Hessian: ch = Ut U ch <- try(chol(hessian), silent=TRUE) ### NOTE: solve(hessian, gradient) is not good enough because it will ### compute step for negative-definite Hessians and we don't want ### that. ### OPTION: What if Hessian is closely singular but slightly positive? ### Could we do something better in that case? if(inherits(ch, "try-error")) { if(abs.conv) { ## step.ok not true. conv <- 1L break ## cannot meet relative criterion. } ## If Hessian is non-positive definite: min.ev <- min(eigen(hessian, symmetric=TRUE, only.values=TRUE)$values) inflation.factor <- 1 ## Inflate diagonal of Hessian to make it positive definite: inflate <- abs(min.ev) + inflation.factor hessian <- hessian + diag(inflate, nrow(hessian)) if(control$trace > 0) cat(paste("Hessian is singular at iteration", i-1, "inflating diagonal with", formatC(inflate, digits=5, format="f"), "\n")) ch <- try(chol(hessian), silent=TRUE) if(inherits(ch, "try-error")) stop(gettextf("Cannot compute Newton step at iteration %d", i-1), call.=FALSE) modif.iter <- modif.iter + 1L ## do.newton <- FALSE } else modif.iter <- 0L if(modif.iter >= control$maxModIter) { conv <- 4L break } ## solve U'y = g for y, then ## solve U step = y for step: step <- c(backsolve(ch, backsolve(ch, gradient, transpose=TRUE))) rel.conv <- (max(abs(step)) < control$relTol) ## Test if step is in a descent direction - ## otherwise use step <- grad / max|grad|: ## if(crossprod(gradient, step) < 0) { ## if(control$trace > 0) ## cat("Newton step is not in descent direction; using gradient instead\n") ## step <- c(gradient / max(abs(gradient))) ## } else if(abs.conv && rel.conv) { conv <- 0L ## no need to step back as stephalf was false so the new ## par are just better. break } ## update parameters: rho$par <- rho$par - stepFactor * step nllTry <- rho$clm.nll(rho) lineIter <- 0 stephalf <- (nllTry > nll) ### NOTE: sometimes nllTry > nll just due to noise, so we also check ### reduction in gradient for small diffs: if(stephalf && abs(nll - nllTry) < 1e-10) stephalf <- maxGrad < max(abs(rho$clm.grad(rho))) ## Assess convergence: ## (only attempt to sattisfy rel.conv if abs.conv is true and ## it is possible to take the full newton step) ### OPTION: And if 'step' is not close to 1 or 1/2, but ### small. Otherwise this just indicates that the parameter is ### infinite. ## if(abs.conv && !step.ok) { if(abs.conv && stephalf) { conv <- 1L ## we need to step back to the par for which abs.conv ## was true: rho$par <- rho$par + stepFactor * step rho$clm.nll(rho) break } ## if(abs.conv && rel.conv) { ## conv <- 0L ## rho$par <- rho$par + stepFactor * step ## rho$clm.nll(rho) ## ## no need to step back as stephalf was false so the new ## ## par are just better. ## break ## } if(abs.conv && abs.iter >= 5L) { ## Cannot satisy rel.conv in 5 iterations after satisfying ## abs.conv. Probably some parameters are unbounded. conv <- 1L break } ## Step halving if nll increases: while(stephalf) { stepFactor <- stepFactor/2 rho$par <- rho$par + stepFactor * step nllTry <- rho$clm.nll(rho) lineIter <- lineIter + 1 if(control$trace > 0) { cat("step halving:\n") cat("nll reduction: ", formatC(nll - nllTry, digits=5, format="e"), "\n") Trace(i+innerIter-1, stepFactor, nll, maxGrad, rho$par, first = FALSE) } if(lineIter > control$maxLineIter){ conv <- 3L break } innerIter <- innerIter + 1 stephalf <- (nllTry > nll) if(stephalf && abs(nll - nllTry) < 1e-10) stephalf <- (maxGrad < max(abs(rho$clm.grad(rho)))) } ## end step halving if(conv == 3L) break if(control$trace > 0) cat("nll reduction: ", formatC(nll - nllTry, digits=5, format="e"), "\n") nll <- nllTry ## Double stepFactor if needed: stepFactor <- min(1, 2 * stepFactor) } ## end Newton iterations message <- switch(as.character(conv), "0" = "Absolute and relative convergence criteria were met", "1" = "Absolute convergence criterion was met, but relative criterion was not met", "2" = "iteration limit reached", "3" = "step factor reduced below minimum", "4" = "maximum number of consecutive Newton modifications reached") if(conv <= 1L && control$trace > 0) { cat("\nOptimizer converged! ", message, fill = TRUE) } if(conv > 1 && control$trace > 0) { cat("\nOptimization failed ", message, fill = TRUE) } ## return results: gradient <- c(rho$clm.grad(rho)) res <- list(par = rho$par, gradient = gradient, ##as.vector(gradient), ## Hessian = hessian, Hessian = rho$clm.hess(rho), ## ensure hessian is evaluated ## at optimum logLik = -nll, convergence = conv, ## 0: abs and rel criteria meet ## 1: abs criteria meet, rel criteria not meet ## 2: iteration limit reached ## 3: step factor reduced below minium message = message, maxGradient = max(abs(gradient)), niter = c(outer = i-1, inner = innerIter), fitted = rho$fitted) return(res) } clm_fit_optim <- function(rho, method = c("ucminf", "nlminb", "optim"), control=list()) { method <- match.arg(method) ## optimize the likelihood: optRes <- switch(method, "nlminb" = nlminb(rho$par, function(par) clm.nll(rho, par), function(par) clm.grad_direct(rho, par), control=control), "ucminf" = ucminf(rho$par, function(par) clm.nll(rho, par), function(par) clm.grad_direct(rho, par), control=control), "optim" = optim(rho$par, function(par) clm.nll(rho, par), function(par) clm.grad_direct(rho, par), method="BFGS", control=control) ) ## save results: rho$par <- optRes[[1]] res <- list(par = rho$par, logLik = -clm.nll(rho), gradient = clm.grad(rho), Hessian = clm.hess(rho), fitted = rho$fitted) res$maxGradient = max(abs(res$gradient)) res$optRes <- optRes res$niter <- switch(method, "nlminb" = optRes$evaluations, "ucminf" = c(optRes$info["neval"], 0), "optim" = optRes$counts) res$convergence <- switch(method, "nlminb" = optRes$convergence, "ucminf" = optRes$convergence, "optim" = optRes$convergence) return(res) } clm_fit_flex <- function(rho, control=list()) { lwr <- if(rho$link == "Aranda-Ordaz") c(rep(-Inf, length(rho$par) - 1), 1e-5) else rep(-Inf, length(rho$par)) ## optimize the likelihood: optRes <- nlminb(rho$par, function(par, rho) clm.nll.flex(rho, par), lower=lwr, rho=rho) ## save results: rho$par <- optRes$par res <- list(par = rho$par, lambda = setNames(rho$par[length(rho$par)], "lambda"), logLik = -clm.nll.flex(rho), gradient = numDeriv::grad(func=function(par, rho) clm.nll.flex(rho, par), x = rho$par, rho=rho), Hessian = numDeriv::hessian(func=function(par, rho) clm.nll.flex(rho, par), x = rho$par, rho=rho), fitted = rho$fitted) res$maxGradient = max(abs(res$gradient)) res$optRes <- optRes res$niter <- optRes$evaluations res$convergence <- optRes$convergence return(res) } clm.nll.flex <- function(rho, par) { if(!missing(par)) rho$par <- par with(rho, { if(k > 0) sigma <- Soff * exp(drop(S %*% par[n.psi + 1:k])) ### NOTE: we have to divide by sigma even if k=0 since there may be an ### offset but no predictors in the scale model: eta1 <- (drop(B1 %*% par[1:n.psi]) + o1)/sigma eta2 <- (drop(B2 %*% par[1:n.psi]) + o2)/sigma fitted <- pfun(eta1, par[length(par)]) - pfun(eta2, par[length(par)]) }) if(all(is.finite(rho$fitted)) && all(rho$fitted > 0)) ### NOTE: Need test here because some fitted <= 0 if thresholds are ### not ordered increasingly. -sum(rho$wts * log(rho$fitted)) else Inf } clm.nll <- function(rho, par) { if(!missing(par)) rho$par <- par with(rho, { if(k > 0) sigma <- Soff * exp(drop(S %*% par[n.psi + 1:k])) ### NOTE: we have to divide by sigma even if k=0 since there may be an ### offset but no predictors in the scale model: eta1 <- (drop(B1 %*% par[1:n.psi]) + o1)/sigma eta2 <- (drop(B2 %*% par[1:n.psi]) + o2)/sigma }) ### NOTE: getFitted is not found from within rho, so we have to ### evalueate it outside of rho rho$fitted <- getFittedC(rho$eta1, rho$eta2, rho$link, rho$par[length(rho$par)]) if(all(is.finite(rho$fitted)) && all(rho$fitted > 0)) ### NOTE: Need test here because some fitted <= 0 if thresholds are ### not ordered increasingly. -sum(rho$wts * log(rho$fitted)) else Inf } ## clm.nll <- function(rho) { ## negative log-likelihood ## ### For linear models ## with(rho, { ## eta1 <- drop(B1 %*% par) + o1 ## eta2 <- drop(B2 %*% par) + o2 ## }) ## ### NOTE: getFitted is not found from within rho, so we have to ## ### evalueate it outside of rho ## rho$fitted <- getFittedC(rho$eta1, rho$eta2, rho$link) ## if(all(rho$fitted > 0)) ## ### NOTE: Need test here because some fitted <= 0 if thresholds are ## ### not ordered increasingly. ## ### It is assumed that 'all(is.finite(pr)) == TRUE' ## -sum(rho$wts * log(rho$fitted)) ## else Inf ## } ## clm.grad <- function(rho) { ## gradient of the negative log-likelihood ## ### return: vector of gradients ## ### For linear models ## with(rho, { ## p1 <- dfun(eta1) ## p2 <- dfun(eta2) ## wtpr <- wts/fitted ## dpi.psi <- B1 * p1 - B2 * p2 ## -crossprod(dpi.psi, wtpr) ## ### NOTE: It is assumed that all(fitted > 0) == TRUE and that ## ### all(is.finite(c(p1, p2))) == TRUE ## }) ## } clm.grad <- function(rho) { ### requires that clm.nll has been called prior to ### clm.grad. with(rho, { p1 <- if(!nlambda) dfun(eta1) else dfun(eta1, lambda) p2 <- if(!nlambda) dfun(eta2) else dfun(eta2, lambda) wtpr <- wts/fitted C2 <- B1*p1/sigma - B2*p2/sigma if(k <= 0) return(-crossprod(C2, wtpr)) C3 <- -(eta1 * p1 - eta2 * p2) * S return(-crossprod(cbind(C2, C3), wtpr)) ### NOTE: C2 and C3 are used by clm.hess }) } clm.grad_direct <- function(rho, par) { ### does not require that clm.nll has been called prior to ### clm.grad. clm.nll(rho, par) clm.grad(rho) } ## clm.hess <- function(rho) { ## hessian of the negative log-likelihood ## ### return Hessian matrix ## ### For linear models ## with(rho, { ## dg.psi <- crossprod(B1 * gfun(eta1) * wtpr, B1) - ## crossprod(B2 * gfun(eta2) * wtpr, B2) ## -dg.psi + crossprod(dpi.psi, (dpi.psi * wtpr / fitted)) ## ### NOTE: It is assumed that all(fitted > 0) == TRUE and that ## ### all(is.finite(c(g1, g2))) == TRUE ## }) ## } clm.hess <- function(rho) { ### requires that clm.grad has been called prior to this. with(rho, { g1 <- if(!nlambda) gfun(eta1) else gfun(eta1, lambda) g2 <- if(!nlambda) gfun(eta2) else gfun(eta2, lambda) wtprpr <- wtpr/fitted ## Phi3 dg.psi <- crossprod(B1 * g1 * wtpr / sigma^2, B1) - crossprod(B2 * g2 * wtpr / sigma^2, B2) ## upper left: D <- dg.psi - crossprod(C2, (C2 * wtprpr)) if(k <= 0) return(-D) ## no scale predictors ## upper right (lower left transpose): wtprsig <- wtpr/sigma epg1 <- p1 + g1*eta1 epg2 <- p2 + g2*eta2 Et <- crossprod(B1, -wtprsig * epg1 * S) - crossprod(B2, -wtprsig * epg2 * S) - crossprod(C2, wtprpr * C3) ## lower right: F <- -crossprod(S, wtpr * ((eta1*p1 - eta2*p2)^2 / fitted - (eta1*epg1 - eta2*epg2)) * S) ## combine and return hessian: H <- rbind(cbind(D , Et), cbind(t(Et), F)) return(-H) }) } ordinal/R/utils.R0000644000176200001440000004475515127777530013423 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Various utility functions. setLinks <- function(rho, link) { ### The Aranda-Ordaz and log-gamma links are not supported in this ### version of clm. rho$pfun <- switch(link, logit = plogis, probit = pnorm, cloglog = function(x, lower.tail=TRUE) pgumbel(x, lower.tail=lower.tail, max=FALSE), cauchit = pcauchy, loglog = pgumbel, "Aranda-Ordaz" = function(x, lambda) pAO(x, lambda), "log-gamma" = function(x, lambda) plgamma(x, lambda)) rho$dfun <- switch(link, logit = dlogis, probit = dnorm, cloglog = function(x) dgumbel(x, max=FALSE), cauchit = dcauchy, loglog = dgumbel, "Aranda-Ordaz" = function(x, lambda) dAO(x, lambda), "log-gamma" = function(x, lambda) dlgamma(x, lambda)) rho$gfun <- switch(link, logit = glogis, probit = gnorm, cloglog = function(x) ggumbel(x, max=FALSE), loglog = ggumbel, cauchit = gcauchy, "Aranda-Ordaz" = function(x, lambda) gAO(x, lambda), ## shouldn't happen "log-gamma" = function(x, lambda) glgamma(x, lambda) ) rho$link <- link rho$nlambda <- if(rho$link %in% c("Aranda-Ordaz", "log-gamma")) 1 else 0 if(rho$link == "Aranda-Ordaz") rho$lambda <- 1 if(rho$link == "log-gamma") rho$lambda <- 0.1 } makeThresholds <- function(y.levels, threshold) { ## , tJac) { ### Generate the threshold structure summarized in the transpose of ### the Jacobian matrix, tJac. Also generating nalpha and alpha.names. ### args: ### y - response variable, a factor ### threshold - one of "flexible", "symmetric" or "equidistant" ## stopifnot(is.factor(y)) lev <- y.levels ntheta <- length(lev) - 1 ## if(!is.null(tJac)) { ## stopifnot(nrow(tJac) == ntheta) ## nalpha <- ncol(tJac) ## alpha.names <- colnames(tJac) ## if(is.null(alpha.names) || anyDuplicated(alpha.names)) ## alpha.names <- as.character(1:nalpha) ## dimnames(tJac) <- NULL ## } ## else { ## threshold structure identified by threshold argument: if(threshold == "flexible") { tJac <- diag(ntheta) nalpha <- ntheta alpha.names <- paste(lev[-length(lev)], lev[-1], sep="|") } if(threshold == "symmetric") { if(!ntheta >=2) stop("symmetric thresholds are only meaningful for responses with 3 or more levels", call.=FALSE) if(ntheta %% 2) { ## ntheta is odd nalpha <- (ntheta + 1)/2 ## No. threshold parameters tJac <- t(cbind(diag(-1, nalpha)[nalpha:1, 1:(nalpha-1)], diag(nalpha))) tJac[,1] <- 1 alpha.names <- c("central", paste("spacing.", 1:(nalpha-1), sep="")) } else { ## ntheta is even nalpha <- (ntheta + 2)/2 tJac <- cbind(rep(1:0, each = ntheta / 2), rbind(diag(-1, ntheta / 2)[(ntheta / 2):1,], diag(ntheta / 2))) tJac[,2] <- rep(0:1, each = ntheta / 2) alpha.names <- c("central.1", "central.2") if(nalpha > 2) alpha.names <- c(alpha.names, paste("spacing.", 1:(nalpha-2), sep="")) } } ## Assumes latent mean is zero: if(threshold == "symmetric2") { if(!ntheta >=2) stop("symmetric thresholds are only meaningful for responses with 3 or more levels", call.=FALSE) if(ntheta %% 2) { ## ntheta is odd nalpha <- (ntheta - 1)/2 ## No. threshold parameters tJac <- rbind(apply(-diag(nalpha), 1, rev), rep(0, nalpha), diag(nalpha)) } else { ## ntheta is even nalpha <- ntheta/2 tJac <- rbind(apply(-diag(nalpha), 1, rev), diag(nalpha)) } alpha.names <- paste("spacing.", 1:nalpha, sep="") } if(threshold == "equidistant") { if(!ntheta >=2) stop("equidistant thresholds are only meaningful for responses with 3 or more levels", call.=FALSE) tJac <- cbind(1, 0:(ntheta-1)) nalpha <- 2 alpha.names <- c("threshold.1", "spacing") } ## } return(list(tJac = tJac, nalpha = nalpha, alpha.names = alpha.names)) } getFitted <- function(eta1, eta2, pfun, ...) { ## eta1, eta2: linear predictors ## pfun: cumulative distribution function ## ## Compute fitted values while maintaining high precision in the ## result - if eta1 and eta2 are both large, fitted is the ## difference between two numbers very close to 1, which leads to ## imprecision and potentially errors. ## ## Note that (eta1 > eta2) always holds, hence (eta2 > 0) happens ## relatively rarely. k2 <- eta2 > 0 fitted <- pfun(eta1) - pfun(eta2) fitted[k2] <- pfun(eta2[k2], lower.tail=FALSE) - pfun(eta1[k2], lower.tail=FALSE) fitted } getFittedC <- function(eta1, eta2, link = c("logit", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), lambda=1) ### Same as getFitted only this is implemented in C and handles all ### link functions including the flexible ones. { link <- match.arg(link) .Call("get_fitted", eta1, eta2, link, lambda) } getWeights <- function(mf) { ### mf - model.frame n <- nrow(mf) if(is.null(wts <- model.weights(mf))) wts <- rep(1, n) ## if (any(wts <= 0)) ## stop(gettextf("non-positive weights are not allowed"), ## call.=FALSE) ### NOTE: We do not remove observations where weights == 0, because ### that could be a somewhat surprising behaviour. It would also ### require that the model.frame be evaluated all over again to get ### the right response vector with the right number of levels. if(length(wts) && length(wts) != n) stop(gettextf("number of weights is %d should equal %d (number of observations)", length(wts), n), call.=FALSE) if(any(wts < 0)) stop(gettextf("negative weights are not allowed"), call.=FALSE) ## if(any(wts == 0)) { ## y <- model.response(mf, "any") ## if(any(table(y[wts > 0]) == 0)) ## stop(gettextf("zero positive weights for one or more response categories"), ## call.=FALSE) ## } return(as.double(wts)) } getOffset <- function(mf, terms) { ### mf - model.frame n <- nrow(mf) off <- rep(0, n) if(!is.null(o <- attr(terms, "offset"))) { if(length(o) > 1) stop("only one offset term allowed in each formula", call.=FALSE) varnm <- attr(terms, "variables") ## deparse all variable names - character vector: varnm <- unlist(lapply(as.list(varnm), deparse)[-1]) off <- mf[, varnm[o]] } ## off <- as.vector(mf[, o]) if(length(off) && length(off) != n) stop(gettextf("number of offsets is %d should equal %d (number of observations)", length(off), n), call.=FALSE) return(as.double(off)) } getOffsetStd <- function(mf) { n <- nrow(mf) if(is.null(off <- model.offset(mf))) off <- rep(0, n) if(length(off) && length(off) != n) stop(gettextf("number of offsets is %d should equal %d (number of observations)", length(off), n), call.=FALSE) return(as.double(off)) } getFullForm <- function(form, ..., envir=parent.frame()) { ### collect terms in several formulas in a single formula ### sets the environment of the resulting formula to envir. forms <- list(...) if(lf <- length(forms)) { rhs <- character(0) ## Collect rhs terms in a single vector of rh-sides: for(i in 1:lf) { rhs <- c(rhs, Deparse(forms[[i]][[2]])) if(length(forms[[i]]) >= 3) rhs <- c(rhs, Deparse(forms[[i]][[3]])) } ## add '+' inbetween terms: rhs <- paste(rhs, collapse=" + ") ## combine if 'deparse(form)' is a (long) vector: form2 <- paste(deparse(form, width.cutoff=500L), collapse=" ") ## combine form2 and rhs into a single string: form <- paste(form2, rhs, sep=" + ") } return(as.formula(form, env=envir)) } ## getFullForm <- function(form, ..., envir=parent.frame()) { ## ### collect terms in several formulas in a single formula (on the rhs) ## ### sets the environment of the resulting formula to envir. ## forms <- list(form, ...) ## allVars <- unlist(sapply(forms, all.vars)) ## rhs <- paste(allVars, collapse=" + ") ## form <- paste("~", rhs) ## return(as.formula(form, env=envir)) ## } ## getCtrlArgs <- function(control, extras) { ## ### Recover control arguments from clmm.control and extras (...): ## ### ## ## Collect control arguments in list: ## ctrl.args <- c(extras, control$method, control$useMatrix, ## control$ctrl, control$optCtrl) ## ## Identify the two occurences "trace", delete them, and add trace=1 ## ## or trace=-1 to the list of arguments: ## which.trace <- which(names(ctrl.args) == "trace") ## trace.sum <- sum(unlist(ctrl.args[which.trace])) ## ctrl.args <- ctrl.args[-which.trace] ## ## remove duplicated arguments: ## ctrl.args <- ctrl.args[!duplicated(names(ctrl.args))] ## if(trace.sum >= 1) ctrl.args$trace <- 1 ## if(trace.sum >= 2 || trace.sum <= -1) ctrl.args$trace <- -1 ## ## return the updated list of control parameters: ## do.call("clmm.control", ctrl.args) ## } getCtrlArgs <- function(control, extras) { ### Recover control arguments from clmm.control and extras (...): ### if(!is.list(control)) stop("'control' should be a list") ## Collect control arguments in list: ## 1) assuming 'control' is a call to clmm.control: ctrl.args <- if(setequal(names(control), names(clmm.control()))) c(extras, control["method"], control["useMatrix"], control$ctrl, control$optCtrl) ## assuming 'control' is specified with control=list( 'args'): else c(extras, control) ### NOTE: having c(extras, control) rather than c(control, extras) ### means that extras have precedence over control. ## Identify the two occurences "trace", delete them, and add trace=1 ## or trace=-1 to the list of arguments: which.trace <- which(names(ctrl.args) == "trace") trace.sum <- sum(unlist(ctrl.args[which.trace])) if(trace.sum) ctrl.args <- ctrl.args[-which.trace] ## remove duplicated arguments: ctrl.args <- ctrl.args[!duplicated(names(ctrl.args))] if(trace.sum >= 1) ctrl.args$trace <- 1 if(trace.sum >= 2 || trace.sum <= -1) ctrl.args$trace <- -1 ## return the updated list of control parameters: do.call("clmm.control", ctrl.args) } Trace <- function(iter, stepFactor, val, maxGrad, par, first=FALSE) { t1 <- sprintf(" %3d: %-5e: %.3f: %1.3e: ", iter, stepFactor, val, maxGrad) t2 <- formatC(par) if(first) cat("iter: step factor: Value: max|grad|: Parameters:\n") cat(t1, t2, "\n") } response.name <- function(terms) { vars <- as.character(attr(terms, "variables")) vars[1 + attr(terms, "response")] } getB <- function(y, NOM=NULL, X=NULL, offset=NULL, tJac=NULL) { ### NOTE: Is this function ever used? ### NOTE: no tests that arguments conform. nlev <- nlevels(y) n <- length(y) B2 <- 1 * (col(matrix(0, n, nlev)) == c(unclass(y))) o1 <- c(1e5 * B2[, nlev]) - offset o2 <- c(-1e5 * B2[,1]) - offset B1 <- B2[, -(nlev), drop = FALSE] B2 <- B2[, -1, drop = FALSE] ## adjust B1 and B2 for structured thresholds: if(!is.null(tJac)) { B1 <- B1 %*% tJac B2 <- B2 %*% tJac } ## update B1 and B2 with nominal effects: if(!is.null(NOM) && ncol(NOM) > 1) { ## if !is.null(NOM) and NOM is more than an intercept: LL1 <- lapply(1:ncol(NOM), function(x) B1 * NOM[,x]) B1 <- do.call(cbind, LL1) LL2 <- lapply(1:ncol(NOM), function(x) B2 * NOM[,x]) B2 <- do.call(cbind, LL2) } ## update B1 and B2 with location effects (X): nbeta <- ncol(X) - 1 if(ncol(X) > 1) { B1 <- cbind(B1, -X[, -1, drop = FALSE]) B2 <- cbind(B2, -X[, -1, drop = FALSE]) } dimnames(B1) <- NULL dimnames(B2) <- NULL namedList(B1, B2, o1, o2) } Deparse <- function(expr, width.cutoff = 500L, backtick = mode(expr) %in% c("call", "expression", "(", "function"), control = c("keepInteger", "showAttributes", "keepNA"), nlines = -1L) paste(deparse(expr=expr, width.cutoff= width.cutoff, backtick=backtick, control=control, nlines=nlines), collapse = " ") getContrasts <- function(terms, contrasts) { if(is.null(contrasts)) return(NULL) term.labels <- attr(terms, "term.labels") contrasts[names(contrasts) %in% term.labels] } checkContrasts <- function(terms, contrasts) { ### Check that contrasts are not specified for absent factors and warn ### about them term.labels <- attr(terms, "term.labels") nm.contr <- names(contrasts) notkeep <- nm.contr[!nm.contr %in% term.labels] msg <- if(length(notkeep) > 2) "variables '%s' are absent: their contrasts will be ignored" else "variable '%s' is absent: its contrasts will be ignored" if(length(notkeep)) warning(gettextf(msg, paste(notkeep, collapse=", ")), call.=FALSE) invisible() } get_clmInfoTab <- function(object, ...) { names <- c("link", "threshold", "nobs", "logLik", "edf", "niter", "maxGradient", "cond.H") stopifnot(all(names %in% names(object))) info <- with(object, { data.frame("link" = link, "threshold" = threshold, "nobs" = nobs, "logLik" = formatC(logLik, digits=2, format="f"), "AIC" = formatC(-2*logLik + 2*edf, digits=2, format="f"), "niter" = paste(niter[1], "(", niter[2], ")", sep=""), ### NOTE: iterations to get starting values for scale models *are* ### included here. "max.grad" = formatC(maxGradient, digits=2, format="e"), "cond.H" = formatC(cond.H, digits=1, format="e") ## BIC is not part of output since it is not clear what ## the no. observations are. ) }) info } format_tJac <- function(tJac, y.levels, alpha.names) { lev <- y.levels rownames(tJac) <- paste(lev[-length(lev)], lev[-1], sep="|") colnames(tJac) <- alpha.names tJac } extractFromFrames <- function(frames, fullmf) { lst <- list(y.levels=frames$y.levels, na.action=attr(fullmf, "na.action"), tJac=format_tJac(frames)) lstX <- list(contrasts=attr(frames$X, "contrasts"), terms=frames$terms, xlevels=.getXlevels(frames$terms, fullmf)) lst <- c(lst, lstX) if(!is.null(frames[["S"]])) lst <- c(lst, list(S.contrasts=attr(frames$S, "contrasts"), S.terms=frames$S.terms, S.xlevels=.getXlevels(frames$S.terms, fullmf))) if(!is.null(frames[["NOM"]])) lst <- c(lst, list(nom.contrasts=attr(frames$NOM, "contrasts"), nom.terms=frames$nom.terms, nom.xlevels=.getXlevels(frames$nom.terms, fullmf))) lst } formatTheta <- function(alpha, tJac, x, sign.nominal) { ## x: alpha, tJac, nom.terms, NOM, nom.contrasts, nom.xlevels, Theta.ok <- TRUE if(is.null(x[["NOM"]])) { ## no nominal effects Theta <- alpha %*% t(tJac) colnames(Theta) <- rownames(tJac) return(namedList(Theta, Theta.ok)) } x$nom.assign <- attr(x$NOM, "assign") args <- c("nom.terms", "nom.assign") args <- c("nom.terms") if(any(sapply(args, function(txt) is.null(x[[txt]])))) { ## Nominal effects, but we cannot compute Theta warning("Cannot assess if all thresholds are increasing", call.=FALSE) return(namedList(Theta.ok)) } ## Get matrix of thresholds; Theta: Theta.list <- getThetamat(terms=x$nom.terms, alpha=alpha, assign=attr(x$NOM, "assign"), contrasts=x$nom.contrasts, tJac=tJac, xlevels=x$nom.xlevels, sign.nominal=sign.nominal) ## Test that (finite) thresholds are increasing: if(all(is.finite(unlist(Theta.list$Theta)))) { th.increasing <- apply(Theta.list$Theta, 1, function(th) all(diff(th) >= 0)) if(!all(th.increasing)) Theta.ok <- FALSE } Theta <- if(length(Theta.list) == 2) with(Theta.list, cbind(mf.basic, Theta)) else Theta.list$Theta alpha.mat <- matrix(alpha, ncol=ncol(tJac), byrow=TRUE) colnames(alpha.mat) <- colnames(tJac) rownames(alpha.mat) <- attr(x$NOM, "orig.colnames") ## Return namedList(Theta, alpha.mat, Theta.ok) } ## We don't need this function anymore since the terms objects now ## always contain dataClasses and predvars attributes. ## get_dataClasses <- function(mf) { ## if(!is.null(Terms <- attr(mf, "terms")) && ## !is.null(dataCl <- attr(Terms, "dataClasses"))) ## return(dataCl) ## sapply(mf, .MFclass) ## } ## Returns a named list, where the names are the deparsed actual ## arguments: namedList <- function(...) { setNames(list(...), nm=sapply(as.list(match.call()), deparse)[-1]) } ## a <- 1 ## b <- 2 ## c <- 3 ## d <- list(e=2, f=factor(letters[rep(1:2, 2)])) ## g <- matrix(runif(9), 3) ## ## namedList(a, b, c) ## namedList(a, b, c, d, g) ## ## res <- namedList(d, g) ## names(res) ordinal/R/clm.predict.R0000644000176200001440000003402515127777530014454 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## The predict method for clm objects. predict.clm <- function(object, newdata, se.fit = FALSE, interval = FALSE, level = 0.95, type = c("prob", "class", "cum.prob", "linear.predictor"), na.action = na.pass, ...) ### result - a list of predictions (fit) ### OPTION: restore names of the fitted values ### ### Assumes object has terms, xlevels, contrasts, tJac { ## match and test arguments: type <- match.arg(type) se.fit <- as.logical(se.fit)[1] interval <- as.logical(interval)[1] stopifnot(length(level) == 1 && is.numeric(level) && level < 1 && level > 0) if(type == "class" && (se.fit || interval)) { warning("se.fit and interval set to FALSE for type = 'class'") se.fit <- interval <- FALSE } cov <- if(se.fit || interval) vcov(object) else NULL ### Get newdata object; fill in response if missing and always for ### type=="class": has.response <- TRUE if(type == "class" && missing(newdata)) ## newdata <- update(object, method="model.frame")$mf newdata <- model.frame(object) ## newdata supplied or type=="class": has.newdata <- !(missing(newdata) || is.null(newdata)) if(has.newdata || type=="class") { if(has.newdata && sum(unlist(object$aliased)) > 0) warning("predictions from column rank-deficient fit may be misleading") newdata <- as.data.frame(newdata) ## Test if response is in newdata: resp <- response.name(object$terms) ## remove response from newdata if type == "class" if(type == "class") newdata <- newdata[!names(newdata) %in% resp] has.response <- resp %in% names(newdata) ## FALSE for type == "class" if(!has.response) { ## fill in response variable in newdata if missing: ylev <- object$y.levels nlev <- length(ylev) nnd <- nrow(newdata) newdata <- cbind(newdata[rep(1:nnd, each=nlev) , , drop=FALSE], factor(rep(ylev, nnd), levels=ylev, ordered=TRUE)) names(newdata)[ncol(newdata)] <- resp } ### Set model matrices: if(is.null(attr(object$terms, "predvars"))) warning(paste0("terms object does not have a predvars attribute: ", "predictions may be misleading")) mf <- model.frame(object$terms, newdata, na.action=na.action, xlev=object$xlevels) ## model.frame will warn, but here we also throw an error: if(nrow(mf) != nrow(newdata)) stop("length of variable(s) found do not match nrow(newdata)") ## check that variables are of the right type: if (!is.null(cl <- attr(object$terms, "dataClasses"))) .checkMFClasses(cl, mf) ## make model.matrix: X <- model.matrix(object$terms, mf, contrasts = object$contrasts) Xint <- match("(Intercept)", colnames(X), nomatch = 0L) n <- nrow(X) if(Xint <= 0) X <- cbind("(Intercept)" = rep(1, n), X) # if(object$control$sign.location == "negative") NOM[, -1] <- -NOM[, -1] ## drop aliased columns: if(sum(object$aliased$beta) > 0) X <- X[, !c(FALSE, object$aliased$beta), drop=FALSE] ## handle offset (from predict.lm): ### NOTE: Could factor the offset handling out in its own function for ### code clarity: offset <- rep(0, nrow(X)) if(!is.null(off.num <- attr(object$terms, "offset"))) for(i in off.num) offset <- offset + eval(attr(object$terms, "variables")[[i + 1]], newdata) y <- model.response(mf) if(any(!levels(y) %in% object$y.levels)) stop(gettextf("response factor '%s' has new levels", response.name(object$terms))) ### make NOMINAL model.matrix: if(is.nom <- !is.null(object$nom.terms)) { ## allows NAs to pass through to fit, se.fit, lwr and upr: nom.mf <- model.frame(object$nom.terms, newdata, na.action=na.action, xlev=object$nom.xlevels) ## model.frame will warn, but here we also throw an error: if(nrow(nom.mf) != nrow(newdata)) stop("length of variable(s) found do not match nrow(newdata)") if (!is.null(cl <- attr(object$nom.terms, "dataClasses"))) .checkMFClasses(cl, nom.mf) NOM <- model.matrix(object$nom.terms, nom.mf, contrasts=object$nom.contrasts) NOMint <- match("(Intercept)", colnames(NOM), nomatch = 0L) if(NOMint <= 0) NOM <- cbind("(Intercept)" = rep(1, n), NOM) # if(object$control$sign.nominal == "negative") NOM[, -1] <- -NOM[, -1] alias <- t(matrix(object$aliased$alpha, nrow=length(object$y.levels) - 1))[,1] if(sum(alias) > 0) NOM <- NOM[, !c(FALSE, alias), drop=FALSE] } ### make SCALE model.matrix: if(is.scale <- !is.null(object$S.terms)) { ## allows NAs to pass through to fit, se.fit, lwr and upr: S.mf <- model.frame(object$S.terms, newdata, na.action=na.action, xlev=object$S.xlevels) ## model.frame will warn, but here we also throw an error: if(nrow(S.mf) != nrow(newdata)) stop("length of variable(s) found do not match nrow(newdata)") if (!is.null(cl <- attr(object$S.terms, "dataClasses"))) .checkMFClasses(cl, S.mf) S <- model.matrix(object$S.terms, S.mf, contrasts=object$S.contrasts) Sint <- match("(Intercept)", colnames(S), nomatch = 0L) if(Sint <= 0) S <- cbind("(Intercept)" = rep(1, n), S) if(sum(object$aliased$zeta) > 0) S <- S[, !c(FALSE, object$aliased$zeta), drop=FALSE] Soff <- rep(0, nrow(S)) if(!is.null(off.num <- attr(object$S.terms, "offset"))) for(i in off.num) Soff <- Soff + eval(attr(object$S.terms, "variables")[[i + 1]], newdata) } ### Construct model environment: tJac <- object$tJac dimnames(tJac) <- NULL env <- clm.newRho(parent.frame(), y=y, X=X, NOM=if(is.nom) NOM else NULL, S=if(is.scale) S else NULL, weights=rep(1, n), offset=offset, S.offset=if(is.scale) Soff else rep(0, n), tJac=tJac, control=object$control) setLinks(env, link=object$link) } ## end !missing(newdata) or type == "class" else { env <- get_clmRho.clm(object) ## env <- update(object, doFit=FALSE) } env$par <- as.vector(coef(object)) env$par <- env$par[!is.na(env$par)] ### OPTION: Are there better ways to handle NAs in coef? ## if(length(env$par) != ncol(env$B1)) ## stop(gettextf("design matrix has %d columns, but expecting %d (number of parameters)", ## ncol(env$B1), length(env$par))) ## Get predictions: pred <- switch(type, "prob" = prob.predict.clm(env=env, cov=cov, se.fit=se.fit, interval=interval, level=level), "class" = prob.predict.clm(env=env, cov=cov, se.fit=se.fit, interval=interval, level=level), "cum.prob" = cum.prob.predict.clm(env=env, cov=cov, se.fit=se.fit, interval=interval, level=level), "linear.predictor" = lin.pred.predict.clm(env=env, cov=cov, se.fit=se.fit, interval=interval, level=level) ##, ## "eta" = eta.pred.predict.clm(env=env, cov=cov, ## se.fit=se.fit, interval=interval, level=level) ) ### Arrange predictions in matrices if response is missing from ### newdata arg or type=="class": if(!has.response || type == "class") { pred <- lapply(pred, function(x) { x <- matrix(unlist(x), ncol=nlev, byrow=TRUE) dimnames(x) <- list(1:nrow(x), ylev) x }) ## if(type == "eta") ## pred <- lapply(pred, function(x) { ## x <- x[, -nlev, drop=FALSE] ## colnames(x) <- names(object$alpha) ## }) if(type == "class") pred <- lapply(pred, function(x) { factor(max.col(x), levels=seq_along(ylev), labels=ylev) }) } ### Filter missing values (if relevant): if(missing(newdata) && !is.null(object$na.action)) pred <- lapply(pred, function(x) napredict(object$na.action, x)) return(pred) } prob.predict.clm <- function(env, cov, se.fit=FALSE, interval=FALSE, level=0.95) ### Works for linear and scale models: ### env - model environment with par set. ### cov - vcov for the parameters { ## evaluate nll and grad to set dpi.psi in env: clm.nll(env) pred <- list(fit = as.vector(env$fitted)) if(se.fit || interval) { se.pr <- get.se(env, cov, type="prob") if(se.fit) pred$se.fit <- se.pr if(interval) { pred.logit <- qlogis(pred$fit) ## se.logit <- dlogis(pred$fit) * se.pr se.logit <- se.pr / (pred$fit * (1 - pred$fit)) a <- (1 - level)/2 pred$lwr <- plogis(pred.logit + qnorm(a) * se.logit) pred$upr <- plogis(pred.logit - qnorm(a) * se.logit) } } return(pred) } eta.pred.predict.clm <- function(env, cov, se.fit=FALSE, interval=FALSE, level=0.95) { ## clm.nll(env) pred <- list(eta = c(with(env, B1 %*% par[1:n.psi]))) if(se.fit || interval) { se <- get.se(env, cov, type="lp") if(se.fit) { pred$se.eta <- se[[1]] } if(interval) { a <- (1 - level)/2 pred$lwr1 <- env$eta1 + qnorm(a) * se[[1]] pred$upr1 <- env$eta1 - qnorm(a) * se[[1]] } } pred } lin.pred.predict.clm <- function(env, cov, se.fit=FALSE, interval=FALSE, level=0.95) ### get predictions on the scale of the linear predictor { ## evaluate nll and grad to set dpi.psi in env: clm.nll(env) pred <- list(eta1=env$eta1, eta2=env$eta2) if(se.fit || interval) { se <- get.se(env, cov, type="lp") if(se.fit) { pred$se.eta1 <- se[[1]] pred$se.eta2 <- se[[2]] } if(interval) { a <- (1 - level)/2 pred$lwr1 <- env$eta1 + qnorm(a) * se[[1]] pred$lwr2 <- env$eta2 + qnorm(a) * se[[2]] pred$upr1 <- env$eta1 - qnorm(a) * se[[1]] pred$upr2 <- env$eta2 - qnorm(a) * se[[2]] } } return(pred) ## list with predictions. } cum.prob.predict.clm <- function(env, cov, se.fit=FALSE, interval=FALSE, level=0.95) { ## evaluate nll and grad to set dpi.psi in env: clm.nll(env) pred <- list(cprob1=env$pfun(env$eta1), cprob2=env$pfun(env$eta2)) if(se.fit || interval) { se <- get.se(env, cov, type="gamma") if(se.fit) { pred$se.cprob1 <- se[[1]] pred$se.cprob2 <- se[[2]] } if(interval) { a <- (1 - level)/2 pred$lwr1 <- pred$cprob1 + qnorm(a) * se[[1]] pred$lwr2 <- pred$cprob2 + qnorm(a) * se[[2]] pred$upr1 <- pred$cprob1 - qnorm(a) * se[[1]] pred$upr2 <- pred$cprob2 - qnorm(a) * se[[2]] } } return(pred) } get.se <- function(rho, cov, type=c("lp", "gamma", "prob")) { ### Computes standard errors of predicted probabilities (prob), ### cumulative probabilities (gamma) or values of the linear ### predictor (lp) for linear (k<=0) or location-scale models ### (k>0). rho$xcovtx <- function(x, chol.cov) { ## Compute 'diag(x %*% cov %*% t(x))' diag(x %*% crossprod(chol.cov) %*% t(x)) ## colSums(tcrossprod(chol.cov, x)^2) } rho$type <- match.arg(type) ind <- seq_len(rho$n.psi + rho$k) rho$chol.cov <- try(chol(cov[ind, ind]), silent=TRUE) if(inherits(rho$chol.cov, "try-error")) stop(gettext("VarCov matrix of model parameters is not positive definite:\n cannot compute standard errors of predictions"), call.=FALSE) clm.nll(rho) ## just to be safe with(rho, { ### First compute d[eta, gamma, prob] / d par; then compute variance ### covariance matrix of the observations and extract SEs as the ### square root of the diagonal elements: if(type %in% c("lp", "gamma")) { D1 <- B1 D2 <- B2 if(k > 0) { D1 <- cbind(D1/sigma, -S*eta1) D2 <- cbind(D2/sigma, -S*eta2) } if(type == "gamma") { p1 <- if(!nlambda) dfun(eta1) else dfun(eta1, lambda) p2 <- if(!nlambda) dfun(eta2) else dfun(eta2, lambda) D1 <- D1*p1 D2 <- D2*p2 } se <- list(se1=sqrt(xcovtx(D1, chol.cov)), se2=sqrt(xcovtx(D2, chol.cov))) } if(type == "prob") { p1 <- if(!nlambda) dfun(eta1) else dfun(eta1, lambda) p2 <- if(!nlambda) dfun(eta2) else dfun(eta2, lambda) C2 <- if(k <= 0) B1*p1 - B2*p2 else cbind(B1*p1/sigma - B2*p2/sigma, -(eta1 * p1 - eta2 * p2) * S) se <- sqrt(xcovtx(C2, chol.cov)) } }) rho$se } ordinal/R/clm2.R0000644000176200001440000015523215127777530013111 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## An alternate (and older) implementation of CLMs in clm2(). The new ## and recommended implementation is available in clm(), cf. ./R/clm.R clm2.control <- function(method = c("ucminf", "Newton", "nlminb", "optim", "model.frame"), ..., convTol = 1e-4, trace = 0, maxIter = 100, gradTol = 1e-5, maxLineIter = 10) { method <- match.arg(method) ctrl <- if(method == "Newton") list(convTol=convTol, trace=trace, maxIter=maxIter, gradTol=gradTol, maxLineIter=maxLineIter) else list(trace = abs(trace), ...) if(!all(is.numeric(c(maxIter, gradTol, maxLineIter, convTol)))) stop("maxIter, gradTol, maxLineIter, convTol should all be numeric") if(convTol <= 0) stop("convTol should be > 0") if(method == "ucminf" && !"grtol" %in% names(ctrl)) ctrl$grtol <- gradTol ## if(method == "ucminf" && convTol > ctrl$grtol) ## stop("convTol should be <= grtol/gradTol") ## if(method == "Newton" && convTol > gradTol) ## stop("convTol should be <= gradTol") list(method = method, convTol = convTol, ctrl = ctrl) } newRho <- function(parent, XX, X, Z, y, weights, Loffset, Soffset, ## OK link, lambda, theta, threshold, Hess, control) ### OPTION: Could we remove the theta argument? { rho <- new.env(parent = parent) rho$X <- X rho$dnX <- dimnames(X) dimnames(rho$X) <- NULL rho$Z <- Z rho$dnZ <- dimnames(Z) dimnames(rho$Z) <- NULL rho$weights <- weights rho$Loffset <- Loffset rho$expSoffset <- rho$sigma <- exp(Soffset) rho$Hess <- ifelse(Hess, 1L, 0L) rho$method <- control$method rho$convTol <- control$convTol rho$ctrl <- control$ctrl rho$pfun <- switch(link, logistic = plogis, probit = pnorm, cloglog = function(x) pgumbel(x, max=FALSE), cauchit = pcauchy, loglog = pgumbel, "Aranda-Ordaz" = function(x, lambda) pAO(x, lambda), "log-gamma" = function(x, lambda) plgamma(x, lambda)) rho$dfun <- switch(link, logistic = dlogis, probit = dnorm, cloglog = function(x) dgumbel(x, max=FALSE), cauchit = dcauchy, loglog = dgumbel, "Aranda-Ordaz" = function(x, lambda) dAO(x, lambda), "log-gamma" = function(x, lambda) dlgamma(x, lambda)) rho$gfun <- switch(link, logistic = glogis, probit = function(x) -x * dnorm(x), cloglog = function(x) ggumbel(x, max=FALSE), cloglog = ggumbel, cauchit = gcauchy, "Aranda-Ordaz" = function(x, lambda) gAO(x, lambda), ## shouldn't happen "log-gamma" = function(x, lambda) glgamma(x, lambda) ) rho$link <- link rho$linkInt <- switch(link, logistic = 1L, probit = 2L, cloglog = 3L, loglog = 4L, cauchit = 5L, "Aranda-Ordaz" = 6L, "log-gamma" = 7L) rho$estimLambda <- ifelse(link %in% c("Aranda-Ordaz", "log-gamma") && is.null(lambda), 1L, 0L) rho$nlambda <- 0L rho$lambda <- if(!is.null(lambda)) lambda else 1 if(link %in% c("Aranda-Ordaz", "log-gamma")) rho$nlambda <- 1L if(rho$estimLambda > 0 & rho$link == "Aranda-Ordaz" & rho$method != "nlminb"){ message("Changing to nlminb optimizer to accommodate optimization with bounds") m <- match( names(rho$ctrl), "grtol", 0) rho$ctrl <- rho$ctrl[!m] rho$method <- "nlminb" } if(rho$method == "nlminb") { rho$limitUp <- Inf rho$limitLow <- -Inf } rho$n <- n <- length(y) rho$p <- ifelse(missing(X), 0, ncol(X)) rho$k <- ifelse(missing(Z), 0, ncol(Z)) rho$y <- y rho$threshold <- threshold rho$ncolXX <- ncol(XX) rho$dnXX <- dimnames(XX) rho$lev <- levels(y) rho$ntheta <- nlevels(y) - 1 rho$B2 <- 1 * (col(matrix(0, n, rho$ntheta + 1)) == c(unclass(y))) ### Setting elements of o[12] to [+-]Inf cause problems in ### getGnll and clmm-related functions because 1) 0*Inf = NaN, while ### 0*large.value = 0, so several computations have to be handled ### specially and 2) Inf-values are not by default allowed in .C calls ### and all specials would have to be handled separately. ## o1 <- B2[, rho$ntheta + 1, drop = TRUE] ## o1[o1 == 1] <- Inf ## rho$o1 <- o1 - rho$Loffset ## o2 <- B2[,1, drop = TRUE] ## o2[o2 == 1] <- -Inf ## rho$o2 <- o2 - rho$Loffset inf.value <- 1e5 rho$o1 <- c(inf.value * rho$B2[, rho$ntheta + 1]) - rho$Loffset rho$o2 <- c(-inf.value * rho$B2[,1]) - rho$Loffset rho$B1 <- rho$B2[,-(rho$ntheta + 1), drop = FALSE] rho$B2 <- rho$B2[,-1, drop = FALSE] makeThresholds2(rho, threshold) rho$B1 <- rho$B1 %*% rho$tJac rho$B2 <- rho$B2 %*% rho$tJac rho$xiNames <- rho$alphaNames rho$nxi <- rho$nalpha * rho$ncolXX if(rho$ncolXX > 1) { ## test actually not needed rho$xiNames <- paste(rep(rho$alphaNames, rho$ncolXX), ".", rep(colnames(XX), each=rho$nalpha), sep="") LL1 <- lapply(1:rho$ncolXX, function(x) rho$B1 * XX[,x]) rho$B1 <- do.call(cbind, LL1) LL2 <- lapply(1:rho$ncolXX, function(x) rho$B2 * XX[,x]) rho$B2 <- do.call(cbind, LL2) } if(rho$p > 0) { rho$B1 <- cbind(rho$B1, -X) rho$B2 <- cbind(rho$B2, -X) } dimnames(rho$B1) <- NULL dimnames(rho$B2) <- NULL return(rho) } # populates the rho environment setStart <- function(rho) ## Ok { ## set starting values in the rho environment ## try logistic/probit regression on 'middle' cut q1 <- max(1, rho$ntheta %/% 2) y1 <- (c(unclass(rho$y)) > q1) x <- cbind(Intercept = rep(1, rho$n), rho$X) fit <- switch(rho$link, "logistic"= glm.fit(x, y1, rho$weights, family = binomial(), offset = rho$Loffset), "probit" = glm.fit(x, y1, rho$weights, family = binomial("probit"), offset = rho$Loffset), ## this is deliberate, a better starting point "cloglog" = glm.fit(x, y1, rho$weights, family = binomial("probit"), offset = rho$Loffset), "loglog" = glm.fit(x, y1, rho$weights, family = binomial("probit"), offset = rho$Loffset), "cauchit" = glm.fit(x, y1, rho$weights, family = binomial("cauchit"), offset = rho$Loffset), "Aranda-Ordaz" = glm.fit(x, y1, rho$weights, family = binomial("probit"), offset = rho$Loffset), "log-gamma" = glm.fit(x, y1, rho$weights, family = binomial("probit"), offset = rho$Loffset)) if(!fit$converged) stop("attempt to find suitable starting values failed") coefs <- fit$coefficients if(any(is.na(coefs))) { warning("design appears to be rank-deficient, so dropping some coefs") keep <- !is.na(coefs) coefs <- coefs[keep] rho$X <- rho$X[, keep[-1], drop = FALSE] rho$dnX[[2]] <- rho$dnX[[2]][keep[-1]] rho$B1 <- rho$B1[, c(rep(TRUE, rho$nxi), keep[-1]), drop = FALSE] rho$B2 <- rho$B2[, c(rep(TRUE, rho$nxi), keep[-1]), drop = FALSE] rho$p <- ncol(rho$X) } ## Intercepts: spacing <- qlogis((1:rho$ntheta)/(rho$ntheta+1)) # just a guess if(rho$link != "logit") spacing <- spacing/1.7 ## if(rho$threshold == "flexible") # default alphas <- -coefs[1] + spacing - spacing[q1] if(rho$threshold == "symmetric" && rho$ntheta %% 2) ## ntheta odd alphas <- c(alphas[q1+1],cumsum(rep(spacing[q1+2], rho$nalpha-1))) if(rho$threshold == "symmetric" && !rho$ntheta %% 2) ## ntheta even alphas <- c(alphas[q1:(q1+1)], cumsum(rep(spacing[q1+1], rho$nalpha-2))) if(rho$threshold == "symmetric2" && rho$ntheta %% 2) ## ntheta odd alphas <- cumsum(rep(spacing[q1+2], rho$nalpha-1)) if(rho$threshold == "symmetric2" && !rho$ntheta %% 2) ## ntheta even alphas <- cumsum(rep(spacing[q1+1], rho$nalpha-2)) if(rho$threshold == "equidistant") alphas <- c(alphas[1], mean(diff(spacing))) ## initialize nominal effects to zero: if(rho$ncolXX > 1) { xi <- c(alphas, rep(rep(0, rho$nalpha), rho$ncolXX-1)) stopifnot(length(xi) == rho$nalpha * rho$ncolXX)} else xi <- alphas if(rho$estimLambda > 0){ rho$lambda <- 1 names(rho$lambda) <- "lambda" } start <- c(xi, coefs[-1], rep(0, rho$k), rep(1, rho$estimLambda)) names(start) <- NULL rho$start <- rho$par <- start } getPar <- function(rho) rho$par ## OK getNll <- function(rho, par) { ## ok if(!missing(par)) rho$par <- par with(rho, { if(estimLambda > 0) lambda <- par[nxi + p + k + 1:estimLambda] sigma <- if(k > 0) expSoffset * exp(drop(Z %*% par[nxi+p + 1:k])) else expSoffset eta1 <- (drop(B1 %*% par[1:(nxi + p)]) + o1)/sigma eta2 <- (drop(B2 %*% par[1:(nxi + p)]) + o2)/sigma pr <- if(nlambda) pfun(eta1, lambda) - pfun(eta2, lambda) else pfun(eta1) - pfun(eta2) if(all(is.finite(pr)) && all(pr > 0)) -sum(weights * log(pr)) else Inf }) } getGnll <- function(rho, par) { ## ok if(!missing(par)) rho$par <- par with(rho, { if(estimLambda > 0) lambda <- par[nxi + p + k + 1:estimLambda] sigma <- if(k > 0) expSoffset * exp(drop(Z %*% par[nxi+p + 1:k])) else expSoffset eta1 <- (drop(B1 %*% par[1:(nxi + p)]) + o1)/sigma eta2 <- (drop(B2 %*% par[1:(nxi + p)]) + o2)/sigma if(nlambda) { pr <- pfun(eta1, lambda) - pfun(eta2, lambda) p1 <- dfun(eta1, lambda) p2 <- dfun(eta2, lambda) } else { pr <- pfun(eta1) - pfun(eta2) p1 <- dfun(eta1) p2 <- dfun(eta2) } prSig <- pr * sigma ## eta1 * p1 is complicated because in theory eta1 contains ## Inf(-Inf) where p1 contains 0 and 0 * Inf = NaN... ## eta.p1 <- ifelse(p1 == 0, 0, eta1 * p1) ## eta.p2 <- ifelse(p2 == 0, 0, eta2 * p2) gradSigma <- ## if(k > 0) crossprod(Z, weights * (eta.p1 - eta.p2)/pr) if(k > 0) crossprod(Z, weights * (eta1 * p1 - eta2 * p2)/pr) else numeric(0) gradThetaBeta <- if(nxi > 0) -crossprod((B1*p1 - B2*p2), weights/prSig) else -crossprod((X * (p2 - p1)), weights/prSig) grad <- ## if (all(is.finite(pr)) && all(pr > 0)) ## c(gradThetaBeta, gradSigma) ## else rep(Inf, nxi + p + k) c(gradThetaBeta, gradSigma) }) if(rho$estimLambda > 0) c(rho$grad, grad.lambda(rho, rho$lambda, rho$link)) else rho$grad } getHnll <- function(rho, par) { ## ok if(!missing(par)) rho$par <- par with(rho, { eta1 <- drop(B1 %*% par[1:(nxi + p)]) + o1 eta2 <- drop(B2 %*% par[1:(nxi + p)]) + o2 pr <- pfun(eta1) - pfun(eta2) p1 <- dfun(eta1) p2 <- dfun(eta2) g1 <- gfun(eta1) g2 <- gfun(eta2) wtpr <- weights/pr dS.psi <- -crossprod(B1 * g1*wtpr, B1) + crossprod(B2 * g2*wtpr, B2) dpi.psi <- B1 * p1 - B2 * p2 ### dS.pi <- dpi.psi * wtpr/pr if (all(pr > 0)) dS.psi + crossprod(dpi.psi, (dpi.psi * wtpr/pr)) else array(NA, dim = c(nxi + p, nxi + p)) }) } .negLogLik <- function(rho) { ## negative log-likelihood ## OK with(rho, { eta1 <- drop(B1 %*% par[1:(nxi + p)]) + o1 eta2 <- drop(B2 %*% par[1:(nxi + p)]) + o2 pr <- pfun(eta1) - pfun(eta2) if (all(pr > 0)) -sum(weights * log(pr)) else Inf }) } .grad <- function(rho) { ## gradient of the negative log-likelihood ## OK with(rho, { p1 <- dfun(eta1) p2 <- dfun(eta2) wtpr <- weights/pr if (all(pr > 0)) -crossprod((B1 * p1 - B2 * p2), wtpr) else rep(NA, nalpha + p) }) } .hessian <- function(rho) { ## hessian of the negative log-likelihood ## OK with(rho, { dS.psi <- crossprod(B1 * gfun(eta1)*wtpr, B1) - crossprod(B2 * gfun(eta2)*wtpr, B2) dpi.psi <- B1 * p1 - B2 * p2 if (all(pr > 0)) -dS.psi + crossprod(dpi.psi, (dpi.psi * wtpr/pr)) else array(NA, dim = c(nxi+p, nxi+p)) }) } fitNR <- function(rho) ## OK { ctrl <- rho$ctrl stepFactor <- 1 innerIter <- 0 conv <- 1 ## Convergence flag message <- "iteration limit reached" rho$negLogLik <- .negLogLik(rho) if(rho$negLogLik == Inf) stop("Non-finite log-likelihood at starting value") rho$gradient <- .grad(rho) maxGrad <- max(abs(rho$gradient)) if(ctrl$trace > 0) Trace(iter=0, stepFactor, rho$negLogLik, maxGrad, rho$par, first=TRUE) ## Newton-Raphson algorithm: for(i in 1:ctrl$maxIter) { if(maxGrad < ctrl$gradTol) { message <- "max|gradient| < tol, so current iterate is probably solution" if(ctrl$trace > 0) cat("\nOptimizer converged! ", "max|grad|:", maxGrad, message, fill = TRUE) conv <- 0 break } rho$Hessian <- .hessian(rho) ## step <- .Call("La_dgesv", rho$Hessian, rho$gradient, .Machine$double.eps, ## PACKAGE = "base") ## solve H*step = g for 'step' step <- as.vector(solve(rho$Hessian, rho$gradient)) rho$par <- rho$par - stepFactor * step negLogLikTry <- .negLogLik(rho) lineIter <- 0 ## simple line search, i.e. step halfing: while(negLogLikTry > rho$negLogLik) { stepFactor <- stepFactor/2 rho$par <- rho$par + stepFactor * step negLogLikTry <- .negLogLik(rho) lineIter <- lineIter + 1 if(ctrl$trace > 0) Trace(i+innerIter, stepFactor, rho$negLogLik, maxGrad, rho$par, first=FALSE) if(lineIter > ctrl$maxLineIter){ message <- "step factor reduced below minimum" conv <- 2 break } innerIter <- innerIter + 1 } rho$negLogLik <- negLogLikTry rho$gradient <- .grad(rho) maxGrad <- max(abs(rho$gradient)) if(ctrl$trace > 0) Trace(iter=i+innerIter, stepFactor, rho$negLogLik, maxGrad, rho$par, first=FALSE) stepFactor <- min(1, 2 * stepFactor) } if(conv > 0) if(ctrl$trace > 0) cat(message, fill = TRUE) ## Save info rho$optRes$niter <- c(outer = i, inner = innerIter) rho$logLik <- -rho$negLogLik rho$maxGradient <- maxGrad rho$gradient <- as.vector(rho$gradient) rho$Hessian <- .hessian(rho) rho$optRes$message <- message rho$optRes$convergence <- conv } fitCLM <- function(rho) { ## OK if(rho$method == "Newton") { if(rho$k != 0) stop("Newton scheme not implemented for models with scale") if(rho$ncolXX > 1) stop("Newton scheme not implemented for models with nominal effects") if(rho$link %in% c("Aranda-Ordaz", "log-gamma")) stop("Newton scheme not implemented for models with", rho$link, "link function") fitNR(rho) return(invisible()) } optRes <- switch(rho$method, "nlminb" = nlminb(getPar(rho), function(par) getNll(rho, par), function(par) getGnll(rho, par), control=rho$ctrl, lower = rho$limitLow, upper = rho$limitUp), "ucminf" = ucminf(getPar(rho), function(par) getNll(rho, par), function(par) getGnll(rho, par), control=rho$ctrl), "optim" = optim(getPar(rho), function(par) getNll(rho, par), function(par) getGnll(rho, par), method="BFGS", control=rho$ctrl), ) rho$par <- optRes[[1]] rho$logLik <- - getNll(rho, optRes[[1]]) rho$optRes <- optRes rho$gradient <- c(getGnll(rho)) rho$maxGradient <- max(abs(rho$gradient)) if(rho$maxGradient > rho$convTol) warning("clm2 may not have converged:\n optimizer ", rho$method, " terminated with max|gradient|: ", rho$maxGradient, call.=FALSE) return(invisible()) } finalizeRho <- function(rho) { ## OK if(rho$method != "Newton") { rho$gradient <- c(getGnll(rho)) rho$maxGradient <- max(abs(rho$gradient)) rho$par <- rho$optRes[[1]] if(rho$Hess) { if(rho$k > 0 || rho$threshold != "flexible" || rho$ncolXX > 1 || rho$nlambda > 0) { if(rho$link == "Aranda-Ordaz" && rho$estimLambda > 0 && rho$lambda < 1e-3) message("Cannot get Hessian because lambda = ",rho$lambda ," is too close to boundary.\n", " Fit model with link == 'logistic' to get Hessian") else { rho$Hessian <- myhess(function(par) getNll(rho, par), rho$par) getNll(rho, rho$optRes[[1]]) # to reset the variables: # (par, pr) } } else rho$Hessian <- getHnll(rho, rho$optRes[[1]]) } } rho$convergence <- ifelse(rho$maxGradient > rho$convTol, FALSE, TRUE) with(rho, { if(nxi > 0) { xi <- par[seq_len(nxi)] names(xi) <- xiNames thetaNames <- paste(lev[-length(lev)], lev[-1], sep="|") Alpha <- Theta <- matrix(par[1:nxi], nrow=ncolXX, byrow=TRUE) Theta <- t(apply(Theta, 1, function(x) c(tJac %*% x))) if(ncolXX > 1){ dimnames(Theta) <- list(dnXX[[2]], thetaNames) dimnames(Alpha) <- list(dnXX[[2]], alphaNames) } else { Theta <- c(Theta) Alpha <- c(Alpha) names(Theta) <- thetaNames names(Alpha) <- alphaNames } coefficients <- xi } else coefficients <- numeric(0) if(p > 0) { beta <- par[nxi + 1:p] names(beta) <- dnX[[2]] coefficients <- c(coefficients, beta) } if(k > 0) { zeta <- par[nxi+p + 1:k] names(zeta) <- dnZ[[2]] coefficients <- c(coefficients, zeta) } if(estimLambda > 0) { names(lambda) <- "lambda" coefficients <- c(coefficients, lambda) } names(gradient) <- names(coefficients) edf <- p + nxi + k + estimLambda nobs <- sum(weights) fitted.values <- pr df.residual <- nobs - edf if(exists("Hessian", inherits=FALSE)) { dimnames(Hessian) <- list(names(coefficients), names(coefficients)) } }) res <- as.list(rho) keepNames <- c("df.residual", "fitted.values", "edf", "start", "beta", "coefficients", "zeta", "Alpha", "Theta", "xi", "lambda", "convergence", "Hessian", "convTol", "gradient", "optRes", "logLik", "call", "scale", "location", "nominal", "method", "y", "lev", "nobs", "threshold", "estimLambda", "link", "contrasts", "na.action") m <- match(keepNames, names(res), 0) res <- res[m] res } clm2 <- ## OK function(location, scale, nominal, data, weights, start, subset, na.action, contrasts, Hess = TRUE, model = TRUE, link = c("logistic", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), lambda, doFit = TRUE, control, threshold = c("flexible", "symmetric", "equidistant"), ...) { L <- match.call(expand.dots = FALSE) if(missing(location)) stop("Model needs a specification of the location") if(missing(lambda)) lambda <- NULL if(missing(contrasts)) contrasts <- NULL link <- match.arg(link) if(!(link %in% c("Aranda-Ordaz", "log-gamma")) & !is.null(lambda)){ warning("lambda ignored with link ", link) lambda <- NULL } if(!is.null(lambda) & length(lambda) > 1) { lambda <- lambda[1] warning("lambda is ", length(lambda), " long. Only the first element ", lambda[1], " is used") } if(!is.null(lambda) & link == "Aranda-Ordaz") if(lambda < 1e-6) stop("lambda has to be positive and lambda < 1e-6 not allowed for numerical reasons. lambda = ", lambda, " was supplied.") if (missing(control)) control <- clm2.control(...) if(!setequal(names(control), c("method", "convTol", "ctrl"))) stop("specify 'control' via clm2.control()") if (missing(data)) L$data <- environment(location) if (is.matrix(eval.parent(L$data))) L$data <- as.data.frame(L$data) ### Collect variables in location, scale and nominal formulae in a ### single formula, evaluate the model.frame and get index of row ### names for the rows to keep in the individual model.frames: m <- match(c("location", "scale", "nominal"), names(L), 0) F <- lapply(as.list(L[m]), eval.parent) ## evaluate in parent ## frame to allow 'f <- formula(sureness ~ prod); clm2(f, ...)' varNames <- unique(unlist(lapply(F, all.vars))) longFormula <- eval(parse(text = paste("~", paste(varNames, collapse = "+")))[1]) m <- match(c("location", "data", "subset", "weights", "na.action"), names(L), 0) L0 <- L[c(1, m)] if(!missing(scale) || !missing(nominal)) L0$location <- longFormula L0$drop.unused.levels <- TRUE L0[[1]] <- as.name("model.frame") names(L0)[names(L0) == "location"] <- "formula" L0 <- eval.parent(L0) m <- match(c("location", "scale", "nominal", "data", "subset", "weights", "na.action"), names(L), 0) L <- L[c(1, m)] L$drop.unused.levels <- TRUE L[[1]] <- as.name("model.frame") S <- L ## L: Location, S: Scale L$scale <- L$nominal <- NULL names(L)[names(L) == "location"] <- "formula" L <- eval.parent(L) keep <- match(rownames(L0), rownames(L)) L <- L[keep, , drop = FALSE] TermsL <- attr(L, "terms") ### format response: y <- model.response(L) if(!is.factor(y)) stop("response needs to be a factor") ### format thresholds: threshold <- match.arg(threshold) ### format location: X <- model.matrix(TermsL, L, contrasts) Xint <- match("(Intercept)", colnames(X), nomatch = 0) if (Xint > 0) X <- X[, -Xint, drop = FALSE] else warning("an intercept is needed and assumed in the location") n <- nrow(X) if(is.null(wt <- model.weights(L))) wt <- rep(1, n) if(is.null(Loffset <- model.offset(L))) Loffset <- rep(0, n) ### Format nominal: if(!missing(nominal)) { Nom <- S Nom$location <- Nom$scale <- NULL names(Nom)[names(Nom) == "nominal"] <- "formula" Nom <- eval.parent(Nom) Nom <- Nom[match(rownames(L0), rownames(Nom)), ,drop=FALSE] TermsNom <- attr(Nom, "terms") XX <- model.matrix(TermsNom, Nom)## , contrasts) ### Not allowing other than treatment contrasts in nominal if(is.null(Noffset <- model.offset(Nom))) Noffset <- rep(0, n) Nint <- match("(Intercept)", colnames(XX), nomatch = 0) if(Nint != 1) stop("An intercept is needed in the nominal formula") ### Are there any requirements about the presence of an ### intercept in the nominal formula? } else XX <- array(1, dim=c(n, 1)) ### format scale: if(!missing(scale)) { S$location <- S$nominal <- NULL names(S)[names(S) == "scale"] <- "formula" S <- eval.parent(S) S <- S[match(rownames(L0), rownames(S)), ,drop=FALSE] TermsS <- attr(S, "terms") ### Should contrasts be allowed for the scale? Z <- model.matrix(TermsS, S, contrasts) Zint <- match("(Intercept)", colnames(Z), nomatch = 0) if(Zint > 0) Z <- Z[, -Zint, drop = FALSE] else warning("an intercept is needed and assumed in the scale") if(is.null(Soffset <- model.offset(S))) Soffset <- rep(0, n) if(ncol(Z) > 0 && n != nrow(Z)) # This shouldn't happen stop("Model needs same dataset in location and scale") } else if(missing(scale) && !is.factor(y)){ Z <- array(1, dim = c(n, 1)) Soffset <- rep(0, n) } else { Z <- array(dim = c(n, 0)) Soffset <- rep(0, n) } ### return model.frame? if(control$method == "model.frame") { mf <- list(location = L) if(!missing(scale)) mf$scale <- S if(!missing(nominal)) mf$nominal <- Nom return(mf) } ### initialize and populate rho environment: rho <- newRho(parent.frame(), XX = XX, X=X, Z=Z, y=y, weights=wt, Loffset=Loffset, Soffset=Soffset, link=link, lambda = lambda, threshold=threshold, Hess = Hess, control = control) ### get starting values: if(missing(start)) setStart(rho) else rho$start <- rho$par <- start if(rho$estimLambda > 0 & rho$link == "Aranda-Ordaz") rho$limitLow <- c(rep(-Inf, length(rho$par)-1), 1e-5) if(length(rho$start) != with(rho, nxi + p + k + estimLambda)) stop("'start' is not of the correct length") ### OPTION: Could consider better check of increasing thresholds when ### ncol(XX) > 0 if(ncol(XX) == 0) { if(!all(diff(c(rho$tJac %*% rho$start[1:rho$nalpha])) > 0)) stop("Threshold starting values are not of increasing size") } if(!getNll(rho) < Inf) stop("Non-finite log-likelihood at starting values") if(model) { rho$location <- L if(!missing(scale)) rho$scale <- S if(!missing(nominal)) rho$nominal <- Nom } ### fit the model: if(!doFit) return(rho) fitCLM(rho) res <- finalizeRho(rho) ### add to output: res$call <- match.call() res$na.action <- attr(L0, "na.action") res$contrasts <- contrasts class(res) <- "clm2" res } print.clm2 <- function(x, ...) { if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control=NULL) } if(length(x$beta)) { cat("\nLocation coefficients:\n") print(x$beta, ...) } else { cat("\nNo location coefficients\n") } if(length(x$zeta)) { cat("\nScale coefficients:\n") print(x$zeta, ...) } else { cat("\nNo Scale coefficients\n") } if(x$estimLambda > 0) { cat("\nLink coefficient:\n") print(x$lambda) } if(length(x$xi) > 0) { cat("\nThreshold coefficients:\n") print(x$Alpha, ...) if(x$threshold != "flexible") { cat("\nThresholds:\n") print(x$Theta, ...) } } cat("\nlog-likelihood:", format(x$logLik, nsmall=2), "\n") cat("AIC:", format(-2*x$logLik + 2*x$edf, nsmall=2), "\n") if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") invisible(x) } vcov.clm2 <- function(object, ...) { if(is.null(object$Hessian)) { message("\nRe-fitting to get Hessian\n") utils::flush.console() object <- update(object, Hess=TRUE, start=object$coefficients) } dn <- names(object$coefficients) H <- object$Hessian ## To handle NaNs in the Hessian resulting from parameter ## unidentifiability: if(any(His.na <- !is.finite(H))) { H[His.na] <- 0 VCOV <- ginv(H) VCOV[His.na] <- NaN } else VCOV <- ginv(H) structure(VCOV, dimnames = list(dn, dn)) } summary.clm2 <- function(object, digits = max(3, .Options$digits - 3), correlation = FALSE, ...) { if(is.null(object$Hessian)) stop("Model needs to be fitted with Hess = TRUE") coef <- matrix(0, object$edf, 4, dimnames = list(names(object$coefficients), c("Estimate", "Std. Error", "z value", "Pr(>|z|)"))) coef[, 1] <- object$coefficients vc <- try(vcov(object), silent = TRUE) if(inherits(vc, "try-error")) { warning("Variance-covariance matrix of the parameters is not defined") coef[, 2:4] <- NaN if(correlation) warning("Correlation matrix is unavailable") object$condHess <- NaN } else { coef[, 2] <- sd <- sqrt(diag(vc)) ## Cond is Inf if Hessian contains NaNs: object$condHess <- if(any(is.na(object$Hessian))) Inf else with(eigen(object$Hessian, only.values = TRUE), abs(max(values) / min(values))) coef[, 3] <- coef[, 1]/coef[, 2] coef[, 4] <- 2*pnorm(abs(coef[, 3]), lower.tail=FALSE) if(correlation) object$correlation <- (vc/sd)/rep(sd, rep(object$edf, object$edf)) } object$coefficients <- coef object$digits <- digits class(object) <- "summary.clm2" object } print.summary.clm2 <- function(x, digits = x$digits, signif.stars = getOption("show.signif.stars"), ...) { if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control=NULL) } coef <- format(round(x$coefficients, digits=digits)) coef[,4] <- format.pval(x$coefficients[, 4]) p <- length(x$beta); nxi <- length(x$xi) k <- length(x$zeta); u <- x$estimLambda if(p > 0) { cat("\nLocation coefficients:\n") print(coef[nxi + 1:p, , drop=FALSE], quote = FALSE, ...) } else { cat("\nNo location coefficients\n") } if(k > 0) { cat("\nScale coefficients:\n") print(coef[(nxi+p+1):(nxi+p+k), , drop=FALSE], quote = FALSE, ...) } else { cat("\nNo scale coefficients\n") } if(x$estimLambda > 0) { cat("\nLink coefficients:\n") print(coef[(nxi+p+k+1):(nxi+p+k+u), , drop=FALSE], quote = FALSE, ...) } if(nxi > 0) { cat("\nThreshold coefficients:\n") print(coef[seq_len(nxi), -4, drop=FALSE], quote = FALSE, ...) } cat("\nlog-likelihood:", format(x$logLik, nsmall=2), "\n") cat("AIC:", format(-2*x$logLik + 2*x$edf, nsmall=2), "\n") cat("Condition number of Hessian:", format(x$condHess, nsmall=2), "\n") if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") if(!is.null(correl <- x$correlation)) { cat("\nCorrelation of Coefficients:\n") ll <- lower.tri(correl) correl[ll] <- format(round(correl[ll], digits)) correl[!ll] <- "" print(correl[-1, -ncol(correl)], quote = FALSE, ...) } invisible(x) } anova.clm2 <- function (object, ..., test = c("Chisq", "none")) { test <- match.arg(test) dots <- list(...) if (length(dots) == 0) stop('anova is not implemented for a single "clm2" object') mlist <- list(object, ...) nt <- length(mlist) dflis <- sapply(mlist, function(x) x$df.residual) s <- order(dflis, decreasing = TRUE) mlist <- mlist[s] if (any(!sapply(mlist, inherits, "clm2"))) stop('not all objects are of class "clm2"') ns <- sapply(mlist, function(x) length(x$fitted.values)) if(any(ns != ns[1])) stop("models were not all fitted to the same size of dataset") rsp <- unique(sapply(mlist, function(x) { tmp <- attr(x$location, "terms") class(tmp) <- "formula" paste(tmp[2]) } )) mds <- sapply(mlist, function(x) { tmp1 <- attr(x$location, "terms") class(tmp1) <- "formula" if(!is.null(x$scale)) { tmp2 <- attr(x$scale, "terms") class(tmp2) <- "formula" tmp2 <- tmp2[2] } else tmp2 <- "" if(!is.null(x$nominal)) { tmp3 <- attr(x$nominal, "terms") class(tmp3) <- "formula" tmp3 <- tmp3[2] } else tmp3 <- "" paste(tmp1[3], "|", tmp2, "|", tmp3) } ) dfs <- dflis[s] lls <- sapply(mlist, function(x) -2*x$logLik) tss <- c("", paste(1:(nt - 1), 2:nt, sep = " vs ")) df <- c(NA, -diff(dfs)) x2 <- c(NA, -diff(lls)) pr <- c(NA, 1 - pchisq(x2[-1], df[-1])) out <- data.frame(Model = mds, Resid.df = dfs, '-2logLik' = lls, Test = tss, Df = df, LRtest = x2, Prob = pr) names(out) <- c("Model", "Resid. df", "-2logLik", "Test", " Df", "LR stat.", "Pr(Chi)") if (test == "none") out <- out[, 1:6] class(out) <- c("Anova", "data.frame") attr(out, "heading") <- c("Likelihood ratio tests of cumulative link models\n", paste("Response:", rsp)) out } predict.clm2 <- function(object, newdata, ...) { if(!inherits(object, "clm2")) stop("not a \"clm2\" object") if(missing(newdata)) pr <- object$fitted else { newdata <- as.data.frame(newdata) Terms <- attr(object$location, "terms") m <- model.frame(Terms, newdata, na.action = function(x) x)#, if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) X <- model.matrix(Terms, m, contrasts = object$contrasts) xint <- match("(Intercept)", colnames(X), nomatch=0) if(xint > 0) X <- X[, -xint, drop=FALSE] n <- nrow(X) y <- m[,names(cl)[attr(Terms, "response")]] if(length(object$zeta) > 0) { Terms <- attr(object$scale, "terms") m <- model.frame(Terms, newdata, na.action = function(x) x)#, if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) Z <- model.matrix(Terms, m, contrasts = object$contrasts) zint <- match("(Intercept)", colnames(Z), nomatch=0) if(zint > 0) Z <- Z[, -zint, drop=FALSE] } if(!is.null(object$nominal)) { Terms <- attr(object$nominal, "terms") m <- model.frame(Terms, newdata, na.action = function(x) x)#, if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) XX <- model.matrix(Terms, m, contrasts = object$contrasts) namC <- colnames(XX) } B2 <- 1 * (col(matrix(0, n, nlevels(y))) == unclass(y)) o1 <- c(100 * B2[, nlevels(y)]) o2 <- c(-100 * B2[,1]) B1 <- B2[,-nlevels(y), drop=FALSE] B2 <- B2[,-1, drop=FALSE] locationPar <- c(t(object$Theta)) if(!is.null(object$nominal)) { ncolXX <- ncol(XX) LL1 <- lapply(1:ncolXX, function(x) B1 * XX[,x]) B1 <- do.call(cbind, LL1) LL2 <- lapply(1:ncolXX, function(x) B2 * XX[,x]) B2 <- do.call(cbind, LL2) } if(ncol(X) > 0) { B1 <- cbind(B1, -X) B2 <- cbind(B2, -X) locationPar <- c(locationPar, object$beta) } pfun <- switch(object$link, logistic = plogis, probit = pnorm, cloglog = function(x) pgumbel(x, max=FALSE), ## cloglog = pgumbel, cauchit = pcauchy, loglog = pgumbel, "Aranda-Ordaz" = function(x, lambda) pAO(x, lambda), "log-gamma" = function(x, lambda) plgamma(x, lambda)) sigma <- 1 if(length(object$zeta) > 0) sigma <- sigma * exp(drop(Z %*% object$zeta)) eta1 <- (drop(B1 %*% locationPar) + o1) / sigma eta2 <- (drop(B2 %*% locationPar) + o2) / sigma if(object$link %in% c("Aranda-Ordaz", "log-gamma")) pr <- pfun(eta1, object$lambda) - pfun(eta2, object$lambda) else pr <- pfun(eta1) - pfun(eta2) } if(missing(newdata) && !is.null(object$na.action)) pr <- napredict(object$na.action, pr) as.vector(pr) } profile.clm2 <- function(fitted, whichL = seq_len(p), whichS = seq_len(k), lambda = TRUE, alpha = 0.01, maxSteps = 50, delta = LrootMax/10, trace = 0, stepWarn = 8, ...) { rho <- update(fitted, doFit=FALSE) if(rho$estimLambda > 0 & rho$link == "Aranda-Ordaz") rho$limitLow <- c(rep(-Inf, length(rho$par)-2), 1e-5) nxi <- rho$nxi; k <- rho$k; p <- rho$p; X <- rho$X; Z <- rho$Z B1 <- rho$B1; B2 <- rho$B2 sO <- rho$expSoffset; O1 <- rho$o1; O2 <- rho$o2 beta0 <- with(fitted, coefficients[nxi + seq_len(p+k)]) Lnames <- names(beta0[seq_len(p)]) Snames <- names(beta0[p + seq_len(k)]) Pnames <- c(Lnames, Snames) if(is.character(whichL)) whichL <- match(whichL, Lnames) if(is.character(whichS)) whichS <- match(whichS, Snames) nL <- length(whichL); nS <- length(whichS) summ <- summary(fitted) std.err <- summ$coefficients[nxi + seq_len(p+k), "Std. Error"] if(trace < 0) rho$ctrl$trace <- trace <- 1 origLogLik <- fitted$logLik LrootMax <- qnorm(1 - alpha/2) prof <- vector("list", length = nL + nS) names(prof) <- c(paste("loc", Lnames[whichL], sep=".")[seq_len(nL)], paste("scale", Snames[whichS], sep=".")[seq_len(nS)]) for(where in c("loc", "scale")[c(nL>0, nS>0)]) { if(where == "loc") { rho$p <- max(0, p - 1) which <- whichL } if(where == "scale") { which <- whichS rho$o1 <- O1 rho$o2 <- O2 rho$p <- p rho$k <- max(0, k - 1) rho$X <- X if(rho$nxi > 0) { rho$B1 <- B1 rho$B2 <- B2 } } for(i in which) { if(where == "loc") { rho$X <- X[, -i, drop=FALSE] if(nxi > 0) { rho$B1 <- B1[, -(nxi+i), drop=FALSE] rho$B2 <- B2[, -(nxi+i), drop=FALSE] } } else { rho$Z <- Z[, -i, drop=FALSE] i <- i + p } res.i <- c(0, beta0[i]) for(sgn in c(-1, 1)) { if(trace) { message("\nParameter: ", where, ".", c(Lnames, Snames)[i], c(" down", " up")[(sgn + 1)/2 + 1]) utils::flush.console() } rho$par <- fitted$coefficients[-(nxi+i)] step <- 0; Lroot <- 0 while((step <- step + 1) < maxSteps && abs(Lroot) < LrootMax) { beta.i <- beta0[i] + sgn * step * delta * std.err[i] if(where=="loc") { rho$o1 <- O1 - X[, i] * beta.i rho$o2 <- O2 - X[, i] * beta.i } else rho$expSoffset <- exp(sO + Z[, (i - p)] * beta.i) fitCLM(rho) Lroot <- sgn * sqrt(2*(-rho$logLik + origLogLik)) res.i <- rbind(res.i, c(Lroot, beta.i)) } if(step - 1 < stepWarn) warning("profile may be unreliable for ", where, ".", c(Lnames, Snames)[i], " because only ", step - 1, "\n steps were taken ", c("downwards", "upwards")[(sgn + 1)/2 + 1]) } rownames(res.i) <- NULL prof[[paste(where, c(Lnames, Snames)[i], sep=".")]] <- # -p+nL structure(data.frame(res.i[order(res.i[,1]),]), names = c("Lroot", c(Lnames, Snames)[i])) if(!all(diff(prof[[length(prof)]][,2]) > 0)) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for ", names(prof)[length(prof)]) } } if(lambda & rho$nlambda) prof$lambda <- profileLambda(fitted, trace = trace, ...) val <- structure(prof, original.fit = fitted, summary = summ) class(val) <- c("profile.clm2", "profile") val } profileLambda <- function(fitted, link = fitted$link, range, nSteps = 20, trace = 0, ...) { if(link == "log-gamma" & missing(range)) range <- c(-4, 4) if(link == "Aranda-Ordaz" & missing(range)) range <- c(1e-4, 4) if(!link %in% c("log-gamma", "Aranda-Ordaz")) stop("link needs to be 'log-gamma' or 'Aranda-Ordaz';", link, "not recognized") if(link == "Aranda-Ordaz" & min(range) <= 0) stop("range should be > 0 for the 'Aranda-Ordaz' link") if(fitted$estimLambda == 0) fitted <- update(fitted, Hess = FALSE, link = link, lambda = NULL) MLogLik <- fitted$logLik MLlambda <- fitted$lambda logLik <- numeric(nSteps) rho <- update(fitted, Hess = FALSE, link = link, lambda = min(range)) logLik[1] <- rho$logLik rho <- update(rho, doFit = FALSE) lambdaSeq <- seq(min(range), max(range), length.out = nSteps) if(trace) message("\nNow profiling lambda with ", nSteps - 1, " steps: i =") for(i in 2:nSteps){ if(trace) cat(i-1, " ") rho$lambda <- lambdaSeq[i] fitCLM(rho) logLik[i] <- rho$logLik } if(trace) cat("\n\n") if(any(logLik > fitted$logLik)) warning("Profiling found a better optimum,", " so original fit had not converged") sgn <- 2*(lambdaSeq > MLlambda) -1 Lroot <- sgn * sqrt(2) * sqrt(-logLik + MLogLik) res <- data.frame("Lroot" = c(0, Lroot), "lambda" = c(MLlambda, lambdaSeq)) res <- res[order(res[,1]),] if(!all(diff(res[,2]) > 0)) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for lambda") res } confint.clm2 <- function(object, parm, level = 0.95, whichL = seq_len(p), whichS = seq_len(k), lambda = TRUE, trace = 0, ...) { p <- length(object$beta); k <- length(object$zeta) if(trace) { message("Waiting for profiling to be done...") utils::flush.console() } object <- profile(object, whichL = whichL, whichS = whichS, alpha = (1. - level)/4., lambda = lambda, trace = trace) confint(object, level=level, ...) } confint.profile.clm2 <- function(object, parm = seq_along(Pnames), level = 0.95, ...) { of <- attr(object, "original.fit") Pnames <- names(object) if(is.character(parm)) parm <- match(parm, Pnames, nomatch = 0) a <- (1-level)/2 a <- c(a, 1-a) pct <- paste(round(100*a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(Pnames[parm], pct)) cutoff <- qnorm(a) for(pm in parm) { pro <- object[[ Pnames[pm] ]] sp <- spline(x = pro[, 2], y = pro[, 1]) ci[Pnames[pm], ] <- approx(sp$y, sp$x, xout = cutoff)$y } ci } plot.profile.clm2 <- function(x, parm = seq_along(Pnames), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, fig = TRUE, n = 1e3, ..., ylim = NULL) ### Should this function have a 'root' argument to display the ### likelihood root statistic (approximate straight line)? { Pnames <- names(x) ML <- attr(x, "original.fit")$logLik for(pm in parm) { lim <- sapply(level, function(x) exp(-qchisq(x, df=1)/2) ) pro <- x[[ Pnames[pm] ]] sp <- spline(x = pro[, 2], y = pro[, 1], n=n) sp$y <- -sp$y^2/2 if(relative & !Log) { sp$y <- exp(sp$y) ylab <- "Relative likelihood" dots <- list(...) if(missing(ylim)) ylim <- c(0, 1) } if(relative & Log) { ylab <- "Relative log-likelihood" lim <- log(lim) } if(!relative & Log) { sp$y <- sp$y + ML ylab <- "Log-likelihood" lim <- ML + log(lim) } if(!relative & !Log) { stop("Not supported: at least one of 'Log' and 'relative' ", "have to be TRUE") sp$y <- exp(sp$y + ML) ylab <- "Likelihood" lim <- exp(ML + log(lim)) } x[[ Pnames[pm] ]] <- sp if(fig) { plot(sp$x, sp$y, type = "l", ylim = ylim, xlab = Pnames[pm], ylab = ylab, ...) abline(h = lim) } } attr(x, "limits") <- lim invisible(x) } logLik.clm2 <- function(object, ...) structure(object$logLik, df = object$edf, class = "logLik") extractAIC.clm2 <- function(fit, scale = 0, k = 2, ...) { edf <- fit$edf c(edf, -2*fit$logLik + k * edf) } update.clm2 <- function(object, formula., location, scale, nominal, ..., evaluate = TRUE) ### This method makes it possible to use the update.formula features ### for location and scale formulas in clm2 objects. This includes the ### possibility of using e.g. ### update(obj, loc = ~ . - var1, sca = ~ . + var2) { call <- object$call if (is.null(call)) stop("need an object with call component") extras <- match.call(expand.dots = FALSE)$... if (!missing(location)) call$location <- update.formula(formula(attr(object$location, "terms")), location) if (!missing(scale)) call$scale <- if(!is.null(object$scale)) update.formula(formula(attr(object$scale, "terms")), scale) else scale if (!missing(nominal)) call$nominal <- if(!is.null(object$nominal)) update.formula(formula(attr(object$nominal, "terms")), nominal) else nominal if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call } dropterm.clm2 <- function(object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, which = c("location", "scale"), ...) ### Most of this is lifted from MASS::dropterm.default, but adapted to ### the two formulas (location and scale) in the model. { which <- match.arg(which) Terms <- if(which == "location") attr(object$location, "terms") else attr(object$scale, "terms") tl <- attr(Terms, "term.labels") if(missing(scope)) scope <- drop.scope(Terms) else { if(!is.character(scope)) scope <- attr(terms(update.formula(Terms, scope)), "term.labels") if(!all(match(scope, tl, FALSE))) stop("scope is not a subset of term labels") } ns <- length(scope) ans <- matrix(nrow = ns + 1, ncol = 2, dimnames = list(c("", scope), c("df", "AIC"))) ans[1, ] <- extractAIC(object, scale, k = k, ...) n0 <- length(object$fitted) for(i in seq(ns)) { tt <- scope[i] if(trace) { message("trying -", tt) utils::flush.console() } Call <- as.list(object$call) Call[[which]] <- update.formula(Terms, as.formula(paste("~ . -", tt))) nfit <- eval.parent(as.call(Call)) ans[i+1, ] <- extractAIC(nfit, scale, k = k, ...) if(length(nfit$fitted) != n0) stop("number of rows in use has changed: remove missing values?") } dfs <- ans[1,1] - ans[,1] dfs[1] <- NA aod <- data.frame(Df = dfs, AIC = ans[,2]) o <- if(sorted) order(aod$AIC) else seq_along(aod$AIC) test <- match.arg(test) if(test == "Chisq") { dev <- ans[, 2] - k*ans[, 1] dev <- dev - dev[1] ; dev[1] <- NA nas <- !is.na(dev) P <- dev P[nas] <- pchisq(dev[nas], dfs[nas], lower.tail = FALSE) aod[, c("LRT", "Pr(Chi)")] <- list(dev, P) } aod <- aod[o, ] Call <- as.list(object$call) Call <- Call[names(Call) %in% c("location", "scale")] head <- c("Single term deletions", "\nModel:", paste(names(Call), ":", Call)) if(scale > 0) head <- c(head, paste("\nscale: ", format(scale), "\n")) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } addterm.clm2 <- function(object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, which = c("location", "scale"), ...) ### Most of this is lifted from MASS::addterm.default, but adapted to ### the two formulas (location and scale) in the model. { which <- match.arg(which) if (which == "location") Terms <- attr(object$location, "terms") else if(!is.null(object$scale)) Terms <- attr(object$scale, "terms") else Terms <- as.formula(" ~ 1") if(missing(scope) || is.null(scope)) stop("no terms in scope") if(!is.character(scope)) scope <- add.scope(Terms, update.formula(Terms, scope)) if(!length(scope)) stop("no terms in scope for adding to object") ns <- length(scope) ans <- matrix(nrow = ns + 1, ncol = 2, dimnames = list(c("", scope), c("df", "AIC"))) ans[1, ] <- extractAIC(object, scale, k = k, ...) n0 <- length(object$fitted) for(i in seq(ns)) { tt <- scope[i] if(trace) { message("trying +", tt) utils::flush.console() } Call <- as.list(object$call) Call[[which]] <- update.formula(Terms, as.formula(paste("~ . +", tt))) nfit <- eval.parent(as.call(Call)) ans[i+1, ] <- extractAIC(nfit, scale, k = k, ...) if(length(nfit$fitted) != n0) stop("number of rows in use has changed: remove missing values?") } dfs <- ans[,1] - ans[1,1] dfs[1] <- NA aod <- data.frame(Df = dfs, AIC = ans[,2]) o <- if(sorted) order(aod$AIC) else seq_along(aod$AIC) test <- match.arg(test) if(test == "Chisq") { dev <- ans[,2] - k*ans[, 1] dev <- dev[1] - dev; dev[1] <- NA nas <- !is.na(dev) P <- dev P[nas] <- pchisq(dev[nas], dfs[nas], lower.tail=FALSE) aod[, c("LRT", "Pr(Chi)")] <- list(dev, P) } aod <- aod[o, ] Call <- as.list(object$call) Call <- Call[names(Call) %in% c("location", "scale")] head <- c("Single term additions", "\nModel:", paste(names(Call), ":", Call)) if(scale > 0) head <- c(head, paste("\nscale: ", format(scale), "\n")) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } ## addterm <- function(object, ...) UseMethod("addterm") ## dropterm <- function(object, ...) UseMethod("dropterm") ################################################################## ## Additional utility functions: grad.lambda <- function(rho, lambda, link, delta = 1e-6) { ll <- lambda + c(-delta, delta) if(link == "Aranda-Ordaz") ll[ll < 0] <- 0 par <- rho$par f <- sapply(ll, function(x) getNll(rho, c(par[-length(par)], x))) rho$lambda <- lambda rho$par <- par diff(f) / diff(ll) } TraceR <- function(iter, stepFactor, val, maxGrad, par, first=FALSE) { t1 <- sprintf(" %3d: %.2e: %.3f: %1.3e: ", iter, stepFactor, val, maxGrad) t2 <- formatC(par) if(first) cat("iter: step factor: Value: max|grad|: Parameters:\n") cat(t1, t2, "\n") } print.Anova <- function (x, ...) ## Lifted from package MASS: { heading <- attr(x, "heading") if (!is.null(heading)) cat(heading, sep = "\n") attr(x, "heading") <- NULL res <- format.data.frame(x, ...) nas <- is.na(x) res[] <- sapply(seq_len(ncol(res)), function(i) { x <- as.character(res[[i]]) x[nas[, i]] <- "" x }) print.data.frame(res) invisible(x) } fixed <- function(theta, eps = 1e-3) { res <- vector("list") res$name <- "fixed" if(!missing(theta) && length(theta) > 1) { if(length(theta) < 3) stop("'length(theta) = ", length(theta), ", but has to be 1 or >= 3") res$eps <- NULL res$theta <- theta res$getTheta <- function(y, theta, eps) theta } else if(!missing(theta) && length(theta) == 1) { if(as.integer(theta) < 3) stop("'as.integer(theta)' was ", as.integer(theta), ", but has to be > 2") res$eps <- NULL res$theta <- theta res$getTheta <- function(y, theta, eps) { eps <- diff(range(y)) / (theta - 1) seq(min(y) - eps/2, max(y) + eps/2, len = theta + 1) } } else if(missing(theta) && length(eps) == 1) { res$eps <- eps res$theta <- NULL res$getTheta <- function(y, theta, eps) { J <- diff(range(y))/eps + 1 seq(min(y) - eps/2, max(y) + eps/2, len = J) } } else stop("inappropriate arguments") class(res) <- "threshold" res } makeThresholds2 <- function(rho, threshold, ...) { if(threshold == "flexible") { rho$tJac <- diag(rho$ntheta) rho$nalpha <- rho$ntheta rho$alphaNames <- paste(rho$lev[-length(rho$lev)], rho$lev[-1], sep="|") } if(threshold == "symmetric") { if(!rho$ntheta >=2) stop("symmetric thresholds are only meaningful for responses with 3 or more levels") if(rho$ntheta %% 2) { ## ntheta is odd rho$nalpha <- (rho$ntheta + 1)/2 ## No. threshold parameters rho$tJac <- t(cbind(diag(-1, rho$nalpha)[rho$nalpha:1, 1:(rho$nalpha-1)], diag(rho$nalpha))) rho$tJac[,1] <- 1 rho$alphaNames <- c("central", paste("spacing.", 1:(rho$nalpha-1), sep="")) } else { ## ntheta is even rho$nalpha <- (rho$ntheta + 2)/2 rho$tJac <- cbind(rep(1:0, each=rho$ntheta/2), rbind(diag(-1, rho$ntheta/2)[(rho$ntheta/2):1,], diag(rho$ntheta/2))) rho$tJac[,2] <- rep(0:1, each=rho$ntheta/2) rho$alphaNames <- c("central.1", "central.2", paste("spacing.", 1:(rho$nalpha-2), sep="")) } } if(threshold == "equidistant") { if(!rho$ntheta >=2) stop("symmetric thresholds are only meaningful for responses with 3 or more levels") rho$tJac <- cbind(1, 0:(rho$ntheta-1)) rho$nalpha <- 2 rho$alphaNames <- c("threshold.1", "spacing") } } ordinal/R/clm.fit.R0000644000176200001440000001607615127777530013612 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## The function clm.fit() - an lm.fit or glm.fit equivalent for CLMs. clm.fit <- function(y, ...) { UseMethod("clm.fit") } clm.fit.factor <- function(y, X, S, N, weights = rep(1, nrow(X)), offset = rep(0, nrow(X)), S.offset = rep(0, nrow(X)), control = list(), start, doFit=TRUE, link = c("logit", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) ### This function basically does the same as clm, but without setting ### up the model matrices from formulae, and with minimal post ### processing after parameter estimation. { ## Initial argument matching and testing: threshold <- match.arg(threshold) link <- match.arg(link) control <- do.call(clm.control, control) if(missing(y)) stop("please specify y") if(missing(X)) X <- cbind("(Intercept)" = rep(1, length(y))) stopifnot(is.factor(y), is.matrix(X)) if(missing(weights) || is.null(weights)) weights <- rep(1, length(y)) if(missing(offset) || is.null(offset)) offset <- rep(0, length(y)) if(missing(S.offset) || is.null(S.offset)) S.offset <- rep(0, length(y)) stopifnot(length(y) == nrow(X) && length(y) == length(weights) && length(y) == length(offset) && length(y) == length(S.offset)) frames <- list(y=y, X=X) y[weights <= 0] <- NA y.levels <- levels(droplevels(y)) struct <- namedList(y, X, weights, offset, S.offset, y.levels, threshold, link, control, doFit) ## S and N are optional: if(!missing(S) && !is.null(S)) { struct$S <- S stopifnot(is.matrix(S), length(y) == nrow(S)) } if(!missing(N) && !is.null(N)) { struct$NOM <- N stopifnot(is.matrix(N), length(y) == nrow(N)) } clm.fit.default(struct) } clm.fit.default <- function(y, ...) ### y: design object with the following components: ... ### (tJac=NULL), (y.levels=NULL), threshold, (aliased=NULL), ### (start=NULL), link, control, weights, (coef.names=NULL), y, X, ### (S=NULL), (NOM=NULL), doFit=TRUE, S.offset=NULL { ## check args: stopifnot(is.list(y)) y <- c(y, list(...)) stopifnot(all( c("y", "X", "offset", "weights", "link", "threshold", "control", "doFit") %in% names(y) )) ## preprocess design objects if needed: if(is.null(y$y.levels)) y$y.levels <- levels(y$y) if(is.null(y$tJac)) { y <- c(y, makeThresholds(y$y.levels, y$threshold)) } if(is.null(y$aliased)) y <- drop.cols(y, silent=TRUE, drop.scale=FALSE) ## Make model environment: rho <- do.call(clm.newRho, y) setLinks(rho, y$link) start <- set.start(rho, start=y$start, get.start=is.null(y$start), threshold=y$threshold, link=y$link, frames=y) rho$par <- as.vector(start) ## remove attributes if(y$doFit == FALSE) return(rho) if(length(rho$lambda) > 0 && y$control$method != "nlminb") { message("Changing to 'nlminb' optimizer for flexible link function") y$control$method <- "nlminb" } ## Fit the model: fit <- if(length(rho$lambda) > 0) { clm_fit_flex(rho, control=y$control$ctrl) } else if(y$control$method == "Newton") { clm_fit_NR(rho, y$control) } else { clm_fit_optim(rho, y$control$method, y$control$ctrl) } ## Adjust iteration count: if(y$control$method == "Newton" && !is.null(start.iter <- attr(start, "start.iter"))) fit$niter <- fit$niter + start.iter ## Update coefficients, gradient, Hessian, edf, nobs, n, ## fitted.values, df.residual: fit <- clm.finalize(fit, y$weights, y$coef.names, y$aliased) fit$tJac <- format_tJac(y$tJac, y$y.levels, y$alpha.names) th.res <- formatTheta(fit$alpha, fit$tJac, y, y$control$sign.nominal) ## Check convergence: conv <- conv.check(fit, control=y$control, Theta.ok=th.res$Theta.ok, tol=y$control$tol) print.conv.check(conv, action=y$control$convergence) ## print convergence message th.res$Theta.ok <- NULL fit <- c(fit, conv[c("vcov", "cond.H")], th.res) fit$convergence <- conv[!names(conv) %in% c("vcov", "cond.H")] fit <- fit[sort(names(fit))] class(fit) <- "clm.fit" fit } clm.finalize <- function(fit, weights, coef.names, aliased) ### extracFromFit ### ### distinguishing between par and coef where the former does not ### contain aliased coefficients. { nalpha <- length(aliased$alpha) nbeta <- length(aliased$beta) nzeta <- length(aliased$zeta) nlambda <- length(fit$lambda) ncoef <- nalpha + nbeta + nzeta + nlambda ## including aliased coef npar <- sum(!unlist(aliased)) + nlambda ## excluding aliased coef stopifnot(length(fit$par) == npar) if(nlambda) aliased <- c(aliased, list(lambda = FALSE)) if(nlambda) coef.names <- c(coef.names, list(lambda="lambda")) fit <- within(fit, { coefficients <- rep(NA, ncoef) ## ensure correct order of alpha, beta and zeta: keep <- match(c("alpha", "beta", "zeta", "lambda"), names(aliased), nomatch=0) aliased <- lapply(aliased[keep], as.logical) for(i in names(aliased)) names(aliased[[i]]) <- coef.names[keep][[i]] names(coefficients) <- unlist(coef.names[keep]) par.names <- names(coefficients)[!unlist(aliased)] coefficients[!unlist(aliased)] <- par alpha <- coefficients[1:nalpha] if(nbeta) beta <- coefficients[nalpha + 1:nbeta] if(nzeta) zeta <- coefficients[nalpha + nbeta + 1:nzeta] names(gradient) <- par.names dimnames(Hessian) <- list(par.names, par.names) edf <- npar ## estimated degrees of freedom nobs <- sum(weights) n <- length(weights) fitted.values <- fitted df.residual = nobs - edf ## keep <- i <- fitted <- par.names <- par <- coef.names <- NULL }) notkeep <- c("keep", "i", "fitted", "par.names", "par", "coef.names") fit[!names(fit) %in% notkeep] } ordinal/R/clmm.ranef.R0000644000176200001440000000675315127777530014301 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Implementation of ranef and condVar methods for clmm objects to ## extract the conditional model of the random-effects and their ## conditional variances. ## fixef.clmm <- function(object, ...) coef(object, ...) ## object$coefficients ### NOTE: Should return a *named* vector # ranef <- function(object, ...) UseMethod("ranef") ## fixef <- function(object, ...) UseMethod("fixef") ranef.clmm <- function(object, condVar=FALSE, ...) ### This function... ### args... ### Returns.... { formatRanef <- function(relist, ST, gf.levels, assign, qi) { asgn <- split(seq_along(assign), assign) ## colnames of random effects: cn <- lapply(ST, colnames) cn <- lapply(asgn, function(ii) unlist(cn[ii])) ranefList <- lapply(seq_along(relist), function(i) { matrix(relist[[i]], ncol=qi[i]) }) ## Combine r.e. terms associated with the same grouping factors, ## set dimnames and coerce to data.frame: ranefList <- lapply(seq_along(asgn), function(i) { mat <- do.call(cbind, ranefList[ asgn[[i]] ]) dimnames(mat) <- list(gf.levels[[i]], cn[[i]]) as.data.frame(mat) }) ## list of r.e. by grouping factors: names(ranefList) <- names(gflevs) ranefList } ## which r.e. terms are associated with which grouping factors: asgn <- attributes(object$gfList)$assign ## names of levels of grouping factors: gflevs <- lapply(object$gfList, levels) ## random effects indicator factor: reind <- with(object$dims, factor(rep.int(seq_len(nretrms), nlev.re * qi))) ## list of random effects by r.e. term: relist <- split(object$ranef, reind) ranefList <- formatRanef(relist, object$ST, gflevs, asgn, object$dims$qi) if(condVar) { ### OPTION: Should we return matrices for vector-valued random effects ### as lmer does? ## Add conditional variances of the random effects: cond.var <- object$condVar if(NCOL(cond.var) > 1) cond.var <- diag(cond.var) cvlist <- split(cond.var, reind) cond.var <- formatRanef(cvlist, object$ST, gflevs, asgn, object$dims$qi) for(i in seq_along(ranefList)) attr(ranefList[[i]], "condVar") <- cond.var[[i]] } ranefList } condVar <- function(object, ...) UseMethod("condVar") condVar.clmm <- function(object, ...) lapply(ranef.clmm(object, condVar=TRUE), function(y) attr(y, "condVar")) ordinal/R/clmm2.R0000644000176200001440000010215215127777530013257 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## The main clmm2 function and some related auxiliary functions. clmm2.control <- function(method = c("ucminf", "nlminb", "model.frame"), ..., trace = 0, maxIter = 50, gradTol = 1e-4, maxLineIter = 50, innerCtrl = c("warnOnly", "noWarn", "giveError")) { method <- match.arg(method) innerCtrl <- match.arg(innerCtrl) ctrl <- list(trace=ifelse(trace < 0, 1, 0), maxIter=maxIter, gradTol=gradTol, maxLineIter=maxLineIter, innerCtrl=innerCtrl) optCtrl <- list(trace = abs(trace), ...) if(!is.numeric(unlist(ctrl[-5]))) stop("maxIter, gradTol, maxLineIter and trace should all be numeric") if(any(ctrl[-c(1, 5)] <= 0)) stop("maxIter, gradTol and maxLineIter have to be > 0") if(method == "ucminf" && !"grtol" %in% names(optCtrl)) optCtrl$grtol <- 1e-5 if(method == "ucminf" && !"grad" %in% names(optCtrl)) optCtrl$grad <- "central" list(method = method, ctrl = ctrl, optCtrl = optCtrl) } .negLogLikBase <- function(rho) { ### Update stDev, sigma, eta1Fix, and eta2Fix given new par: with(rho, { if(estimLambda > 0) lambda <- par[nxi + p + k + 1:estimLambda] if(estimStDev) stDev <- exp(par[p+nxi+k+estimLambda+ 1:s]) sigma <- if(k > 0) expSoffset * exp(drop(Z %*% par[nxi+p + 1:k])) else expSoffset eta1Fix <- drop(B1 %*% par[1:(nxi + p)]) eta2Fix <- drop(B2 %*% par[1:(nxi + p)]) }) return(invisible()) } .negLogLikMfast <- function(rho) { ## negative log-likelihood fit <- with(rho, { .C("nll", as.double(u), length(u), as.integer(grFac), as.double(stDev), as.double(o1), as.double(o2), length(o1), eta1 = as.double(eta1), eta2 = as.double(eta2), as.double(eta1Fix), as.double(eta2Fix), as.double(sigma), pr = as.double(pr), as.double(weights), as.double(lambda), as.integer(linkInt), nll = double(1) )[c("eta1", "eta2", "pr", "nll")] }) rho$eta1 <- fit$eta1 rho$eta2 <- fit$eta2 rho$pr <- fit$pr fit$nll } update.u2.v3 <- function(rho) { ### third version: C-implementation of NR-algorithm. .negLogLikBase(rho) ## update: par, stDev, eta1Fix, eta2Fix eta2Fix, sigma fit <- with(rho, .C("NRalgv3", as.integer(ctrl$trace), as.integer(ctrl$maxIter), as.double(ctrl$gradTol), as.integer(ctrl$maxLineIter), as.integer(grFac), as.double(stDev), as.double(o1), as.double(o2), as.double(eta1Fix), as.double(eta2Fix), as.double(sigma), as.integer(linkInt), as.double(weights), u = as.double(uStart), pr = as.double(pr), funValue = double(1), gradValues = as.double(uStart), hessValues = as.double(rep(1, length(uStart))), length(pr), length(uStart), maxGrad = double(1), conv = 0L, as.double(lambda), Niter = as.integer(Niter) )[c("u", "funValue", "gradValues", "hessValues", "maxGrad", "conv", "Niter")] ) ## Get message: message <- switch(as.character(fit$conv), "1" = "max|gradient| < tol, so current iterate is probably solution", "0" = "Non finite negative log-likelihood", "-1" = "iteration limit reached when updating the random effects", "-2" = "step factor reduced below minimum when updating the random effects") ## Check for convergence and report warning/error: if(rho$ctrl$trace > 0 && fit$conv == 1) cat("\nOptimizer converged! ", "max|grad|:", fit$maxGrad, message, fill = TRUE) if(fit$conv != 1 && rho$ctrl$innerCtrl == "warnOnly") warning(message, "\n at iteration ", rho$Niter) else if(fit$conv != 1 && rho$ctrl$innerCtrl == "giveError") stop(message, "\n at iteration ", rho$Niter) ## Store values and return: rho$Niter <- fit$Niter rho$u <- fit$u rho$D <- fit$hessValue rho$gradient <- fit$gradValue if(!is.finite(rho$negLogLik <- fit$funValue)) return(FALSE) return(TRUE) } clmm2 <- function(location, scale, nominal, random, data, weights, start, subset, na.action, contrasts, Hess = FALSE, model = TRUE, sdFixed, link = c("logistic", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), lambda, doFit = TRUE, control, nAGQ = 1, threshold = c("flexible", "symmetric", "equidistant"), ...) ## Handle if model = FALSE ### Marginal fitted values? (pr | u = 0) or (pr | u = u.tilde) ? ### How can we (should we?) get u.tilde and var(u.tilde) with GHQ? ### Make safeStart function if !is.finite(negLogLik) ### Write test suite for doFit argument { R <- match.call(expand.dots = FALSE) Call <- match.call() if(missing(random)) { Call[[1]] <- as.name("clm2") return(eval.parent(Call)) } if(missing(lambda)) lambda <- NULL if(missing(contrasts)) contrasts <- NULL if(missing(control)) control <- clmm2.control(...) if(!setequal(names(control), c("method", "ctrl", "optCtrl"))) stop("specify 'control' via clmm2.control()") if (missing(data)) data <- environment(location) if (is.matrix(eval.parent(R$data))) R$data <- as.data.frame(data) ### Collect all variables in a single formula and evaluate to handle ### missing values correctly: m <- match(c("location", "scale", "nominal"), names(R), 0) F <- lapply(as.list(R[m]), eval.parent) ## evaluate in parent varNames <- unique(unlist(lapply(F, all.vars))) longFormula <- eval(parse(text = paste("~", paste(varNames, collapse = "+")))[1]) m <- match(c("location", "data", "subset", "weights", "random", "na.action"), names(R), 0) R <- R[c(1, m)] R$location <- longFormula R$drop.unused.levels <- TRUE R[[1]] <- as.name("model.frame") names(R)[names(R) == "location"] <- "formula" R <- eval.parent(R) nonNA <- rownames(R) ### Append nonNA index to Call$subset to get the right design matrices ### from clm2: Call$subset <- if(is.null(Call$subset)) nonNA else c(paste(deparse(Call$subset), "&"), nonNA) Call$start <- if(is.null(Call$start) || !is.null(Call$sdFixed)) Call$start else start[-length(start)] Call$random <- Call$control <- Call$nAGQ <- Call$sdFixed <- Call$innerCtrl <- NULL Call$method <- control$method Call$doFit <- Call$Hess <- FALSE Call[[1]] <- as.name("clm2") rhoM <- eval.parent(Call) if(control$method == "model.frame") return(rhoM) rhoM$call <- match.call() rhoM$randomName <- deparse(rhoM$call$random) ### Set grouping factor and stDev parameter: rhoM$grFac <- R[,"(random)"] if(!missing(sdFixed) && !is.null(sdFixed)) { stopifnot(length(sdFixed) == 1 && sdFixed > 0) rhoM$estimStDev <- FALSE rhoM$stDev <- sdFixed } else rhoM$estimStDev <- TRUE with(rhoM, { r <- nlevels(grFac) ## no. random effects grFac <- as.integer(unclass(grFac)) if(r <= 2) stop("Grouping factor must have 3 or more levels") s <- ifelse(estimStDev, 1L, 0L) ## no. variance parameters Niter <- 0L }) ### set starting values: if(missing(start)) { suppressWarnings(fitCLM(rhoM)) if(rhoM$estimStDev) rhoM$start <- rhoM$par <- c(rhoM$par, log(1)) else rhoM$start <- rhoM$par } else rhoM$start <- rhoM$par <- start rhoM$uStart <- rhoM$u <- rep(0, rhoM$r) ### Test starting values: if(length(rhoM$start) != with(rhoM, nxi + p + k + estimLambda + estimStDev)) stop("'start' is ", length(rhoM$start), " long, but should be ", with(rhoM, nxi + p + k + estimLambda + estimStDev), " long") if(rhoM$ncolXX == 0) { if(!all(diff(c(rhoM$tJac %*% rhoM$start[1:rhoM$nalpha])) > 0)) stop("Threshold starting values are not of increasing size") } ### Change the lower limit if lambda is estimated with the ### Aranda-Ordaz link and sdFixed is not supplied: if(rhoM$estimLambda > 0 && rhoM$link == "Aranda-Ordaz" && is.null(rhoM$call$sdFixed)) rhoM$limitLow <- c(rep(-Inf, length(rhoM$par)-2), 1e-5, -Inf) ### This should hardly ever be the case: .negLogLikBase(rhoM) ## set lambda, stDev, sigma, eta1Fix and eta2Fix if(!is.finite(.negLogLikMfast(rhoM))) stop("Non-finite integrand at starting values") rhoM$ctrl <- control$ctrl rhoM$optCtrl <- control$optCtrl if(rhoM$method == "nlminb") { m <- match(names(rhoM$optCtrl), c("grad","grtol"), 0) rhoM$optCtrl <- rhoM$optCtrl[!m] } ### Match doFit: if(is.logical(doFit) || is.numeric(doFit)) { if(doFit) doFit <- "C" else doFit <- "no" } else if(!is.character(doFit) || !doFit %in% c("no", "R", "C")) stop("argument 'doFit' not recognized. 'doFit' should be\n numeric, logical or one of c('no', 'R', 'C')") ### Set ObjFun parameters: ObjFun <- getNLA2 ## same for "R" and "C" rhoM$updateU <- if(doFit == "R") update.u2 else update.u2.v3 rhoM$nAGQ <- as.integer(nAGQ) if(rhoM$nAGQ >= 2) { ghq <- gauss.hermite(rhoM$nAGQ) rhoM$ghqns <- ghq$nodes rhoM$ghqws <- ghq$weights if(doFit == "R") { ObjFun <- getNAGQinR rhoM$PRnn <- array(0, dim=c(rhoM$n, rhoM$nAGQ)) rhoM$PRrn <- array(0, dim=c(rhoM$r, rhoM$nAGQ)) rhoM$ghqws <- ghq$weights * exp(rhoM$ghqns^2) } else ObjFun <- getNAGQinC } if(rhoM$nAGQ <= -1) { ghq <- gauss.hermite(abs(rhoM$nAGQ)) rhoM$ghqns <- ghq$nodes rhoM$ghqws <- ghq$weights * exp((ghq$nodes^2)/2) if(doFit == "R"){ ObjFun <- getNGHQinR } else { ObjFun <- getNGHQinC rhoM$ghqws <- log(ghq$weights) + (ghq$nodes^2)/2 } } stopifnot(rhoM$nAGQ != 0) ## test needed? ### Fit the model: if(!doFit %in% c("C", "R")) return(rhoM) if(rhoM$nAGQ > -1) rhoM$updateU(rhoM) # Try updating the random effects rhoM$optRes <- switch(rhoM$method, "ucminf" = ucminf(rhoM$start, function(x) ObjFun(rhoM, x), control=rhoM$optCtrl), "nlminb" = nlminb(rhoM$start, function(x) ObjFun(rhoM, x), control=rhoM$optCtrl, lower = rhoM$limitLow, upper = rhoM$limitUp)) rhoM$par <- rhoM$optRes[[1]] if(Hess) { if(rhoM$link == "Aranda-Ordaz" && rhoM$estimLambda > 0 && rhoM$lambda < 1e-3) message("Cannot get Hessian because lambda = ",rhoM$lambda ," is too close to boundary.\n", " Fit model with link == 'logistic' to get Hessian") else { rhoM$Hessian <- myhess(function(x) ObjFun(rhoM, x), rhoM$par) rhoM$par <- rhoM$optRes[[1]] } } .negLogLikMfast(rhoM) ## update pr ## if(rhoM$nAGQ > -1) rhoM$updateU(rhoM) # Makes sure ranef's are evaluated at the optimum ### Post processing: res <- finalizeRhoM(rhoM) res$call <- match.call() res$na.action <- attr(R, "na.action") res$contrasts <- contrasts class(res) <- c("clmm2", "clm2") res } getNLA2 <- function(rho, par) { ### negative log-likelihood by the Laplace approximation ### (with update.u2 in C or R): if(!missing(par)) rho$par <- par if(!rho$updateU(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) ## logDetD <- sum(log(rho$D/(2*pi))) logDetD <- sum(log(rho$D)) - rho$r * log(2*pi) rho$negLogLik + logDetD / 2 } getNAGQinR <- function(rho, par) { ### negative log-likelihood by adaptive Gauss-Hermite quadrature ### implemented in R: if(!missing(par)) rho$par <- par if(!rho$updateU(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) with(rho, { K <- sqrt(2/D) agqws <- K %*% t(ghqws) agqns <- apply(K %*% t(ghqns), 2, function(x) x + u) ranNew <- apply(agqns, 2, function(x) x[grFac] * stDev) eta1Tmp <- (eta1Fix + o1 - ranNew) / sigma eta2Tmp <- (eta2Fix + o2 - ranNew) / sigma if(nlambda) ## PRnn <- (pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))^weights ## This is likely a computationally more safe solution: PRnn <- exp(weights * log(pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))) else ## PRnn <- (pfun(eta1Tmp) - pfun(eta2Tmp))^weights PRnn <- exp(weights * log(pfun(eta1Tmp) - pfun(eta2Tmp))) ### OPTION: The fitted values could be evaluated with getFittedC for ### better precision. for(i in 1:r) ## PRrn[i,] <- apply(PRnn[grFac == i, ], 2, prod) PRrn[i,] <- apply(PRnn[grFac == i, ,drop = FALSE], 2, prod) PRrn <- PRrn * agqws * dnorm(x=agqns, mean=0, sd=1) ### OPTION: Could this be optimized by essentially computing dnorm 'by hand'? }) -sum(log(rowSums(rho$PRrn))) } ## tmpAGQ(rho) tmpAGQ <- function(rho, par) { if(!missing(par)) rho$par <- par with(rho, { ls() stDev <- exp(ST[[1]][1, 1]) nlambda <- 0 K <- sqrt(2/D) agqws <- K %*% t(ghqws) agqns <- apply(K %*% t(ghqns), 2, function(x) x + u) grFac <- unclass(grFac) ranNew <- apply(agqns, 2, function(x) x[grFac] * stDev) eta1Tmp <- (eta1Fix + o1 - ranNew) / sigma eta2Tmp <- (eta2Fix + o2 - ranNew) / sigma if(nlambda) PRnn <- exp(weights * log(pfun(eta1Tmp, lambda) - pfun(eta2Tmp, lambda))) else PRnn <- exp(wts * log(pfun(eta1Tmp) - pfun(eta2Tmp))) dim(eta1Tmp) exp(wts[IND] * log(pfun(eta1Tmp[IND, ]) - pfun(eta2Tmp[IND, ]))) PRrn <- do.call(rbind, lapply(1:dims$q, function(i) { apply(PRnn[grFac == i, ,drop = FALSE], 2, prod) })) head(PRrn) PRrn <- do.call(rbind, lapply(1:dims$q, function(i) { apply(PRnn[grFac == i, ,drop = FALSE], 2, function(x) sum(log(x))) })) head(PRrn) ## Could we do something like PRnn <- wts * log(pfun(eta1Tmp) - pfun(eta2Tmp)) PRrn <- do.call(rbind, lapply(1:dims$q, function(i) { apply(PRnn[grFac == i, ,drop = FALSE], 2, function(x) sum(x)) })) head(PRrn, 20) ## to avoid first exp()ing and then log()ing? head(exp(PRrn), 20) range(PRrn) exp(range(PRrn)) out <- PRrn + log(agqws) + log(dnorm(x=agqns, mean=0, sd=1)) log(2 * 3) log(2) + log(3) PRnn[grFac == 12, , drop=FALSE] IND <- which(grFac == 12) cbind(IND, wts[IND], PRnn[IND, ]) dim(PRrn) ## There seems to be underfloow allready in the computations ## in PRnn, which propagates to PRrn PRrn <- PRrn * agqws * dnorm(x=agqns, mean=0, sd=1) }) -sum(log(rowSums(rho$PRrn))) } getNAGQinC <- function(rho, par) { ### negative log-likelihood by adaptive Gauss-Hermite quadrature ### implemented in C: if(!missing(par)) rho$par <- par if(!rho$updateU(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) with(rho, { .C("getNAGQ", nll = double(1), ## nll as.integer(grFac), ## grFac as.double(stDev), ## stDev as.double(eta1Fix), as.double(eta2Fix), as.double(o1), as.double(o2), as.double(sigma), ## Sigma as.double(weights), length(sigma), ## nx - no. obs length(uStart), ## nu - no. re as.double(ghqns), as.double(log(ghqws)), ## lghqws as.double(ghqns^2), ## ghqns2 as.double(u), as.double(D), as.integer(abs(nAGQ)), as.integer(linkInt), as.double(lambda))$nll }) } getNGHQinR <- function(rho, par) { ### negative log-likelihood by standard Gauss-Hermite quadrature ### implemented in R: if(!missing(par)) rho$par <- par .negLogLikBase(rho) ## Update lambda, stDev, sigma and eta*Fix with(rho, { ns <- ghqns * stDev SS <- numeric(r) ## summed likelihood for(i in 1:r) { ind <- grFac == i eta1Fi <- eta1Fix[ind] eta2Fi <- eta2Fix[ind] o1i <- o1[ind] o2i <- o2[ind] si <- sigma[ind] wt <- weights[ind] for(h in 1:abs(nAGQ)) { eta1s <- (eta1Fi + o1i - ns[h]) / si eta2s <- (eta2Fi + o2i - ns[h]) / si ## SS[i] <- exp(sum(wt * log(pfun(eta1s) - pfun(eta2s)))) * ## ghqws[h] * exp(ghqns[h]^2) * dnorm(x=ghqns[h]) + SS[i] SS[i] <- exp(sum(wt * log(pfun(eta1s) - pfun(eta2s)))) * ghqws[h] + SS[i] ### OPTION: The fitted values could be evaluated with getFittedC for ### better precision. } } -sum(log(SS)) + r * log(2*pi)/2 }) } getNGHQinC <- function(rho, par) { ### negative log-likelihood by standard Gauss-Hermite quadrature ### implemented in C: if(!missing(par)) rho$par <- par .negLogLikBase(rho) ## Update lambda, stDev, sigma and eta*Fix with(rho, { .C("getNGHQ_C", nll = double(1), as.integer(grFac), as.double(stDev), as.double(eta1Fix), as.double(eta2Fix), as.double(o1), as.double(o2), as.double(sigma), as.double(weights), length(sigma), length(uStart), as.double(ghqns), as.double(ghqws), as.integer(abs(nAGQ)), as.integer(linkInt), as.double(ghqns * stDev), as.double(lambda))$nll }) } finalizeRhoM <- function(rhoM) { if(rhoM$method == "ucminf") { if(rhoM$optRes$info[1] > rhoM$optCtrl[["grtol"]]) warning("clmm2 may not have converged:\n optimizer 'ucminf' terminated with max|gradient|: ", rhoM$optRes$info[1], call.=FALSE) rhoM$convergence <- ifelse(rhoM$optRes$info[1] > rhoM$optCtrl[["grtol"]], FALSE, TRUE) } if(rhoM$method == "nlminb") { rhoM$convergence <- ifelse(rhoM$optRes$convergence == 0, TRUE, FALSE) if(!rhoM$convergence) warning("clmm2 may not have converged:\n optimizer 'nlminb' terminated with message: ", rhoM$optRes$message, call.=FALSE) } if(rhoM$ctrl$gradTol < max(abs(rhoM$gradient))) warning("Inner loop did not converge at termination:\n max|gradient| = ", max(abs(rhoM$gradient))) with(rhoM, { if(nxi > 0) { xi <- par[1:nxi] names(xi) <- xiNames thetaNames <- paste(lev[-length(lev)], lev[-1], sep="|") Alpha <- Theta <- matrix(par[1:nxi], nrow=ncolXX, byrow=TRUE) Theta <- t(apply(Theta, 1, function(x) c(tJac %*% x))) if(ncolXX > 1){ dimnames(Theta) <- list(dnXX[[2]], thetaNames) dimnames(Alpha) <- list(dnXX[[2]], alphaNames) } else { Theta <- c(Theta) Alpha <- c(Alpha) names(Theta) <- thetaNames names(Alpha) <- alphaNames } coefficients <- xi } else coefficients <- numeric(0) if(p > 0) { beta <- par[nxi + 1:p] names(beta) <- dnX[[2]] coefficients <- c(coefficients, beta) } if(k > 0) { zeta <- par[nxi+p + 1:k] names(zeta) <- dnZ[[2]] coefficients <- c(coefficients, zeta) } if(estimLambda > 0) { names(lambda) <- "lambda" coefficients <- c(coefficients, lambda) } if(s > 0) { stDev <- exp(par[nxi+p+k + estimLambda + 1:s]) coefficients <- c(coefficients, stDev) } names(stDev) <- randomName if(exists("Hessian", inherits=FALSE)) dimnames(Hessian) <- list(names(coefficients), names(coefficients)) edf <- p + nxi + k + estimLambda + s nobs <- sum(weights) fitted.values <- pr df.residual = nobs - edf ranef <- u * stDev condVar <- 1/D * stDev^2 logLik <- -optRes[[2]] }) res <- as.list(rhoM) keepNames <- c("ranef", "df.residual", "fitted.values", "edf", "start", "stDev", "beta", "coefficients", "zeta", "Alpha", "Theta", "xi", "lambda", "convergence", "Hessian", "gradient", "optRes", "logLik", "Niter", "grFac", "call", "scale", "location", "nominal", "method", "y", "lev", "nobs", "threshold", "estimLambda", "link", "nAGQ", "condVar", "contrasts", "na.action") m <- match(keepNames, names(res), 0) res <- res[m] res } anova.clmm2 <- function (object, ..., test = c("Chisq", "none")) { anova.clm2(object, ..., test = c("Chisq", "none")) } print.clmm2 <- function(x, ...) { if(x$nAGQ >= 2) cat(paste("Cumulative Link Mixed Model fitted with the adaptive", "Gauss-Hermite \nquadrature approximation with", x$nAGQ ,"quadrature points"), "\n\n") else if(x$nAGQ <= -1) cat(paste("Cumulative Link Mixed Model fitted with the", "Gauss-Hermite \nquadrature approximation with", abs(x$nAGQ) ,"quadrature points"), "\n\n") else cat("Cumulative Link Mixed Model fitted with the Laplace approximation\n", fill=TRUE) if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control=NULL) } if(length(x$stDev)) { cat("\nRandom effects:\n") varMat <- matrix(c(x$stDev^2, x$stDev), nrow = length(x$stDev), ncol=2) rownames(varMat) <- names(x$stDev) colnames(varMat) <- c("Var", "Std.Dev") print(varMat, ...) } else { cat("\nNo random effects\n") } if(length(x$beta)) { cat("\nLocation coefficients:\n") print(x$beta, ...) } else { cat("\nNo location coefficients\n") } if(length(x$zeta)) { cat("\nScale coefficients:\n") print(x$zeta, ...) } else { cat("\nNo Scale coefficients\n") } if(x$estimLambda > 0) { cat("\nLink coefficient:\n") print(x$lambda) } if(length(x$xi) > 0) { cat("\nThreshold coefficients:\n") print(x$Alpha, ...) if(x$threshold != "flexible") { cat("\nThresholds:\n") print(x$Theta, ...) } } cat("\nlog-likelihood:", format(x$logLik, nsmall=2), "\n") cat("AIC:", format(-2*x$logLik + 2*x$edf, nsmall=2), "\n") if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") invisible(x) } vcov.clmm2 <- function(object, ...) { if(is.null(object$Hessian)) { stop("Model needs to be fitted with Hess = TRUE") } dn <- names(object$coefficients) structure(solve(object$Hessian), dimnames = list(dn, dn)) } summary.clmm2 <- function(object, digits = max(3, .Options$digits - 3), correlation = FALSE, ...) { estimStDev <- !("sdFixed" %in% names(as.list(object$call))) edf <- object$edf coef <- with(object, matrix(0, edf-estimStDev, 4, dimnames = list(names(coefficients[seq_len(edf-estimStDev)]), c("Estimate", "Std. Error", "z value", "Pr(>|z|)")))) coef[, 1] <- object$coefficients[seq_len(edf-estimStDev)] if(is.null(object$Hessian)) { stop("Model needs to be fitted with Hess = TRUE") } vc <- try(vcov(object), silent = TRUE) if(inherits(vc, "try-error")) { warning("Variance-covariance matrix of the parameters is not defined") coef[, 2:4] <- NaN if(correlation) warning("Correlation matrix is unavailable") object$condHess <- NaN } else { sd <- sqrt(diag(vc)) coef[, 2] <- sd[seq_len(edf - estimStDev)] object$condHess <- with(eigen(object$Hessian, only.values = TRUE), abs(max(values) / min(values))) coef[, 3] <- coef[, 1]/coef[, 2] coef[, 4] <- 2*pnorm(abs(coef[, 3]), lower.tail=FALSE) if(correlation) object$correlation <- (vc/sd)/rep(sd, rep(object$edf, object$edf)) } object$coefficients <- coef object$digits <- digits varMat <- matrix(c(object$stDev^2, object$stDev), nrow = length(object$stDev), ncol=2) rownames(varMat) <- names(object$stDev) colnames(varMat) <- c("Var", "Std.Dev") object$varMat <- varMat class(object) <- "summary.clmm2" object } print.summary.clmm2 <- function(x, digits = x$digits, signif.stars = getOption("show.signif.stars"), ...) { if(x$nAGQ >=2) cat(paste("Cumulative Link Mixed Model fitted with the adaptive", "Gauss-Hermite \nquadrature approximation with", x$nAGQ ,"quadrature points\n\n")) else if(x$nAGQ <= -1) cat(paste("Cumulative Link Mixed Model fitted with the", "Gauss-Hermite \nquadrature approximation with", abs(x$nAGQ) ,"quadrature points"), "\n\n") else cat("Cumulative Link Mixed Model fitted with the Laplace approximation\n", fill=TRUE) if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control=NULL) } if(length(x$stDev)) { cat("\nRandom effects:\n") print(x$varMat, ...) } else { cat("\nNo random effects\n") } ### OPTION: Should the number of obs. and the number of groups be ### displayed as in clmm? coef <- format(round(x$coefficients, digits=digits)) coef[,4] <- format.pval(x$coefficients[, 4]) p <- length(x$beta); nxi <- length(x$xi) k <- length(x$zeta); u <- x$estimLambda if(p > 0) { cat("\nLocation coefficients:\n") print(coef[nxi + 1:p, , drop=FALSE], quote = FALSE, ...) } else { cat("\nNo location coefficients\n") } if(k > 0) { cat("\nScale coefficients:\n") print(coef[(nxi+p+1):(nxi+p+k), , drop=FALSE], quote = FALSE, ...) } else { cat("\nNo scale coefficients\n") } if(x$estimLambda > 0) { cat("\nLink coefficients:\n") print(coef[(nxi+p+k+1):(nxi+p+k+u), , drop=FALSE], quote = FALSE, ...) } if(nxi > 0) { cat("\nThreshold coefficients:\n") print(coef[1:nxi, -4, drop=FALSE], quote = FALSE, ...) } cat("\nlog-likelihood:", format(x$logLik, nsmall=2), "\n") cat("AIC:", format(-2*x$logLik + 2*x$edf, nsmall=2), "\n") cat("Condition number of Hessian:", format(x$condHess, nsmall=2), "\n") if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") if(!is.null(correl <- x$correlation)) { cat("\nCorrelation of Coefficients:\n") ll <- lower.tri(correl) correl[ll] <- format(round(correl[ll], digits)) correl[!ll] <- "" print(correl[-1, -ncol(correl)], quote = FALSE, ...) } invisible(x) } ## ranef.clmm2 <- function(x) { ## x$ranef ## } ## Trace <- function(iter, stepFactor, val, maxGrad, par, first=FALSE) { ## t1 <- sprintf(" %3d: %-5e: %.3f: %1.3e: ", ## iter, stepFactor, val, maxGrad) ## t2 <- formatC(par) ## if(first) ## cat("iter: step factor: Value: max|grad|: Parameters:\n") ## cat(t1, t2, "\n") ## } gauss.hermite <- function (n) { n <- as.integer(n) if (n < 0) stop("need non-negative number of nodes") if (n == 0) return(list(nodes = numeric(0), weights = numeric(0))) i <- 1:n i1 <- i[-n] muzero <- sqrt(pi) a <- rep(0, n) b <- sqrt(i1/2) A <- rep(0, n * n) A[(n + 1) * (i1 - 1) + 2] <- b A[(n + 1) * i1] <- b dim(A) <- c(n, n) vd <- eigen(A, symmetric = TRUE) w <- rev(as.vector(vd$vectors[1, ])) w <- muzero * w^2 x <- rev(vd$values) list(nodes = x, weights = w) } profile.clmm2 <- function(fitted, alpha = 0.01, range, nSteps = 20, trace = 1, ...) { estimStDev <- !("sdFixed" %in% names(as.list(fitted$call))) if(!estimStDev) ## || is.null(fitted$Hessian)) fitted <- update(fitted, Hess = TRUE, sdFixed = NULL) MLogLik <- fitted$logLik MLstDev <- fitted$stDev if(missing(range) && is.null(fitted$Hessian)) stop("'range' should be specified or model fitted with 'Hess = TRUE'") if(missing(range) && !is.null(fitted$Hessian)) { range <- log(fitted$stDev) + qnorm(1 - alpha/2) * c(-1, 1) * sqrt(vcov(fitted)[fitted$edf, fitted$edf]) range <- exp(range) pct <- paste(round(100*c(alpha/2, 1-alpha/2), 1), "%") ci <- array(NA, dim = c(1, 2), dimnames = list("stDev", pct)) ci[] <- range } stopifnot(all(range > 0)) logLik <- numeric(nSteps) stDevSeq <- seq(min(range), max(range), length.out = nSteps) if(trace) message("Now profiling stDev with ", nSteps, " steps: i =") if(trace) cat(1, "") rho <- update(fitted, Hess = FALSE, sdFixed = min(range)) logLik[1] <- rho$logLik start <- as.vector(rho$coefficients) for(i in 2:nSteps){ if(trace) cat(i, "") rho <- update(rho, sdFixed = stDevSeq[i], start = start) logLik[i] <- rho$logLik start <- as.vector(rho$coefficients) } if(trace) cat("\n") if(any(logLik > fitted$logLik)) warning("Profiling found a better optimum,", " so original fit had not converged") sgn <- 2*(stDevSeq > MLstDev) -1 Lroot <- sgn * sqrt(2) * sqrt(-logLik + MLogLik) res <- data.frame("Lroot" = c(0, Lroot), "stDev" = c(MLstDev, stDevSeq)) res <- res[order(res[,1]),] if(!all(diff(res[,2]) > 0)) warning("likelihood is not monotonically decreasing from maximum,\n", " so profile may be unreliable for stDev") val <- structure(list(stDev = res), original.fit = fitted) if(exists("ci", inherits=FALSE)) attr(val, "WaldCI") <- ci class(val) <- c("profile.clmm2", "profile") val } confint.profile.clmm2 <- function(object, parm = seq_along(Pnames), level = 0.95, ...) { Pnames <- names(object) confint.profile.clm2(object, parm = parm, level = level, ...) } plot.profile.clmm2 <- function(x, parm = seq_along(Pnames), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, fig = TRUE, n = 1e3, ..., ylim = NULL) { Pnames <- names(x) plot.profile.clm2(x, parm = parm, level = level, Log = Log, relative = relative, fig = fig, n = n, ..., ylim = ylim) } update.clmm2 <- function(object, formula., location, scale, nominal, ..., evaluate = TRUE) { call <- object$call if (is.null(call)) stop("need an object with call component") extras <- match.call(expand.dots = FALSE)$... if (!missing(location)) call$location <- update.formula(formula(attr(object$location, "terms")), location) if (!missing(scale)) call$scale <- if(!is.null(object$scale)) update.formula(formula(attr(object$scale, "terms")), scale) else scale if (!missing(nominal)) call$nominal <- if(!is.null(object$nominal)) update.formula(formula(attr(object$nominal, "terms")), nominal) else nominal if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call } ordinal/R/clm.frames.R0000644000176200001440000002412215127777530014274 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## methods for computing, manipulating and extracting design matrices, ## weights, offsets, model.frames and things like that. ## ################################# ## ## call sequence ## clm() { ## get_clmFormulas() ## get_clm.mf() ## get_clmTerms() # optionally ## get_clmDesign() ## ## makeThresholds() ## drop.cols() ## ## clm.fit.default() ## get_clmInfoTab() ## } ## ## get_clmFormulas() { ## getFullForm() ## } ## ## get_clm.mf() { ## model.frame() ## } ## ## get_clmTerms() { ## get_clm.mf() ## } ## ## get_clmDesign() { ## checkContrasts() ## get_clmDM() ## for formula, scale, nominal ## getWeights() ## get_clmY() ## } ## ## get_clmDM() { ## model.matrix() ## getContrasts() ## getOffset() ## } get_clmTerms <- function(mc, formulas, call.envir=parent.frame(2L)) ### Compute terms objects for each of the formulas. { ## We need this approach in order to get the predvars and ## dataClasses attributes of the terms objects. nms <- c("formula", "scale", "nominal") keep <- match(nms, names(formulas), nomatch=0) lapply(formulas[keep], function(form) { terms(get_clm.mf(mc, form, attr(formulas, "envir"), call.envir)) }) } get_clmDesign <- function(fullmf, terms.list, contrasts) { ### Compute (y, X, weights, off, S, NOM etc.) for a clm object. ### clm-internal+external ### ### terms.list: list of terms.objects. stopifnot(all(sapply(terms.list, inherits, "terms"))) ## Check that contrasts are specified only for terms in the model: checkContrasts(terms=attr(fullmf, "terms"), contrasts=contrasts) ## Extract X (design matrix for location effects) + terms, offset: res <- get_clmDM(fullmf, terms.list[["formula"]], contrasts, type="formula") res$terms <- terms.list[["formula"]] res$contrasts <- attr(res$X, "contrasts") res$xlevels <- .getXlevels(res$terms, fullmf) res$na.action <- attr(fullmf, "na.action") ## Extract weights: res$weights <- getWeights(fullmf) ## Extract model response: res <- c(get_clmY(fullmf, res$weights), res) ## Extract S (design matrix for the scale effects): if(!is.null(terms.list$scale)) { ans <- get_clmDM(fullmf, terms.list[["scale"]], contrasts, type="scale") res$S <- ans$X res$S.terms <- terms.list[["scale"]] res$S.off <- ans$offset res$S.contrasts <- attr(res$S, "contrasts") res$S.xlevels <- .getXlevels(res$S.terms, fullmf) if(attr(res$S.terms, "response") != 0) stop("response not allowed in 'scale'", call.=FALSE) } ## Extract NOM (design matrix for the nominal effects): if(!is.null(terms.list$nominal)) { ans <- get_clmDM(fullmf, terms.list[["nominal"]], contrasts, type="nominal") res$NOM <- ans$X res$nom.terms <- terms.list[["nominal"]] res$nom.contrasts <- attr(res$NOM, "contrasts") res$nom.xlevels <- .getXlevels(res$nom.terms, fullmf) if(attr(res$nom.terms, "response") != 0) stop("response not allowed in 'nominal'", call.=FALSE) if(!is.null(attr(res$nom.terms, "offset"))) stop("offset not allowed in 'nominal'", call.=FALSE) } ## Return results (list of design matrices etc.): res ### NOTE: X, S and NOM are with dimnames and intercepts are ### guaranteed. They may be column rank deficient. } get_clmDM <- function(fullmf, terms, contrasts, check.intercept=TRUE, type="formula", get.offset=TRUE) ### Get DM (=Design Matrix): { X <- model.matrix(terms, data=fullmf, contrasts.arg=getContrasts(terms, contrasts)) ## Test for intercept in X(?): Xint <- match("(Intercept)", colnames(X), nomatch = 0) if(check.intercept && Xint <= 0) { X <- cbind("(Intercept)" = rep(1, nrow(X)), X) warning(gettextf("an intercept is needed and assumed in '%s'", type), call.=FALSE) } ## Intercept in X is guaranteed. res <- list(X=X) if(get.offset) res$offset <- getOffset(fullmf, terms) res } get_clm.mf <- function(mc, formula, form.envir, call.envir=parent.frame(2L)) ### clm-internal ### Extract the model.frame from formula ### mc - matched call containing: data, subset, weights, na.action { ## Extract the full model.frame(mf): m <- match(c("data", "subset", "weights", "na.action"), names(mc), 0) mfcall <- mc[c(1, m)] mfcall$formula <- formula mfcall$drop.unused.levels <- TRUE mfcall[[1]] <- as.name("model.frame") if(is.null(mfcall$data)) mfcall$data <- form.envir eval(mfcall, envir=call.envir) } get_clmY <- function(fullmf, weights) { y <- model.response(fullmf, "any") ## any storage mode if(is.null(y)) stop("'formula' needs a response", call.=FALSE) if(!is.factor(y)) stop("response in 'formula' needs to be a factor", call.=FALSE) ## y.levels are the levels of y with positive weights y.levels <- levels(droplevels(y[weights > 0])) ## check that y has at least two levels: if(length(y.levels) == 1L) stop(gettextf("response has only 1 level ('%s'); expecting at least two levels", y.levels), call.=FALSE) if(!length(y.levels)) stop("response should be a factor with at least two levels") ## return: list(y=y, y.levels=y.levels) } get_clmFormulas <- function(mc, envir=parent.frame(2L)) ### clm-internal ### Extracts and returns a list of formulas needed for further processing. ### mc: matched call ### envir: environment in which mc is to be evaluated { ## Collect all variables in a full formula: ## evaluate the formulae in the enviroment in which clm was called ## (parent.frame(2)) to get them evaluated properly: forms <- list(eval(mc$formula, envir=envir)) if(!is.null(mc$scale)) forms$scale <- eval(mc$scale, envir=envir) if(!is.null(mc$nominal)) forms$nominal <- eval(mc$nominal, envir=envir) ## get the environment of the formula. If this does not have an ## enviroment (it could be a character), then use the parent frame. form.envir <- if(!is.null(env <- environment(forms[[1]]))) env else envir ## ensure formula, scale and nominal are formulas: forms[] <- lapply(forms, function(x) { # 'is.character(.)' for scale = "~ ..." tryCatch(formula(if(is.character(x)) x else Deparse(x), env = form.envir), error = function(e)e) }) if(any(vapply(forms, inherits, FUN.VALUE=logical(1), what="error"))) stop("unable to interpret 'formula', 'scale' or 'nominal'") ## collect all variables in a full formula: forms$fullForm <- do.call("getFullForm", forms) ### OPTION: do we actually need to set this name? names(forms)[1] <- "formula" ## set environment of 'fullForm' to the environment of 'formula': attr(forms, "envir") <- environment(forms$fullForm) <- form.envir ## return: forms } get_clmRho <- function(object, ...) { UseMethod("get_clmRho") } get_clmRho.default <- function(object, terms.list, contrasts, link, threshold, parent=parent.frame(), start=NULL, control=clm.control(), ...) ### .default method(?) ### object: model.frame (fullmf) with all variables present ### terms.list: list of terms.objects for each of the formulas in the ### clm object. { ## Get design matrices etc: design <- get_clmDesign(fullmf=object, terms.list=terms.list, contrasts=contrasts) ## Get threshold information: design <- c(design, makeThresholds(design$y.levels, threshold)) ## Drop columns for aliased coefs: design <- drop.cols(design, drop.scale=FALSE, silent=TRUE) ## Set envir rho with variables: B1, B2, o1, o2, weights, fitted: rho <- with(design, { clm.newRho(parent.frame(), y=y, X=X, NOM=design$NOM, S=design$S, weights=weights, offset=offset, S.offset=design$S.off, tJac=tJac, control=control) }) ## Set and check starting values for the parameters: start <- set.start(rho, start=start, get.start=is.null(start), threshold=threshold, link=link, frames=design) rho$par <- as.vector(start) ## remove attributes ## Set pfun, dfun and gfun in rho: setLinks(rho, link) ## Return: rho } get_clmRho.clm <- function(object, parent=parent.frame(), ...) { ### Safely generate the model environment from a model object. o <- object get_clmRho.default(object=model.frame(o), terms.list=terms(o, "all"), contrasts=o$contrasts, start=c(o$start), link=o$link, threshold=o$threshold, parent=parent, control=o$control, ...) } ## get_mfcall <- function(mc, envir=parent.frame(2)) { ## m <- match(c("data", "subset", "weights", "na.action"), ## names(mc), 0) ## mf <- mc[c(1, m)] ## ## mf$formula <- fullForm ## mf$drop.unused.levels <- TRUE ## mf[[1]] <- as.name("model.frame") ## ## if(is.null(mf$data)) mf$data <- form.envir ## list(mfcall=mf, envir=parent.frame(2)) ## } ordinal/R/clm.methods.R0000644000176200001440000003472715127777530014476 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Implementation of various methods for clm objects. print.clm <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("formula:", Deparse(formula(x$terms)), fill=TRUE) ### NOTE: deparse(x$call$formula) will not always work since this may ### not always be appropriately evaluated. if(!is.null(x$call$scale)) cat("scale: ", Deparse(formula(x$S.terms)), fill=TRUE) if(!is.null(x$call$nominal)) cat("nominal:", Deparse(formula(x$nom.terms)), fill=TRUE) if(!is.null(data.name <- x$call$data)) cat("data: ", Deparse(data.name), fill=TRUE) if(!is.null(x$call$subset)) cat("subset: ", Deparse(x$call$subset), fill=TRUE) cat("\n") print(x$info, row.names=FALSE, right=FALSE) if(length(x$beta)) { if(sum(x$aliased$beta) > 0) { cat("\nCoefficients: (", sum(x$aliased$beta), " not defined because of singularities)\n", sep = "") } else cat("\nCoefficients:\n") print.default(format(x$beta, digits = digits), quote = FALSE) } if(length(x$zeta)) { if(sum(x$aliased$zeta) > 0) cat("\nlog-scale coefficients: (", sum(x$aliased$zeta), " not defined because of singularities)\n", sep = "") else cat("\nlog-scale coefficients:\n") print.default(format(x$zeta, digits = digits), quote = FALSE) } if(length(x$lambda)) { cat("\nLink coefficient:\n") print.default(format(x$lambda, digits = digits), quote = FALSE) } if(length(x$alpha) > 0) { if(sum(x$aliased$alpha) > 0) cat("\nThreshold coefficients: (", sum(x$aliased$alpha), " not defined because of singularities)\n", sep = "") else cat("\nThreshold coefficients:\n") if(!is.null(x$call$nominal)) print.default(format(x$alpha.mat, digits = digits), quote = FALSE) else print.default(format(x$alpha, digits = digits), quote = FALSE) } if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") return(invisible(x)) } vcov.clm <- function(object, tol = sqrt(.Machine$double.eps), method = c("clm", "Cholesky", "svd", "eigen", "qr"), ...) { method <- match.arg(method) if(method == "clm") return(object$vcov) if(is.null(object$Hessian)) stop("Model needs to be fitted with Hess = TRUE") dn <- dimnames(object$Hessian) H <- object$Hessian if(!all(is.finite(H))) stop("cannot compute vcov: non-finite values in Hessian") if(method == "svd") { Hsvd <- svd(H) ## positive <- Hsvd$d > max(tol * Hsvd$d[1L], tol) positive <- Hsvd$d > tol if(!all(positive)) stop(gettextf("Cannot compute vcov: \nHessian is numerically singular with min singular value = %g", min(Hsvd$d))) cov <- Hsvd$v %*% (1/Hsvd$d * t(Hsvd$u)) } else if(method == "eigen") { evd <- eigen(H, symmetric=TRUE) ## tol <- max(tol * evd$values[1L], tol) ## if evd$values[1L] < 0 if(any(evd$values < tol)) stop(gettextf("Cannot compute vcov: \nHessian is not positive definite with min eigenvalue = %g", min(evd$values))) cov <- with(evd, vectors %*% diag(1/values) %*% t(vectors)) } else if(method == "Cholesky") { cholH <- try(chol(H), silent=TRUE) if(inherits(cholH, "try-error")) stop("Cannot compute vcov: \nHessian is not positive definite") cov <- chol2inv(cholH) } else if(method == "qr") { qrH <- qr(H, tol=sqrt(.Machine$double.eps)) if(qrH$rank < nrow(H)) stop("Cannot compute vcov: \nHessian is numerically singular") cov <- solve.qr(qrH) } else stop("method not recognized") ## Need to test for negative variances, since some methods (svd, ## qr) may produce a vcov-matrix if the Hessian is *negative* ## definite: if(any(diag(cov) < 0)) { stop("Cannot compute vcov: \nHessian is not positive definite") } structure(cov, dimnames=dn) } summary.clm <- function(object, correlation = FALSE, ...) { vcov <- object$vcov coefs <- matrix(NA, length(object$coefficients), 4, dimnames = list(names(object$coefficients), c("Estimate", "Std. Error", "z value", "Pr(>|z|)"))) coefs[, 1] <- object$coefficients if(!all(is.finite(vcov))) { ## warning("Variance-covariance matrix of the parameters is not defined") coefs[, 2:4] <- NA if(correlation) warning("Correlation matrix is unavailable") } else { alias <- unlist(object$aliased) coefs[!alias, 2] <- sd <- sqrt(diag(vcov)) ## Cond is Inf if Hessian contains NaNs: object$cond.H <- if(any(is.na(object$Hessian))) Inf else with(eigen(object$Hessian, symmetric=TRUE, only.values = TRUE), abs(max(values) / min(values))) coefs[!alias, 3] <- coefs[!alias, 1]/coefs[!alias, 2] coefs[!alias, 4] <- 2 * pnorm(abs(coefs[!alias, 3]), lower.tail=FALSE) if(correlation) object$correlation <- cov2cor(vcov) } object$coefficients <- coefs class(object) <- "summary.clm" return(object) } print.summary.clm <- function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) { cat("formula:", Deparse(formula(x$terms)), fill=TRUE) ### NOTE: deparse(x$call$formula) will not always work since this may ### not always be appropriately evaluated. if(!is.null(x$call$scale)) cat("scale: ", Deparse(formula(x$S.terms)), fill=TRUE) if(!is.null(x$call$nominal)) cat("nominal:", Deparse(formula(x$nom.terms)), fill=TRUE) if(!is.null(data.name <- x$call$data)) cat("data: ", Deparse(data.name), fill=TRUE) if(!is.null(x$call$subset)) cat("subset: ", Deparse(x$call$subset), fill=TRUE) cat("\n") print(x$info, row.names=FALSE, right=FALSE) nalpha <- length(x$alpha) nbeta <- length(x$beta) nzeta <- length(x$zeta) nlambda <- length(x$lambda) if(nbeta > 0) { if(sum(x$aliased$beta) > 0) cat("\nCoefficients: (", sum(x$aliased$beta), " not defined because of singularities)\n", sep = "") else cat("\nCoefficients:\n") printCoefmat(x$coefficients[nalpha + 1:nbeta, , drop=FALSE], digits=digits, signif.stars=signif.stars, has.Pvalue=TRUE, ...) } ## else cat("\nNo Coefficients\n") if(nzeta > 0) { if(sum(x$aliased$zeta) > 0) cat("\nlog-scale coefficients: (", sum(x$aliased$zeta), " not defined because of singularities)\n", sep = "") else cat("\nlog-scale coefficients:\n") printCoefmat(x$coefficients[nalpha + nbeta + 1:nzeta, , drop=FALSE], digits=digits, signif.stars=signif.stars, has.Pvalue=TRUE, ...) } if(nlambda > 0) { cat("\nLink coefficients:\n") printCoefmat(x$coefficients[nalpha + nbeta + nzeta + nlambda, , drop=FALSE], digits=digits, signif.stars=signif.stars, has.Pvalue=TRUE, ...) } if(nalpha > 0) { ## always true if(sum(x$aliased$alpha) > 0) cat("\nThreshold coefficients: (", sum(x$aliased$alpha), " not defined because of singularities)\n", sep = "") else cat("\nThreshold coefficients:\n") printCoefmat(x$coefficients[seq_len(nalpha), -4, drop=FALSE], digits=digits, has.Pvalue=FALSE, signif.stars=FALSE, ...) } if(nzchar(mess <- naprint(x$na.action))) cat("(", mess, ")\n", sep="") if(!is.null(correl <- x$correlation)) { cat("\nCorrelation of Coefficients:\n") ll <- lower.tri(correl) correl[ll] <- format(round(correl[ll], digits)) correl[!ll] <- "" print(correl[-1, -ncol(correl)], quote = FALSE, ...) } return(invisible(x)) } logLik.clm <- function(object, ...) structure(object$logLik, df = object$edf, nobs=object$nobs, class = "logLik") extractAIC.clm <- function(fit, scale = 0, k = 2, ...) { edf <- fit$edf c(edf, -2*fit$logLik + k * edf) } ### NOTE: AIC.clm implicitly defined via logLik.clm anova.clm <- function(object, ..., type = c("I", "II", "III", "1", "2", "3")) ### requires that clm objects have components: ### edf: no. parameters used ### call$formula ### link (character) ### threshold (character) ### logLik ### { mc <- match.call() dots <- list(...) ## remove 'test' and 'type' arguments from dots-list: not.keep <- which(names(dots) %in% c("test")) if(length(not.keep)) { message("'test' argument ignored in anova.clm\n") dots <- dots[-not.keep] } if(length(dots) == 0) { if(inherits(object, "clmm")) stop("anova not implemented for a single clmm fit") return(single_anova(object, type=type)) } ## Multi-model anova method proceeds: mlist <- c(list(object), dots) if(!all(sapply(mlist, function(model) inherits(model, c("clm", "clmm"))))) stop("only 'clm' and 'clmm' objects are allowed") nfitted <- sapply(mlist, function(x) length(x$fitted.values)) if(any(nfitted != nfitted[1L])) stop("models were not all fitted to the same dataset") ### OPTION: consider comparing y returned by the models for a better check? no.par <- sapply(mlist, function(x) x$edf) ## order list with increasing no. par: ord <- order(no.par, decreasing=FALSE) mlist <- mlist[ord] no.par <- no.par[ord] no.tests <- length(mlist) ## extract formulas, links, thresholds, scale formulas, nominal ## formulas: forms <- sapply(mlist, function(x) Deparse(x$call$formula)) links <- sapply(mlist, function(x) x$link) thres <- sapply(mlist, function(x) x$threshold) nominal <- sapply(mlist, function(x) Deparse(x$call$nominal)) scale <- sapply(mlist, function(x) Deparse(x$call$scale)) models <- data.frame(forms) models.names <- 'formula:' if(any(!nominal %in% c("~1", "NULL"))) { nominal[nominal == "NULL"] <- "~1" models$nominal <- nominal models.names <- c(models.names, "nominal:") } if(any(!scale %in% c("~1", "NULL"))) { scale[scale == "NULL"] <- "~1" models$scale <- scale models.names <- c(models.names, "scale:") } models.names <- c(models.names, "link:", "threshold:") models <- cbind(models, data.frame(links, thres)) ## extract AIC, logLik, statistics, df, p-values: AIC <- sapply(mlist, function(x) -2*x$logLik + 2*x$edf) logLiks <- sapply(mlist, function(x) x$logLik) statistic <- c(NA, 2*diff(sapply(mlist, function(x) x$logLik))) df <- c(NA, diff(no.par)) pval <- c(NA, pchisq(statistic[-1], df[-1], lower.tail=FALSE)) pval[!is.na(df) & df==0] <- NA ## collect results in data.frames: tab <- data.frame(no.par, AIC, logLiks, statistic, df, pval) tab.names <- c("no.par", "AIC", "logLik", "LR.stat", "df", "Pr(>Chisq)") mnames <- sapply(as.list(mc), Deparse)[-1] colnames(tab) <- tab.names rownames(tab) <- rownames(models) <- mnames[ord] colnames(models) <- models.names attr(tab, "models") <- models attr(tab, "heading") <- "Likelihood ratio tests of cumulative link models:\n" class(tab) <- c("anova.clm", "data.frame") tab } print.anova.clm <- function(x, digits=max(getOption("digits") - 2, 3), signif.stars=getOption("show.signif.stars"), ...) { if (!is.null(heading <- attr(x, "heading"))) cat(heading, "\n") models <- attr(x, "models") print(models, right=FALSE) cat("\n") printCoefmat(x, digits=digits, signif.stars=signif.stars, tst.ind=4, cs.ind=NULL, # zap.ind=2, #c(1,5), P.values=TRUE, has.Pvalue=TRUE, na.print="", ...) return(invisible(x)) } model.matrix.clm <- function(object, type = c("design", "B"), ...) { type <- match.arg(type) mf <- try(model.frame(object), silent=TRUE) if(inherits(mf, "try-error")) stop("Cannot extract model.matrix: refit model with 'model=TRUE'?") ### NOTE: we want to stop even if type="B" since the fullmf is needed ### in get_clmRho also and this way the error message is better. if(type == "design") { contr <- c(object$contrasts, object$S.contrasts, object$nom.contrasts) design <- get_clmDesign(fullmf=object$model, terms.list=terms(object, "all"), contrasts=contr) keep <- c("X", "NOM", "S") select <- match(keep, names(design), nomatch=0) ans <- design[select] } else { ## if type == "B": env <- get_clmRho.clm(object) ans <- list(B1 = env$B1, B2 = env$B2) ans$S <- env$S ## may not exist } return(ans) } model.frame.clm <- function(formula, ...) { ### returns a model frame with *all* variables used for fitting. if(is.null(mod <- formula$model)) stop("Cannot extract model.frame: refit model with 'model=TRUE'") else mod } coef.clm <- function(object, na.rm = FALSE, ...) { if(na.rm) { coefs <- object$coefficients coefs[!is.na(coefs)] } else object$coefficients } coef.summary.clm <- function(object, na.rm = FALSE, ...) { if(na.rm) { coefs <- object$coefficients coefs[!is.na(coefs[,1]), , drop=FALSE] } else object$coefficients } nobs.clm <- function(object, ...) object$nobs terms.clm <- function(x, type=c("formula", "scale", "nominal", "all"), ...) { type <- match.arg(type) term.nm <- c("terms", "S.terms", "nom.terms") Terms <- x[names(x) %in% term.nm] ind <- match(term.nm, names(Terms), 0L) Terms <- Terms[ind] names(Terms) <- c("formula", "scale", "nominal")[ind != 0] if(type == "all") return(Terms) if(!type %in% names(Terms)) stop(gettextf("no terms object for '%s'", type)) Terms[[type]] } ordinal/R/clm.nominal_test.R0000644000176200001440000001704215127777530015516 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Implementation of of nominal_test.clm() and scale_test.clm() for ## automatic testing of nominal and scale effects in clm()s. These ## functions work in a fashion similar to add1(). nominal_test <- function(object, ...) { UseMethod("nominal_test") } scale_test <- function(object, ...) { UseMethod("scale_test") } nominal_test.clm <- function(object, scope, trace=FALSE, ...) ### Test nominal effects for all (or selected) terms in location ### and scale formulas. { ## get scope: vector of terms names which to add to nominal: termsnm <- attr(object$terms, "term.labels") if(!is.null(object$S.terms)) termsnm <- union(termsnm, attr(object$S.terms, "term.labels")) if(!missing(scope) && !is.null(scope)) { if(!is.character(scope)) scope <- attr(terms(update.formula(object, scope)), "term.labels") if(!all(match(scope, termsnm, 0L) > 0L)) stop("scope is not a subset of term labels") } else { scope <- termsnm } if(!is.null(object$nom.terms)) { scope <- scope[!scope %in% attr(object$nom.terms, "term.labels")] } if(!length(scope)) message("\nno additional terms to add to nominal\n") env <- environment(formula(object)) ## get list of (updated) nominal formulas: nomforms <- if(!is.null(object$call$nominal)) lapply(scope, function(tm) { update.formula(old=formula(object$nom.terms), new=as.formula(paste("~. + ", tm))) }) else lapply(scope, function(tm) { as.formula(paste("~", tm), env=env) }) ns <- length(scope) ## results matrix: ans <- matrix(nrow = ns + 1L, ncol = 3L, dimnames = list(c("", scope), c("df", "logLik", "AIC"))) ans[1L, ] <- c(object$edf, object$logLik, AIC(object)) n0 <- nobs(object) ## for all terms in scope: i <- 1 for(i in seq(ns)) { if(trace) { cat("trying +", scope[i], "\n", sep = " ") utils::flush.console() } ## update and fit model with nominal effect added: nfit <- try(update(object, nominal=nomforms[[i]], convergence="silent"), silent=TRUE) ## model may not be identifiable or converge: if(!inherits(nfit, "try-error") && ### NOTE: non-negative convergence codes indicate that the likelihood ### is correctly determined: nfit$convergence$code >= 0) { ans[i + 1L, ] <- c(nfit$edf, nfit$logLik, AIC(nfit)) nnew <- nobs(nfit) if(all(is.finite(c(n0, nnew))) && nnew != n0) stop("number of rows in use has changed: remove missing values?") } } dfs <- ans[, 1L] - ans[1L, 1L] dfs[1L] <- NA aod <- data.frame(Df = dfs, logLik = ans[, 2L], AIC = ans[, 3L]) rownames(aod) <- rownames(ans) ## compute likelihood ratio statistic and p-values: LR <- 2*(ans[, 2L] - ans[1L, 2L]) LR[1L] <- NA nas <- !is.na(LR) P <- LR P[nas] <- pchisq(LR[nas], dfs[nas], lower.tail = FALSE) aod[, c("LRT", "Pr(>Chi)")] <- list(LR, P) head <- c("Tests of nominal effects", paste("\nformula:", Deparse(formula(object$terms)))) if(!is.null(object$call$scale)) head <- c(head, paste("scale: ", Deparse(formula(object$S.terms)))) if(!is.null(object$call$nominal)) head <- c(head, paste("nominal:", Deparse(formula(object$nom.terms)))) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } scale_test.clm <- function(object, scope, trace=FALSE, ...) ### Test scale effects for all (or selected) terms in formula { ## get scope: vector of terms names which to add to scale: termsnm <- attr(object$terms, "term.labels") if(!missing(scope) && !is.null(scope)) { if(!is.character(scope)) scope <- attr(terms(update.formula(object, scope)), "term.labels") if(!all(match(scope, termsnm, 0L) > 0L)) stop("scope is not a subset of term labels") } else { scope <- termsnm } ## if(!is.null(object$nom.terms)) { ## scope <- scope[!scope %in% attr(object$nom.terms, ## "term.labels")] ## } if(!is.null(object$S.terms)) { scope <- scope[!scope %in% attr(object$S.terms, "term.labels")] } if(!length(scope)) message("\nno relevant terms to add to scale\n") env <- environment(formula(object)) ## get list of (updated) scale formulas: scaleforms <- if(!is.null(object$call$scale)) lapply(scope, function(tm) { update.formula(old=formula(object$S.terms), new=as.formula(paste("~. + ", tm))) }) else lapply(scope, function(tm) as.formula(paste("~", tm), env=env)) ns <- length(scope) ## results matrix: ans <- matrix(nrow = ns + 1L, ncol = 3L, dimnames = list(c("", scope), c("df", "logLik", "AIC"))) ans[1L, ] <- c(object$edf, object$logLik, AIC(object)) n0 <- nobs(object) ## for all terms in scope: for(i in seq(ns)) { if(trace) { cat("trying +", scope[i], "\n", sep = " ") utils::flush.console() } ## update and fit model with scale effect added: nfit <- try(update(object, scale=scaleforms[[i]]), silent=TRUE) ## model may not be identifiable or converge: if(!inherits(nfit, "try-error") && nfit$convergence$code >= 0) { ans[i + 1L, ] <- c(nfit$edf, nfit$logLik, AIC(nfit)) nnew <- nobs(nfit) if (all(is.finite(c(n0, nnew))) && nnew != n0) stop("number of rows in use has changed: remove missing values?") } } dfs <- ans[, 1L] - ans[1L, 1L] dfs[1L] <- NA aod <- data.frame(Df = dfs, logLik = ans[, 2L], AIC = ans[, 3L]) rownames(aod) <- rownames(ans) ## compute likelihood ratio statistic and p-values: LR <- 2*(ans[, 2L] - ans[1L, 2L]) LR[1L] <- NA nas <- !is.na(LR) P <- LR P[nas] <- pchisq(LR[nas], dfs[nas], lower.tail = FALSE) aod[, c("LRT", "Pr(>Chi)")] <- list(LR, P) head <- c("Tests of scale effects", paste("\nformula:", Deparse(formula(object$terms)))) if(!is.null(object$call$scale)) head <- c(head, paste("scale: ", Deparse(formula(object$S.terms)))) if(!is.null(object$call$nominal)) head <- c(head, paste("nominal:", Deparse(formula(object$nom.terms)))) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } ordinal/R/gumbel.R0000644000176200001440000000746315127777530013531 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## [pdqrg]gumbel functions for the gumbel distribution. ## Here ggumbel is the gradient of the density function, dgumbel. pgumbel <- function(q, location = 0, scale = 1, lower.tail = TRUE, max = TRUE) ### CDF for Gumbel max and min distributions ### Currently only unit length location and scale are supported. { if(max) ## right skew, loglog link .C("pgumbel_C", q = as.double(q), length(q), as.double(location)[1], as.double(scale)[1], as.integer(lower.tail), NAOK = TRUE)$q else ## left skew, cloglog link .C("pgumbel2_C", q = as.double(q), length(q), as.double(location)[1], as.double(scale)[1], as.integer(lower.tail), NAOK = TRUE)$q } pgumbelR <- function(q, location = 0, scale = 1, lower.tail = TRUE) ### R equivalent of pgumbel() { q <- (q - location)/scale p <- exp(-exp(-q)) if (!lower.tail) 1 - p else p } pgumbel2R <- function(q, location = 0, scale = 1, lower.tail = TRUE) { q <- (-q - location)/scale p <- exp(-exp(-q)) if (!lower.tail) p else 1 - p } dgumbel <- function(x, location = 0, scale = 1, log = FALSE, max = TRUE) ### PDF for the Gumbel max and mon distributions { if(max) ## right skew, loglog link .C("dgumbel_C", x = as.double(x), length(x), as.double(location)[1], as.double(scale)[1], as.integer(log), NAOK = TRUE)$x else ## left skew, cloglog link .C("dgumbel2_C", x = as.double(x), length(x), as.double(location)[1], as.double(scale)[1], as.integer(log), NAOK = TRUE)$x } dgumbelR <- function(x, location = 0, scale = 1, log = FALSE) ### dgumbel in R { q <- (x - location)/scale log.d <- -exp(-q) - q - log(scale) if (!log) exp(log.d) else log.d } dgumbel2R <- function(x, location = 0, scale = 1, log = FALSE) { q <- (-x - location)/scale log.d <- -exp(-q) - q - log(scale) if (!log) exp(log.d) else log.d } ggumbel <- function(x, max = TRUE) { ### gradient of dgumbel(x) wrt. x if(max) ## right skew, loglog link .C("ggumbel_C", x = as.double(x), length(x), NAOK = TRUE)$x else ## left skew, cloglog link .C("ggumbel2_C", x = as.double(x), length(x), NAOK = TRUE)$x } ggumbelR <- function(x){ ### ggumbel in R q <- exp(-x) ifelse(q == Inf, 0, { eq <- exp(-q) -eq*q + eq*q*q }) } ggumbel2R <- function(x) -ggumbelR(-x) rgumbel <- function(n, location = 0, scale = 1, max = TRUE) { if(max) location - scale * log(-log(runif(n))) else location + scale * log(-log(runif(n))) } qgumbel <- function(p, location = 0, scale = 1, lower.tail = TRUE, max = TRUE) { if(!lower.tail) p <- 1 - p if(max) ## right skew, loglog link location - scale * log(-log(p)) else ## left skew, cloglog link location + scale * log(-log(1 - p)) } ordinal/R/clmm.R0000644000176200001440000007707415127777530013213 0ustar liggesusers############################################################################# ## Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen ## ## This file is part of the ordinal package for R (*ordinal*) ## ## *ordinal* is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## (at your option) any later version. ## ## *ordinal* 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 ## and/or ## . ############################################################################# ## This file contains: ## Implementation of Cumulative Link Mixed Models in clmm(). if(getRversion() >= '2.15.1') utils::globalVariables(c("ths", "link", "threshold", "optRes", "neval", "Niter", "tJac", "y.levels")) clmm <- function(formula, data, weights, start, subset, na.action, contrasts, Hess = TRUE, model = TRUE, link = c("logit", "probit", "cloglog", "loglog", "cauchit"), ##, "Aranda-Ordaz", "log-gamma"), ## lambda, doFit = TRUE, control = list(), nAGQ = 1L, threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) { ### Extract the matched call and initial testing: mc <- match.call(expand.dots = FALSE) ### OPTION: Possibly call clm() when there are no random effects? link <- match.arg(link) threshold <- match.arg(threshold) if(missing(formula)) stop("Model needs a formula") if(missing(contrasts)) contrasts <- NULL ## set control parameters: control <- getCtrlArgs(control, list(...)) nAGQ <- as.integer(round(nAGQ)) formulae <- clmm.formulae(formula=formula) ## mf, y, X, wts, off, terms: frames <- clmm.frames(modelcall=mc, formulae=formulae, contrasts) ### QUEST: What should 'method="model.frame"' return? Do we want Zt ### included here as well? if(control$method == "model.frame") return(frames) ## Test rank deficiency and possibly drop some parameters: ## X is guarantied to have an intercept at this point. frames$X <- drop.coef(frames$X, silent=FALSE) ## Compute the transpose of the Jacobian for the threshold function, ## tJac and the names of the threshold parameters, alpha.names: ths <- makeThresholds(levels(frames$y), threshold) ## Set rho environment: rho <- with(frames, { clm.newRho(parent.frame(), y=y, X=X, weights=wts, offset=off, tJac=ths$tJac) }) ## compute grouping factor list, and Zt and ST matrices: retrms <- getREterms(frames = frames, formulae$formula) ## For each r.e. term, test if Z has more columns than rows to detect ## unidentifiability: test_no_ranef(Zt_list=retrms$retrms, frames=frames, checkRanef=control$checkRanef) ### OPTION: save (the evaluated) formula in frames, so we only need the ### frames argument to getREterms() ? use.ssr <- (retrms$ssr && !control$useMatrix) ## Set inverse link function and its two first derivatives (pfun, ## dfun and gfun) in rho: setLinks(rho, link) ## Compute list of dimensions for the model fit: rho$dims <- getDims(frames=frames, ths=ths, retrms=retrms) ## Update model environment with r.e. information: if(use.ssr) { rho.clm2clmm.ssr(rho=rho, retrms = retrms, ctrl=control$ctrl) ## Set starting values for the parameters: if(missing(start)) start <- c(fe.start(frames, link, threshold), 0) rho$par <- start nbeta <- rho$nbeta <- ncol(frames$X) - 1 ## no. fixef parameters nalpha <- rho$nalpha <- ths$nalpha ## no. threshold parameters ntau <- rho$ntau <- length(retrms$gfList) ## no. variance parameters stopifnot(is.numeric(start) && length(start) == (nalpha + nbeta + ntau)) } else { rho.clm2clmm(rho=rho, retrms=retrms, ctrl=control$ctrl) if(missing(start)) { rho$fepar <- fe.start(frames, link, threshold) rho$ST <- STstart(rho$ST) start <- c(rho$fepar, ST2par(rho$ST)) } else { stopifnot(is.list(start) && length(start) == 2) stopifnot(length(start[[1]]) == rho$dims$nfepar) stopifnot(length(start[[2]]) == rho$dims$nSTpar) rho$fepar <- as.vector(start[[1]]) rho$ST <- par2ST(as.vector(start[[2]]), rho$ST) } } ### OPTION: set starting values in a more elegant way. ## Set AGQ parameters: set.AGQ(rho, nAGQ, control, use.ssr) ## Possibly return the environment, rho without fitting: if(!doFit) return(rho) ## Fit the clmm: fit <- if(use.ssr) clmm.fit.ssr(rho, control = control$optCtrl, method=control$method, Hess) else clmm.fit.env(rho, control = control$optCtrl, method=control$method, Hess) ## Modify and return results: fit$nAGQ <- nAGQ fit$link <- link fit$start <- start fit$threshold <- threshold fit$call <- match.call() fit$formula <- formulae$formula fit$gfList <- retrms$gfList fit$control <- control res <- clmm.finalize(fit=fit, frames=frames, ths=ths, use.ssr) ## add model.frame to results list? if(model) res$model <- frames$mf return(res) } clmm.formulae <- function(formula) { ## Evaluate the formula in the enviroment in which clmm was called ## (parent.frame(2)) to get it evaluated properly: form <- eval.parent(formula, 2) ## get the environment of the formula. If this does not have an ## environment (it could be a character), then use the calling environment. form.envir <- if(!is.null(env <- environment(form))) env else parent.frame(2) ## ensure 'formula' is a formula-object: form <- tryCatch(formula(if(is.character(form)) form else Deparse(form), env = form.envir), error = identity) ## report error if the formula cannot be interpreted if(inherits(form, "error")) stop("unable to interpret 'formula'") environment(form) <- form.envir ## Construct a formula with all (fixed and random) variables ## (fullForm) and a formula with only fixed-effects variables ## (fixedForm): fixedForm <- nobars(form) ## ignore terms with '|' # Handle case where formula is only response ~ RE: fixedForm <- if(length(fixedForm) == 1 || !inherits(fixedForm, "formula")) reformulate("1", response = form[[2]], env=form.envir) else fixedForm fullForm <- subbars(form) # substitute `+' for `|' ## Set the appropriate environments: environment(fullForm) <- environment(fixedForm) <- environment(form) <- form.envir list(formula = form, fullForm = fullForm, fixedForm = fixedForm) } clmm.frames <- function(modelcall, formulae, contrasts) { ## Extract full model.frame (fullmf): m <- match(c("data", "subset", "weights", "na.action", "offset"), names(modelcall), 0) mf <- modelcall[c(1, m)] mf$formula <- formulae$fullForm mf$drop.unused.levels <- TRUE mf[[1]] <- as.name("model.frame") fixedmf <- mf ## save call for later modification and evaluation fullmf <- eval(mf, envir = parent.frame(2)) ## '2' to get out of ## clmm.frames and clmm ### OPTION: Consider behavior if data is a matrix? fixedmf$formula <- formulae$fixedForm fixedmf <- eval(fixedmf, envir = parent.frame(2)) attr(fullmf, "terms") <- attr(fixedmf, "terms") ## return: list(mf = fullmf, y = getY(fullmf), X = getX(fullmf, fixedmf, contrasts), wts = getWeights(fullmf), off = getOffsetStd(fullmf), terms = attr(fixedmf, "terms") ) } getY <- function(mf) { ### Extract model response: y <- model.response(mf) if(!is.factor(y)) stop("response needs to be a factor") y } getX <- function(fullmf, fixedmf, contrasts) { fixedTerms <- attr(fixedmf, "terms") X <- model.matrix(fixedTerms, fullmf, contrasts) n <- nrow(X) ## remove intercept from X: Xint <- match("(Intercept)", colnames(X), nomatch = 0) if(Xint <= 0) { X <- cbind("(Intercept)" = rep(1, n), X) warning("an intercept is needed and assumed") } ## intercept in X is garanteed. X } getZt <- function(retrms) { ZtList <- lapply(retrms, '[[', "Zt") Zt <- do.call(rbind, ZtList) Zt@Dimnames <- vector("list", 2) Zt } getREterms <- function(frames, formula) { ### NOTE: Need to parse mf - not just fullmf because we need the model ### fits for an identifiability check below. fullmf <- droplevels(with(frames, mf[wts > 0, ])) barlist <- expandSlash(findbars(formula[[3]])) ### NOTE: make sure 'formula' is appropriately evaluated and returned ### by clmm.formulae if(!length(barlist)) stop("No random effects terms specified in formula") term.names <- unlist(lapply(barlist, function(x) Deparse(x))) names(barlist) <- unlist(lapply(barlist, function(x) Deparse(x[[3]]))) ### NOTE: Deliberately naming the barlist elements by grouping factors ### and not by r.e. terms. ## list of grouping factors for the random terms: rel <- lapply(barlist, function(x) { ff <- eval(substitute(as.factor(fac)[,drop = TRUE], list(fac = x[[3]])), fullmf) ## per random term transpose indicator matrix: Zti <- as(ff, "sparseMatrix") ## per random term model matrix: mm <- model.matrix(eval(substitute(~ expr, list(expr = x[[2]]))), fullmf) Zt = do.call(rbind, lapply(seq_len(ncol(mm)), function(j) { Zti@x <- mm[,j] Zti } )) ### QUEST: can we drop rows from Zt when g has missing values in terms ### of the form (1 + g | f)? ST <- matrix(0, ncol(mm), ncol(mm), dimnames = list(colnames(mm), colnames(mm))) list(f = ff, Zt = Zt, ST = ST) ### OPTION: return the i'th element of Lambda here. }) q <- sum(sapply(rel, function(x) nrow(x$Zt))) ### OPTION: If the model is nested (all gr.factors are nested), then ### order the columns of Zt, such that they come in blocks ### corresponding to the levels of the coarsest grouping factor. Each ### block of Zt-columns contain first the j'th level of the 1st gr.fac. ### followed by columns for the 2nd gr.fac. ### ## single simple random effect on the intercept? ssr <- (length(barlist) == 1 && as.character(barlist[[1]][[2]])[1] == "1") ## order terms by decreasing number of levels in the factor but don't ## change the order if this is already true: nlev <- sapply(rel, function(re) nlevels(re$f)) if (any(diff(nlev)) > 0) rel <- rel[rev(order(nlev))] nlev <- nlev[rev(order(nlev))] ## separate r.e. terms from the factor list: retrms <- lapply(rel, "[", -1) names(retrms) <- term.names ## list of grouping factors: gfl <- lapply(rel, "[[", "f") ## which r.e. terms are associated with which grouping factors: attr(gfl, "assign") <- seq_along(gfl) ## only save unique g.f. and update assign attribute: fnms <- names(gfl) ## check for repeated factors: if (length(fnms) > length(ufn <- unique(fnms))) { ## check that the lengths of the number of levels coincide gfl <- gfl[match(ufn, fnms)] attr(gfl, "assign") <- match(fnms, ufn) names(gfl) <- ufn } ## test that all variables for the random effects are factors and ## have at least 3 levels: stopifnot(all(sapply(gfl, is.factor))) stopifnot(all(sapply(gfl, nlevels) > 2)) ## no. r.e. per level for each of the r.e. terms qi <- unlist(lapply(rel, function(re) ncol(re$ST))) stopifnot(q == sum(nlev * qi)) dims <- list(n = nrow(fullmf), ## no. observations nlev.re = nlev, ## no. levels for each r.e. term nlev.gf = sapply(gfl, nlevels), ## no. levels for each grouping factor qi = qi, nretrms = length(rel), ## no. r.e. terms ngf = length(gfl), ## no. unique grouping factors ## total no. random effects: q = sum(nlev * qi), ## = sum(sapply(rel, function(re) nrow(re$Zt))) ## no. r.e. var-cov parameters: nSTpar = sum(sapply(qi, function(q) q * (q + 1) / 2)) ) ## c(retrms=retrms, list(gfList = gfl, dims = dims, ssr = ssr)) list(retrms=retrms, gfList = gfl, dims = dims, ssr = ssr) } test_no_ranef <- function(Zt_list, frames, checkRanef=c("warn", "error", "message")) { ## For each r.e. term, test if Z has more columns than rows to detect ## unidentifiability: checkfun <- switch(checkRanef, "warn" = function(...) warning(..., call.=FALSE), "error" = function(...) stop(..., call.=FALSE), "message" = message) nrow_fullmf <- with(frames, nrow(mf[wts > 0, ])) REterm.names <- names(Zt_list) for(i in seq_along(Zt_list)) { Zti <- Zt_list[[i]][["Zt"]] if(nrow(Zti) > ncol(Zti) || (all(frames$wts == 1) && nrow(Zti) == ncol(Zti))) checkfun(gettextf("no. random effects (=%d) >= no. observations (=%d) for term: (%s)", nrow(Zti), ncol(Zti), REterm.names[i])) } ## Test if total no. random effects >= total nobs: q <- sum(sapply(Zt_list, function(x) nrow(x$Zt))) if(all(frames$wts == 1) && q >= nrow_fullmf) checkfun(gettextf("no. random effects (=%d) >= no. observations (=%d)", q, nrow_fullmf)) invisible(NULL) ### NOTE: q > nrow(fullmf) is (sometimes) allowed if some frames$wts > 1 ### ### NOTE: if all(frames$wts == 1) we cannot have observation-level ### random effects so we error if nrow(Zti) >= ncol(Zti) ### ### NOTE: Could probably also throw an error if q >= sum(frames$wts), ### but I am not sure about that. ### ### NOTE: It would be better to test the rank of the Zt matrix, but ### also computationally more intensive. ### } fe.start <- function(frames, link, threshold) { ## get starting values from clm: fit <- with(frames, clm.fit(y=y, X=X, weights=wts, offset=off, link=link, threshold=threshold)) unname(coef(fit)) } getDims <- function(frames, ths, retrms) ### Collect and compute all relevant dimensions in a list { dims <- retrms$dims ## n is also on retrms$dims dims$n <- sum(frames$wts > 0) dims$nbeta <- ncol(frames$X) - 1 dims$nalpha <- ths$nalpha dims$nfepar <- dims$nalpha + dims$nbeta dims } rho.clm2clmm <- function(rho, retrms, ctrl) ### update environment, rho returned by clm.newRho(). { ### OPTION: write default list of control arguments? ## control arguments are used when calling update.u(rho) rho$ctrl = ctrl ## compute Zt design matrix: rho$Zt <- getZt(retrms$retrms) rho$ST <- lapply(retrms$retrms, `[[`, "ST") rho$allST1 <- all(sapply(rho$ST, ncol) == 1) ## Lambda <- getLambda(rho$ST, rho$dims$nlev.re) ## Vt <- crossprod(Lambda, rho$Zt) ## rho$L <- Cholesky(tcrossprod(Vt), ## LDL = TRUE, super = FALSE, Imult = 1) rho$L <- Cholesky(tcrossprod(crossprod(getLambda(rho$ST, rho$dims$nlev.re), rho$Zt)), LDL = TRUE, super = FALSE, Imult = 1) rho$Niter <- 0L ## no. conditional mode updates rho$neval <- 0L ## no. evaluations of the log-likelihood function rho$u <- rho$uStart <- rep(0, rho$dims$q) rho$.f <- if(package_version(packageDescription("Matrix")$Version) > "0.999375-30") 2 else 1 } getLambda <- function(ST, nlev) { ### ST: a list of ST matrices ### nlev: a vector of no. random effects levels .local <- function(ST, nlev) { if(ncol(ST) == 1) .symDiagonal(n=nlev, x = rep(as.vector(ST[1, 1]), nlev)) else kronecker(as(ST, "sparseMatrix"), .symDiagonal(n=nlev)) ## This would make sense if the columns in Z (rows in Zt) were ordered differently: ## kronecker(Diagonal(n=nlev), ST) ### NOTE: .symDiagonal() appears to be faster than Diagonal() here. } stopifnot(length(ST) == length(nlev)) res <- if(length(ST) == 1) .local(ST[[1]], nlev) else .bdiag(lapply(seq_along(ST), function(i) .local(ST[[i]], nlev[i]))) ## coerce to diagonal matrix if relevant: if(all(sapply(ST, ncol) == 1)) as(res, "diagonalMatrix") else as(res, "CsparseMatrix") ### QUESTION: Are there any speed gains by coerce'ing Lambda to ### 'diagonalMatrix' or 'CsparseMatrix'? ### QUESTION: What is the best way to form the kronecker product in .local()? } getNLA <- function(rho, par, which=rep(TRUE, length(par))) { ### negative log-likelihood by the Laplace approximation if(!missing(par)) { setPar.clmm(rho, par, which) if(any(!is.finite(par))) stop(gettextf(paste(c("Non-finite parameters not allowed:", formatC(par, format="g")), collapse=" "))) } rho$neval <- rho$neval + 1L if(!update.u(rho)) return(Inf) if(any(rho$D < 0)) return(Inf) logDetD <- c(suppressWarnings(determinant(rho$L)$modulus)) - rho$dims$q * log(2*pi) / 2 rho$nll + logDetD } nll.u <- function(rho) { ## negative log-likelihood if(rho$allST1) { ## are all ST matrices scalars? rho$varVec <- rep.int(unlist(rho$ST), rho$dims$nlev.re) b.expanded <- as.vector(crossprod(rho$Zt, rho$varVec * rho$u)) ### NOTE: Working with Lambda when it is diagonal will slow things ### down significantly. } else { rho$ZLt <- crossprod(getLambda(rho$ST, rho$dims$nlev.re), rho$Zt) b.expanded <- as.vector(crossprod(rho$ZLt, rho$u)) } rho$eta1Fix <- drop(rho$B1 %*% rho$fepar) rho$eta2Fix <- drop(rho$B2 %*% rho$fepar) rho$eta1 <- as.vector(rho$eta1Fix - b.expanded + rho$o1) rho$eta2 <- as.vector(rho$eta2Fix - b.expanded + rho$o2) rho$fitted <- getFittedC(rho$eta1, rho$eta2, rho$link) if(any(!is.finite(rho$fitted)) || any(rho$fitted <= 0)) nll <- Inf else nll <- -sum(rho$wts * log(rho$fitted)) - sum(dnorm(x=rho$u, mean=0, sd=1, log=TRUE)) nll } nllFast.u <- function(rho) { ## negative log-likelihood ## Does not update X %*% beta - fixed effect part. if(rho$allST1) { rho$varVec <- rep.int(unlist(rho$ST), rho$dims$nlev.re) b.expanded <- as.vector(crossprod(rho$Zt, rho$varVec * rho$u)) } else { rho$ZLt <- crossprod(getLambda(rho$ST, rho$dims$nlev.re), rho$Zt) b.expanded <- as.vector(crossprod(rho$ZLt, rho$u)) } rho$eta1 <- as.vector(rho$eta1Fix - b.expanded + rho$o1) rho$eta2 <- as.vector(rho$eta2Fix - b.expanded + rho$o2) rho$fitted <- getFittedC(rho$eta1, rho$eta2, rho$link) if(any(!is.finite(rho$fitted)) || any(rho$fitted <= 0)) nll <- Inf else nll <- -sum(rho$wts * log(rho$fitted)) - sum(dnorm(x=rho$u, mean=0, sd=1, log=TRUE)) nll } grad.u <- function(rho){ ## gradient of nll wrt. u (random effects) ### should only be called with up to date values of eta1, eta2, par ## compute phi1: rho$p1 <- rho$dfun(rho$eta1) rho$p2 <- rho$dfun(rho$eta2) rho$wtpr <- rho$wts/rho$fitted phi1 <- as.vector(rho$wtpr * (rho$p1 - rho$p2)) if(rho$allST1) (rho$Zt %*% phi1) * rho$varVec + rho$u else rho$ZLt %*% phi1 + rho$u } hess.u <- function(rho) { ## Hessian of nll wrt. u (random effects) ### should only be called with up-to-date values of eta1, eta2, par, ### p1, p2 g1 <- rho$gfun(rho$eta1) ## does not need to be saved in rho g2 <- rho$gfun(rho$eta2) ## does not need to be saved in rho phi2 <- rho$wts * ( ((rho$p1 - rho$p2) / rho$fitted)^2 - ( (g1 - g2) / rho$fitted) ) ## This may happen if the link function [pfun, dfun and gfun] ## evaluates its arguments inaccurately: if(any(phi2 < 0)) return(FALSE) if(rho$allST1) Vt <- crossprod(Diagonal(x = rho$varVec), tcrossprod(rho$Zt, Diagonal(x = sqrt(phi2)))) else Vt <- rho$ZLt %*% Diagonal(x = sqrt(phi2)) rho$L <- update(rho$L, Vt, mult = 1) return(TRUE) } getPar.clmm <- function(rho) ### Extract vector of parameters from model-environment rho c(rho$fepar, ST2par(rho$ST)) setPar.clmm <- function(rho, par, which=rep(TRUE, length(par))) { ### Set parameters in model environment rho. which <- as.logical(as.vector(which)) oldpar <- getPar.clmm(rho) stopifnot(length(which) == length(oldpar)) stopifnot(sum(which) == length(par)) ## over-wright selected elements of oldpar: oldpar[which] <- as.vector(par) ## assign oldpar to rho$fepar and rho$ST: rho$fepar <- oldpar[1:rho$dims$nfepar] rho$ST <- par2ST(oldpar[-(1:rho$dims$nfepar)], rho$ST) } ST2par <- function(STlist) { ### Compute parameter vector from list of ST matrices. unlist(lapply(STlist, function(ST) { ## if(ncol(ST) == 1) as.vector(ST) else as.vector(c(diag(ST), ST[lower.tri(ST)])) })) } par2ST <- function(STpar, STlist) { ### Fill in parameters in list of ST matrices. Reverse of ST2par(). nc <- sapply(STlist, ncol) asgn <- rep(1:length(nc), sapply(nc, function(qi) qi * (qi + 1) / 2)) STparList <- split(STpar, asgn) stopifnot(length(asgn) == length(ST2par(STlist))) for(i in 1:length(STlist)) { par <- STparList[[i]] if(nc[i] > 1) { diag(STlist[[i]]) <- par[1:nc[i]] STlist[[i]][lower.tri(STlist[[i]])] <- par[-(1:nc[i])] } else { STlist[[i]][] <- par } } STlist } STatBoundary <- function(STpar, STlist, tol=1e-3) { ### Compute dummy vector of which ST parameters are at the ### boundary of the parameters space (variance-parameters that are ### zero). STcon <- STconstraints(STlist) stopifnot(length(STpar) == length(STcon)) as.integer(STcon == 1 & STpar <= tol) } paratBoundary <- function(rho, tol=1e-3) ### Compute dummy vector of which parameters are at the boundary of ### the parameter space. c(rep(0, rho$dims$nfepar), STatBoundary(ST2par(rho$ST), rho$ST, tol)) paratBoundary2 <- function(rho, tol=1e-3) { STcon <- STconstraints(rho$ST) c(rep(0L, rho$dims$nfepar), as.integer(STcon == 1 & ST2par(rho$ST) < tol)) } STconstraints <- function(STlist) { ### Compute indicator vector of which variance parameters are constrained above zero. The ### variance parameters are non-negative, while the covariance parameters are not ### constrained. ### ### This function can also be used to generate starting values for the covar. parameters. nc <- sapply(STlist, ncol) unlist(lapply(nc, function(qi) { c(rep(1L, qi), rep(0L, qi * (qi - 1) / 2)) } )) } parConstraints <- function(rho) ### Returns a dummy vector of the same length as getPar.clmm(rho) ### indicating which parameters are contrained to be non-negative. c(rep(0, rho$dims$nfepar), STconstraints(rho$ST)) STstart <- function(STlist) par2ST(STconstraints(STlist), STlist) isNested <- function(f1, f2) ### Borrowed from lme4/R/lmer.R ### Checks if f1 is nested within f2. { f1 <- as.factor(f1) f2 <- as.factor(f2) stopifnot(length(f1) == length(f2)) sm <- as(new("ngTMatrix", i = as.integer(f2) - 1L, j = as.integer(f1) - 1L, Dim = c(length(levels(f2)), length(levels(f1)))), "CsparseMatrix") all(diff(sm@p) < 2) } set.AGQ <- function(rho, nAGQ, control, ssr) { ## Stop if arguments are incompatible: if(nAGQ != 1 && !ssr) stop("Quadrature methods are not available with more than one random effects term", call.=FALSE) if(nAGQ != 1 && control$useMatrix) stop("Quadrature methods are not available with 'useMatrix = TRUE'", call.=FALSE) rho$nAGQ <- nAGQ if(nAGQ %in% 0:1) return(invisible()) ghq <- gauss.hermite(abs(nAGQ)) rho$ghqns <- ghq$nodes rho$ghqws <- if(nAGQ > 0) ghq$weights ## AGQ else log(ghq$weights) + (ghq$nodes^2)/2 ## GHQ } clmm.fit.env <- function(rho, control = list(), method=c("nlminb", "ucminf"), Hess = FALSE) ### Fit the clmm by optimizing the Laplace likelihood. ### Returns a list with elements: ### ### coefficients ### ST ### logLik ### Niter ### dims ### u ### optRes ### fitted.values ### L ### Zt ### ranef ### condVar ### gradient ### (Hessian) { method <- match.arg(method) if(method == "ucminf") warning("cannot use ucminf optimizer for this model, using nlminb instead") ## Compute lower bounds on the parameter vector lwr <- c(-Inf, 0)[parConstraints(rho) + 1] ## hack to remove ucminf control settings: keep <- !names(control) %in% c("grad", "grtol") control <- if(length(keep)) control[keep] else list() ## Fit the model with Laplace: fit <- try(nlminb(getPar.clmm(rho), function(par) getNLA(rho, par), lower=lwr, control=control), silent=TRUE) ### OPTION: Make it possible to use the ucminf optimizer with ### log-transformed std-par instead. ## Check if optimizer converged without error: if(inherits(fit, "try-error")) stop("optimizer ", method, " failed to converge", call.=FALSE) ### OPTION: Could have an argument c(warn, fail, ignore) to optionally ### return the fitted model despite the optimizer failing. ## Ensure parameters in rho are set at the optimum: setPar.clmm(rho, fit$par) ## Ensure random mode estimation at optimum: nllFast.u(rho) update.u(rho) names(rho$ST) <- names(rho$dims$nlev.re) ## Prepare list of results: res <- list(coefficients = fit$par[1:rho$dims$nfepar], ST = rho$ST, logLik = -fit$objective, dims = rho$dims, ### OPTION: Should we evaluate hess.u(rho) to make sure rho$L contains ### the right values corresponding to the optimum? u = rho$u, optRes = fit, fitted.values = rho$fitted, L = rho$L, Zt = rho$Zt ) ## save ranef and condVar in res: if(rho$allST1) { res$ranef <- rep.int(unlist(rho$ST), rho$dims$nlev.re) * rho$u res$condVar <- as.vector(diag(solve(rho$L)) * rep.int(unlist(rho$ST)^2, rho$dims$nlev.re)) } else { Lambda <- getLambda(rho$ST, rho$dims$nlev.re) res$ranef <- Lambda %*% rho$u res$condVar <- tcrossprod(Lambda %*% solve(rho$L), Lambda) } ## Add gradient vector and optionally Hessian matrix: bound <- as.logical(paratBoundary2(rho)) optpar <- fit$par[!bound] if(Hess) { ### NOTE: This is the Hessian evaluated for all parameters that are ### not at the boundary at the parameter space. The likelihood for ### models with boundary parameters is still defined as a function of ### all the parameters, so standard errors will differ whether or not ### boundary terms are included or not. gH <- deriv12(function(par) getNLA(rho, par, which=!bound), x=optpar) res$gradient <- gH$gradient res$Hessian <- gH$Hessian } else { res$gradient <- grad.ctr(function(par) getNLA(rho, par, which=!bound), x=optpar) } ### OPTION: We could check that the (forward) gradient for variances at the ### boundary are not < -1e-5 (wrt. -logLik/nll/getNLA) ## Setting Niter and neval after gradient and Hessian evaluations: res$Niter <- rho$Niter res$neval <- rho$neval ## return value: res } update.u <- function(rho) { stepFactor <- 1 innerIter <- 0 rho$u <- rho$uStart rho$nll <- nll.u(rho) if(!is.finite(rho$nll)) return(FALSE) rho$gradient <- grad.u(rho) maxGrad <- max(abs(rho$gradient)) conv <- -1 ## Convergence flag message <- "iteration limit reached when updating the random effects" if(rho$ctrl$trace > 0) Trace(iter=0, stepFactor, rho$nll, maxGrad, rho$u, first=TRUE) ## Newton-Raphson algorithm: for(i in 1:rho$ctrl$maxIter) { if(maxGrad < rho$ctrl$gradTol) { message <- "max|gradient| < tol, so current iterate is probably solution" if(rho$ctrl$trace > 0) cat("\nOptimizer converged! ", "max|grad|:", maxGrad, message, fill = TRUE) conv <- 0 break } if(!hess.u(rho)) return(FALSE) step <- as.vector(solve(rho$L, rho$gradient)) rho$u <- rho$u - stepFactor * step nllTry <- nllFast.u(rho) ## no 'X %*% beta' update lineIter <- 0 ## Step halfing: while(nllTry > rho$nll) { stepFactor <- stepFactor/2 rho$u <- rho$u + stepFactor * step nllTry <- nllFast.u(rho) ## no 'X %*% beta' update lineIter <- lineIter + 1 if(rho$ctrl$trace > 0) Trace(i+innerIter, stepFactor, rho$nll, maxGrad, rho$u, first=FALSE) if(lineIter > rho$ctrl$maxLineIter){ message <- "step factor reduced below minimum when updating the random effects" conv <- 1 break } innerIter <- innerIter + 1 } rho$nll <- nllTry rho$gradient <- grad.u(rho) maxGrad <- max(abs(rho$gradient)) if(rho$ctrl$trace > 0) Trace(i+innerIter, stepFactor, rho$nll, maxGrad, rho$u, first=FALSE) stepFactor <- min(1, 2 * stepFactor) } if(conv != 0 && rho$ctrl$innerCtrl == "warnOnly") { warning(message, "\n at iteration ", rho$Niter) utils::flush.console() } else if(conv != 0 && rho$ctrl$innerCtrl == "giveError") stop(message, "\n at iteration ", rho$Niter) rho$Niter <- rho$Niter + i - 1 if(!hess.u(rho)) return(FALSE) if(!is.finite(rho$nll)) return(FALSE) else return(TRUE) } clmm.finalize <- function(fit, frames, ths, use.ssr) { fit$tJac <- ths$tJac fit$contrasts <- attr(frames$X, "contrasts") fit$na.action <- attr(frames$mf, "na.action") fit$terms <- frames$terms ### QUEST: Should the terms object contain only the fixed effects ### terms? fit$xlevels <- .getXlevels(frames$terms, frames$mf) fit$y.levels <- levels(frames$y) fit <- within(fit, { ## extract coefficients from 'fit': names(coefficients) <- names(gradient) <- c(ths$alpha.names, colnames(frames$X)[-1]) alpha <- coefficients[1:dims$nalpha] beta <- if(dims$nbeta > 0) coefficients[dims$nalpha + 1:dims$nbeta] else numeric(0) ## set various fit elements: edf <- dims$edf <- dims$nfepar + dims$nSTpar dims$nobs <- sum(frames$wts) dims$df.residual <- dims$nobs - dims$edf Theta <- alpha %*% t(tJac) nm <- paste(y.levels[-length(y.levels)], y.levels[-1], sep="|") dimnames(Theta) <- list("", nm) rm(nm) info <- data.frame("link" = link, "threshold" = threshold, "nobs" = dims$nobs, "logLik" = formatC(logLik, digits=2, format="f"), "AIC" = formatC(-2*logLik + 2*dims$edf, digits=2, format="f"), ## "niter" = paste(optRes$info["neval"], "(", Niter, ")", ## sep=""), "niter" = paste(neval, "(", Niter, ")", sep=""), "max.grad" = formatC(max(abs(gradient)), digits=2, format="e") ## BIC is not part of output since it is not clear what ## the no. observations are. ) }) bound <- if(use.ssr) rep(FALSE, fit$dims$edf) else as.logical(paratBoundary2(fit)) dn <- c(names(fit$coefficients), paste("ST", seq_len(fit$dims$nSTpar), sep=""))[!bound] names(fit$gradient) <- dn if(!is.null(fit$Hessian)) dimnames(fit$Hessian) <- list(dn, dn) ## set class and return fit: class(fit) <- "clmm" return(fit) } ordinal/NEWS0000644000176200001440000002717715125475162012427 0ustar liggesusersThis file documents updates and changes in package ordinal since version 2010.03-04 March 04 2010: - First version of the package is created. 2010-04-06: - removing class "clm.fit" from results of finalizeRho. - moving offset computations from logLik and gradient funtions to newRho function. - Bug fixed in grad.lambda - checks and warning messages added to profile.clm - a warning is now given if the profile fits do not converge - profile.clm has grown the argument 'stepWarn', which gives a warning if the no. profile steps in each direction (up or down) is less than stepWarn (default 8), which indicates that the profile is unreliable. - Bug in loglog-link for clmm fits fixed. - Missing values are handled better in clm and clmm. - clmm has grown an argument 'sdFixed' which assigns a fixed value of the standard deviation of the random effects. Optimization is performed with respect to the remaining parameters. - profile.clmm, confint.profile.clmm and plot.profile.clmm are now available. Profiling is restricted to the standard deviation parameter of the random effects. - control.clm and control.clmm now handles the control parameters. 2010-05-06: - allowing the formulas to be constructed outside clm and clmm (the formulas are evaluated in the parent frame before the variable names are extracted) 2010-05-17: - Better evaluation in case of non-standard formula usage allowing e.g. clm(data$y ~ data$x). - Better handling of ill-defined variance-covariance matrix of the parameters in summary methods for clm and clmm objects. 2010-06-12: - Standard Gauss-Hermite quadrature is now available via the nAGQ argument to clmm. - Core functions implemented in C for speed. This includes all link functions, update of the conditional modes of the random effects, adaptive Gauss-Hermite quadrature and standard, i.e. non-adaptive Gauss-Hermite quadrature. Select R or C implementation via the argument doFit to clmm. - Bug in random effects estimates and their conditional modes corrected. 2010-07-06: - Bug in predict when 'newdata' was supplied is now corrected. 2010-07-23: - Better descriptions of random effect estimates and fitted values in the clmm help page. 2010-10-22: - Updated help page for predict.clm/clmm. 2010-12-13: - Bug in predict.clm corrected for models with nominal effects and newdata supplied (thanks to Simon Blomberg for the bug report). 2011-04-21: - Better message from summary.clmm when Hess = FALSE - endpoint thresholds are now closer to infinity. This is due to a bug report from Ioannis Kosmidis (March 30, 2011); the model estimates weren't right with very large scale effects. Tests are added to testCLM.R - gradTol in clm.control now defaults to 1e-5 rather than 1e-4. convTol is retained at 1e-4, so we are asking for closer convergence than we require. - getGnll no longer returns Inf if !all(pr > 0) - link utility functions are moved from clm.R to linkUtils.R - extensive testing for NaN-specials in C-code for the link functions is added. - details section added to clmm.control.Rd with comment about using "central" gradients with the ucminf optimizer. - examples updated in confint.Rd 2012-01-19: - Changed evaluation of formula in clm to make clm more forgiving for evaluation inside other functions. 2012-05-09: - Updated evaluation of formula in clmm, cf. resent update of clm. 2012-05-22: - Better evaluation of fitted probabilities. This should reduce the occurance of the "sqrt(phi2) : NaNs produced" error message. - Improved evaluation of control parameters in clmm using the new function getCtrlArgs. - Better warning if intercept is attempted removed in clmm. 2012-05-23: - Adding useMatrix argument to clmm.control - Using getFitted in clm - Implementing getFittedC in C and updating C code for fit.clmm.ssr with better and faster evaluation of fitted values - Introduction of links.h, links.c and get_fitted.c in /src 2012-05-29: - Correcting formula interpretation in clm to allow for really long formulas. - Better evaluation of control arguments in clmm (adjustment of getCtrlAgs). - Adding clmm.control.R to ./test 2012-09-10: - Computing Newton step in clm with solve() rather than .Call("La_dgesv", ...) to accomodate changes in R base. 2012-09-11: - Using globalVariables() conditional on getRversion() >= '2.15.1'. 2013-03-20: - Adding symmetric2 threshold function, which restricts the latent mean in the reference group to zero. This means that the central threshold (ylev even) is zero or that the two central thresholds are equal apart from their sign (ylev uneven). 2013-04-08: - Allowing zero weights in clm unless there are no observations with a positive weight in one or more response categories. 2013-04-11: - clm now computes Theta and alpha.mat tables of thresholds and threshold-parameters if nominal effects are specified. 2013-04-17: - anova.clm and anova.clmm now tests for illegal arguments 'test' and 'type' (wish from Ben Bolker and Jonathan Dushoff) - introducing convergence code 3 in clm: Thresholds are not increasing, which can happen with nominal effects. 2013-06-21: - Allowing zero weights in clm even if an entire response category is zeroed out. 2013-07-23: - Newton-Raphson fitting algorithm for CLMs has been redesigned: clm.fit.env is now deprecated (and removed from the code base) and all fitting of CLMs take place in a new version of clm.fit.NR - Convergence assessment has been improved with a new set of convergence codes and new message handling. - clm.control has gained several arguments to accommodate this. - in clm the new function conv.check assess convergence and compute the variance-covariance matrix of the parameters. Thus vcov is always part of a clm object. - vcov.clm has been redesigned and can now compute the variance-covariance matrix with Cholesky, SVD, EIGEN and QR methods or just grap it from the clm object (default). - nominal_test and scale_test functions added: they add all terms in a model to nominal and scale formulae respectively and perform likelihood ratio tests. These functions can be helpful in model development and model/GOF testing, e.g. of non-proportional odds. - Lazy-loading of data enabled. - MASS moved from Depends to Imports. - In clm man-page the 'value' list is ordered alphabetically as are the elements in a clm object. - clmm now computes the variance-covariance matrix with the Cholesky decomposition. - makeThresholds now take ylevels rather than y as argument. - clm.control and clmm.control are moved to control.R - drop.cols has gained argument drop.scale which controls whether columns in the scale design matrix are droped if they are linearly dependent of columns in the nominal design matrix. This was previously implicitly TRUE but is now FALSE to allow fits of certain models. - The list of control arguments are now storred as part of the clm output. - weights, offset and S.offset can now be missing or NULL in clm.fit. - predict.clm now allows type="eta". 2013-08-22: - Exporting S3 print method for convergence.clm objects. 2013-08-23: - Fixing an issue in the Hessian computation for boundary fits with useMatrix=FALSE and a single scalar random-effects term. - Allowing control parameters to be passed on to nlminb (when it is used). A bug was fixed in getCtrlArgs and clmm.control now includes method="nlminb". - Adding test for no. random effects >= no. observations for each r.e. term. 2013-08-25 - changing default optimizer from ucminf to nlminb - adding grad.ctr4 to the list of gradient functions - explicitly computing the number of objective function evaluations rather than relying on the optimizer's count. - wrapping calls to optimizers in try() to catch errors that occur here - adding test for non-finite parameter values in *.ssr objective functions. - adding list of control parameters to list of clmm output. - refining test of no. random effects > no. observations. - removing ucminf control settings from clmm.control when fitting with nlminb. - fixing bug with C version of NRalgv3 (conditional mode update): Hessian (D) values are now initialized to 1 rather than 0. 2013-08-26: - registrering global variables. - removing use of ':::'. 2013-08-27: - documenting list of control parameters in clmm objects. 2013-09-27: - no longer importing numDeriv as we now use our own gradient and hessian functions - moving Matrix package from Depends to Imports 2013-10-01: - Updating convergence checking in clm.fit and simple_clm to the clm standard - Removing distinction between (non-S3/4) sclm, eclm and clm model classes 2013-10-31: - Now having 'methods' in depends since this is needed to run clmm. This was most likely only a problem when using Rscript where the methods package is not loaded by default. 2014-11-12: - Reimplementation of formula, model.frame and design matrix processing motivated by a bug in model.matrix.clm and predict.clm reported by Russell Lenth 2014-11-07 when implementing lsmeans support for clm::ordinal. 2014-11-14: - Fixing bug in convergence checking (conv.check) and added test to /tests/test.clm.convergence.R - Improved the efficiency (i.e. speed) in the evaluation of standard errors for predictions using predict.clm (based on feature request by Thomas Jagger). 2015-01-21: - Updating Citation information per CRAN request. 2015-06-28: - Updating maintainer email address 2016-12-12: - Fixing a couple of errors in CLM tutorial vignette - Correcting description of threshold argument to clmm - qgumbel did not respect it's lower.tail argument (thanks to John Fox for reporting) - Test for no. random effects less than the no. observations now gives a warning instead of an error and is now manageable via clmm.control. 2018-04-19: - Fixed insufficient protect in get_fitted - Registration of native routines (C-code) - Reduce exec time for clmm examples - change rBind -> rbind 2018-08-25: - Added sign.location and sign.nominal to clm.control() - Implemented type I, II and III type ANODE tables for clm fits - Implemented flexible link functions for clm()s - Added new article submitted to JSS as vignette and moved old vignettes to GitHub 2019-03-09: - Massage tests to check out on R-devel 2019-04-25: - Change in formula evaluation in base R prompts this update - very kindly fixed by Martin Maechler (R core) in PR#18 2019-12-11: - Get rid of S3 class checks with class() - now using inherits() instead. 2020-08-22: - Fix evaluation of long formulae in clmm - thanks to StĂ©phane Guillou, Stefan Th. Gries and Tingting Zhan for reporting. 2022-11-13: - Fix function declaration without a prototype in utilityFuns.c per CRAN request. - Add model.matrix method for clmm-objects. - Enable evaluation of anova.clmm in separate environments - thanks to Karl Ove Hufthammer for reporting and Jack Taylor for a detailed analysis and suggestion for a fix. - Allow models with an implicit intercept and only random effects in clmm(). - Fixed index in equation (7) of the clm-vignette. - Fix import of ranef and VarCorr methods from nlme and lme4 packages 2023-12-04: - Change NCOL usage because Kurt Hornik wants to change the behavior of NCOL(NULL) in base R - Names of functions clm.fit.NR, clm.fit.flex and clm.fit.optim changed to clm_fit_NR, clm_fit_flex and clm_fit_optim to avoid hiccup from CRAN checks. 2025-06-16: - Fix bug in type-3 anova tables for clm objects. Thanks to AndrĂ© Meichtry, Bern, Switzerland for reporting. 2025-12-29: - Clarifying the distinction between the unidentifiable parameters and the standardized parameters on the latent scale in Figure 1 in the clm-vignette following discussion with Michael MĂĽhlbauer. Also removing static figures and now generate them directly in the Rnw file. ordinal/vignettes/0000755000176200001440000000000015130020364013704 5ustar liggesusersordinal/vignettes/clm_article_refs.bib0000644000176200001440000003766515130020023017670 0ustar liggesusers@Misc{ordinal-pkg, title = {\pkg{ordinal}---Regression Models for Ordinal Data }, author = {R. H. B. Christensen}, year = {2025}, note = {\proglang{R} package version 2025.12-29}, url = {https://cran.r-project.org/package=ordinal/}, } @Manual{emmeans, title = {\pkg{emmeans}: Estimated Marginal Means, aka Least-Squares Means}, author = {Russell Lenth}, year = {2020}, note = {R package version 1.4.6}, url = {https://CRAN.R-project.org/package=emmeans}, } @Manual{margins, title = {\pkg{margins}: Marginal Effects for Model Objects}, author = {Thomas J. Leeper}, year = {2018}, note = {R package version 0.3.23}, } @Article{ggeffects, title = {\pkg{ggeffects}: Tidy Data Frames of Marginal Effects from Regression Models.}, volume = {3}, doi = {10.21105/joss.00772}, number = {26}, journal = {Journal of Open Source Software}, author = {Daniel LĂĽdecke}, year = {2018}, pages = {772}, } @Article{effects1, title = {Visualizing Fit and Lack of Fit in Complex Regression Models with Predictor Effect Plots and Partial Residuals}, author = {John Fox and Sanford Weisberg}, journal = {Journal of Statistical Software}, year = {2018}, volume = {87}, number = {9}, pages = {1--27}, doi = {10.18637/jss.v087.i09}, url = {https://www.jstatsoft.org/v087/i09}, } @Article{effects2, title = {Effect Displays in \proglang{R} for Multinomial and Proportional-Odds Logit Models: Extensions to the \pkg{effects} Package}, author = {John Fox and Jangman Hong}, journal = {Journal of Statistical Software}, year = {2009}, volume = {32}, number = {1}, pages = {1--24}, url = {https://www.jstatsoft.org/v32/i01/}, } @Manual{generalhoslem, title = {\pkg{generalhoslem}: Goodness of Fit Tests for Logistic Regression Models}, author = {Matthew Jay}, year = {2019}, note = {R package version 1.3.4}, url = {https://CRAN.R-project.org/package=generalhoslem}, } @article{ananth97, author = {Ananth, C V and Kleinbaum, D G}, title = "{Regression Models for Ordinal Responses: A Review of Methods and Applications.}", journal = {International Journal of Epidemiology}, volume = {26}, number = {6}, pages = {1323-1333}, year = {1997}, month = {12}, issn = {0300-5771}, doi = {10.1093/ije/26.6.1323}, url = {https://doi.org/10.1093/ije/26.6.1323}, eprint = {https://academic.oup.com/ije/article-pdf/26/6/1323/18477637/261323.pdf}, } @Article{ordinalgmifs, title = {\pkg{ordinalgmifs}: An \proglang{R} Package for Ordinal Regression in High-dimensional Data Settings}, author = {Kellie J. Archer and Jiayi Hou and Qing Zhou and Kyle Ferber and John G. Layne and Amanda Elswick Gentry}, journal = {Cancer Informatics}, year = {2014}, volume = {13}, pages = {187-195}, doi = {10.4137/CIN.S20806} } @Manual{oglmx, title = {\pkg{oglmx}: Estimation of Ordered Generalized Linear Models}, author = {Nathan Carroll}, year = {2018}, note = {R package version 3.0.0.0}, url = {https://CRAN.R-project.org/package=oglmx}, } @Article{mvord, title = {\pkg{mvord}: An \proglang{R} Package for Fitting Multivariate Ordinal Regression Models}, author = {Rainer Hirk and Kurt Hornik and Laura Vana}, journal = {Journal of Statistical Software}, year = {2020}, volume = {93}, number = {4}, pages = {1--41}, doi = {10.18637/jss.v093.i04}, } @Manual{CUB, title = {\pkg{CUB}: A Class of Mixture Models for Ordinal Data}, author = {Maria Iannario and Domenico Piccolo and Rosaria Simone}, year = {2020}, note = {R package version 1.1.4}, url = {https://CRAN.R-project.org/package=CUB}, } @Article{MCMCpack, title = {\pkg{MCMCpack}: Markov Chain Monte Carlo in \proglang{R}}, author = {Andrew D. Martin and Kevin M. Quinn and Jong Hee Park}, journal = {Journal of Statistical Software}, year = {2011}, volume = {42}, number = {9}, pages = {22}, url = {https://www.jstatsoft.org/v42/i09/}, doi = {10.18637/jss.v042.i09}, } @Article{decarlo98, author = {Lawrence T DeCarlo}, title = {{Signal Detection Theory and Generalized Linear Models}}, journal = {Psychological Methods}, year = 1998, volume = 3, number = 2, doi = {10.1037/1082-989X.3.2.186}, pages = {185-205}} @Article{christensen11, author = {Rune Haubo Bojesen Christensen and Graham Cleaver and Per Bruun Brockhoff}, title = {{Statistical and Thurstonian Models for the A-not A Protocol with and without Sureness}}, journal = {Food Quality and Preference}, year = 2011, pages = {542-549}, volume = {22}, doi = {10.1016/j.foodqual.2011.03.003}} @Book{macmillan05, author = {Neil A Macmillan and C Douglas Creelman}, title = {Detection Theory, A User's Guide}, publisher = {Lawrence Elbaum Associates, Publishers}, year = 2005, edition = {2nd}, ISBN = {978-0805842319} } @article{kuznetsova17, author = {Alexandra Kuznetsova and Per Brockhoff and Rune Christensen}, title = {\pkg{lmerTest} Package: Tests in Linear Mixed Effects Models}, journal = {Journal of Statistical Software, Articles}, volume = {82}, number = {13}, year = {2017}, keywords = {denominator degree of freedom, Satterthwaite's approximation, ANOVA, R, linear mixed effects models, lme4}, abstract = {One of the frequent questions by users of the mixed model function lmer of the lme4 package has been: How can I get p values for the F and t tests for objects returned by lmer? The lmerTest package extends the 'lmerMod' class of the lme4 package, by overloading the anova and summary functions by providing p values for tests for fixed effects. We have implemented the Satterthwaite's method for approximating degrees of freedom for the t and F tests. We have also implemented the construction of Type I - III ANOVA tables. Furthermore, one may also obtain the summary as well as the anova table using the Kenward-Roger approximation for denominator degrees of freedom (based on the KRmodcomp function from the pbkrtest package). Some other convenient mixed model analysis tools such as a step method, that performs backward elimination of nonsignificant effects - both random and fixed, calculation of population means and multiple comparison tests together with plot facilities are provided by the package as well.}, issn = {1548-7660}, pages = {1--26}, doi = {10.18637/jss.v082.i13}, url = {https://www.jstatsoft.org/v082/i13} } @Article{cox95, author = {Christopher Cox}, title = {Location-Scale Cumulative Odds Models for Ordinal Data: A Generalized Non-Linear Model Approach}, journal = {Statistics in Medicine}, year = 1995, volume = 14, doi = {10.1002/sim.4780141105}, pages = {1191-1203}, } @Book{elden04, author = {Lars Eld\'en and Linde Wittmeyer-Koch and Hans Bruun Nielsen}, title = {Introduction to Numerical Computation --- Analysis and \proglang{MATLAB} Illustrations}, publisher = {Studentlitteratur}, ISBN = {978-9144037271}, year = 2004} @Article{farewell77, author = {Vernon T Farewell and R L Prentice}, title = {A Study of Distributional Shape in Life Testing}, journal = {{Technometrics}}, year = 1977, volume = 19, doi = {10.2307/1268257}, pages = {69-77}} @Article{genter85, author = {Frederic C Genter and Vernon T Farewell}, title = {Goodness-of-Link Testing in Ordinal Regression Models}, journal = {{The Canadian Journal of Statistics}}, year = 1985, volume = 13, number = 1, doi = {10.2307/3315165}, pages = {37-44}, } @Article{aranda-ordaz83, author = {Francisco J Aranda-Ordaz}, title = {An Extension of the Proportional-Hazards Model for Grouped Data}, journal = {Biometrics}, year = 1983, volume = 39, doi = {10.2307/2530811}, pages = {109-117}} @Article{peterson90, author = {Bercedis Peterson and Frank E {Harrell Jr.}}, title = {Partial Proportional Odds Models for Ordinal Response Variables}, journal = {Applied Statistics}, year = 1990, volume = 39, doi = {10.2307/2347760}, pages = {205-217} } @Article{peterson92, author = {Bercedis Peterson and Frank E {Harrell Jr.}}, title = {Proportional Odds Model}, journal = {Biometrics}, year = 1992, month = {March}, note = {Letters to the Editor} } @Book{brazzale07, author = {A R Brazzale and A C Davison and N Reid}, title = {Applied Asymptotics---Case Studies in Small-Sample Statistics}, ISBN = {9780521847032}, publisher = {Cambridge University Press}, year = 2007} @Book{pawitan01, author = {Yudi Pawitan}, title = {{In All Likelihood---Statistical Modelling and Inference Using Likelihood}}, publisher = {Oxford University Press}, ISBN = {978-0198507659}, year = 2001 } @Article{efron78, author = {Bradley Efron and David V Hinkley}, title = {{Assessing the Accuracy of the Maximum Likelihood Estimator: Observed versus Expected Fisher Information}}, journal = {Biometrika}, year = 1978, volume = 65, number = 3, doi = {10.1093/biomet/65.3.457}, pages = {457-487}, } @article{burridge81, title = {A Note on Maximum Likelihood Estimation for Regression Models Using Grouped Data}, author = {Burridge, J.}, journal = {Journal of the Royal Statistical Society B}, volume = {43}, number = {1}, pages = {41-45}, ISSN = {00359246}, language = {English}, year = {1981}, publisher = {Blackwell Publishing for the Royal Statistical Society}, } @article{pratt81, title = {Concavity of the Log Likelihood}, author = {Pratt, John W.}, journal = {Journal of the American Statistical Association}, volume = {76}, number = {373}, pages = {103-106}, ISSN = {01621459}, language = {English}, year = {1981}, doi = {10.2307/2287052}, } @Book{agresti10, author = {Alan Agresti}, title = {Analysis of Ordinal Categorical Data}, publisher = {John Wiley \& Sons}, year = 2010, edition = {2nd}, doi = {10.1002/9780470594001} } @Book{agresti02, author = {Alan Agresti}, title = {Categorical Data Analysis}, publisher = {John Wiley \& Sons}, year = 2002, edition = {3rd}, ISBN = {978-0470463635}, } @Article{mccullagh80, author = {Peter McCullagh}, title = {Regression Models for Ordinal Data}, journal = {Journal of the Royal Statistical Society B}, year = 1980, volume = 42, pages = {109-142} } @Article{randall89, author = {J.H. Randall}, title = {The Analysis of Sensory Data by Generalised Linear Model}, journal = {Biometrical journal}, year = 1989, volume = 7, pages = {781-793}, doi = {10.1002/bimj.4710310703}, } @phdthesis{mythesis, title = "Sensometrics: Thurstonian and Statistical Models", author = "Christensen, Rune Haubo Bojesen", year = "2012", publisher = "Technical University of Denmark (DTU)", school = "Technical University of Denmark (DTU)", url = "http://orbit.dtu.dk/files/12270008/phd271_Rune_Haubo_net.pdf" } @Manual{SAStype, title = {The Four Types of Estimable Functions -- \proglang{SAS/STAT} \textregistered 9.22 User's Guide}, author = {\proglang{SAS} Institute Inc.}, organization = {\proglang{SAS} Institute Inc.}, address = {Cary, NC}, year = {2008}, url = {https://support.sas.com/documentation/cdl/en/statugestimable/61763/PDF/default/statugestimable.pdf}, } @Manual{SAS, title = {\proglang{SAS/STAT} \textregistered 9.22 User's Guide}, author = {\proglang{SAS} Institute Inc.}, organization = {\proglang{SAS} Institute Inc.}, address = {Cary, NC}, year = {2010}, url = {https://support.sas.com/documentation/}, } @Manual{ucminf, title = {\pkg{ucminf}: General-Purpose Unconstrained Non-Linear Optimization}, author = {Hans Bruun Nielsen and Stig Bousgaard Mortensen}, year = {2016}, note = {\proglang{R} package version 1.1-4}, url = {https://CRAN.R-project.org/package=ucminf}, } @Book{fahrmeir01, author = {Ludwig Fahrmeir and Gerhard Tutz}, title = {Multivariate Statistical Modelling Based on Generalized Linear Models}, publisher = {Springer-Verlag}, year = 2001, series = {Springer series in statistics}, edition = {2nd} } @Book{greene10, author = {William H Greene and David A Hensher}, title = {Modeling Ordered Choices: A Primer}, publisher = {Cambridge University Press}, year = 2010} @Book{mccullagh89, author = {Peter McCullagh and John A. Nelder}, title = {Generalized Linear Models}, edition = {2nd}, year = {1989}, publisher = {Chapman \& Hall}, address = {London}, doi = {10.1007/978-1-4899-3242-6}, } @Manual{Stata, title = {\proglang{Stata} 15 Base Reference Manual}, author = {{StataCorp}}, publisher = "\proglang{Stata} Press", address = "College Station, TX", year = {2017}, url = {https://www.stata.com/}, } @article{oglm, author = "Williams, R.", title = "Fitting Heterogeneous Choice Models with \pkg{oglm}", journal = "Stata Journal", publisher = "\proglang{Stata} Press", address = "College Station, TX", volume = "10", number = "4", year = "2010", pages = "540-567(28)", url = "https://www.stata-journal.com/article.html?article=st0208" } @Article{gllamm, author="Rabe-Hesketh, Sophia and Skrondal, Anders and Pickles, Andrew", title="Generalized Multilevel Structural Equation Modeling", journal="Psychometrika", year="2004", month="Jun", day="01", volume="69", number="2", pages="167--190", issn="1860-0980", doi="10.1007/BF02295939", url="https://doi.org/10.1007/BF02295939" } @Manual{SPSS, title = {\proglang{IBM SPSS} Statistics for Windows, Version 25.0}, author = {{IBM Corp.}}, organization = {IBM Corp.}, address = {Armonk, NY}, year = {2017}, } @manual{Matlab, author = {\proglang{Matlab}}, address = {Natick, Massachusetts}, organization = {The Mathworks, Inc.}, title = {{\proglang{Matlab} version 9.8 (R2020a)}}, year = {2020} } @phdthesis{mord, author = {Fabian Pedregosa-Izquierdo}, title = {Feature Extraction and Supervised Learning on fMRI: From Practice to Theory}, school = {UniversitĂ© Pierre et Marie Curie}, year = 2015, address = {Paris VI}, url = {https://pythonhosted.org/mord/} } @Manual{R, title = {\proglang{R}: {A} Language and Environment for Statistical Computing}, author = {{\proglang{R} Core Team}}, organization = {\proglang{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2020}, url = {https://www.R-project.org/}, } @Article{brms, title = {\pkg{brms}: An \proglang{R} Package for {Bayesian} Multilevel Models Using \pkg{Stan}}, author = {Paul-Christian BĂĽrkner}, journal = {Journal of Statistical Software}, year = {2017}, volume = {80}, number = {1}, pages = {1--28}, doi = {10.18637/jss.v080.i01}, encoding = {UTF-8}, } @Manual{rms, title = {\pkg{rms}: Regression Modeling Strategies}, author = {Frank E {Harrell Jr}}, year = {2018}, note = {\proglang{R} package version 5.1-2}, url = {https://CRAN.R-project.org/package=rms}, } @Book{MASS, author = {William N. Venables and Brian D. Ripley}, title = {Modern Applied Statistics with \proglang{S}}, edition = {4th}, year = {2002}, pages = {495}, publisher = {Springer-Verlag}, address = {New York}, doi = {10.1007/978-0-387-21706-2}, } @Article{VGAM, author = {Thomas W. Yee}, title = {The \pkg{VGAM} Package for Categorical Data Analysis}, journal = {Journal of Statistical Software}, year = {2010}, volume = {32}, number = {10}, pages = {1--34}, doi = {10.18637/jss.v032.i10}, } @Article{Zeileis+Kleiber+Jackman:2008, author = {Achim Zeileis and Christian Kleiber and Simon Jackman}, title = {Regression Models for Count Data in \proglang{R}}, journal = {Journal of Statistical Software}, year = {2008}, volume = {27}, number = {8}, pages = {1--25}, doi = {10.18637/jss.v027.i08}, } ordinal/vignettes/clmm2_tutorial.Rnw0000644000176200001440000004375215125475162017362 0ustar liggesusers\documentclass[a4paper]{article} \usepackage{amsmath}%the AMS math extension of LaTeX. \usepackage{amssymb}%the extended AMS math symbols. %% \usepackage{amsthm} \usepackage{bm}%Use 'bm.sty' to get `bold math' symbols \usepackage{natbib} \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{Sweave} \usepackage{url} \usepackage{float}%Use `float.sty' \usepackage[left=3.5cm,right=3.5cm]{geometry} \usepackage{algorithmic} \usepackage[amsmath,thmmarks,standard,thref]{ntheorem} %%\VignetteIndexEntry{clmm2 tutorial} %%\VignetteDepends{ordinal, xtable} \title{A Tutorial on fitting Cumulative Link Mixed Models with \texttt{clmm2} from the \textsf{ordinal} Package} \author{Rune Haubo B Christensen} %% \numberwithin{equation}{section} \setlength{\parskip}{2mm}%.8\baselineskip} \setlength{\parindent}{0in} %% \DefineVerbatimEnvironment{Sinput}{Verbatim}%{} %% {fontshape=sl, xleftmargin=1em} %% \DefineVerbatimEnvironment{Soutput}{Verbatim}%{} %% {xleftmargin=1em} %% \DefineVerbatimEnvironment{Scode}{Verbatim}%{} %% {fontshape=sl, xleftmargin=1em} \fvset{listparameters={\setlength{\topsep}{0pt}}} %% \fvset{listparameters={\setlength{\botsep}{0pt}}} \renewenvironment{Schunk}{\vspace{-1mm}}{\vspace{-1mm}} %RE-DEFINE marginpar \setlength{\marginparwidth}{1in} \let\oldmarginpar\marginpar \renewcommand\marginpar[1]{\oldmarginpar[\-\raggedleft\tiny #1]% {\tiny #1}} %uncomment to _HIDE_MARGINPAR_: %\renewcommand\marginpar[1]{} \newcommand{\var}{\textup{var}} \newcommand{\I}{\mathcal{I}} \newcommand{\bta}{\bm \theta} \newcommand{\ta}{\theta} \newcommand{\tah}{\hat \theta} \newcommand{\di}{~\textup{d}} \newcommand{\td}{\textup{d}} \newcommand{\Si}{\Sigma} \newcommand{\si}{\sigma} \newcommand{\bpi}{\bm \pi} \newcommand{\bmeta}{\bm \eta} \newcommand{\tdots}{\hspace{10mm} \texttt{....}} \newcommand{\FL}[1]{\fvset{firstline= #1}} \newcommand{\LL}[1]{\fvset{lastline= #1}} \newcommand{\s}{\square} \newcommand{\bs}{\blacksquare} % figurer bagerst i artikel %% \usepackage[tablesfirst, nolists]{endfloat} %% \renewcommand{\efloatseparator}{\vspace{.5cm}} \theoremstyle{plain} %% {break} \theoremseparator{:} \theoremsymbol{{\tiny $\square$}} %%\theoremstyle{plain} \theorembodyfont{\small} \theoremindent5mm \renewtheorem{example}{Example} %% \newtheoremstyle{example}{\topsep}{\topsep}% %% {}% Body font %% {}% Indent amount (empty = no indent, \parindent = para indent) %% {\bfseries}% Thm head font %% {}% Punctuation after thm head %% {\newline}% Space after thm head (\newline = linebreak) %% {\thmname{#1}\thmnumber{ #2}\thmnote{ #3}}% Thm head spec %% %% \theoremstyle{example} %% %% \newtheorem{example}{Example}[subsection] %% \newtheorem{example}{Example}[section] \usepackage{lineno} % \linenumbers \newcommand*\patchAmsMathEnvironmentForLineno[1]{% \expandafter\let\csname old#1\expandafter\endcsname\csname #1\endcsname \expandafter\let\csname oldend#1\expandafter\endcsname\csname end#1\endcsname \renewenvironment{#1}% {\linenomath\csname old#1\endcsname}% {\csname oldend#1\endcsname\endlinenomath}}% \newcommand*\patchBothAmsMathEnvironmentsForLineno[1]{% \patchAmsMathEnvironmentForLineno{#1}% \patchAmsMathEnvironmentForLineno{#1*}}% \AtBeginDocument{% \patchBothAmsMathEnvironmentsForLineno{equation}% \patchBothAmsMathEnvironmentsForLineno{align}% \patchBothAmsMathEnvironmentsForLineno{flalign}% \patchBothAmsMathEnvironmentsForLineno{alignat}% \patchBothAmsMathEnvironmentsForLineno{gather}% \patchBothAmsMathEnvironmentsForLineno{multline}% } \begin{document} \bibliographystyle{chicago} \maketitle \begin{abstract} It is shown by example how a cumulative link mixed model is fitted with the \texttt{clmm2} function in package \textsf{ordinal}. Model interpretation and inference is briefly discussed. A tutorial for the more recent \texttt{clmm} function is work in progress. \end{abstract} %% \newpage %% \tableofcontents %% \newpage \SweaveOpts{echo=TRUE, results=verb, width=4.5, height=4.5} \SweaveOpts{prefix.string=figs} \fvset{listparameters={\setlength{\topsep}{0pt}}, gobble=0, fontsize=\small} %% \fvset{gobble=0, fontsize=\small} \setkeys{Gin}{width=.49\textwidth} <>= ## Load common packages, functions and set settings: library(ordinal) library(xtable) ## RUN <- FALSE #redo computations and write .RData files ## Change options: op <- options() ## To be able to reset settings options("digits" = 7) options(help_type = "html") ## options("width" = 75) options("SweaveHooks" = list(fig=function() par(mar=c(4,4,.5,0)+.5))) options(continue=" ") @ We will consider the data on the bitterness of wine from \citet{randall89} presented in Table~\ref{tab:winedata} and available as the object \texttt{wine} in package \textsf{ordinal}. The data were also analyzed with mixed effects models by \citet{tutz96}. The following gives an impression of the wine data object: <<>>= data(wine) head(wine) str(wine) @ The data represent a factorial experiment on factors determining the bitterness of wine with 1 = ``least bitter'' and 5 = ``most bitter''. Two treatment factors (temperature and contact) each have two levels. Temperature and contact between juice and skins can be controlled when crushing grapes during wine production. Nine judges each assessed wine from two bottles from each of the four treatment conditions, hence there are 72 observations in all. For more information see the manual entry for the wine data: \texttt{help(wine)}. \begin{table} \centering \caption{Ratings of the bitterness of some white wines. Data are adopted from \citet{randall89}.} \label{tab:winedata} \begin{tabular}{lllrrrrrrrrr} \hline & & & \multicolumn{9}{c}{Judge} \\ \cline{4-12} <>= data(wine) temp.contact.bottle <- with(wine, temp:contact:bottle)[drop=TRUE] tab <- xtabs(as.numeric(rating) ~ temp.contact.bottle + judge, data=wine) class(tab) <- "matrix" attr(tab, "call") <- NULL mat <- cbind(rep(c("cold", "warm"), each = 4), rep(rep(c("no", "yes"), each=2), 2), 1:8, tab) colnames(mat) <- c("Temperature", "Contact", "Bottle", 1:9) xtab <- xtable(mat) print(xtab, only.contents=TRUE, include.rownames=FALSE, sanitize.text.function = function(x) x) @ \end{tabular} \end{table} We will fit the following cumulative link mixed model to the wine data: \begin{equation} \label{eq:mixedModel} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j - \beta_1 (\mathtt{temp}_i) - \beta_2(\mathtt{contact}_i) - u(\mathtt{judge}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation} This is a model for the cumulative probability of the $i$th rating falling in the $j$th category or below, where $i$ index all observations and $j = 1, \ldots, J$ index the response categories ($J = 5$). $\{\theta_j\}$ are known as threshold parameters or cut-points. We take the judge effects to be random, and assume that the judge effects are IID normal: $u(\mathtt{judge}_i) \sim N(0, \sigma_u^2)$. We fit this model with the \texttt{clmm2} function in package \textsf{ordinal}. Here we save the fitted \texttt{clmm2} model in the object \texttt{fm1} (short for \texttt{f}itted \texttt{m}odel \texttt{1}) and \texttt{print} the model by simply typing its name: <<>>= fm1 <- clmm2(rating ~ temp + contact, random=judge, data=wine) fm1 @ Maximum likelihood estimates of the parameters are provided using the Laplace approximation to compute the likelihood function. A more accurate approximation is provided by the adaptive Gauss-Hermite quadrature method. Here we use 10 quadrature nodes and use the \texttt{summary} method to display additional information: <<>>= fm2 <- clmm2(rating ~ temp + contact, random=judge, data=wine, Hess=TRUE, nAGQ=10) summary(fm2) @ The small changes in the parameter estimates show that the Laplace approximation was in fact rather accurate in this case. Observe that we set the option \texttt{Hess = TRUE}. This is needed if we want to use the \texttt{summary} method since the Hessian is needed to compute standard errors of the model coefficients. The results contain the maximum likelihood estimates of the parameters: \begin{equation} \label{eq:parameters} \hat\beta_1 = 3.06, ~~\hat\beta_2 = 1.83, ~~\hat\sigma_u^2 = 1.29 = 1.13^2, ~~\{\hat\theta_j\} = [-1.62,~ 1.51,~ 4.23,~ 6.09]. \end{equation} Observe the number under \texttt{Std.Dev} for the random effect is \textbf{not} the standard error of the random effects variance, \texttt{Var}. Rather, it is the standard deviation of the random effects, i.e., it is the square root of the variance. In our example $\sqrt{1.29} \simeq 1.13$. The condition number of the Hessian measures the empirical identifiability of the model. High numbers, say larger than $10^4$ or $10^6$ indicate that the model is ill defined. This would indicate that the model can be simplified, that possibly some parameters are not identifiable, and that optimization of the model can be difficult. In this case the condition number of the Hessian does not indicate a problem with the model. The coefficients for \texttt{temp} and \texttt{contact} are positive indicating that higher temperature and more contact increase the bitterness of wine, i.e., rating in higher categories is more likely. The odds ratio of the event $Y \geq j$ is $\exp(\beta_{\textup{treatment}})$, thus the odds ratio of bitterness being rated in category $j$ or above at warm relative to cold temperatures is <<>>= exp(coef(fm2)[5]) @ The $p$-values for the location coefficients provided by the \texttt{summary} method are based on the so-called Wald statistic. More accurate test are provided by likelihood ratio tests. These can be obtained with the \texttt{anova} method, for example, the likelihood ratio test of \texttt{contact} is <<>>= fm3 <- clmm2(rating ~ temp, random=judge, data=wine, nAGQ=10) anova(fm3, fm2) @ which in this case is slightly more significant. The Wald test is not reliable for variance parameters, so the \texttt{summary} method does not provide a test of $\sigma_u$, but a likelihood ratio test can be obtained with \texttt{anova}: <<>>= fm4 <- clm2(rating ~ temp + contact, data=wine) anova(fm4, fm2) @ showing that the judge term is significant. Since this test of $\sigma_u = 0$ is on the boundary of the parameter space (a variance cannot be negative), it is often argued that a more correct $p$-value is obtained by halving the $p$-value produced by the conventional likelihood ratio test. In this case halving the $p$-value is of little relevance. A profile likelihood confidence interval of $\sigma_u$ is obtained with: <<>>= pr2 <- profile(fm2, range=c(.1, 4), nSteps=30, trace=0) confint(pr2) @ The profile likelihood can also be plotted: <>= plot(pr2) @ The result is shown in Fig.~\ref{fig:PRsigma_u} where horizontal lines indicate 95\% and 99\% confindence bounds. Clearly the profile likelihood function is asymmetric and symmetric confidence intervals would be inaccurate. \begin{figure} \centering <>= <> @ \caption{Profile likelihood of $\sigma_u$.} \label{fig:PRsigma_u} \end{figure} The judge effects, $u(\mathtt{judge}_i)$ are not parameters, so they cannot be \emph{estimated} in the conventional sense, but a ``best guess'' is provided by the \emph{conditional modes}. Similarly the \emph{conditional variance} provides an uncertainty measure of the conditional modes. These quantities are included in \texttt{clmm2} objects as the \texttt{ranef} and \texttt{condVar} components. The following code generates the plot in Fig.~\ref{fig:ranef} illustrating judge effects via conditional modes with 95\% confidence intervals based on the conditional variance: <>= ci <- fm2$ranef + qnorm(0.975) * sqrt(fm2$condVar) %o% c(-1, 1) ord.re <- order(fm2$ranef) ci <- ci[order(fm2$ranef),] plot(1:9, fm2$ranef[ord.re], axes=FALSE, ylim=range(ci), xlab="Judge", ylab="Judge effect") axis(1, at=1:9, labels = ord.re) axis(2) for(i in 1:9) segments(i, ci[i,1], i, ci[i, 2]) abline(h = 0, lty=2) @ The seventh judge gave the lowest ratings of bitterness while the first judge gave the highest ratings of bitterness. The significant judge effect indicate that judges perceived the bitterness of the wines differently. Two natural interpretations are that either a bitterness of, say, 3 means different things to different judges, or the judges actually perceived the bitterness of the wines differently. Possibly both effects play their part. \begin{figure} \centering <>= <> @ \caption{Judge effects given by conditional modes with 95\% confidence intervals based on the conditional variance.} \label{fig:ranef} \end{figure} The fitted or predicted probabilites can be obtained with the judge effects at their conditional modes or for an average judge ($u = 0$). The former are available with \texttt{fitted(fm)} or with \texttt{predict(fm)}, where \texttt{fm} is a \texttt{f}itted \texttt{m}odel object. In our example we get <<>>= head(cbind(wine, fitted(fm2))) @ Predicted probabilities for an average judge can be obtained by including the data used to fit the model in the \texttt{newdata} argument of \texttt{predict}: <<>>= head(cbind(wine, pred=predict(fm2, newdata=wine))) @ Model~\eqref{eq:mixedModel} says that for an average judge at cold temperature the cumulative probability of a bitterness rating in category $j$ or below is \begin{equation*} P(Y_i \leq j) = \textup{logit}^{-1} [ \theta_j - \beta_2(\mathtt{contact}_i) ] \end{equation*} since $u$ is set to zero and $\beta_1(\mathtt{temp}_i) = 0$ at cold conditions. Further, $\textup{logit}^{-1}(\eta) = 1 / [1 + \exp(\eta)]$ is the cumulative distribution function of the logistic distribution available as the \texttt{plogis} function. The (non-cumulative) probability of a bitterness rating in category $j$ is $\pi_j = P(Y_i \leq j) - P(Y_i \leq j-1)$, for instance the probability of a bitterness rating in the third category at these conditions can be computed as <<>>= plogis(fm2$Theta[3] - fm2$beta[2]) - plogis(fm2$Theta[2] - fm2$beta[2]) @ This corresponds to the third entry of \texttt{predict(fm2, newdata=wine)} given above. Judge effects are random and normally distributed, so an average judge effect is 0. Extreme judge effects, say 5th and 95th percentile judge effects are given by <<>>= qnorm(0.95) * c(-1, 1) * fm2$stDev @ At the baseline experimental conditions (cold and no contact) the probabilites of bitterness ratings in the five categories for a 5th percentile judge is <<>>= pred <- function(eta, theta, cat = 1:(length(theta)+1), inv.link = plogis) { Theta <- c(-1e3, theta, 1e3) sapply(cat, function(j) inv.link(Theta[j+1] - eta) - inv.link(Theta[j] - eta) ) } pred(qnorm(0.05) * fm2$stDev, fm2$Theta) @ We can compute these probabilities for average, 5th and 95th percentile judges at the four experimental conditions. The following code plots these probabilities and the results are shown in Fig.~\ref{fig:ratingProb}. <>= mat <- expand.grid(judge = qnorm(0.95) * c(-1, 0, 1) * fm2$stDev, contact = c(0, fm2$beta[2]), temp = c(0, fm2$beta[1])) pred.mat <- pred(eta=rowSums(mat), theta=fm2$Theta) lab <- paste("contact=", rep(levels(wine$contact), 2), ", ", "temp=", rep(levels(wine$temp), each=2), sep="") par(mfrow=c(2, 2)) for(k in c(1, 4, 7, 10)) { plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") } @ \begin{figure} \centering <>= k <- 1 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 4 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 7 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 10 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ \caption{Rating probabilities for average and extreme judges at different experimental conditions.} \label{fig:ratingProb} \end{figure} At constant experimental conditions the odds ratio for a bitterness rating in category $j$ or above for a 95th percentile judge relative to a 5th percentile judge is <<>>= exp(2*qnorm(0.95) * fm2$stDev) @ The differences between judges can also be expressed in terms of the interquartile range: the odds ratio for a bitterness rating in category $j$ or above for a third quartile judge relative to a first quartile judge is <<>>= exp(2*qnorm(0.75) * fm2$stDev) @ \newpage \bibliography{ordinal} %% \newpage \end{document} <>= @ ordinal/vignettes/ordinal.bib0000644000176200001440000002472715130020202016015 0ustar liggesusers@Book{brazzale07, author = {A R Brazzale and A C Davison and N Reid}, title = {Applied Asymptotics---case studies in small-sample statistics} , publisher = {Cambridge University Press}, year = 2007} @Book{pawitan01, author = {Yudi Pawitan}, title = {{In All Likelihood---Statistical Modelling and Inference Using Likelihood}}, publisher = {Oxford University Press}, year = 2001 } @Manual{R11, title = {R: A Language and Environment for Statistical Computing}, author = {{R Development Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2011}, note = {{ISBN} 3-900051-07-0}, url = {https://www.r-project.org/}, } @Article{tutz96, author = {Gerhard Tutz and Wolfgang Hennevogl}, title = {Random effects in ordinal regression models}, journal = {Computational Statistics \& Data Analysis}, year = 1996, volume = 22, pages = {537-557} } @Article{efron78, author = {Bradley Efron and David V Hinkley}, title = {{Assessing the accuracy of the maximum likelihood estimator: Observed versus expected Fisher information}}, journal = {Biometrika}, year = 1978, volume = 65, number = 3, pages = {457-487}} @article{bauer09, author = {Bauer, Daniel}, affiliation = {University of North Carolina Department of Psychology Chapel Hill NC 27599-3270 USA}, title = {A Note on Comparing the Estimates of Models for†Cluster-Correlated or Longitudinal Data with Binary or Ordinal†Outcomes}, journal = {Psychometrika}, publisher = {Springer New York}, issn = {0033-3123}, keyword = {Humanities, Social Sciences and Law}, pages = {97-105}, volume = {74}, issue = {1}, url = {http://dx.doi.org/10.1007/s11336-008-9080-1}, year = {2009} } @article{fielding04, author = {Fielding, Antony}, title = {Scaling for Residual Variance Components of Ordered Category Responses in Generalised Linear Mixed Multilevel Models}, journal = {Quality \& Quantity}, publisher = {Springer Netherlands}, issn = {0033-5177}, keyword = {Humanities, Social Sciences and Law}, pages = {425-433}, volume = {38}, issue = {4}, url = {http://dx.doi.org/10.1023/B:QUQU.0000043118.19835.6c}, year = {2004} } @article{winship84, jstor_articletype = {research-article}, title = {Regression Models with Ordinal Variables}, author = {Winship, Christopher and Mare, Robert D.}, journal = {American Sociological Review}, jstor_issuetitle = {}, volume = {49}, number = {4}, jstor_formatteddate = {Aug., 1984}, pages = {512-525}, url = {https://www.jstor.org/stable/2095465}, ISSN = {00031224}, abstract = {Most discussions of ordinal variables in the sociological literature debate the suitability of linear regression and structural equation methods when some variables are ordinal. Largely ignored in these discussions are methods for ordinal variables that are natural extensions of probit and logit models for dichotomous variables. If ordinal variables are discrete realizations of unmeasured continuous variables, these methods allow one to include ordinal dependent and independent variables into structural equation models in a way that (1) explicitly recognizes their ordinality, (2) avoids arbitrary assumptions about their scale, and (3) allows for analysis of continuous, dichotomous, and ordinal variables within a common statistical framework. These models rely on assumed probability distributions of the continuous variables that underly the observed ordinal variables, but these assumptions are testable. The models can be estimated using a number of commonly used statistical programs. As is illustrated by an empirical example, ordered probit and logit models, like their dichotomous counterparts, take account of the ceiling and floor restrictions on models that include ordinal variables, whereas the linear regression model does not.}, language = {English}, year = {1984}, publisher = {American Sociological Association}, copyright = {Copyright © 1984 American Sociological Association}, } @article{thompson81, jstor_articletype = {research-article}, title = {Composite Link Functions in Generalized Linear Models}, author = {Thompson, R. and Baker, R. J.}, journal = {Journal of the Royal Statistical Society. Series C (Applied Statistics)}, jstor_issuetitle = {}, volume = {30}, number = {2}, jstor_formatteddate = {1981}, pages = {125-131}, url = {https://www.jstor.org/stable/2346381}, ISSN = {00359254}, abstract = {In generalized linear models each observation is linked with a predicted value based on a linear function of some systematic effects. We sometimes require to link each observation with a linear function of more than one predicted value. We embed such models into the generalized linear model framework using composite link functions. The computer program GLIM-3 can be used to fit these models. Illustrative examples are given including a mixed-up contingency table and grouped normal data.}, language = {English}, year = {1981}, publisher = {Blackwell Publishing for the Royal Statistical Society}, copyright = {Copyright © 1981 Royal Statistical Society}, } @article{burridge81, jstor_articletype = {research-article}, title = {A Note on Maximum Likelihood Estimation for Regression Models Using Grouped Data}, author = {Burridge, J.}, journal = {Journal of the Royal Statistical Society. Series B (Methodological)}, jstor_issuetitle = {}, volume = {43}, number = {1}, jstor_formatteddate = {1981}, pages = {41-45}, url = {https://www.jstor.org/stable/2985147}, ISSN = {00359246}, abstract = {The estimation of parameters for a class of regression models using grouped or censored data is considered. It is shown that with a simple reparameterization some commonly used distributions, such as the normal and extreme value, result in a log-likelihood which is concave with respect to the transformed parameters. Apart from its theoretical implications for the existence and uniqueness of maximum likelihood estimates, this result suggests minor changes to some commonly used algorithms for maximum likelihood estimation from grouped data. Two simple examples are given.}, language = {English}, year = {1981}, publisher = {Blackwell Publishing for the Royal Statistical Society}, copyright = {Copyright © 1981 Royal Statistical Society}, } @article{pratt81, jstor_articletype = {research-article}, title = {Concavity of the Log Likelihood}, author = {Pratt, John W.}, journal = {Journal of the American Statistical Association}, jstor_issuetitle = {}, volume = {76}, number = {373}, jstor_formatteddate = {Mar., 1981}, pages = {103-106}, url = {https://www.jstor.org/stable/2287052}, ISSN = {01621459}, abstract = {For a very general regression model with an ordinal dependent variable, the log likelihood is proved concave if the derivative of the underlying response function has concave logarithm. For a binary dependent variable, a weaker condition suffices, namely, that the response function and its complement each have concave logarithm. The normal, logistic, sine, and extreme-value distributions, among others, satisfy the stronger condition, the t (including Cauchy) distributions only the weaker. Some converses and generalizations are also given. The model is that which arises from an ordinary linear regression model with a continuous dependent variable that is partly unobservable, being either grouped into intervals with unknown endpoints, or censored, or, more generally, grouped in some regions, censored in others, and observed exactly elsewhere.}, language = {English}, year = {1981}, publisher = {American Statistical Association}, copyright = {Copyright © 1981 American Statistical Association}, } @Manual{christensen11, title = {Analysis of ordinal data with cumulative link models --- estimation with the \textsf{ordinal} package}, author = {Rune Haubo Bojesen Christensen}, note = {R-package version 2011.09-13}, year = 2011} @Book{agresti10, author = {Alan Agresti}, title = {Analysis of ordinal categorical data}, publisher = {Wiley}, year = 2010, edition = {2nd}} @Book{agresti02, author = {Alan Agresti}, title = {Categorical Data Analysis}, publisher = {Wiley}, year = 2002, edition = {2nd} } @Article{mccullagh80, author = {Peter McCullagh}, title = {Regression Models for Ordinal Data}, journal = {Journal of the Royal Statistical Society, Series B}, year = 1980, volume = 42, pages = {109-142} } @Article{randall89, author = {J.H. Randall}, title = {The Analysis of Sensory Data by Generalised Linear Model}, journal = {Biometrical journal}, year = 1989, volume = 7, pages = {781-793} } @Book{fahrmeir01, author = {Ludwig Fahrmeir and Gerhard Tutz}, title = {Multivariate Statistical Modelling Based on Generalized Linear Models}, publisher = {Springer-Verlag New York, Inc.}, year = 2001, series = {Springer series in statistics}, edition = {2nd} } @Book{greene10, author = {William H Greene and David A Hensher}, title = {Modeling Ordered Choices: A Primer}, publisher = {Cambridge University Press}, year = 2010} @Book{mccullagh89, author = {Peter McCullagh and John Nelder}, title = {Generalized Linear Models}, publisher = {Chapman \& Hall/CRC}, year = 1989, edition = {Second} } @Book{collett02, author = {David Collett}, title = {Modelling binary data}, publisher = {London: Chapman \& Hall/CRC}, year = 2002, edition = {2nd} } ordinal/vignettes/clm_article.Rnw0000644000176200001440000034437515125475162016710 0ustar liggesusers% \documentclass[article]{article} % \documentclass[article]{jss} \documentclass[nojss]{jss} %% -- Latex packages and custom commands --------------------------------------- %% recommended packages \usepackage{thumbpdf,lmodern,amsmath,amssymb,bm,url} \usepackage{textcomp} \usepackage[utf8]{inputenc} %% another package (only for this demo article) \usepackage{framed} %% new custom commands \newcommand{\class}[1]{`\code{#1}'} \newcommand{\fct}[1]{\code{#1()}} %% For Sweave-based articles about R packages: %% need no \usepackage{Sweave} \SweaveOpts{engine=R, eps=FALSE, keep.source = TRUE, prefix.string=clmjss} <>= options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) library("ordinal") library("xtable") @ %%\VignetteIndexEntry{Cumulative Link Models for Ordinal Regression} %%\VignetteDepends{ordinal, xtable} %% -- Article metainformation (author, title, ...) ----------------------------- %% - \author{} with primary affiliation %% - \Plainauthor{} without affiliations %% - Separate authors by \And or \AND (in \author) or by comma (in \Plainauthor). %% - \AND starts a new line, \And does not. \author{Rune Haubo B Christensen\\Technical University of Denmark\\ \& \\ Christensen Statistics} \Plainauthor{Rune Haubo B Christensen} %% - \title{} in title case %% - \Plaintitle{} without LaTeX markup (if any) %% - \Shorttitle{} with LaTeX markup (if any), used as running title \title{Cumulative Link Models for Ordinal Regression with the \proglang{R} Package \pkg{ordinal}} \Plaintitle{Cumulative Link Models for Ordinal Regression with the R Package ordinal} \Shorttitle{Cumulative Link Models with the \proglang{R} package \pkg{ordinal}} %% - \Abstract{} almost as usual \Abstract{ This paper introduces the R-package \pkg{ordinal} for the analysis of ordinal data using cumulative link models. The model framework implemented in \pkg{ordinal} includes partial proportional odds, structured thresholds, scale effects and flexible link functions. The package also support cumulative link models with random effects which are covered in a future paper. A speedy and reliable regularized Newton estimation scheme using analytical derivatives provides maximum likelihood estimation of the model class. The paper describes the implementation in the package as well as how to use the functionality in the package for analysis of ordinal data including topics on model identifiability and customized modelling. The package implements methods for profile likelihood confidence intervals, analysis of deviance tables with type I, II and III tests, predictions of various kinds as well as methods for checking the convergence of the fitted models. } %% - \Keywords{} with LaTeX markup, at least one required %% - \Plainkeywords{} without LaTeX markup (if necessary) %% - Should be comma-separated and in sentence case. \Keywords{ordinal, cumulative link models, proportional odds, scale effects, \proglang{R}} \Plainkeywords{ordinal, cumulative link models, proportional odds, scale effects, R} %% - \Address{} of at least one author %% - May contain multiple affiliations for each author %% (in extra lines, separated by \emph{and}\\). %% - May contain multiple authors for the same affiliation %% (in the same first line, separated by comma). \Address{ Rune Haubo Bojesen Christensen\\ Section for Statistics and Data Analysis\\ Department of Applied Mathematics and Computer Science\\ DTU Compute\\ Technical University of Denmark\\ Richard Petersens Plads \\ Building 324 \\ DK-2800 Kgs. Lyngby, Denmark\\ \emph{and}\\ Christensen Statistics\\ Bringetoften 7\\ DK-3500 V\ae rl\o se, Denmark \\ E-mail: \email{Rune.Haubo@gmail.com}; \email{Rune@ChristensenStatistics.dk}%\\ % URL: \url{http://christensenstatistics.dk/} } \begin{document} This is a copy of an article that is no longer submitted for publication in Journal of Statistical Software (\url{https://www.jstatsoft.org/}). %% -- Introduction ------------------------------------------------------------- %% - In principle "as usual". %% - But should typically have some discussion of both _software_ and _methods_. %% - Use \proglang{}, \pkg{}, and \code{} markup throughout the manuscript. %% - If such markup is in (sub)section titles, a plain text version has to be %% added as well. %% - All software mentioned should be properly \cite-d. %% - All abbreviations should be introduced. %% - Unless the expansions of abbreviations are proper names (like "Journal %% of Statistical Software" above) they should be in sentence case (like %% "generalized linear models" below). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} \label{sec:intro} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Ordered categorical data, or simply \emph{ordinal} data, are common in a multitude of empirical sciences and in particular in scientific disciplines where humans are used as measurement instruments. Examples include school grades, ratings of preference in consumer studies, degree of tumor involvement in MR images and animal fitness in ecology. Cumulative link models (CLM) are a powerful model class for such data since observations are treated correctly as categorical, the ordered nature is exploited and the flexible regression framework allows for in-depth analyses. This paper introduces the \pkg{ordinal} package \citep{ordinal-pkg} for \proglang{R} \citep{R} for the analysis of ordinal data with cumulative link models. The paper describes how \pkg{ordinal} supports the fitting of CLMs with various models structures, model assessment and inferential options including tests of partial proportional odds, scale effects, threshold structures and flexible link functions. The implementation, its flexibility in allowing for costumizable models and an effective fitting algorithm is also described. The \pkg{ordinal} package also supports cumulative link \emph{mixed} models (CLMM); CLMs with normally distributed random effects. The support of this model class will not be given further treatment here but remain a topic for a future paper. The name, \emph{cumulative link models} is adopted from \citet{agresti02}, but the model class has been referred to by several other names in the literature, such as \emph{ordered logit models} and \emph{ordered probit models} \citep{greene10} for the logit and probit link functions. The cumulative link model with a logit link is widely known as the \emph{proportional odds model} due to \citet{mccullagh80} and with a complementary log-log link, the model is sometimes referred to as the \emph{proportional hazards model} for grouped survival times. CLMs is one of several types of models specifically developed for ordinal data. Alternatives to CLMs include continuation ratio models, adjacent category models, and stereotype models \citep{ananth97} but only models in the CLM framework will be considered in this paper. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Software review} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Cumulative link models can be fitted by all the major software packages and while some software packages support scale effects, partial proportional odds (also referred to as unequal slopes, partial effects, and nominal effects), different link functions and structured thresholds all model structures are not available in any one package or implementation. The following brief software review is based on the publicly available documentation at software package websites retrieved in May 2020. \proglang{IBM SPSS} \citep{SPSS} implements McCullagh's \pkg{PLUM} \citep{mccullagh80} procedure, allows for the five standard link functions (cf. Table~\ref{tab:linkFunctions}) and scale effects. Estimation is via Fisher-Scoring and a test for equal slopes is available for the location-only model while it is not possible to estimate a partial proportional odds model. \proglang{Stata} \citep{Stata} includes the \code{ologit} and \code{oprobit} procedures for CLMs with logistic and probit links but without support for scale effects, partial effect or structured thresholds. The add-on package \pkg{oglm} \citep{oglm} allows for all five standard link functions and scale effects. The \pkg{GLLAMM} package \citep{gllamm} also has some support for CLMs in addition to some support for random effects. \proglang{SAS} \citep{SAS} implements CLMs with logit links in \code{proc logistic} and CLMs with the 5 standard links in \code{prog genmod}. \proglang{Matlab} \citep{Matlab} fits CLMs with the \code{mnrfit} function allowing for logit, probit, complementary log-log and log-log links. \proglang{Python} has a package \pkg{mord} \citep{mord} for ordinal classification and prediction focused at machine learning applications. In \proglang{R}, several packages on the Comprehensive \proglang{R} Archive Network (CRAN) implements CLMs. \code{polr} from \pkg{MASS} \citep{MASS} implements standard CLMs allowing for the 5 standard link functions but no further extensions; the \pkg{VGAM} package \citep{VGAM} includes CLMs via the \code{vglm} function using the \code{cumulative} link. \code{vglm} allows for several link functions as well as partial effects. The \code{lrm} and \code{orm} functions from the \pkg{rms} package \citep{rms} also implements CLMs with the 5 standard link functions but without scale effects, partial or structured thresholds. A Bayesian alternative is implemented in the \pkg{brms} package \citep{brms, brms2} which includes structured thresholds in addition to random-effects. In addition, several other \proglang{R} packages include methods for analyses of ordinal data including \pkg{oglmx} \citep{oglmx}, \pkg{MCMCpack} \citep{MCMCpack}, \pkg{mvord} \citep{mvord}, \pkg{CUB} \citep{CUB}, and \pkg{ordinalgmifs} \citep{ordinalgmifs}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[ordinal package overview]{\pkg{ordinal} package overview} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{ordinal} package implements CLMs and CLMMs along with functions and methods to support these model classes as summarized in Table~\ref{tab:functions_in_ordinal}. The two key functions in \pkg{ordinal} are \code{clm} and \code{clmm} which fits CLMs and CLMMs respectively; \code{clm2} and \code{clmm2}\footnote{A brief tutorial on \code{clmm2} is currently available at the package website on CRAN: \url{https://CRAN.R-project.org/package=ordinal}} provide legacy implementations primarily retained for backwards compatibility. This paper introduces \code{clm} and its associated functionality covering CLMs with location, scale and nominal effects, structured thresholds and flexible link functions. \code{clm.fit} is the main work horse behind \code{clm} and an analogue to \code{lm.fit} for linear models. The package includes methods for assessment of convergence with \code{convergence} and \code{slice}, an auxiliary method for removing linearly dependent columns from a design matrix in \code{drop.coef}. Distributional support functions in \pkg{ordinal} provide support for Gumbel and log-gamma distributions as well as gradients\footnote{gradients with respect to $x$, the quantile; not the parameters of the distributions} of normal, logistic and Cauchy probability density functions which are used in the iterative methods implemented in \code{clm} and \code{clmm}. \begin{table}[t!] \centering \renewcommand*{\arraystretch}{1.2} \begin{tabular}{llll} \hline \rotatebox{0}{Fitting} & \rotatebox{0}{Miscellaneous} & \rotatebox{0}{Former impl.} & \rotatebox{0}{Distributions} \\ \hline \code{clm} & \code{convergence} & \code{clm2} & \code{[pdqrg]gumbel}$^{\textsf{c}}$ \\ \code{clmm}$^{\textsf{c}}$ & \code{slice} & \code{clmm2}$^{\textsf{c}}$ & \code{[pdg]lgamma}$^{\textsf{c}}$ \\ \code{clm.fit} & \code{drop.coef} & \code{clm2.control} & \code{gnorm}$^{\textsf{c}}$ \\ \code{clm.control} & & \code{clmm2.control} & \code{glogis}$^{\textsf{c}}$ \\ \code{clmm.control} & & & \code{gcauchy}$^{\textsf{c}}$ \\ \hline \end{tabular} \\ \caption{Key functions in \pkg{ordinal}. Superscript "c" indicates (partial or full) implementation in \proglang{C}.\label{tab:functions_in_ordinal}} \end{table} As summarized in Table~\ref{tab:clm_methods}, \pkg{ordinal} provides the familiar suite of extractor and print methods for \code{clm} objects known from \code{lm} and \code{glm}. These methods all behave in ways similar to those for \code{glm}-objects with the exception of \code{model.matrix} which returns a list of model matrices and \code{terms} which can return the \code{terms} object for each of three formulae. The inference methods facilitate profile likelihood confidence intervals via \code{profile} and \code{confint}, likelihood ratio tests for model comparison via \code{anova}, model assessment by tests of removal of model terms via \code{drop1} and addition of new terms via \code{add1} or AIC-based model selection via \code{step}. Calling \code{anova} on a single \code{clm}-object provides an analysis of deviance table with type I, II or III Wald-based $\chi^2$ tests following the \proglang{SAS}-definitions of such tests \citep{SAStype}. In addition to standard use of \code{clm}, the implementation facilitates extraction a model environment containing a complete representation of the model allowing the user to fit costumized models containing, for instance, special structures on the threshold parameters, restrictions on regression parameters or other case-specific model requirements. As CLMMs are not covered by this paper methods for \code{clmm} objects will not be discussed. Other packages including \pkg{emmeans} \citep{emmeans}, \pkg{margins} \citep{margins}, \pkg{ggeffects} \citep{ggeffects}, \pkg{generalhoslem} \citep{generalhoslem} and \pkg{effects} \citep{effects1, effects2} extend the \pkg{ordinal} package by providing methods marginal means, tests of functions of the coefficients, goodness-of-fit tests and methods for illustration of fitted models. \begin{table}[t!] \centering \renewcommand*{\arraystretch}{1.2} \begin{tabular}{llll} \hline \multicolumn{2}{l}{Extractor and Print} & Inference & Checking \\[3pt] \hline \code{coef} & \code{print} & \code{anova} & \code{slice} \\ \code{fitted} & \code{summary} & \code{drop1} & \code{convergence}\\ \code{logLik} & \code{model.frame} & \code{add1} & \\ \code{nobs} & \code{model.matrix} & \code{confint} & \\ \code{vcov} & \code{update} & \code{profile} & \\ \code{AIC}, \code{BIC} & & \code{predict} & \\ \code{extractAIC} & & \code{step}, \code{stepAIC} & \\ \hline \end{tabular} \caption{Key methods for \code{clm} objects.\label{tab:clm_methods}} \end{table} The \pkg{ordinal} package is therefore unique in providing a comprehensive framework for cumulative link models exceeding that of other software packages with its functionality extended by a series of additional \proglang{R} packages. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Organization of the paper} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The remainder of the paper is organized as follows. The next section establishes notation by defining CLMs and associated log-likelihood functions, then describes the extended class of CLMs that is implemented in \pkg{ordinal} including details about scale effects, structured thresholds, partial proportional odds and flexible link functions. The third section describes how maximum likelihood (ML) estimation of CLMs is implemented in \pkg{ordinal}. The fourth section describes how CLMs are fitted and ordinal data are analysed with \pkg{ordinal} including sections on nominal effects, scale effects, structured thresholds, flexible link functions, profile likelihoods, assessment of model convergence, fitted values and predictions. The final parts of section four is on a more advanced level and include issues around model identifiability and customizable fitting of models not otherwise covered by the \pkg{ordinal} API. We end in section~\ref{sec:conclusions} with Conclusions. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Cumulative link models} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A cumulative link model is a model for ordinal-scale observations, i.e., observations that fall in an ordered finite set of categories. Ordinal observations can be represented by a random variable $Y_i$ that takes a value $j$ if the $i$th ordinal observations falls in the $j$'th category where $j = 1, \ldots, J$ and $J \geq 2$.\footnote{binomial models ($J = 2$) are also included.}% % A basic cumulative link model is \begin{equation} \label{eq:BasicCLM} \gamma_{ij} = F(\eta_{ij})~, \quad \eta_{ij} = \theta_j - \bm x_i^\top \bm\beta~, \quad i = 1,\ldots,n~, \quad j = 1, \ldots, J-1 ~, \end{equation} where \begin{equation*} %% \label{eq:cum} \gamma_{ij} = \Prob (Y_i \leq j) = \pi_{i1} + \ldots + \pi_{ij} \quad \mathrm{with} \quad \sum_{j=1}^J \pi_{ij} = 1 \end{equation*} are cumulative probabilities\footnote{we have suppressed the conditioning on the covariate vector, $\bm x_i$, i.e., $\gamma_{ij} = \gamma_j(\bm x_i)$ and $P(Y_i \leq j) = P(Y \leq j | \bm x_i)$.}, $\pi_{ij}$ is the probability that the $i$th observation falls in the $j$th category, $\eta_{ij}$ is the linear predictor and $\bm x_i^\top$ is a $p$-vector of regression variables for the parameters, $\bm\beta$ without a leading column for an intercept and $F$ is the inverse link function. % The thresholds (also known as cut-points or intercepts) are strictly ordered: \begin{equation*} -\infty \equiv \theta_0 \leq \theta_1 \leq \ldots \leq \theta_{J-1} \leq \theta_J \equiv \infty. \end{equation*} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{The multinomial distribution and the log-likelihood function} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The ordinal observation $Y_i$ which assumes the value $j$ can be represented by a multinomially distributed variable $\bm Y_i^* \sim \mathrm{multinom}(\bm\pi_i, 1)$, where $\bm Y_i^*$ is a $J$-vector with a $1$ at the $j$'th entry and 0 otherwise, and with probability mass function % \begin{equation} \label{eq:multinom_pmf} \Prob(\bm Y_i^* = \bm y_i^*) = \prod_j \pi_{ij}^{y_{ij}^*} ~. \end{equation} % The log-likelihood function can therefore be written as % \begin{equation*} \ell(\bm\theta, \bm\beta; \bm y^*) = \sum_i \sum_j y_{ij}^* \log \pi_{ij} \end{equation*} % or equivalently % \begin{align*} \ell(\bm\theta, \bm\beta; \bm y) =~& \sum_i \sum_j \mathrm I (y_i = j) \log \pi_{ij} \\ =~& \sum_i \log \tilde\pi_i \end{align*} % where $\tilde\pi_i$ is the $j$'th entry in $J$-vector $\bm \pi_i$ with elements $\pi_{ij}$ and $\mathrm I(\cdot)$ is the indicator function. Allowing for observation-level weights (case weights), $w_i$ leads finally to % \begin{equation} \label{eq:clm-log-likelihood} \ell(\bm\theta, \bm\beta; \bm y) = \sum_i w_i \log \tilde\pi_i ~. \end{equation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Likelihood based inference} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Confidence intervals for model parameters are obtained by appealing to the asymptotic normal distribution of a statistic $s(\cdot)$ for a scalar parameter of interest $\beta_a$ and defined as \begin{equation*} CI:~\left\{ \beta_a; |s(\beta_a)| < z_{1 - \alpha/2} \right\} . \end{equation*} where $z_{1 - \alpha/2}$ is the $(1 - \alpha/2)$ quantile of the standard normal cumulative distribution function. Taking $s(\cdot)$ to be the Wald statistic $s(\beta_a):~ w(\beta_a) = (\hat\beta_a - \beta_a)/\hat{\mathrm{se}}(\hat\beta_a)$ leads to the classical symmetric intervals. Better confidence intervals can be obtained by choosing instead the likelihood root statistic \citep[see e.g.,][]{pawitan01, brazzale07}: \begin{equation*} s(\beta_a):~ r(\beta_a) = \mathrm{sign}(\hat\beta_a - \beta_a) \sqrt{-2 [ \ell(\hat{\bm\theta}, \hat{\bm\beta}; \bm y) - \ell_p(\beta_a; \bm y)]} \end{equation*} where \begin{equation*} \ell_p(\beta_a; \bm y) = \max_{\bm\theta, \bm\beta_{-a}} \ell(\bm\theta, \bm\beta; \bm y)~, \end{equation*} is the profile likelihood for the scalar parameter $\beta_a$ and $\bm\beta_{-a}$ is the vector of regression parameters without the $a$'th one. While the profile likelihood has to be optimized over all parameters except $\beta_a$ we define a \emph{log-likelihood slice} as \begin{equation} \label{eq:slice} \ell_{\mathrm{slice}}(\beta_a; \bm y) = \ell(\beta_a; \hat{\bm\theta}, \hat{\bm\beta}_{-a}, \bm y)~, \end{equation} which is the log-likelihood function evaluated at $\beta_a$ while keeping the remaining parameters fixed at their ML estimates. A quadratic approximation to the log-likelihood slice is $(\hat\beta_a - \beta_a)^2 / 2\tau_a^2$ where the \emph{curvature unit} $\tau_a$ is the square root of $a$'th diagonal element of the Hessian of $-\ell(\hat{\bm\theta}, \hat{\bm\beta}; \bm y)$. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A commonly used link function is the logit link which leads to % \begin{equation} \label{eq:cum_logit_model} \mathrm{logit}(\gamma_{ij}) = \log \frac{\Prob (Y_i \leq j)}{1 - \Prob(Y_i \leq j)} \end{equation} % The odds ratio (OR) of the event $Y_i \leq j$ at $\bm x_1$ relative to the same event at $\bm x_2$ is then % \begin{equation} \label{eq:odds_ratio} \mathrm{OR} = \frac{\gamma_j(\bm x_1) / [1 - \gamma_j(\bm x_1)]} {\gamma_j(\bm x_2) / [1 - \gamma_j(\bm x_2)]} = \frac{\exp(\theta_j - \bm x_1^\top \bm\beta)} {\exp(\theta_j - \bm x_2^\top \bm\beta)} %% =&~ \exp(\theta_j - \theta_j - \bm x_1 \bm\beta + \bm x_2 \bm\beta) = \exp[(\bm x_2^\top - \bm x_1^\top)\bm\beta] \end{equation} which is independent of $j$. Thus the cumulative odds ratio is proportional to the distance between $\bm x_1$ and $\bm x_2$ which motivated \citet{mccullagh80} to denote the cumulative logit model a \emph{proportional odds model}. If $x$ represent a treatment variable with two levels (e.g., placebo and treatment), then $x_2 - x_1 = 1$ and the odds ratio is $\exp(-\beta_\textup{treatment})$. Similarly the odds ratio of the event $Y \geq j$ is $\exp(\beta_\textup{treatment})$. The probit link has its own interpretation through a normal linear model for a latent variable which is considered in section~\ref{sec:latent-variable-motivation}. The complementary log-log (clog-log) link is also sometimes used because of its interpretation as a proportional hazards model for grouped survival times: \begin{equation*} -\log\{1 - \gamma_{j}(\bm x_i) \} = \exp( \theta_j - \bm x_i^T \bm\beta ) \end{equation*} Here $1 - \gamma_{j}(\bm x_i)$ is the probability or survival beyond category $j$ given $\bm x_i$. The proportional hazards model has the property that \begin{equation*} \log \{ \gamma_{j}(\bm x_1) \} = \exp[ (\bm x_2^T - \bm x_1^T) \bm\beta ] \log \{ \gamma_{j}(\bm x_2) \}~. \end{equation*} thus the ratio of hazards at $\bm x_1$ relative to $\bm x_2$ are proportional. If the log-log link is used on the response categories in the reverse order, this is equivalent to using the clog-log link on the response in the original order. This reverses the sign of $\bm\beta$ as well as the sign and order of $\{\theta_j\}$ while the likelihood and standard errors remain unchanged. % % Thus, similar to the proportional odds % model, the ratio of hazard functions beyond category $j$ at $\bm x_1$ % relative to $\bm x_2$ (the hazard ratio, $HR$) is: % \begin{equation*} % HR = \frac{-\log\{1 - \gamma_{j}(\bm x_2) \}} % {-\log\{1 - \gamma_{j}(\bm x_1) \}} = % \frac{\exp( \theta_j - \bm x_1^T \bm\beta )} % {\exp( \theta_j - \bm x_2^T \bm\beta )} = % \exp[(\bm x_2 - \bm x_1)\bm\beta] % \end{equation*} % Details of the most common link functions are described in Table~\ref{tab:linkFunctions}. \begin{table}[t!] \begin{center} %\footnotesize \begin{tabular}{llll} \hline Name & logit & probit & log-log \\ \hline Distribution & logistic & normal & Gumbel (max)$^b$ \\ Shape & symmetric & symmetric & right skew\\ Link function ($F^{-1}$) & $\log[\gamma / (1 - \gamma)]$ & $\Phi^{-1}(\gamma)$ & $-\log[-\log(\gamma)]$ \\ Inverse link ($F$) & $1 / [1 + \exp(\eta)]$ & $\Phi(\eta)$ & $\exp(-\exp(-\eta))$ \\ Density ($f = F'$) & $\exp(-\eta) / [1 + \exp(-\eta)]^2$ & $\phi(\eta)$ \\ \hline \hline Name & clog-log$^a$ & cauchit \\ \hline Distribution & Gumbel (min)$^b$ & Cauchy$^c$ \\ Shape & left skew & kurtotic \\ Link function ($F^{-1}$) & $\log[ -\log(1 - \gamma)]$ & $\tan[\pi (\gamma - 0.5)]$ \\ Inverse link ($F$) & $1 - \exp[-\exp(\eta)]$ & $\arctan(\eta)/\pi + 0.5$ \\ Density ($f = F'$) & $\exp[-\exp(\eta) + \eta]$ & $1 / [\pi(1 + \eta^2)]$ \\ \hline \end{tabular} \end{center} % \footnotesize % % $^a$: the \emph{complementary log-log} link \\ % $^b$: the Gumbel distribution is also known as the extreme value % (type I) distribution for extreme minima or maxima. It is also % sometimes referred to as the Weibull (or log-Weibull) distribution % (\url{http://en.wikipedia.org/wiki/Gumbel_distribution}). \\ % $^c$: the Cauchy distribution is a $t$-distribution with one df \caption{Summary of the five standard link functions. $^a$: the \emph{complementary log-log} link; $^b$: the Gumbel distribution is also known as the extreme value (type I) distribution for extreme minima or maxima. It is also sometimes referred to as the Weibull (or log-Weibull) distribution; $^c$: the Cauchy distribution is a $t$-distribution with one degree of freedom. \label{tab:linkFunctions}} \end{table} The \pkg{ordinal} package allows for the estimation of an extended class of cumulative link models in which the basic model~(\ref{eq:BasicCLM}) is extended in a number of ways including structured thresholds, partial proportional odds, scale effects and flexible link functions. The following sections will describe these extensions of the basic CLM. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Extensions of cumulative link models} \label{sec:extensions-of-clms} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A general formulation of the class of models (excluding random effects) that is implemented in \pkg{ordinal} can be written % \begin{equation} \gamma_{ij} = F_{\lambda}(\eta_{ij}), \quad \eta_{ij} = \frac{g_{\bm\alpha} (\theta_j) - \bm x_i^\top \bm\beta - \bm w_i^\top \tilde{\bm\beta}_j}{\exp(\bm z_i\bm\zeta)} \end{equation} % where \begin{description} \item[$F_{\lambda}$] is the inverse link function. It may be parameterized by the scalar parameter $\lambda$ in which case we refer to $F_{\lambda}^{-1}$ as a \emph{flexible link function}, % \item[$g_{\bm\alpha}(\theta_j)$] parameterises thresholds $\{\theta_j\}$ by the vector $\bm\alpha$ such that $g$ restricts $\{\theta_j\}$ to be for example symmetric or equidistant. We denote this \emph{structured thresholds}. % \item[$\bm x_i^\top\bm\beta$] are the ordinary regression effects, % \item[$\bm w_i^\top \tilde{\bm\beta}_j$] are regression effects which are allowed to depend on the response category $j$ and they are denoted \emph{partial} or \emph{non-proportional odds} \citep{peterson90} when the logit link is applied. To include other link functions in the terminology we denote these effects \emph{nominal effects} (in text and code) because these effects are not integral to the ordinal nature of the data. % \item[$\exp(\bm z_i\bm\zeta)$] are \emph{scale effects} since in a latent variable view these effects model the scale of the underlying location-scale distribution. \end{description} With the exception of the structured thresholds, these extensions of the basic CLM have been considered individually in a number of sources but to the author's best knowledge not previously in a unified framework. % For example partial proportional odds have been considered by \citet{peterson90} and scale effect have been considered by \citet{mccullagh80} and \citet{cox95}. % \citet{agresti02} is a good introduction to cumulative link models in the context of categorical data analysis and includes discussions of scale effects. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Latent variable motivation of CLMs} \label{sec:latent-variable-motivation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% It is natural to motivate the CLM from a linear model for a categorized version of a latent variable. Assume the following linear model for an unobserved latent variable: % \begin{equation} \label{eq:latent} S_i = \alpha^* + \bm x_i^\top \bm\beta^* + \varepsilon_i, \quad \varepsilon_i \sim N(0, \sigma^{*2}) \end{equation} % If $S_i$ falls between two thresholds, $\theta_{j-1}^* < S_i \leq \theta_j^*$ where % \begin{equation} \label{eq:thresholds} -\infty \equiv \theta_0^* < \theta_1^* < \ldots < \theta^*_{J-1} < \theta_{J}^* \equiv \infty \end{equation} % then $Y_i = j$ is observed and the cumulative probabilities are: % \begin{equation*} \gamma_{ij} = \Prob (Y_i \leq j) = \Prob(S_i \leq \theta_j^*) = \Prob \left( Z \leq \frac{\theta_j^* - \alpha^* - \bm x_i^\top \bm\beta^*}{% \sigma^*} \right) = \Phi ( \theta_j - \bm x_i^\top \bm\beta ) \end{equation*} % where $Z$ follows a standard normal distribution, $\Phi$ denotes the standard normal cumulative distribution function, parameters with an ``$^*$'' exist on the latent scale, $\theta_j = (\theta_j^* - \alpha^*) / \sigma^*$ and $\bm\beta = \bm\beta^* / \sigma^*$. Note that $\alpha^*$, $\bm\beta^*$ and $\sigma^*$ would have been identifiable if the latent variable $S$ was directly observed, but they are not identifiable with ordinal observations. See Figure~\ref{fig:standard_clm} for an illustration. If we allow a log-linear model for the scale such that % \begin{equation*} \varepsilon_i \sim N(0, \sigma^{*2}_i), \quad \sigma_i^* = \exp(\mu + \bm z_i^\top \bm\zeta) = \sigma^* \exp(\bm z_i^\top \bm\zeta) \end{equation*} % where $\bm z_i$ is the $i$'th row of a design matrix $\bm Z$ without a leading column for an intercept and $\sigma^* = \exp(\mu)$, then \begin{equation*} \gamma_{ij} = \Prob \left( Z \leq \frac{\theta_j^* - \alpha^* - \bm x_i^\top \bm\beta^*}{% \sigma^*_i} \right) = \Phi \left( \frac{\theta_j - \bm x_i^T \bm\beta}{\sigma_i} \right) \end{equation*} where $\sigma_i = \sigma_i^* / \sigma^* = \exp(\bm z_i^\top \bm\zeta)$ is the \emph{relative} scale. The common link functions: probit, logit, log-log, c-log-log and cauchit correspond to inverse cumulative distribution functions of the normal, logistic, Gumbel(max), Gumbel(min) and Cauchy distributions respectively. These distributions are all members of the location-scale family with common form $F(\mu, \sigma)$, with location $\mu$ and non-negative scale $\sigma$, for example, the logistic distribution has mean $\mu$ and standard deviation $\sigma \pi / \sqrt{3}$. Choosing a link function therefore corresponds to assuming a particular distribution for the latent variable $S$ in which $\bm x_i^\top \bm\beta$ and $\exp(\bm z_i^\top \bm\zeta)$ models location \emph{differences} and scale \emph{ratios} respectively of that distribution. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Structured thresholds} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Structured thresholds, $\{ g(\bm\alpha)_j \}$ makes it possible to impose restrictions on the thresholds $\bm\theta = g(\bm\alpha)$. For instance restricting the thresholds to be equidistant means that only the location of, say, the first threshold and the spacing between adjacent thresholds has to be estimated, thus only two parameters are used to parameterize the thresholds irrespective of the number of response categories. \pkg{ordinal} takes $g(\bm\alpha)$ to be a linear function and operates with \begin{equation*} g(\bm\alpha) = \mathcal{J}^\top \bm\alpha = \bm \theta \end{equation*} where the Jacobian $\mathcal{J}$ defines the mapping from the parameters $\bm\alpha$ to the thresholds $\bm\theta$. The traditional ordered but otherwise unrestricted thresholds are denoted \emph{flexible thresholds} and obtained by taking $\mathcal{J}$ to be an identity matrix. Assuming $J=6$ ordered categories, the Jacobians for equidistant and symmetric thresholds (denoted \code{equidistant} and \code{symmetric} in the \code{clm}-argument \code{threshold}) are \begin{equation*} \mathcal{J}_{\mathrm{equidistant}} = \begin{bmatrix} 1 & 1 & 1 & 1 & 1 \\ 0 & 1 & 2 & 3 & 4 \\ \end{bmatrix}, \quad \mathcal{J}_{\mathrm{symmetric}} = \begin{bmatrix} 1 & 1 & 1 & 1 & 1 \\ 0 & -1 & 0 & 1 & 0 \\ -1 & 0 & 0 & 0 & 1 \\ \end{bmatrix}. \end{equation*} Another version of symmetric thresholds (denoted \code{symmetric2}) is sometimes relevant with an unequal number of response categories here illustrated with $J=5$ together with the \code{symmetric} thresholds: \begin{equation*} \mathcal{J}_{\mathrm{symmetric2}} = \begin{bmatrix} 0 & -1 & 1 & 0 \\ -1 & 0 & 0 & 1 \\ \end{bmatrix}, \quad \mathcal{J}_{\mathrm{symmetric}} = \begin{bmatrix} 1 & 1 & 0 & 0 \\ 0 & 0 & 1 & 1 \\ -1 & 0 & 0 & 1 \\ \end{bmatrix} \end{equation*} The nature of $\mathcal{J}$ for a particular model can always be inspected by printing the \code{tJac} component of the \code{clm} fit. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Partial proportional odds and nominal effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The nominal effects $\bm w_i^\top\tilde{\bm\beta}_j$ can be considered an extension of the regression part of the model $\bm x_i^\top \bm\beta$ in which the regression effects are allowed to vary with $j$. % The nominal effects can also be considered an extension of the thresholds $\theta_j$ which allows them to depend on variables $\bm w_i^\top$: $\tilde{\theta}_{ij}(\bm w_i^\top) = \theta_j - \bm w_i^\top \tilde{\bm\beta}_j$ is the $j$'th threshold for the $i$'th observation. The following treatment assumes for latter view. In general let $\bm W$ denote the design matrix for the nominal effects without a leading column for an intercept; the nominal-effects parameter vector $\tilde{\bm\beta}_j$ is then $\mathrm{ncol}(\bm W)$ long and $\tilde{\bm\beta}$ is $\mathrm{ncol}(\bm W) \cdot (J-1)$ long. If $\bm W$ is the design matrix for the nominal effects containing a single column for a continuous variable then $\tilde{\beta}_j$ is the slope parameter corresponding to the $j$'th threshold and $\theta_j$ is the $j$'th intercept, i.e., the threshold when the covariate is zero. Looking at $\tilde{\theta}_{ij}(\bm w_i^\top) = \theta_j - \bm w_i^\top \tilde{\bm\beta}_j$ as a linear model for the thresholds facilitates the interpretation. If, on the other hand, $\bm W$ is the design matrix for a categorical variable (a \code{factor} in \proglang{R}) then the interpretation of $\tilde{\bm\beta}_j$ depends on the contrast-coding of $\bm W$. If we assume that the categorical variable has 3 levels, then $\tilde{\bm\beta}_j$ is a 2-vector. In the default treatment contrast-coding (\code{"contr.treatment"}) $\theta_j$ is the $j$'th threshold for the first (base) level of the factor, $\tilde{\beta}_{1j}$ is the differences between thresholds for the first and second level and $\tilde{\beta}_{2j}$ is the difference between the thresholds for the first and third level. In general we define $\bm\Theta$ as a matrix with $J-1$ columns and with 1 row for each combination of the levels of factors in $\bm W$. This matrix is available in the \code{Theta} component of the model fit. Note that variables in $\bm X$ cannot also be part of $\bm W$ if the model is to remain identifiable. \pkg{ordinal} detects this and automatically removes the offending variables from $\bm X$. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Flexible link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{ordinal} package allows for two kinds of flexible link functions due to \citet{aranda-ordaz83} and \citet{genter85}. The link function proposed by \citet{aranda-ordaz83} reads % \begin{equation*} F^{-1}_\lambda (\gamma_{ij}) = \log \left\{ \frac{(1 - \gamma_{ij})^{-\lambda} - 1} {\lambda} \right\}~, \end{equation*} which depends on the auxiliary parameter $\lambda \in ]0, \infty[$. When $\lambda = 1$, the logistic link function arise, and when $\lambda \rightarrow 0$, \begin{equation*} \{ (1 - \gamma_{ij})^{-\lambda} - 1 \} / \lambda \rightarrow \log (1 - \gamma_{ij})^{-1}~, \end{equation*} so the log-log link arise. The inverse link function and its derivative are given by \begin{align*} F(\eta) =&~ 1 - (\lambda \exp(\eta) + 1)^{-\lambda^{-1}} \\ f(\eta) =&~ \exp(\eta) (\lambda \exp(\eta) + 1)^{-\lambda^{-1} - 1} \end{align*} The density implied by the inverse link function is left-skewed if $0 < \lambda < 1$, symmetric if $\lambda = 1$ and right-skewed if $\lambda > 1$, so the link function can be used to assess the evidence about possible skewness of the latent distribution. The log-gamma link function proposed by \citet{genter85} is based on the log-gamma density by \citet{farewell77}. The cumulative distribution function and hence inverse link function reads \begin{equation*} F_\lambda(\eta) = \begin{cases} 1 - G(q; \lambda^{-2}) & \lambda < 0 \\ \Phi(\eta) & \lambda = 0 \\ G(q; \lambda^{-2}) & \lambda > 0 \end{cases} \end{equation*} where $q = \lambda^{-2}\exp(\lambda \eta)$ and $G(\cdot; \alpha)$ denotes the Gamma distribution with shape parameter $\alpha$ and unit rate parameter, and $\Phi$ denotes the standard normal cumulative distribution function. The corresponding density function reads \begin{equation*} f_\lambda(\eta) = \begin{cases} |\lambda| k^k \Gamma(k)^{-1} \exp\{ k(\lambda\eta - \exp(\lambda\eta)) \} & \lambda \neq 0 \\ \phi(\eta) & \lambda = 0 \end{cases} \end{equation*} where $k=\lambda^{-2}$, $\Gamma(\cdot)$ is the gamma function and $\phi$ is the standard normal density function. By attaining the Gumbel(max) distribution at $\lambda = -1$, the standard normal distribution at $\lambda = 0$ and the Gumbel(min) distribution at $\lambda = 1$ the log-gamma link bridges the log-log, probit and complementary log-log links providing right-skew, symmetric and left-skewed latent distributions in a single family of link functions. Note that choice and parameterization of the predictor, $\eta_{ij}$, e.g., the use of scale effects, can affect the evidence about the shape of the latent distribution. There are usually several link functions which provide essentially the same fit to the data and choosing among the good candidates is often better done by appealing to arguments such as ease of interpretation rather than arguments related to fit. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Implementation of ML Estimation of CLMs in ordinal]{Implementation of ML Estimation of CLMs in \pkg{ordinal}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the \pkg{ordinal} package cumulative link models are (by default) estimated with a regularized Newton-Raphson (NR) algorithm with step-halving (line search) using analytical expressions for the gradient and Hessian of the negative log-likelihood function. This NR algorithm with analytical derivatives is used irrespective of whether the model contains structured thresholds, nominal effects or scale effects; the only exception being models with flexible link functions for which a general-purpose quasi-Newton optimizer is used. Due to computationally cheap and efficient evaluation of the analytical derivatives, the relative well-behaved log-likelihood function (with exceptions described below) and the speedy convergence of the Newton-Raphson algorithm, the estimation of CLMs is virtually instant on a modern computer even with complicated models on large datasets. This also facilitates simulation studies. More important than speed is perhaps that the algorithm is reliable and accurate. Technical aspects of the regularized NR algorithm with step-halving (line search) are described in appendix~\ref{sec:algorithm} and analytical gradients are described in detail in \citet{mythesis}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Properties of the log-likelihood function for extended CLMs} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \citet{pratt81} and \citet{burridge81} showed (seemingly independent of each other) that the log-likelihood function of the basic cumulative link model~(\ref{eq:BasicCLM}) is concave. This means that there is a unique global optimum of the log-likelihood function and therefore no risk of convergence to a local optimum. It also means that the Hessian matrix for the negative log-likelihood is strictly positive definite and therefore also that the Newton step is always in direction of higher likelihood. The genuine Newton step may be too long to actually cause an increase in likelihood from one iteration to the next (this is called ``overshoot''). This is easily overcome by successively halving the length of the Newton step until an increase in likelihood is achieved. Exceptions to the strict concavity of the log-likelihood function include models using the cauchit link, flexible link functions as well as models with scale effects. Notably models with structured thresholds as well as nominal effects do not affect the linearity of the predictor, $\eta_{ij}$ and so are also guaranteed to have concave log-likelihoods. The restriction of the threshold parameters $\{\theta_j\}$ being non-decreasing is dealt with by defining $\ell(\bm\theta, \bm\beta; y) = \infty$ when $\{\theta_j\}$ are not in a non-decreasing sequence. If the algorithm attempts evaluation at such illegal values step-halving effectively brings the algorithm back on track. Other implementations of CLMs re-parameterize $\{\theta_j\}$ such that the non-decreasing nature of $\{\theta_j\}$ is enforced by the parameterization, for example, \code{MASS::polr} (package version 7.3.49) optimize the likelihood using \begin{equation*} \tilde\theta_1 = \theta_1, ~\tilde{\theta}_2 = \exp(\theta_2 - \theta_1),~\ldots, ~ \tilde{\theta}_{J-1} = \exp(\theta_{J-2} - \theta_{J-1}) \end{equation*} This is deliberately not used in \pkg{ordinal} because the log-likelihood function is generally closer to quadratic in the original parameterization in our experience which facilitates faster convergence. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Starting values} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% For the basic CLMs~(\ref{eq:BasicCLM}) the threshold parameters are initialized to an increasing sequence such that the cumulative density of a logistic distribution between consecutive thresholds (and below the lowest or above the highest threshold) is constant. The regression parameters $\bm\beta$, scale parameters $\bm\zeta$ as well as nominal effect $\bm\beta^*$ are initialized to 0. If the model specifies a cauchit link or includes scale parameters estimation starts at the parameter estimates of a model using the probit link and/or without the scale-part of the model. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Estimation problems} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% With many nominal effects it may be difficult to find a model in which the threshold parameters are strictly increasing for all combinations of the parameters. Upon convergence of the NR algorithm the model evaluates the $\bm\Theta$-matrix and checks that each row of threshold estimates are increasing. When a continuous variable is included among the nominal effects it is often helpful if the continuous variable is centered at an appropriate value (at least within the observed range of the data). This is because $\{\theta_j\}$ represent the thresholds when the continuous variable is zero and $\{\theta_j\}$ are enforced to be a non-decreasing sequence. Since the nominal effects represent different slopes for the continuous variable the thresholds will necessarily be ordered differently at some other value of the continuous variable. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Convergence codes} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Irrespective of the fitting algorithm, \pkg{ordinal} reports the following convergence codes for CLMs in which negative values indicate convergence failure: % \begin{description} \item[-3] Not all thresholds are increasing. This is only possible with nominal effects and the resulting fit is invalid. \item[-2] The Hessian has at least one negative eigenvalue. This means that the point at which the algorithm terminated does not represent an optimum. \item[-1] Absolute convergence criterion (maximum absolute gradient) was not satisfied. This means that the algorithm couldn't get close enough to a stationary point of the log-likelihood function. \item[0] Successful convergence. \item[1] The Hessian is singular (i.e., at least one eigenvalue is zero). This means that some parameters are not uniquely determined. \end{description} % Note that with convergence code \textbf{1} the optimum of the log-likelihood function has been found although it is not a single point but a line (or in general a (hyper) plane), so while some parameters are not uniquely determined the value of the likelihood is valid enough and can be compared to that of other models. In addition to these convergence codes, the NR algorithm in \pkg{ordinal} reports the following messages: \begin{description} \item[0] Absolute and relative convergence criteria were met \item[1] Absolute convergence criterion was met, but relative criterion was not met \item[2] iteration limit reached \item[3] step factor reduced below minimum \item[4] maximum number of consecutive Newton modifications reached \end{description} Note that convergence is assessed irrespective of potential messages from the fitting algorithm and irrespective of whether the tailored NR algorithm or a general-purpose quasi-Newton optimizer is used. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Fitting cumulative link models in ordinal with clm]{Fitting cumulative link models in \pkg{ordinal} with \code{clm}} \label{sec:fitting-clms} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \code{clm} function takes the following arguments: % <>= clm_args <- gsub("function ", "clm", deparse(args(clm))) cat(paste(clm_args[-length(clm_args)], "\n")) @ % Several arguments are standard and well-known from \code{lm} and \code{glm} and will not be described in detail; \code{formula}, \code{data}, \code{weights}, \code{subset} and \code{na.action} are all parts of the standard model specification in \proglang{R}. \code{scale} and \code{nominal} are interpreted as \proglang{R}-formulae with no left hand sides and specifies the scale and nominal effects of the model respectively, see sections~\ref{sec:scale-effects} and \ref{sec:nominal-effects} for details; \code{start} is an optional vector of starting values; \code{doFit} can be set to \code{FALSE} to prompt \code{clm} to return a model \emph{environment}, for details see section~\ref{sec:customized-modelling}; \code{model} controls whether the \code{model.frame} should be included in the returned model fit; \code{link} specifies the link function and \code{threshold} specifies an optional threshold structure, for details see section~\ref{sec:threshold-effects}. Note the absence of a separate \code{offset} argument. Since \code{clm} allows for different offsets in \code{formula} and \code{scale}, offsets have to be specified within a each formulae, e.g., \verb!scale = ~ x1 + offset(x2)!. Methods for \code{clm} model fits are summarized in Table~\ref{tab:clm_methods} and introduced in the following sections. Control parameters can either be specified as a named list, among the optional \code{...} arguments, or directly as a call to \code{clm.control} --- in the first two cases the arguments are passed on to \code{clm.control}. \code{clm.control} takes the following arguments: % <>= cc_args <- gsub("function ", "clm.control", deparse(args(clm.control))) cat(paste(cc_args[-length(cc_args)], "\n")) @ % The \code{method} argument specifies the optimization and/or return method. The default estimation method (\code{Newton}) is the regularized Newton-Raphson estimation scheme described in section~\ref{sec:algorithm}; options \code{model.frame} and \code{design} prompts \code{clm} to return respectively the \code{model.frame} and a list of objects that represent the internal representation instead of fitting the model; options \code{ucminf}, \code{nlminb} and \code{optim} represent different general-purpose optimizers which may be used to fit the model (the former from package \pkg{ucminf} \citep{ucminf}, the latter two from package \pkg{stats}). The \code{sign.location} and \code{sign.nominal} options allow the user to flip the signs on the location and nominal model terms. The \code{convergence} argument instructs \code{clm} how to alert the user of potential convergence problems; \code{...} are optional arguments passed on to the general purpose optimizers; \code{trace} applies across all optimizers and positive values lead to printing of progress during iterations; the remaining arguments (\code{maxIter, gradTol, maxLineIter, relTol, tol}) control the behavior of the regularized NR algorithm described in appendix~\ref{sec:algorithm}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[Fitting a basic cumulative link model with clm]{Fitting a basic cumulative link model with \code{clm}} \label{sec:fitting-basic-clm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the following examples we will use the wine data from \citet{randall89} available in the object \code{wine} in package \pkg{ordinal}, cf., Table~\ref{tab:wineData}. The data represent a factorial experiment on factors determining the bitterness of wine with 1 = ``least bitter'' and 5 = ``most bitter''. Two treatment factors (temperature and contact) each have two levels. Temperature and contact between juice and skins can be controlled when crushing grapes during wine production. Nine judges each assessed wine from two bottles from each of the four treatment conditions, hence there are 72 observations in all. The main objective is to examine the effect of contact and temperature on the perceived bitterness of wine. \begin{table}[t!] \centering \begin{tabular}{llrrrrr} \hline & & \multicolumn{5}{c}{Least---Most bitter} \\ \cline{3-7} <>= ## data(wine) tab <- with(wine, table(temp:contact, rating)) mat <- cbind(rep(c("cold", "warm"), each = 2), rep(c("no", "yes"), 2), tab) colnames(mat) <- c("Temperature", "Contact", paste("~~", 1:5, sep = "")) xtab <- xtable(mat) print(xtab, only.contents = TRUE, include.rownames = FALSE, sanitize.text.function = function(x) x) @ \end{tabular} \caption{The number of ratings from nine judges in bitterness categories 1 --- 5. Wine data from \citet{randall89} aggregated over bottles and judges.% \label{tab:wineData}} \end{table}% Initially we consider the following cumulative link model for the wine data: \begin{equation} \label{eq:CLM} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j - \beta_1 (\mathtt{temp}_i) - \beta_2(\mathtt{contact}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation}% % where $\beta_1(\mathtt{temp}_i)$ attains the values $\beta_1(\mathtt{cold})$ and $\beta_1(\mathtt{warm})$, and $\beta_2(\mathtt{contact}_i)$ attains the values $\beta_2(\mathtt{no})$ and $\beta_2(\mathtt{yes})$. The effect of temperature in this model is illustrated in Figure~\ref{fig:standard_clm}. This is a model for the cumulative probability of the $i$th rating falling in the $j$th category or below, where $i$ index all observations ($n=72$), $j = 1, \ldots, J$ index the response categories ($J = 5$) and $\theta_j$ is the intercept or threshold for the $j$th cumulative logit: $\textup{logit}(P(Y_i \leq j))$. Fitting the model with \code{clm} we obtain: <<>>= library("ordinal") fm1 <- clm(rating ~ temp + contact, data = wine) summary(fm1) @ The \code{summary} method prints basic information about the fitted model. % most of which is self explanatory. % The primary result is the coefficient table with parameter estimates, standard errors and Wald based $p$~values for tests of the parameters being zero. If one of the flexible link functions (\code{link = "log-gamma"} or \code{link = "Aranda-Ordaz"}) is used a coefficient table for the link parameter, $\lambda$ is also included. The maximum likelihood estimates of the model coefficients are:% % \begin{equation} \label{eq:parameters} \begin{gathered} \hat\beta_1(\mathtt{warm} - \mathtt{cold})= 2.50, ~~\hat\beta_2(\mathtt{yes} - \mathtt{no}) = 1.53, \\ \{\hat\theta_j\} = \{-1.34,~ 1.25,~ 3.47,~ 5.01\}. \end{gathered} \end{equation} % The coefficients for \code{temp} and \code{contact} are positive indicating that higher temperature and contact increase the bitterness of wine, i.e., rating in higher categories is more likely. % Because the treatment contrast coding which is the default in \proglang{R} was used, $\{\hat\theta_j\}$ refers to the thresholds at the setting with $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{no}$. % Three natural and complementing interpretations of this model are % \begin{enumerate} \item The thresholds $\{ \hat\theta_j \}$ at $\mathtt{contact}_i = \mathtt{yes}$ conditions have been shifted a constant amount $1.53$ relative to the thresholds $\{ \hat\theta_j \}$ at $\mathtt{contact}_i = \mathtt{no}$ conditions. \item The location of the latent distribution has been shifted $+1.53 \sigma^*$ (scale units) at $\mathtt{contact}_i = \mathtt{yes}$ relative to $\mathtt{contact}_i = \mathtt{no}$. \item The odds ratio of bitterness being rated in category $j$ or above ($\mathrm{OR}(Y \geq j)$) is $\exp(\hat\beta_2(\mathtt{yes} - \mathtt{no})) = 4.61$. \end{enumerate} % Note that there are no $p$~values displayed for the threshold coefficients because it usually does not make sense to test the hypothesis that they equal zero. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm1_fig <- clm(rating ~ contact + temp, data=wine, link="probit") ## Version with arbitrary location and scale parameterization: alpha_ast <- .6 sigma_ast <- 1.4 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 5, 1), line=1, labels = seq(-2, 5, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: mtext(expression(paste(alpha, '*')), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta, '*'))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1], '*')), expression(paste(theta[2], '*')), expression(paste(theta[3], '*')), expression(paste(theta[4], '*'))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") @ <>= ## Version of figure with standardized location and scale: alpha_ast <- 0 sigma_ast <- 1 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 4, 1), line=1, labels = seq(-2, 4, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1])), expression(paste(theta[2])), expression(paste(theta[3])), expression(paste(theta[4]))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") @ \caption{Illustration of the effect of temperature in the standard cumulative link model in Equation~\ref{eq:CLM} for the wine data in Table~\ref{tab:wineData} through a latent variable interpretation. Left: Arbitrary location ($\alpha^*$) and scale ($\sigma^*$) and right: Standardized parameters.\label{fig:standard_clm}} \end{figure} The number of Newton-Raphson iterations is given below \code{niter} with the number of step-halvings in parenthesis. \code{max.grad} is the maximum absolute gradient of the log-likelihood function with respect to the parameters. % The condition number of the Hessian (\code{cond.H}) is well below $10^4$ and so does not indicate a problem with the model. The \code{anova} method produces an analysis of deviance (ANODE) table also based on Wald $\chi^2$-tests and provides tables with type I, II and III hypothesis tests using the \proglang{SAS} definitions. A type I table, the \proglang{R} default for linear models fitted with \code{lm}, sequentially tests terms from first to last, type II tests attempt to respect the principle of marginality and test each term after all others while ignoring higher order interactions, and type III tables are based on orthogonalized contrasts and tests of main effects or lower order terms can often be interpreted as averaged over higher order terms. Note that in this implementation any type of contrasts (e.g., \code{contr.treatment} or \code{contr.SAS} as well as \code{contr.sum}) can be used to produce type III tests. For further details on the interpretation and definition of type I, II and III tests, please see \citep{kuznetsova17} and \citep{SAStype}. Here we illustrate with a type III ANODE table, which in this case is equivalent to type I and II tables since the variables are balanced: <<>>= anova(fm1, type = "III") @ Likelihood ratio tests, though asymptotically equivalent to the Wald tests usually better reflect the evidence in the data. These tests can be obtained by comparing nested models with the \code{anova} method, for example, the likelihood ratio test of \code{contact} is <<>>= fm2 <- clm(rating ~ temp, data = wine) anova(fm2, fm1) @ which in this case produces a slightly lower $p$~value. Equivalently we can use \code{drop1} to obtain likelihood ratio tests of the explanatory variables while \emph{controlling} for the remaining variables: <<>>= drop1(fm1, test = "Chi") @ Likelihood ratio tests of the explanatory variables while \emph{ignoring} the remaining variables are provided by the \code{add1} method: <<>>= fm0 <- clm(rating ~ 1, data = wine) add1(fm0, scope = ~ temp + contact, test = "Chi") @ % Confidence intervals of the parameter estimates are provided by the \code{confint} method which by default compute the so-called profile likelihood confidence intervals: <<>>= confint(fm1) @ The cumulative link model in Equation~\ref{eq:CLM} assumes that the thresholds, $\{\theta_j\}$ are constant for all values of the remaining explanatory variables, here \code{temp} and \code{contact}. This is generally referred to as the \emph{proportional odds assumption} or \emph{equal slopes assumption}. We can relax this assumption in two general ways: with nominal effects and scale effects examples of which will now be presented in turn. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Partial and non-proportional odds: nominal effects} \label{sec:nominal-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The CLM in Equation~\ref{eq:CLM} specifies a structure in which the regression parameters, $\bm\beta$ are not allowed to vary with $j$ or equivalently that the threshold parameters $\{\theta_j\}$ are not allowed to depend on regression variables. In the following model this assumption is relaxed and the threshold parameters are allowed to depend on \code{contact}. This leads to the so-called partial proportional odds for \code{contact}: % \begin{equation} \label{eq:CLM_nominal} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j + \tilde{\beta}_{j} (\mathtt{contact}_i) - \beta (\mathtt{temp}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation} % One way to view this model is to think of two sets of thresholds being applied at conditions with and without contact as illustrated in Figure~\ref{fig:clm_nominal}. The model is specified as follows with \code{clm}: <<>>= fm.nom <- clm(rating ~ temp, nominal = ~ contact, data = wine) summary(fm.nom) @ As can be seen from the output of \code{summary} there are no regression coefficient estimated for \code{contact}, but there are additional threshold coefficients estimated instead. % The naming and meaning of the threshold coefficients depend on the contrast coding applied to \code{contact}. Here the \proglang{R} default treatment contrasts (\code{"contr.treatment"}) are used. Here coefficients translate to the following parameter functions: \begin{equation} \label{eq:nom_parameters} \begin{gathered} \hat\beta(\mathtt{warm} - \mathtt{cold})= 2.52, \\ \{\hat\theta_j\} = \{-1.32,~ 1.25,~ 3.55,~ 4.66\}, \\ \{ \hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}) \} = \{-1.62,~ -1.51,~ -1.67,~ -1.05\}. \end{gathered} \end{equation} % Again $\{ \theta_j \}$ refer to the thresholds at $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{no}$ settings while the thresholds at $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{yes}$ are $\{ \hat\theta_j + \hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}) \}$. % The odds ratio of bitterness being rated in category $j$ or above ($\mathrm{OR}(Y \geq j)$) now depend on $j$: $\{\exp(-\hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}))\} = \{ 5.03,~ 4.53,~ 5.34,~ 2.86\}$. % \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm_fig.nom <- clm(rating ~ temp, nominal =~ contact, data=wine, link="probit") th1 <- unlist(fm_fig.nom$Theta[1, 2:5]) # thresholds for contact: "no" th2 <- unlist(fm_fig.nom$Theta[2, 2:5]) # thresholds for contact: "yes" ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.nom$beta[1])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.nom$beta[1], H+dnorm(0), fm_fig.nom$beta[1], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.nom$beta[1], H+.3+dnorm(0), length=.1) text(fm_fig.nom$beta[1]-.2, loft-.22, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th1, side=1, col="red") segments(th1, -.05, th1, loft, col="red") mtext("contact: no", at=4.3, side=1, col="red") mtext(theta.text, at=th2, side=3, col="blue") segments(th2, 0, th2, loft+.05, col="blue") mtext("contact: yes", at=4.3, side=3, col="blue") @ \caption{Illustration of nominal effects leading to different sets of thresholds being applied for each level of \code{contact} in a latent variable interpretation, cf., Equation~\ref{eq:CLM_nominal}.\label{fig:clm_nominal}} \end{figure} The resulting thresholds for each level of \code{contact}, i.e., the estimated $\bm\Theta$-matrix can be extracted with: <<>>= fm.nom$Theta @ As part of the convergence checks, \code{clm} checks the validity of $\bm\Theta$, i.e., that each row of the threshold matrix is non-decreasing. We can perform a likelihood ratio test of the proportional odds assumption for \code{contact} by comparing the likelihoods of models (\ref{eq:CLM}) and (\ref{eq:CLM_nominal}) as follows: <<>>= anova(fm1, fm.nom) @ There is only little difference in the log-likelihoods of the two models and the test is insignificant. Thus there is no evidence that the proportional odds assumption is violated for \code{contact}. It is not possible to estimate both $\beta_2(\mathtt{contact}_i)$ and $\tilde{\beta}_{j}(\mathtt{contact}_i)$ in the same model. Consequently variables that appear in \code{nominal} cannot enter in \code{formula} as well. For instance, not all parameters are identifiable in the following model: <<>>= fm.nom2 <- clm(rating ~ temp + contact, nominal = ~ contact, data = wine) @ We are made aware of this when summarizing or printing the model in which the coefficient for \code{contactyes} is \code{NA}: <<>>= fm.nom2 @ To test the proportional odds assumption for all variables, we can use <<>>= nominal_test(fm1) @ This function \emph{moves} all terms in \code{formula} to \code{nominal} and \emph{copies} all terms in \code{scale} to \code{nominal} one by one and produces an \code{add1}-like table with likelihood ratio tests of each term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Modelling scale effects} \label{sec:scale-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % To allow the scale of the latent variable distribution to depend on explanatory variables we could for instance consider the following model where the scale is allowed to differ between cold and warm conditions. The location of the latent distribution is allowed to depend on both temperature and contact: \begin{equation} \label{eq:CLM_scale_wine} \begin{gathered} \textup{logit}(P(Y_i \leq j)) = \frac{\theta_j - \beta_1 (\mathtt{temp}_i) - \beta_{2} (\mathtt{contact}_i)} {\exp( \zeta (\mathtt{temp}_i))} \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{gathered} \end{equation} This model structure is illustrated in Figure~\ref{fig:clm_scale} and can be estimated with: <<>>= fm.sca <- clm(rating ~ temp + contact, scale = ~ temp, data = wine) summary(fm.sca) @ In a latent variable interpretation the location of the latent distribution is shifted $2.63\sigma^*$ (scale units) from cold to warm conditions and $1.59\sigma^*$ from absence to presence of contact. The scale of the latent distribution is $\sigma^*$ at cold conditions but $\sigma^* \exp(\zeta(\mathtt{warm} - \mathtt{cold})) = \sigma^*\exp(0.095) = 1.10 \sigma^*$, i.e., 10\% higher, at warm conditions. However, observe that the $p$~value for the scale effect in the summary output shows that the ratio of scales is not significantly different from 1 (or equivalently that the difference on the log-scale is not different from 0). Scale effects offer an alternative to nominal effects (partial proportional odds) when non-proportional odds structures are encountered in the data. Using scale effects is often a better approach because the model is well-defined for all values of the explanatory variables irrespective of translocation and scaling of covariates. Scale effects also use fewer parameters which often lead to more sensitive tests than nominal effects. Potential scale effects of variables already included in \code{formula} can be discovered using \code{scale_test}. This function adds each model term in \code{formula} to \code{scale} in turn and reports the likelihood ratio statistic in an \code{add1}-like fashion: <<>>= scale_test(fm1) @ \code{confint} and \code{anova} methods apply with no change to models with scale and nominal parts, but \code{drop1}, \code{add1} and \code{step} methods will only drop or add terms to the (location) \code{formula}. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= ## Scale differences: fm_fig.sca <- clm(rating ~ contact + temp, scale=~temp, data=wine, link="probit") ## Exagerate the scale for better visual: sca <- 1.5 # exp(fm_fig.sca$zeta) ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.sca$beta[2], sca)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0, ,sca)+H+.3, lty=3, lwd=2) segments(fm_fig.sca$beta[2], H+dnorm(0, ,sca), fm_fig.sca$beta[2], dnorm(0, ,sca)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, ,sca), fm_fig.sca$beta[2], H+.3+dnorm(0, ,sca), length=.1) text(fm_fig.sca$beta[2]-.2, loft-.35, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=fm_fig.sca$alpha, side=1) segments(fm_fig.sca$alpha, -2, fm_fig.sca$alpha, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, fm_fig.sca$alpha+.5), col="red") @ \caption{Illustration of scale effects leading to different scales of the latent variable, cf., Equation~\ref{eq:CLM_scale_wine}.\label{fig:clm_scale}} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Structured thresholds} \label{sec:threshold-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In section~\ref{sec:nominal-effects} nominal effects were described where the assumption that regression parameters have the same effect across all thresholds was relaxed. In this section additional restrictions on the thresholds will be imposed instead. The following model requires that the thresholds, $\{ \theta_j \}$ are equidistant or equally spaced. This allows us to assess an assumption that judges are using the response scale in such a way that there is the same distance between adjacent response categories, i.e., that $\theta_j - \theta_{j-1} = \textup{constant}$ for $j = 2, ..., J-1$. The effect of equidistant thresholds is illustrated in Figure~\ref{fig:clm_structured_thresholds} and can be fitted with: <<>>= fm.equi <- clm(rating ~ temp + contact, data = wine, threshold = "equidistant") summary(fm.equi) @ The parameters determining the thresholds are now the first threshold (\code{threshold.1}) and the spacing among consecutive thresholds (\code{spacing}). The mapping to this parameterization is stored in the transpose of the Jacobian matrix (\code{tJac}) component of the model fit. This makes it possible to extract the thresholds imposed by the equidistance structure with <<>>= drop(fm.equi$tJac %*% coef(fm.equi)[c("threshold.1", "spacing")]) @ These thresholds are in fact already stored in the \code{Theta} component of the model fit. % The following shows that the average distance between consecutive thresholds in \code{fm1} which did not restrict the thresholds is very close to the \code{spacing} parameter from \code{fm.equi}: <<>>= mean(diff(coef(fm1)[1:4])) @ One advantage of imposing additional restrictions on the thresholds is the use of fewer parameters. Whether the restrictions are warranted by the data can be assessed in a likelihood ratio test: <<>>= anova(fm1, fm.equi) @ In this case the test is non-significant, so there is no considerable loss of fit at the gain of saving two parameters, hence we may retain the model with equally spaced thresholds. Note that the shape of the latent distribution (determined by the choice of link function) also affects the distances between the thresholds. If thresholds are equidistant under a normal distribution (i.e., with the logit link) they will in general\footnote{The exception is perfect fits such as CLMs with flexible thresholds and no predictors where models have the same likelihood irrespective of link function.} not be equidistant under a differently shaped latent distribution such as a skew latent distribution (e.g., with the log-log or clog-log link). \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm_fig.flex <- clm(rating ~ contact + temp, data=wine, link="probit") th <- fm_fig.flex$alpha par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.flex$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: # mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.flex$beta[2], H+dnorm(0), fm_fig.flex$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.flex$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.flex$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta[1]), expression(Delta[2]), expression(Delta[3]))) @ <>= fm_fig.equi <- clm(rating ~ contact + temp, data=wine, threshold="equidistant", link="probit") th <- c(fm_fig.equi$alpha[1], fm_fig.equi$alpha[1] + cumsum(rep(fm_fig.equi$alpha[2], 3))) par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.equi$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.equi$beta[2], H+dnorm(0), fm_fig.equi$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.equi$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.equi$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta), expression(Delta), expression(Delta))) @ \caption{Illustration of flexible (left) and equidistant (right) thresholds being applied in a cumulative link model in a latent variable interpretation.\label{fig:clm_structured_thresholds}} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Scale effects, nominal effects and link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This section presents an example that connects aspects of scale effects, nominal effects and link functions. The example is based on the \code{soup} data available in the \pkg{ordinal} package. This dataset represents a sensory discrimination study of packet soup in which 185 respondents assessed a reference product and one of 5 test products on an ordinal sureness-scale with 6 levels from "reference, sure" to "test, sure". The two key explanatory variables in this example are \code{PRODID} and \code{PROD}. \code{PRODID} identifies all 6 products while \code{PROD} distinguishes test and reference products: <<>>= with(soup, table(PROD, PRODID)) @ The so-called bi-normal model plays a special role in the field of signal detection theory \citep{decarlo98, macmillan05} and in sensometrics \citep{christensen11} and assumes the existence of normal latent distributions potentially with different variances. The bi-normal model can be fitted to ordinal data by identifying it as a CLM with a probit link. The following bi-normal model assumes that the location of the normal latent distribution depends on \code{PRODID} while the scale only varies with \code{PROD}: <<>>= fm_binorm <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="probit") summary(fm_binorm) @ Here we observe significant differences in scale for reference and test products and this is an example of what would have been denoted non-proportional odds had the link function been the logit function. In this context differences in scale are interpreted to mean that a location shift of the latent normal distribution is not enough to represent the data. Another test of such non-location effects is provided by the nominal effects: <<>>= fm_nom <- clm(SURENESS ~ PRODID, nominal = ~ PROD, data = soup, link="probit") @ A comparison of these models shows that the scale effects increase the likelihood substantially using only one extra parameter. The addition of nominal effects provides a smaller increase in likelihood using three extra parameters: <<>>= fm_location <- update(fm_binorm, scale = ~ 1) anova(fm_location, fm_binorm, fm_nom) @ Note that both the location-only and bi-normal models are nested under the model with nominal effects making these models comparable in likelihood ratio tests. This example illustrates an often seen aspect: that models allowing for scale differences frequently capture the majority of deviations from location-only effects that could otherwise be captured by nominal effects using fewer parameters. The role of link functions in relation to the evidence of non-location effects is also illustrated by this example. If we consider the complementary log-log link it is apparent that there is no evidence of scale differences. Furthermore, the likelihood of a complementary log-log model with constant scale is almost the same as that of the bi-normal model: <<>>= fm_cll_scale <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="cloglog") fm_cll <- clm(SURENESS ~ PRODID, data = soup, link="cloglog") anova(fm_cll, fm_cll_scale, fm_binorm) @ Using the log-gamma link we can also confirm that a left-skewed latent distribution ($\lambda > 0$) is best supported by the data and that the estimate of $\lambda$ is close to 1 at which the complementary log-log link is obtained: <<>>= fm_loggamma <- clm(SURENESS ~ PRODID, data = soup, link="log-gamma") summary(fm_loggamma) @ The analysis of link functions shown here can be thought of as providing a framework analogous to that of Box-Cox transformations for linear models. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Profile likelihood} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In addition to facilitating the generally quite accurate profile likelihood confidence intervals which were illustrated in section~\ref{sec:fitting-basic-clm}, the profile likelihood function can also be used to illustrate the relative importance of parameter values. As an example, the profile likelihood of model coefficients for \code{temp} and \code{contact} in \code{fm1} can be obtained with % <>= pr1 <- profile(fm1, alpha = 1e-4) plot(pr1) @ The resulting plots are provided in Figure~\ref{fig:ProfileLikelihood}. The \code{alpha} argument controls how far from the maximum likelihood estimate the likelihood function should be profiled: the profile strays no further from the MLE when values outside an (\code{1 - alpha})-level profile likelihood confidence interval. From the relative profile likelihood in Figure~\ref{fig:ProfileLikelihood} for \code{tempwarm} we see that parameter values between 1 and 4 are reasonably well supported by the data, and values outside this range has little likelihood. Values between 2 and 3 are very well supported by the data and have high likelihood. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= plot(pr1, which.par = 1) @ <>= plot(pr1, which.par = 2) @ \caption{Relative profile likelihoods for the regression parameters in \code{fm1} for the wine data. Horizontal lines indicate 95\% and 99\% confidence bounds.} \label{fig:ProfileLikelihood} \end{figure} Profiling is implemented for regression ($\beta$) and scale ($\zeta$) parameters but not available for threshold, nominal and flexible link parameters. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Assessment of model convergence} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Likelihood slices} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The maximum likelihood estimates of the parameters in cumulative link models do not have closed form expressions, so iterative methods have to be applied to fit the models. Further, CLMs are non-linear models and in general the likelihood function is not guaranteed to be well-behaved or even uni-model. In addition, the special role of the threshold parameters and the restriction on them being ordered can affect the appearance of the likelihood function. To confirm that an unequivocal optimum has been reached and that the likelihood function is reasonably well-behaved around the reported optimum we can inspect the likelihood function in a neighborhood around the reported optimum. For these purposes we can display slices of the likelihood function. The following code produces the slices shown in Figure~\ref{fig:slice1} which displays the shape of the log-likelihood function in a fairly wide neighborhood around the reported MLE; here we use $\lambda=5$ curvature units, as well as it's quadratic approximation. <<>>= slice.fm1 <- slice(fm1, lambda = 5) par(mfrow = c(2, 3)) plot(slice.fm1) @ Figure~\ref{fig:slice1} shows that log-likelihood function is fairly well behaved and relatively closely quadratic for most parameters. \setkeys{Gin}{width=.32\textwidth} \begin{figure} \centering <>= plot(slice.fm1, parm = 1) @ <>= plot(slice.fm1, parm = 2) @ <>= plot(slice.fm1, parm = 3) @ <>= plot(slice.fm1, parm = 4) @ <>= plot(slice.fm1, parm = 5) @ <>= plot(slice.fm1, parm = 6) @ \caption{Slices of the (negative) log-likelihood function (solid) for parameters in \code{fm1} for the wine data. Dashed lines indicate quadratic approximations to the log-likelihood function and vertical bars indicate maximum likelihood estimates.} \label{fig:slice1} \end{figure} Looking at the log-likelihood function much closer to the reported optimum (using $\lambda = 10^{-5}$) we can probe how accurately the parameter estimates are determined. The likelihood slices in Figure~\ref{fig:slice2} which are produced with the following code shows that the parameters are determined accurately with at least 5 correct decimals. Slices are shown for two parameters and the slices for the remaining 4 parameters are very similar. <>= slice2.fm1 <- slice(fm1, parm = 4:5, lambda = 1e-5) par(mfrow = c(1, 2)) plot(slice2.fm1) @ \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= plot(slice2.fm1, parm = 1) @ <>= plot(slice2.fm1, parm = 2) @ \caption{Slices of the (negative) log-likelihood function (solid) for parameters in \code{fm1} for the wine data very close to the MLEs. Dashed lines (indistinguishable from the solid lines) indicate quadratic approximations to the log-likelihood function and vertical bars the indicate maximum likelihood estimates.} \label{fig:slice2} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Parameter accuracy} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% As discussed in section~\ref{sec:algorithm} the method independent error estimate provides an assessment of the accuracy with which the ML estimates of the parameters have been determined by the fitting algorithm. This error estimate is implemented in the \code{convergence} method which we now illustrate on a model fit: <<>>= convergence(fm1) @ The most important information is the number of correct decimals (\code{Cor.Dec}) and the number of significant digits (\code{Sig.Dig}) with which the parameters are determined. In this case all parameters are very accurately determined, so there is no reason to lower the convergence tolerance. The \code{logLik.error} shows that the error in the reported value of the log-likelihood is below $10^{-10}$, which is by far small enough that likelihood ratio tests based on this model are accurate. Note that the assessment of the number of correctly determined decimals and significant digits is only reliable sufficiently close to the optimum so in practice we caution against this assessment if the algorithm did not converge successfully. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Fitted values and predictions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Several types of fitted values and predictions can be extracted from a CLM depending on how it is viewed. By \emph{fitted values} we denote the values ($i=1, \ldots, n$) \begin{equation*} \hat{\tilde\pi}_i = \tilde\pi_i(\hat{\bm\psi}) \end{equation*} that is, the value of $\tilde\pi_i$, cf., Equation~\ref{eq:clm-log-likelihood} evaluated at the ML estimates $\hat{\bm\psi}$. These are the values returned by the \code{fitted} and \code{fitted.values} extractor methods and stored in the \code{fitted.values} component of the model fit. The values of $\pi_{ij}$ (cf., Equation~\ref{eq:multinom_pmf}) evaluated at the ML estimates of the parameters (i.e., $\hat\pi_{ij}$) can also be thought of as fitted values for the multinomially distributed variable $\bm Y_i^*$. These values can be obtained from the model fit by use of the \code{predict} method: <<>>= head(pred <- predict(fm1, newdata = subset(wine, select = -rating))$fit) @ Note that the original data set should be supplied in the \code{newdata} argument \emph{without} the response variable (here \code{rating}). If the response variable is \emph{present} in \code{newdata} predictions are produced for only those rating categories which were observed and we get back the fitted values: <<>>= stopifnot(isTRUE(all.equal(fitted(fm1), t(pred)[ t(col(pred) == wine$rating)])), isTRUE(all.equal(fitted(fm1), predict(fm1, newdata = wine)$fit))) @ Class predictions are also available and defined here as the response class with the highest probability, that is, for the $i$'th observation the class prediction is the mode of $\bm\pi_{i}$. To obtain class predictions use \code{type = "class"} as illustrated in the following small table: <<>>= newData <- expand.grid(temp = levels(wine$temp), contact = levels(wine$contact)) cbind(newData, round(predict(fm1, newdata = newData)$fit, 3), "class" = predict(fm1, newdata = newData, type = "class")$fit) @ Other definitions of class predictions can be applied, e.g., nearest mean predictions: <<>>= head(apply(pred, 1, function(x) round(weighted.mean(1:5, x)))) @ which in this case happens to be identical to the default class predictions. <>= p1 <- apply(predict(fm1, newdata = subset(wine, select=-rating))$fit, 1, function(x) round(weighted.mean(1:5, x))) p2 <- as.numeric(as.character(predict(fm1, type = "class")$fit)) stopifnot(isTRUE(all.equal(p1, p2, check.attributes = FALSE))) @ Standard errors and confidence intervals of predictions are also available, for example: <<>>= predictions <- predict(fm1, se.fit = TRUE, interval = TRUE) head(do.call("cbind", predictions)) @ where the default 95\% confidence level can be changed with the \code{level} argument. Here the standard errors of fitted values or predictions, $\hat{\tilde{\pi}} = \tilde{\pi}(\hat{\bm\psi})$ are obtained by application of the delta method: \begin{equation*} \mathsf{Var}(\hat{\tilde{\bm\pi}}) = \bm C \mathsf{Var}(\hat{\bm\psi}) \bm C^\top, \quad \bm C = \frac{\partial \tilde{\bm\pi}(\bm\psi)}{\partial \bm\psi} \Big|_{\bm\psi = \hat{\bm\psi}} \end{equation*} where $\mathsf{Var}(\hat{\bm\psi})$ is the estimated variance-covariance matrix of the parameters $\bm\psi$ evaluated at the ML estimates $\hat{\bm\psi}$ as given by the observed Fisher Information matrix and finally the standard errors are extracted as the square root of the diagonal elements of $\mathsf{Var}(\hat{\tilde{\bm\pi}})$. Since symmetric confidence intervals for probabilities are not appropriate unless perhaps if they are close to one half a more generally applicable approach is to form symmetric Wald intervals on the logit scale and then subsequently transform the confidence bounds to the probability scale. \code{predict.clm} takes this approach and computes the standard error of $\hat\kappa_i = \mathrm{logit}(\hat{\tilde{\pi}}_i)$ by yet an application of the delta method: \begin{equation*} \mathrm{se}(\hat\kappa_i) = \frac{\partial g(\hat{\tilde{\pi}}_i)}{\partial \hat{\tilde{\pi}}_i} \mathrm{se}(\hat{\tilde{\pi}}_i) = \frac{\mathrm{se}(\hat{\tilde{\pi}}_i)}{% \hat{\tilde{\pi}}_i(1 - \hat{\tilde{\pi}}_i)}, \quad g(\hat{\tilde{\pi}}_i) = \log \frac{\hat{\tilde{\pi}}_i}{1 - \hat{\tilde{\pi}}_i}. \end{equation*} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Model identifiability} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Unidentifiable models or unidentifiable parameters may happen in CLMs for several reasons some of which are special to the model class. In this section we describe issues around model identifiability and how this is handled by \code{ordinal::clm}. Material in the remainder of this section is generally on a more advanced level than up to now. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Complete separation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In binary logistic regression the issue of \emph{complete separation} is well known. This may happen, for example if only ``success'' or only ``failure'' is observed for a level of a treatment factor. In CLMs the issue may appear even when outcomes are observed in more than one response category. This can be illustrated using the \code{wine} data set if we combine the three central categories: <<>>= wine <- within(wine, { rating_comb3 <- factor(rating, labels = c("1", "2-4", "2-4", "2-4", "5")) }) ftable(rating_comb3 ~ temp, data = wine) fm.comb3 <- clm(rating_comb3 ~ temp, data = wine) summary(fm.comb3) @ Here the true ML estimates of the coefficients for \code{temp} and the second threshold are at infinity but the algorithm in \code{clm} terminates when the likelihood function is sufficiently flat. This means that the reported values of the coefficients for \code{temp} and the second threshold are arbitrary and will change if the convergence criteria are changed or a different optimization method is used. The standard errors of the coefficients are not available because the Hessian is effectively singular and so cannot be inverted to produce the variance-covariance matrix of the parameters. The ill-determined nature of the Hessian is seen from the very large condition number of the Hessian, \code{cond.H}. Note, however, that while the model parameters cannot be uniquely determined, the likelihood of the model is well defined and as such it can be compared to the likelihood of other models. For example, we could compare it to a model that excludes \code{temp} <<>>= fm.comb3_b <- clm(rating_comb3 ~ 1, data = wine) anova(fm.comb3, fm.comb3_b) @ The difference in log-likelihood is substantial, however, the criteria for the validity of the likelihood ratio test are not fulfilled, so the $p$~value should not be taken at face value. The complete-separation issue may also appear in less obvious situations. If, for example, the following model is considered allowing for nominal effects of \code{temp} the issue shows up: <<>>= fm.nom2 <- clm(rating ~ contact, nominal = ~ temp, data = wine) summary(fm.nom2) @ Analytical detection of which coefficients suffer from unidentifiability due to \emph{complete separation} is a topic for future research and therefore unavailable in current versions of \pkg{ordinal}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Aliased coefficients} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Aliased coefficients can occur in all kinds of models that build on a design matrix including linear models as well as generalized linear models. \code{lm} and \code{glm} determine the rank deficiency of the design matrix using the rank-revealing implementation of the QR-decomposition in \code{LINPACK} and displays the aliased coefficients as \code{NA}s\footnote{if the \code{singular.ok = TRUE} which is the default.}. Though the QR decomposition is not used during iterations in \code{clm}, it is used initially to determine aliased coefficients. An example is provided using the \code{soup} data available in the \pkg{ordinal} package: <<>>= fm.soup <- clm(SURENESS ~ PRODID * DAY, data = soup) summary(fm.soup) @ The source of the singularity is revealed in the following table: <<>>= with(soup, table(DAY, PRODID)) @ which shows that the third \code{PRODID} was not presented at the second day. The issue of aliased coefficients extends in CLMs to nominal effects since the joint design matrix for location and nominal effects will be singular if the same variables are included in both location and nominal formulae. \code{clm} handles this by not estimating the offending coefficients in the location formula as illustrated with the \code{fm.nom2} model fit in section~\ref{sec:nominal-effects}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Over parameterization} \label{sec:over-parameterization} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The scope of model structures allowed in \code{clm} makes it possible to specify models which are over parameterized in ways that do not lead to rank deficient design matrices and as such are not easily detected before fitting the model. An example is given here which includes both additive (location) and multiplicative (scale) effects of \code{contact} for a binomial response variable but the issue can also occur with more than two response categories: <<>>= wine <- within(wine, { rating_comb2 <- factor(rating, labels = c("1-2", "1-2", "3-5", "3-5", "3-5")) }) ftable(rating_comb2 ~ contact, data = wine) fm.comb2 <- clm(rating_comb2 ~ contact, scale = ~ contact, data = wine) summary(fm.comb2) @ <>= ## Example with unidentified parameters with 3 response categories ## not shown in paper: wine <- within(wine, { rating_comb3b <- rating levels(rating_comb3b) <- c("1-2", "1-2", "3", "4-5", "4-5") }) wine$rating_comb3b[1] <- "4-5" # Remove the zero here to avoid inf MLE ftable(rating_comb3b ~ temp + contact, data = wine) fm.comb3_c <- clm(rating_comb3b ~ contact * temp, scale = ~contact * temp, nominal = ~contact, data = wine) summary(fm.comb3_c) convergence(fm.comb3_c) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Customized modelling} \label{sec:customized-modelling} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Using the \code{doFit} argument \code{clm} can be instructed to return a \emph{model environment} that we denote \code{rho}: <<>>= rho <- update(fm1, doFit=FALSE) names(rho) @ This environment holds a complete specification of the cumulative link models including design matrices \code{B1}, \code{B2}, \code{S} and other components. The environment also contains the cumulative distribution function that defines the inverse link function \code{pfun} and its first and second derivatives, i.e., the corresponding density function \code{dfun} and gradient \code{gfun}. Of direct interest here is the parameter vector \code{par} and functions that readily evaluate the negative log-likelihood (\code{clm.nll}), its gradient with respect to the parameters (\code{clm.grad}) and the Hessian (\code{clm.hess}). The negative log-likelihood and the gradient at the starting values is therefore <<>>= rho$clm.nll(rho) c(rho$clm.grad(rho)) @ Similarly at the MLE they are: <<>>= rho$clm.nll(rho, par = coef(fm1)) print(c(rho$clm.grad(rho)), digits = 3) @ Note that the gradient function \code{clm.grad} assumes that \code{clm.nll} has been evaluated at the current parameter values; similarly, \code{clm.hess} assumes that \code{clm.grad} has been evaluated at the current parameter values. The NR algorithm in \pkg{ordinal} takes advantage of this so as to minimize the computational load. If interest is in fitting a \emph{custom} CLM with, say, restrictions on the parameter space, this can be achieved by a combination of a general purpose optimizer and the functions \code{clm.nll} and optionally \code{clm.grad}. Assume for instance we know that the regression parameters can be no larger than 2, then the model can be fitted with the following code: <<>>= nll <- function(par, envir) { envir$par <- par envir$clm.nll(envir) } grad <- function(par, envir) { envir$par <- par envir$clm.nll(envir) envir$clm.grad(envir) } nlminb(rho$par, nll, grad, upper = c(rep(Inf, 4), 2, 2), envir = rho)$par @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Constrained partial proportional odds} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A type of models which are not implemented in full generality in \pkg{ordinal} are the so-called \emph{constrained} partial proportional odds models proposed by \citet{peterson90}. These models impose restrictions on the nominal effects considered in section~\ref{sec:nominal-effects} and are well suited to illustrate the customisable modelling options available in the \pkg{ordinal} package. We consider an example from \citet{peterson90} in which disease status is tabulated by smoking status: <<>>= artery <- data.frame(disease = factor(rep(0:4, 2), ordered = TRUE), smoker = factor(rep(c("no", "yes"), each = 5)), freq = c(334, 99, 117, 159, 30, 350, 307, 345, 481, 67)) addmargins(xtabs(freq ~ smoker + disease, data = artery), margin = 2) @ The overall odds-ratio of smoking is <<>>= fm <- clm(disease ~ smoker, weights = freq, data = artery) exp(fm$beta) @ showing that overall the odds of worse disease rating is twice as high for smokers compared to non-smokers. Allowing for nominal effects we see that the log odds-ratio for smoking clearly changes with disease status, and that it does so in an almost linearly decreasing manor: <<>>= fm.nom <- clm(disease ~ 1, nominal = ~ smoker, weights = freq, data = artery, sign.nominal = "negative") coef(fm.nom)[5:8] @ \citet{peterson90} suggested a model which restricts the log odds-ratios to be linearly decreasing with disease status modelling only the intercept (first threshold) and slope of the log odds-ratios: <<>>= coef(fm.lm <- lm(I(coef(fm.nom)[5:8]) ~ I(0:3))) @ We can implement the log-likelihood of this model as follows. As starting values we combine parameter estimates from \code{fm.nom} and the linear model \code{fm.lm}, and finally optimize the log-likelihood utilizing the \code{fm.nom} model environment: <<>>= nll2 <- function(par, envir) { envir$par <- c(par[1:4], par[5] + par[6] * (0:3)) envir$clm.nll(envir) } start <- unname(c(coef(fm.nom)[1:4], coef(fm.lm))) fit <- nlminb(start, nll2, envir = update(fm.nom, doFit = FALSE)) round(fit$par[5:6], 2) @ Thus the log-odds decrease linearly from 1.02 for the first two disease categories by 0.3 per disease category. %% -- Illustrations ------------------------------------------------------------ %% - Virtually all JSS manuscripts list source code along with the generated %% output. The style files provide dedicated environments for this. %% - In R, the environments {Sinput} and {Soutput} - as produced by Sweave() or %% or knitr using the render_sweave() hook - are used (without the need to %% load Sweave.sty). %% - Equivalently, {CodeInput} and {CodeOutput} can be used. %% - The code input should use "the usual" command prompt in the respective %% software system. %% - For R code, the prompt "R> " should be used with "+ " as the %% continuation prompt. %% - Comments within the code chunks should be avoided - these should be made %% within the regular LaTeX text. %% -- Summary/conclusions/discussion ------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Conclusions} \label{sec:conclusions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This paper has described the class of cumulative link models for the analysis of ordinal data and the implementation of such models in the \proglang{R} package \pkg{ordinal}. It is shown how the package supports model building and assessment of CLMs with scale effects, partial proportional odds, structured thresholds, flexible link functions and how models can be costumized to specific needs. A number of examples have been given illustrating analyses of ordinal data using \code{clm} in practice. The significant flexibility of model structures available in \pkg{ordinal} is in one respect a clear advantage but it can also be a challenge when particular model variants turn out to be unidentifiable. Analytical detection of unidentifiable models could prove very useful in the analysis of ordinal data, but it is, unfortunately, a difficult question that remains a topic of future research. In a wider data analysis perspective, cumulative link models have been described as a very rich model class---a class that sits in between, in a sense, the perhaps the two most important model classes in statistics; linear models and logistic regression models. The greater flexibility of CLMs relative to binary logistic regression models facilitates the ability to check assumptions such as the partial proportional odds assumption. A latent variable interpretation connects cumulative link models to linear models in a natural way and also motivates non-linear structures such as scale effects. In addition to nominal effects and the non-linear scale effects, the ordered nature of the thresholds gives rise to computational challenges that we have described here and addressed in the \pkg{ordinal} package. In addition to computational challenges, practical data analysis with CLMs can also be challenging. In our experience a top-down approach in which a ``full'' model is fitted and gradually simplified is often problematic, not only because this easily leads to unidentifiable models but also because there are many different ways in which models can be reduced or expanded. A more pragmatic approach is often preferred; understanding the data through plots, tables, and even linear models can aid in finding a suitable intermediate ordinal starting model. Attempts to identify a ``correct'' model will also often lead to frustrations; the greater the model framework, the greater the risk that there are multiple models which fit the data (almost) equally well. It is well known statistical wisdom that with enough data many goodness of fit tests become sensitive to even minor deviations of little practical relevance. This is particularly true for tests of partial proportional odds; in the author's experience almost all CLMs on real data show some evidence of non-proportional odds for one or more variables but it is not always the case that models with partial or non-proportional odds are the most useful. Such effects complicate the interpretation and often generalize poorly outside the observed data and models assuming proportional odds or including scale effects are often more appropriate. %% -- Optional special unnumbered sections ------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section*{Computational details} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % \begin{leftbar} % If necessary or useful, information about certain computational details % such as version numbers, operating systems, or compilers could be included % in an unnumbered section. Also, auxiliary packages (say, for visualizations, % maps, tables, \dots) that are not cited in the main text can be credited here. % \end{leftbar} The results in this paper were obtained using \proglang{R}~\Sexpr{paste(R.Version()[6:7], collapse = ".")} with \pkg{ordinal}, version~\Sexpr{packageVersion("ordinal")}. \proglang{R} itself and all packages used are available from CRAN at \url{https://CRAN.R-project.org/}. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % \section*{Acknowledgments} % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % \begin{leftbar} % % All acknowledgments (note the AE spelling) should be collected in this % unnumbered section before the references. It may contain the usual information % about funding and feedback from colleagues/reviewers/etc. Furthermore, % information such as relative contributions of the authors may be added here % (if any). % \end{leftbar} %% -- Bibliography ------------------------------------------------------------- %% - References need to be provided in a .bib BibTeX database. %% - All references should be made with \cite, \citet, \citep, \citealp etc. %% (and never hard-coded). See the FAQ for details. %% - JSS-specific markup (\proglang, \pkg, \code) should be used in the .bib. %% - Titles in the .bib should be in title case. %% - DOIs should be included where available. \bibliography{clm_article_refs} %% -- Appendix (if any) -------------------------------------------------------- %% - After the bibliography with page break. %% - With proper section titles and _not_ just "Appendix". \newpage \begin{appendix} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{A regularized Newton-Raphson algorithm with step halving} \label{sec:algorithm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The regularized NR algorithm is an iterative method that produce a sequence of estimates $\bm\psi^{(0)}, \ldots, \bm\psi^{(i)}, \ldots$, where parenthesized superscripts denote iterations. From the $i$th estimate, the $(i+1)$'th estimate is given by % \begin{equation*} \bm\psi^{(i+1)} = \bm\psi^{(i)} - c_1 \bm h^{(i)}, \quad \bm h^{(i)} = \tilde{\bm H}(\bm\psi^{(i)}; \bm y)^{-1} \bm g(\bm\psi^{(i)}; \bm y) \end{equation*} where \begin{equation*} \tilde{\bm H}(\bm\psi^{(i)}; \bm y) = \bm H(\bm\psi^{(i)}; \bm y) + c_2 (c_3 + \min(\bm e^{(i)})) \bm I, \end{equation*} % % where % $\bm h^{(i)}$ is the step of the $i$th iteration, $\bm H(\bm\psi^{(i)} ; \bm y)$ and $\bm g(\bm\psi^{(i)}; \bm y)$ are the Hessian and gradient of the negative log-likelihood function with respect to the parameters evaluated at the current estimates; $\bm e^{(i)}$ is a vector of eigenvalues of $\bm H(\bm\psi^{(i)}; \bm y)$, $\bm h^{(i)}$ is the $i$'th step, $c_1$ is a scalar parameter which controls the step halving, and $c_2$, $c_3$ are scalar parameters which control the regularization of the Hessian. Regularization is only enforced when the Hessian is not positive definite, so $c_2 = 1$ when $\min(\bm e^{(i)}) < \tau$ and zero otherwise, were $\tau$ is an appropriate tolerance. The choice of $c_3$ is to some extent arbitrary (though required positive) and the algorithm in \pkg{ordinal} sets $c_3 = 1$. Step-halving is enforced when the full step $\bm h^{(i)}$ causes a decrease in the likelihood function in which case $c_1$ is consecutively halved, $c_1 = \frac{1}{2}, \frac{1}{4}, \frac{1}{8}, \ldots$ until the step $c_1 \bm h^{(i)}$ is small enough to cause an increase in the likelihood or until the maximum allowed number of consecutive step-halvings has been reached. The algorithm in \pkg{ordinal} also deals with a couple of numerical issues that may occur. For example, the likelihood function may be sufficiently flat that the change in log-likelihood is smaller than what can be represented in double precision, and so, while the new parameters may be closer to the true ML estimates and be associated with a smaller gradient, it is not possible to measure progress by the change in log-likelihood. The NR algorithm in \pkg{ordinal} has two convergence criteria: (1) an absolute criterion requesting that $\max | \bm g(\bm\psi^{(i)}; \bm y) | < \tau_1$ and (2) a relative criterion requesting that $\max | \bm h^{(i)} | < \tau_2$ where the default thresholds are $\tau_1 = \tau_2 = 10^{-6}$. Here the first criterion attempts to establish closeness of $\bm\psi^{(i)}$ to the true ML estimates in absolute terms; the second criterion is an estimate of relative closeness of to the true ML estimates. % Both convergence criteria are needed if both small (e.g., $\approx 0.0001$) and large (e.g., $\approx 1000$) parameter estimates are to be determined accurately with an appropriate number of correct decimals as well as significant digits. The NR algorithm in \pkg{ordinal} attempts to satisfy the absolute criterion first and will then only attempt to satisfy the relative criterion if it can take the full un-regularized NR step and then only for a maximum of 5 steps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Convergence properties and parameter accuracy} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Convergence to a well-defined optimum is achieved when the gradient of the negative log-likelihood function with respect to the parameters is small and the Hessian is positive definite i.e., having only positive eigenvalues away from zero. % Identifiability problems occur when the likelihood function is flat in directions of one or more parameters (or linear functions of the parameters) while well-defined, i.e., pointy in other directions. It may happen that a parameter is exactly unidentifiable and \code{clm} is in some cases (including rank-deficient design matrices) able to detect this and exclude the parameter from the optimization procedure. In other cases the likelihood is almost flat in one or more directions. These cases are not uncommon in practice and it is not possible to reduce the parameter space before optimizing the model. To measure the degree of empirical identifiability \code{clm} reports the condition number of the Hessian which is the ratio of the largest to the smallest eigenvalue. A large condition number of the Hessian does not necessarily mean there is a problem with the model, but it can be. A small condition number of the Hessian, say smaller than about $10^4$ or $10^6$, on the other hand is a good assurance that a well-defined optimum has been reached. A key problem for optimization methods is when to stop iterating: when have the parameters that determine the optimum of the function been found with sufficient accuracy? The \emph{method independent error estimate} \citep{elden04} provides a way to approximate the error in the parameter estimates. Sufficiently close to the optimum the Newton-Raphson step provides this estimate: \begin{equation*} |\hat{\bm\alpha}^{(i)} - \bm\alpha^*| \lesssim \bm h^{(i)}, \quad \bm h^{(i)} = \bm H(\bm\psi^{(i)}; \bm y)^{-1} \bm g(\bm\psi^{(i)}; \bm y) \end{equation*} where $\bm\alpha^*$ is the exact (but unknown) value of the ML estimate, $\hat{\bm\alpha}^{(i)}$ is the ML estimator of $\bm\alpha$ at the $i$'th iteration and $\bm h^{(i)}$ is the full unregularized NR step at the $i$'th iteration. % Since the gradient and Hessian of the negative log-likelihood function with respect to the parameters is already evaluated and part of the model fit at convergence, it is essentially computationally cost-free to approximate the error in the parameter estimates. Based on the error estimate the number of correctly determined decimals and significant digits is determined for each parameter. The assessment of the number of correctly determined decimals and significant digits is only reliable sufficiently close to the optimum and when the NR algorithm converges without regularization and step-halving. In practice we caution against this assessment if the algorithm did not converge successfully. % % \begin{leftbar} % Appendices can be included after the bibliography (with a page break). Each % section within the appendix should have a proper section title (rather than % just \emph{Appendix}). % % For more technical style details, please check out JSS's style FAQ at % \url{https://www.jstatsoft.org/pages/view/style#frequently-asked-questions} % which includes the following topics: % \begin{itemize} % \item Title vs.\ sentence case. % \item Graphics formatting. % \item Naming conventions. % \item Turning JSS manuscripts into \proglang{R} package vignettes. % \item Trouble shooting. % \item Many other potentially helpful details\dots % \end{itemize} % \end{leftbar} % % % \section[Using BibTeX]{Using \textsc{Bib}{\TeX}} \label{app:bibtex} % % \begin{leftbar} % References need to be provided in a \textsc{Bib}{\TeX} file (\code{.bib}). All % references should be made with \verb|\cite|, \verb|\citet|, \verb|\citep|, % \verb|\citealp| etc.\ (and never hard-coded). This commands yield different % formats of author-year citations and allow to include additional details (e.g., % pages, chapters, \dots) in brackets. In case you are not familiar with these % commands see the JSS style FAQ for details. % % Cleaning up \textsc{Bib}{\TeX} files is a somewhat tedious task -- especially % when acquiring the entries automatically from mixed online sources. However, % it is important that informations are complete and presented in a consistent % style to avoid confusions. JSS requires the following format. % \begin{itemize} % \item JSS-specific markup (\verb|\proglang|, \verb|\pkg|, \verb|\code|) should % be used in the references. % \item Titles should be in title case. % \item Journal titles should not be abbreviated and in title case. % \item DOIs should be included where available. % \item Software should be properly cited as well. For \proglang{R} packages % \code{citation("pkgname")} typically provides a good starting point. % \end{itemize} % \end{leftbar} % \end{appendix} %% ----------------------------------------------------------------------------- \end{document} ordinal/data/0000755000176200001440000000000015125475162012623 5ustar liggesusersordinal/data/income.rda0000644000176200001440000000047415125475162014572 0ustar liggesusers‹ }RĎJĂ0ŹIgY™Cń"Ä‹‚JfŇŇo9čÍ“§]C›‚Đ­’Ĺ›ŻˇĎ¤/ă¬&mľJ‹óŻß˙żôáv‹!„ž&Fő°ůěŢ}\ĄĺR!DŤeÂdĎČ©ËŘĆx;÷»ęYkŁí» ëőřÍśýę TŤŇB®ˇ¨k•Ë´*µŃ6nÁ©8F ‰ÓĽ!qţnéC$o­˙:jH\¸řÜŮNąú“OK_âŇĺť9?»oýw“FŔÁ-`Čł+Ű ű˙Ç외v—ůî2ÂhjDcPcšF ĺ€×3ĘĂÎ)ď x|ŐN 0÷Kť)­˛ż ě#ż’KČ˙ޤ†!Oi5üszĆş|™A‹¶oQ×ő÷`7(2YÉY®ĄmŐĽíćě^;¶ordinal/data/soup.rda0000644000176200001440000002170615125475162014307 0ustar liggesusers‹ íÝw€$ÇY÷ń­§Şž±dMŽ&ÇłµłávÁËŇYlť|’Á&ú°V¶±N2’ś&çśsÎ9gx#Ľ9Ŕ›_x_xĽ9Ŕ›âŰŇvwÝŁęŮgćúÔŁÝůă'őNčę źęęžÝąK·ľx~ă‹oÜÚÚ’-yrŘ’ČfţČ ÍŢ˙šWomŧ˛ýţ˙&[[łóÇĎ{"ÎDg’3ŮufćĚ“śąÁ™ťy˛3OqćMśySgŢĚ™7wć-śyKgžęĚ[9óÖÎĽŤ3oëĚŰ9óöÎĽ3ďčĚ;9óÎÎĽ‹3ďęĚÓśy7gŢÝ™÷pć=ťy/gŢŰ™÷qć}ťy?gŢß‘pćť9çĚÓťy†379łíĚÜ™gvťŮsfß™óÎ8sčĚ9óÁÎ<Ó™qćYÎ|¨3ĎvćfgžăĚ-ÎÜęĚgžëĚmÎ|3ĎsćĂťůgžďĚ śąÝ™‹ÎÜáĚ ťąäĚťÎÜĺĚ‹śůHg>Ę™;óg>Ú™Źqćcťů8g>Ţ™OpćĄÎ\vćťy™3w;säĚ=ÎĽÜ™W8óJg>É™W9sŻ3WśąĎ™űťyµ3źěĚÎ<čĚCÎĽĆ™×:ó:g^ďĚśůg>Ő™OsćÓťů g>Ó™7:óYÎ|¶3źăĚç:óyÎ|ľ3_ŕĚ:óEÎ|±3_âĚ—:óeÎ|ą3_áĚW:óUÎ|µ3_ăĚ×:ňuÎ|˝3ßŕĚ7:óMÎ|ł3ßâĚ·:ómÎ|»3ßáĚw:ó]Î|·3ßăĚ÷:ó}Î|ż3?ŕĚ:óCÎü°3?âĚŹ:ňcÎü¸3?áĚO:óSÎü´3?ăĚĎ:ósÎüĽ3żŕĚ/:óKľ\őů§Ţ{ôÚŁ{›Ő˘y4l·óvc§ÝŘm7öÚŤývă|»qpĽ!Ű7u[ŰÝÖN·µ×míw[ç»­ĂvkŢíeŢíe>ﶺýÍw»­nĎónĎónĎóîřć];];];];];];];];Ýžwş=ďv{ŢíöĽŰíe·ŰËn·—ÝîHw»ýívűŰëö˛×ß^w|{Ýž÷ş=ďu{ŢëöĽ×íyŻŰó~w¤ű]ű]Ýcýc]ą]ą]ą]ą]ą]ą]ą‡]ą‡]‡]‡]‡]‡]‡]‡]‡]‡mqű¦›úÍí~sŢoîô›»ýć^żąßožď7úÍľ´íľ´íľ´íľ´íľ´íľ´íľ´íľ´íľ´íľ´íľ´y_ÚĽ/mŢ—6ďK›÷ĄÍűŇć}ióľ´y_ÚĽ/m§/m§/m§/m§/m§/m§/m§/m§/m§/m§/m·/m·/m·/m·/m·/m·/m·/m·/m·/m·/mŻ/mŻ/mŻ/mżtżx´?†ýţöű‚÷ű‚÷ű‚÷ű‚Ď÷źď‹8ßqľ/â|_ÄůľšçűŇÎ÷ĄťďK;ß—vĐ—vĐ—vĐ—vĐqĐqĐqĐqĐqĐqŘqŘqŘqŘWč°/í°/í°/í°/í°/­×=ďuĎ{Ýó^÷Ľ×=ďuĎ{Ýó^÷Ľ×=ďuĎ{Ýó^÷Ľ×=ďuĎ{Ýó^÷Ľ×=ďuĎ{Ýó^÷Ľ×=ďuĎÝWťżóËî˝ü`{úîNę÷\~ŮC÷7·ľţÔüJ“Tţ_&ś°]űµ§ˇý˝˙¤çĆzl•çŻĄţµç=·čůE}3ôşÚľW©÷бžt «ôÁ˘rWéGo;{úí¤¶]ÔO‹ęçéË“ęá}Ź§ŻĹÂIíĺí/oÝĽăzŮ2–éÓEăsŐ¶]vĽ.3§­ŇĎËó*ăl•±˛ęţíc•ń˝l˝W[Ţ÷®2FWm«“ÚţZ^ďÝߪĽý¶LýW­ß˘q·Ě?©ý–űµ}Żâo•ç˝uôľvŐqďí[Ďc'=~-ý±Ěxôď2í|’•eßłŚéeúp™ţ9©N×Ň–«Ě'µß2ă`¬ş,3/,Ó×:W-s<«ŚżEőZvÎ[ĹíXăn•ö]ÔďËŽ“UúĂŰnž184GyŹuŮă_Ą'ó˛cĂŰżž˙Żęhčý«öŁ·¬eÇÄ*usîňöŃ*cýZĆѢ÷^«_O[¬˛żeű™ům•cšgĽý˛Šß“Ć„·~ËôĹŞýZkϱçľUÚÝŰ·×ňzďcCí|­–=†Ë×zÚŃkdŮ6[v{YßËĚi×ҧŢcóŽŮ1ĆŕăuUs‹Ţż¨ź®Ąďe]†îżÔĆ_mk·íąjčŢ“]—Ô®kkî†ĆýĐ}A;ÖjăÓ®‹lżŮűö<\/vž˛ćkěő‹­Ó˘µmŰ/µ1aëkűŻ¶Ö¶ÇeËo÷[»ßS›síţÚ}Ř5úP=jăÍžKĘăłu®™şď7t˙­v˝šĚëNşď·Č¤uQ–S»oV[[ŐÚzčZ«lŰ.µµń˘ó|ŮĺqÔî—…­Ç¶GŰ^v®·cÎÖ×ú°kíÚ=’˛žµ5Í2ăohiç?ëŰö}m­^+ł\G ]Ůő€­kŰďµůŢÖ×ÖahL-şć[TŹrLťWký_»vşŹS¶É˘űC÷ŚěYdŁÖomÝă*ëP»OR›Ëjmg×vŤhßWÎ)ˇňţăvąęĂŇć5ͧ KăĂźĄ¶uÎf[̶Ď·ŰRüżlżd^Ó/T:)Ç-',xLŠýëÖcŹ«ö^­izo­ţC}[[é·t8dĚÎ+‹ÚĂÖÍž†úa¨>ĄŮňěůlŃţíÜvҸ/ĎqŮěǶ}íü}RűÔÚtQ_fł]s;÷Úó“íďEă¤ÖŻµó¶=žZ›µM­.e}¬ťr\¶sÁ˘çŰvhËłë3;/•©Ť÷EífĎçöü_›»kcş\·—í^;g×ÎíÖl9_•sŢĐúÄn×ÖصĎjó©—¶]˶­Ť›Ú_tĽjĘ2^ł`ÇZ¬ěłÖ¶¶®Ó5CÇj÷Y».łçŞÚ8lÇ(łVľç<Ҧ†Ća­\ŰćµçË9°ô–¶믭ź=˙–k»ďˇă.ďłŘqQ>nŻCěóĄ»löoëVľnčšÓł&]tľ¶sę˘ëšZ{Řý۹ʎ…rma׶ŤÂÖđ\[ţßžCl™‹Öµ¶¬][•÷ŻËĎě}uŰŽĄ#űنµőuÚŞ×Á­ŐŃ^×ƆMíú©¶ĆşwU»¶ĄĹňýµóˇť/ĘvE9e[ź479±÷[ěë†ć€Z»ÚëąÚ9®6íë†úkŃq.ë幧+ĺcv˝P¶Ki |M2Ż/×C×4íűěuM.Ţ_źťóË>±Ź•ç›˛­ě}ăÚąŔި]3´Ż+瀡ńgçřň<44o,Š <®ćąÚ9Ôş*ŹĎ:«ŤóˇqhŻ/jó][ Ů·×Ú©Řn÷»hţ«9·ç“˛żjëŐšŰnĺçFyë±m`ŻŁŰÇËuť]»Ř÷ÔĆy­Ý‹Ď«®Ăg©rüÄěţî>zŕčî­“ţLŐ×Z ď“^çŮß2ĺNőş1ë»îŻ{ŚÝż×cĽŚ]ďx9Kí·î.ŻG»ś†ń2vą§Ą/¦:ľÍë6ŻűugŃ›§ÜëŃ.§ˇÜeŽĎŰżS´Ëş·óŘ>NKąO„zLőşMű]˙ö»íć×}n»Ü±ë;öń­űĽ1•ŹÇ{ţ~˘ä¬őﺏ—u?Oź–v9-őťŞSąűĽ5Őúŕ¬őŰTóÚiÉY›˙¦ŞÇŘóĐ:ç´Ś•ŤŤőĘÔăz]mĆŢőĎšĎW}NÚGó)č wÝ{Ďą+—ď>:~@oą|ß}Ý“În}ŕ 箼ňőK}†:Őx[g[×ăřÎZ}§:ľuo—łVŹuo—Ó2ţ¦j—1ë1ö˝uď‹uďŰ©­?ŃŰyÝë{ZĘ=-ÎÇľ'ĽîŽ¦j—łć|Şý­{;Ż{}§jżu/÷¬Ťł¶Ţ]÷śµq0U˙žµqµîăyÝ}¬óXžŞĎĆž[¦®÷şŽůu/wŞk¨ÓĐ·cďoÝ­ť’úV?Cť=kűŻ;:zŐńŹ7lźŰ}Ć•űď{čÇ<é™ŰíĎO€żD=kŮ´ó¦ť7Ůä¬fcr=Úřz´ói™s§ZŤ®{6í˛ÉiĘYϧĄ›öŰÔcSßM®WĆ>/L5ţÖ}ÜŹ}|ë^ßM6ý¶É&›l2eÎŘ|[ýĆ^ąýţă­ř’Ł—ú¨tćĚ“śÉÎÜčĚI˙ćuďńMUnrĆŰ~c—ëŢvńĆ[®·]ĽűóćgĆ®‡7c·óŘă`ě~»]Ć®‡×Ą·ľ^żŢr˝ăyěq5ć\ęí o]˝űÜáí۱ű»Üđţ˘ŘŘc~ěŚ}|SÍácĎUSĹŰcgl—cź+˝™j<Ź˝†őλŢyhěsęŘăĹ[ß±×öŢKä±çݱŰeŞrÇ^3Ťť±ĎűcŹ±çµ±×ÄŢŚý‹óc÷ďTçoxŰoŞk”©ĆŐTóÁŘăjŞkä±×cź÷˝ó·ýĆ®ÇTăĹ»ż±ÇËk!ďŘ{ŚN5·Ś}m4Ő\ę=>ŻÉ±Ç·Ţąeěr˝ă`ěsęóŮŘ÷ýĆ>ľ±ŻgÇ>y3ňőńU•Ţ¸UůÇMÝŘi7vŰŤ˝vcżÝ8ßn´‡Ç˛}ÓÖőřŰÔ±3öçé›ă{|~oá¬eŞßűşŢOôz¬»Ź©ŽoÝűmŠ:¬{›Ś=V¦ĘşŹu?ľuŻďş·ßćřźńwZĆý¦׫ľëžÓŇ~§ĹůfëŐoSeÝ}¬{}§jż©ö·îő=-YgżS·Íş¶Ý&›ţX¦ľ§ˇ]Öyžš˛Ť×Ľo«›š^půŢŁăm}îŃ•G~ZâóұąĐ»ż±Űú´Ôcě_‚]ó1=úś0ö/ MŐ.cßŘăyě_P»ßĆv>UĆ/Sy›˘í6ëk› ¦šĂ§šëÇž«Öý8Őř;cŹ©Úyl—Sť‹ĆvtZ\ž†sę2íج7Ö«Üu?OŹí|ěr×y˝6ö±Ť=–§š Ć^űŤť©-=Ţ6Ć6>vąSřXçye™ŚÝ·SÍóťÇŻúĽ´y¬ů4ośŰą©ýagűÜn÷Ăîöą˝î‡˝ísű{[Ë|’:Ő(Ůd“M6Ůd“MÎF¦ľĘÚd“M6Ůd“M6Ůd“'RĆľ+˝É&›l˛É&›lrĘrŐ'©Íúé‘Ż ľtôňWŢßÓ¶ÍĎsóóŽçSÔćÝ3ůľËWšgő‘—?ĺřÁtéÂťw´Űw\şxk»›fűyíOOşóE—.Ü~áÎ;ŹŽ·Ţü’î©‹/şă®—Üqˇüůą—.Ľ°Ýé-źßî&]¸ůÎö}zŰ…Űo˝p©}×Í·]¸íďl~ţĹ[nľëyo7u¸áű_÷ô¶ĺGÄrÜ„ÍŇíżNÖ~S{űŻŕ=ů¸ŢĽoëMÉ›·Ĺ[·$O%oEŢšĽ y[ňväíÉ;w$ďDŢ™Ľ yWň4ňnäÝÉ{÷$ďEŢ›Ľy_ň~äýÉ$çČÓÉ3HóÉxÓŐM÷6_éÜ|›sóEÎÍw87ukľąąůŇć"LžI>„<‹|(y6ą™<‡ÜBš¦nşâąä6ňaäyäĂÉGç“vë"iĽéަ#šŢ˝‹Ľ|$ů(ňbŇtŮG“Ź!K>Ž|<ůňRr™|"yą›48}y9yy%ů$ň*r/ąBî#Í?˙űjňɤ°Mź>D^C^K^G^OŢ@>…|*ů4ňéä3Čg’7’Ď"źM>‡|.ů<ňůä Č’/"_Lľ„|)ů2ňĺä+ČW’Ż"_Mľ†|-ů:ňőäČ7’o"ßLľ…|+ů6ňíä;Čw’ď"ßMľ‡|/ů>ňýäČ’"?L~„ü(ů1ňăä'ČO’ź"?M~†ü,ů9ňóäČ/’_"żL~…ü*ů5ňëä7Čź#žüňÉ_"™ü&ů-ňWČ_%Ťüuň7Čß$‹ümňwČß%żM~‡ü=ň÷É? ˙ü#ňŹÉ?!˙”ü.ů=ňĎČ?'żOţ€ü ň/Éż"˙šü!ů#ňoČż%˙Žü{ňČ$˙‰ügň_Č%Lţ„ü7ňßÉ˙ ˙“ü/ňżÉ˙!˙—ü?ň˙·™Ü¶>ţä†˙üüüüüüüüüüüüüüüüüüüüüüüüüüüüüü‡§üüüüüüüüüüüüüüüü7_îŢ|Ż{ó•îÍ·ą7_äŢ|‡{óőíÍ7·7_ÚđđđđđđžMđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđ^JđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđŢHđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđđ>^Iá_šĄţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚Áżŕ_đ/řü ţ˙‚ÁséôČťgüÇćR"ţ#ţ#ţ#ţ#ţ#ţ#ţ#ţ#ţ›_-ŤřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹřŹ·4f˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙±ůń‡Ź'=ęŚ;(íü\ç°ó±öďDŘëx } Ľ ~ f_wťůzĐםőnł~čě;×Çţrź8ů¸˙Ż}›u3 …˙@żŞ.UßšBŔŹú‡đ3ăĄÇyĚéř™¶ŔÇ…'ŤúÔĺc“r™vëĆ ~ë,6bő]Ĺą–ˇ‚Ęę-PX¤°Da™ÂŠ3UŘŹŁś3I›i6P™0ÝYÔ/ŇLKWƆy¤˙|Ľę˛;Ť úiĚ®Ł(Ö~>ýn6řÖŽ»ÜëÓ;.“’˙Cĺwn·ůW¨ÎYuó55Z÷ăV»[ân˙ ZXĄ°Fáů_ipŹ¬‹i˙ůI÷Đ$„3Đć ´f };¬˘ýěP-¬˙ÉVŮwM ­Lĺ—i’+†gQq‘śC 5Ľ„Üě§Iˇç¦ă—´(b†…_ż Ε“°ťĄŁy&­>Yę×x<ţ9ĄöÎ *˘ůłL‡Ôő‹«kµ§ńË ordinal/src/0000755000176200001440000000000015130020365012464 5ustar liggesusersordinal/src/links.h0000755000176200001440000000407415127777706014015 0ustar liggesusers///////////////////////////////////////////////////////////////////////////// // Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen // // This file is part of the ordinal package for R (*ordinal*) // // *ordinal* is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // *ordinal* 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 // and/or // . ///////////////////////////////////////////////////////////////////////////// #ifndef _ORDINAL_LINKS_H_ #define _ORDINAL_LINKS_H_ /* That ifndef, etc. is an idiom to prevent the body of the header * being read more than once. */ #include #include #ifdef __cplusplus extern "C" { #endif /* That stanza allows the same header file to be used by C and C++ * programs. There is a matching stanza at the end of this header * file. */ /* Additional scalar cumulative probability functions */ double d_pgumbel (double,double,double,int); double d_pgumbel2 (double,double,double,int); double d_pAO (double,double,int); double d_plgamma (double,double,int); /* Additional scalar density functions */ double d_dgumbel (double,double,double,int); double d_dgumbel2 (double,double,double,int); double d_dAO (double,double,int); double d_dlgamma (double,double,int); /* Scalar density gradients */ double d_glogis (double); double d_gnorm (double); double d_gcauchy (double); double d_ggumbel (double); double d_ggumbel2 (double); double d_gAO (double,double); double d_glgamma (double,double); #ifdef __cplusplus } #endif #endif ordinal/src/get_fitted.c0000755000176200001440000001150215127777706015000 0ustar liggesusers///////////////////////////////////////////////////////////////////////////// // Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen // // This file is part of the ordinal package for R (*ordinal*) // // *ordinal* is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // *ordinal* 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 // and/or // . ///////////////////////////////////////////////////////////////////////////// #include #include #include #include "links.h" SEXP get_fitted(SEXP, SEXP, SEXP, SEXP); // ------------------------------------------------------- SEXP get_fitted(SEXP eta1p, SEXP eta2p, SEXP linkp, SEXP lambdap) { /* Compute fitted values (probabilities) from vectors of linear predictors (eta1 and eta2) given the link function (linkp) and an optional lambda parameter. eta1 and eta2 are required to be equal length numeric vectors, linkp a character vector and lambdap a numeric scalar. return: vector of fittec values of same length as eta1 and eta2. */ SEXP ans = PROTECT(duplicate(coerceVector(eta1p, REALSXP))); eta2p = PROTECT(coerceVector(eta2p, REALSXP)); linkp = PROTECT(coerceVector(linkp, STRSXP)); const char *linkc = CHAR(asChar(linkp)); double *eta1 = REAL(ans), *eta2 = REAL(eta2p), lambda = asReal(lambdap); int i, nans = LENGTH(ans); if(LENGTH(eta2p) != nans) { // ".. don't have to UNPROTECT before calling into "error"; it is not a bug to do so, but it is not needed either, error will result in a long jump that will UNPROTECT automatically." Email from Tomas Kalibra 19Apr2018. ; UNPROTECT(3); error("'eta1' and 'eta2' should have the same length"); } if(strcmp(linkc, "probit") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // pnorm(x, mu, sigma, lower_tail, give_log); eta1[i] = pnorm(eta1[i], 0.0, 1.0, 1, 0) - pnorm(eta2[i], 0.0, 1.0, 1, 0); else eta1[i] = pnorm(eta2[i], 0.0, 1.0, 0, 0) - pnorm(eta1[i], 0.0, 1.0, 0, 0); } } else if(strcmp(linkc, "logit") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // plogis(x, mu, sigma, lower_tail, give_log); eta1[i] = plogis(eta1[i], 0.0, 1.0, 1, 0) - plogis(eta2[i], 0.0, 1.0, 1, 0); else eta1[i] = plogis(eta2[i], 0.0, 1.0, 0, 0) - plogis(eta1[i], 0.0, 1.0, 0, 0); } } else if(strcmp(linkc, "loglog") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // d_pgumbel(double q, double loc, double scale, int lower_tail) eta1[i] = d_pgumbel(eta1[i], 0., 1., 1) - d_pgumbel(eta2[i], 0., 1., 1); else eta1[i] = d_pgumbel(eta2[i], 0., 1., 0) - d_pgumbel(eta1[i], 0., 1., 0); } } else if(strcmp(linkc, "cloglog") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // d_pgumbel2(double q, double loc, double scale, int lower_tail) eta1[i] = d_pgumbel2(eta1[i], 0., 1., 1) - d_pgumbel2(eta2[i], 0., 1., 1); else eta1[i] = d_pgumbel2(eta2[i], 0., 1., 0) - d_pgumbel2(eta1[i], 0., 1., 0); } } else if(strcmp(linkc, "cauchit") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // pcauchy(q, loc, scale, lower_tail, give_log) eta1[i] = pcauchy(eta1[i], 0., 1., 1, 0) - pcauchy(eta2[i], 0., 1., 1, 0); else eta1[i] = pcauchy(eta2[i], 0., 1., 0, 0) - pcauchy(eta1[i], 0., 1., 0, 0); } } else if(strcmp(linkc, "Aranda-Ordaz") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // d_pAO(q, lambda, lower_tail) eta1[i] = d_pAO(eta1[i], lambda, 1) - d_pAO(eta2[i], lambda, 1); else eta1[i] = d_pAO(eta2[i], lambda, 0) - d_pAO(eta1[i], lambda, 0); } } else if(strcmp(linkc, "log-gamma") == 0) { for(i = 0; i < nans; i++) { if(eta2[i] <= 0) // d_plgamma(double eta, double lambda, int lower_tail) eta1[i] = d_plgamma(eta1[i], lambda, 1) - d_plgamma(eta2[i], lambda, 1); else eta1[i] = d_plgamma(eta2[i], lambda, 0) - d_plgamma(eta1[i], lambda, 0); } } else { // ".. don't have to UNPROTECT before calling into "error"; it is not a bug to do so, but it is not needed either, error will result in a long jump that will UNPROTECT automatically." Email from Tomas Kalibra 19Apr2018. ; UNPROTECT(3); // unprotecting before exiting with an error error("link not recognized"); } UNPROTECT(3); return ans; } ordinal/src/init.c0000644000176200001440000001130315127777706013621 0ustar liggesusers///////////////////////////////////////////////////////////////////////////// // Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen // // This file is part of the ordinal package for R (*ordinal*) // // *ordinal* is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // *ordinal* 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 // and/or // . ///////////////////////////////////////////////////////////////////////////// #include #include #include // for NULL #include /* .C calls */ extern void dAO_C(void *, void *, void *, void *); extern void dgumbel_C(void *, void *, void *, void *, void *); extern void dgumbel2_C(void *, void *, void *, void *, void *); extern void dlgamma_C(void *, void *, void *, void *); extern void gAO_C(void *, void *, void *); extern void gcauchy_C(void *, void *); extern void getNAGQ(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void getNGHQ_C(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void ggumbel_C(void *, void *); extern void ggumbel2_C(void *, void *); extern void glgamma_C(void *, void *, void *); extern void glogis_C(void *, void *); extern void gnorm_C(void *, void *); extern void grad_C(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void gradC(void *, void *, void *, void *, void *, void *, void *, void *); extern void grFacSum_C(void *, void *, void *, void *, void *); extern void hess(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void hessC(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void nll(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void NRalg(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void NRalgv3(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void pAO_C(void *, void *, void *, void *); extern void pgumbel_C(void *, void *, void *, void *, void *); extern void pgumbel2_C(void *, void *, void *, void *, void *); extern void plgamma_C(void *, void *, void *, void *); /* .Call calls */ extern SEXP get_fitted(SEXP, SEXP, SEXP, SEXP); static const R_CMethodDef CEntries[] = { {"dAO_C", (DL_FUNC) &dAO_C, 4}, {"dgumbel_C", (DL_FUNC) &dgumbel_C, 5}, {"dgumbel2_C", (DL_FUNC) &dgumbel2_C, 5}, {"dlgamma_C", (DL_FUNC) &dlgamma_C, 4}, {"gAO_C", (DL_FUNC) &gAO_C, 3}, {"gcauchy_C", (DL_FUNC) &gcauchy_C, 2}, {"getNAGQ", (DL_FUNC) &getNAGQ, 19}, {"getNGHQ_C", (DL_FUNC) &getNGHQ_C, 17}, {"ggumbel_C", (DL_FUNC) &ggumbel_C, 2}, {"ggumbel2_C", (DL_FUNC) &ggumbel2_C, 2}, {"glgamma_C", (DL_FUNC) &glgamma_C, 3}, {"glogis_C", (DL_FUNC) &glogis_C, 2}, {"gnorm_C", (DL_FUNC) &gnorm_C, 2}, {"grad_C", (DL_FUNC) &grad_C, 16}, {"gradC", (DL_FUNC) &gradC, 8}, {"grFacSum_C", (DL_FUNC) &grFacSum_C, 5}, {"hess", (DL_FUNC) &hess, 13}, {"hessC", (DL_FUNC) &hessC, 11}, {"nll", (DL_FUNC) &nll, 17}, {"NRalg", (DL_FUNC) &NRalg, 29}, {"NRalgv3", (DL_FUNC) &NRalgv3, 24}, {"pAO_C", (DL_FUNC) &pAO_C, 4}, {"pgumbel_C", (DL_FUNC) &pgumbel_C, 5}, {"pgumbel2_C", (DL_FUNC) &pgumbel2_C, 5}, {"plgamma_C", (DL_FUNC) &plgamma_C, 4}, {NULL, NULL, 0} }; static const R_CallMethodDef CallEntries[] = { {"get_fitted", (DL_FUNC) &get_fitted, 4}, {NULL, NULL, 0} }; void R_init_ordinal(DllInfo *dll) { R_registerRoutines(dll, CEntries, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } ordinal/src/links.c0000755000176200001440000001624515127777706014013 0ustar liggesusers///////////////////////////////////////////////////////////////////////////// // Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen // // This file is part of the ordinal package for R (*ordinal*) // // *ordinal* is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // *ordinal* 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 // and/or // . ///////////////////////////////////////////////////////////////////////////// #include "links.h" /* This file implements scalar distribution, density and gradient function */ /*-------------------------------------------------------*/ /* Scalar cumulative distribution functions (CDFs) */ /*-------------------------------------------------------*/ double d_pgumbel(double q, double loc, double scale, int lower_tail) // Consider implementing 'int give_log' to follow the convention from // pnorm etc. { if(ISNAN(q)) // true for NA and NaN return NA_REAL; if(q == R_PosInf) q = 1.; else if(q == R_NegInf) q = 0.; else { q = (q - loc) / scale; q = exp( -exp( -q)); } return !lower_tail ? 1 - q : q; } double d_pgumbel2(double q, double loc, double scale, int lower_tail) // this is (partly) redundant since d_pgumbel2(q) = 1 - d_pgumbel(-q) { if(ISNAN(q)) // true for NA and NaN return NA_REAL; if(q == R_PosInf) q = 1; else if(q == R_NegInf) q = 0; else { q = (-q - loc) / scale; q = exp(-exp(-q)); } return !lower_tail ? q : 1 - q; } double d_pAO(double q, double lambda, int lower_tail) { if(ISNAN(q) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(q == R_PosInf) q = 1; else if(q == R_NegInf) q = 0; else { if(lambda < 1.0e-6) error("'lambda' has to be positive. lambda = %e was supplied\n", lambda); q = 1 - R_pow(lambda * exp(q) + 1, -1/lambda); } return !lower_tail ? 1 - q : q; } double d_plgamma(double eta, double lambda, int lower_tail) { double v; if(ISNAN(eta) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(eta == R_PosInf) v = 1; else if(eta == R_NegInf) v = 0; else { v = R_pow_di(lambda, -2) * exp(lambda * eta); if(lambda < 1.0e-6) v = 1 - pgamma(v, R_pow_di(lambda, -2), /*scale = */ 1, 1 /*lower_tail*/, 0 /*give_log*/); if(lambda > -1.0e-6) v = pgamma(v, R_pow_di(lambda, -2), /*scale = */ 1, 1 /*lower_tail*/, 0 /*give_log*/); if(lambda >= -1.0e-6 && lambda <= 1.0e-6) // pnorm(x, mu, sigma, lower_tail, give_log); v = pnorm(eta, 0., 1., 1, 0); } return lower_tail ? v : 1 - v; } /*-------------------------------------------------------*/ /* Scalar probability density functions (PDFs) */ /*-------------------------------------------------------*/ double d_dgumbel(double x, double loc, double scale, int give_log) { if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) // if(x == INFINITE || x == -INFINITE) // seems to work as well. return 0; // this special case needs to be handled separately x = (x - loc) / scale; x = -exp(-x) - x - log(scale); return give_log ? x : exp(x); } double d_dgumbel2(double x, double loc, double scale, int give_log) { if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) return 0; x = (-x - loc) / scale; x = -exp(-x) - x - log(scale); return give_log ? x : exp(x); } double d_dAO(double eta, double lambda, int give_log) { if(ISNAN(eta) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(eta == R_PosInf || eta == R_NegInf) return 0; if(lambda < 1.0e-6) error("'lambda' has to be positive. lambda = %e was supplied\n", lambda); eta -= (1 + 1 / lambda) * log(lambda * exp(eta) + 1); return give_log ? eta : exp(eta); } double d_dlgamma(double x, double lambda, int give_log) { if(ISNAN(x) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) return 0; if(lambda < 1.0e-5 && lambda > -1.0e-5) // lambda close to zero return dnorm(x, 0. , 1., give_log); double q_2 = R_pow_di(lambda, -2); x *= lambda; x = log(fabs(lambda)) + q_2 * log(q_2) - lgammafn(q_2) + q_2 * (x - exp(x)); return !give_log ? exp(x) : x; } /*-------------------------------------------------------*/ /* Scalar gradients of probability density functions */ /*-------------------------------------------------------*/ double d_glogis(double x) { // Gradient of dlogis(x) wrt. x if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) // if(x == INFINITE || x == -INFINITE) // seems to work as well. return 0; // this special case needs to be handled separately /* Store the sign of x, compute the gradient for the absolute value and restore the sign. This is needed to avoid exp(LARGE) to blow up and the function to return NaN. */ int sign = x > 0; //could use fsign() instead... x = exp(-fabs(x)); x = 2 * x * x * R_pow_di(1 + x, -3) - x * R_pow_di(1 + x, -2); return sign ? x : -x; } double d_gnorm(double x) { if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == INFINITY || x == -INFINITY) return 0; else return -x * dnorm(x, 0., 1., 0); } double d_gcauchy(double x) { if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) return 0; return x = -2 * x / M_PI * R_pow_di(1 + x * x, -2); } double d_ggumbel(double x) { if(ISNAN(x)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) return 0; x = exp(-x); if(x == INFINITY) return 0; double eq = exp(-x); return -eq * x + eq * x * x; } double d_ggumbel2(double x) // redundant function... { return -d_ggumbel(-x); } double d_gAO(double eta, double lambda) { if(ISNAN(eta) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(eta == R_PosInf || eta == R_NegInf) return 0; double lex = lambda * exp(eta); if(lex == R_PosInf || lex == 0) return 0.; double y = d_dAO(eta, lambda, 0/*give_log*/); return y == 0. ? 0. : y * (1 - (1 + 1/lambda) * lex / (1 + lex)); } double d_glgamma(double x, double lambda) { if(ISNAN(x) || ISNAN(lambda)) // true for NA and NaN return NA_REAL; if(x == R_PosInf || x == R_NegInf) return 0.; if(lambda < 1.0e-5 && lambda > -1.0e-5) // lambda close to zero return -x * dnorm(x, 0., 1., 0/*give_log*/); double z = exp(lambda * x); if(z == R_PosInf || z == 0.) return 0.; double y = d_dlgamma(x, lambda, 0/*give_log*/); return y <= 0. ? 0.0 : y * (1 - exp(lambda * x)) / lambda; // Equivalent to: /* if(y <= 0) return 0.0; else return y * (1 - exp(lambda * x)) / lambda; */ } ordinal/src/utilityFuns.c0000755000176200001440000005662315127777706015236 0ustar liggesusers///////////////////////////////////////////////////////////////////////////// // Copyright (c) 2010-2026 Rune Haubo Bojesen Christensen // // This file is part of the ordinal package for R (*ordinal*) // // *ordinal* is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // *ordinal* 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 // and/or // . ///////////////////////////////////////////////////////////////////////////// #include #include #include "links.h" double mu = 0, sigma = 1; int give_log = 0, lower_tail = 1; //--------------------------------- double d_pfun(double, double, int); double d_pfun2(double, double, int, int); // with lower_tail arg double d_dfun(double, double, int); double d_gfun(double, double, int); //--- negative log-likelihood: double d_nll(double *, int, int *, double, double *, double *, int, double *, double *, double *, double *, double *, double *, double *, double, int *); //--- Utilities: double mmax(double *, int); double maxAbs(double *, int); void Trace(int, double, double, double, double *, int, int); //--------------------------------- //------------------------------------------------------------------ // CDFs: void pgumbel_C(double *q, int *nq, double *loc, double *scale, int *lower_tail) { // pgumbel() int i; // How can I handle if loc and scale are not of unit length? for(i = 0; i < *nq; i++) q[i] = d_pgumbel(q[i], *loc, *scale, *lower_tail); } void pgumbel2_C(double *q, int *nq, double *loc, double *scale, int *lower_tail) { int i; for(i = 0; i < *nq; i++) q[i] = 1 - d_pgumbel(-q[i], *loc, *scale, *lower_tail); } void pAO_C(double *q, int *nq, double *lambda, int *lower_tail) { int i; for(i = 0; i < *nq; i++) q[i] = d_pAO(q[i], *lambda, *lower_tail); } void plgamma_C(double *q, int *nq, double *lambda, int *lower_tail) { int i; for(i = 0; i < *nq; i++) q[i] = d_plgamma(q[i], *lambda, *lower_tail); } //------------------------------------------------------------------ // PDFs: void dgumbel_C(double *x, int *nx, double *loc, double *scale, int *give_log) { int i; for(i = 0; i < *nx; i++) x[i] = d_dgumbel(x[i], *loc, *scale, *give_log); } void dgumbel2_C(double *x, int *nx, double *loc, double *scale, int *give_log) { int i; for(i = 0; i < *nx; i++) x[i] = d_dgumbel2(x[i], *loc, *scale, *give_log); } void dAO_C(double *x, int *nx, double *lambda, int *give_log) { int i; for(i = 0; i < *nx; i++) x[i] = d_dAO(x[i], *lambda, *give_log); } void dlgamma_C(double *x, int *nx, double *lambda, int *give_log) { int i; for(i = 0; i < *nx; i++) x[i] = d_dlgamma(x[i], *lambda, *give_log); } //------------------------------------------------------------------ // gradients of PDFs: void glogis_C(double *x, int *nx) { int i; for(i = 0; i < *nx; i++) x[i] = d_glogis(x[i]); } void gnorm_C(double *x, int *nx) { // Gradient of dnorm(x) wrt. x int i; for(i = 0; i < *nx; i++) x[i] = d_gnorm(x[i]); } void gcauchy_C(double *x, int *n) { // Gradient of dcauchy(x) wrt. x int i; for(i = 0; i < *n; i++) x[i] = d_gcauchy(x[i]); } void ggumbel_C(double *x, int *nx) { int i; for(i = 0; i < *nx; i++) x[i] = d_ggumbel(x[i]); } void ggumbel2_C(double *x, int *nx) { int i; for(i = 0; i < *nx; i++) x[i] = -d_ggumbel(-x[i]); // or x[i] = d_ggumbel2(x[i]); } void gAO_C(double *x, int *nx, double *lambda) { int i; for(i = 0; i < *nx; i++) x[i] = d_gAO(x[i], *lambda); } void glgamma_C(double *x, int *nx, double *lambda) { int i; for(i = 0; i < *nx; i++) x[i] = d_glgamma(x[i], *lambda); } //------------------------------------------------------------------ // link utility functions: /* Link functions:: 1: logistic 2: probit 3: cloglog 4: loglog 5: cauchit 6: Aranda-Ordaz 7: log-gamma */ double d_pfun(double x, double lambda, int link) { switch(link) { case 1: // logistic return plogis(x, mu, sigma, lower_tail, give_log); case 2: // probit return pnorm(x, mu, sigma, lower_tail, give_log); case 3: // cloglog return d_pgumbel(x, mu, sigma, lower_tail); case 4: // loglog return d_pgumbel2(x, mu, sigma, lower_tail); case 5: // cauchit return pcauchy(x, mu, sigma, lower_tail, give_log); case 6: // Aranda-Ordaz return d_pAO(x, lambda, lower_tail); case 7: // log-gamma return d_plgamma(x, lambda, lower_tail); default : // all other // if(link == 6) // error("the Aranda-Ordaz link is not available"); // if(link == 7) // error("the log-gamma link is not available"); // else error("link not recognized\n"); return NA_REAL; } } double d_pfun2(double x, double lambda, int link, int lower_tail) // 2nd version of d_pfun with a lower_tail arg { switch(link) { case 1: // logistic return plogis(x, mu, sigma, lower_tail, give_log); case 2: // probit return pnorm(x, mu, sigma, lower_tail, give_log); case 3: // cloglog return d_pgumbel(x, mu, sigma, lower_tail); case 4: // loglog return d_pgumbel2(x, mu, sigma, lower_tail); case 5: // cauchit return pcauchy(x, mu, sigma, lower_tail, give_log); case 6: // Aranda-Ordaz return d_pAO(x, lambda, lower_tail); case 7: // log-gamma return d_plgamma(x, lambda, lower_tail); default : // all other // if(link == 6) // error("the Aranda-Ordaz link is not available"); // if(link == 7) // error("the log-gamma link is not available"); // else error("link not recognized\n"); return NA_REAL; } } void pfun(double *x, int *nx, double *lambda, int *link) { int i; for(i = 0; i < *nx; i++) x[i] = d_pfun(x[i], *lambda, *link); } double d_dfun(double x, double lambda, int link) { switch(link) { case 1: // logistic return dlogis(x, mu, sigma, give_log); case 2: // probit return dnorm(x, mu, sigma, give_log); case 3: // cloglog return d_dgumbel(x, mu, sigma, give_log); case 4: // loglog return d_dgumbel2(x, mu, sigma, give_log); case 5: // cauchit return dcauchy(x, mu, sigma, give_log); case 6: return d_dAO(x, lambda, give_log); case 7: return d_dlgamma(x, lambda, give_log); default : // all other error("link not recognized\n"); return NA_REAL; } } void dfun(double *x, int *nx, double *lambda, int *link) { int i; for(i = 0; i < *nx; i++) x[i] = d_dfun(x[i], *lambda, *link); } double d_gfun(double x, double lambda, int link) { switch(link) { case 1: // logistic return d_glogis(x); case 2: // probit return d_gnorm(x); case 3: // cloglog return d_ggumbel(x); case 4: // loglog return d_ggumbel2(x); case 5: // cauchit return d_gcauchy(x); case 6: return d_gAO(x, lambda); case 7: return d_glgamma(x, lambda); default : // all other error("link not recognized\n"); return NA_REAL; } } void gfun(double *x, int *nx, double *lambda, int *link) { int i; for(i = 0; i < *nx; i++) x[i] = d_gfun(x[i], *lambda, *link); } //------------------------------------------------------------------ void getFitted(double *eta1, double *eta2, int *neta) { // adjust for NA and NaN values? int i; for(i = 0; i < *neta; i++) { if(eta2[i] <= 0) // pnorm(x, mu, sigma, lower_tail, give_log); eta1[i] = pnorm(eta1[i], 0.0, 1.0, 1, 0) - pnorm(eta2[i], 0.0, 1.0, 1, 0); else eta1[i] = pnorm(eta2[i], 0.0, 1.0, 0, 0) - pnorm(eta1[i], 0.0, 1.0, 0, 0); } } void getFitted2(double *eta1, double *eta2, int *neta, double *lambda, int *link) // 2nd version now including a link arg { // adjust for NA and NaN values? int i; for(i = 0; i < *neta; i++) { if(eta2[i] <= 0) // d_pfun2(x, lambda, link, lower_tail) eta1[i] = d_pfun2(eta1[i], *lambda, *link, 1) - d_pfun2(eta2[i], *lambda, *link, 1); else eta1[i] = d_pfun2(eta2[i], *lambda, *link, 0) - d_pfun2(eta1[i], *lambda, *link, 0); } } //------------------------------------------------------------------ // Gradients and Hessians for update.b in clmm2(): void grFacSum_C(double *x, int *grFac, int *nx, double *u, int *nu) // compute tapply(x, grFac, sum) + u { int i, j; double z = 0; for(i = 0; i < *nu; i++) { for (j = 0; j < *nx; j++) { if(grFac[j] == i + 1) z = z + x[j]; } u[i] = u[i] + z; z = 0; } } // FIXME: grFacSum_C such that it can be used by gradC and hessC - this // should simplify the code double d_nll(double *u, int nu, int *grFac, double stDev, double *o1, double *o2, int no, double *eta1, double *eta2, double *eta1Fix, double *eta2Fix, double *sigma, double *pr, double *weights, double lambda, int *link) /* Returns: nll Updates: eta1, eta2, pr given the new value of u Leaves unchanged: u, grFac, stDev, o1, o2, eta1Fix, eta2Fix, sigma, weights */ { int i, j; double o, nll = 0.0; for(i = 0; i < no; i++) { o = u[grFac[i] - 1] * stDev; eta1[i] = (eta1Fix[i] + o1[i] - o) / sigma[i]; eta2[i] = (eta2Fix[i] + o2[i] - o) / sigma[i]; /* Accurate evaluation of pr (fitted values) even if eta1 and eta2 are both large: */ if(eta2[i] <= 0) pr[i] = d_pfun2(eta1[i], lambda, *link, 1) - d_pfun2(eta2[i], lambda, *link, 1); else pr[i] = d_pfun2(eta2[i], lambda, *link, 0) - d_pfun2(eta1[i], lambda, *link, 0); if(!R_FINITE(pr[i]) || pr[i] <= 0.) { return INFINITY; } nll -= weights[i] * log(pr[i]); } for(j = 0; j < nu; j++) nll -= dnorm(u[j], 0., 1., 1); return nll; } void nll(double *u, int *nu, int *grFac, double *stDev, double *o1, double *o2, int *no, double *eta1, double *eta2, double *eta1Fix, double *eta2Fix, double *sigma, double *pr, double *weights, double *lambda, int *link, double *nll) { *nll = d_nll(u, *nu, grFac, *stDev, o1, o2, *no, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); } void grad_C(double *stDev, double *p1, double *p2, double *pr, double *weights, double *sigma, double *wtprSig, double *eta1, double *eta2, double *gradValues, double *u, int *grFac, int *nx, int *ngv, double *lambda, int *link) /* Returns: void Updates: gradValues, p1, p2, wtprSig given the new values of eta1, eta2 Leaves unchanged: grFac, stDev, eta1, eta2, pr, sigma, weights, link, nx, ngv Assumes: nx: length of grFac, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2 ngv: length of gradValues */ { int i, j; // double tmp[*nx], z = 0; // update p1, p2, wtprSig: for(i = 0; i < *nx; i++) { p1[i] = d_dfun(eta1[i], *lambda, *link); p2[i] = d_dfun(eta2[i], *lambda, *link); wtprSig[i] = weights[i] / pr[i] / sigma[i]; } // sum for each level of the grouping factor: for(i = 0; i < *ngv; i++) { gradValues[i] = 0; // Could set these to for (j = 0; j < *nx; j++) { if(grFac[j] == i + 1) gradValues[i] += *stDev * wtprSig[j] * (p1[j] - p2[j]); } gradValues[i] += u[i]; } } void gradC(double *stDev, double *p1, double *p2, double *wtprSig, int *grFac, int *nx, double *u, int *nu) { // gradient for update.b int i, j; double z = 0; for(i = 0; i < *nx; i++) { wtprSig[i] = *stDev * wtprSig[i] * (p1[i] - p2[i]); } for(i = 0; i < *nu; i++) { for (j = 0; j < *nx; j++) { if(grFac[j] == i + 1) z += wtprSig[j]; } u[i] += z; z = 0; } } void hess(double *stDev, double *p1, double *p2, double *pr, double *wtprSig, double *eta1, double *eta2, int *link, int *grFac, int *nx, double *hessValues, double *lambda, int *nhv) /* Returns: void Updates: hessValues given the new values of eta1, eta2 Leaves unchanged: grFac, stDev, eta1, eta2, p1, p2, pr, sigma, weights, link, nx, ngv Assumes: nx: length of grFac, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2 nhv: length of hessValues */ { int i, j; // sum for each level of the grouping factor: for(i = 0; i < *nhv; i++) { hessValues[i] = 0; for (j = 0; j < *nx; j++) { if(grFac[j] == i + 1) hessValues[i] += (R_pow_di(p1[j] - p2[j], 2) / pr[j] - (d_gfun(eta1[j], *lambda, *link) - d_gfun(eta2[j], *lambda, *link))) * wtprSig[j]; } hessValues[i] = (hessValues[i] * *stDev * *stDev) + 1; } } void hessC(double *stDev, double *p1, double *p2, double *pr, double *g1, double *g2, double *wtprSig, int *grFac, int *nx, double *z, int *nz) { // hessian for update.b int i, j; double sigma2; sigma2 = R_pow_di(*stDev, 2); for(i = 0; i < *nx; i++) pr[i] = (R_pow_di(p1[i] - p2[i], 2) / pr[i] - (g1[i] - g2[i])) * wtprSig[i]; for(i = 0; i < *nz; i++) { for (j = 0; j < *nx; j++) { if(grFac[j] == i + 1) z[i] = z[i] + pr[j]; } z[i] = z[i] * sigma2 + 1; } } //------------------------------------------------------------------ // Trace function: void Trace(int iter, double stepFactor, double val, double maxGrad, double *par, int npar, int first) { int i; if(first) Rprintf("iter: step factor: Value: max|grad|: Parameters:\n"); Rprintf(" %3d: %1.3e: %.3f: %1.3e: ", iter, stepFactor, val, maxGrad); for(i = 0; i < npar; i++) Rprintf(" %.4f", par[i]); Rprintf("\n"); } //------------------------------------------------------------------ void NRalg(int *trace, int *maxIter, double *gradTol, int *maxLineIter, int *grFac, double *stDev, double *o1, double *o2, double *eta1Fix, double *eta2Fix, double *eta1, double *eta2, double *sigma, int *link, double *weights, double *u, double *pr, double *funValue, double *gradValues, double *hessValues, int *nx, int *nu, double *maxGrad, int *conv, double *p1, double *p2, double *wtprSig, double *lambda, int *Niter) { /* nx: length(pr) r: length(start) = length(u) updates: u, funValue, gradValues, hessValues, maxGrad, correct vector input: eta1, eta2, pr, funValue (grad is called before d_nll), u = 0, grFac, o1, o2, eta1Fix, eta2Fix, sigma, weights arbitrary input: p1, p2, wtprSig, gradValues, hessValues, needed output: u, funValue, gradValues, hessValues, conv, Niter, */ int lineIter, innerIter = 0, i, j; double stepFactor = 1, funValueTry, step[*nu]; *funValue = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); if(!R_FINITE(*funValue)) { *conv = 0; return ; } grad_C(stDev, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2, gradValues, u, grFac, nx, nu, lambda, link); *maxGrad = maxAbs(gradValues, *nu); *conv = -1; // Convergence flag if(*trace) Trace(0, stepFactor, *funValue, *maxGrad, u, *nu, 1); // Newton-Raphson algorithm: for(i = 0; i < *maxIter; i++) { if(*maxGrad < *gradTol) { *conv = 1; return ; } hess(stDev, p1, p2, pr, wtprSig, eta1, eta2, link, grFac, nx, hessValues, lambda, nu); for(j = 0; j < *nu; j++) { step[j] = gradValues[j] / hessValues[j]; u[j] -= stepFactor * step[j]; } funValueTry = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); lineIter = 0; // simple line search, i.e. step halfing: while(funValueTry > *funValue) { stepFactor *= 0.5; for(j = 0; j < *nu; j++) u[j] += stepFactor * step[j]; funValueTry = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); lineIter++; if(*trace) Trace(i+1+innerIter, stepFactor, *funValue, *maxGrad, u, *nu, 0); if(lineIter > *maxLineIter){ *conv = -2; return ; } innerIter++; } *funValue = funValueTry; grad_C(stDev, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2, gradValues, u, grFac, nx, nu, lambda, link); *maxGrad = maxAbs(gradValues, *nu); if(*trace) Trace(i+1+innerIter, stepFactor, *funValue, *maxGrad, u, *nu, 0); stepFactor = fmin2(1., stepFactor * 2.); (*Niter)++; } } void NRalgv3(int *trace, int *maxIter, double *gradTol, int *maxLineIter, int *grFac, double *stDev, double *o1, double *o2, double *eta1Fix, double *eta2Fix, double *sigma, int *link, double *weights, double *u, double *pr, double *funValue, double *gradValues, double *hessValues, int *nx, int *nu, double *maxGrad, int *conv, double *lambda, int *Niter) // Less input and slightly faster than NRalg(). { /* control arguments from clmm - see ?clmm.control: trace, maxIter, gradTol, maxLineIter all of length 1 length = nx: grFac, o1, o2, eta1Fix, eta2Fix, sigma, weights length = 1: stDev, funValue, nx, nu, maxGrad, conv, lambda, Niter length = nu: gradValues, hessValues, u updates: u, funValue, gradValues, hessValues, maxGrad, conv, Niter, pr, correct vector input: eta1, eta2, pr, u = 0, grFac, o1, o2, eta1Fix, eta2Fix, sigma, weights arbitrary input: gradValues, hessValues, needed output: u, funValue, gradValues, hessValues, conv, Niter, */ int lineIter, innerIter = 0, i, j; double stepFactor = 1, funValueTry, step[*nu]; double eta1[*nx], eta2[*nx], p1[*nx], p2[*nx], wtprSig[*nx]; *funValue = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); if(!R_FINITE(*funValue)) { *conv = 0; return ; } grad_C(stDev, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2, gradValues, u, grFac, nx, nu, lambda, link); *maxGrad = maxAbs(gradValues, *nu); *conv = -1; // Convergence flag if(*trace) Trace(0, stepFactor, *funValue, *maxGrad, u, *nu, 1); // Newton-Raphson algorithm: for(i = 0; i < *maxIter; i++) { if(*maxGrad < *gradTol) { *conv = 1; return ; } hess(stDev, p1, p2, pr, wtprSig, eta1, eta2, link, grFac, nx, hessValues, lambda, nu); for(j = 0; j < *nu; j++) { /* Actually there is no need to store 'step' since 'gradValues' could hold the step values (maintained here for code clarity) */ step[j] = gradValues[j] / hessValues[j]; u[j] -= stepFactor * step[j]; } funValueTry = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); lineIter = 0; // simple line search, i.e. step halfing: while(funValueTry > *funValue) { stepFactor *= 0.5; for(j = 0; j < *nu; j++) u[j] += stepFactor * step[j]; funValueTry = d_nll(u, *nu, grFac, *stDev, o1, o2, *nx, eta1, eta2, eta1Fix, eta2Fix, sigma, pr, weights, *lambda, link); lineIter++; if(*trace) Trace(i+1+innerIter, stepFactor, *funValue, *maxGrad, u, *nu, 0); if(lineIter > *maxLineIter){ *conv = -2; return ; } innerIter++; } *funValue = funValueTry; grad_C(stDev, p1, p2, pr, weights, sigma, wtprSig, eta1, eta2, gradValues, u, grFac, nx, nu, lambda, link); *maxGrad = maxAbs(gradValues, *nu); if(*trace) Trace(i+1+innerIter, stepFactor, *funValue, *maxGrad, u, *nu, 0); stepFactor = fmin2(1.0, stepFactor * 2.0); (*Niter)++; } (*Niter)--; } //------------------------------------------------------------------ void getNGHQ_C(double *nll, int *grFac, double *stDev, double *eta1Fix, double *eta2Fix, double *o1, double *o2, double *Sigma, double *weights, int *nx, int *nu, double *ghqns, /* double *ghqws,*/ double *lghqws, int *nGHQ, int *link, double *ns, double *lambda) { int i, j, h; double SS = 0, SS1 = 0, SS2 = 0, eta1tmp, eta2tmp, pr_tmp; for(i = 0; i < *nu; i++) { for(h = 0; h < *nGHQ; h++) { for(j = 0; j < *nx; j++) { if(grFac[j] == i + 1) { eta1tmp = (eta1Fix[j] + o1[j] - ns[h]) / Sigma[j]; eta2tmp = (eta2Fix[j] + o2[j] - ns[h]) / Sigma[j]; /* Accurate evaluation of differences of probabilities even if eta1tmp and eta2tmp are large: */ if(eta2tmp <= 0) pr_tmp = d_pfun2(eta1tmp, *lambda, *link, 1) - d_pfun2(eta2tmp, *lambda, *link, 1); else pr_tmp = d_pfun2(eta2tmp, *lambda, *link, 0) - d_pfun2(eta1tmp, *lambda, *link, 0); // sum up contributions: SS1 += weights[j] * log(pr_tmp); } } // SS2 += exp(SS1) * ghqws[h]; // SS2 += exp(SS1 + log(ghqws[h])); SS2 += exp(SS1 + lghqws[h]); SS1 = 0; } SS += log(SS2); SS2 = 0; } *nll = -SS + *nu * log(M_PI * 2) * 0.5; } void getNAGQ(double *nll, int *grFac, double *stDev, double *eta1Fix, double *eta2Fix, double *o1, double *o2, double *Sigma, double *weights, int *nx, int *nu, double *ghqns, double *lghqws, /* double *lghqws, */ double *ghqns2, double *u, double *D, int *nAGQ, int *link, double *lambda) /* nll: negative log-likelihood (return value) length = nx: grFac, o1, o2, eta1Fix, eta2Fix, Sigma, weights length = 1: stDev, nll, nx, nu, nAGQ, lambda, link length = nu: D, u length = nAGQ: ghqns, lghqws (log ghqws) / ghqws */ { int i, j, h; double SS1 = 0, SS2 = 0, eta1tmp, eta2tmp, K, ranNew, pr_tmp; *nll = 0; for(i = 0; i < *nu; i++) { K = sqrt(2. / D[i]); for(h = 0; h < *nAGQ; h++) { for(j = 0; j < *nx; j++) { if(grFac[j] == i + 1) { ranNew = *stDev * (u[i] + K * ghqns[h]); eta1tmp = (eta1Fix[j] + o1[j] - ranNew) / Sigma[j]; eta2tmp = (eta2Fix[j] + o2[j] - ranNew) / Sigma[j]; /* Accurate evaluation of differences of probabilities even if eta1tmp and eta2tmp are large: */ if(eta2tmp <= 0) pr_tmp = d_pfun2(eta1tmp, *lambda, *link, 1) - d_pfun2(eta2tmp, *lambda, *link, 1); else pr_tmp = d_pfun2(eta2tmp, *lambda, *link, 0) - d_pfun2(eta1tmp, *lambda, *link, 0); // sum up contributions: SS1 += weights[j] * log(pr_tmp); } } // SS2 += exp(SS1) * K * ghqws[h] * // dnorm(u[i] + K * ghqns[h], mu, sigma, give_log); // SS2 += exp(SS1 + lghqws[h] + ghqns2[h] - //R_pow_di(ghqns[h], 2) + // 0.5 * R_pow_di(u[i] + K * ghqns[h], 2)) * K; SS2 += exp(SS1 + lghqws[h] + ghqns2[h] - //R_pow_di(ghqns[h], 2) + 0.5 * R_pow_di(u[i] + K * ghqns[h], 2)); SS1 = 0; } // *nll -= log(SS2); *nll -= log(SS2) + log(K); SS2 = 0; } *nll += *nu * log(M_PI * 2) * 0.5; } //------------------------------------------------------------------ double mmax(double *x, int nx) /* Return the maximum of the elements in x nx: length of x ( >= 1) */ { int i; double cmax; // current max cmax = x[0]; if(nx == 1) return cmax; for(i = 1; i < nx; i++) { if(x[i] > cmax) cmax = x[i]; } return cmax; } double maxAbs(double *x, int nx) /* Return max(abs(x)) nx: length of x ( >= 1 ) */ { int i; double cmax; // current max cmax = fabs(x[0]); if(nx == 1) return cmax; for(i = 1; i < nx; i++) { if(fabs(x[i]) > cmax) cmax = fabs(x[i]); } return cmax; } ordinal/NAMESPACE0000644000176200001440000001012415125475162013127 0ustar liggesusersuseDynLib("ordinal", .registration = TRUE) importFrom(graphics, plot, par, abline, lines, points, contour) importFrom(grDevices, dev.interactive, devAskNewPage) importFrom(utils, "combn", "packageDescription", "as.roman") importFrom(ucminf, ucminf) importFrom(numDeriv, grad, hessian) importFrom("stats", ".checkMFClasses", ".getXlevels", "AIC", "add.scope", "approx", "as.formula", "binomial", "coef", "confint", "dcauchy", "dlogis", "dnorm", "drop.scope", "drop.terms", "extractAIC", "fitted", "formula", "glm.fit", "is.empty.model", "logLik", "model.frame", "model.matrix", "model.offset", "model.response", "model.weights", "na.pass", "napredict", "naprint", "nlminb", "optim", "pcauchy", "pchisq", "pgamma", "plogis", "pnorm", "printCoefmat", "profile", "qchisq", "qlogis", "qnorm", "runif", "setNames", "spline", "terms", "update.formula", "vcov", "nobs", "delete.response", "lm.fit", "resid", "reformulate") ## importFrom(stats, ## nobs) import(methods) ## import(stats) ## importFrom(methods, ## as, ## checkAtAssignment, ## loadMethod) import(Matrix) importFrom(nlme, ranef, # also exported VarCorr) # also exported ## importFrom(numDeriv, ## hessian, ## grad) importFrom(MASS, ginv, addterm, dropterm) ## importFrom(stats, ## coef, ## confint, ## nobs, ## logLik, ## profile, ## vcov, ## extractAIC, ## anova, ## fitted## , ## ## terms ## ## update ## ) # Functions: export(clm) export(clm.fit) export(clmm) export(clm.control) export(clmm.control) export(slice) export(convergence) export(drop.coef) export(nominal_test) export(scale_test) export(condVar) export(ranef) export(VarCorr) export(gnorm, glogis, gcauchy, pgumbel, dgumbel, ggumbel, qgumbel, rgumbel, plgamma, dlgamma, glgamma ## , ## pAO, dAO, gAO, ) ## Methods: S3method(clm.fit, default) S3method(clm.fit, factor) S3method(print, clm) S3method(vcov, clm) S3method(summary, clm) S3method(print, summary.clm) S3method(convergence, clm) S3method(print, convergence.clm) S3method(slice, clm) S3method(plot, slice.clm) S3method(anova, clm) S3method(print, anova.clm) S3method(predict, clm) S3method(coef, clm) S3method(nobs, clm) S3method(coef, summary.clm) S3method(scale_test, clm) S3method(nominal_test, clm) S3method(profile, clm) S3method(confint, clm) S3method(confint, profile.clm) S3method(plot, profile.clm) S3method(logLik, clm) S3method(extractAIC, clm) S3method(model.matrix, clm) S3method(model.frame, clm) S3method(terms, clm) S3method(print, clmm) S3method(vcov, clmm) S3method(summary, clmm) S3method(print, summary.clmm) S3method(logLik, clmm) S3method(extractAIC, clmm) S3method(anova, clmm) S3method(nobs, clmm) ## S3method(profile, clmm) ## S3method(confint, profile.clmm) ## S3method(plot, profile.clmm) ## S3method(update, clmm) ## S3method(fixef, clmm) S3method(ranef, clmm) S3method(condVar, clmm) S3method(VarCorr, clmm) S3method(model.matrix, clmm) ################################################################## ### clm2 stuff: ## Functions: export(clm2) export(clmm2) export(clm2.control) export(clmm2.control) ## Methods: S3method(print, clm2) S3method(vcov, clm2) S3method(summary, clm2) S3method(print, summary.clm2) S3method(anova, clm2) S3method(predict, clm2) S3method(profile, clm2) S3method(confint, clm2) S3method(confint, profile.clm2) S3method(plot, profile.clm2) S3method(logLik, clm2) S3method(extractAIC, clm2) S3method(update, clm2) S3method(dropterm, clm2) S3method(addterm, clm2) S3method(print, clmm2) S3method(vcov, clmm2) S3method(summary, clmm2) S3method(print, summary.clmm2) S3method(anova, clmm2) S3method(profile, clmm2) S3method(confint, profile.clmm2) S3method(plot, profile.clmm2) S3method(update, clmm2) ordinal/LICENCE.note0000644000176200001440000000156015130017124013627 0ustar liggesusersCopyrights ========== All files are copyright (C) 2011-2026 R. H. B. Christensen with all rights assigned to R. H. B. Christensen Licence ======= This 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. Files share/licenses/GPL-2 and share/licenses/GPL-3 in the R (source or binary) distribution are copies of versions 2 and 3 of the 'GNU General Public License'. These can also be viewed at http://www.r-project.org/licenses/ Rune.Haubo@gmail.com ordinal/inst/0000755000176200001440000000000015130020364012651 5ustar liggesusersordinal/inst/CITATION0000755000176200001440000000071415125475162014031 0ustar liggesusersyear <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) vers <- paste0("R package version ", meta$Version) bibentry( 'Manual', title = 'ordinal---Regression Models for Ordinal Data', author = person("Rune H. B.", "Christensen", comment = c(ORCID = "0000-0002-4494-3399")), header = "To cite 'ordinal' in publications use:", year = year, note = vers, url = "https://CRAN.R-project.org/package=ordinal" ) ordinal/inst/doc/0000755000176200001440000000000015130020364013416 5ustar liggesusersordinal/inst/doc/clmm2_tutorial.Rnw0000644000176200001440000004375215125475162017074 0ustar liggesusers\documentclass[a4paper]{article} \usepackage{amsmath}%the AMS math extension of LaTeX. \usepackage{amssymb}%the extended AMS math symbols. %% \usepackage{amsthm} \usepackage{bm}%Use 'bm.sty' to get `bold math' symbols \usepackage{natbib} \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{Sweave} \usepackage{url} \usepackage{float}%Use `float.sty' \usepackage[left=3.5cm,right=3.5cm]{geometry} \usepackage{algorithmic} \usepackage[amsmath,thmmarks,standard,thref]{ntheorem} %%\VignetteIndexEntry{clmm2 tutorial} %%\VignetteDepends{ordinal, xtable} \title{A Tutorial on fitting Cumulative Link Mixed Models with \texttt{clmm2} from the \textsf{ordinal} Package} \author{Rune Haubo B Christensen} %% \numberwithin{equation}{section} \setlength{\parskip}{2mm}%.8\baselineskip} \setlength{\parindent}{0in} %% \DefineVerbatimEnvironment{Sinput}{Verbatim}%{} %% {fontshape=sl, xleftmargin=1em} %% \DefineVerbatimEnvironment{Soutput}{Verbatim}%{} %% {xleftmargin=1em} %% \DefineVerbatimEnvironment{Scode}{Verbatim}%{} %% {fontshape=sl, xleftmargin=1em} \fvset{listparameters={\setlength{\topsep}{0pt}}} %% \fvset{listparameters={\setlength{\botsep}{0pt}}} \renewenvironment{Schunk}{\vspace{-1mm}}{\vspace{-1mm}} %RE-DEFINE marginpar \setlength{\marginparwidth}{1in} \let\oldmarginpar\marginpar \renewcommand\marginpar[1]{\oldmarginpar[\-\raggedleft\tiny #1]% {\tiny #1}} %uncomment to _HIDE_MARGINPAR_: %\renewcommand\marginpar[1]{} \newcommand{\var}{\textup{var}} \newcommand{\I}{\mathcal{I}} \newcommand{\bta}{\bm \theta} \newcommand{\ta}{\theta} \newcommand{\tah}{\hat \theta} \newcommand{\di}{~\textup{d}} \newcommand{\td}{\textup{d}} \newcommand{\Si}{\Sigma} \newcommand{\si}{\sigma} \newcommand{\bpi}{\bm \pi} \newcommand{\bmeta}{\bm \eta} \newcommand{\tdots}{\hspace{10mm} \texttt{....}} \newcommand{\FL}[1]{\fvset{firstline= #1}} \newcommand{\LL}[1]{\fvset{lastline= #1}} \newcommand{\s}{\square} \newcommand{\bs}{\blacksquare} % figurer bagerst i artikel %% \usepackage[tablesfirst, nolists]{endfloat} %% \renewcommand{\efloatseparator}{\vspace{.5cm}} \theoremstyle{plain} %% {break} \theoremseparator{:} \theoremsymbol{{\tiny $\square$}} %%\theoremstyle{plain} \theorembodyfont{\small} \theoremindent5mm \renewtheorem{example}{Example} %% \newtheoremstyle{example}{\topsep}{\topsep}% %% {}% Body font %% {}% Indent amount (empty = no indent, \parindent = para indent) %% {\bfseries}% Thm head font %% {}% Punctuation after thm head %% {\newline}% Space after thm head (\newline = linebreak) %% {\thmname{#1}\thmnumber{ #2}\thmnote{ #3}}% Thm head spec %% %% \theoremstyle{example} %% %% \newtheorem{example}{Example}[subsection] %% \newtheorem{example}{Example}[section] \usepackage{lineno} % \linenumbers \newcommand*\patchAmsMathEnvironmentForLineno[1]{% \expandafter\let\csname old#1\expandafter\endcsname\csname #1\endcsname \expandafter\let\csname oldend#1\expandafter\endcsname\csname end#1\endcsname \renewenvironment{#1}% {\linenomath\csname old#1\endcsname}% {\csname oldend#1\endcsname\endlinenomath}}% \newcommand*\patchBothAmsMathEnvironmentsForLineno[1]{% \patchAmsMathEnvironmentForLineno{#1}% \patchAmsMathEnvironmentForLineno{#1*}}% \AtBeginDocument{% \patchBothAmsMathEnvironmentsForLineno{equation}% \patchBothAmsMathEnvironmentsForLineno{align}% \patchBothAmsMathEnvironmentsForLineno{flalign}% \patchBothAmsMathEnvironmentsForLineno{alignat}% \patchBothAmsMathEnvironmentsForLineno{gather}% \patchBothAmsMathEnvironmentsForLineno{multline}% } \begin{document} \bibliographystyle{chicago} \maketitle \begin{abstract} It is shown by example how a cumulative link mixed model is fitted with the \texttt{clmm2} function in package \textsf{ordinal}. Model interpretation and inference is briefly discussed. A tutorial for the more recent \texttt{clmm} function is work in progress. \end{abstract} %% \newpage %% \tableofcontents %% \newpage \SweaveOpts{echo=TRUE, results=verb, width=4.5, height=4.5} \SweaveOpts{prefix.string=figs} \fvset{listparameters={\setlength{\topsep}{0pt}}, gobble=0, fontsize=\small} %% \fvset{gobble=0, fontsize=\small} \setkeys{Gin}{width=.49\textwidth} <>= ## Load common packages, functions and set settings: library(ordinal) library(xtable) ## RUN <- FALSE #redo computations and write .RData files ## Change options: op <- options() ## To be able to reset settings options("digits" = 7) options(help_type = "html") ## options("width" = 75) options("SweaveHooks" = list(fig=function() par(mar=c(4,4,.5,0)+.5))) options(continue=" ") @ We will consider the data on the bitterness of wine from \citet{randall89} presented in Table~\ref{tab:winedata} and available as the object \texttt{wine} in package \textsf{ordinal}. The data were also analyzed with mixed effects models by \citet{tutz96}. The following gives an impression of the wine data object: <<>>= data(wine) head(wine) str(wine) @ The data represent a factorial experiment on factors determining the bitterness of wine with 1 = ``least bitter'' and 5 = ``most bitter''. Two treatment factors (temperature and contact) each have two levels. Temperature and contact between juice and skins can be controlled when crushing grapes during wine production. Nine judges each assessed wine from two bottles from each of the four treatment conditions, hence there are 72 observations in all. For more information see the manual entry for the wine data: \texttt{help(wine)}. \begin{table} \centering \caption{Ratings of the bitterness of some white wines. Data are adopted from \citet{randall89}.} \label{tab:winedata} \begin{tabular}{lllrrrrrrrrr} \hline & & & \multicolumn{9}{c}{Judge} \\ \cline{4-12} <>= data(wine) temp.contact.bottle <- with(wine, temp:contact:bottle)[drop=TRUE] tab <- xtabs(as.numeric(rating) ~ temp.contact.bottle + judge, data=wine) class(tab) <- "matrix" attr(tab, "call") <- NULL mat <- cbind(rep(c("cold", "warm"), each = 4), rep(rep(c("no", "yes"), each=2), 2), 1:8, tab) colnames(mat) <- c("Temperature", "Contact", "Bottle", 1:9) xtab <- xtable(mat) print(xtab, only.contents=TRUE, include.rownames=FALSE, sanitize.text.function = function(x) x) @ \end{tabular} \end{table} We will fit the following cumulative link mixed model to the wine data: \begin{equation} \label{eq:mixedModel} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j - \beta_1 (\mathtt{temp}_i) - \beta_2(\mathtt{contact}_i) - u(\mathtt{judge}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation} This is a model for the cumulative probability of the $i$th rating falling in the $j$th category or below, where $i$ index all observations and $j = 1, \ldots, J$ index the response categories ($J = 5$). $\{\theta_j\}$ are known as threshold parameters or cut-points. We take the judge effects to be random, and assume that the judge effects are IID normal: $u(\mathtt{judge}_i) \sim N(0, \sigma_u^2)$. We fit this model with the \texttt{clmm2} function in package \textsf{ordinal}. Here we save the fitted \texttt{clmm2} model in the object \texttt{fm1} (short for \texttt{f}itted \texttt{m}odel \texttt{1}) and \texttt{print} the model by simply typing its name: <<>>= fm1 <- clmm2(rating ~ temp + contact, random=judge, data=wine) fm1 @ Maximum likelihood estimates of the parameters are provided using the Laplace approximation to compute the likelihood function. A more accurate approximation is provided by the adaptive Gauss-Hermite quadrature method. Here we use 10 quadrature nodes and use the \texttt{summary} method to display additional information: <<>>= fm2 <- clmm2(rating ~ temp + contact, random=judge, data=wine, Hess=TRUE, nAGQ=10) summary(fm2) @ The small changes in the parameter estimates show that the Laplace approximation was in fact rather accurate in this case. Observe that we set the option \texttt{Hess = TRUE}. This is needed if we want to use the \texttt{summary} method since the Hessian is needed to compute standard errors of the model coefficients. The results contain the maximum likelihood estimates of the parameters: \begin{equation} \label{eq:parameters} \hat\beta_1 = 3.06, ~~\hat\beta_2 = 1.83, ~~\hat\sigma_u^2 = 1.29 = 1.13^2, ~~\{\hat\theta_j\} = [-1.62,~ 1.51,~ 4.23,~ 6.09]. \end{equation} Observe the number under \texttt{Std.Dev} for the random effect is \textbf{not} the standard error of the random effects variance, \texttt{Var}. Rather, it is the standard deviation of the random effects, i.e., it is the square root of the variance. In our example $\sqrt{1.29} \simeq 1.13$. The condition number of the Hessian measures the empirical identifiability of the model. High numbers, say larger than $10^4$ or $10^6$ indicate that the model is ill defined. This would indicate that the model can be simplified, that possibly some parameters are not identifiable, and that optimization of the model can be difficult. In this case the condition number of the Hessian does not indicate a problem with the model. The coefficients for \texttt{temp} and \texttt{contact} are positive indicating that higher temperature and more contact increase the bitterness of wine, i.e., rating in higher categories is more likely. The odds ratio of the event $Y \geq j$ is $\exp(\beta_{\textup{treatment}})$, thus the odds ratio of bitterness being rated in category $j$ or above at warm relative to cold temperatures is <<>>= exp(coef(fm2)[5]) @ The $p$-values for the location coefficients provided by the \texttt{summary} method are based on the so-called Wald statistic. More accurate test are provided by likelihood ratio tests. These can be obtained with the \texttt{anova} method, for example, the likelihood ratio test of \texttt{contact} is <<>>= fm3 <- clmm2(rating ~ temp, random=judge, data=wine, nAGQ=10) anova(fm3, fm2) @ which in this case is slightly more significant. The Wald test is not reliable for variance parameters, so the \texttt{summary} method does not provide a test of $\sigma_u$, but a likelihood ratio test can be obtained with \texttt{anova}: <<>>= fm4 <- clm2(rating ~ temp + contact, data=wine) anova(fm4, fm2) @ showing that the judge term is significant. Since this test of $\sigma_u = 0$ is on the boundary of the parameter space (a variance cannot be negative), it is often argued that a more correct $p$-value is obtained by halving the $p$-value produced by the conventional likelihood ratio test. In this case halving the $p$-value is of little relevance. A profile likelihood confidence interval of $\sigma_u$ is obtained with: <<>>= pr2 <- profile(fm2, range=c(.1, 4), nSteps=30, trace=0) confint(pr2) @ The profile likelihood can also be plotted: <>= plot(pr2) @ The result is shown in Fig.~\ref{fig:PRsigma_u} where horizontal lines indicate 95\% and 99\% confindence bounds. Clearly the profile likelihood function is asymmetric and symmetric confidence intervals would be inaccurate. \begin{figure} \centering <>= <> @ \caption{Profile likelihood of $\sigma_u$.} \label{fig:PRsigma_u} \end{figure} The judge effects, $u(\mathtt{judge}_i)$ are not parameters, so they cannot be \emph{estimated} in the conventional sense, but a ``best guess'' is provided by the \emph{conditional modes}. Similarly the \emph{conditional variance} provides an uncertainty measure of the conditional modes. These quantities are included in \texttt{clmm2} objects as the \texttt{ranef} and \texttt{condVar} components. The following code generates the plot in Fig.~\ref{fig:ranef} illustrating judge effects via conditional modes with 95\% confidence intervals based on the conditional variance: <>= ci <- fm2$ranef + qnorm(0.975) * sqrt(fm2$condVar) %o% c(-1, 1) ord.re <- order(fm2$ranef) ci <- ci[order(fm2$ranef),] plot(1:9, fm2$ranef[ord.re], axes=FALSE, ylim=range(ci), xlab="Judge", ylab="Judge effect") axis(1, at=1:9, labels = ord.re) axis(2) for(i in 1:9) segments(i, ci[i,1], i, ci[i, 2]) abline(h = 0, lty=2) @ The seventh judge gave the lowest ratings of bitterness while the first judge gave the highest ratings of bitterness. The significant judge effect indicate that judges perceived the bitterness of the wines differently. Two natural interpretations are that either a bitterness of, say, 3 means different things to different judges, or the judges actually perceived the bitterness of the wines differently. Possibly both effects play their part. \begin{figure} \centering <>= <> @ \caption{Judge effects given by conditional modes with 95\% confidence intervals based on the conditional variance.} \label{fig:ranef} \end{figure} The fitted or predicted probabilites can be obtained with the judge effects at their conditional modes or for an average judge ($u = 0$). The former are available with \texttt{fitted(fm)} or with \texttt{predict(fm)}, where \texttt{fm} is a \texttt{f}itted \texttt{m}odel object. In our example we get <<>>= head(cbind(wine, fitted(fm2))) @ Predicted probabilities for an average judge can be obtained by including the data used to fit the model in the \texttt{newdata} argument of \texttt{predict}: <<>>= head(cbind(wine, pred=predict(fm2, newdata=wine))) @ Model~\eqref{eq:mixedModel} says that for an average judge at cold temperature the cumulative probability of a bitterness rating in category $j$ or below is \begin{equation*} P(Y_i \leq j) = \textup{logit}^{-1} [ \theta_j - \beta_2(\mathtt{contact}_i) ] \end{equation*} since $u$ is set to zero and $\beta_1(\mathtt{temp}_i) = 0$ at cold conditions. Further, $\textup{logit}^{-1}(\eta) = 1 / [1 + \exp(\eta)]$ is the cumulative distribution function of the logistic distribution available as the \texttt{plogis} function. The (non-cumulative) probability of a bitterness rating in category $j$ is $\pi_j = P(Y_i \leq j) - P(Y_i \leq j-1)$, for instance the probability of a bitterness rating in the third category at these conditions can be computed as <<>>= plogis(fm2$Theta[3] - fm2$beta[2]) - plogis(fm2$Theta[2] - fm2$beta[2]) @ This corresponds to the third entry of \texttt{predict(fm2, newdata=wine)} given above. Judge effects are random and normally distributed, so an average judge effect is 0. Extreme judge effects, say 5th and 95th percentile judge effects are given by <<>>= qnorm(0.95) * c(-1, 1) * fm2$stDev @ At the baseline experimental conditions (cold and no contact) the probabilites of bitterness ratings in the five categories for a 5th percentile judge is <<>>= pred <- function(eta, theta, cat = 1:(length(theta)+1), inv.link = plogis) { Theta <- c(-1e3, theta, 1e3) sapply(cat, function(j) inv.link(Theta[j+1] - eta) - inv.link(Theta[j] - eta) ) } pred(qnorm(0.05) * fm2$stDev, fm2$Theta) @ We can compute these probabilities for average, 5th and 95th percentile judges at the four experimental conditions. The following code plots these probabilities and the results are shown in Fig.~\ref{fig:ratingProb}. <>= mat <- expand.grid(judge = qnorm(0.95) * c(-1, 0, 1) * fm2$stDev, contact = c(0, fm2$beta[2]), temp = c(0, fm2$beta[1])) pred.mat <- pred(eta=rowSums(mat), theta=fm2$Theta) lab <- paste("contact=", rep(levels(wine$contact), 2), ", ", "temp=", rep(levels(wine$temp), each=2), sep="") par(mfrow=c(2, 2)) for(k in c(1, 4, 7, 10)) { plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") } @ \begin{figure} \centering <>= k <- 1 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 4 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 7 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ <>= k <- 10 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") @ \caption{Rating probabilities for average and extreme judges at different experimental conditions.} \label{fig:ratingProb} \end{figure} At constant experimental conditions the odds ratio for a bitterness rating in category $j$ or above for a 95th percentile judge relative to a 5th percentile judge is <<>>= exp(2*qnorm(0.95) * fm2$stDev) @ The differences between judges can also be expressed in terms of the interquartile range: the odds ratio for a bitterness rating in category $j$ or above for a third quartile judge relative to a first quartile judge is <<>>= exp(2*qnorm(0.75) * fm2$stDev) @ \newpage \bibliography{ordinal} %% \newpage \end{document} <>= @ ordinal/inst/doc/clmm2_tutorial.pdf0000644000176200001440000027442615130020365017066 0ustar liggesusers%PDF-1.5 %ż÷˘ţ 1 0 obj << /Type /ObjStm /Length 4075 /Filter /FlateDecode /N 85 /First 714 >> stream xśĹ\Ys۸–~ź_·Ű·şşIÄ©[]ĺ%NěÄéÄv;Ë­~P,ÚÖ´,ą%9ťÜ_?߸(ÚÖL—,$€ĺěç€,e’)Î2Ć- Läśi– Í ł©f–ńÔ –3.uŠ2ă -8ţL.L¤Â ’ iĐ6cB+4&@÷šI®Ű0©0 ·LZ‰ö9ˤ Î,łŇ2Á™JeÎđH ŁŚ)cR&2¦ć"Ó˘¨sôdžS?ËŚ443V &SđŚ3k0 ‰™§ ÷’ĺY†úŚĺ“–Šĺ6—Lj,‰cTšSŞ0 霢 V‘ćF˛ kć<Ǧк3Ě€8×6ĂPČSÁ2,Q¤ m,–Č‚NČBŕyČBć¨dˇ -'´32Miń(`'™’TPŠ)@–SE™K……bŕ;¨hß f¨YZ A;ź l:ˇ*SX¨ćTŔ¶h@Î4új@Î,IhÉrLF˛âŠ¶ ¨YaL˛ĘVNĐl´¦ýGÁ`zFPżčČ• Ś¨«39·(2đ˘d-3B Ę€¬5!µÁŽY@Öűşă&A™(äłDJ`- eZ@6ŘŐ˙ú׿XrZ¬FăŃjä®ĎXňntS,AŰîćâű}Á’ÔOç7ě—_\—E1ZMćłĂŃŞ`?ţ7ČY§Dň ;.Lů?Ňô˙,ŰÍ쇋â#nOçăm=Ţ-ć㇫]^ľ{Ă^ŢΗ«ĺŐbrż]ýśĘźÓÖs?Ěč)K^OĆKöo°!MÔĺ.~-ĘŻ¤ Đé.ľء‹ńŚďţ{µbż őXłU1[-¶ŢíĘi1žŚöçß0lŠđö3¸ĘfügPńďÔ{öŐžËůĂâ đŘŃśjDą×‹ůŐy±śäÝá/ľ­ŕ—_Ú󨦱?Z®wňvďüôlďÇóŁłS`Ô˛äĹěj>žĚn2ŕŁÉbą:¸-Ý݇…ßIŕŁDô›QŮÜÇ’ó‡/+7$ Ě«ńýx&ăŐ­Űd!ÜŠwń1)íŹv3? ¤hÁ…TÖ˛Ş_ײúdĆýBTŇ é*¬qOé^8XÄ• Élje|_ ^–ŕLşşçhGcŃő÷jď÷–W„Q“Zâ†űWĹä涺ĹHö’äMršĽK.’Qr•Ś“"ąN®'ÉMr›L’?’ir—Ě’y˛H–É*yHľ&%ß@ö„˙ř{>ÝşÍ߯ČĚŐŮ”»A÷•G“i!™­pŽ'oGwĹú8˙N®öf7Óm“ÓÉr jqh…Ü—Ŕţ޸»ô„Đ ľE2ÉÇrÉX+˘ÇŁW§źĎ1ŢĹE‡A:ł˝ŮrŇě+PT‰}¨ ­ČOcäď~}yúĂťź?ůą‰†áĽ‹}čĹa؇ŢörŔf5f„­+ŐÔ2Ź8Š¶ÍŮî¶Ć׼<Îó¶qfúq-MŔBśń.΢MȱzÎdŚł˝_?}ĽŘ÷B¤é@śeYŚ3ŮĹ™ŕq&LĹM™“`ţwÝ}űS–‘ÁSk™9.”ťvFôó2AW™§–L*Ď˸ofĺď«YHKv®vתZŔHŹu„ u„jSŇ>tÄ«ä$9M}I®ćww#h ×Ô)‰J=,'ß " ! &ľ'˙)óPOČŠđ¤…t$G#‡d'şdŃA/ŮÁ“¨0đEqrńúě‘ůţÇ4LwZĹt§"YˇŇů0ĎÔ°5< %ôłđi ôyCr·M%<´$uxCˇŤxÝ/oŕ{’ź`!âeń"zźgŤ…°ńđŠ"Ä:8~uůÚZń¶š[źĹĘc“u¨qNŁá[‘*¬„|cşOd =φ! ŞŤf••WIĎĘç~6 đ¨dáÁ¸u”µ -r ÁßYšú´4řŞň«7Ş7’Ű1ĚVOrµŃz=ŤěÖűäľXLćăĐ€Mľ‡˘©¶ct,™°1ƉÍ6f]Ť¦—@±âZ2ŮíşF#ľ Y¸çŚ¦GH&ąF#F6¬*™”pHŞSŠďžňíÂKŔM9nMŢ5äôŃ0žżF˙Yäą-rÝőÝ“ÉQňúůŘůqo“_áË˝‡®>‡G÷[r -Ż&“Őd:.Ŕ-_F‹äËbtőG±š×«ŞĽpÚü Ú}:ź•:~śŚçÓ)ÚWĘľřóa4uśö 7X€Űn(`R,Ŕu·ßďo‹ďűM‹ĺŇńŕl2+Ŕsü‚)Ěŕv%?,8”–[qęýôa™ü™üů0_ă/S_ ΙŢÎ(ľb˛6–ÓŃň–lŽŰEQ”–GÉßÉb DÔ¦Ż ŐŚ^WKbHç]ËWu=bĽ^oE´4ŃvFÇ "Fyvô~˙­ł´ÁčkÜń w%÷¤’Ť^˘pgsĄ’öNż(Ësş+b»«×~ @­Í¸mş‹¶hĘg×Ű°¦×9,{_{uŔÓĐ~H»ö×1®b7E Ä•”Ň}KA–ZśBIŠđeehTV÷î,]a¬DWiČ×·&»ĂVE‰ˇć Ö`ŕjl†N3°¨NęŠv4Ä`Nž€ňýµŰ,#µ›µ)y<6|łTj–ÁŰ©® Ľzî–C÷čMeZ2=Żęéą„ËAÖ#mAő̸„…u_‚‘¶ -cŐ±Ś÷;’ú¤%«˝¤ţPš2ˇü­ďlL‚®–żô7qOKGřI·‘»®auăۆŇw°Ü…}ż6BřS–úZđGîv-ä`ÓĺŕĄz9X6ABĹ7°pĵ—§ďß|đ˛˝Ăµ˝a†8.("wo¸ýżÖŕi%kíóÎóĘş›ĚˇňSŚ®Í˝6<Ş'I,ô*0m®Ú¬Rr‡÷*űżźňÇ !âĐ5pžÝş¨ĹOĘ×R®Ž¦’®í’nDWm“?)ZöńőÉĹű śNĆëL†ČŤn2ŘĘqlb_˘ĚŤř+ŐTęI®sˇ“A3Ň-&śQť;p!Ö˘¬D´ŤŽŮž”Đë ˝ÓOo^ťŃpĎôčÄî<ş§{BŰG(¤¶AŘî•ýťž\w­Źőäö[öY=>P Áµüś98oEíĆ^¬=Á»ű{ü:oMÜMü¬J»˘ĎŁŰěĎĺaÜF…ŻÖĐą‘CÇÓ´ËçăµůÜÉ“Mň9—Oré~;˙xyxţăÁé<*¨ÔgYČČ‹ś —Öş/ŮÖŤPîłĺŰĄ´ÓďńázÓo蕤ά^k{¨®M˘Äš%fŰxÚfŻÍ1Y\=Ü]O‹oÝGÍ žĘ{hśÚYĂ5Ĺ~‹)Uµ5Rjâ(#y; Ušx‡VŁĽ[H:ý‰Ňô11ĆĚĆtzxpńé❇„ZEVÄ„ą°Ă¦…tv:Őé0ł¦Ś˙Ý$ßFŽž$»ä’`EšÖĺěôšą˛ŰĆ’”™ăŐ|uÉZŤ ®Ěű§—¬OŕAľK>%_ŠŐ¨JˡD‚zÖÄ˝ď' ĎÔ•˘ő–ÚĆşP×ü·l…qÁxőë`h¸†˘–Uëm˝ž§÷ž˙ µpóˇÖăµad4–ćž×~dâůŇÝdő¶Ť'W¸[Nî&d1–WפMĽąŢ HR_g)â‹‘(ľŢˇĄˇbdcž7Íľ8yrA*t¨q!¬Őv},5Ô1V:wß´őÉ Ć2A$Ä™&d•8ËăŻÎA‹:™©”¶±ń! “uńĚm…ŤńŠř`ĹÉŢéĹ! SDäéŠ,Îi 62"Ç3Ś´Ą,vÓŕi„5\{_k7!ŚfQe;|á3×7ĐU®zŐѢŽśRl!ťúZňDn•Qä´łŮ]dŽľµfÜquTŤÚÇdŻÎčÝÔOăŚK2˲bĽ:eĚéxUÎéµ_†%,ŞľB2QőĹ\DŐÜ.ŞľŘQő…w$«ľ”©úBçËŞ/Ž¬úJĘv”eĐRVő…óX–rćë»G«É¦~öŮęßV/ĎWtĆű@ŰG·•5×NŇY‡m‡fGl‡`… |8[·‹Ź´hscü… ľ~yp|üŮűXôvă0óĆŠH48쮆JJľ=î_C#!%e÷Ą#ÍŰNQ&ש _6Ň60*Î`@Đ;ä-yZŘşoĐ9kČEäEűÜkčćE3±é°áş÷ŤB~©5ur–kúw -J$ čAőáäúşĺ©ýŰ˝t=iţ9@Ýî)ŔČmź eá±P:V^QĄăbÉőµĘ‚Ž©îhć”-› ¤·Şä…çD…ËW6ÉÖĘ~ř|S™ĺŘő|w®Ägr˝«ůQšŻ9ţ°+Bˇ.V#zůŤrŅ́›é,lr?qÄárŃDĺe~šůĚ5ůŽ>C˝Ł©dŞ˙ Ů„Ő1endstream endobj 87 0 obj << /Subtype /XML /Type /Metadata /Length 1168 >> stream 2026-01-08T22:26:13+01:00 2026-01-08T22:26:13+01:00 TeX Untitled endstream endobj 88 0 obj << /Filter /FlateDecode /Length 3193 >> stream xśµZÝoÜĆďłĐ‡´č[Sŕ Č^a1Üď]%) Ň mSC@QD} ď(‰ö©đxVśżľ3ł»äR˘ąE`^’łł3żůÜ9˙°* ľ*ńOüwł?)W×'?śpz»Š˙lö«/.N>~iWÜ‚kµş¸: ;řŠsŘ­ůĘ8_”†Ż.ö'ßłĎ×g’‹Â{Ĺ.ÖÖÂB*vşőYY”JhĄ ë›5n†ŔŠs<°˝F2 » űň¸_ KgŘq÷đĽ ÉKň–6Ŕ«Óq†};;ŕM< Ôěoů‡ëmÚ_@t䤕dŰ:ś­J©-;¬˙sń͉vśnWg‚ž»ŐĹp»Ë%nđă—>Ç]šÂIŹčÓŽMĆ8?d˙`Šé}`>3Şr…¶6ńľ"4/µÔ¬źoUĬŁśśçĽ â>ĘŮŤ°öŰőħiésa«vë™tYˇźď€ĎÜz›µĐč`’˝Ykg4o îSr#ŘuN;J*ÁoB <áŚ+YŔ«3© ­m8čĺ‘$3Ţx„ô%眼‚´ě뉢:f$ŻŔňŕó¦tčżç‚}—%g_ŢL;űć0Ôů‡ř„_QZá m„GS€(‰÷MŐ®áp=Ë2I«ţ]<´u/’¬’‰R¤Ľ^9Îş˘,”°č†Ú#wöů«ĂĐW›a}ńémFĆĄ/@Ŕ¬°ŇFiţ: ?袬9ŕRˇŘáĚ|9Ç]IJˇ.‚˝ ¤Ţ¬?VűŰ]=˝Ŕ­©9»‹;9YCĎ;Ë6ŰZ<„v54oń(ř Cŕ"=g»&D+>I¶ob†#ö˘¨6`!ĺ“Q\;öá0ÔkŽôl; r×@xFN>Źź%K_g‚ď˛ÍnżKJ! ]Ŕ˝ÖÇŕ;¶›ˇé5Ť^Ł0V`­ ŮŰjÇ·ČW]'1ĎpĽPÖŰ,Xi!›v ş™Lŕ5n Ţb}¦<úQČj:  Óřޡpżő‚ uŰ×C•IĎ!¸Űmźk ľŞűşÝÔé» “v@}S˙á]dîŰ6‡Íńp¨·Q˛´PbPl€ĚRđ9v”šľ©P<%ČC®:˛!ëă[p4I†Â7#ÓěUˇŇ· ^$†ë®Â‰ďš¶Nl »ę»}úfŘKpŹ*<ä’q¬Ëu\_źq Śń6fc:IÔ´I ­‡“誯vŁ ’qB/H`ßž\üéűŕźÂ•äpV+p íú  V5»ČĆsU¨§ă”ŽĘë hŞăëz“śŠŘd,ŽÎŞč< 9Ď̢ŚŹÎCş‘„6$ŃIJ(#Ŕť%›ńQ¶0Pýł€ĐY5OóŁ!ČŐ<`ą3_LŞŞääó»­cu?ú»C— tµ{: čc š˙Dö#PEĚ«AKJŘ9%RĐ n SbĐŁ U¬Řőďk´‰çŃ>ć*ţąŠľŞ Ż¨tb;ô.ľÔÉ[śĂFő§đš\üiŔsľ®Ű¶~KZJhNŻwÓ'tXo.×”,©*¤â÷«n·ëh§V ~ť$ĺ캡®ÓkČ“uŇzČŞMű!eî1”;Â÷\>4˘Ăt–î„HˇcI)(đÉ7©žpňÍódüYfżój Ť—†="D?r»¤ 6)ŚbŢ}HzSWŰé˝ü‰}z÷„‚5&tĽ…lT#EůŻ‡B‚¦0pńëřĹaˇŮß&:ŹIlŔž%ś)äU7 ;b$‰Ńëă6†ÇŮttV58 d,ú“†j»C”Ĺtŕ¦Űm§m7­96űtnĚ.†*7ŃĘç0K eĆĐ>ÁvŃ»:4cXĹjΑt·.™NMĚMĆ\=‹ąZd>ş…žxŰeŢwUż_FB/!a2aË÷dhî3ĽďýŃz4tĹO94’„R\őŐľź…îę0űč’”*Ň_$~‚*ůčŔ:9´qJăÍ‹Ă} J›Tz[AS%č‚đoF3'ţăDžBé<ĽÂŠŘBĎžëńŽíę·”öŔ’ťňÓOOü•đWť~Zç‰Öäa.—ę饞–aŢňi)¦eŇţžÎ!Ł‰ŇÓő(Sú«\aź+,Űe…1bO_śb,śžÇ‚™hźŽX^ŠÇ—Ä@<ÍŕQMłl­¨đżŹ˛lŇ6ä÷Ó¶]!-ŤŞBďú„VĎ‘˙1îÓŻGTMučľ#?Ą¦›©IA¨Ťľj4ŻCw~îüÜů¸ó‹čΡćK.{łž–Y˛±#Q–÷tćPoϸĆ<ýlÍýSáű}ÖĄźXÎĚ”\Đ÷ţýkJČĐŽ‹Ř•.·Ëś§űŚÔ|ĽĎ@&BŻ U±†ű+!FWÚĐ)CŁ[c®ŕR{[]켛}ÝŽŤćĬËnÝaü¶­áć¶oÚĐ•†wC.řěnGßEh?©ó·én‡_\lâîX<ÜŻ±Ř}†KE7˙‚Ą€ŠFŻC"sńÜßÄۇ1qŚ@_)Í>ŕgŘű.°Ź‘öĺt˙3ˇÓ‡r_Xş‰ŐĐ×Ő1,9äá‘™ź€K/.SÎĆË‘@ř«á R&0e˝pkĂ+6°J=4Âdd‚©Ć»Ú.™8dr!CŢT$ę® Ɔq$Ýr™”™«ĺ4mߥ‹ â o3,&5¬ÍÔpaÚÔp:Í Č[KaYČâ$#ÎâxHxVă =»Öm ś_Ĺ­ń„pÜáM~ďkÚCúÄ6U›öřń8T)ˇŁx`G¸rĹ+ăxQ ßÝ J„ŃÓ¦?nČőULB×}ugÖĐ•LĹ$´=ö‘2ě ŽOűh<3 ´=Ҥp†;<űűH‡nM©1q…~a´¸ähqbŽ5Ž˝Ň›Ůqpxˇë‚ýáâĂi¦O993 •˘Cň)98ícŽ‡ž#3ň8ż;ö“ÍăƉäřŰá)Ď 8ťSĹ›8 $Ft—ťąŢřŚ°}N˛@ű\÷o§áGäź>ÓŕŚ¶±j·›JÔWŁËc ’RŇě"Ž˙dřÁ§iŻş~źFH±~¨‰"̶ôĹ°}Ŕ?ŇÜ©ŕšŹ©h4Ź´äŇŃbâ„'1°^ś/ŤŹÔTUƉŕ·»/&ÇHZ"ýbÄ $ źŚwt÷†űś[’ .Ť ¦–}8$ĺ\ÍçĆĹůFPC†Q}VĄY˝Ĺ”—4Îę‘‚‡Łźxî4×I#h:Äé’4nnť„i0É„©…Íűč§ ¶ë®›ř»‡äůĽÎ°4»d(śĺL°ŽĚ—…łń+öÝ3¸`Z/ß›×÷ěßHi CůH©W şEű™ ë$Ů´P^q‡†¸…{Ě~qO>„¬B{f[~‡[,ŕë–‚ ›ć&Iôúm®¨*ŕ’^Žâă80ga´ë ˙Ů“Ň4{:ń·H,ˇŕ)ąžhĄşBK§^AqnĹ„_=)­¦ÉěŻďŰĹĎěb$"6‰ă ™„»Eŕ”t7)8 Á¶(~ĎQ ÝE·Ł®$x^Ź€ý4ř…Ą Ř#>2g,ąĺ~5Ű’™ň·˛Î'xžĺDü?`)~Y,Ó]ő!śŇ†ÓŻOO‡Üśsq~18ŹH¬ ŻĺKÂ@΀غ—ŠžB%Ąµpą[p0Sp]şe3ĄZĘĎt°ůo]ŢÜşř€ÎĎyTYS¤čg!ůX§Ćŕ<Éi`cG\>®Ĺ@Ö†’sŽKS`~ďmX~2´Am§ ”ăk"ń?—3a ű^’ş˙SĐoŕ–»ź„ę$•{Üýř=÷“"ČŰýŞskp'ČŐDwÉxh]θĂ:G˙CÚŇNlţrqňOřó_ó]Óendstream endobj 89 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3219 >> stream xśŤW TSך>!’}PÄ^ÓTZťs¬3˝w͵íí팭Ž×Vű°ŠPđUĺaä yHČłOŢ$ä ŹCR|˘Xmm©`[˝Úö®™Î˝sm§ťÚŐ渦s"íťvÖ¬57묬užű˙ż˙˙żďŰa˛ŁTĘÄŇĺĽŢ‘­c@eu(BZíu´Ú[cm‡ >%oŇ#0 C0Ly ­·ęÚö¤zĘ<ĺž2«ŢŢuxU!%%$¨„Ń‚7`˝»~¨âzőŤŞĐ’´äJ1řšTÂćj&ŹĄć˛OdłOĽÁ>ˇ.T¦AmFZŚî˘önbJ¬ťfbĎČyßM˘C“ü±Ť"‰DŰuIök›r¸µ2¨©¶ö“(\Ť|óŐ»ţĚkâĘćrBżŻHŞ­GI¤đ5RÝ+é+tÂđőýőŮÔ¤¦|Ďűčć“ĹvÉyŃwQĎ{|$‰eŠŘdőkŹĂ•řŞY6 -G‹>F‰(á»—P2űÁ.gˇş(tÁ<˙úűż#`óĂ;đÔ‹®Ť´’V@Ě1ĄçŐ”—ÔĂő0˙¦~oöBołç ďÂÔĚÜj†wî?v9öď˘}—Ó‡_€8»űň«l»=Ćľ‚˛Hż=âř–áN@YM¬‡vUł^ĎbĎ=ΦŔ—ŕKÇöOíš®ű ~ §[®ö_ýôł·îB”gŮä¶_âÖC]âN›ŐE"7°Qv®tk©šŕň.OÇćľ7Á?östk qtó P^m&ŃJ§m7&ÇľŽ–0—·“r™ë›ô\5•­ŞöfĽŰëo?V(ÍÜ—µł‘¤?‘[ˇÚđ˛ýCH;Äż~Zd„KN+O@|ćłž{'e§vFȬ>VX§ý·©)fjbşâI=4¸ť´ÝI G€­ŮaÔ©kµMDEW•§âik¤«wť*:Ł&ŁŤć¨îxĂ°Ř’Ź›Ŕ¶ťĄékËfßWÍKXq=e2ě:`˛ěnWŘí ěN»ÓęÂçsç"{†ArŢ7“|DÄ+ŮK¨ţŔ*ÔPj¨Á7 fÜľĽs…8É]RÓj¨Âó×mĎÖĽ7I ^´’aW˘ Ŕ5ŞW{şß!_ú U— oţЬĂţ†\Ą‚j’}ŔúPw%S1ÚpNÁ‹'|č§RŃBW"ŁĄr×)<…ľlrC˘đ¦$‚ …$» l*YłFRáěTőíT7ěÄąÇţ¸ľúl>^ ö˛Hâç([eĎćŰl~ŞŻ¤cSôB«ßęŽŢNíű¨÷zßuďPűé· Î°+$ TČUMJ†,{±ěĹŠL:“ÎÜS]¤>ŇĐłL5» čĆ-ŔbŔ|çţdÉVĐzwq835útô©ţ'­Ťµč¶YĎ@çlßlű5Ü"°©»şgmdmß:«Î˘iĄÚ``Ö;Řs“ąĹÜ žlďµpQ‘ĐEu©`Tč”FeĹzésG64vşôť’j>¬ţŔě2ą` nÖŽ^:Oäy‰ BŹĆ]f1Řô° oTŁ±ŃÔ(ŮPąA˛ˇbV~CrM©ć@ł[GçóO|S$öOňĄ§ßAů“»Đ“Ë„_ľůĎś‰ž…řěŕ«[Éđ dyň˝ë†(ĂőŔ‘vC2'á;‘ŕ[8- öĺFK üÓ°˝{Ŕv ˙P‘ ĘŚŠ á×ĹÍăÝ$Ú`/QwWžÍŽäŔÝpg•4ۨ5r WűUanšÂŞ€Üd¤(JYLô÷¦ĚŘlÄ ‚ĽüÁ±oýrľŘܬ¦0ĽÖ8ň„m”ż)¨kU´ŞĂUáĘpUô@ŞÍčj‚Ę o2Ĺ©ol/J[ q ZÍťUç0·Ŕ–Gá‰k{Nqáwé)í* IRzgÔÁzµľžâŢÄ4%TĐj§˘EŰ® >}ř¤ř´É®sB't86[ßńÔŃ oľ}+^Őŕ7:ő-¤çWçIyDÖ#‹¤:7G^‹—žďťmsĚ-bxhĹ4jŽ›Ź.ĐĎŠôTl"ď[4Đń"—›Ëą$V"čBŽD…@˙śi»¤¬ĘP +!ľIP§´E´ÚÉŘ îwőz)č!ÔµĂôß s4C÷D&ÚH› .Ó(岠: ú»Ż˙îěvéËěâ•lŇťUčˇéKăWÚH‹•¶Cn6m®‡jť™î>P ĺPfW´¦ +>łř-=ŚĆĆ+ňÚ8ĺď_öcJd(f~‡)žz˙'+x˝H[Ŕ1éě©čś$éŘX`gWNhçŁ#ě‚7Ů#l˘˙P„ĺ‡ÍŘ˙MŰřôëóhőEôkg[K»­ťľ˙yjays!Ń A¦ZPVmrŇ.č c`NĘ ]řń^ëQ"Ä°Ź 4ÍŠ|6˙ţy¶,öI“Oc‰K¨O6—ÇůÎńŃD<Ŕč ë‹HŠ5JNîíÎ…Ź˛K6°€ĺŻĽÎ&˘¤ń©Č)†¤9ĄăIJ”žcäŘéű´Č>éDŹˇä·/fíŃRZ¨%ŘçÁîWr˛^Ů?ű~#aöCł˙i˘Ó¨ţ-ţ—¨A„˘‚›Ĺýĺî/ŘDváFꧭÉŇ%ďź ]Ł­´•«Ýl5Ő›Ş´Bšź'Î…°Ô# eť5Ţ„38Ynżű)üöľŕČ´h©z‹6ľ$qo~@P7g&řßqcň;ÉÇ쟇%ÔaÂײJAąÄ6H˘?"Ăâč1`ëşvŃÂ1–É­Çëę4JŹ2D‘L«?(Ţ˙®\‰ŇË-‘ÁČ@ŤÔ%ç’ąřK~‰ýĹöĆŹź;˙Q ® Š~Vđ0Ó÷ő—W‚Ű3 VJjšó˙šŰJP khĄ˘Ş^éđ~oĚ„Żh˛8/T˙~ÁŃŤÜF!s_}ÎŤBBŇŃ÷ˇpbT4Á˙–Ł™ő’ß˙„f2¸>«®á˛AFk¸Ůá–˙1ć ţ»‘X `Ň%˛J´\olFá 6TĹÉ~ťR#—TˇPŔ"­ŕrZďžW×–ľVFčd”Jńb!ßóbr†ý7Íî endstream endobj 90 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 557 >> stream xścd`ab`ddä v 147˛q$şŰ~´ýdaíćaîća™ô“Gč´ŕ!ţ= Ŕ’ś“kÄŔŕÂŕËŕÇ ĚŔ ÔÎŔÎPĘ°‹q=“ÖĆŻ{řŔdŰţď/÷3^?Ěüůźhg[wkwGĹŚšůsfO›Ű'wĂj˘ÇoSĺßÜÚÇó|—j•›Ěv±űěŠĺWzű{&t÷sĚ©îk”kc+čî-o¬®ĚÉ®Îčć0tľűP~:ű¤űoĽč^Ö˝˘{I#Ķžý?ú÷3~/:Âü˝čÇŃ?ýż…Ř«šęk+f´Ě‘˙ľŹmá´Ésç4N)‘˙Íýc%ۢ꾹ߪl5•Ą5“ęçÉC 9đýţÎŘý]ĺBýobw~!qáÓ~ȉNbźÝ6łL.…­Ş¦­ĽnJÝĚ.yáăËßbkíníiéć>]^ßP]9Ły¶ü#¶9ł&ÎźW3ąŞĄµ«»Uţ»5{÷Úž5S×LYµpíúnŽ^¶mýÁ™ňżŰءziˇ3’˝{vϬîŮ«OÔÜrHČ/Ě*–ž˝Ą>{N¦tfw~ui!"äfďgü!w„ů‡ÜŃß“ŘöíÜ·c˙ö+§ď_ęţÎČńÜĺýo9= źßĄsjćÎť3{Ţô¦IÝSäzŮ»—.߸tÎü &,ęć¸ů(FOIÉŢ;X><&,6<¦©Ą©µ»–ŁxvÇ,ąďOŮfÍí]$ż}NűěâĘ†Ć 9>9.ćiö<ś Rš"Çendstream endobj 91 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 614 >> stream xś=]HSaÇßwÇ<ďlhĽ:óB˘¨ űŠ Y¬BÍŹ–eIm¦]:K›‹¦ËŮ cŹ‰sů˘!DTS,Ąčk›™s"Ě\0ű¸iT`đžńNě,ˇçî˙ó˙˙ž?FI*„1VŽ »˛wďO,é Éşih8Đ$uĘ«[ć7ŇŢnB‰á͵uĺ•UŐ˘"d@:¤Gąč"ŠâQzŠ–±Ä+*Í>PR×đjÓ˝x)HĎ9Ş•UÂ\q\¤ ü‡ŢźËŹ<·Ż Š–»f0ć R‰‡ľ¶>č'ó–ĹŚ3%uefQ±Y䧿˝xĚOÇ&8Z' lŁ=Ź© 0U©¨FěJ¦ęîYŠ`…PśCSXšČ2]€§ :Hd2ü5ňţP–ţjîńˢM˛Ý±Á>8ş!JBNv4׊ĂŽŠ4*|3ÄőZĆCčálxx ó~ű ?ź+ë ‰‹É$yéź7Ř凌Ó\®=®wŹËÓ?î2ý¤¸Řî´ĂMív¶§žq%ĂE3SÁŢŃ—Ú‹Ú´ţf —†·]09¬˘ÔÚÜ -ĐŘŢŘÖH¨Ťíô|^ĺôĄSŻi¦űY»č†{ŕn#ë˝J>őŃÇVüb‚‚ý#fX„7ŤT iIÎt”25쀬W,ő—t'żßŃqr23ňl*Ţ+€ËŮ.ňÉű=ú|ŞúśĂŮ ‘m塶¦ĆŇtŁŮÚzöBů’´ D˘Ď]JC1ń_Caů×dźOŻÇććř˙ăş@Y5”¤T1…ë>¬Q#ôDe†endstream endobj 92 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2778 >> stream xś•VyTSWĚ˝.EK&}ŻśşŚ­Ö­ăV;V¤ÚşRWŞ(‹ °'ad|’°dI A•2EŃjEŰÁjĹÚÚń¨ŐÖcëÜ0×sśńĚé?óÇĽű×;÷˝wż÷ű~Ë'bÜG0"‘hÔ†kçĚť=ŰuătçPČPĐHëcÝ &Ťőô$Ż˝Ţ?®{<ăşţ,ó“/Ź‹Oř8qծݪđ˝űfĚž;!ìgŢbÉĚf#ÄLg61ď0~Ěrfł‚ů„™Ç¬b^c^g$ŚăÍx ç2Qć‹ŽŹđŃî¶ĆíűB÷ć‘Fž/źCď!;­řĹ(Ýč1ŁcöĽ­XĎxĽÁ}Ëđ§ŹUDK$ô’[ŁÓO*«BŽzýgmDJ] +#ŃŽ$‹7¶rd5ękyüř«Ň€–f ˝˛śh6ůĺľ8&–?‚Fá”ú„ŁŰËB`ěRí ÎĘĐdčÓ O'ç{źáëł“Č/VrĚÁ+< ŰO.Ü]}ĎKŇŃ1ôˇTÖ„šô´ÜóJĄßĎFÉHŹX’Xe5X}~2˛ąž0FK^”â'SnĚaË󱤥·úĚ龉peýŮ5öđ˛Ýůˇ€%Ç”JŇg:˝'%“Äep€/üčě‹Ţ^şî/©i<¤qÇd×q¤ŰťQmIq-KĆ‹ż‚ΤúuXŇQ 2)g,šËzĽ=Hb˛Şťł« OG?iđ’ś ÉÎ@é›ę™ď•`*ţžş‘ děgd+ î ÉkÔ›•śĐë z:žšĄ†Bp­ľ‚{‡±d °˘ĘXésZ“F·ě6n€Í°Á°:<8.*B !äFöőÜb(1cŹˇÍ ÇĐ,‡čô}7ç€óßŇm§Z—¦›é4şŚŇOÉşŚláɸÂg?[Č$ŢF0áBC‘:Ĺ™¬gS&ĎťCÝařµąń›ôpz‹úťí¸uűˇ@$đęQőŻÎUV.É7rÄ‚Ě9fM¶.S«gĺ;´jm–Ní- ‘zÄEžY Ńo˝nő.┣††śŕ?'Ý2!Ă8Rnč3 Á€…Ś´ćđ… g06 TmV*¤ŕ„Şkm™Őں׶oSXřN%«Ž2¨ ÄM Ź(˗ɲ:W*<›N•-餗ä>iuΓĘköîĽ|ˇü. µŇ%Dýč4Ľv|Ó´¸[}Él®9Ǥś•«ŃptŇĺi +Ę: „ĺĹą¦lł®NŃÝ řú`ëŻç‚Om¬ŕ‚*č=ÜÂgĎ[;żěŤšźĹkJXÉ“Âü•T*PX´6:#‡Lv»eĽ‚=ĆÜĆé¦6´+6wĹËÍH´?Ęx¤€7™sV ¶sĹbĐpP» YŔ—nŞÓ…qTK»‰µ7ĺg+âaĂP ˙Úl´űŇ2Ľ$/MŁłé×s4AYS»ł'˝NĂą–=üÜ „+éP"™ÜxśDóQßĚ‘’™57änçč6¤ű(Ě˙€=EęSąU`…*,ßtú”ŠŐ©y±ąś6*aß>Řš}[ć cIgJ‘ŞPeĽd#nÍđ őí™jÂôMú˝”T˘Úâ’ZöšřÎĂx*]Ľ}űßR¸X}Ä‚@NѸG.€¦ďź6ÁD˝‚C·CŁ]·ăÁęHC˛¸ĽfÎ9‘xiŚ>-’pRąüС*»]N[J}+ąź“cČńţ4]šD:ä—ŰÜ_Ą”W°r6$„†ęőZ ś‹ňtĆÜ|AŐö–’Şš¶źC'>˘ľ¸%Z'ŻVÖ–—ż r…uh˘UAŽö“˘~ÁĹHĘĐ»R¨2P5Ľéőtńg-bX™GRá±ËŤ&ÉČNę'T§Ót>Tü|ş+΋„8żMňŹšŽ×4Ű[Ş[“IY4t&· Á2ý’ÍŞ=Ń»kĹtlq!y/ë.żâĽ t×yŰmĐi•Z/tu÷ţ©sÁ’)~‹Ö,ç–/NJHŠOŠ÷NŐfgë!ÝtĽôŘÉkÉ’‘‰âěŕüí! 49W.Ś‹ĹÝÝ˙ât×ĺއýđ;&žo_ĄĚôyďO•'Ö˛M5kŇŞä&NZĐäľ*BQçśl%‘vQű Ń ş‘ńd@jĂ##1pĄ®¶Ąě04‘ĚĘč>rÇ«Tń J»ÝZŃĐ÷Iăzşd. ˘Sé¤:ş‡|üĎď®Ţ±qćš<;ŘńS‚éŘMkö®Laů7Ą%čJa˛fńďYF:VâdksýÂ’3•:„A´-±1ş3˙¬îÔ‹ň8čŮ~BŐNěG•Bę˙DÖ“{RňŹü(@·«řţ˛ć~Ž@í'ż]&Łş?ßŰĚĄ–%'[ŇŠŇJR p’ ś­9wĆ| ˇŹŻůÎźą~ę‡GwÜ f§Ń-RÉOÂbś—»{zZŚyfŁ ,ŕŻĚčÚw'üń_—l[şÔŻëµĐůj§—ôÚ7m__Ľ˛8đłŕ«ĎŐëuÂ#VCĽ5µxkÓ„ý¶¨Z];ö`G»•,;ŠaţJČęendstream endobj 93 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1041 >> stream xś“}LSgĆßŇöŢËW‡˝é !ąŤ$ś.!Ć°éś87ĄČ¨Ů`ĐÁP@ľĘ€––^ĘĄoˇmŔiˇĘPˇ€vvŐY¦ÁąůCŤ3Űţزeq8·„äŻ »ś˙Nrňśß“<ŹI˘H$ŠVÜ_”ľ+=}cIÄ]k¬•â81Ž“śzq^ţ`ÓwŻ\K@Cľ]ßĐXZ¦E(©Q:†öŁltQ‚"‡ž‰ľŽ’GĹŮâкȦA˛uqű ˛‡!%)Ö‹‚ó ů W ‡Ż:¬Ă5®P&;¤`!Ü=#ĺÁ-Ň×5đ4Ľ“čŔ6'7`šHÜ…o@Á^(4Ťšť b‰ZĚ6Zô{řĽLţČn>ĎÜhŃWq:lÄF»S`…DĂÄđSRY¤]řŢiÚ€<{Rź§‚DI/"y Ť‡¤đŤq:›¤ßŐŔp }Dü2[@Ę ]ÜJŃ‹źNÔÍú/ŚÔľâ^¦“ČĹyC® $‰ůśt![ý8şľjiŽĽ5k×Ë/=öˇ’ž†˛ČqEiw‰µ˛®¦©µWŕO<şÉ¦PĺÍîć‹ě˛ «©C{ŮŠŁůŢĄ“ {Ć>ŇŚ©N˘…3U|,IWcłÝ<ÄQýÄ89wSvâ”m k ‡˘§Ű§§şć’˙w$Ků׺U‡ÜĽŚĂw©›:Ć™>â ľn8­ékc[&± ŕu¸†T‘CV—ˇĹĐŠŤŚ·ąŚŠv÷57ö6%ÓÓ,kc“'÷ä¨+/Ú0¨őňU)š‡Řy%ýö­%(2Šy*…Ń’ô“_y«Ő#u“e· W0u÷ţĹçŞPQ)YÉćű¨#bŔ ŰHújßjR¶•ĄDÖ÷Cj@> ń»áUxb”ô*ĽŮ®ëó9Ć1uíNkŠŞžäiĚkęÍ|<µ}ĄúŮÂcď­1f@goöG;}6áîqÖémsTÝDSď OR`&{ĽŹÉ]z'Ă}SV‚^Éá7őě(9_?3{nrÎc9Óń… rřlE:ů^ˇö0CŻ–}9˙7l]v¨Ć,1N/^10Ie`-[Ż ;í.LŤz¬:ŐËÂdxaŞtI˙ NZÄŹFćĂÁËŢ[ř{ ”iOů­¨ŰO”1â7“‘´—ý NË•×V5Ô–*0EŻ|é˙V'Éţ™źüa!ąČ˝5S°Ž-ŘbłPLü=d ‚ v~”_Ú`XŚ#Ż)L¶N}6QsyÎwÁ˙O8syź’Çgń;@ů$,?»?Ëô»ś§ń ĺ ą!ÓF5ş‰FŚŰYCCII“S|lý?«čą'NÜăµu{#ĚŠ‹FčČůßčendstream endobj 94 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3551 >> stream xś­WyXSgş?a9ßÁ]b*ÖzŇŽŁőŽÖkŰyzÇÖnj]PÜ•ĺ" "„¬°d!d!ä Y!$,!@ «Š¨ŕríT;˝ÔÖÖ©·Ői§·3×έ~ńžëýíŚÎťgžűÇÍIž$Ďó~çĽËďý˝ż—EÄD,+n÷†]I«VŻZůł2™˙őĚŁĚX8#α?7çX<úŮÜŰłGç‘עwůˇXRTĽY*Ë,É*=””}8'÷H^ŻđąE+ âgÄvb±“ŘMě!öű_ÉD ±–H%ÖiÄzb%ń±ŘHl"6‰ÄV"‰ŘF|b6Acg@8XóX0ę™(yô+ŃŽŮ117cCd" ’J ,q»ă>™–8mdúĹŰg´ĎLťéµkÖÄěÁŮż{ĚÚWIĚzĄ L!” §ËX=]¸lŽE+ü$˙ «ßeuYëąMĂî+HˇJ˛Öď®Ö [˛a U¸ ię @1”Ԩꕮ*Ź®qÚ» Ą¬G{5Ţ„*gUm9”Â*‰®|óÖ6ćť$ćÍŇ”éÖ,Ů|Ǩ”¦ˇ[hs+vÖă¨×?#,~µ4üK_<Šůxă ”sc>{ 7ĽŽĂkÁ!ťË@–ČBł‹x€Ý=Ž]}Ů_DňĹ–~.ÚnÝůö|cjͨ@.ż:ź–““†S†%$źoîă")€Ac@Ţ)N®OIpkVńNă°¬‹„Úţ‡Ł,>řęą3ź=„ôá=†R- 2ó¨źßdf˘_ 8u=Cło˘é+Qłfé«Śú…L»?ř·Ň/Ä^Ć°kýydžŔr”‹ÖűUĎű2…V'‡rJč-k÷5{۲ĽG¶ĄĄěVĐě~ăC\hV]ˇö…˙±5ľg•űççłď}ÓĂé*P Bę‹ßžřŽëU ¦zĵ‹ČšéŘ\/Q—®»ŻśĘYoŁ5&u=Íľo‡v‹ÉNˇ™Ŕn¨­”WˇŠ®&µ5Z›Î,­Y$ZżĽhÉRWvMÁ=©9-˛¤Që¶K÷Ńjr­ĺĐ…˛«'l”CŞÂ ©ä2qˇžRרťµŽz›Ť¶Úlv›Íj_€˝¶ÔNixĄOBI˛ř7~´°s>ű´"<ÁY›ÇL[F‹{řÓDB^MaŁ°=ólů)HŐ’źş\·áűTż@…)’šę·wěU]9CŁ6´$Ä,AI` 8-ś>› ă ý7'Ń_ :ŹUóą5P +(&ŔBżAčOý âĽĎu{FMŻ% eÎŘP(,4q1p˙0Ë+bŮ7ynę2ěç2i@—˝öMxćÖUŽV{`3ôPŘđ2~6Kü5a >Š˛Đó_Gw?z3 şM.Hő…tŮ܉8tDwD©4Á Üő˙J¨0*!•Ëłă†ŕxŻ­×ĺ2B'Š„Bo›ĚUŐńżŚ@łĽw͉}ËN¬°*­Š&Ř˝c GăÁ±Ŕ¸˝ÉÖT×ŕéô»» i†X†mFŻÂ$¦ôŠ‹«„âí‚íĹIm•í•mŰŃĎ4ÍÚfMsµ]o‡ŞŁÇäťzň7Ď>ůd7¸MyľÄŢý+şVX+ĚJw5UC6@«ÓZßůI‚gÔs®eÔÚŕh07R&Ň\î[ĺu˘Zq­(řzţ’ÔŠ­*kEħÜ5f—ŐŮűý±ďű˙Ăs¶-0l˘BĚ<Đa )`ÉŽ¨ůĹŰ$ŰĄIG~—÷uá7{•Ú)˙1ŘL‡dž tĂF}C–YgŃ@-U `ĄNmĐ`F”í+Ý+M>ňoü;…_ţxŞłĎÔ:Q„•|â㨽$öĹÜF‡o\óĎgg YáN§o ®öÁPIKˇG`âÁެ®\ 7$ç‹EŮ0‹zý‚Ź.ź ŤhGV{ĆăŻ;G.p‡©@ ;ĚËŻ>ŮJŁdđĂËŁŻ$­­ˇŮ˝ÂFií35¶Á6Ř)uY)”ËĽČY6¦íŘ@kČtkn/˘ľEä©oé©Z›BáË3EXgaŁ´Ťß"ňŠ[D} ˝C u°˛W^šľc˙¶_AŠF0wpü¤ĚŞ« °­©©ˇ±ąÍŰÚÔŽ‹Đ‘Óu¤3תsh`%”K5J#ĹC‡B% –z‹Bą'ó†rO¬•¸űaťßďn<}éÄčgŕ$cŕpdS]™B¦PV(¸e˛©ĽŞ&%Gł»e}ŐfŁšˇ»ĄÖŤK÷—–[Ňl2ÖĂqÔ~':Á~č`ľ›ř#đ×ôżß—zşř<\€ćŢ€f>| Ź«göd”<ČEcvť¨ćTĄë3ůąÂ‚CĹYđ Ěňőiś80…$ŔqrüŘćć8/˙Žó¬–;•3ć OŚć†%ˇx¶×;…Ő~جvçySü›[ü›şßL0k8 ĄL§T J2x;wW—Âr«ÂŮn­o€^Š}°˝ÜS(TIdi§ †ţt-ş¤˙4xčűćÁÖ“ŕĽ0˙Ä‘fŞCaQ¶Š/Ţ)ÚU´3űËĽ»‡żú©şěÖ=x˘>ô˘Ŕ™€WŃă0Í)֔ޠ’4:Ľžŕřkľm5DŠ‰z‰yŽ™őď/ ycöŹűą56k-†ŻCkŃ–E -É8ŔÇÓža塹7ąěţ/üxćÇvŞ*|´Ý`ÓŰ xF÷Ś`=ŠÂüł$îý"zp’‚śĐeއTo—ţ0PPÇťÍ;u0©B`˙.ÇżÖ™ja-׶ŮdµR‡lÁŻ™ĹĄ—%C ™`UZ¤MCŞÉdiµşĆĐ–hë ”čđ:[m­¦‰±„¬]R1EjGCŮ €gŕ†ŕX·­»~ŠÎwĚ .gŠ&®huMÚ¦™?¤˘yřťŚć-Pwhő–R¸ŕŻŔÔsµŹGŁŹ#a8ÁńŽę\ć0Č?–Ţ’Šs1gńbf6CŢc˘ŃÜáŰ|\Ó´Ó·äóÍĂÜđ#Ŕ|;aä¸Áo[Đ<?ríp’Ҩ‚JšÁĂ[©ŻÔŞ…Ů‚t s[$!~Ő~§‘uyN¤zGÚŃ›>–˙.ŞşŤ*ă 3d˝ŐćDsßúôfÖ üaf÷ťňŢ_í?ą‘÷|öŕß\¤8Řާ ąŘĆO_ű RÚ±ĺ_j±ü?ۢlŤçíÓE ';Óŕv¸ĺtyĺŐÄŽí0nÍ•lťÚž~‚#.—Żă(WěĚCěűŢçO°Ŕ$°®›cżŔ?Ç ±ě3ˇ" ™{ąč6^Mü­šl.+ˇVoúqÝ›˛˝>i+ÁÂţ‡IŔ¬TĹ2Ď~OBŻÉëhi;÷A÷%‚ˇĘv©¤ZZĹ”Ä#ńűZ[:i3¸úvpÇ2fF CŇ˙Ožć3·źn•§ĽźęZaTV© eŔ¬ ´iÍe–Ňš2UF.fâö11\t”‰â0…ÉëĂcZ[Ş ­´B]©‚ĄPěŐ×ČMxčáK…ąż‚šW«2Ö]DDŁgÁ¤ĹP@‰Z]ľPs_§´3ßP Ťz=-ÚůöŚ8‚řxŃŔendstream endobj 95 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8518 >> stream xśĄzxĺŢď„ŔĚ `ɺΠô "(í¨ô*˝"˝Ej ›lď=ŮÝw{ď5 BB(‡:Č" QQ=vŹ^Ëy×;|÷|ď,Eüž{îwî˝lČó@ćťyßů•˙¤ëÜ +((č:riéŕWf˙ń¤çvý6Ł čVşuv?9@_·=ąŹ¶?†±¦ŤŰR97±jRődţÁë©"ń*ÉęŇ53eĺłŢś˝vÎşąëçmż±tÓ‚Š…›źaŮŔ ~IńňŐĐaĂGüĄď+Żöë?ňŮQŁ˙<` †őĹfcs°~Ř\¬?6{›Ź=‹•bĆ`°…ŘsXö6[„MŔb‹±‰Ř‹Řl6›Ś Ʀ`/aŻc/cS±!Ř4l(6†ÍŔ†c3±Ř,¬ÖŤ=‚=Š=†=ŽaË0ö¶ăb=°žX1Ö +Äzc%X ÇžÂÖcFc]±‡°‘ŘtŚŔL*hę4 ÓéÂ!…;;ó:ץ ďŠG ’¸EÎ'[şŽîúÁCĽ‡×>ü·nóşÝĺŹ ¤ůщŹŢ~ěÍÇ»=î-*ŕtâˇ'üÜ™Üă=–őř˘çĚâgŠO÷ęÖëťŢîŢ?– *±—ś/až\ůäO•=ŐLőĄÎĐýioźgúěyú٧ö]Ô÷ó?˝Üď‘~˙«ż¨˙ĄgF<łăŮnĎ ź˝ňĎNÝnbŹäż[/,ÁˇŮ\q§íł \#Đ[ €Ę´aH“ˇ˙Žsx.—ĹU’Š’4§-ˇ ń F 0R©/}¶.°î3%­ęĹW*Ĺ4‡'Š¨S§Í岺JţŽgBţTZćôhmŽÔDj#Ć&CŁ±i*fy! Ąř ‘*Ö2/®cobŐĘkäf9 áîqč÷÷Ílg]în: Ű/yŕĐqpNGOÎWpd®×K´ ¬bj.’ę«EMść\?´—ᜯ„j…TŐĄiř*ž‰řR1uXH—Áżŕ ĹŮś¬ĎlÝßȶzŮ,šo ŞĺZÁťËă™đýË7ăתŢď»d©tÓ:ęÎFjłđB¶ŕřUč(„ÖÜt.ÓY5zPmRK0…1ť`Ŕaßőo?“Ž„8Óbz2.pXśŔA^;qíĘŠ_'y¦ uă–2růG wˇÍć@¶`×µÂÜ ąîúúµ±6R‹3/ cĆ0ý™§>dĆĂŚ´˙ţa—”:Pő¦“'¨ˇősć®^H3ľ¬j®l{ł]žYp,p˘ţ@ý_< H~޸»40۱)hLr«+§á"Ł‰«ôUbíÝ 0UYřüxę^ŔÁµžś_PŔK¸nb«Ŕ.ˇJq0Xő¨h$ş»q˙îČí8Šű/˙"îKń­›÷Hö>üů?`×ď'ÇÎ’5ň-oŇ0łąĆ eGňő×O¬ŕ§îŁgwä‡GM4‚‹‘ľW ËEą}٢:`ŕjOÎţrű¸·…Ő*>Í‘"Ş$ĹŮďr˘JDąäHü~K Ľ G@öš'1#hf.–ę˘:Csö˙p[ČÍ ?#`·#Lźľ–3˝űjéß#ńÂx.[°ó*Śwćşĺ2ĺó :Ą$¤JĐp^ĘźR@ĎĎťÄÄNiµFÁ§ÔÄĆíËcËÉtĐŹéĘÖF|üđdk+ÍÄŕŔ{Ĺđ~öÚŤsGćÎpSs‰ ŻĎť=zÁ…ë÷ =*Ü™…‹˛VqŃ×°čZ[G*ţ}Ř×ůCo"2ť€ć1QH•ˇ8{5ŹŐ]’{ŹŰĽQn‹¸ČŹ‰´:Č—Ť[ŚÖPCÍb‚°r`´ÜŐ%ă1×Vę\V7ZĐ(óŠD2ݶÍËpôL¨›oŽ’uţPőÁŮĄŚńMú‰Ţ`1”0˙ŻRj„ŐqCňÁLgśâ˘¸hÚw@†ŰLÔkC•ó.–i…˘0›ş›LűPśł^ RJ¤!EŠć4ÝÉ` ŹY}!Q„yzO¨AÄo˙vŁxIY:ťŚ6Rśŕ±™ľőST,[v?t°śý*řˇö@a+ü!±őůIŠ$ Çŕő`"® čą°öÄ˙ÝxôDW×ü!©šŘ&ęvOś§Ô Ş÷P›ť'ŔnđĎÓ˛EW˛Đ—íɉ§·qwTí×íäMXĐřěÁ̵OŇ<ת¨'\÷ěŢ~ĘRîˇ8Ű.‹¸µ¤Ů‘LĐ—‰„6*R© ęŞ"ĽÎ±#Nüç™×ŕµĎCĐłÔň©ÔůËcÂĂ$§˘NkŠV”l4 %ôs„Ř'K%‚‘¸ă>ŔŔ˛pW¶ íjaîáť\ˇ_QŹ»ë)8ÎC$cŢLFęŃĚ8_©ĺËü ^ł¸Şß8TÍÄJ8ěłďÁÁżžŮ>Ż,D{Öص[‡’´&,âkbµ±qux% 58ó¬r30=ŔčŘ·¦·–[‘­EP´ě‰nŰFţŞQpY>*.‚ϡZ‘Ŕçr¸Cńj•J,©Sôç Ŕ=ŁŹ/»ČŽ‡?Nč#›WÄ+6JPW)yĘ-%łU{öĐ'»7 ÂdŁČ!ŁW>Ĺ›d±H®«|°­veál[Ýě€ĺčq{oćë‡`D‡`D$ +Ó¨ˇÜnÔO·pŽČ屸KRQ?ŞĚ˝Ie€OUB,gx<\ × Ńń» 'lŔÓiNkB ‹?KPŮ·—äjtŁ˝č°Ş‘y)‡oüű îFń2lĎ|ÍRdá׹N\Ć@€-¶-Q~cůÝ~°ě÷mŻłJ‚ţ·đDÔ—NĘýú ř!žÖ‡7QŻâ2amĄÔŻHÓG™řkł…ĄëÖ:NQ0AdôŃ j8.R O<Đâ9a¶  ód:UjT4b€,łĺ3$Dőťć}9'„ťQă’ůĆc˛¸Ô¬S))ëůšF´iş ďÇśëĎuiĘG™MÝç$ [>"šÓ.h3n¨ŕ"ÚŚ˝ÚUĺ¨ŢĘŚ)Ž=m“íű€/ĐsD1kŚ´â`qjNpĄoC¬¶¶Sľ·CÇ>öL†ńt(¬“¸Qsqq>ŞlÔ\)ú$ľ„ŮÚä{´;z隌uŠ(ôZŚ UęŐęUşU‹áľâ“x:Ś'4Ájv­Hb¨Fě•ľ4Đ A(ÓŢr1ŽíÉŮÇćnš°%yđŠt,ÍŕĚL>óŘK_,ý`ď_Sݸ©ÍŚ4PŹ¤í[QłČi%ÎąÎDk/ h ‚ řhĘÉQ!±]Ä€\đ˛iBeJRתo¤áëĚ@îhbÖë’Ňňé±cG>‹ďqSÍÎf{3 Ŕ˙Nů$&ˇ ňąB­Ö*´Ęyc‹U }5şă\ZmÚ"FěEĂ'đDĚ›N*BZÉŹ˛‹˘(Ńś•‚¨ ̤ŰHáÎYéöX<%™p0Ů$pHQŽQr %:\ĚŁ§/ě]l¶×8€•_ŘăOÔĹëăuáD±ÓmwúŮ‚§"ţTFâ‘ŇLÎq°—ĺDĄIIP•¦‚řÔA“żěÄSp,-őŠď€ˇJĽĄÎG…ŔŕŃÇ«‹c‚0&đŞ=*żöî©k\¸ óm®ć™ÚFlŚčS™@(Mą-„¦»„HÎÁef•HIIP™˘r$óí˙<úµŞ®í˙5ß–oŢU qP‰„Â~ Są‡ńý®Np7ů>Q§ W‹%zŢ=ť Ę Ďé`(žTřů43©2¶'îÉ#Ń…\úN—ţŔv©ÚĄqh¶ŤÚ6z먆ÉĹvť[´ ĆTc©ŐU+–‰ĆͤŢčŃQĽNšŕń…˛ĘĄmkÂN»ŕ“ź5Q„?Ř}VôJ≤˝•®MÉśRÄ:ęKŁÁj,ÉXĚk…5uT>ŤYÄŘŌ부ţ. xjŻŰÇlZ“6­eľ‘…Í}DTÓŞ.]Aň‘Y ßIőâŔt'ű|Čŕ°_öRýąFĘáµű€—LJÝRdmĘ#˙\2|JÇGGëŽţu+ÝßćŘČ8‰Z4t-ᬎÉÓ€¬O&ë:žµ/ĄŐH!#1a!ÄÉ‹g`âláĹ|Fd„Pˇĺ™í‰S)6Ä Üš«°Şj»şWřŤÄ´úiŃ©˝<|_UŘüűÝŤ±S‰“±Sá#Ĺö€U‚ővE± Gw‹ţëťrB7?ÂŮ€ž‰ŻµĆŠA‚©˘)â)&M­hQuĘf}˝đ’č˘ŕ˘|ŻÜ¶3qZ‰T´&}ż ŕŃ ‡:ŕ6ňŹ˘,C­E®“‰äŠ^cĆŤš0jĽHTĄ›Iq@žAĹŠ7ŰÓqú"Ń$qIĄ#ŹZĘx‰[[Z[¶gĎž?wál8 €$Ů,tŠ)ćk\*0UĐs ľGÖ{šwYogQˇŇją m¨ż97f ±±ľ<˛ •ÄC/őcfđO˙ ěOlßNkę şŽú$Ďk)ąOL/ĘůpÎŤ¸:Śŕ˙;ŁÁ˙ \ĘGxD¨Ë,B}śp’×N˝˙!ĺÄOŽ,Ą@cŃT¸V-Đ’Ó–Ś7rÍçőÔÚ íë‹3°úLOÎö/î VHüĘ”NEžý3ˇ`‚ćlżĂţlbbŹČ-éŐÎô;ÄÖB»}î’6ÂśPz„`3°H4rqĹ›Ęő`sBÓAZĎsCŮăÇߧŔńUŽQäćőĚ%CĺRů[!w¤nŠSÍŚ¬]–ĺä̱͎–ŐŹě0˝ČřAĐnoŮľgŹý+py¶ŃÔ·+N‰nňl›PŞűŢîĘENĆ <ŕ48ĺ§ĺzd N kŹŚĐ“.n{ĚÖuČu•tţc8Ys@׾4ł.¶ÜŠň¶źĆ›·”ń™&©$Ňş`ˇu§ĚYĺä……-K®€“€| ·‡ŐŔ-tięĘ|+ö ^Ŕ^źźFÝÔ† e˘AŮ@®˝ČŐ§ĺ)MZ˛D„¨ĘpPšM ˛–Z·Îˇ÷ čCJđÍ đ“j.‚s eM‚ą‡(ČÖ™"l‡¬ű3)-H/ľ첤Ĺ-<çë`YDHIL&Ŕ8ó”µkďW?<ĹÂëµďî”^ń/G8˙Ł38ë§lîíĄTŰÎĂ7ł¬ŹÔë3 çk”tŠý#SÎ…ĺlj:PgÉčvĘ[Ö#<©%F©ž!“Yü÷C{|řŁ8‰ «®éXÇŐÎ ‡Q@n÷%f §ŚÉ2ăŔŽĂN6 b|ˇXÁ«Ąj±?švPnükđN6|Óžq s/ŰĹ ĹŚD~ÔXUŐ×Ó°˙ż#$µ¸pBőúř8ű…J‰ţŔÇo ç˛vB"óÉQĚ粮/W…ô\dJź‚¤‚Đ5ĆK2@=ý)Q§ ©Űýqž^^MŹ x]"u7Q H˛Z ź›Ť´Ŕ.ĺk¶”ŕěa”ź/Âáě„đÎJ;đ÷®Bśy¶‹ ŻV˛-ŕ'tIĨ¸óĆF76 ÁPńJŁĐ.Ą„¸(·Ş"÷nŘłiźÉQăNŕŠ†|žĆşC§“€tăîü ŹdíPťŘ-ˇ™8_ˇ ‘H¦[qćy¦ořÜůĚgG4°3»™¨Ő !YË˙űôYĂžéJT Ř]żÂĘ®$ şpŕ!ć)řôűŽ^ŰF…Úě;ÁNłÄÁp3‘Žz‘ßŢźTѮߙ vÍ4ŹÍĚ°F¤.[3ÖśP­I‚H‘đĘ»ţ_Ťz•*ŤHá•ł ńT(Ď(Ľ<šé‘sŕ­‡b^ĹĺH÷ńúƻw ŠrG.äŤË{č&vä2ś˛ôŔâô‹éAčďËĹNˇOĽ•Ő÷­Ŕńm‹]-Î|“ţ6óMćŰbg̵Ç\Ŕu…9«)Ŕ:”Ľö’±ymgçAn—¸¨ZŤ}ä3Š«úóú‰űŐ ¨† »Šy»>Qź¨Ť¤»{Ăt8„Dc2) )N»Ń”ĹĽZĄ ŁęTţ†÷âpžĚ`×Ůgŕ#ě«‘;ĺúq›ř6 µ—HőBÍą±ŤiÇＰ!9ß!ŁË Ő ý#žDOÉ"¤Ťá7q"đUG«uIĹô„@‘ö$ý7<Ć“˛ đ˙öBqF}óŐňĺ˘ %n« o@znŁB şËC?‰`i–Š  ,[eđK.3—Y”J Ň°*j!á0f(n•1dSC!kýFD­ˇúŹ"(ł’ĚP8 ·D•!´¨ů;Ĺ'нÅ°ŮÎU­—ňËeĘZY ŞBYPł—/Ţş~hó±kŞ7oX×XąĂĺ˛Zťwü ęđß–±­•ůáµň·‡¸˙QÂŚ$ä¦üČŠłľ:©ŹSś¦üĐ‘e,eßF˙¶šĐ§•6 Ň­Żŕś`^ÄK…FÍi /ĘÇÝÝÁy㬅ĐĘ•›ô  $óø G–;Ö…ĺvšńăś±zťU_bdÇÓ÷üd ‰—üÉž(„nČĺVŞ…`ąˇľb7ĺ·ąëR …l©Ú¶ćnSĎýe™ÓžűŰ4®Řd”čĺ“™g&0ýŃwŃ Á ńňUC‹ • ČIiP§lxÚęNy˘ßĂĹ_²oŕ"Ú—¤ÝADHN2ŞËP…šÍó]äŐ\ČYޱ‹tŔVvôíHţ3ýĺs™I€yĚńĎÉ,Ř6éü¸ŹÁ5pöTËŮ–łÁËŕ8­9Í?Fr®_®ÖńJ gM­Ą¦„á2rC¸™‚O|‰ŘúşÝë±zK`ÁvćŐéý×1Żő3Ńfü5°ŞŢ7G-1sôe˙[!Jšíˇ rUÜŰ^$ٲ/*Ą9ű˘Ňé´:K`ŕŢË…¸2ȧ^Ěń<;şÉ´&*ŕ…2=%YżeÝj-ż†g›HÁOŐ„Q€[íÍá†4y?¶1” áµBčE±tB zd ä» .Čőí(Ěő˝Ŕe„řŰíď>{âŘág]×É «Ę;_f ^b JűlŠ‹ë‰úĆüÔŽ‹Ío]ű`ůglěśĹÔ¦Ş Ţ¦ŞE«Š*‰ÉÍ)Sś‚_ŕ‰¤Ł…n!ŇúXĄXj¸7G٢\÷kËPě>/çąÍ‰V7R{ű/ ç–.[şĐ@Ż4ĚĄ(VIX—`ő.çŇ»ŕÚZ÷(Ň@Ś˝lňĘ…ţćÍ’övä­˝^´)ŇJÔ ŐUĽjĘDxűŔ˘Ť7ů ěü.$ßYüîěĆśOö¦wľ}˛÷÷ öדPëľP´QuöpĹËköÖxîĆ;§„Źˇ*ăŚE†-Ç]U3e XGr4Ň<Ö:ŕÚ‰˘ś eT[ŻhTn;¶6´8ÝnŠ8glL‘nQ.®-§jqŽfůšcóJ8c‘|¨˝/~ĘćžDů|÷l!ĽGqűM#ŞŐ*I~(ăń`0‘Tú…ôÔźnŕ©`(ž'öWáĎxŇ”XKmÂףLĆ[5µxÁđĂשő„RbșZ˛\¸~Ő…ůŠ¸˙*&}fˇŕ䯱 >ţ“ gŔ ̑™¨»™¶D”~Â’)ťUWÂ7ĐL†;[ë܉@„j¬Ëły±S§ÝŞ`“€®uł—Źuóuâd5O$Ţü,ÄĘ>ýv{r˙ń—ŻbŐ:Ťlíď/‡š˛px¶ŕđMG5]żáúľ» †ťYÄ­ŤhŚ:“hÉꤨ®>oúxtz6eÄ™îŕů>›űh×Ő®kI¦h'3Nż»ţüę×LĄĂ€7¤«×‘äá®_Üs±ăÄÔ ç˝>fÜŞ·Ď*);|“8,.łËâş›lż(w,AÝüŞČKđ!VČ9đŞMU[ëG2Ź,aúć˛Ę'lD€•±ůâ ŤÚĂgĽ ÇĂ^°W0ň"ES…Äs™XŁ™XN›Dů%ŤR>]J óśHÄÜŤż 6 ˲EűŻÎî€ÁŽŮčÉ?Áéđ&wjő„•``°źÇ˙T‹ŚÖŻ°ËUŘůć”ýhÎwgcçßşŇ|ß÷ôËvR‡bşĚď;9»âŚ”ćü4ŤühÇőď\<÷ćŘňŁăG/™:eúî«*$bCp'×CdŻ7;‘­ăˇôÄô1ĚźÚ|ęŢŘ ţ<€˘Ŕůč•/_»üÍçŁ/÷ä|G˙Ö‰+4Käf0 n7Ř—s˛ö•ö¶•Ö*KĹ.Đ Śl ’sŐqÜvÜqÜęBŇŃIş SJE~ŽíqąţÎň[÷—oţ}ůçöÝÖÝöÝöýĹQ-‘N˘6%aďp?bĂŮŞ):t ĆoŽyi˙\_á‡Ěbş?m µ¸¤Üň¸ü¤›„±jžDTůĘG‚3pŘŹ¨Ř_„E<¸™ÁöĘ<Ô÷ăA°°–ňâÇŔ‘Řž¤ârr»FÓ{ňÄU3&͂Օ΀;`eG…HşË˘H¶^Ď‹Î~¦ĹĘťŁŤeäÂĚkç‘Í;íIv€Łd;˙Ă鬻íáÎŐ '‚÷~|Ę“z»ócćt®ý% p€´·-ę$mx˝mF­@·ZfFÜ/ş6sś„Íč.÷.óď‰ÚȤ§T%Đ°É€~‡)q÷ĽŠrzTĎÁÓÜýMűö7Ţ:Vś$‰`Ř›đ‚$UF¤T ®6kőZăĽuĹC+şPĄSéŚ4¶-GEŤŇ‹«.­Ľ¸ęäşbźŃ§XH' F˘)‘[á§gěš×:·u^[/dEr7ůÇÖ­¸ńę,©úQÓ Ě2™Y@ę ˛ ¬"űëű›¤¶*©ńšŠ¸×óŘ@¬W€ŕ\˛µsµ"ů<¦Ś$.¸×vpqöÖť—/ďä^ćĘĚ*Ú(űŰNdśü'ž  ąOjŁ™O‘?Ńj­Ú=$ YĂĽŔUh%jqT•¦sťńdŇ› kĂ2}»7Z`˛ü!pą‡ŕîň-ËyË+‡.(«E*±Jˇ뀔…ä1ʉl>ŹĎurGń­öOŹßjzeČMeÉĘŘ”·&ďťňÖĽĹZ—ÖŁ¶’5¸T%— “†°†~»üäúSëO®íÖEÔĂuŐX¤ŘĘÜX3{Φ5Ó_[ß Ěď“ezĂÎĂĂę„ YŕX(IH=Jý§KĄ°€Ý|ôDW\xü^&cŠ€Ě„–éżb¸-Ď+ťŃf­("   6ń4Ă 0EóGűŽWjdĺ!e4 řCěţiRţ Ŕ§_‡O1ÄMÄ*~…,$)á\2›î‹â\Ä漋Ř'ăţVGŢű%N°Nä‘ ‘7äȨJ…¦ ú?VAČGŤLÄúüë„XĘŐŔšĽ1 ˇ*ôŹéÖĂţ"Fąňendstream endobj 96 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 623 >> stream xś5‘}HSaĆßw×xŻ5fîvQ4®A!b"}؇l6›%&l¤ŁĐ-¨t®rµWk*X-ęź jJMŇR˛pĂ°PáÎŤbB,‘9wĽ»#:篇çyÎď`”¦AătÓ1“© ¤  5dS§r5aÝBµŐ¦ő(›úŻ™ScŰQŞH“íĘ…zË%„ ČLč0:ŠN˘rÄ«: J@QlĆ!Ľ®Ńmâ*Ňmjôcč©]ÉůhęĺÔF˛„(R2Ĺ/‡’Upéľß±ŕ«†˛VOm“XW^:twđÚK^Ś¶űÍągč ›­†WĹđÔ> ±ÇˇX‚U,JťČ˛ZK†˛tži˛4ČŚµ?°CR˝2ňaŰ) ·ÇťËDć©×ÓM»ya!:±¸ĽPlĹ\’ÖԴˆ+MVÉPKV?-'Í‘2ZŇĐTˇfÁ+#¨}~}Ćoˇ.ÂEaUôő>ęóőúź ÷ S~¦˙Hu^#ŮĂŽ·0|*P>7z04šwQˇľNőń˧żď:kno>'ąÜN7uR»×ŢiçÁÍňĹb¨m,łTřĆĄ®wᇯĽ÷_Ü ü?¤Î üÂ3ö/A—Ě)\Â*˛rŢ_Ů_IUF–˝w÷4€źz˙Ü˙&Ż:’°N>i·Ç«Ź¬ N6[˝Rçmšę6•ż“gű˝\oµ9[;®ßąA‹hÝüÍyŐ­RoŚĆőßâĺ,a6¬TIŁ¬‰-„[âţxśü_KX)~a5Ó†EVŤuŇV®ŻT›ŽĐ_u‹%Wendstream endobj 97 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8103 >> stream xś­Y TS×Öľä^«VKšď^k«­u˘U[µÖYQqę, !@ C ™OČLH¦‚ÎłŐ:ŹUlmŐÖ¶v°ÓÓžĐă{ď?¬ŻoXŻë­ősYÉ‚ś›{÷>ßţö÷íBtďF„„„ôX2{qěQQQěăQŃŻęŽÂ0Đ+ôęn8ô×pXöěŰçh_‚ý™5M0=mFúĚŚYÂŮ™ŃYsDsĹó$ł7ÍωŹÍMX·yá–­‹“–$/M᧮8b$oTÔoŽ;î…·Ţ?aâwűľ6lM‰8âeb!ń ±B,&†KW‰ĄÄkÄ2b±śxťXA 'VÓ‰UÄ b$ń1“E¬&fŁ‰ŮDMĽAĚ!ćcyÄX"†GĚ'b‰Äx"•čMęűÁ^?>„á4·ö|R¨ÍÝ«Ő´Pääí!ąí7}‚a·÷EOqĐE" "0O51fł¤@¤ÎÓÁĘ“ň[zpë]ř˛Ý®ö$ÄŽ‘ă?‡ďuź{Ü—lWěúřŢé/ě nŁç\0ÉŐ9@ą‹¬Ĺ ´‘6C.]3IĄŁ»ŕ‚–ŕop?äŃčľZˢĄ’l¨×áÍĘ$·dht‹…LNj¦ą…1ÂiŐ›NHÚ@?Ř÷űÇ°7ě5ęę±tuć¦-Ěy–#-O3=ap”’Rs6€_fKˇS] ÜśD—c:zéĐ©·ˇ™ 6hŘű@;1„:BBŕźď_ü1´ůŹpó yö6·ś‰-ŔuŠ»÷‹Ą{^J§4:‹Íöb‹3ý3ć!«Î^§â° śBç’™ńrkŽÄ”=€Ű®ÖÔž˙{h_-¦( ‡˛ |ű~hđËs<—°5Ń(«ÉjgŕdX 6`Ł¶Őíˇ¨…Mp™± Puë Č0…ʨ·ŢM4zěńŰčä3…¸pŔĂŞźo_jk9Y}ŔnŕFT- ±JÔ[|€ršm˙Â>y®‚Ň<׆Ŕ{îĺŠ+Đ04 Ĺ1R҆ćĂ×Ńx¸ě’g˙9–©UçX¦ćyE+ ˙ˡđEpoŔaÁ'ĽŮôÂZDr?ş‡ś\”\&đĆďĎݨOĘľ:Ë´ I 5JAµ^1yábĺĺ˝4ôÁÁ$w †±äÓ¶ŢĎආN\ąŹqő t DnL/ÚÍŔ xUńIÚ-t2űŚńă[ů–L0@îh´6»\ŕÄ©<Ŕo&w×ę72HŽ@ąłŮÜB78]\,÷#Z¬¸vëjÝíť­ŰMÖz˝5ç\äZM‚d#żBP»á¤l?Ř vUů[mŶbS‰qL$â HÉäTÓ^÷łż‘č5y·ýY1Î%§%NżDŕ~ŚŰ<ŁI űŤ|Ţ­·Ű̶€f3ó¤™LLQ'KĄF Ăqź¸† p|)ÖíL°™lm¶4»ÜPBČ.˘tŠŁ!•]ťä0KSnŁµ‘e‰US} T^+m˝ă#ýgĽŤ'@ăř¤×ź›Y Î×0‚™iłłtJŤRŻ  UµĽZY=®‹Ôٵv`§Ě¤Ą*`¬Âç±W 9A˝"¸$( „đő{l—Ťâ}r{«6yCĆ "jýĆę–LÚd0>×ç 0Ü솬šľP”4öŢę›wîűĚMáĐq‹ ľG6—[NwE„;vWD]´v‰ü3ýłkfűf7Ľi–›ňÝl {ű˘«©âhĺŃŞŁ·Őmrăr6ĺ[ó-ůő#+VT­¬Xa–›enŕĺWKZNÂ1‘ŐgÝ·o˛9Ŕ'k uů¦4–›˘ĚČŰ ĹGˇX!Ňp4ľ‚…?ë|ć9ŃťM÷4Ţ&Ŕć-çW;€CęJ*RY” Đ Ô(t…‹ŃHu®&W•'«)¬WÔJŰňÚ¤m9‡#őV-[Ý5­Fog€ťJČ+j…ÉžZ8Fä ßu Ăďş?‚›»_ŕů{Ü­€ú°iÎL\üDďnAL!iźüťä$8 Î7»ăH­j7c4‚–&Ë^ęşp%™®ŮÄOŃ쨥á;dg!ą¨ď˘ŽŽź˙&˙š»GŕÉ®©+÷úęłĘÓi„ń†’`öęĄó´”–łfcëĆBÚ~„aŰö_Ü^şcâ_ŁBËŮť¨Â;áW ľF}"ÍZ{!«& uÚ¸ŮëŁ^FČlE…»ŞÔ]RĘ””–”ąJíŇŐéO÷¤x•ÂHłĆ¦**O¤ĚÇŘŢČ!sA¶QjĎqČ*eĄÉ{¶îIŢŁ,‰ÔéYŕXmV“9°=˛Â[ćóTęv”ífÓ?›OViě Üş)ąY*ĄTŚ• ČŻV:Eu[[@9(őÚ]Ć.Ŕâ2Çťc„Z%¸SŠ;ˇµ,XËÉ[źOľ'}E®rßî°"Žoő©ĚCXÉôý°'$ÇŔnčĹk… [x+­'€§]­ŮşY’(ŽXlůłX±ĺĄTgĆ;ĹÖéëűN@˘…Oę”2¬ÚJo˙]Á˙Ń+ČşNńP8±Q ;iI‘Ôj©ŕNrg‹ĄÉYlşľ“ĘX­´Áüč)”aóęĘ÷ˇn{Pč~ÔÍTh“%0ôŔ +$J‰ä=At,‰UVRiŞr‚: xĄ˘"Šź—#\µźż—1r®íúO5\‹ÜvŻľ“‘ĺűkZO>eęęGČ»pľĺJ-Sdµ8pQŮ4•T™X ˘36e®3 Éżh>˘JHî^đq%ě»SvN+Ř!ŻbX‡:20¬;şá˝Tô~ÚúďŰa"çĹ©7`xČu ­—F,ZcĐaKě’~WPě54˙Š1Ë-˘R€+±´Č\m)ąănŔEWáB[ą˝ÜRa|ňad|Š:%ż ‹ČwČ˙Ҩ¦“Ů:EJ}r ‚§e٦°®LýA®7ä(ŢW9ćçm+Úĺ­ó5î7íÄX ĺŚD˝ß@/ŽF}4j5¦"JaÓÓđ+N9ŚĂ REk& WdéE Pc9×řđ‡ż÷Ö·唣ĐTH˙K…`ˇ]~)ždłRFn«Ő.b hsćÎĹžµXW÷öę=čôŚ<˛ßżł‰™GÂ×p˙Ë%ů©¦ýL°DwźyĄ$řĐqăňľŞ’j[5 ^‰ź_€X&’ @ŁT)26Ö`§¶ö˘ü˛Ţ Jőnę7·ßą7ë‚ęž–Š»K 5Ôę¤Ě“rÖ"Íş®˝Ů°Ŕz‘Ý;T’e9.‘Kű hŘ Íeßm [î©Ĺ&› ~@^cPę9úđ„Ďă™jE­Ú(§śk«m7š°O4Q6-ơ:Y®¦…ëW V€Í Ĺ“^żOwĽO=Ľö]ß~B[8•†—‹ăX öp⚎ń5Ř cY¸ńgÜFdÇrŢ›S g-™2Ś¦ĐTÉB¸®„a4śĎšâ4ÎCk±śĐh š(éÉóĽr@Ň# y⶗ÖŤî‚kq;Ţ©]jź ÉÇ.wÔĘ|­TźĐ0“ÂŢXň–ë+XÉ÷F^ÝC«7†^ …ˇqďňoˇ;ś$.•O¨)Ś#ŁĚYč.PBÁ@=`y|űĹcĹn˝ÚNgkä9 ›Ę¨ĘőŐTVy¬ňoŠš7óuú©“j€;jŕąvjńçűđŽú»?ôž˙P~j8źüĆ{ľŹŁŹ_ZLqoĄůFéîwťăŠŃčk  ¶ÜTYDÝŕśçő;Öř¦x°lŃ%ŠR“6,R®üm6VĂŧ>őAťĎ) Ż;*ş §ßl:Á}(‡=«yrŤrý:°† _Iiż醟ϯÝWNoqn6&*Š“b6‚FĘB]¶šbŕҹ奚 u•®«áŹ?¸Űśż3ÝËÉÚŞšŠŔJ!“A©V«@•çĘ/+/q—ŐŠĽi[“ňE´N§Őj AŐ Đ®1QÜżČÝ©öÔ“ŢZ•ěJ­Ę`ĚZ›ŕC­Ńk $*!Č|÷¦)Ĺ},OÄł“G÷ŽŃ·8gżUNž>;wtĂ%żč|Âs‘Ç]~xĆż(fSáÄw3„%Ţ\ZZĄ÷é|ÔďFY, Ŕnaâ•ĐFvkJÉÖíjćI TFfÄtmťŮ5ĐúĆYM҆Ě=«\k1ç%d/1Ŕ#ńUď|Źő$h€ÇĽđhç8¶ţüÇă˝Ď á€ň8ťh›LŤ'ŁëÇÂűw®Űi i×+sL+„y´,/G– Ţ…T;d·"ĺW˛ŽŤhŞ´U™+í'üÇ÷ZĎSv¶~ĐŔ÷GÚrŤy{×AčSÄbéÍźć\ŚŕŢoíŇßő5Úµ j ·ć¨ăđ­¦$dF¦©‘ ö$C ŹŰ.ÔIDéýţĚşÚo ^čKŁątzn@×.Qu!ÇĎÁËçB!uwö˝âvĚő=oüňÓ§kÚßibř§č—7ĆűłÚŔ꣋‡Ż~yŇ«e´IŞKÇÖit8JÚô¶B©<­ VcĘŐ*6íZS?PÆD#îË7ŁŠŹ¦JíŃś(8‘ď›a‘šň€”šşrĆŰŻľ~’Úŕ0”Ť,ÖX úBŤŇIU‘Ę^ę¬sŮi«ĂVl.~ʬüřŰÓtüĺqg:ŢďJGsŁ§ă rŚ9 ‡Z˘-Í09etµ©ÄbşhnŢvŇ´P~NmHb=U|ĽzKnĹ l}Ńś„Dó.ÖNŐ—[¶Ó~Î>pR׼5dšifçŮťs‡g*–K:ç,]ұ±ţ?Dz ‹“*4ogŔłłÎWáČuIťyľd_Š7ŮŞ´`ź#ŃJ1*VXá ňěY®<_ľG¸MŘ’±mËáHÜEŔL᯶5xÝÎ};Źě=Çę­y|˛Ô%ĎO]“š.bR3©B*IţĹŽá’NÖnúŻ›‰ RiŢÁtřĚĐi/ýÓě:žýĹ|üßĆ×·«÷ë;żüöśmîZ)É-©údZúĎ|đź?sRÓMŰ(&A«ľ)ł9Łi#ĚËÓe_]çź bŔ‚xq,Ĺý®sÔÝ=TCqÇ[Ř ˛yČłŔ,p&žE‹NŁEgĐbKľI‰¶Sa25ší‡ŕČpÔa8Âä0Ů‹XY2ťYÖ¬˝Ţ}v¤GšTf•]Ź»w0ů,îł0ö$Ś;cKvy¶_a3˝™On L @­WéŐJadîâě%Ů‹ăPl¤2M‘^–߬Ř.ß{m†˝7Á^:§Šm† '@ÖĺüZr/p(Şgck¨JJŹ%Ź"[›źŐx4‚€˘:‹Ęĺ¤gVfŐV{ĘüEŚ•Ľ<#°pę)Ó·Ň ±÷~Ş phŠ‘„ß=Äžîe]É+ŇŐŘE§,ZżZŻÓkŽŇZÔwívŻ‹öíríű©˝§VĐÜ»©˘¬Ô¤šěÚŇ2‹ËÁ˛iěT.8â„zŢBXyę©C†¬DÝEA­÷)νâN~á…Źy˛€V µužÍőÔHęRhîQť®“ŘŻUwDz±ÖŘń)´ÝaM†Ľc4-ËŐ"9FŮQČŮiŤ‰Ç±ë».´×^6Ý×Á× ČYp™âîÝ‘´Ě·r·]Łe…VŘ“<Ř:@‚`żĺ€i»y·§ÉŰ´­z&čv4ô5f ŇŤJˇsŤşˇţ.¸üśšîş%lűâZMżúEđÜäÚŔËő¤’LHT'äćkŚo±ôkČTüVvčsťtčlňüÜěB9˝^°¬đ™€1~<Úrč\˙ečý`€ç;Üzř ľŢ=îÝѱSĎeĎYłh®R©UcÉ!Ă»_g°ćr­eţ’xŽŔ€±žą|!˛®¶¶¶Ţ˙á…ŻŻJÁ°áź °á#§§ěn¨ö4ÔJjřXvÍÓpÄuA>\}ÜnúöŹđťS°¤ŰC‚íĽćýÇJŹęTmÜŞůâ s$L–zˇ KCiTŮ v@•pś „íđÜ«kFÍ`¤¤!&mĚ8°Ě©f•’PŤŐţ@]vuš™QsâsŇřaŘĘĎ!ńř#H>tőÍ2†{ţzÍĄ>ë˙yÔ‘‘“_Ű8"Ĺ—][[]ŐUńËyöEXsîż5ăZ÷Ç:8‘+Ł8›řút>úś‚.k–’ŽÓýĺ÷ׂKI`6Z:źŮeąz•\EŹDG˘—GˇÁ˛™ä5 yŞ.Ŕă>€ş ö„| ]Imp F|`ázčűŐ}kĘO`/žEo5XUďńÔ×eUe¤ge§ĽňÉÄaďo~†˝šŤUH/†űíj°.gk2W>µOí7ŕ\]ö7[­Věz‹HEkÖČĘĎŃ”|-¬ńÎ n,5E“ĆHé9€ĺ¤†B’J“޸ÄéµX躦¶Ę=¬{ůLďBÝÁ­}krb^aŽ.q̡ܳTWEljá˛ÇávŘKäý‚}Áőó(ř (ŚJ ĐĹ —nŘ ŐŞ4@…wTcÓ™JkZ*Kh˙β¸6vĘ?xĎFqď'Š$É|Ż(PᶹK¸ůO˙Óéţůôgě…)ţÝ_@١°ĽĂ3pŔ}óOç.×7´xÚ@3h*¨J×1 *#[’‘Q%©©­¬hľCďŚ@‹Đpôçz´·Ď 9°űŁ°ęąh1^cDĎńŠÉK>Čů†Qżt9GŤz"blú·iiP ś†â§őÄÁ»7¶á‚žń ôóŽ ĽdŹ%}·ţh j8>P]äĂĚ0źł|Ć’é'˝7j+ /Q©•˘zşSc,÷€zŞ‚UźF8řÂ#W•»Ň]ů5ŚŚ´;měŃKČ·A¬n0XZuőÔočč+î h/ô·‰a­Ŕ/xzrzĆĚ©`%'­Żýeţ7€úr.ÂçÚŹOŰĂČěrG»ĂÓŰOďü¨˙˝·?ůć¨ŘASŹŻ<ł#{%Ź{ßl0›ű+‡Žßf.˛-8҆¬Š‚™?¬ł¨·§®zgĆä}źË± őűńäĹö–ă>HśRB­Q´`Ńşőüµ ž|ÇŠ¦zŐűĎnnő‡Ô„ďľóLřkŤ`7x…gä€q†aKfĄ%'e­I ŢžUGŐúÝ ţÜę´,q^¦ŽQ’S®ň/Ái·ŕZźŔÍhöIó& hî#e†.-˝?"n"v†'vś*Ą ËŰBjgň‡ŹÔË…0ňęEóí Ű™R{ąąPŹŠŃŕ%Ěo=%8Ť­Ň{ŹŮFśţµ«±\îl,¨˝űż,`?Ĺö/«©–VĂ_« Ő°Čű™7üř¸¸NŔŻ5Ü#rx®c8ooÚ1é1p´ąvW/3&.*>nS\|⡥‘Šü\1.kĄ]Y¬ď|Je÷Řťp<4Ŕ‰PËľ›­fvě”Ű•ůę|ĄŠŢ¸lNĘl0,ń,Ţ+¬ÎŞÚ^kPwÝdJAľqq~Ó ű´ď,Ü!mˇá-t‰%[;ŚĄŢŢŹzţ@s>+n†ÝÁÇ÷ŽüŁÍ°ĎHߧN‹CĹ\”ĆÓĦż6Poŕđf/ůŔ»ß,-Q)Kč‰î™` č|¨L=Y|•‡ĎŚŐŕő:—˙c)óOK»†đe/śĘ6gîŃ3đWžVŻÓ-Ą˛jmtG_ŽÍYä`¸»Ň¬Â-˝óń˙_»st@ôĘ–ó4z=‹8ŤYm3Pá[±ÉnWU¸U-ó׼VÇ®}JfĚc¸L®öŠ`Ż/Ř—îň``ŠM§ýÇŰÚĚf\q6,Ŕ,*“Nš±%[F ăóVŐWTáĘŮî­j Ľüś|Uľ¬“Ěţ—Óď˙óé]ŹŮP¶ř×<?śbńwĄCÉË×äHd2ÔőY…&ô.@sOˇeđUôśEgŐX;šťéą‹yöIă|Ŕ Mp.ě űZ­ĹěŔ•ŰjĹ©Á 5č †˙¸–SUΩĐ3ř:Z6: «ÎuĘ~A}Ů+˝ иdzˇ^*U{ŤEcĄŤś’˘*OI ‡á‡ŕdŔţÎŹ1h(ě‹{ŤE řčĚv·č¨§Ži,$EŢđNÍÁ˝ýßUëflűżć?Ś™Čzîśq}vÍáfíęÜÂcŁQ‘]ÓŕöVZ^µ))µ 7Öę4jvH’_*·Šś™ÖL#%çŚ@˝Öˇľ ljăé”@fô¤G$÷öW—NÜ®«.”űi±*O2ANqN…šzf:gbl[.ÂŻYkűëfËď‚ů˙“ćÜ'¬8xs€ŐQ ĽÔ• ‹¬Č޲Š–n_PľŚ¨ÇFŮP P$%˙ĚůňÜ©Oëĺ"?-ĚĘä[óťJcHoTQĎÓĎ…:§ôęA˙‚×­endstream endobj 98 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4158 >> stream xś­XytŐž®¸Ul]ö$_OPÄ…EAQq|Č* ‚€l YéîęîôľĄÓ·Ó[zß;I‡$„M–6ĂÖ "‘ETpÇ }ç©·ťâĚĚ­Âűăť3çĚäôIźÔą·îoůľď÷Ýä}ű999ý gŤ7nśđG…—gÓżĎéĺÂA}=ŃGDh°Ż†J?#**«¦MŻŮ$™%•q%ŠŐoŻY»ný …E‹6ľQţäńOżôŘh‚xťO, !% ‰"b1šxXL,!^!Ţ$¦Ó‰ÄLbń*ń 1›@L$ž%ćĎóÁÄBDĐCô'#qxIŘźręsPźtî¨Üł}'öŇŻ€}ärj%í/ęo@ =pë Ĺ ë߸Oy_÷˛ˇó†z‡v{bX›H$’Š.üwźAź÷őţ¶gP&S”ůŃŘé=¨¨'Źľ€^ČŠĹ~2aW3€BĄădCśĄĎä3‹˝›Óh”˛°>ŢI )ŇJ¨ýrv1z|˛˙ÜŐĂÁ·W0|í2R¦SŐJb¦‹&€TŘ—Śj‚^U >P|É÷]ö¦Ľt=s+K}”É9v5÷ä"{ö51?P7u8NéI'źsíQÔR€ú.üĄüdĘťř7~¤ř|^!†N› :©‹ď^ýü㮩Óů—ĺO<ĂÔż¸—ť3^ˇnÂWgĐŘ :{7Wç‡yôw8×ÄŤd§Ě®`&Ni”pa=ÎőßÝlĹą^ţ'ą–€­e;ű!…ČŻ~EäoSŕ‡+Ę7°ČÉĎ›¦,™ň¤f_>°`€…~ţ˘Nżwđĵ}ăgZ`ťÍÂÜéŔ*Y¶+#şÚ˘¸üű®f»Ä7ŐŐ¤\a”˛´\Ô$zźÇmw 1€–űń« и4=č×Ń~"ËŻ2•žă‚şf–Ţ÷ýMµ8«ţšD˘.ţ‘‘ăVó,ßWÇŢ= íĘ Ń÷=č_>ÜÓł zčűŢCKIi­AĆŇ.˘Ĺ‡ôxěž‚,b Ť1›z¨+dJ(ä–JłÝ-Ě<>Ž¤(Ź„f›š¨ň9‹ş73×Ič¶ ÚänĄBa.7ŮŤĐĚđyh !ë|PµÄ›üć2™Ş‹–17‡‚µAÚ‹š{˘˝öëĚ̢Ś¨NǡzQ ú]ĽťlŃ«~0« 2YPŹóö|Îg&úm‰V«PTI–nqąí®´? Gl‘‚ö¸«•Ąí1] †áID‚Ż >č>†n ŮŠß)H%˘é®…á5ł”.+fď€sšúŁÇ瞝ϠX&ŹŽ"¶SĽŁrź÷˙Úoí?Ł<~śf+=%!Ř÷]hěhđBŻÝ;ŕ»&ĎjŠî¬öŘj; Úśń8{™Lč‚rµÎ µ0Bĺž5zžď'}ś]ľ‡łVrÎČ:)†ďb¸,)ë¦čŤi- —”×)ěˇĘ&\ei@ov'bž»:›AC¸ôdŹyôdvŞxؤŐĘąô7|x^9Vň ¤.^Ý˙) [N…T«•0&ň­béşBnë~iĐód,ĺhŤkR–ůKĐVë–ËkM÷`íΠ⌝]ďAëqCö\ďĹNYŁÓ(XZĆ…tM ˝ÇÓ{Đ27†MA*ĬړPů¤L’ˇőĽ¬üŻ7dŐm ŮÇŇŰâę /6mćÜěmf“ÝT Uiäx1¦nŠiă‹ůő¨¸Mť„°A” Lw6ń†­Z!lá w X$(ˇ@ A÷}źbľž„vi´˘uŐaĂ~¸îőoMS´ś čš™ĎpDŢŽOÎ.A×@Ę.eţ(Ąő• ż&ĹćK˝oňÂňůkßveÔD&-± ć9¬1)ÖÓŘm|ĹdŮţB1é#YR8’ŕĎ÷«<Î÷k¸żM Ťż†č¤I\˘Ňr,}D5Ä™‚vµC[”ßú|ë¤ö«}’vHąA FíÁpŁ·!ŕôoůyÇOť?9|öPR- őbb$Ş.ă\FSÁ(PŁŃq÷°®7¦śł8G…§ŇUŃÎżśďÝVxî‡.'ĘwFś{”˛řVzn ¸±4nn†]f|Ýíčĺ|W›głŁŤ dŘ›J)9–ż`¬Éĺ]’=–đ‡aı„Pw›ż(‚«aÝzc•¦DS˘_ąÎ?’üďDY* ’w y}xRÔݸQrôRv 8ćH4Ä!uâśd2ËâgVđÇüÇę‹]ő6ídě H5 ©‚–Íú° RÍľpŚu¶¨Ú«„T9s q—Ý ť,šMÂď^ÉŚvSëŔ“Ěł*Rʦ–x˘ŮGŤEsůńâgIzßě)ÚĄ%ŻĹŹű&¶ËĂlqu:¶Ŕ;ÆËd;ouőG\Ĺ˝ËŕÔwĽĐ9ąăĹÖ™ůN}ŁˇÖ¨±ęKĺ/LO ”­\tS…Z"]¶»tďĎ»ĐŔ+if"vţ¶ă7wÔqE]ţúpRIŹ;:RśKÉ>ŚqŃˉV ŇŚĚ¦<Ćć:Ü“ äK¤T^;\Xiî]©î]Ň7ýĂü˝Đ“›íK ­6+´R͵©D,v1OrÎź4Łfę›LÍZM1\A=|•ďŹţtîôűŚĂăđÂF*¦ö*=A‹Ě¬©-]­Ú©§g\şöĹéŹ~H&ëëď6Ż¨W¨€Pśíç[ĐôźX@ř§É˛–5ńUxŞyf$?Ďąôęc`}  îMlŰF©HşBę×61źx¬1•Tů8vi6úP ć·ŮŚů= (”™" I˛ürţ†şlNč˘>>yĺ*㇬]ĹžĺÔęěZ¨Ą¦ľ>kÎK+®ś3Ý­ĂC'ťÉÉ>t>ѨHŚdĚŐţ®ęXé.vÝż-J,Âáő1ž/` ¤‹řëX4R>ĐÝp"ąuc €§$•Txĺ6ąRĎČĘÖ¨×ÂŕÜnŮUĘ~R?łçÔ§đÜłŔ9şÇ~!Q&ÍÁ˘=‹ö‹ŔŤxRR›4N3ĹŘżó™çđCSďCťZ©ňŞ#ő,:ţ`4ˇ HŚ&4±“Pĺx0KKśµ,?ě(8¸'±;i2hÝLŁ:l C*I¶™éŞś6aő„Ű-áĺ'Ń+G»O˘ĺ'Ýś¨í8'ŕŽyôßučłěb¤V5n„Ô¤ç^{˛ŇSŢÄ6Ôą,v eĂ…”—A)¬đËŐýŁn5WşxÉ#Đ+ľëęr'ö2ű’]ŰťďRŤ$Ćç'F2ó€Ĺ^g·Ř)ÖśtŇ×ŕsřŘMZßVŹËxíę™ďҦm[ß`Ŧzwxb§<¨JÂ8Ś)ĘEî\Ű°vy-Ç1Ľĺ¦^ ¶č şŹ·íÇĆúC żµx¦Pf®+ŮT®+Ő¬«[×µîőáj˙†¸µÂą@űľĂ{şŽ0Đe}gŤ{ e$Ż\öcËoď4şŰ˘^ÄŢc‘¸e—“ô/˙f- ·*ť2f,P[uZ¨˘äAmüŹą»D†ŢÉ ŇŚ0ugőLGóřgp îť˝ÂĹCşŮëŔÝkÖ(aŠ #”­@Ąß‚ýć]•pULŇĘ…ž±ßt˝ł˙xZéV(”–rƦ®ŻÁ:HX÷¤ŮĎČú=5í7Sôţ©-'( /-|oz˛Ě»–bŚ2Á[őMě ľTŚJÉŚŮcđ0üH›śŢ`j0B#UGÂâuëW×n2ÔŘjཇźŢŕ’ś™pż “0ů2üP"ąÚ«ŕ}ľwôÂŰ(Ŕ{"ÂnDá’3üh ”ŐUIĂĆfÝŹ,⪺Z ”RŇXe[GŞ9ÍĐ?¤›Ëú+–˛‚[‡ę3ŮĆS6Ntč,Úý~ý1¸]|xýQÝ HÝř⣟/,ű`j ;»‰ ÂߨÓg¶=}hÝś(㩲Vď€T»`ÜĐp,ú)}«1TsV†ţxsńÚxQÁÇ_őę_ŰÄîTî5ď24Yšë’şíň–5p55}ÎŞąłÇ´ŐŽÍVY=§`řá¤Ô§N´xÓ Ç˝Í˛h켌(Ýň„n«€/”wS=ż·Ęrż.͢yďˇH/ľćgŐ(ďu@_­Yb©€ż…ůŚlÇťdnŽ…ś}Ž¬Žăńg3óGţÖLÎŤëÉ˝(ČífĘmr(‡ŁňCŘHůÁ'đýc›Ď·9vÂ0n‹Á8…âťd*âĹvÁ/cyÔŕhpá›ŘNţ€(±Hµo”,śçĂ’cÚ#–l‚MşôOvý‘° ‡Źë…/Ď’r<ż¤Q#&Čß@ÄŃ‚!*Šm2®WÖ ziÁOµRk÷;6%$Ëľ{ŞwČ^ÂŻqż_\ÚÁnă‡mĺ;8ż*nĄÚA'ôĹÜiO‹;ínŮ‚îߎÄíH슺c ŃŰ$IF|©¸»¬§nÍHso™ŕ˛"ş$ľwA73âćd}!öeѨIčşşńľ’ż`Ą’Jź[©ŢôTo®˛>‰ŻN·>…Ţ?Z(ŔĎ‚úE"á“Gż‡ěńfÎĹ áŚ(&‰Ę'¨;}˛Ď3Ä“ň=Nabz'ŮA»Î”ÂË™Ě6hfŃxoĽr*âjŔWHí‚…YžS‘2|-Ân ‰ý$CţÄ˙i˝[Žężś´zEMą‚ˇ#[”5©5Ą°´V"˝ăxúËPß>–ŁGsŃ6§ŘR.­ŞV)őe6XkCŞŤ:óᵏTYdg×TWn(MŐtZXđ—ĆŰoIÉĐ0ü’·Đ\ÔDâ2ŁTK©uéŞ=Ě<óa'µ˝şuĺ=—‘ßs±X0ev K–ß|ţ)˛F«Ă—Şš©ˇw„ĂöpZ R@<®öobÇd›@Ň’m˛H”Fľ®˘t•~“©Ú78´ůnMĐ„”ětĄĂM(–@žě#ćf=%ćőŕôˇ÷ťě>}¬ű üšBCyň?Źçs ůśĘ´µ9‘lk˝xÁpSKÄßM{ZńµëÓ•ă}lÚôlYőĆŞ˛ęĄ%ů*5g€Ş2UaĐ÷Řj8·°ťdŇ«”+Í•·łDË…;ד˝ň Šk­ TSŞ@-ľ3%Ý.áż7A*âK„u!e{3`ű†M…žč«˛ę…Ÿţ)Ľăýhň#a}XXš‡—Ö Koť4Wö{W˙lţ}¶XS_«ŃůOżĘ@~Ą$ÝüĂ—ř‘hčŻĹkńA* …ŁJŹÖÇţůÂ$‚č~Ä'°sĘ˝čwaŠj k=´Y™8˘Sż>B]oĐB ”Ç aýß_ęćB^yz?Ś'^V4FXKŐµ‘wÎ~°wsęrÇ x˘áłŃźřţ×Ő~eXŽS­ďÍ€ëyP‚ř¬áaüendstream endobj 99 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 615 >> stream xś5}HSQĆĎń.Ď™SÇĹ(¸+Š@ĐÂB‚ŠÔ"KT–:­$WM éÓšA¸-bÇLŻhj¬X(áW‚Q – +?®»4Íč®$úř#ĺÜqvGôţ÷ŔËóüřA ‹B˝yŻŮśš’’ «K­•Ż ±‰Ő‰ębâTÂ+ĂP<:}ć|ىŠJrA0= d€µ€@AXGŕ·(nćěqËQ:7¸I|‰É ™–ČIĆš¬ĆóáBdôË´:z¬eIyÓ}|ŤŰA»%S"žş»Ä§/+,F0. Ą•'KqÜ2ü=\Żé/ěňÓ>™ŁŐĘł„+; LŹ`+©IhŤ¦†¶™‘ęp+˘ú4j`k¶–ŢÝH‰ç†?•é[wÚ6®ß^<Ľ*hÝÍÖĂv8+q4™†ů/™áB‰AdćÁř§nŹč­÷üe“mÖ ‡"4ógkŚ.ŤÂ'“Ôęçfé"ßŢÔÚÜŢÔíéěëŘg©qׇiˬbŕŕ`Îű—ă·{Mĺ}„ČܱŻ ŠŘ]LJ]G«®Ýp\'Nbo¨®łcZËRůl”ź{ŃRVtď©psHľÓ×ĐŮĐUßIđ?ł.ýîŁ^;ěőS·ĆĚBĺ<“µ§Đ[@0ÓçłŐ›ÖŤ0#5 ?ŘŰo*’C6ĦÂm "iÄž Śžł84őNmF%Y§liVż\«ů?§">>+‰ÓJş”d|Póůpž¤ć!ă|:uň[ý Ůě0 qŤŕŹMŇfâ„®eW¬€żb >endstream endobj 100 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8792 >> stream xś˝zxUUľď 1ëlGĘáČ aöV¤ČXAE&„*˝i§÷Ţ×é˝×4BIčEQ”v˘¨€:ťQg®ŽŁło;wîÚ'ˇĽąóŢ˝ď˝ď{ě|ůÂw˛×^ë_~ĺżSĆş««¬¬ěî…Ó.?qüxć?C´äFŮŤ9đžrxĎ]ľˇ˙} J @úťčĎbţMˇ~JCă´¦ůÓ3„3EâY’uŇősd6nÚ<żfÁ–ę­ km[Ľ}IÝč1«ĆŽ{dĽâ7ŹŞS?ţÄSĂ&>ýëg†?;éą‘Ł^Áb c˝Ěz5źµ€5śUÍzµ5‚µ5’µ5Šµ„µ”5šµŚ5…ő k*k,k9këEÖtÖ ÖoX3YŹ˛^b=ĆšĹzś5›őkëIÖ\ÖS¬y¬{Xżd=Çş—ŐŹŐź5€µ’5Ĺa­f b­aqY÷±x¬rÖV«‚5”Xżb‘,Šu7«/ë¬gY3p XlÖ…2Mź~}6•Ź*·ßőD¨§Á5v;1ůnŢÝoö}±ďá_¨îyú—“~ů齯ô{¤_®˙´ţű<1ŕÂŔ+śÔ eÜaÜÝ÷-Ělć­©RY7„WĹ©rU}8tĘPÍĐ˝żü+ůk2@=Cýî~ëýWh|ŕ Ű>ěÇm^ýőÁáĂzđ!ßC±}Ä™‘ăGţcÔşôąç*ëŢŇwG÷*1zĽP.ţvnáç9GĐÔnîŢo"Î t?đŚ5BĂ+…rµâHĄQU–äńůŢŞOGęőÚ}UŮx$Cq¤±Éd‡&f­{–ŕ1˘ŃşŇ—=cÉlç€,ĆĺÂęjú׋éáóéaVM©…D۵r¨ ęZěIňzĎŇŢŞt"’É(B" ˝€ăŇŔÇhm'*« ËŮ>šWŃ{†:QđHÇ\ĚąTĹ!\‡ şˇ‹HkBňI ’kE¤>MËé P­’Š#Ú =ň‰P6©ŚJ©•Ŕw&\ńŘ×<˙«ý]»Űš»’{!‘k¶¬“ĹV)%˘ď3msn’ÁJ-485*TbaʢУ żµŽ+ä9CÍčaž»ŮŰ[ N×QŃŮqËÖIד·öÜX@Ë ‹ł.ŻŔŰţÍ,ć>ół¨b+hRjÄâ6Oˇ¸¸ö üžÜ|~fŕ\+´~5ľµá­Ya…[ĺ e€ŻR‹…IC†Jý,âvˇĆ 4pľď޵nÉŇ-ë×J(¶Éމąh/w'ZVîśk»O*ç>;aĂlŞg?–ę.”}uĺ/—ŁËĹŮ\zzÝŇ\büéGĐÝd A‘ź€č>âZő5ş/ů=˝k|váCbRíĄłWß»ţ‡Â±…ó,v+´ô®J7V‹Q}ť?Ăägů•ÁśH]$ąvZfR#TÜJŤ]mUŮÔ+éNža­qŤq­qĎ®r5$6T[Ťő„Ť •!uĚJŕxs„>żÝ_•M†rgWR•+Ŕn´¦}ËĹAX‰x¨ B~?˙:]ľfµ˘©†BŤôX®ń©™ŁÇ@b˙ěë”3ëÍş2Î#î ăÚ|#sn˙©Ş ťó™ˇĹn¦nfŞ(*”7_)GĎő¦¨e:(ĄÇ‰_ЬŃ*ôü·5Kߡh5ŕ+ŐbQJ—Ćm˝” '哢¨±Ŕ´ůap:Aß3ŤžFßOţs ßĂ:RtŚk\iXeXi\Ďłëj\i«L`ŻĄ,lA‹5F˘qLřpď%łľfĘĹćI©ĂbrY©„ťń«E3ĎáÁ-ŕ&še>é&g=ßLnďZ“X륒îKßK÷ÎXÔçŤéŽĂÔn´ŽkŢb«•Ô6,_şľ/ląpćÚ—×®ťŰY˝Ä ­vë­Xŕťî-|ŹžUpHrÚŃÜŢlÜd’¦™*ââk,mn´wxšx΀+DNä—5%iXc×:¤ XÉi7›Ö*ZS·Ú bÔŔn°ęˇžhĘ㝎–V7»V‘WÄuf™ĚJZĹô@°˝RôŔ,15@n0aÚě„­i<ĺâÇ+mqMHá ~.śfŁŢa¨(UŠÓ.Lč3äíŮLqr2h/ú×r…aČ)"’ľ{Z1Gý¶„ăPĄÁ8¸Vfp0ăń:Ă+3»níęŰ°°±€îşß‹hao|W‰J-Ćô&€\<śIj˘"j1Ř6V ű€]o5ŕńÓ¦DOČ<;B{ŕ˘UčVlrlZIú>bü»ć[1űâ3pÎ ·bvQ×çČ›P1 MEISF˙nÔđÁ¬Â`Î.4j'wWĂaĂ!ř|Ă{¸˝3×v‚čqúđ4ř9q pÄ›OXkI›ź2ĄÚ= ć±g>§z+ʨśäÄTPk0i·Dę|› 1î_?|ę'ÂsZꤾĹňŽŢµˇrŢéâ5ŻN«IÎö]Fs¨ľj´I,RőDžÝ`3@!Ťj“éh*áíÝ­®€Ć^@űşí’źaś˝Věż›+ŚëŇ™¨·ÝMbŚvíá(¬tCŻÝĹä'á ÄaśČ‰ý"˝Á ä ›äAe–: Ôs=: Ź Đ/Πň×Đ?ľMĄBą@ľłŐîU„™ Mv4ŤiS˛ËŢšq“Y„›ŃᆞJÎG)YH)T7Éu$çZľv[zUŐt8gŐşe3źŮr?|yȇâm;oE˝U@ý$ehs±×&0 ¬B!]Ĺł©­j»šĐ˛§˝ľöĘĺŹ~!^§úĽÄ'ét¸ă•¶ÔŻ…DmStOÜťpE©,ú•;ďÍ;ó•čYĚyÚ’*\Dô“Ŕ“uĺ\Y‡ßŔmš{ĺŤ&UŁ™Ô/µ)*%¬ś2%QMöN$ŘÇ0S§]hjoťn"™7@#V 9’Ó…!ĐW…ĘAs$šN+Ă|ÜĐD•8jĐĎVÎ6̲R5Ł„:ąß)pfLé*NWŔďđW}’_KFđťFŠŇť —bĐoO©˘BüŚRŻŃ}0 jĢ¤6ëó3°[K/« 7†đţ{7ôĆű=,&ĘĐ8&ŘBłĐ"Óž…ol„M„žrAy€űÂ{Ň.EX“„¸z^HĽ2©@>/ó‹©uL×ăë(jíľ ÁHrH |YD•¦Ž\´«TJ—ńĚ5¶-Űšj4›!aŇŤÎŻë+ęĘ;0ľŕîČK˝bňi –é%®ěŮi#W)ú'ŠĎáÝŇŹĐç—ˇó@&Ob*=”sÂ˱j M8'ę,•qčXéF&Ä'†'x·9ĹÇŕ>ÎEňh<ęćy|Đ„D+Č&yfuŹW1íĆŞqÄ´"Q\wł t ++`ô,NÂ`ŐŘÔ6M5ýgžnAÝŇ ů^Q„p°}~wbł¶Y–âo—đëž»ÚřŢ{tśď$ĂWŢť{Ýŕ9#®°#Bt‚ćx0—RGpe.+ĺ莺K‹§‡{¶qńˇáSΉđ)bŞˇÚˇÁŞOšŇÇý-űSd¸%ÜlőD}QGŚp¨µkˇÖŃŕŞw7¸ęxž­Qc‡ţý­_4ÜţqËG΀—?‘1W âvVîkÄrťç-K˝FÓ‡á!ËAÓÁJk ěŘ„O(ŃjëUŰy:‘N¨•ĄUaG‡yç@&ΦTaEÁŠ@+Çu©ŰEćF÷Îľ0đňeäe(‹VŔÍŔ´'‰#gĺ‹)+[µ*R¦éi‘Ň#‰o¸tđh ±‡ôşü^.Ś¤4fN›rv|Ďt„¶˛˛€„4%T8”î’žMäŃpž3ęŠŔ(üpĘŃĄC•X:Ęň<Ĺů¨)+ĎďH¶´’čz W_ăzEĐ°mkµ~=$¶­H8ńaîxęňďsc%|Ű2ű”*/vs˙Śó4a‚F‡ VŠJt±VÓ0üče|Ö=é´ż%# ‰ŚŚ= Ś@őYCDŢ&o•·)Zx6—ŐcwĂČgWöözÝŢ$Ŕv&9oĹńdäaÜą\†L1 •Z‘8®MS~0aü’Ż+b ‹U|É(ŕtI1\‹ÚśĎË´µ ^ßńâMń¦DSXÂsZ]h±L«ŮV3ó)$ ó§C ±ČÔ€O ‰©óř%üú ¤“Á\NÜVËç ¨ËÂĺX2Ȣ´+­ĘÉ?ŻâŮÍv34‚¬9ŢáÍćťdŹ %ţ… óőóîb´sĹu!…‹ ä"3ź2łĺuŠDďŃo˙/Ekć ¬X!ńź%+V5‡™®DŻôâň+@¤QĘ$8-T±ë•’qŰ ííî|¨ŔsJŔß,óK·Y% iSb-®´Ęx6ŁŐbŔĆ-cµ8lUôVŔpĂy$ťU…=ńÂ%»Ň+gŸŠĄYű =Śë—3@ŮŇę¨5Ňşúu â1·'J]nŰe÷;§Đ]§QţŢňĎtFŁhÁüänoąäÔ€ă1™Ć*‘\#„á G¶ú—´UĽRuu5ÚPŃZ˘á,S'%ĐË”@Źf…Đ\/‹¨ÓT`1ŚĂś‚v‘K.59>9>Ťç4¸uX6YŘ6łŐl3«y˘Ő[^‡Řěńş°‹tŢᏺËţŠÍŃ·Ś9â*č>÷Cš‡ď¤Á·/~÷î»­ou’Ţ€—AąŚŘ'Ż5nדbßȇČ—_żôáÉÂéŞ-Ňćî€DÄPŹSŚ»/×–inywĽ{©FŰČNÜ ĚüÓ$eÝWŤ//2Z°‰_׾1ľVŇÁčô qçơ>G§Ű÷P=ĄçE´ÎÄ ŚCĘKýLLđuĄ¸„×Ă,DZbbKőQĂ“ťNrőŁëGŹáëm:›ž!¤ţ¦Óđ4ńĺ•ďŻď;QżŘf·AŰmm½€î)”}yĺphž@Ő\trtu~şĺ:Í+YŤ_ĐCčňkϢ˛îKůSű(_І"#÷‹,2…šÔmPbµ7cƱϨčnţLá̸زjŽ—.;hŁîđůh–B& ýŚ GĚč0B‚ŹaGP&m:˛±H&­ ń©Qŕ8:Áá 沬2ȧh¸3°9Š<݉FFŚgr­'gşćÍ®_˛ŤT4Z6[ę ˝Ńf$ǡ7MT“żSő ČČw‘_˛ł˙ł˘8Âä8ŕ/)źľ 9Îd”!!ŐÜ1GĚK!6Ďéł0Ë"@ߢ»ţzŠbA;µ=¶Í±;´€łË„á´J¬Pb4= H3ä9ÚČ݇ŚWÁŃß›žü¢éĆ›'ą€ž>űz-ş0ű˝¨ě2ZxĄáÜ`ÎOu”»\˛z\‚e©oúUăđî?D}?UĐ÷Ć!7 fOŤ“0‰>žHřžŐ®lŃíĆ}˙oúăgßeMluSŢD ítŠRšÖń|ćŕĆČö­[uň:ĘbłX,°ťËč׹ÎOrźĚ#sZ0zô3#¤.‰_F9-®H™MV‹Jd0ÜéQúĄ*Đ×0‹f5ĽWŔEľÍ»tc‰‡í?uv×1H\Gľ˛Î±2ĄGqţ¶ g˙ĺE çmŢ”?ţö›oźŮßٰ⦗ľ[ŚŠ°Pvő#túŁrTĐsý5É­ÁŻ4`‰áfń”+2†­JŰ®i×ď8źÎ~9ŐŠ*r¨ź±‰oĄé_ŕ^|>cÝüTÝLÝóę©ęéÚéöi°Ń±5!ܱéŚý($| łŽ,$ŢĽĘ5gµYcÖµ%¤ĄŘ*6xô.ĺúE~!!Ëű>ř$q5ţ >úę|&ăË9łŚÖ8ţšnĆsňÉęÉ”îeŐoÖ4·Jý­‚sąüV‰ý˙\Ý[őh‰ â0^Ć‹É*¦ ©\Ä8 Xë°8ĘÜj‘EbÔĹŘŘč/—_@ čç/?ĚŮ÷OńĚ|ÄGý'wŔXÚK`×)s5ňők‡lHÎçı×OşÉ6ąO"ŐZ¶H‹RĎÇ2†sTg‹(›łîŹíwî'ĽlŘĄlojÁťn=ńîĹ!_?{r$‰‰ŠŃ&â„6ë/=v?˝‘ËâSŕŔ—¦§ćĽ´rˇ‰RŮÔP‰;ŕ~ň}Éčžúa0çGôz/îĐ\Ф҉”8—JtÔÄřXž`Ź2ˇ7ŽÇPłŘ!ÍbŹŚ¤1ž(4bY+I4 ŮąMV‰ČÖDX1 ›Ű›síNf(đ§QKî­6»µŞg+ú kÄĹŽčŔ÷‘ú}F/Ţ·›{¬~Żö5+‘Äň·«ýĹÂăSÔüČČ ĽDĽóŃ«çNľÚ0ËKJŘuŘnwÚ›Ón2ń3čĂPeJ• t|©\׶9ľ #čŠç1ť<ŠŞk¨ňx=¬#¦Mť?}ń„ř%Ň͆>§ú‰©OşŐ.[Hů6ťE5•)É\¤9uÓqÓ’îbţVŕţ˝¸8pv5c´3xÚ5řŇÎăigŐ?ů$ęFëRQ¶5-‰J Šd>ˇaOżnßMşŔuřńŰ;®»cNŚť…bĎĆZ6L´ ] ’~HÄŘT…±©B/˙ź„ÔQ(r™1KIÄâĘDSśsKF·gú:d"ŃTBP‹Kş˙ŽIln‚R‚s‚ź1'Ú=©¬› ľí şÂĚě$Ą břy8¨f©UŞ™ÂłmŃ aÚȇC;\Xš¸’ž”#IܡÔús›8Ě$vEo—ĽÜÓëĚě =YrDx#Bj)^ţęŇWôŢąĽ@Ą7eÍIę{Ŕ‘–˘-±H–˛F+8Gâ…CQeĚĎP×®‹5n:ŇxČć˛x ű2§7 ůs©|*—JÇy^Ż×5w'3`Ęć%>)E?„Řý”Ňa§§Đ÷‡ŻĆ?Ź~^ľ„O§Nk#MŘśĘZ‘<¤ĚÝr†E-C’?”FňO1 YaĂ×:Áł-($ lďÄOţ˙Ż~şă+_Îťwç_EűyŽ »gĽ‰|’1í]ieD@r.J¦˝o —“ôd ZëD1][ď’qń &čĹO_éfň ^nô­wm 8gô€0Ý?Hp6Y¶€D tÂh<Ľ3š÷ę˙:€ż›co$!‘ GOíhtb@a6ä’0(1`ŇZ4fMăKĽu#ÖŽŘ<\/Ňâ8Űżçm/˛˝%%XŮĹÂHćSNWIQăbSś‹’¨6÷Ż&˘ÓŠ#ą¶śÔ-Äffü ”DÔy*Zš… Ů=†qě(>ď1ŢŞL‚y”ÉĘbRÜ gŇ•Ë ^č¸vłťKˇ˘Ll(·âk˝€gÇÓ®#”™{Mţ7 ‡[.­ (ĺ˙óýž´3ăN§ŕy:ü»ŕN‚ăyMrüĺu„ŤŤ¤¦ł.şn†Byť˛·ŁEXDa}ą}ĂĄ2ľµ^VĆqަŐúŐĆŐ6ť™2ŞŇ\ł+“÷‘Ţ}ŢN_§§łŤ‰W{\S8)úQŕ;ę?â?ęđ•fr}F ŇčUf҆×f4mä™jŚ5ćâ¶nIăoDĂËQ»«Üşµ~«Ne–™ˇ*Š¸•pLcľ·;ŽŕExPعʇĺů¦mŰ6Ő´öVÚDśľ«zÍůnôĺŢ˙÷Ş ú °ęPApÖňł¦ăkýŚ:Á$Ž™Ô·@żĎ߉Ŕ \ÉĄ)˘ľEăÄfŤ~‚ń^\)‘±§–!ŻŢJAsJŹŃ˘‘ČÁUXőJ¨$dau†D»KYécr‰ŕŞÝX­Y›,MBz(O3c˛®Rm»"¨LŘ©$Řc»bëˇÚ$¤‡ń¬ › §ed2Ţö¤2,#µ`Ý4\˛Ś¤šŃCÎCW%ĚÓŠ¤Ůkt›˝w°ÓŤňR)˝_¬ăÎüytĹ(ШUIŘjŮ)ĆĺăńŘ=U™h<…‹#©Ć¸úhŹM\*ÎĹTŤĺFŘžĐD¤Xířy㦠5«Ěr+ßk 6Ş{wÇ3·°gŞ(Î/ ,nż4Ó…ćwscáD8ڕߙߕű·÷Ń]W™÷Ź!¶ů»ŃoŽ…ĂKÚKóv— ­ÄqnOç›)Űî53mçb:N¶·ú".ćŚÄŰďÖNŁ š|rć já†Ekn”«št°‰hČZ’$úĆ]ŘâĘ`‘a†•Ťq}ĽqY~9l 9]ć5ŐÍĚݨę.CWŃy®Ť]Żĺ7j·Ĺ6ˇEd®7×[ęM[yĘY“-‹™™’HŁK#ę,ĺďĂëá=ç#Ě´3źECq†/_w1iuîÜE&ď ćĹ–z[µŢ†ýT&¶4®M0ŮvzŇî¤'Ď âËżGƉ‰ ÷q^–ôěű6ZLŰ­›Lóy–u¦őÖuDcT—Ć!çtĄ=ĚťÁý}˙tçí×ă.P;VŰw_FŮ+9Żç˘4wű¨I4 ď‚9Ürż/äa GŮ*ŠŠkeŤu“/‰»É@5‰ß##DďÖ »č4—ľç!şjćţŮçÉŚ!kÍÚ‰8ßJîÝI$ŃÓ\«Â©°(Ĺ/MÝ4 K—ěëľţ»wa×ÜEVh»őN=+.NÁĘ3á$4h0.Ű˙Š_Gor9·šęk†livô|Ü;‰=Ťąm·Ů˛/1đę‡ ‘äÝÁśk¨än˘Ĺ[Ý«˛đ@%ŚĄ‚8™Ye¶aťnă¶GO®ţZNZf ˛„&ž÷&°aÄřsFŻ{~ú ţ~°đýÇ»Ńj^‡í°Üł™ůc ­TŤąV·N€ăŢţÇş¦(WÜ“‚ [LR:«aŰl‰ĘdŞ·ËM磅/.0OĆćNü`Ńe=ŃF ą{Đ潺ׄpq%śňLÍ:ˇ@Çą›"Ë"đ xúcŻşcx·dR±»¬ác{‚ő§•Ž§ü·BXh šE3s>*:±đ[ R˝b]ÎNĎř5=s$=Ó P)°)”Äĺi‡ś# &ÎŁrŢĐc_ˇÇľFŹí»ČóEĂ1¬ŰÓŠ„äˇ÷9¸łt[ź€ł‰çÉB`Ď—°›xU~z6‰–üěçÎŐo~ Îěůđ| ësx±çCzJń®­A·‘/·Ů™Y,a:§%ŁÖťíÁŽlÖĺtąÜp€ G µ`Ĺaˇđ’^®­V×Čç÷ŢĄ¶6G)?Űą+ŇšĎ;Nč€DČ#Tßůן‹F Í«Đ)n,”ôÇÝ]…®î®‹űx‰@6łDB•)•ŁšśS3nÉĄc—TŞ0ť@Ě'a}Äđj-ď·‹?ZřŰ%AcŔ¶Ä«­ş­!E-Ý»dĎ’.µ_Růn˘Äň—=ď3ŃŕâŁ\ąM­ĆĽ$‹*łŻzHôď Ť&ÓĘ ËĘ/0é´]•í;±ťE¨A U„0ˇm!‹,Éň1#B®dL0>ZďŁ~[:YqfpąF˘—éF/ć-®[\»¨^®é±7•GäÉh,ä ‘¨ď9.˘» Q$“0®jü+vń&ť|îôłŻë|ş€ĆILĄK’†Žzĺ»Kß_ŃEuQCďăćŠo¤p ë.•ݸ‚jÍs–lŮ2zĚz¤‡BúŢăĂţ4)h 1$#ńxJШ©gj®ĂkXeţŤAĽĎ#ľ ×O\•Z­Đnýç"ýŞd´ůxyĄUĎL±ä1}X˙áÜÝăŕH?:š~ść=«2*ő¸a1U jĆBŃyíG4 ˘éĺ¨ß¨n‚Óĺ×i˝š*ÎEŰíy Ş`pŞ B˙ŕňc‚$?®ó©Cj'aB‰L(ĘzęHcĐ0†,•6¶Áj°,ŹŻĺÉt*=aǤL·˝s4w´k­:›VóϦ·h Žá3íuwíp“îĎwGł2/kVŤmÄF`hO'sY±_ V·ęĽzźÖ]édű]~·ßýĺ!^2e*1ŞŹIf®®%!WĐ wóś¬=DRVm˛l®ł–íć:Ëvâ_ř¤r.bݨŞ@O–ČźâxšĹ~IĎëFc= ĘlŮBł˙>Ť™čˇ1жaµ‰ž` ”¨TžyMYúŁň^˛oyhň=włX˙ÍXąendstream endobj 101 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2026 >> stream xśM•{TWÇ'„dFEâ,ŕcrşşUńQ‘ZEĄv}»oĹ€ x@@áž&ů‘( ĽB$(4 JAŠ/ě*[µ¶ę˘Řu+´ľu©żŕĺôě€öśÎýgćśů˝ľß{?W@Y[Q@ĽdÍ:×ŮCoăčv ¤‰ŔF6Öą\Ř߲kC =’Čř]Óeł]ç¸}>÷‹ůîţS§ůQ”/µ•ZJŮP_Rö”%ˇĆR,őĘ‘r¦ĆQÉGŤ FR‹¨±|-Ęš*l\´m5Ýę¤Ő[a5c˝S$UgŠ/Š¦?ĄSénzŔ˘˛µ´“M&śa°87í7:üv‹{%ĎŃÓbĂvŃd˛RNßÎÍ J †ŇţJXÎ…Ó§˛Űµ•p.¨ë4m6“Lôr%ś“â"ú}XŃ´ń.08ę/E‰ËKb-•<÷€Ŕ€¸XFGŠXŚ¦«.´V]ćÎ57""Ł˙>Ď+h—ľ1RšTŮ gl-`˛L‚Ł–l!š1…­>}şµ˘ŇTßXÔ’Íč(u„& "`“69›ŻN—«ó’AŠÔä¬Ě5NŻÓňA 9ÎPTtD?ˇYˇVŔŘž©Ž¸Ůšź—„ušIFůů®UçpşRkĘ®„*hRW|+V—QE`¨Ş˝öýÝ)NyĘBdBZZb¤† §«ł/i Ľ g4Őęáß7‚\SĹ°ViÄrô68śěÁ´®ýFG‰­ń0›ÓOó6źŚ–’´,Ö :(ąń9±'Ěg“‰˝TŇOĆő» Ť¶çPX–ź®ÍJSg¦«ąĐÉ® [!¨:¦!âkč‚zĆv t~9ž3ăy˝Ŕ"2 -31a(ĺ±2Đëă!IJj°V| Ęââ >‰#µ¤–NŠ‡¸¸28&EţKśńz=”ăl±ščĚďg8Ę,D·4–L zţű — ś(¶µ¨b NÁ™ĚëZvŕşłşC=s/đŽÚ9+li–,ĎC®Ť‹Ď.¸× p·ĽůiÍÍĂ÷áß !wŘ`Xk”?SvB\…ëĐ•×Q†Ł~G‘¦‚”tŽtîáiFKTbTYF†GG«¸Ú€Ž=m/ýL˙łŁäťe#ĘXĺţŠP~;ˇ!n¦ő™µ5<:ěnőć¨ghÔ Ę’ĆĄm‹[A ËÝ^ž®SóJ3©®’VZéÇrµşśC\AqCÇhŁ,O^Ľ[ [É{źčŔčŕÝQ2đ†uß$\Őitš`jKŚ Ć˝Iˇ˛ą7]'Ô;dŢN2çr’Áe°{KśFň#»":3‹ä-Đ ĄĚýšWOŠĎĂWş¶Ŕ6đ­ !>˛¬Ź{˙uKřvÚbš±˛9¦mĎó,2VV}đ”0×n4Ýľs}ó’uÁ~>ˇś!‘ýľˇµşľ9—gOYŕ5K®őoÚΤ4ě7&0’·ľű殟:î“7ËűQô´ç]˝ňÜ®&.ľ\‘żĘĚL dŃÎăd|KüĂŮËsłűÜ%ßö\©ąţS 7ÜI}ߣă–ÉCʬěĂŕ'CF ń6F“äI2ß„ŤÚS‘\s^U‰)ş(V‘ĽĽcçOü5`‹0Ś „ţnΆmr˙ÜN˙@đdý§ˇ5'yw ›Ž_aČ/YČ üźňh!‚´”7śh;]XçˇvO‰˙Ń°C«AĆĚßăâ6Ô”ĄˇüA»€?]z!ęV˛d™P*çíDúoĄĄ"žčlĆYfÁĄ™Â%ŘÍýÇÁgâŹ0,’Zž’MěGl&J'ţI[‹Ń•ż_ŻĽĽ"ÄG$hJ=:„ˇ/ŕL@ďÓčŤvh_x”żxtLîA]fŞë2"YËm!V)DóŔŁ€ŚľHDťÄî?+óÉ9¤ËýSjTđą›PÇÂ}%ŽŢ€"´›{#Ě3U .“K_L˝LÜ€ě˛x7ůŠŚ!É)üiP1™‡ćä?ů%Wą hu…đůÍGň4Ď#:Öěň~Ćs3™ř{"mËŤ´ž§·AQ˙‹9Ďendstream endobj 102 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2262 >> stream xśŤ–{pSUÇoš6\ŘRŔ1Úŕš;ě.« 2 :‚+®,˛Ę›ŇÚgRh›6¤Iźy4íM~7·y?Ú&iúLJ›¶v€"(uKyŐ*RDFF«ŕîęě:xn=({JŮÝŮŮqfgîť9śó;ßűű}~ßßQ‰ ”H$šµ6-măň'§—bţ‡¤)c$‹!9ŃůËŮż=°ŕëy̧’D˘$zÎĽű_ÍUg‘§DQ¦Č?”Ą. kŠ˘í)9üŇË[ĘŐ«~—Ľ@öĐ}µ™ZEĄS;©Ç¨'¨ĺÔKÔ&j.5Źš/j±"‹Č*ę>"€J¤N¸„ľ—&ţ6ńlŇö¤$KVKÔł6Ěú–®ˇ?™˝^`S„żę#²ýp®i\üůY)[eVC=­ ›|AWŘ)çlľ×‘?§:"Ž˝­±Ĺĺ›zFľüčawž2-ß_™ÉŐÖZĐÓűâŻß@Ź¸ŇŇď?6ú. Ö†jV^˝M»> hŤÁßń˝îŠ3Ýâ›<ŤM2{›gt°Ú]UŻ˛*Lrí đÚÚťÖ†ěŐ/˝Ë0<0Úýaç%Ćł DěYš‡g>ĹÖl—w|680´»ŮZX¦/2W1yK4iA/˝TúÖD˙p¤Ež"Ľy82Š„ŠŃ” …葉^›űO@7{!ä6ó&¦^fK >«xĺt¦Ťµ¤´.čló€Ąigť,TŮRg1áY·¤–=ş~ç.PÁNOĺiŢę$@ŃŻuöĹŽ”x*tµëÓFö}řŐwßt0)SÇgŔťb…«RĎP°ç:OŰ}\O Che•  ĚŢ˝Ô\{;sĆęŐŔa`-UV'ŢNOĹ*!d Z95ČđBIą‘ěsCČ~Ś ^x»Ď]Q¸Š•™őVmÝ46G Îh źíý6#§gŇm¦„ÁÉŮy/J:RÍ`±íö§©Î Ţâ/oŇ)S@ěD‰ň%7Äh]’˘ç$čWů%^Űř>~Á×$Zj­Âţ Őęcš-ôĐ`eŮÚiY©†‹éYâÓ»|Ŕw_桛i…•Ľ±´íôĎ´J^16;ç`ĐBaXęŽŰřc@˙EňńHÉ‹9ĺ+sň™=Żl6‘ÖŔ‹$)hĆÁĐ_®ź;FJ’†«›Ő%%Şm ˘˝-Ö“Żąť,őE &]®đżáY–ű_đtÝŠőíjBMť¦ÁŔTŻ`ş2Ó ŞQ‚†Ţ×Wp’XŰb÷¬M÷GĺË»ďY›#ĐvžtĂ8+âůLŕď Şů ] ‹˘PuK™úúPy ˛­««łKŽ÷˙ř´T»fďÖm`†*ĐącΦNÓÍúPIi‘&?{čđÉ÷nŚ|Ó!˙JH°‡!ĽěLV|Ďâ­÷D»9.ä’wś?qž 6dÍ4o Šá­čů["´1"F8éDék9ĘňŇâ’°Ş×çot{伍ă8 9ÎZýű‚ÍJ%Ł×…xáĹî˝~ Í–“(pKôé-1Ú>"Ť–µ••µ—EŁííQŇD,ć[ŘŤ Š…MSű¤«FŕhŻŃ­Ż«cͬűSZ} 4€U¦w˝~ŢŮâ /ŕť­he݉"ČÝI÷1uQ|'áą;qó«Ű/¬J/®TČ·goT»Żřq^޵Ánv lţ=M m>žw®ŔŐřđń“'ŽŚĂű0™w:żc¬÷̤ńĽJZSŻ·”‘6-·ě6OżĹ ­ŕ=ŤćŁt)¬Ë]»ë`‰§ÜvxŃ6NÉX‹OóA€&.ćĚ·äöŰŇËž/ÎÉٱ!+ĐkrÇ.{ ÉbĆ‘#ňé$Z’A6?¸™ÔĽl01î?Ś‹…*“ÚĽşč·łŹ>˙ě®]eňú3Y±Wţ˙ťpé¸rf Ë~v Ű®^ÎÁ»{Fűş"Í=!ŇÇĽŠüzв,ąťÉÖ’ŠZdUŢÚ–gÔË“ÔżŁoEwĆDč‹SbfKQ’D‰—3aáŻÄĄđđš›Č m †`3˘Ix› ˛ç[ŢÓ4’HüýĐ×®-?—†\8°Ż Gµźü-XÁčsŮ]ů©kcÄSč3’B> stream xśEĎIhqđ'•%ÄtćŕÁ‚÷ćĐŁPÔŞ`‹‡ÔFkDMI'mÚ”‰YjҤÉk§Ů'›ŤYf&ÖĆÔTö(´E‘ę‚â‚ŕÁăLM/ľÓwůř~ÇT‡0Çź7.ę:©SµĎušµ*&?>±sĽutóÖ9búî= Ć.aú&¦Â^ŕđ=yAÓÖ͉2%âŇ™w„Ü/őiŽćPxv|lČh^?Ü÷Ĺ·TĽÍBµFk×Î^WN;Ý`3‹‘K–?67€ňqď”Ý73g§†¬@#ë–ęTĂ÷^A­¶ö¤¨ß qPľ°˛Vld¶Ei,¸ÂAÚOzŚł7Ůü%>ŻÇx*&$źGŠĄ/'Ł•T"¨ŕäŰ~«ĹGjäŢ´¤ýŽKŞýŐ7„ôˇÝĄÍyŠ´ŐfeŇ3BUR1ýŽhî€dÜ0oýlJd6íî,Î{¤˝ôć-@Ž@şXŠ­$ŠTRH )>Q®[ćŘ$ËAmŽ=»Ú;˘śbţ˙ËjÖ×ĺ>Ú>Ň@iäqĹ$F?Ëľü÷„¬˙'Ę»ŃVz‚vrÓ˘P嫤rçOź–ľrÜŕYň.ó\Ľ YTžM;Ćm´ĹÜÜÝ•şë’f•ü*ýbSK Čöl ˇW(WGÁ-˛ŮYŮn˝ÜTI0oČPňJWPwcŘ_şa`endstream endobj 104 0 obj << /Filter /FlateDecode /Length 212 >> stream xś];nĂ0 @wťB7°Ĺ8vCK˛dhQ´˝€,Q†Č‚â ą}HŞ)ŠOŔIđÓϧsN›î>ęężpÓ1ĺPń¶Ţ«G˝ŕ%ee@‡ä·“×_]QÝńÍ•ďGAM ›ż»+vźů2­ČŻoĹy¬._PÍ}oç­Âţ…­`‰2VÍf°Ŕ8°î­@şg=X`çIa˛ v¤ăh…ľźVŠ0¤t˘&Skäd°×<#oűZNű{­79‰¬Ě›¦ŚżW+ká*M¨'jTiqendstream endobj 105 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 896 >> stream xśu’KlU†çÚyL „‡°…jo"(EAHv@›Bˇ¨ FięÔ¨Ćuc§Đ$ŤS§4Ź=ă̱Ǟńxj—Dv@… ŁX‰iQpú@µ°ŕ%!X€AĹ˝Î8;,»şçęťďÓ.˘šLB¨u×+=ѵY>·zŞkŐp3´›ˇ˝IYçîĂŢ‹[îţ÷Şˇ»Řöp—wŘăő {Žźpž‘‘z1ě:ęs»#ľ!_Ŕ5ĽuÔ_(Š˘Ľs˙Ű–NŠ:L˝N}€CÓHD@µTu=ŠöŁĎLť¦¸iŐÜKb$¦K2đ>ńĺÜ0ăŮ` |T<™™Ö8`;»úžmúx+żűÍÁcžé"/ DaJ†Śx]¨x5‡ÄÂ4xiÝŃ .đW<‹C×ŮE µ4hŁ1nß—tO_Ž©€ŤZa‰›ńÇ Ç2oĄ}Ż´_Đ[Jâ+4”zîă/ë(Ň@Ҭęß.˙·aCiŠĺŹçĎ/$ćâ e¨Ăö&űKěrLk° Ą Pě_p´'ă:Ě[·_–ýŮ>)Ü07”śéPŃ_;?ő!÷Ě¨× ŻŃŐY*Łß6W;q™™…|ţ$„ěµ…–ĐIgaĆn4éŰĘřń™Ď7ZźÂ?39YV@…Ś O(µ ÎZŢQDOrav2ÍkĽťĚéPËë ‹D­¬Ö¤(Y™×ť Ôś˛×J-§Ćn‹ÚIV-•NÁc]ę$¦[í’ž q±pVË‘\”\Ňł–l$’±UŐTAĄíµ<›‰\ ŢöĂ­žÂú<úľZ0ëĆ_Śľ›X#ďň«<°Üc»,§§ŚkŚćĄ¨"ĎäŇšMNťŐ´4>Të¶()#ł ÉJŽ8Öźµ(9HB‚Îp™I.ÂOp¶Í„­+¸c­Tw«řwf.šáx.2.Ú„í{{şaô_t\ě[:¸ôĐ:zU7uůłפĽdObÓŹź~ × rdůČeçç·@cô%6­nfU*ăçWţů4ŮÍĚEÔFŤŃOw~ öC˙üÁrď…ŢO^ú‘=OîĘŠŤÁ©›ż”>‡Ż 2xĹ}ŐuőŤ@ßüîŹ5űĆť:a&‚[‘µ–ztăĆ—č°ÝŃ´3ßŢFQ˙ đwendstream endobj 106 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 513 >> stream xśö ţCMR7‹wřĄů6‹ ‹ ’řÇľ¸1246Q˝ŁřřÍ‹Żř¤Ż·ź÷’Ü÷ăů¦‰ŚoKL0Šb‹gŁ‹Í‹Â§ü’j‹~'egťŚ÷Ž°‹Ş‹÷ˇŠ˝ #Że'‹¬řÍ‹ŕ÷ěőčŻĘő÷ěřŤ÷JiuP~…>‹}‹űLô讧ǺŐĆĐÉ‹ę÷ !Őűű74/X¶†•Ł¨śŻť„®WŞŇϡş‹ďż=:4MFkgű…ű‚‚‹‰‹oř0řÍ‹Ż÷ŻřZź÷čŮřĄ÷8ŻűřR ‹’u‡‹}űßü`g÷ş9i‹:pg˝ŤËŤŻ‹°‹Ë‰˝‰˝ #Żp:‹—­Ý=ř&üűśřÍw«ř§ŰꮨÁî÷ťë÷*÷Ű‹Ý’ձȭÁÁ°Ë‹©‹łźpr‰vz‹nrśu©©ťź¨Ĺaż(ű$ű'űűkű—÷=÷÷őč÷÷&éű ;_V^u÷űĎY‹d¨v·|©˝‹ÇěĹÖŰąŞyf¤ŁeŚa‹Q‹R‹apdshkxZ‹ 7ź ©Óëâendstream endobj 107 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1336 >> stream xś…TkPWÝ@Řl+ͲÚQ»;ťŠvD¬ŕŁęX ęŕ UÁÚVy(”(@xŇ_Jä‘še‹čŠ"‹Ú!h´ţŔiŁµ(Ĺ:¶wÇëŹ& V§ítgěÎśůÎ=ß9÷± !‰$kCĂĂ};?ßúkŁ ¸éÜEŕî îâň9äéÝé?xôL#śŹ{ŠbOş2fwl\|b2A„›‰bHÁÄ:b±‘ŘDĽáL‰<âśhĄč‹ÄĄÂeÔ5ĘőŚXď&qkLSđh祬(Ü:“ľV žL3TîfɬT'wFýý‡–†cĐŘ” Y\ &é3ă×Úľë5(ÂXś+™Ŕwâ|^ĆiɇŰ;VłôŤ ™ VSîBÝŕEç­¨Áę*Ä#9¦/ú ‹±xŃ»x:¦G"ä2zIY—1ˇ×ďÝ˝|ůĘŐK!‹…úpŽ8•Gďńh虄 #hŞb.ô÷^ĽÖ¸Ô;8$řŮí.Ď·Çtä7…DFŤ<üĆŢţ,R#Oŕč–bCÜ+‚źš˙K09yđ!ţQ­ůX‘źŐĄ $V• Pš„WÜ$kŔ” U»réäJ ’»Ť‹Hďˇx۵‘{5e‰%ŞL¶$tËľt Ö@O71<ÜéÉsGÔčI3ŁK2B5P6ňh45î…l.Ý$› +^µ)Áa†ďŞÜ¤ŐđM3‹ę$˙DčIokšŤĄŐíĐ^Ńj¦žúň㼴ĎmGˇR•ŕŇĚä]%m@™MĘTĐĆěűę@‡ä’+?áąŃ^lĚŞŻ4ë[u,|­ÓŐ–tG@ÔŹ=ň ŽîÄÁEŘăďYë.†üÎŇŞV,ďl˘ňĐ&ć} ¤*Vź @…îj9Ů}«y•q/Bał˘4»«đ91ć(ĚÚWś±ź-ĚQďjůÚá»]f$AłŤ'!źÓÉj˛ëŞ7VYlď@$öĂs–`÷_˝q-cU/v:Ä#7^zb2%Zôä,Ů߲//U8ř/Kő#énK⮣ѳ±Č{!¦ń´; ţŕhí98uÜlˇP’8H˛5rĹš °+öűĂ—‡/uo g'•Ě@žĽ¨ĎŠę _Ť¶2ĆhEäĆ1<OńžŹ=đÔ‡óŢěĽÓŕÔ©)(Rďç”Ű#ňŕţgłnQşĆ`»Đ7 =0Şźë4 kPŔůľ´s@jéW;sr˛óŐ™ôźy(11ť˝çOźîůţÔŽm[˘˘>ć|eĚâ¶ôn ~±]µ7ć[2Íśńp}ŮÝÁ=uű+€ŞŞ;l©S7Eä}Z’°“Ë:$«Ů ”O˙ňčŞÄJ5Gc"/+_™< d†T}n@$¬‡üąUsvűq6§<Ćä T0Y9PPŞ…BČ5äJjˇĘJ eš‚/2óý;NWë››ką†Łz°eGn°,Ę?zţÄ…VóB ?2.í˛Ł™ăëN=ÄÂ,f‡/®šńÔ‡„LŰ+Ű'w*rKµĄş¶rĘś^ĄJWf¦|8íČërżÄŇ÷„GbłŇ¤P(• …Ii6›LföĄ ě=‡¦8_g…/¦¸14@%‘Ú˝,7 JâUĎÚí6YéěÄsh˝„w¶×2CXś-Q?ŻŔ므ţň…¤é—Ľ+'VÁj[Ő‰@Ń#Iśť¦¤¦˛Ż‹5 ÷×â/Úß˙Şendstream endobj 108 0 obj << /Filter /FlateDecode /Length 2873 >> stream xśĹYIŹÇľóSçŔ›‹‰ŘîÚ«ä(€-Ž 9€ĺArrčá2ÓÉ“MŤůíů^-˝Ěôx<É!ŇaŞ›µĽő{ß«ţe^|^Ň˙ôwµź•ó«Ů/3ŢÎÓźŐ~ţőĹě‹×BÎ}áŤ0ó‹í,®ŕsď Á…ź[ˇŠRşůĹ~öOv±p˛(K'XuąŰ,–J˘äžńç‹ĄÁŘ;Ď^Wm}¸:ő?6Ű8öN˛ö:¬âxŕě˛nŰÍń°9ťň×M.KÉNÍ>źQv»XrěgĽg×u`·5–‹ĄĺŘŇöMŐVůdÍŞcF"ăaÝÜ´›uŢбí±Ů'aĽcŻËĺ%”[ŕ¤RYÉńPĄ[W»Ýâ_?Ěč(­ěüâŐŚ˝a:żY‹Ďgß^Ě~‚5•›_ťfÚĚoaöďf\)[(=·%Śçí|?SşÔ…äÝ›Ýěç§9G^hĽ‚1 'Á9ě‡óújł¸xĺ0pÁ%f˛Prph~óäCą. +ÄÜ8[8«îFÄfłX Ľ¸9V홌ĎEYÂ~ěesX„ß$gmµjń ‡ěđĺ×MŰîŇLĆű˘Ę~¨úˇî‡¦Ú~čúˇŽ †ÉŢ0N•…sCä7˙˝a¬†W˘]V͡¦KiIÉCłXÂg†” ±7ĐîQť§ßN/ă}„jNzńÇeI–GŹzôí´,"Čr_€Ź!ŚölÄ—řW”‚vľ+ źˇ3Ş"x? ç`ĄWiť 2)ëĐ#•K©-˘h–w˘ -KPˇUň% ‹ĺŔĂ‘˛;hěaQ:´ő˘PF ÷€qĹ]U"Ů€ [J°/CPd #tÜeśžĄ ‘˙ŠűŇ'dĚŞô! ďÓ©4í¶<€¦ĄDNBéˇq˛ÉĐlµŰďŬ =Ẹ؞+ŞĽI<1UçC „¬Zuô®/ÚWť$ĂŘsDŮTWä"@SŘq]ŞÝTí µUż¤ ĆMŕ©Ř_7!ÓTřzZŢ˝ÔěTĹ·Ąbď{~ž· ů‚ů%ĚO×ESö+~Ä~Ki©¸č;đxßu® ć$:Ŕ:ŠA` @”ĚčŔgßÖ¦$QC…éŞĺžOČĂ=8żç}:˘ĐŰ|hdâ[+Ť´rv\G#-D®ý¬F‹“†ŰU›ČŰ?´‹ń}(DB#t°Ň„`ŕwÖeňɦ4Ö!€{Ť¤,ń 1 Ťă=AěD–ňćXÚéÄđĘš€ÎY]b"–,[*UďçKÄxhQHĄŘ©ŢßěĎmŚP-iqéą0ě†z‰Čŕ¬"PĽVu*w!Ś  ą !*ÎƨKĄÍ­ëëż ´DlÖ(hđ€@CĘüyĆ1¶ßt˝Mřđýď<¬ ×~á Ęý‰†TÓŮŞ9Đ=ßłüOU˙E(vń5[Wmő‚®pášĐYĂB€ĺ‡Ä‹ ń‘B _ˇÎĹ/ĎűŘ*n˛„†˝ŞĂm®)=;Ľë7ü±ţ@—Ááőc’1?ncGm |ÄŐ¬fpyÜź˝ŞnvŐj“—jVÝ 'ý@gr ÖWďCĂ„§«fîÂĹńK4<ĎźG•»ŰŽdď]łŠ‹Â!$Ď‹Ţâ#g o˙gô› ö'é©‹ž"‹ńŕ­~÷ÁŠ{ G§h¶Ůn ŔBV ¦O1F5Ů8Äs2…óß«cŤ?·ëâ›ÍűţSłűËÎ〯th5µDş—•.Ĺ9—˝°¶ ·W#«“•VÍfŰ™b[Żę͡MBL9­ÉAöż ·@ýdůNăöcęĂĆnGÖ˝=]éh?4®R9…\v'eŰćŐô‘üóŞÚ ´_‘ŢNŔ âg©'ĽsŃ7q-éŰy;Vh,¤±c…ů'şD6@$T\ńIöň“ęÔ'ť°kj ¤Á[C×XĄňáć,SĘřF—LCĆ8˛9gmŮëd:ĄvÍŐrWżŰěęë¦Y?Ϭ٭ŤV|Âţ_}˙ňyŮÜZIéč\­“]ČüX}4xuĽ°Bx±3b@zâ%–Aś€é˛¤BąĐ:T9 oH÷Í©%Ě·†>¸%Übůx­«MŘYŹ›Cá.¶;q!€N†Ţ“_ué¤\ľtmÖi2Hĺůď«âÚÁA § ŁČ-˛†•Ş^ž&îK.ĄRA‰Đ/*îrVÍţćLßöâŹůFPEd͆ N†Ět!®¦/ŹÄYC.˝ˇĘĂŘ1wmBy@€ĺŹ}ô…‘hĄĄ ű*I·űćeóhTW«3Ŕ8˝ˇO”ťUŔ5ĺ« Ő&4 tžĂş°ĘÁIĂëŕ/C3k–¬ ľazV­«›|OjDěéĂwUĹľ«Î§Ór¬`Ëűđ5.Öě—áéçjť?áÉđąT´ ¦˝ÎDŠ®ÉZŠg.ůhjÖm€ś8ĺÓQĽ¤±ś8uѝҞ{u\đ^>J‡ž˛é!éCÇ‘•‚‰>żÇá-őÖ™ÖžÎű}uü8AöčúD¨®‰Ý'Í©Áá1Ö¤]y¬ër%ĄÝÇôŢ‚q®×5E@µëo-ęĂ–.čő$][jěb .‰·©DőĆ´Hü˙XŰłI„$Č@ł˝$šĚŁĚLtߥšýaolendstream endobj 109 0 obj << /Filter /FlateDecode /Length 3470 >> stream xśµZÝŹŰĆďóˇOú” Đ[V­Źć~ďşp€Ô5’NŰ8×…ť<‰wÇDĎeÇŃż˝3ł»äRGůś´Ĺ=śHîÎÎüć{ČW‹˛ŕ‹˙â˙Őö¬\\ź˝:ătw˙­¶‹?^ś=|.üÂ޵¸¸: ;ř‚›˛^.¬, çýâb{ö‚}Yď÷Ź/ž˙ýé幪đNłÝç_|łäEÉKnŮc^ľ\.ż»řóŮąáw%_śó˛đ¬ŔóĎpŁ.ĘR˛ýa»­ş·/ŮŐv K¬s†3·?|Î'\ąBIďĎÎ.~÷‚=9l›Şo^׉Ăž5ČEiJĎv?Ś§|ÝüXŻă%wěëv]oĆË«¦ďĂcYxĎŮ›¦ż‰$˝gýÍ@źUëę6;Ö~Qö{äÜsÎ%;˙˛î¶M_űIćŔî«CµîŞţĐeěV·»·]űcłqÚ]âŰqÂËô„µđ Y/ŮmŰěú=ń xáą!ĚŘ“jły´üôŻŐf»/٦] ‡+‚ĺqâSŕÍîz<ŕß㣾ŢŢŽ,ţ>˘čŘŞÝőŐŞ0BŐU»u»‰dôż?¬C§Ťqěş ‹­«ľ©g;Ţ4;XF(»Â %¦&†6:»/łŰ’›`·sëFč”.šđDÍę««zŐ“B”0l˙öj^XŔ~ÂŮ?Şn 7”‡}ěŰ~]üi´žúu8rn@t]Ź6Ë á¬U´Ws@ŠgĽ\*ëěhĎ<›hµ˛jë«Á®šUSéĚ°ďDŕăéľG3Í\…HÎcŮÓ®k»‘ĎźF¶^W›C&Áßş—ěłw?ŃŮÚö.>'=ZŮ›ŞÄEé=ě`˛( ÷Ą¶HŹ•… ŕąAŐ ¦ ®´­MäjVifŚ·őyigś4ZíŰzOJr¨$^8)Őä$.Äx’,´őv<©„cJ ‘jÉ™™ŃÁ_Ú,ü­ŞM=š#*#é€vâú‹›®Ţß´›!€á2r[ Ď®¦J›u‡˙ViSGČ)ów".¶Žťó© * eaB—”v. iőđâťÝ‚ÂM — HŻTj„^ş„ç )ůNŤDTJJD,ω¸Ň—ąĄˇĹČZz`J˝Ó#=S”n gDNĎ[´ÄDĎ-ó®â7íőů¦ůˇŢ47m»~”ŕ×ěÜÄR(3Ěç_=y”ĄkÁî•D~ŇîÖM–48۶Łq\Öݨžöj4< Mµ{4Z„° ĽŇÉy…\€ŘFĘĽ€`ąŔŚ¨(Ěs¶źÄㄱžUäcB8¶ˇ»ăJúV[¶Z ‡–.ŘMµ»F/SŃĐš]ZĄBĘMÜV]µ­{DE«Ł9ďÓ*¸7í$€Pů;¬,K ”Ş>^Ö"]ÍžU·›jU§'1ä_$9Hł‘ůRKĎ!–IYtČ|UđO Öš'dH {9ř%ĸ˘˘1ŢdL–U«Őˇ#Ź¤;·˝´kŽf)®VŐľgµ>Čô×Ë}Ý˝&f•0 ž¤%" ůD@¬NK°nŘ×}"l"ÄŻaí-‰µŻ3íK. c°&<έpćădS†rëśőh ţ ŐcÜ_$†XRp<—ęT‡…""ŞlXJ(pĘqlW×k¬ŇµcÍţt2‰ęŃĆQ ŽF賛Վ @)űHŔ9Ö·i­f‡}ť(K‚e®TAHeëňâűcaUYŘ$)-ĺ9š|),[Źgď›Ýj81ęXAĎ ®ŁĽŚś4“ů$z"ÎŞÝŢú!n«ÂE`ŃT‘ł}LŐÁv)l7¬Ć°ÇkIča°€´Gů€řŁŕD[”Č’TEXđ…űľT¬ţSŇ2.ë÷EpŚ0zEQĂ Ă6ý>‰yx™`ë+tŤpŚyA/ÚVŃUą‚Ňl—‰mąt_xÁ(öFţÁŃŁr8„‚bZ€•B°Ď˘RL»źKž» $:Ř·Ŕ¤)ť¦Ú‰ý+‹ĚÍR¦ßŔňŔq>ęç×(–sđ‘¸_áŇ‘?ę;»Ŕ˝^q31nŃŕ ÜÍ0d !-‡Ž.ßň‘p…OLaÂ×°Ú ŽűOpŕF\Ěś  j:(:Hif„Ą_|$x/=pmĺ¬_d¸üOÔÜ!(îEĐXqA~A+'Zđ gîE2ń ťź x’xUr]2oBˇ8+ćčB˛ÝP#¶CŤ|IR‰Í¶,°–vkř9W[ĄW4ĎŞ_Ď—Ĺ\ŹúŞí&çH SB© M–ëŹp°CYű…‡ĎµĘą(M­\äb×ö3˛žśŐÂt¦µpZKa|äŐĐ@Ý]Ť‘©®Ž8qÁ…jFâ~Ź×’zÇ×K­‘#ÍŞ*űUśaZZD+ŠĂ»â@Ć3ÎaSŞZöśZÍp¨çˇkčCÔ@/©¦ű°i!°Ş ¸ť×Ö± Žtá8őô:Sl€ š˘.ÄĆDÂ)sÔš ·ˇĘěR­ďŽšý«Ŕ› $;T]ëtčH»Ô(ÎÚ›Żĺ±ő‰JÁ1@P u¨ŠŚă«Ýص‡n¤PçťGµ˝Ý¤žq’g„,ˇ:• ¨”ŕŃHnq§C#7zqö lSnq˝?CQoÎĘĹgRZIj V/¶gR B76gßž|™3-ăË M4'–ř2ç”-R1…µT gŹ˘śđCŐôéűkVś®š{rŮq˛ř@îR &Nf p# ©čŰ .0LěXe,[ĂŘ‹ă¬C`šćnPź K‡R0EC)lžBi\Ú^ĹźN§Ţ?PŤSąxĚo[WűCG®xg˛ľŢŢ6]łŞ6éąbÍşÎZçćăę˛Ů€KZ˛·qĄv§¸PC‡ď) lŠąI×—Íő 8041Ů Ł¦S˛côÄ3ś­ă(ÖTah2†ĎK)ئę®)ń„Y!ŽµvsM6—Pő»ÁXĘ÷Tز0\ąXzŞă {bPH4°ólk»™â ›+ĹöůćŢóąQ“óq˛¸=ăĽ0 hă°Ź0ăqd*&Ä6ÎhÉOE̤›đV|Ľ«×óÎ^.nH?řúd˛ćžíałNc% «ÇŃ{ŕSh• %Ä®aäHŹ<GI^>…F#ćl…>@pnnG‘Ľo ć6×kĚ-¶ ď"ăQŠş÷µŕV—›·‘&¤Źv[‡ Ěéă,'je”Ŕ§ ‚b`t0ÍmŇ›ČT Lŕ9ź ˘Ął4÷ÄYë¶ů)ćÔ°Ć„ĺ ôÜąĹE^ ¸Sč$„µů$hSŕúæ=›ŇÓĚü«awš8a'Îń™WS^˛Ŕ—V#Áń‡ŇcśËşÄ ŤŇfâČ$«áŹ2.Fśj2Ĺę¬ŘŤyÝä®AłKP^ŢÝv-čf¦űáJNk€#—É–ŇM'–ZR~߸W…jëÜ™ĎH‰)‰…Wč3+ôúRĄV­)¬™TŠĘÍ‚âŰËĺ·gˇ^Ňő‰ź€jC× Śe٢2}îE›¦+v !t 4Ŕ ź˘uęô…B\Ś:fÜ)ž€;ĹŹâɶ ŰT= ‡ľ@‘j›ÝŞ«Őj™w’Üŕ?ńčvôć‚îĹrv«ř5\ú©F —?\Xo¸ú&gý:(ť¦Ź±@ăĽn»¦Ţ4z"˘¦Ő츆Eu40‘eač:&_âćĂě5ĹmEŢ€o´ń’Ç(CżS”‰o}ëŘ.‚ LJßôłă6¨Üy9Ś ˙yů eXB¬Ă¸ś,çÚÖŠ·ÁX0‹LŚEOŚeâC"Řîe16„Ö6ŕ+Ľé»<|۹ΣvŇŃ9čCi!7żűŞX[¸‰yäďŽÍĂgm5ô” ]»Ś®(¤ú3żŃ!{cUÖ:fŻ»íx»«éűł%)•`YŠoăҲ}»‘"#˝Š‘qČm> stream xśˇ^ţ SFBX1000‹…řűů‹ ‹ ’ř,ČÁĽnotOPUtđO˙=˙~»ŚşřŻ¸÷@$ň$÷÷`÷ä¸řO\źÔĄ˘műĎäF\÷şĚF÷t’×ČÎŰ‹¸–]Vű F\÷şF÷‹‹®‰°x©nşP’X‹H‹:_wKäŠ÷ű…˙>܆łř®«÷÷“÷÷ řZU‚c‡apIai?‹>‹WśSŻdżS×vŐ‹÷ ÷Ë÷6÷,űÜű ű űťĚ‹¸ŤŔ¬«˘˘®—­‹Ż‹Ż~˘r¬g‹R‹]m‹^‰Tohtoe}f‹d‹dšu©sŞŚ´‡°˙ż…´÷˙Żgş÷Swń÷\ş÷ »Ö÷=ů:aű !gÚÜű•‹jŤkžo§cĹ}ş‹ŃĻ暊š‹š\af…KTYżµ÷ˇ÷'şşű'÷S –? Ö´lendstream endobj 111 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 778 >> stream xś…’]HSQŔĎuşs µÚe­»¨!Z/FYX+F%.rjˇéťËm:§™ůŃÍť5µ$+?§Îµ›Vf~TV*=¨ C…4ŇCő¦gx»–EÔy;śĂůýůť|}Aţ2It”čH´±Ů‰ô«ďš ŕ ßŰ«$orűđÖÁm`cqUŮ9I©™ś2pHdčÁ ‘@¬úh9ÁëDÉ{´î“;Ś.o€•7„CÄnńľ:' ¤ÜvŰÍKB¦ RąÖK§ák®\HŤ©˛MN!–ÂÉľůĺ‘ĆKRš)€éŞJ%]řăWŁ1=bD6˝ #»_v/E˘pEÎY’ňľĹVř­/Ďo˘đÉ„ä€ZŘäNüć.lr+]°JI˝ËĐT»„35šQ9kÁ  °¸¬Ľ’ę–üöŽFłů™Ľ5%ň|LLM-°OÜ/¦Ţá%­jŽĘăáŔ9E'ŢíPÓ8Ü»Ć?šĘp÷ŃjHÍ~fjąHyKŮ ±$ż(čC.ä¨o±™¦.ÔMv+ *4n°’oDHeׇ_Ѹ‹ ŐďbD8 ˛ZKŢŞîĹÉ–NĽWmĺ˝™gĹş;”‡zi~GcWŤőˇ'ąfyťÎ¨EZ22ŚLÁN»żOYFZ…FnÍĺö´ADľîéŽ*â`Vyú•Ś WŤĂ Ş3Öˇ{ä ž‹¤!ůÇhŞWÓ ł[›š­-Ĺőş;4ÎdöóCá Yě©™mhďu~¤YĚ뀝 ‡=$/qđśĎÇ܆ęšH;ßAfŚŕ­nĎÓ™fˇŃd¬B&Ň wĘŞJQŞH/*PĄ\ÔĹ#ň&WŽÍÚyOŮ(zK-ü»śźľ°ŇY•mĘÚ$'Ö9ö“µö#·Ą_ąM˙ţöĄ?s˙_n˙>×q5Y¦N!N‡ăe‹Ěž8]R]Ş//)Ő많›ŁŮ2Źdäś!©ĄźeŇ[8w#üřî7Dendstream endobj 112 0 obj << /Filter /FlateDecode /Length 2536 >> stream xśíYÝoä¶÷żĐC±/‡r[ŻĘ/‘âˇ.&iĐâ4}8çAŢ•˝ĘiĄŤ¤µ{AŃż˝3CR{ňŮEóR đ—9śůÍpćÇŃO+žÇżđ{¸ŕ«ű‹ź.=]…ŰĂęO׿'Ý*Kś1zu}wáW•s‰đĆ*ždέ®ďŮ»?®7©LÎ+ţqĽaۦ¸»awkž8›eF°ĽYżO¸YŻ¸ţ+Č3ŮYbĘz{Áúâp|ĚŰĂú7 UâR˙TŠD™Ś§đôR+kĄˇµ&±™ĚhÖőľ  j:AňD:«@ůë¨z\oŔ|εU^“™40A+ăä Nć)—ĘXö°NÓÄéT±Ľ:ÝzŁŚł”Ý5-4 ëAV5덴‰s\łmŢ—M&9 đŚďŠ_oˢ^ă0ËXOr ŞÁŽmł–ěKJ('¤aĺ®Ř…ťťf·´ fýC® iLK§8HťHĺĽi¬;yűq}ýă9Ę%VŹxŠ~ŹÚf,ěËą`y[5ap›w^'?lÖ"!xY!’N âÇĄ«ŤŕÜTřMşf†ô6Ż*é2%Ůß×™3’Ľ§¬ëÖ®/·Ézc@mçŘ· ić,9&ßnOmŢÓZ®®„ fŕd÷9°áíh\®«ĘôX‚G‹ŞÄ•ŕ§$#Ä ú×0·KŮ »e-F„> WGfŔŘŚäÎ#6ŕôöâú·ďDŐ FGUŃŁČĆć¶ĎËš4§'Ž=–ý>Ś¸{*>Ä&ŹˇĎňşyȢCBt¤6ű$:ĐO–í.qG1îOiBRđ¸ möñ*p¦ĺŢ)tdŚ ›T€NgAÝű“îVçHf@‡x€Ľ‡aÄEĆš»ĹŁˇŞ… ¦n›şĎ·ý‚± ’‡6łhee¦ÎRJ¬S6şišď S!űÆ~łmu€”HĘ×÷áu&ŘżâOI‰đŇą@3ë]s¸úń´»/.ŁpÁvyź_=‚»/ăĘ”Ő_Đ´:eß|w%xHşc:=ל}Š’R4ŚäÓŮZr˝-?źš]Ô•% F:'ZOaöőŢ Ůž§ Đx(˘ bˇţĂ<4»˘ęH#(Nd)Ewlę®x%#¬Xz2ËĄc0.Ę8†‘g 0€żEˇŁF ŞÜ%AĆÝDĂŤ¬š{°v˝©MŮ5šäY$űj2ńí»ń7ć(ÄB` '>.*"`Ťµčkću—PjÄŔŢ?ag®)ĎÁOmIGf̸›°6vÓÜńÇËyŤřţ.?ś‹~jçÔDzŔCn´‹˘öxčFő$fEŠçé Č;J˛¤«‚S¬Őö·ö†}ą/!áŘm&|qfB ‰GĘÔR(*eáőBĹ÷ü!‚ó¸/·kĘfĘ1Č™Z*5eŤżS:ý2Śp# ug™c¨ştUyżęF_} ŻR ˇÜúE¬+ďëňfuÚŐBů†đłK Ä஧ŔŢ^<Żgőĺř´ç•ĘfjÔM’µpRóŰŞ3ÁŐ”Ą˝e*0# #´e^o'H©í·9¤ý˘í YHç(v:ĚÍNP°S\—fJ(Űq)‰ ˝ö–ŽAg=µô0éŚÝę5(AhgĎQ2DŰö‹´cŢxľ%…xA FF§ ß“jŽoMÍúôîďűĽz\çéHKăčš:’ż3ć$á"ť˝Ľ 'łfm‚ÚZĚÔ¶Äî| @ˇŘť¶^qG/(zs4މxYĺo9¸pů‡ây… ,Esl÷d@¨1Ń]îže|+ 3L(Sp+I¤Uáh!±F+˙B\KĹĤ-ó· a®[Ţż{xžRăĺŔObçxŇĘůxńűz®á9"ňĐľŻŠŔ†vU„;\żđĚG ľČɱM ĐDÚî xőŐTH„]aŻt™á*ędýújW„üâq+'N-Ú4ž‚Q÷'?ÜZÂ˙ é5}9ĺĎ }gNĚ“ţ ß3†­aż‰µ`ÎŤťI”ŚÜXéOąń±•#kŚÜż+«‰ŞÚHHöęűâj{ĂűPpĐ”WýVßÇîJńI÷©oˇ\=ßt?Ý•uŰŹź ž Ćpď‚ÄĽ„zOáČŔ…r4ć5ŃGâNÎ/`ôÚ‡Ü(bB»ţ+ĐĄr¸yę,]ÓĺŁĹŮQ_<´Đ}žđ\ďcěABüŻĂyz Ë+ĽhÇ°^ş’ v¬šľ/v‹2Ü™>u.C_Ś[¨ÁB—ÍL®J†¶čN6,VKß|ŔWآźr?ěˇXAŤ ę§ĐrĂţ\Ţ'Ł0ä8Ë÷E;Ůfß´ĺĎÍřĄOŻ—‡ąą.ü¶ zWn©éďőQĚĄŻŁF˛Đn8÷:nGyŁĆÄÄ{１7aż>ŁŚ¨Ř—U‘·Ôá!ľî+Ť6š~ z'>ůn°TH|‹Ű/ČŘÝ©ŢúHô„{LâaŻĽű8ío€“µĺßKâ8Ţbę–kÖ}śĽ÷w±1a˘ÍhhĚ—žx‡| ÚAřĹ83ěq¨°Í‰ľĘPŚ~•š>á”uüăK€pP {ŃLT®Ż___|˙ĂőÉ endstream endobj 113 0 obj << /Filter /FlateDecode /Length 10139 >> stream xśĄ|KŹF’Ţť'ű<:4 zÍ®É÷ca°á]Ă=ějű0ÔˇŘ,’5î‡ÔÝ”F˙Ţß_dU5ŐÜ`»ľĘČGddĽ2˛~ĽŰxřź˙{}űęŹß•qńńńŐŹŻRžů˘Žš¶ř7Ö¶ř&–6·©_<ě/ţĎĹÝ«˛­!–tńó«xń'ü˙×WáâľJĄĚ‹:cنyq‹Ź5lKÚ"q;’R…ä­- Ŕ_N4ś¨mµ©ŰŕD}[¤)`l‡#UÝ´°MNÔŐM‹ŰÖ »($łCC’:nWR©ś†!Ă‘ÎÖ@ú6:28yC|U=lC҉üČŘFŤŢÓvd!E3ěĆ'C†VŃ붸/ oCĐĽ#Ż3aČ"drކřtF$Ł ™ęx¤m3޸ÍMH3€ ő3ęÖ64ĄmBšd8Ő3RŢfmĹ[k˘>f#vU@RőÍĽS€™řfhŰâ4M;—Ŕq'ř\ç¤ŰjD5`­€4·ąÁ:äŕ˝Ô·m™*ż·Ýi …Ň i4y[ÁF„Sa@ Ć\}ţUžđ ¨š}kś€¶Ö—LWŚL¬¤<-Jo’âÓÁaɆ«=o;‰°ëYS†‹$ĘÇýź `ł’Ř ť7ITšëˇ W8ŁËŚŕčß ŕŚu­1h"ŁÉAGâÓńŔŤ&`ŠY<ťĆ Č`W†LN˛ôĺÇ`n/ăôˇŕÇ^ËZ4ţ*¤‚ŇrŃśv Z G!ŠĂjLŠ–!ť«E9ďGŽTÉ4ě Íćú Ä#Ň"ÖB254!ý >#"d:b±ÁŘ;˱fji ݧŚň„´ Ť«1#bŰ»#‘­t_F5fD—˘)Óň“ ®ÍÄ Ôg@†Ë<:0f$¨ăćČ0f$čÔX4w+á_±_ŇŰŇÝČ5š)li‚F‘Đ6č:(FüC%h@ĄáźčJ«<‚ĹÁdk ŠDrĐ`S© ĽYCŐ%RIĘ Iś<šš<Rx@[Ć®9QĄ=09¤!Íx‘Ąë `‘(-ŰŃhHjő EHTÖˇj8;ŕM†&^@6Nd(‚âDŐ8‘ˇůšFÂńęĆQş ćp˛1^p7«AÍ‘ÖVNUĂ „˛nK Ő ćĐ“î05Lś(´Íęj.’J‹3¤Ń×h…cz›N_ŁŃ×óíÄŽdRa¤¬śĽF*ś‹ eŤ©›™6$ÓtaęÝUCĂăŔÔ‡Ôck¦Ů[ŤÇé`X®F+W˝Í4fĺŃŇ!÷•T`Šôn/É *d9U Ę„Ě ˛ôă»ŇI6G-úŽĚ0Uâ=wcł<Ő&4ž0ąt ôdĄ^+‡éáj”;ŤD%ɡ0x ó÷ĂĄ56yä{ľeaš«Í (6RËíh(Uv›Kq–aµŔşV ˇ‡!mi ¨<đ¤u§˛Ö`Q_«śćßaěîÎd›ćε^Źç˘7IŐşkŻL“€iĂE°ĂŃŁőęcí^‡Î#/úQs®4_#¸ZěP‚äĹ Ü:2Ś®Ž€ij{P•ÚNőhjĽY{‡†"/F]ľA‡¤ů05Ú»Ťť^/ĂB>qóŘßä\ŕIvÄL¸ßÖčÉäŁYü˘ŇUťéęH¦Ľ6z§ň÷z2Ňč$ę@pOhÄčąéđuęPRá8-dšŢžz‰JϦ÷̵R^$ř.˝ÓáďQoO·ˇů`Đŕ=€˙:#:ÜŔ6ć­wÓiĂ°‹Ń5Q‡Ę‹$ÂŇĄîĨÓmŇ‹M;]]_ôb1 vz9‰˝°Ő+ęéPz‰cas†#ťĚčîž;ßťF_ˇEg\ˡfđ3¬ĺçî~egT řęM ő,&úÁęč »;ąńB¨˘ŤbPK’\DÓ’(·%űŚiITÜÓëͶŔ86)ÔŮą˛z1Ď"·ÂCžĄD"|35ŰfžŹĐhľ“ÝĽK Í#ěΖTP<Í ¬čą3˘%Ő<2śm&R×Ňb˙ťGě¤YSfD; H†Î’‚Ţ…0ś%ELş¬FgHK*F%Z7cZR•ŕ®ZgPK*ę^G*µ Ş 17ČQć' _É{žÔ`@’kÄ.+°ťŇ Úθ*ë5ŕňuŁZ:rŕ´7`™Ş·iâ¤`µéś+$Á lů9»@x|đ<€÷Ô´46uš#[Í·f0Ź3„4G=ěnţ”aČAŃ<"CŚé‘­Ó(TfřÎ[djëóNŘ:MrćHSŃLÖŢ`PĺŘzśOŚjµd ŁÔ€qE}0¤Mb›LÔ°D€¸&¶Š× Ëe‡D:↠cAí} ´ľ’F.Q,¨Ŕ W“pČŬ¶ Pô^*U„lůUál— JăŃxUÍěćr0ś5ŞČ¶DÎÚ1X” ÂnÇ`…á,©ňŠ|ĂYŁ ®ĂY?rÍŰ #;–RžŁšw $®6ÍŽ#Ž÷p1ŃrűcuŁ?×™RnżG«âFXĹ`X;ĄX\čˇčŚa…#ŁY„ µ\ŽÁłq˘§Ü-$,ńeT[Ą÷|2ťŮ-+†T›$ę+NÝüQ eńŹQ-µđtű>ŕăő!˝¬Ë`‡¦©Ł[üÁ€Ú˝ą˘ĂÖ$­UcZ¦¨©htš+ eĆ”\$’ÇZ3gć*çĹ)ž‹/Ŕu ĂŰqn®<<3Wq…°A-˛d<5.„ĺ2 (8łW Jmr“f€¶t:Ń QFýkó'CZL;;RČ! Ĺ÷„^µ4wíŰdLKŞž=Şśćű™í×™› iIéŇŞgŚň3ę i'Ť‡ŞÉφ'ł;ó25L:RáüH 6?#W—r&yi˛čÓ(δ .©ŔR9ĚĹsŤ–5·Ěk•ł”ťŞÁ!}?Z¬ óÎ)eş`ál&ÜGdŠ”ŃᤋŻ6Ů&nľť„Ó2 ¤ęy-)›ŕ6ć×|_Ď’J™vCšĘł®l#3ś ”'UŚ·± gcŠŇAµC—u¸şd†“2'á΀–D©ą9eB“óuVf1ÓějAk $ö˝;Ńd Íľ8Zé¨ÂWŻnâ¸:¦ x€}Ęo6j§áŮC Đ÷ ä’EŃ•ĺ„u` EĄ©ťŢwdp1×iŠIDM­n`—Ň ř˛Ě~”-˙I"Č…b ć?$ÓĘŞ_†˛)®Ŕ˘Sá‘ ób$˘»! XŚL?F>"3¤Ś‘ű kĚeFbeMŹç1*ZóŔH¶Yľł¨Ś‘é—:‡•pkôw]$Ě’ŠÜχ9ţŤţş2“Á,©$,† ‹łzž´ä) /»Č›cî•Ě8EŞ“Ń,© [ŇĚĚĆ’Śä\ 0š%x}š{$»ŤźŚf\Ď÷MFłH’ż‘C0OᶠdÜ`€oj H±Ü&/9ÎŚ¦'3'ać%3ŐË8™ÉŽćm†ĹÉLŁŘś3󿌓-AS aľ:Ň,F®5ŻÝĚY4Ţř’˛q;[9ÓX–YŞš/ôß´\SÖ©’Mg3ĺ»ÉPÖ2Ty±ŻX®Ĺ˛XŢÄ.>ď–|ˇ eIÜŚgfĐŤÁÍ8» iĽQSżŚe-V–DÂŃ#/ ަYj“W†U3ś%Ő:Ő@Lë¶Ň=[‘Cł8§ńn´kĺÍn“,ĹEĄ;Z iń˘ŮTď|}YŚh‘ĽŐ©f™q,së4ĂŇĽ\kjÂx–4ŚŮ´{Ýî\Zˇ·.Ŕ¬€¸6á,‰`S%K˝zj3)餋Ńó?™/+Š2߆L3^%O+#ZRż›’Lkz?ꇭ%_űâÖ0Ý$ëHSž˛_µÎ1”çUV:Ók"/ňđ;¦hÚčíşŤ”çíGAf@K"Ýúb—ď@ę: h™AĆ&şH2 µDt_ě™fË€)ŕ)U AfH2µť‹§€dËóć’tť¤šó‘qś‚·i¦¶--Ţ…tła9GgýÎDŞ´D'FKYňyYK**{G2˝0KĘ'GŠ±ě)+MĚAˇffbÇüj&Ó/¦ ËÁ=¨Ě‹2#Íą†Ňu-沓]GÉş*Ęô¸;o¦«ŢţPi§á”@,¶ŰçVL^¤îWź™YĄlwîA1—Čq‚Śm 9ŠY0‹ ‡j™^ĆĂޤÓ˙`¬[˝Ĺ°(S«›NçłQ“Ź4ĎîZłe9 ‘ä fęaIp+QCčĆVÇ|U6żĹ‘&>ä˘ÄÖDŮĹoö^¬&Şń K'%i§Fe ďŽÉ’¦űco‘ÍzQÇDu‹¸Ň‘¦RX4]ĚqU¦i솙‰>ő’l§Ô,ŹŤÝ0ÓżT?)‰Ě2:•ĺ\ázĽ¤ę†947(<˘vĂ,`D5ŤäD‰.XĚď&»¤÷D+jĚá{ĎŮ.çÍZtÄ"łĆL„” ŐĘ0Şä‚ĹY2Ş \z¦2jV"0ÝďaZŤÜöLFn„Q×čĹʢ­ľŐaŽ#͆÷ˇëZzRl‰#Iz_˛V­v¨ńrĂyĂĚ2ĺ73ł‹ÍË ˘vŞVńˇ/7™f‚ÂłLŐN·ăXM‘™h¦¶+„Ë4śK««IłŞ¨FÎGjVŐ~ŃdÝňłG}ٵ^Őá+j–¦kô.ł÷K§€şčv«€ŹUQ!»V˛Z™s<ň zU€"&ŕ¤Ëi˘•Ś^qâĂśĄĘpśúJ_ÍČ6©pĹh<(eí˛ßŃŇżwIVeĺ/Y»8¬Ş1*fJĂęˇc‰áýX4mU4.Ó*µ#©¦4­Ş1J‰Ž×jŐ8.«ÓJŁťîŐC5FDÎŃiőP@˘ÇWiÚ=«Őů¸„O«‡jŚµ4ç¬ ßv±z(+’~ÍŚkŤĘ“d@޸‘VtGjv•)~ĘŚkŤĘk2ë)ŚÉďÚŕzETZK¦Ţ©*hJŢ&‹ŠT YeQÝ%4ű=-ă[é„ĚÖÜÁX=bÉŃ ŁârqéJZaµ«zN*Śâő‰’Fa˘:/9yaTô\~f HSŐ–Ď/yaT[oa…Ťą@‰vÎŞ‹ײ^Şź—śł‡y~@UńXőŹ^’{ú9w•‡aS»#ÓĘĂBpcž‹ůŐ3†$•ńÎą¸É¨–ŔXł-VeĄmXYTeňR¦0Ó™Őň-Z´®:­BÎÇ®AUĽsľąZY/ŚĚ¬Ť‰6TReRfHbUĽs… ąZ4V™#ňŽ­0Á€ŕDCEĽců|ąYPgE}˛ŐŚ‡¬w¬Ŕ-·¬*Ţc’'7 U¨±ÔUuuž[3F9ö3ÄŚ‘סęAUĽ#Żůô(fŚeh3ăÚ¨bEé»Ě¸ÖË]¬uM[™ś“çĘŕжŻOŹÁr·śjŞ »/·ŠA¦•±öî2Ź¤bŢŢ= ÉöéT`™=XrTĂ Ł ŢłIŤjú ÇT9Ż®cL«Ś2$:’T’Ţ“G= ž­ WOC¬4ĘäHSMzdF¶Cň9ĹŤćŮZś€`5˝mxÇ%$1Ł ︄,f4ŻbzÄčH3šßŞébF[Ů‚bWµVü*§č޶2?<IŞÄnĹą\bVQoËî^1EaµŘmE€%6•¤·ĺŕ”ŘUÔŰüţ)y+ĎwJ *ęmq-"Eő6OĎÉŞIo^¤¨¨·úŐ&fÔéz’™«IŻËбŞlz±ÔJÉ–I¨ĚąËąc§M!Š¨ #۬Bd_CŰ(D'‡‰ ăF­kstĺoHňžÇóçĚ„’őÖĺ™—UÔ[ó•RĽMQQoő›' Ve o)]ŐéĽyŇJ‹EV„-eČŚ×,B|kTy:]?µ©Veş©ćU»“Ńŕ n“é]>ÂM÷bŐQV$î+gl;„řĘ[/dWĂSyzwÓ¦»Wíy.Ş$¨Ľ˝ń&M| ĐĎ-âśhŠĹ F3`XAvQŤZćk SÝô˝ÔMĎŞÇfiĽ†bd[„DďĆ*Ł¬ Ţ›Xa”boźRÜeůËĚxšc˛JD#©6˝,[SF–â^Ąű™Ď/¦QE8d>¶°Út Ţq—ަ#čČ”cč(DE„†ČĽóÁ…±˛Ľuľ¸0Väą&Čzä.Ä'8›¬ÓŐŽt±"Ź%G¬GîBdYřć‘— Ué!Uw[Suy«§Ž1#w7ÎŐ”v^Ć‘o.LiçćŰËŇM{G”›OŹ.Déě\}ľ|ta,×5_†ŁąÖXeŔňŠ×ůę"ůëŽćTŹÉcŐËC˘#VeŹD¦€$Ťť=CÍGf˝X+á(†ř ÚŃJ0ý/F$Ůš¦3"ąÇGÉ©˘€äŚ’a>ąţĘĹw@OU Qň ęâÖŕTĂ÷mĺEkžzC”/ŞD9TŔŽ$©ëőć&óŢCO¦{k|qˇ'DÓý®ZšÔuš®yś*y?ÓߍµS5řC˘á‡/.Ěx­GAąę¦Ë_h­2^i™ľ¸ĐŞî›Çč¶ pń«ÓßSůŐ7<Ĺŕď©–çÍ7Ńß(ÉĎáŐ‘ŢS­äimEľGjké­I[ŻÇO@şŢS5O(±–88"5Ŕ‡¦­S]‡Ś1®Zćt‡—Ú^ôś(Őuę㠋ŇzTUÜpŐ>üQUqłÉ:ć,@™É:˘ôuZöŹ//˘É·ĺ]ś1Ô)ŞlVĘKÎGw.¬‹ŤĘW€łeéę´˛nÓë{}¨„źaŮŠÓEŹŹ.Śqşěµ”ʼnőv(7{üg€Xl÷ÄN”ĽI#ât÷°éŢÖ™ý¦{ŰÓ{ÉĚâws8âpůl¦q pžKµźž]f>şČŢFË«mo’Ľß)—#?Ě­©ë¸ň…­řGĄăřä"!¦űÚ×&X^čôl@WĐ˝´4óĹEđ6ľÝćµŕ›RŁÜ®ŘÖ¦đĆ6]śŢ¬)[ú*ąç ŚéDÍűí˛YqÝ5ƶ¨ůę@˘ż|ő: ţŃĎE+ţěµ®sŃŞ?{­kÓZ—Żq¬hmřłWĚ—YŘśJw‚|lQśJń_ëIz:ú«śĚW É©|#{•ŻqL×4š§×Ĺ™Ź-ôxĄéZźţxÝţ°C¬(4ĺeO/™3_L§ŞNUťeí8ăZ§ňg\ëT~ÇtnŹ¦řŕ"ři‚™¤ŞuŇ Ér9hôYť+Ţkł)J$˘ŃuckËKčđvĺx ‘\đ˝EňˇöłćĄ HNT/Çě‚Â÷ʼn‚uS×*°3`ĘhĹäÂÓu7`„‡ď-˘Éź['’ č±8'’ë>·Čx/ݱ®žřÚ"8‘„‰Ő?U€43ź_ '’tu]֢ظŰe­Á{iň7âş6ä[ ÓÖ1ş¸ő4Ću÷ß•Y5DâÖs”şŽ+čć[‹čT@ľµ(NU˝ź*ĂŁ‹$[d§ĘŢĎ÷Ł‹$[D§’Hö,Q?%ąľ^!?[d§’öR,ńž»lW\·%˝ 熿3ɬç7üťaćs‹ěTŰ^“s#xČĎ÷Ń©$Ȭ«Nĺ’¬ [CŠ÷<|Ă’í:,Ç°d»Eyq,ô–\m‡%î-+ZfňV=·*×#®tGoÍőöşÜä«‹čT~ÚTÄć:=Hq‡é>ëćĚ|…uĐŮ:•Š^eż¨çŢ2ź!]nXXé>»ČN凱­SůÉᝯ?8#‹aş^fńßt"?JŁIw‡u%ÖGWśV•/b{†Ě ÝV[ץ­ŤĄW·†ř›EQsëŔͦ¨9Śuŕf—űq†LEÍÁźze>ĽČN%0B”îĂ%^$§Ňˇˇ(j>Cš,YX,>Ľ(NU}¬áÜđl™O/R~ŽDç†?+ËCŹc ŃQćŰ‹âT:ĘV7>Gş6přŮŃÍ"x©zćă‹ŕmt¶ůř”÷’0Ż¬Ě|~±ˇÓÎ ÔÖž#]†,t?˙|an^Ł2ĄľOHŽ žCw1ă:•ta„ö© žĂJĂąN%­1Trü ™ŠžĂş«ĺ; 3e@¤GřŁ´çHvnt×,ŁřŻZ¨ Ý˙U‹3dą!]cĄżă ůó«ăO´đ®†sŕď•@L#3Víôďßů•–(Cá?ńr{ĆóëV'„*#©•O:o´€S«+ĘçĂ-ଠóV<]§FGä¬Őó<źů©U¸řEű}› ˙çúöâżżyőÇďXżM!a'Ţ|xĄż‰V.Da±ß…hon_ýe.ŻJˇčĺM<ý™NćÓźĺňű7zőOo°9úő”ăŢęăéŐŇźý}™~Ô“¶7i,łę?5YČ© Óżúł&ŽśšĐG2?kâČ© oÉz>oâȱɚ˙©ÉůŠ~ŻÉç+2<Ů+ŰjâęĚނ݉&ŁŕC˛|D€ĺü›vţÍ8}#ůĺ|őŚ~óś—|đzĐŰç“l’Můńéě/ů5¤±ůÉ?­ŃrŹ,c˝5˙nł{:ütÉäJHsłż¸9üßKĆŃŁĹÍţćđéţţýi ˙ö˙÷CL’ `É7ś’ôCŽśÉ!<©ŮΚ,Dšćß;J°F,¤¶ÜssöyÂŔ?Í$ž`‡yÇ]ë†B=ĆT7ďI7÷Ś_ü.?›Jć5óŔtŢĽÇčż»Ľ˘bĚ޸^0NζðG«c×Ŕřz˘ůě4aŃ<[+Ä6ŔjśQl¶—oţúę*±új䊅°Ö×›O\‹7CÝüőó{v='‘ióŃľá}ĎŘě·ż~z|ýŇ‚ě Î&Wćś±{ăřlrĆú±ńŰ [°¶©q9oĚLlUSN óÁ2ľŕoŕjş¸b0ˇa­Ű{ŤsÖňŇřŁ ţÂ3’·—¶ňG|§´ŃNµO{÷°7w÷OúeóĂîaw»Ú?€UWĽťŕăă=ĐŽÍÓ§ý/NšëćzwçäúöťÄiňü9«őťÉ´ă4öŹO‡ŰÝÓţ’?r1#ď…ąóÎi±¬ą[Űm“YS›ëű»+˛ ÔŚhж㊥ Pë?f á?[?ŮhjáîŇd+:Üßín°čÎľŰćń2BÇŞöwŹ{°·$óÍ»ĎOŢ,¦ÍŽňlőÍxç'ërx¤ÍÇĎűÇÇ˙r+vŘ×WuóĂĂ=§¦Äë4}ÚŢďmčXjáIÔHĽ5Öö±ůĹÁ2Ť/đ™Ąj‘‰óěÚ<ććţîýá¸Pf…gÝÜŢ_VăćýţńĄ °Emu¶˝Ľ˛§ Đ&>Ünv7kBˇ|mBW,ĄĐÚ ¸żçĂšÎgĆĘkp~óÓîá°»ó6%EęŮäX)‚@aÍÎXJ{q’rLgĹ\ył»ăߌUâćóÝőţái™ZbűdO€\fłĐŔ˘ýîńóiS¸Y<żSňľ µĄŹ%ö~ýlmŢâÖ5ďĎ0=0µ­šThŹÇnŰćÇó•|ŢýZĆžËřFäŞY-CáÔ‰oѶüpw}óůýţ˝Ťu€ÎŰzÎ[^Óçíćúćö6I=ŰÄź^Őó¸Ç1 ¨pęŻTşksł{ÔBČg‚ňlHOPűkȇÝÝţĂ׆lkb»»÷ŢćĽ'¦ÇKíkňŘ„˙˝{xˇ/ľO ĺ¨ŃŻďoĐ95B,]EđĂ·‰‚ŞJv‡‹L}¸żą±Łl–ôçĂÝG[ŰkG\ROĎFCśď={ˇČŘ«»ýÔˇq‰‡Óś}7?ÜŞmÍÄÄô }“člŹ4iáŘ盛ϏOč’rĘę–HŤ`3eő5‰žťÝęíą[_Đ_±Oőó鸞>­Éĺͬ0Öň/ŻŢüYr÷Íű=NŁy& v(70E?]2—Ţ ív7ŹîĘ@ażŰ=šg˝;'‹Ë&؇öĹśłŚ”÷GU`úe˙ŹKçÎ\}27ÇLćšŕw˙•[_mfׇÓß˙劗͇Űôź$­ú*nţł}a&ŕÇ»ű‡Ű·¦ŕ*í4ߔͱů‡S‹ÇžŢZ'.¨jVŚg¸˙>„„mx»ąŠŻ×(cŃŇJ2_šîýĂű-OżŤ:×”ŹßíŢžfŢYżuńׇżüşŁ×ß˙ťyQžßÂ[ťŻ}u°čGúżhÖßW Sű·ýă·˙üßţĺĎ—qóO Łą9Ü~ ˘Źű· ¶qŻ–:Ő˘O€'ďo7»wßţţO<ż×¨ >B«ËľŮř€Cń{çĆŐ‹}ť/e÷·Ă#–˛ÂÉ>}»VVípc=Ĺwmę·§Í÷ ây©-m|Ô/ŮĄ1ŇWľýpîÖřÍÔĂú9‰ÓÜ<î?ŢîďžĐŮáőiÉŘC|4?,âhÄď_Ż ž5‹Ţě(}éűŻÍöÝÍáňiIű<_qx}jyóôË·kU_F= vŕčşđĘĺ#,:´‘´]“}١űÄĆÔF}©<ÖusÖwŇé¦íŽ¤ę{iÝ5ÎŤů?ť/*ą5îÓan¤d]“;Ŕńđ÷»ĂôŘü@'€ëńó§ĂÍy6ć7Ź«k8瓇°ÉŻy×yšw<ď¤m>>~˘#zÔ¶t ÄČÓdËEźl6 ‡ŮďN_íăę ÉYdńp˝?hýŮ74"ŞÎ˙pĆő%ˇ\g¶B0·|í„©Áb›ńâG¬ęýáwű‡eřfwđ·`Ŕ*ş–»n›7—Ăât&÷«—´ąŰ=}~0Ă3$őN°űáa˙´Łmz<µ—ćô⇦X6{ŃýĂjÚxdV%#˙bÇ6§Ť:Ĺ‚_3Bę!=î.—­Öz Ó6ë{ô“Ź|‚ĂkÓâtÓ‰ŐFůJ•ńśŁ -7O÷ú÷Ys„Źg͵«2‰…÷ç}íýĂěÇýGĂÍîúéóî†Q†M¨Žż# 6uf!éÉ9žBŤ9WŠk>súQ č2śsŕe(üĄ7pű_y2ďďl˛$ÎÝâ@węŢ\!­A¤ŹŽW¦-t•—çźF7–4˙ cNÎâô§­Ž6ßĂŐç*2ŰÁÝ|ő®ĂrňZ‡|"LÚăřů×A]>ܿ۽;ÜžŽçŽQµ…KYnîłđއÁ‚ß1‚RWĐkćîé»x~ óI„ł”ĚIńśNżäĂĂęćą÷‚÷¸ĽĐ!–Ę$ŰČ/xîüëŚ+Ňße#®Ç^Î ÁĂÎückrś5?RUĽÝĽśăoňôß–Câ\2+áŤaíA ”RxŃ Öíů_˝˝¤ âoCÜ…Ô…<ÜšŠŕďUĹĄMŞ”ńůJŹţ/˘÷w–$E¨ÚĽ˘2ľŽĹS›Z<Ť·ß)Ň)çŤměa˙řLę~u7+ü]áĎÓžţr†ˇYžvtKäŃÂk¸zş9FKq˙ĺđ>›š˘ÓD,:(šH´ŔŮâĽÜđ·ý`¤EçË ľľżyúâîţô7h퇓ááĎČÚR*Ś3vď…¸*ťF+ăÔQţ-ŁĄŻŤÖSĺKa>®˙;ĂĄ¦H÷SĘŃ~…­^ŻBaĆ_X]9 ×Ά+żi¸ň•ářÜ)ő5.;3׋+«ˇîđm*Ϥßý?:§Ä—endstream endobj 114 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4363 >> stream xś]W tS×™–1‘n6’ jCć˝–$dź&@“)mCBÓ`b 1Ř`L0¶Áx7Ö.YÖľĽ_Ű{O‹µX¶ä]llI°CŘ áČFh“tŇž´§í4çÚ}™f®0™ÎŚŢŃŃŃ‘Î{÷~˙·ÝŃÜ9˘śśśŰ_Ď/z噧ź~:űeaµ°mćÚLůmpW.Ü5—{@úÔ|śwß•{ŽÜ+Ęľî±aeă/›^ÚݢPŞĘµ•U»^Ż©«jÉs‹E˘E˘µ˘EëD‰Ö‹˝.*mm‹VŠ6‹^˝,Ę­-^Šć‰¤"ąH"ZHÖ@>ţ”“™ăšs#să·ÜvI\ ţNr•ßţĐíÜ‘çwîż«řîĹw_šW|OÓ=Ý÷ęî{x~Ăw9U#˘yßÍůŹĹ"OƢšĚôőüiďĄ××~¶@::Ă:[(‚¨ŢĺlaElnsë-ś“ŁĄŔă_wzČH:z&ŕ  Ăľ(ëâlZ#Ţt|Ś¤ăö?Ř~o˙’˛bä<ăÂ÷·˛y.Ź \ĐUËZ¶ Ńoß·lo,]o7şµ>P#[ŔÎuuú ‹’j`€`P»XzČďgü CŰžzMă´WâM„ă|,Úë!ď>ąź‚ŕ‡ădĎČp!ľ’®ÜF¶ąD&2§¦źLĺL—ťÉĹÝř;™yĐ4ů:üt?1ndśn'8•u‡Űđđ•VëmEV Ôj¬µeBÜÖÜV-Č4&ŮîKĂÍžůňŞ'Ď/ŢÇďhĘŻ[ˇx…¶4›vC*Ý×0úńđőŁqĘă÷ €ĽÎć·j»ôNŞmgók[i\ŃhŘžöE:ĎvźJśÍăŇčAç·­nŘÔD‘µ™yÍ*üÇÍĚźľţeí ¤ăÓűđŚĚ+ąĚă;.Ăź‘_"=Ł»Ňý[Ľe€„cb+cł€™nžJ‰ÓÝŚŢěhs›iAúmŔ\éßý<ä‘m{ś€LVk›)Âđ4îK5ń“Xřkř¬ďř™ˇážĂ0…Ţ-úč9Jhn“á5â“ý…›héř—>!ä´¶zŔH-›­ŢPg$æéIĽŮň=ˇ<6%K_‹ßčľćďđG»}Ďď»čzjů«?˙…‚V;ÔŚ ĐĽďrţńí­Éŕ9qäb.ţëtˇLřWĂCÂC HŃĎÇ—ýŤ ‹ń‘ođ#€ečJŮő‡©O…<™«Ę¶ÓĽSýBĹOčŃ«ęcStXâä¸řŮôŮ©‰®Žľř źřhga…“!|Ł ď•‹T™™§29řńĎsg*frdŠ“ů}ë`1<ňZ~ţ˛e…Â= ܇„{?áźa9ÎýF“TdČđ˛Čc8»ĎJ€Z«nÇăŹ=.Ě´¨ŕËođâ÷ńZ,˙‚ëťęšôÍČ“Ëő sëiĆᶙy2VôzB^ţ(®•ű"ţvoů$~7gŐU®kn¦fኲÓ.Č‚2şđüé!Ľů°Ě#UďWě„ąŠK˙xľö·KwV«[ši‹Őf¶ŘcUUđ"h¶T2.Bg'ˇł“Oz’í>*4–¸8 ¨Sé* Ű-Uô3Âß]—ÎnČłé´n¬âV·ÍvźťePXś‚”7˝Đ˝ngS|\8Ş-íë@ L;p^ŢËeđ}r<đĹvâ™k—u—Ą¦uťv}y™^ۢiT¦|7C{Bţ74Ś”ó{CéĚţhTž÷$zl߼Ă6Ć–ťŃ_/OšÉÉä̬şž‹ŰfVČě.ů™YW0ą«‡Ń[ťĆN żÝo®¨…JČłŠŰlí1ó O@ş&ĆoDđłXx+üm#ľC¸3ađéÁ@”ńľ8k>nMojd&aÉ*¶+őn=ŁryČźJÄ6ŹŐCnă}±tš“óiGć  ß‰G`Żsźr˘ľłÄ[śĄpo@VMŻ$ć˛vú1™ŇaĐ€éÂúÔ`g_ďŰk"µkš·VRÖuĺ°ÔŹYʉă8˛ŽĂąŮN&óS‘±Ř‡ŁłŢĺbírÖę1Trĺ r7Ů/XŔ1ÇA¤ůŢ“X/Źź{óÓs<âĹrFMٵ´żű˝śž:‘‹çś—őötőuÚ5»tuőżü°ůřĄ‡® Ňl<Đ—8´ě­oíČ7ÁůŔäÁýG`öę5J·V d´%úă}˝gÖ÷nZţüÚ%‚\„R+_®\żcSô€)ËŮ5eź)Ďŕu.ž~Hćh°4Ř· ?•ŰUv•[…’­ýe'.żyăť4ĺó{ą›~Č°vŻvB›°h) …#™¤9‰'Iě˘ăŽĘ}!H´ú@ś%(̱‘°Ío´Ů°ŃkÄüţđţŕţŕÜĂů8ŕP§‰oÝeŻm¶SuÂÝn«ÇÜ y°“ AbŁŮŮJ;%^+ĎpYŰ™#wŹÓŹĎäNĎ›’µďěk…“Đu&úfö¦~OüDťł«$‚ßíÔ[vjWď¤töĹö„3|†žŔ/q=‘=Đťk šlJĄŤZ%ôK«Š^#OWđć ĂůľóéłÁžH‘ÇđnÎŇ%oín 톗`Űł¦Ťn‡ŰNŚŘĆ;9čfKDFzO”`[ µ†S­\۸ Đ‹‡Ţ879Ü=ÜźĹý˝ĎżßĂÓdoŞÜ-jP€&fáŤa « ëV:”v•âąJaÁŹm1Ľ5|!s1ýͧ8"qاŮÂ"›ř¨xŇXBćdőÚ#ťLośĄÚÇúĎLŠsmd µćÚ®·ëězUľÜ®p4Ănôz˙«_SA1ľ34… {đ<Ęź‚4굍×P˙4ötťĎĹ9-‹oëjš€ ú<<ĺńű˛$ŕ­^›Ám¶¸)Óşźo¤µuĆč RlW ë4¶řĂž0JšBz…Q«vQĘŚŞżÁKÂ]†Zĺ6C l‚W»V_hąBLÁ±ˇÔ:Ž2Ćä4ąĚŐÂĺ.Ł[oołéZőm­\§kR7ŞŇNLŇŢ‘ŕHp8v*~ćŔ›‰d:Ůë!‰1‘.¬#F”óe“HŘ–šţAx¦O¦y¶T¸÷q éŢnB~qO*ճƴ>Ú!®l­«_¸áđ×—Ż_ßKGG¸±Đč'řmą—'4˘,;š-J•ť°ŁŻmSŐ­yĄĆ‘ýďőĽ×ušőGű!FUăE+«—(bŕbŕ6ÎÁ§\}1–ŠŽwź>Lf0ŚµćfZ±¦>VˇUĄç÷ĹŇÝ˙¤ĂJu6Is§WMß-kR¨ŐQcr0Ő·çĆÁŤÂŹ„ąÂRáKŽ­řýµŹľ=F\hÇ+qs6Î&04™L۶ż^ż+Š¸ÖwH±ËđýÁ䥾Ë&ˇN®H'kŤ4üďôƬú朧:-“9Ht˛ÚžćöŘĄŐőőëÖV-…ç`í˙źÓ,%Đ˙ág÷[+ŁÂ°šŇÚH{Ů^ß?=›ŔlžGÂŰ|V»Ý NŞŢŐŕ®w·1hĹďPQq˘—ŃÓ. X]·µBX&w¨l*— é×ţ#~$·V¶©Z ôúFáBmËĐ)ÚCîülß÷™ď& ÖŐŇ·€MăĆ^žfÔó±řvŚ,^ĹÉ6•Zćđ#´břQ<ç“/ĆÎŤQ>źÇ>ÄÚB‹ÝdsR[7˝Vń2 őę““Sˇł~–ý~8o§Ą_Ýś)ˇ¤WťĆąPxPX'“~ýIâÄď®.뮯{Px‚Y•]Ĺ’Č-¨kÔ]ęůҸŚ<ţKÍó†’Y˙@VŢÉg\¤ż^Ą˘AłFan´(hífm©vs[Ť®ŞQEWĹ1Šźg‡®Ĺ¦nS˙l1µUsń§ ¶h{o¨7ŘMwL%';¦Â™ÄŘ‹ĆcEÔe\#S¸4jR‚µQC˛§;ŐCI/$[cJzĂíf\ g‹¶jpć™ţüČa™Wś.ľ®#Ćü/ÂwžP]ßKYŻŐ_”o‰VuÁIR]{ĺĆŤO¬[n cĄ\őŚ“!éç’xl¬›8ď ż… ĺŢY7đJX»ßa¬ß˘ŇPę#ńlÝ˝w‘pŻ )é,y§™ŽY㮸ă]­ü¤.Ł ®ůo?}té›ăĂŤ”ş×¶‡$\:Ři†łym¤0·ĄX¨’“LveUpú“#'"<5 ú¬̢ŽŁ§Hż /Ęş‚ńô˘Ž¶˛Qµ»©|B7üńűÇŢď§Ř/ćŹ]ÁźČŮźµŘĂŤ#%,˛‹-ů™rťŰéĘżŤwpťľG%Ç÷ťśÔĹkUĺúmć ú—¸±¤îŃ!Ď%6yĚ~łáS3 ôjâíH7$©€8íëě‚n$ý4iüż"ř» ţ˘ďŚ¤‹ĚlPç|u*ŹÍČÖŰ_đ“óŐçQíâd?ŁÓšw;ÔôsÂĆbe!”ćyĘű·ĉşGöł]r„M@8~śŤ´]ÍÍđ3ďÔľBÂĎŘMLĽ>@ă;§›˝,ń7>X7i,Ärź ~ĐŠăodŚŘýNůđF@Nq¬®k.µ'Ý­1CBRÂË ú‰©„q’j—mBÎ`Đ`˝Tt"ňů›¤ ůż›4!îźMHť/dn5!¤ŹšcžnŽĂvwtä7żĽ~gSą±ŇĽť.6Îţ/ĎŁo·Ä€¸ő`Ŕ;ŔuÂůň@§/Ĺ'Ó'Ž]úHwrńŐĐĚójÍZŐ«ć†Öz¨#'?e¦~ ÎÁŘĹÄioŔO¶‰x‡ĎŞň(´6Ş­˘ą°[lô8ÂL„p’$ŰŃy¬óhě8×Ă’ŢŚÎmŰżnýK;Š[˛L"ÇmĽîxÎź±Sfq:Z#˛úí W‹Sľžv‡Hß$4®ľŮM]Ě-sU]ܤşśÂáKÍÇ_m°@jÄO~":<|`j‹>Ä/ü ¸şýł‡#Č,$đĽ0·ţ»Úˇ!Gé†XÝľ«ăřŽńë>Ýé°SDUźÓK¶B ®•”ţdłĘťŚ˙ćsĽ‹N Żć=»¬€Ú´cCËÖ­[¶T¬ÓŻf\Ś\$Á´]†cÔ( ŐŞ‘ôm}wż©á0ůźg8`oń۬—ŐEi7ě(ü¬Â5`rußÚ¨¦Ą_ôd}l:4˝OÖ\Ő˛]Q±J¬du‚ĚirÁ„\’€*lM Žň#Gđ–OqľŻ`áIUžč—Íď€Ę!.c'ńÜPeŤ;ŞąD< íČ#‘^Č2XeÚ¦µP»76)6Ü`¶µ{RG:{ôĆČäŃgSĐöň A<eł-ń:‘*5łšä˙üKx<µ'wĆ=ý_2EńŽ˛˛š5[ŰOŁťÝ»F»»;ű:ŚíZĄÎ¨±Q.‚ôľ5şg$=DääeÉ®5ÚŔzđ¨+,Qk\j·ĐňĹűđ<:*ńťî?ž<–RfL™›ŠdŚÂ[hHŮ·µn‡AÓLMíĹőřÔ¤˝c+l'ŞjnŇ4hŰ[St@<â€=„‰ÇŞNĽ"ü˳³‹µ>-«Ą<î,Łn‹BѦ«ßŇTM ÷ă{JţfCíâ+đYǹÿ>}çÂ×0Ąź¬wű¤xëëhŹî=ôĽ‰’­ín…j·>¤ď¦„ż 2g­˛¶ÚE”в«»“öIĽ‡G÷’â,Nt•®Ůc7uGnxĹ]·‹D˙ 7GMžendstream endobj 115 0 obj << /Filter /FlateDecode /Length 3620 >> stream xśµZÝoÇϳЗ})š‡{he^nżw ¸šF $©€˘ý@‘”LC"ň×E˙řţfżŹ>É2šĆîvovfvľg¨şˇçÝ@˙Ňs}ńő÷Ęu·§‹.„ô˛ÓN‹O®ąčń…+ă{a»ă¶űG·żP˝¸Ýű Ţ˝Ä˙o/†î/BIŃ»Îp«z'şűşádoM'”Eµçý híËb hm{Ż›ĎF÷‚7Çó:â§yOp[1hמ Ägúůsb/źž°żľřű…0íťíŚr®çŽ®TvĽí0d=—ťŃęĄĂZ¨~pe Şh˝i Ŕ…p †ĽŽ4čDޱ:˔彷•FZÓ‰ÄEČ\f Ó{„»Y'‚°”’şęŽ·řBâŐ8M ±Ř纬A× ®T…pŕCšŠˇ®‡¤˛˛ăxzĆ  uŇI¦‘Ö8‘ą(™Ë„áěánž d® ™ď}łc}áÉt`ÚŠŢ@+Řą-kĐő0;Îŕ—¶ÁבťČ;Ęöś ¤OŰĐk:‘ąČ™ËŚazş›äR‰™Á¶űf˛t'9°ÁŚdpXÂTYŻqŔ[°ˇt Ż# :‘v4ŚU0hç‰ÁB#­éDd˘$ ‚é-ÂÍ$läe,^ÓÍĘtlT'%YŹŁuÄ*á R”5Čâż^4ŕB‹A^Gt ď¸=ď H^ë†B\ÓĚC†ČĎF„*żFQieRą],ąłŠ‰ř„W2__]úŞň–eş~5髬[ĽZI¬h=BŘ@ń),Ŕ,ąKPĐůwÜĎú˛S@Uoy’w*t!87 i§‚ ľí˝kAŇN!Y› ˇ´S@ěŕ4GÉ;$]±i.ý<ŤU/®÷‚śÉ Ş *[BŢb LëŮR4ďďĺ™±lŔ+eBlóú*Â+JCgEQßýŹí9±G%*möi$.3ńi#bTăÓĆ×ۉK¸)}ăŇ`×ůćJN"Š"«T—6TĎ*5qi’€*†ęŇĆQí:ńhÔüś®X=Úxe2Á’ŞRd̲iq~ 2¤őhT&ŠZ‹ęŃ–CóŠO<·†p‡¶P UítŐq )+Ô OŘřkXÁćÜ„ĄG¸'\Ť ÷dÖ@íG•tŇ\Ep˛.Ü%F´®ov·Çíb)e(ÎÄKjřĽ7ěeČ#ř3qŽáuŔľ3cż^ŕŐ15Ů^Ź'‚‡ő9Ínč0ÉĆŮ.‚XäIöăBPµ­=Űě:ězë؇ċfëĂ~łw‡ýę.ógŘýFm?›m!¦ŘűÝř&ŁŁ–Iëß泊~ą‰ě:Ť,·_o+âÝ~ď8Ňç¸=ţ¸ĐĐęήW§í¦r}Ř·Bnőč%şËż^\ţo-UŢÜž]B-ÇvˇŮę¸[Ť>ŕůú{î;DÔ¸¤7ÔPΑž"ZDbŰ1‹0+wääŐ¤PŹhü~uĽŻö‡ú®)Ô&śâ×1>  ôĘĹ[@,Úgj¦R3ĂgR3Ď vnŁ¦G‡™‰{Ünvë1Š=/ŚáÝńp˝şŢÝA–Qíd†ÝŽ b]íó»a«¨M¤+śéáĺšmŹ«hĎ69ołyŘn<î·ë`e†%X8;\Ź«Ý>˛śŽźŰ-ŽX˛¤`îĘKÁÖw›Ýţ6ź0É:—›Ő¸Jź0xůö\]¨"=rO„»‚ß>ÜĂť,ĆÄ t(žx3G·ˇ"%|ő>Gp0ž÷‡ŃzËRŢ+Ö%bŞőõď˙H [${ł]m^±őőnżˇđeZ!ö ˇcżý*ٵ׉‰“Wěć^”o’$źF«”÷‚żZĐż9FÄç(˝ÁÍÂĽŹ<·§w‡ýi›ńrv\ŤĐ ç°ľŰęeăöţ]†óMĆŻÄ5»>Śă]@$˘lÓ\S!Ź»ń[ĄÉ Áee)ů;qÄ«·KSYT>Ö‡»ÍĽ·ó‰·Fśť¦+(,fB‹¨Ä ůbbžGj”ŢbDB6$ě$€+}1…ę –g4â„ŻŞzŻ÷˘SM°śÍOSŹ*9ă RN!÷Óe‚*@ĎĄóŞřéÂ˙,‰'Ł˙ß(~92[“XLĚpU7Ă2„\vZ-BŚFf˙@˛Ň‘“ť"±íÝ!\Ý †˝Ż‰ewZĚĐ^˘h2;ÝŮŔsŇĹ·1]H>ˇk­/<ľbAŇČ’|©D#¬3č? Ň ťř‰¦Ą'Sé v,QˇC› jńHP#˘?"b:cěÍť™ůĺąĐ¦F3ÂÍŁž\Tˇ?¦“ ˙@uđâIÍ —ᵸ;ÜîRb¶íŤŃ‘H„¨Í4¤#‘/±‘s‘8ňÍô[Âđ˘rNŔz włěŁ+…T–WOŠG ż˛Ügż ` 7RrFe$ăő™Ę˘LQň=«˛C'Gľx’'zăVdž~vnE~bEF’~§,‰gÉirä#łVü̬•Č ÎĄEt•VBT{Qßř)Łžâ–Ü çě, ;ěő“¶5!†´n|ÚQĂů›¨©FéâË„}»çv3ÂѦď(ňůĐ)°ÓvĚ‹Ps㝪hËţ˝=ҬVűÍ\äqĽ—VČç+Ř«$Q®žíťů´‚‘˘’‚CnúX»çśe Ż FýLí’MŽ„ÔěĐ×rN‘E:ÓSČćľ !ŹâĄŁ°©«Oµ_X53€SżXň5űfá$µl‚=‘RŹ(Đ!ʤ)LEŠÓ8E˝”HqŠšęâ˛~‚ËgĆ)ĺiČóÉ8• |:Żý\±źźî„€î% Š†'„íŇ<öÜ?T/J1“ © \I!¸şAZgcqŻCţűş ĽĐTvYĘ :¦+ 6ŚŞő_ń 4ÁŢŰĆŐІGˇ =ČŮ܆˘ŘëĎ ĘV* s 0‘ú\r#ç´sQ Öh>Ž&5Ú*Ł8L@iĚ2šěÝi<î®ČLvó°_ç• M%J±@ :ěiÜ­ëÎ9şX-®ĘtęÇ…†ÂÍ;vw«ë»mtvŹ™†{)I›€­ŢŘ»ŔĆ\ß «Ňçç{‘/Ş!”‡—ń2>”ŁŻĐě—Ahä©(łĐč/FĐloÝhűXńJ_š%ćť %k”u®Xă ÄBˇvM±ŁÔ®á\Ş]µR»Î9˘2ýőÔD"hä•qÉtXÚ´•ÁSë©Ś5|‘¨ ýTíqV¸šŹ2ë‹scźşżů OĂĆO«áÇô˙] ;GµĎÇŐđł®—¤7=Ż†ĺ gĆ|™78_¬˙‹§ą ż&îi)ă´{ľ”›ÜđI9+pţąrVÖ~V×Ar®%ěÇm‡ť\V vŮ=ÚŁLdw»üIÚ<ó@4×UŽ_‘ŹÇéWlńµŇäü§qGüô;ËSRúŚTůHôqŤŠŃÇQ Á‡x9í—Ăצ_¦“H“!ćJ^rE¤RreşŤovÇMn´MÓ\‡v[ŰX…ˇnŕý´Íť»hꢌ€§vöęI]ţőáţÝCś«‡E)#‰¸ť[†jů塝ˇĆL梿 łE)-%qu%_×沊ňšľ‹×¤×4ZĆŃ„ę9wÓYdK!"Żó1ű8â™ékŔîÓô5Ő©LţG‘oŇ„IH;™ŇŚ/Mö>΄ÓŐĺ›]š™PÖ‡#Ít“ČŤaĐN©ŘK„Š›ţ8tfa‚ÎĆj"ŹpÎ’87ľw˘”= «uÝőx—9őěđMŇŻľĄşMé!5ţB— pµČ?MdÓBÂ?4UIů•ĄOF#âThHŽţ1Îă™!ɦźˇ˙ ™¨`Úendstream endobj 116 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 105 >> stream xścd`ab`dddsö Ž4±Ä»».ůľśµ›‡ą›‡Ąű­Đ>ÁÝü;@€—1012˛hýčŕű%đ˝lăw†źĚ?kľ—‰Î^Ü˝xIIw•üźlŐĹÝĹE‹şçČó10U ·endstream endobj 117 0 obj << /Filter /FlateDecode /Length 2407 >> stream xśµXKoăFľű/$AČb[3Ă~±»gŁěääM ěÁň’h™ŠŇ´ÇĆÎţ÷Tő‹-Yă¬X 0űQ]ýUŐWUýq’gt’ă?˙w˝»Č'Ű‹ŹÔŽNüźőnňĂŐĹ·ż2>1™)X1ąş˝p;čÄŚQf&Šç™6frµ»¸&?Ýo¶ŐlÎŚÎŚ‘¤úŞZ=~Ă~-IŮ…I]®l7űÝlÎó<Ë© đ&i÷Ý®lš'·7/8ŮÔýĐŐ«űˇÚ\â¦ÂžĐďý + ě‡ß3¦aP ň0c°T MWFĺŕAWÜ]X]gó¤ć9§dđ3ą!u?ž‘głąŕĚ x˙ësÉ eşjWÍn®~ş 43R¨ÉŐĎWo®Ă9śs@=&—nŔMzĐUÁ/ŞČ“_¦(‘Ă]ŘS8hÜú‚?JN îfî·®Z¸7ę¦7'çĂ!Ń&đíěa×1˛­¬±hGőVN;ĄQ»x]Ľ'8†™–E!¬cđL.µýűl.™9ůć\xFÎŕ?ĄuAÉr† „…ňÍřs˝$szé÷RM¨[‡‚hşîv7Ł0¦„$ě›~řGő0sJŃ#ĄtV°<ÚâšŢx pź9ÍtQH©gsš ´/‰#ţ~GŽ_dJł é{ 4ŔDѵ9î*÷‘SCVe_5u‹#,··¨ĽŻPQ°`3 Ă]˝C›á—”d(›qËzßnęˇŢ·h,Ş­µ—0Úlü©&8†=UCĚŘ͸ŃzÎH\ *S559tűUąŞ›z¨ú°„ěoí˛Ş‡Ö"Ʀ¤›QŇÚO*¤ Uߏľ.M@Ą+‡şÝöÁů v¬' ®Täkďi9ČńžŚ†/‡j»ďęŞÎÇÉíľ‹Z†Ą'Áńr J'X÷ł×ąďˇ«6ŢmŚ!ߡ kfŔńć‘QŞ'ŕD€@±"Ľ˝o×h»%©†ňrtŕaÜ|—Ě ąË!87YŚnNß-ISµŰán Ž»aórö‚ă2hk2p»ßÇ‘DСŮo1b€łđ T}n2A©b©ňäßł«g&®Éę<ŞüÝ|ÄĂÖj§r8€VürDlWÖŞ0ëĎÂć}y84OK„"BV ”Ł`ężýAz¬e€aéô˝ţ€Ű Ą”“·1ţ!üGl,ŁľÉL„‘ÓŕČQčMŔáAeÁ2ŽQ’˘üDy.2•L_ŕÔ÷–Ž@ę$Č%ăIň=Ä!ń⽆ź˝€Wí„.ť˘'đ&5^ú™YQČA„}ćöCŽđĎÂ~">Ëô®'&É3Y䢀:Aä¸âRy!5¨ä¨?\ ˛»Z2–ŽFş‡8‚-•ăa %©„čřsňţ×L3ë–ŕ*HUk¬¸Ŕ˛Üyż;Üv¶°řpo?SÚt\…űŃO-WY\ôqýC…4®ţŔÄ/Ń=‰ŮĂą'r»™‡ Ź'C żŔov˝ç·>쀬0ŚsŽxí)¨â}wŽ¶_‘ťDHÓ1;AE¤¨¶Îz…‡ ţ¶oš}Üř r‚·ěżŢű ýoězn3(Ö%vY.ŕîóč¨FÄÍę wq']Őß7Q …üŃYÉ™ @#ýÜ9•Ť ä“Ë[–ćęvĚg?ÖŰ,| Âł/g’s‰d9^ö„řx€[dŰ®†@÷©*0eÂßH1„}1K#*_*ˇň$Ń1…|ˇKř/g »1q’ŔúXYŚ§/|Tk<  nŻ‹3U«Î(răĐ[®±žD;aůRpk+wǀܟźŠ¦Ť¶oŞEÚQ§ŹJě\ɉÎ*ź˝,ą3a8#ľĹfÖÂ]Ő>îtÉŐx:tŔű @;ÄkÚů3Z/µóçŠ0¨·€€ŢŘz*&Łg•8[ťďšb ŹM`,§$Úëy–!‚f:7Śž‰®ăFĹÔL–ş6őWUWµk¬ĂŘ*Akpf‡ŃOńͮ§<¦\‡ú÷­]Çă> U4ö-Uą~$•ëN®:ŽŰEˇů”Pŕë­’Öüu4ŰUÝ®ăóR8HoW;/ŁĆnů>­Ţ—ťó»te»­ŢAiO [•Ł 3ýł°W®±v‡3AOJ&-śňýţDĎßÂâţ„|=(aé Ňáv^0éáô9ő(XžgZÉ˙–(„ĄdżŘ]CXÝ-1 lpż˝} ÇÖ;éJbXhąň~F\úĂ]ÝmÂĄ 95Ň,ÖJž Žcäz¸#K »H껲9ËMĆ4=!¸gĽáčäë®<h4˛˝Ć-5Ży|o¨˙ośň‚Πj2‡Ëä"gv±Â…ďŻ.ţ ˙ţVú7+endstream endobj 118 0 obj << /Filter /FlateDecode /Length 1846 >> stream xśµXMo7˝ď_če/EW@Í’~Č%@[ čˇI ô`ä ŘŠ«Ŕ˛YIšßÇÝ%9+˲ +­FŹ;äĚpŢ<jĄP­L˙ĆĎËUóËÚëűćSŁŚ4B©ÖJm…Ž­˛J ü¨Ś‹B»v˝h˙io›‹V‘°ŇP«5>˝jßâMWŤÁetűµQí+ü˙ĐČöĽÔÉţĄÁhˇŰUŁ‚’émÖ‘Áµ7ŤV€máN Ľ ŚE-zCÄĆdŔbţn^§Ke…Š­qäąVEc„Să§Î;–íuîŹ<~\®Ú—ç8ľ¸Ľ»ąšťŔKśo˝ĐRëĐż[UÖµg8ŞHń9żj.ş—ËÍf±žť!¶R†îvqß®gQÄHŇtóÍňöş˝żśß,foĎ_5igi7 9đˇ°Q¨ĐoäŻőÝ»ů»ĺÍró-ą˙í±x"řcFW,%Eň!*[LDüĄP9o5Z8Şä˛z-TÉoAŤ– jkŻu÷őXb·r’‹ÂŠZś)5+¤FÍÎ ’ ‚ît}¤ţŃ ;S­¶OOóz_|ľŻíŃâŚéă7D÷ŠpŠX Y%|d Ń09M"X PVÄŔ@ŁśrAHö¦l€ĆĂT;ÝaŃŻŐLé^ĄŚŠn\Š>,¸Ľ°xÖěŮôĎAĆÇ~ĺ¬&äőáMě‰űB’„÷Ľ[Et3éVCmLşUtBąi»Âíb~‘ŽŹŕJ´“ˇaoJĄ60éŤë=÷ćťÎqoĘ{Ajâ-FaÔčmđˇ! H™ BĄâÓÚ™T+Ů2€wwôĽĐ—=_;vź*/Ňéc˛j´¤eű:ňî‹«)•Ś‡ď ´¶CéĚg)rAűî˵h?|ľşşgÎč¶ýgÓŮÍżíŹg›ĺÍbüÔtq‡±TÚv<- ’!ßßfäN¦ ýEëëʧĽ…“)Ü Ť,útŤFSĘ+*-Ń  ŔPꪯ†±D§»=ĺAý|$‡žçÁ‹B„ß{"Ű-î9%¦ ĐÚ…ľKśN:/ĽD›µEµS ~ťŻW;Ő T.tZ5ŕ UŇ‘r0ç´ Şlár°˘ŞíĘNÔ K•TVĹRA9»T,´µOľó:N ę¨ ×ÍI” )äSY¦Ń ¬°f"¨jTŮ0zśfŞ+& —.#yŮ0E0Ľáo d0¶§ë]@Ů0Ť‡© vşă” ŠRŤOqćSŹRź:L >ŃÄž¸- Ädą¤4„H.)bâđ\žvšiłÂöŐctQ˝ˇžĺÄ›rNĂ˝Ůň§łěÍËX“y3Ů)îĆXôlˤY¶  ˇ*â‹GË^9ht 9ž' 8Ő»đýĹŕIYpśtPWŤ9(*śÔ°1Ee““:ćaD&>ć ¨\bĽm%8eŔ“(Aκʀ{u`O†;u vpßO«ŹŁĂś‡Â)%¨Ś €ŠˇđNÉ`ĹK•¤VoĹRA9ĎT,´µKľď#ą0kŔ'ąđp XIn4p®Ř¤g *DX@Ś 3¨a1&Ě B„Ä0ołaq&Ü: Ď„Y~_*<¬‘=Ń°ôŘúK}§ą8hŢł,"Ę•Éoµ¬Ôµu|„/Ş/›Ťű"€KN¨/@ w"Zć,ő±a‡[:°’`Vf‡ŕ°´P`Yş—‡E™Ëšç`Ö;đ¤:pßÎo¸szBŐ¤\mĘJű}yýy˝@·đ„¸ÄŽ~ťťˇ]cüÖÝ›ľąçßL÷±´ďĺâ>™ťŮîýÝzř"•ÇA‘Ô“v_f(Éčlěëůő"Ct7ż˝GÝ-ţ›ťáBˇł9ÝmÖ‹UŮ‹ďúߏßUâšüÓá¸GĘĹŘ-X¬·3Ý'Vu›Ľ –—STÚuq}Âv´\Ą%ă×Íü¦Ď†B[G}6Ŕ W8čÝí˝@ĚUúĆ»ł¤ňśŐ‰»PHěuó?In'4endstream endobj 119 0 obj << /Filter /FlateDecode /Length 117 >> stream xś-Ë;Â@Đ~Ná2)vöÇşEĘ@s ¶Čý6!raÉňŰÔöś˝v řČ&v¬8kí¸»\źF4e­ţ–ż0-·´‘đ.SÖ­1Íţ,&p°XƢL—Ěţ’‰űqqyŚüąŔendstream endobj 120 0 obj << /Filter /FlateDecode /Length 587 >> stream xśmR=oÔ@íݧ˘Ů Ť^Ľß;%Šh,Q s·9ůŘ$řő̬}$‚Č…wgçÍÇ{ďNÔR‰šżíżŠZŠ»Bĺ¨Ř~»Aś7Ĺ«+ôBYi¬×˘ą)VR+Ť"ZFDŃ Ĺ¸Je-kccôn_f>[cĐYXă.`a,«‡¤Ýă—ĄüÚ\P{mJôÚsw­dTQ4‹ćµkÇ}Ű÷/ËĘ ’µ˛p!éÎp #^—qÁhˇůžÖgŚÚ±íĺîŽĐÚĂŇ-'°é†ĎQ"*XŇH/Ô FoaâU0jo"/faßŰ =|+u l9…kňre‰1Ímß-i˙wŢľS;o×:Â0•U.RSńÔËŤŃA˘HŹŽiöD˙y7 é8w»Ňń´^CŰgXeŚ—ÁQ)%I‚°ćßN÷3±PV–žyÓđ綖Ć}jÂlÍ @ę, YG«ĺiä„ŐěNoĘhx ÷Çߌőž·}ĎB9JDKJě× Ĺ?sÜĄJÇ4ŽégfŇ L‡ţYĹEżŠKžŕ*l†iŕ”‡KĎŇŞyčƇŽÓĽďňâąkíaN‡9-ě†MŮĄ›ĆÓPřŻËÓbx-m +Ođf~ÜWesKä;-ťvůN­ÄŰ#őX‡Ů4ź8´»OíH‘hŕůşńvuXNÖđşÔŽx!籏łw­rŮćZ?%Ł"âUt˙ɨŔ™pć¨lF© 5FQ9k¤Ă<+¨š÷x×—ôý ü†endstream endobj 121 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 957 >> stream xś=ŇmL[eđçR¸÷©Cć¸6Ě·[łÍ—L]@Qc4٤ĄdF fÉ€Áh`Q¬”R %Ąôˇĺö ş-†ÉË•şŮ”4đEęĆp‰:ŁÍ$f!9ĹK‚—Ĺř|;χó;ůźCˇÄDQ”Ľ@“U”‘™™ľ[ě'[ [ůI$YF’=˙”¤®ě[Ü;÷Ú}LmCŁ®˛ęBą¨"5Ň ôÂRÄ :t›˛SŰ Í ?ÉŞw¨ZJŮI¨ÔŤď ĄFŕÝĂoBÉf‹ÄsşA†]¶×(ĹU†Ťeë 'JłKŮPFŻ^űűÁ˘ëNěôť †„{† ~şĐ[BT$»ôĽł10I˘ŚN١ľ)’ÁţšPę8Ľ}díČú:ČŇŘĺń˙¨ď˙§–Ąžý%dÂ!:ć‚ag6[ͤłËgG›źŹŽ}­Ę>Ҟȵp‹Č–$‘ďĐĄć¸ę‹Ô/— %Rą”Ć®mL(Ćëf:§ľ˙ë䆲ź±-–Miëýu}z^çQůÉ<^¸10s}ţśÚËYő"çˇxţ‚’]w;ÜüÓ1Ć×Í[ZLM¤“3“ó .ŁËŘk$8ë%ȼɆŰfĺ”őz+ÉĂďżcŻŕŽůkÂú{vż•X6ۺ۔b Cě±a‹«Ë?xĽśÇíĺÝ, ˝¶lář3aę*02ăéŠÖöÎ6ŇŚëk'87}ĺł1!&>Ů[ĄěˇóI^[i•¶\źCr°Č=L‡go­ q.ŹŰOĽŘguvq]´8M]íMŧ‹ ~ąt’îúAűFFş»‡”’ą)—L(ŕč8Ě÷epšđ-čó úxC|ődˇéÓre὆h°x¨×»ó[h5Äőö9]¤ű,|‡ÁVßfĺę+ŠšŠ‰– 7Ě"Žir ‰dšź®^—&¤ô‡^9¶+çáÝsCQŘĎI—ŔŢ„„xľ"K·˛Ťm=3Ž 1*â?éţŻ?Ľ^‡ĂÇŰ-­RěďŐ#çBÁ‘áń…“B±&˝1KĎu6’R/Ĺ(Ë8Ž:B†(L† M…çáqŔSi¬éĘ–JˇŰÜŢ8 {Ń0 óĂÍOŢTŞv.{ř=Pµ Üňp<ă·űLg/g ÷ńÂköŃîŮ–éSc&źŃgtř€3ŔßZš#ż;ó Ç•SMp†xWчĚůŮ>Q2¨wV’jRf-?Ł×5žę9Mp ÷¬˙h˛ˇ°ţÂ@endstream endobj 122 0 obj << /Type /XRef /Length 156 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 123 /ID [<99ab31e5d549c4f2a0885b5521b31216>] >> stream xścb&F~0ů‰ $Ŕ8JŽ8ň?@ ›ő( đ‘> stream xśÝ\és·˙Ţżbż5ťŽ÷ŐIݱĺ$v|F˛'ťL†"—m’«ËŘé_ßß°ĹC˘×”“Öô ‹=Ţ ¬,xˇ !Bˇ‹ŕEa ˇPŘBď Wxá ©‚+B!­ÇĽˇ˝ÇK…ć–Bšn UhÇLFř…±ř#la‚Äs®°Âăľ/¬T´é¤Vn9-E˙Î8´% çµE›…JR^4n ď4!Qîp)zßÁSČP„€?  9÷şP'R‹BIś¨ŕ …ÖąŐ¸Ąqâ9n?Ś+:†¸…žéĐIę˘F+ }94ş‹€ř’q Č@ś(´ŕBš˛Ś˛$Ä4ŃHąYIŕŢ ‡ ©deťĺh@]@š‡P˘¨ Ş0€¬5‡ľ m=Noă@642€l$°2D ŇĐĹa°€lZ@6Á˲Ł ČVáIKŁe4 NHaŮDzC 4'śâľp4¤†c´ŮYŕěŮy°€dđ®dOĚŕŮ+t'Ľ8O‹ÁĆIµ bEO̡8Şř/‚ÂÄ?!€†Épöy®@IQrŁKpâŔN@Iňř0¸ŁÄÁ88‘€ß4'–xśÁ\€,Á7Ed r‚˝p"‰żY*oţňĺ—{V5˝AŻéaŢ`ťěĹe5˝ßoFő´ř7&RĽöő¨)~Ć­E3M«9qfşń˛w^=«UÁ^Ď«ĺíxyŽąźyőű%q}^Ü»›˝żh.ęYńĺ°97’s ·”¨ríq.ňu\°Ă|]ć¤ű€D(JÔťNďާó{h}Vő¨K{MU|ńđ Śĺ; ‡ňď\ü•óżţ-?ĽľxÚ{U˝)ŢŹš‹âřĎfŐ·źTżżŻgy‹7áŰ× ‡?p¶}ŕŘOxZ•ű0Če?÷+żăěUźă˝ÎYľ6HíضoýÔ·ľă‡a:oqjáÇwWńâ+đô,•đmź]âEíÚ|ܧµwŤťÁ ·‘řĺ¬,úhüÍ˧Ĺ7őĽ™÷gŁË\UrUrÖeütbÚx-ź·řšÜ®áą•đŽçne0vâuŻť]ÇőbÚČfOFŕÖvŰř"(—.–$•S©óuźë&—éyx.E.e.Ű÷!ýs+ď’lĄÝtZ74"j[rąĚ@th×Ó¦šâťCPF˝ő@ˇ·M0%:ęµ(ˇ~¦g zzú¤š×‹Y(Pű_}hľ9mhbBÁf‘ŽPYŽĎęţiŐ6{ůđkôˇú@˙Ţ˝ŐîlôF&t3ťU¦O;ú©Čc•Y(sH;p™™¸Îeć;ns™ů”gľäíxđ\Š\ć!žČđD†'2<‘በŻ”<*2´l‡Xfx2Ă“fË(ąOĄ8$–†äAo^Ĺ×Ů›o<}ňŐßź>;©'˝éĂj2üč¤:_Ś{30´_FÓó",5űlŢ_ŕLÄÁĂ*‰chÁl<íĺG(D˛ą‰í˘E&5ţĂhĐ\Dyçâˇ~&˘Ă(»8"ńJśé±ŤîäóÜ®ÁňĆŮßŢ5Z¬¸Gň(–°ô'+6˝/őß`řčĚŻéj{—¬feš 銑íó?/gĘĽOŁ áMĐĺŁjt~ŃVAPŢ/Ř}ö€łoŘSöŚ˝d§ě{Íľg=vĆúlŔ*6dĂ!;glÄޱ1›°)«Ů%›±9kŘ‚ýĆ>@KҨQSG0'1ăŢ9Ů_qX´ěďĚBŕçtóëѸ‚Çăý•TxŢ›T·ńŃcsŁţýé9T3:ól4ź«âđĂ“!.iŞÉ÷Q´®0Č kmđíëWOžťž´ímçY»ÎłŃ뀳P¸bZ Ów?¦Ő°üéHěA ­zĹ/ÄÓqśqxŐň·r:–tĹąÄ+ sťşë¸Geäť=™ań•gÄ`ó`ô|ś Ź%/ľ•˙@÷t¦ÜŁw,äT€¬‹ďPĎRéTęC„aLx~Y±Q ®t<łür˘ëą6Qb}ÇT1q˘Č4Y@–ö!@%É(řüµB붚%«}6Dą.BĚň}Ĺľ† yÄłoŮ“(Pžł*ß±“Ą`ů˝a?˛ź `zëMŕŰĚ{ÓA”6ýz\Ońw2éEÉSőú‹5ÉŞÉ 7ż`Ő4ż.ză$š†Ă‹˙¬Â5h´(®ŕ7]TSH­·Ką5…{áUÓßůŕ\˛KŇăjؤłYl XQ·©Őö+űuQÍÉĂIÝTłńň$ľÚVŇ۱–NIJÎ!ĽR×ćŐoŔh>úŔRë k.fUĹš÷5$éb0ŞfŐ|4‡L}Ď>°ßŮŘŞY}MĽá·‰×#ÍÓ]ČŚÇgMÂ&#cEÂî–xűJW#ö•®ÇĎ_żůîŰ•¶ÔăÁŠh…śŢźÎGW®„¬6›B6YF+–I⽄¬j54¬řőcóęĘôĐô…‰>m: ËÓ¬ ąőź†\'ŹDĂFżEź[ř×&cŇÝiÚÄé§BbKnNěŮ2ĺ*;®3žXŞuŠľń ÝŽű&ܦjĎ^Ű ăí`†}ąfđv®co2A44Ň ľxđćÍ‹‡+­¦öVő{¶ˇWlR±Ézzťőäľúť†ŠN.ÇŘÂS  ž‰ćĎúOÁďĐĺaYWĆÇ’G`íÁsťŻ\OO­¨đŻĂ°9ĚgLaI#“ćŽö"[úšěU‹aôÁĄ7¬‹ORéŕnĹ#A {8BŘ6¨}my<ÚóŘ›\Ź=ÉuIÖ <ˇH‡Ś{|t˘ž+ř»FĄg-,M°Ą{ź˘¤nVQ˝íúh‹"J*čJýÜ®yv«śVŐ\ÓMÖ]tĽß¤hŇlę„HY™š;'Éľ“Óú}U›ßťśś˘©ÓŢtľŐŢľI)Ř-JÁnĚL±çĚ´Äćt¨UvNć/ý|VéľŐ6»`;…7倄»6%ÚšŚ0¨nVŚ{eŻÔž6X›Ü kÇęk?Ž±1±ď8Ź<µ†ý~Ý?3-ł`fm8h& żĆ*rťUvŽßľ¬B]¸EŽ[ ŹžÝ‚vźŐÓúŁůFéMľŮ 3ěkLŠˇżéěęüÇaˇí†Ę·Ô6˙~Žcµ˝ő@á”UŁGŞŹń@ZូřóţhÔŚĆř s·ów¬×`ÚśőfělÖëż«š(ˇóy’Çë*aPŹÁzWšˇuJ˘.H~Č9etŞŮ¦VWóůţŞaŐą/ć[]’ëÖÜVc:€żŐŻgŐMúŠľëNFşK ™ĆcMF¨ ±k®îmë™[e„–KF‰QĚSx6'ŹŰ×r&1^úâ˘i.ç˙`ěýű÷ĺŰyÓkćő°)ëŮ9ű[Śk>¨g OťFey+0ۨňxSĚ´OAQ!}éaŁ(­K +HşP:đ¤2®Ô<>ż!OGÓwK„(x˝”j;Śô—šĘń`öćÇź@y´â E¬*)«SLăńr2đRPjŘŮRQtD{<3Ä%Ýąe=ç#tB#gMtN†ä\JNˇäĚINh$Áš“ 9đź#ţ&A1 JÎĽĹ,SWńíś»ůôř¶đ9ňÜ-ĺŕäśr S—úëR]ęŻOýÍIźú›SD>Aɨä KáçPhö׳÷”-µ¬…óD»N s µ”î˙˙éńă‡ß?o-ČÓqoÚ|Ľq·V•n—{*é6^ąô„ĚŇ˙ĘĘĺu“Q·=É÷Ž×ď Anz÷ćz´Ţ¬*:RsŹ˘b;Y‰ŃßžÝüł;Ěż(Űq7Ű\“ímě{)Űoč}%ĽŢĺ0ÜěÍżzúíß®Xź/ÎĆ#(Ä}CJ›ą&ąá=ěRZµăw˙ZcőZëaŐí>†ő»ĂD›^Ć®ZwËŐ6źbÍ]Ţô)ç¤P˛žÝĆ­Y±ĂݢB÷ŻńUsYňŐΑÝ;çs;Gmó+~|vňęÉ˵„ÓDZŐ6ąŐ=‡y=ăxÓĎíŚJ¦ěýÍFľ!Żâ›9»Č—®î™E‹á\“UŻÁ6m1I©VF‘„ZěLnsNôßbÜČŢ<{[ź»˛‡+˛É|ş-g­(ą6;l9%CIÉ3WZEimIţ)ósOKîÎPs˛4aą`aűú»@.Żzą†ś0Á•ŘśđČHt!!#˝-Ť§Ŕ'^W{čK»Ď$9e§™dśŮdśĺuB6ˇWűŘd°ŘĽň)i› ä@6Aq Ęuk.gk>Ůšs]ŘÜŐHđ‰‡yŃ tEI1鏒=™y r–8€ËČY “U ˇmé`ßC—VÉ?7ad)á,‘_'·ďąmR@ęR˝9ŻKIÖ p˘%O"`ŢAqřš"Ĺ˙8Ü$$‡ýŘ"'Ą*˝˝ä¶M…ł[B)WrĄˇjiiI¶ŔěÖ´oé?ą Jň•[䤰e€đQČí‘9>ą˙Ľ<9şśŐ´î¶cHFĽ§•/­0~dÉI)Žúľ_”ő(â)8¦bPlô¶bD«R(©>yÉ1,ŽrL`bČ&č¸éŁ$űě°Č÷ú˝­J(ëĹeŮŻ'űެőÇŐŃĺ`ž0˨'Lx 9¨.Q˝ÄÝCct(Ű™{g¤ŚÜô˙Ń»ufŕ‹Á6Ł‚’ľ´ŤÄůŇíkýQ|§lš-ňË‘ů_@ľ%Ľ1%-ş€˘+Vŕâ.ÇĹ˝¦şPY”îÉaéŃע•´ňÎĐÖĐ8ěřńóňTrĎm‡ ·ÁHĹ=¬ŘÂĐV%ąűĚ"őb.<ÍŃ·óyů0/GĽŮ'K^-¸Ĺ;ZňGšL‚üŕôCăľEˇ]öúď`d˙ł>O>t =DĄ0´/”¤Ü$™‚ĐJ”´·ëpčűzv6jĘAł(ďŘNöś )iwŹg—éÄ/'‹iőËŁŢâ¬ţeZ5µ‚ä%m9„ž¦řu+z$ĽÚtńżŘĄ,‘¤ p:•-ą¤.Bhě›Ú›ÉúłŢ´śmg˛Ů`4퍻$¶ś.i;T2Îqb4ęd«1wjD ËŢ–ĂşP•Č%â~,ŢA1ĐÝC´ °–ŽV@CCĐÎHČ€;í—l>š”\h!¸ůx䵄~ ť˘Ú”´ăµť¸؉?7öy~á´[–GOKh ĺÝÚĐ´ßď(řđ¦Ó’ÖčbC-AÜ«BA±qÚ?Ë]üˇ˝žu‹BHëĄq]t/ /¬+µ…R@/\:ă°ho¦ĎS’A'w‘6•&îi‡ 瀹Р…ŁE%eK>ŹEá`Q„.k żČf&{“¶I[S: âĐŢoÖ o vˇ7m ˇâţ÷;Ŕ{ťÇaŻŔîí WH„SŮHHEí(©ČFůŇëC –ě·ŮdŢY*jHCÚ±Ł@ŽŕhU+ôÓçbó ŔćşĺI’•/ R•^ę#Ť‘ŕĘüą‘o Ďż„ĽáŃ Óţŕ.â \süúA‡‰ 3†>$A" d ÷Ë÷8 €>¤Í ňçŐ´šőĆő|\M:t#ć`{0 đ7\RCWňĎ&ăe9ÝC ŇÇD«8ô°ÍĚg‘ńЬ]đ†)“Ŕ,‡Y#ow‚ř ¬SM&UoÚAb “=~&E”ŇŠ¦d]—·iVŐŮ˝ěm ¶ˇ'Č“<—řU˛y“¦˘žD{~Ďi{{¶Č;ż©bŠĽí›*ŽvK§Š E{ŠÚS]ä]é8·…háЇZ0!~LÎ7ÖB<|yüÝÉw7í•ąi<ČŤŚyţvÂĘ:zhżĹů°Ă7{umÝż¶xVťŹhQo5XY\°cŹ &˝žZYYU`ÚoĚ\­*ŘI–}€nÜń©BNËn†¬‚źí=­*§’f×’ąp0ÎisŮťK9MîCčŕ>hŤ¨—x·–Éźń¬Vl1f Ó8íž°ÖęóIçE2švsQČÎÚăMQeúŕVČŮsY<Óvů{sQOéC=Ő b?¦Ý™Ĺ€ą)ÍşĚtX(qh3öPH·)×’>㦠 ŔŮF;ĘâŢuŠCQvŚw(L* ŃR;úÔ X0¶!bĎ´{w¬ĄwÜtŃŰR”B­¤#‘µŃĺĘC[ŰóĹĺe=kĘyoS”şż@OĹĎ„±ţ`ĚhŞ‹sÚć1靍+f…łŠđ°A5ě-ĆÍúăđ;pÔ9ÍćÖÁì>xĐúĎÔń<ąśKMý‡qŻí¸5¨Ö~wÇݸ2Đ')żç(™Ç6ܡyL_;cľćRTc:/ .ă´»7ëĄtÔˇ•ß!1o•ŠSĆđ*XIy,wđâz`ţl4yK”c¨]§¤H ŕů°6X:„ĂĚ#·ś>buxké“WôQZI1…=GsĘEď;@“ZeĆ$Vzq~v¶/`K”q×z›Î”\rhľţTd۸(jŁWMY?úfYÜ(v·s08ÄŹ”wGR8nŹ:¨jŠp‰;Ö¦mx° 9ĺČś/Íťđr$öŃŰz1›öĆ‘čyEQyŃLĆ˙Ę•Î.ąďŇ!ZJ Śk×ĐuÓfw›v]qĹČ:X{’Ó6CąLšaÖú^ďÇ$ÍöŤwú~Ľ›ŕÇ ŃŤ‡Łá°šUSZ\ýďř­şá:–z˛|® 0Úvłú1ˇâúׄâGHŇÇ&Šü퉶}6áÓůľf¸ňéáv{Űű4ű_ÄKdąendstream endobj 98 0 obj << /Subtype /XML /Type /Metadata /Length 1552 >> stream GPL Ghostscript 10.03.0 ordinal, cumulative link models, proportional odds, scale effects, R 2026-01-08T22:26:12+01:00 2026-01-08T22:26:12+01:00 LaTeX with hyperref Cumulative Link Models for Ordinal Regression with the R Package ordinalRune Haubo B Christensen endstream endobj 99 0 obj << /Type /ObjStm /Length 3615 /Filter /FlateDecode /N 95 /First 893 >> stream xśÍ\ÝŹ·ď_ÁÇAx$‡źE`Ävę&€ťş¤IřAÖíŮBÎRp’‹ôżď —\‘»”N˛tIË]qÉůž‡Ü“B0Á¤ĚŇE1ŻŔŔ^53ńjstµř‡ĄpLB|â™4†I'±!qś`%6$SJPFőř;ţ¬,˝%5SŢŕDŇ0Ç–ŃÔÇ1°ipÔL Ŕ •`<¨$Ó–^WŠé`°Źfd|‚Ć)”aĆƆE$őqČŁG”gViäBf5Ž*A0kĽÂĘÁibN1,5€9^‚f uFa¤W‚eÎzË1ç=ńĚ  ÎyEBŇ‚yMťµdޢĄVĚ{śY"q>8ęŁY$AjĂ‚! µeÁij8"Ú“’â@ôDR$b„¦Ť¤ýbi‹îŁRŃ`HaŢZ%„/ă˝±Ô"ůGŞ ř‹!=Íd˘˛}˛ ¤ Ç‹*µ¤]«HMńWŇe ÷,‰“ô*-iÄ&iFĄ<ő#íYŹő¤#˛)K*±$}'H9dVŽ”ëi|§¨EĘ&NA˝N“^Č✡‰>J=rN’Ks8O*!Č| Ô<‰WĐX4¦Ž´‘Â5 Ę%ŃŁ5Qę5IźŚĂ“®ś˘~$uOR¤F‡x’R´\2lŁÉŔiÂEäďHDŁ č2Ď‚,;”@čż|ő»zľţ¸Ú2Ë®^,ď7Ű艂ÍŘŐË9ݡ‚âÝ˙ý­cW˙ř¸˝[®ş {ň¤x÷K`WßtŘűfúŢ?˙ëß Ůi¸p(ÝŐÇ»;öf7…*§@ąÇ»ď»ß·ŃÓăÝëů}·˘{‘Xnď:öŐmw{‹ a;!śĆ?…m|f©mđ ýsŇóîI&7i+"ŤÜؙ耲AľÖĎa-Ű2Ń„´ŕeh;›h˘¶Ó„«¦J÷NN¨ŇmŞ^ßw˙Ůɵ˘‘č‹4d™t=Ťv‘čéžxy›ÚnG|ß&şŐĂ|¸Š râĚÇʡĄĺLy’j¤gvó$ĺJË;jI‘3úÝšHśĆkäćÉČÝ^>8n¦¦lKS–Pš˛+KT,· JC2â›t]Ô¬fEDV…Bߦg7;g°é}c6ĺŔ¦ P›ť<?eÓUë*Źő#6MËSFş(tĄeŢ&&BmĄŮz^O}T?NÓ˛Íč¶=DŢööĄn ľÝ /ŢűÔďv7Vôx“Ć0âŚĹ¬´âAű†WŘ–QśB—J©o~žĺ[x˛-č·fJł®=٧ŃĆ)´µźŚü ?Ąá”gećú:ŮXÁ˛4˘OŠôů}$źh0yţ1=Óxc×y˝ÔIÖ8Í•°ľĺAľĂ>˝ČßŮw¬Ře¶ě›*ńajú+~ŹÓôhn}Óć·ÎŚÖ:ĚŚjÂŻ:ÄŻlˇSÄ’9¸Ň?F±cČćPřߢď÷0íĘJîÁOhcŤšö&ň;} ňeőŚŚ\ÎâjŞ‹*ĆfŰÓ…}Źbč$FŹÇ0)Ć$[d:‘ QŰ1 Ő‰µ4ZGŰť%’çćĚPYçyQg’:Ö×ô Djš:Ą©‚©Â8xÖˇ•H#ô˝IJMěEe{”ÓÝôNŰf—Xm˙tÇ­Ť*Śn =Çb…˝bUŢ´PS±ÖŔk„A2ôšřLĺfä¦×˙8Ü°ë“E—}jśŹ†ˇŹ‰ˇÔČ×$—ŇMâI±‰ä 0˛Rz]’H‘-b3Y˛Q× zŮÇş­ăAaś`Đe¤,c†=J’JBF­•nŘ"M‰Ëśałľ(ńA#:‰‚Đr‚\• ±äGJ”~ˇ OzśS«đÔô1ťV‡1ć7,ăq0Ň)ˇ'iÝíč$?äKsŢLóx˝cąW“ša.ŮDYIH6|č©{, ž.­@Ś(a"Ő–HoAމĘ@6{I×GăK _íÔ¨]yÇu vĺŐ,4ôYé=ÇdHú”˘ĆE'đ`GńZqˇ&hVé<´đŰă#q{p ŇäÔÍAÚ[U*s˛\ń÷ĹąöµÇ.˛˛†ŃĘZÉ­› eĘę!fs±…Ń"©qÖSĺa1*ś&˝ŞśĄŞ¤{‚xb«‰ÉSÎE—ˇ=Âĺ“‚ÁžPlŹSŐŤ -7zjćŁu‡:·ěä ř}Â@ÝÓŐj˝ÝPŃĆô’CĘ[mqň .ś’Ä_u7ËůłőďŘŹAUžvŻ¸´J†5ë6ëŹ÷‹nĂh†żýľýűővľíâ.RěđbM¬™A}ëĹuG2şzýÍ d•ń Ě{Żçďşq‰IŐŽ µG°g¦`op…ŢFZ`ŻLkŃm“mdP?€ý\Š‡"üĄg.4$jű$JŰcSÉŞó%Ű‹ŃŞ3ÄŁ•~ĐÜÁçĂáÜ×4Ń1–*óDs ˛§2\ěÓ ńˇzŔ d¸¨ůZ[šŻuź ÷ɢšv“«šVLâ"čj1૸©Ž…&Păłśrq1§‡¬â0)Ź3š ÉÔ´F© šŰM9ꎪ+Ů°†8gÄn+)ôvůçĄN4ĽS_Ôpś, Çťĺ°ŁłĐ¦ sđm©&‹h.ĺNŁÍmŠ¬řäśj‹ić 9›KEA§ĎęZÉuąĂ»GŚÍ¸7Ú“­v7$ý»§űëśZÔŃ[[››b*]ź8˘öúź+ 70ŽD—vňࢧe˝Đ‘ŤţęŇŐ§khŘŽ˝”íxq†íčZ„kQý ŰiVJ8YîźĘB`eć|ô˝…é^^ [­Ç0.'{ŤzĽORףâ=W3˛‘[éWŁő¨×˝ŮŞě©îţëć6†¬ŹŚŢŻJ<Ą —Ĺߤ@*á ž“Ę!&g(R‚OŚŹ7Éý\CѬ(‘§í+ žš2˘Js °+GďÚ#÷U Tz€©QëŮúČâéÄh˙đđ‚ŘýŮ|ÓĹpőÝĎĎ_>›}ńňŐő|µ‘âËgë»Ěé«ĹúfązÇ®~Z®ž®6ËÝhiĎßĎď™W}`Aa.î—żm×÷ńÔŢ`€C§ëŹo·1®Pt‘9Čôó˙´ĽŮľ§ŘčÄľ"ćfAr·AŁ3Ěű¶[ľ{źoqT ^ź]Í>ŹŠŚ=Žw7·aÖëűÁźí‚Ą5ß~Ó˙ňby×m—íŕĘ÷óÝ>i|·ťß-OWďP÷8Ń«ĺf˘”3r«ëm÷áź,¸’µB*Yčëű›î>Q$bŹ7˛żÉ6Yl>ŕN!nSęSlß"QăqĹ­wtäÎYIŔ7ń _Ŕ4sĂ —ËŐŻ™Ę–N$Nµó\–ٸ"NKÉťŽLÄiĽj:ý÷AśĂ_ű#”‘8Cţ/ŕ4âf(pÄąó#Ěó*GŰY<ßjňM`ÉęfpBn˘@dnÓqÎܦ#–©MG+]9K[*2ßdđä‹]©—gt.×{ftHZíî z@®´ÍčŻŇĂÚ˝2yŔ±!Żűg€+'Č+ŤŇN?Ń„/µpOÇÚQ”Öjđ€ÁU+DĽ.$C…3Ŕp÷Řüv®±;b^Áé,E[ ął'Ě€v­śátf^ÉŤ8R źDh:“Ž  jy€dŕ{(dĽ\h¦µÁHz¤Š.bÓhzřmdáŘÓ ă°÷*\—aąĹŐ+4ţ ­,żé,‰ßśľh{8‚ś'öKQa„ą»łxçš>äCç„»ăŤS©29ÇrţsŤ!śo Ióź˛o0’\%źQC‘‚ő rUÉ.8„ ôÁ‰@lZ‰­q†ÂnŽ"»Žă.´ ž”ţáŮ’>Ň’Ă쉶-Ž2ź6Ŕ;d<ÇÉ÷Áó5´EŔkp’z©‘ŠÓwZŕf‘#AÜ óL[:Ę@ ç÷.‚,&đń4}Ś§=ú›ĄŻ& Ą}‡ÁĹ‹#AĆŁŮŞRÓ7‘™8:܆°ń$âŽw°O*»Şłďą“ľ±3‘ŹĄ_ şü);ŹĄ sô‘.8‡QľADtŠ€rÓ×˝˛]Łéh9‡ š+Ě='wlŠ;†9b]۸\9Ł°×~™ŽçËt[¦Żµý^ŕäFożytšý…Ô—ß˙4»ţá‹W×O_Ńء`*s@ŢNµťN}JžCá”:M §ëWK·Ł|Ţ÷o×Rť›ÔR¨˛–ÚßµÔ»nłYßo––wóű˘®úĄR6—Vő¨¬sJƱęĘjÖř®˛:ϡ’ŞCI•ľŽş@M>ęŔp+÷Ő ”Ä€a‘¸±Ž¶ ąĆi‚ÂŐńEăéÄiYáň@ś˛ôÉäiÄ=Ť¦Í®~ś}7tXl—ëU˙čłóĺÝvý×ŮÇUÇżť|»ţú=â‹ő‡ĎŁ7ěgO6ĘbH*}˘Ž_XÂŮ–ÇD éđú‘č’ż~ţţ~ąÁ ±éV´®Ćör±á7żžN»Ň‚÷ßŘGҵđÜÓ 8…ôGŻuTËŰCkvŁMü˙ŚĹ.˝;Dß,oo;Ś¶^‰q¬Š.$°^BĂ+8î˙˙«áWendstream endobj 195 0 obj << /Type /ObjStm /Length 4509 /Filter /FlateDecode /N 96 /First 905 >> stream xśÍ\ks·’ýľżwk+Ŕŕ TÝşU~ۉí(rÖŽł•´4’ćš"yI*±óëďi3|ÍP”-É.Šš7pĐčn4Nc(Łc“Ń3­¶ąŠ¶‘lUU±h,¶’IŤ“ŞRLzO;šÉ v nwt÷Iĺ°Ż ô”gĘşEŮHĺá>oéĆŠ©HŹKÉtĺ= Ę`G3­®KĂ´ŐtłeÚEşŮ1 Ęž™Šę‘éčRdFăźR3ĆÉŚÓ;ŠQ ŇĚDP¨ĆJWĘ2«śÄŽcÖHşä™µÔdĂFI÷Dć”ĹŽ®óuiÉĽt(P+ćµA¨ĆŰ€Úµŕpťžr,xŤjĎBô´X”š.E3$f§ŚdŃAĆ R‹(;šĹĂ@ÎUĺčdEř‘•&QŁU˛˛$kˇ«‘II˘R],=Á˛čHČĺˇ!͢žAWŞQP+ĄÖ†®˘í 9eu=Ú®,ę02 ą&ŤŽtę0Ž CҨÉSšHŕŃ1ŇJtźr¨Ă*BďP€ŇUÔam@)uX)(‡: H`†N@Ć$A(şŠ˘<ępš´%Ig łGΑ\=ępňVŢĐé™G^BĄTBzş[yÔáˇ,ŘC2=IŻ©ßˇyŘJP‡Ź„4 ŽÜ­ÔľŠtź! =…ü!•ŠöPG°čVPGp–öPGHm~ČĐÔç2DČ6ë©ŚţŻü‰“Étą`˙źtĄbÇIUň6ć-ŠÉ[Y¶ŞluŮš˛µeëŇVWşlMŮÚ˛mŻű˛ e›ëÓ˛*[Y¶ąľ?x4ť,ë ĐZ™ËŻęÓfôpú řé)-‡ě‚‘ ÇGŁ9`ĺîăz1˝šźÔ F-ňiůěÍr´¬QE†*ž˘•ŰŹćÓ“7őe‹ŁÇO™řµţ´Dˇ˙ü'v?Ďj*ýĽĆá–m‘›+rsEn®ČÍąą"7Wäć\Ů–~pĄ\)Ď—ň|)Ď÷ÉĹަ\H»Wr! ˙ąřŇN_ÚéK;}či‡»ÝvÄőv„ę Ú±†Í=¶D~‡ŁEťo=ůúĹ˙ľ|u<˝M¤úáát|ŠvON¦§Íä<ąÜěfľX>şÍ!‰\÷ăzq2ofËé<Ťłé®—Łr“„ o®>,SÝ„@¶@rĹďšÓĺő©ŁĆ8…çcňC20Ťţφfa‡|óÝ«OŔŹČB:Oă›O>$ CŤŚéG.·‚ ŃÉ—ä“ůťTć“Hú?ăÝcQEÚh87‚BÇŠ±¸1i&µŠ)ţĎĬž7ÓS1 ±¨˙Ä}‹ć“XŠĺĹĽ®ĹňŻ©¸ŠżÄ'ńYü-ţ®çÓ˙a‚t‰Úňi’x:ť/ ôIU¶ć‘®!€°©‰ä«O›q ńČ°2ÎףËzP±_,GăćäÁä|\ă ńŞY, ćI“Q‹7Ëúň-Ćr˝®®kŞ^d˙ć;Ťu{×ĘQ´&6ťźÖób× îŁt óJ$[UĹş~{˙;łš{rĐ.8n+„“«ńî}Řdü'ô˘&NîĎ(Ç)JD8Ă+ŚÚ´µÎţX3»—Íäc 0ůĐ»gLĹ#‡ś3ÜÇxŕd{PŔQČߡ“Ęs­5Ů*˛fHvÚsřVş†ĚČ2ÉÝ\ Řö®e‡°›»jB^Naf \běBŔČ)ÜÔAń úýmÁ9Ë+Ś€¸h„ş'lŇInĽŔ†Y÷ńµÉ`0CŕQ2f1<ĘřŤÁD…ĐľçIÝ}Óű!pEæĐÜ8˛ĹM IJŽHţ›b3ĘpLŹVŘ ¶óî ôŰ‹Đo •»ÁL+Ž‰Ś’Ó´łlŐ7ĆaÇ®…¦¤#ĺĽ/hĆ’űęR©*^ă!ÄÁ‘Ëä WÚ Ć {5qšˇ, ăŰ‚‹;ŚîŔać„ŕÉÜ8%űĆ.‡chě2N/Ż2‹x$Fâq1âU·;zÝÄš°Iěi"ŞaĽ„ŐPs¶cI[ć˝yz`6ľZgęe‡tůĽK¶Ž!˛…2ĚŞëײF„f®eP™e[ Dýl‹ř­Ś˛L;JüóŃ/Ď~ú őľ-/r]˛ęUe»­ĘR®vTąŹÄśţߤAÁ5ÜSy ź×4¤ ®pSU˘ô ŤU‰L´W`a®Ęü¤őů?´*ĺPl$V4ë·q7Ős•ŇJy|‰2ô‰ouÝˬÓă€T¶!¬Ö¶v•09“mŔm0¨.Č…ő3”}´*¦ćó&YµB‹ë°)•kvÉ©Y”Oýi¬LŇЮřŔňŇóÎŢĐŠ‰§â™x!~ŻĹ‘x#Ţ‹ßaYŁńěb$>ÔËddMa9ë٢!ΓΟ‰sq>˘łçóz´¬ÉÎţ%>ŠŹŁŮl$ƣ˧ŘÔ‹…g]—W0Â޲ŤO›łł–ôśˇ†YÓ™ŕ9 ]ŚG‹ 2ĹŃĚ‘*\qźËŃAćřĆůlţ®A¶cŮĘ Ż1ŚCÍŐî%AW–řÓë㇯ߵŔőŘ cň`˛hV'ÖĆ•ŘcŚjˤP€m÷}·ŐÉa”]S§|Ř©ÓĘë’·MŢ´őĄ}ÖŃŐÎZvĽ(Ć-gRŮ[}¦¶űlP„ö‚;ëÁ«ÇOž>nkŠ˝Óo;LzúČě8ĚCÇ~ňtÖKÖç˝L•żÉ“%˙”˙÷zşŕ¶®úTŞ7»Iňh_ßŐë­¸·ówă“WĆPŘn‰ĄmĎçşÓěërËĘU:O«A¤G-jĎQŤ¶|ŻórpŠéśG%‰s<ľ9K›qJŐ¬r4Óě±z‚†ěşŠĎŞ/›\Ţr•§ŮPřd¬1®…ú\ÔZ8«ű 윆ô}3 ,ßQţwGżýřbÓ5öZ@¬¶-ăஸ ¨µÝŻý÷ń±…ł»ÖeŁż¶ŁöÖô®ËĹąu—›;Ýţăöű2˙K|Útłn`hDŻ¤«”•u©Ę ˝3Űz·ż˙U>Ä<űťí—OB-Í3ă`’ČcfiPáyićú•xśÖw?AŢŹÍZ®öµŘ|äłŃ»ŔÖC{xmą“T›uĽÂc›&ŽÄĆď›ÄÉ›©lfŹ%]Ą%Ľ=asË[uáË~•98|‘Oěź=xńü¨[FŐĎ®µ„`§ž=<±­v´ÓŞťj»ďĽž±öŃiő ĎÜXŃę°oËŻm>˝U[×ôö>Żwcí\’*\]‹#/l˙§š­+÷ć»Öé\{Ť\«b´ĽťZ–Ϥ¬ZÇŘ»„pŻÖ?Ků Z6xŃ`Ţ ÝźŹN>ÖË4“,űy.ąAdçy䙝g§}ë™íÍ jĎâÂf|Ú˛Ý4q˝1ß-uźşm#6Š ď đ—ź|űöI1ř7ź/?LÇ‹~3Ś- ¸× ·i5)Żá¸ Ôk™ľł}źN÷ #˝˝żúČŞşÎpÓ-Î]?;Ýü¸kQ}Z›_Yjű!ű»éř1šÍćÓOŮFóůôŻ¬ŢFódHugRuľ€—(—¬§ůs4®''uKSçBšÉY3i–źCťO]6ˤ>-›é$G™ä!xđTĚG§Í n]4— ÔhÝH˘6şFŮă#ŮY€{ťâj*ć`SůőÝŁ÷?=ßf˝w´·”ŔŢ`ĘîR›‡.h÷püέÔ'Ą^Ü怵pŃ+S_¦ž›ź W†A©•űH&YEÍčĹ2⧽׽7Ů$ zµĚąý b;zurˇ”MÚ]¨ľÁţäõü -P'~Ë™›UަNCŬłEs]ĄR{VŹÓ‹c•Oőn)ďNFsź*޸á`Ĺ}÷üÝËwŻ6MĄ"ĐE{]ü6'éö{ř6íŮ«ĚmŽý.ŮĘ<żÔ*ĺvyDÄ8ëLw÷Ěg7ggőśŃüË LśťáŰ 8 Ý†$ťEŰ=ó%µ°ĘiÜRˇ45L KŁŐM§LYĹE®VĚD‰÷şŁzób«Uő"ý+ Ć´š•Ô&—W-,wZŢĚh]sůě˘a´ÂšŃÂĽ˛ľšÁĂę™ĺdiâ%Íî[[BÍ0ž¶+¬o©ą@•8¦Ů)„ Ë> stream xśŐ\YsŰH’~ß_QŹ3±aÔ}MĚN„o»×v»)·»í‰~ (Hâ"Ő$ĺ±÷×Ď—€ÄE ’(Ű ’( ••WefeIEÍSŃ0é~-3‚ÚŽ9eđë™ÔL !q™”Ö3Ť^RË É¤µ ŠÉîh¦”¶¸%.,SÖ\` /čuĎTpÔ‡î*Ť/Ľ)ŕHÁ´ÖÔ›h‰».â¶Dżđ% ÓQPgB؆tĚĐ—–žké"0]Df-!¦ł.`P%™ŤřŇJ1' <0pšć…Y;ď0–˛Ě š—rĚë@Ź@ ˘ŠVyčőHä!| ‚îhÉ‚ŇŔG+4ȉ©°čŁ žf Ň„ŕ€v,¦ąkĎ"Ń_ăMŢŠ,@ŐF°h g#Yô†H˘X DŁ‰)Ú€}B)ŤĹ•v@Ň8\YEO=®Ľ 7Ť^4đQD ©­ + ŔřH)iŔ”’f§­&~˛cČ–j‹1”pŔd–J!A:©´§§CYM÷0†rXžR‚ě0„ÔtŠđ5 I]0c,‡hH|SŚ-u0t…1 M;Śa±Ýa +{Ź1¬ň€ěI" Č­˝"Ů$ ôĂ:-ŕ& yŚa¦70†Ť$—x_:AótéŃĘGşŤ5TA:ŠiđW]CdĄsš$c8Oü ĂAW·č]Śá‰‹$KŇšh#˝•ćżţţwĆÎç‹őŠý3 š`#öăŹóu>Ç]«uşÇ_ç'ÓńŁĹôřłŃfGĐ6 ‘Ţx;^âfŠŢŁ|µ¸ZNňŁž~Y??ZŹ×yáÔáHrśZo—‹ÉQľlţöÉ3Ćßĺ_ÖúŹŕňëeNĐĎr4[řj‘^'á/~Uů«Ë_SţÚň×őĚĎt~Ú×ç§ĂÝćW‡t±ř-çiĘyšrž¦ś§±=ółťźiĚĎÜf~5ÜÜaq‹uܬ¸ím)3Ö•żľü ĺoÉWňĆ•Ľq%ośéá…żű|‹É9{7‡>:áĽnŹĆ«<˝Îúí·_>˙ďWŻŹĆóUx0ĘĎ®fă%Ć›O'ÓůăżMçç«éöĆłérµ~|Ž^pOňŐd9˝\/–ÉcHřĽ×:]Ż„Š¬0*0řmz˛>'!0°ălDc5I´ăůăńĺ‹|zv^5•fú>ů+ă46ő|«ĎźÍĆg+Zp$V°˙QEozn ŇâŹâŮłé,×`OMߌ/ňÝDyąϦ“‡ółYŽWřëéjŠ¤ ŔĎÁťŁu~ńža]©Í°Fţ{mV<úĺÇ#Śúz1_Ä˛Ć¨Ë Őb…„×4Ś+bőI˛Zţn˙şOŠ«úw˙ő>}ýúút[ű>Ýžmąrp…krĺĐĄ&Wůcţ”żá#ţŽ˙ĘÇ|Â'‹ŮbÎOxÎó?ŻĆ3~ĆĎůů×Ëó|Χü_üźń >ç ~É/óĺtq—|ĹWłńꜯůúß ~U—U˝/…«h]P¸â©%H6EŐÔTżŐ]B3PTáţ\'ŞXţ*Q],Oňei˝D2¶©!‹Ţ&óŁJôű‡ŹĐ­Ě#`VŠ η`ó«ŮŚúľ†dâ&ôF™€ľÂ`gäPť!ĎÖŠ Ž ußČě«éüS…qZ=î7ëáŔms6ó19Y5Jädt[ě¤2Y¤hČ©9DýčÁ Ëâ.ăe&( íüzp?Éýý AŤRpěv˛b'"B73 ŃŚ™7ß;3ďě.ěśĚ,Ĺ7Ne.‚f.`=1dńîA±ó[ěŔź,7mŁÎ‚ŮĹZCFa7"ÜLQ°- y]«!h<¨Z¨®Z$đníćçK şk"”¨ČdBĆďŚ\„ÎJ˝AÎJPNÝą‡Éí:bü×ŃËM‡Ézş·ţrľ^_®ţĆůăŃĂ7ŮčÁĺrń/ ź-–gür<ůoë0żé|<űkňÂvĎVvg`#Ô:Đ‚ťyMKĘb¤0”*Śy DŐ¬‚Ž)U )şŻşĂ^K_ÇwëÝ˝{sôîŐŰҧ”â†î­Řm÷NşŽ{gşw.ůĽŐźsľ×3Aîpζ_ç\ĄćĆązËßĂĄZ6\wyŤë.™ ŞĎ’mh'™:DÁ_ë!öěp÷Ĺű÷ďż"7lĽ>G¬–Ź‹y/›)mT ˝á®T=Ü îęî.~ťO8-J;ŮËđ"I3äĎc%¤Ź…ňѧş„KźvžľO$bÝď›ţICiOĺĂŕ7* hý˘RŠFD)ę˛yĽOňüKń;ËO׏¦gŤF­uĽŢ^_LO¶Ťőeq˝¤6ŞVŃü”ŻËv łl•”­,ZPéĆöÝÔÜľśšxű’Ň ›QSk Ć˙äj˛>™®.găŻ|9>™NĆ3Â~uuq1¦UŁzö9'ů>!ő™ĺŤ¨&Rx^(rG‡ÓCIYQ#ÚZ¬ŰZ|˝: TgĘ–÷ësG…~?zţű¨óčëĹńb¶r˝úëÚúŰcś•h©oźňöijt…Α‰î®ł ŮuŤ¨#AĘVźŔ­s~1ť_­jĚ»˝Ô>j1Ĺ´™r rDR¨=Ś#Ďź=ţůÝŁrŔ|Cöf¨|k:iµë¦o§+ \+{Ö@×\]c SÖ ˇ:iŃŰłR‡€µeŰŚÚO·|ŠňúĚ@ĎBřËó—ŹŢ˝ÁŘŁĹĹx.Őb¸†ţř¶ţč>2m.oøÜţĹ®HVZ “;éE±¬4ˇ7‚OĎíö©Ý Űm,ѧşÖbŰ.˛§ÔR––Ü=±ĹŚI;·şLk[ő7ľŘÓmˡ— 9,š­D×+ţš˙ żěryĚ')ÍuĘOO§Í4W=ÉEŮ­5żâźůţ•˙ßQnJń3=Ť !Ň’ăʬnäx§, 55fW"¶#¶Ď>ľyţ듦mëKÁŇ^^KxUźđv\óÁ&ĆÇŰxIßëO…nn•Ôˇ.r¶ébŤ—|–ŻV)ŹÚ»sŤJĎ<¬,ÁjIMm‡¬škX9TvÄu˛3(ńŁbéŰ4ŇRJd^™]G©3Ú qˇ2â[t¦ô‘ 2SCŽ"çŰĆĘőčX"”QfŽ‘2(Đe7P"™´ ÄĘn  ¬S¶‚˘¨čcP«˛ÖŁj…TçQ¶”H5U«¨ď¨Z&Éž(~şß9 ĺ¤ÍRĹJ?ųîĹ “ybd``„űĚĹ){CŇD%6rZŘŚÂëű@®'çnśČÄ䱦ŚĽŰRÎźŇĺ°E´[äĽĘ˘°ßŚ­ÁeV¨]lµ.“*)lˇr«,RŤ– Â|Wä)— ˝Jä  –ę•îŽ\×ěÚ-vPxëM¦Ä®|1ŚEćť$S–©dŇŐ‰š” 9ÉMĺq›†g[ó»ĎÄÄŢÖ¨öN\RµÖaŚ¨ŐbĎţV4i×Í _h+L(GK¤ľÓÍÝQSc‹Ĺ±ÂŤĚ˝3ß ·ýŞf´Í‚‹n&DLäA ,Ąí«5+Cćíý­Ç¶KivíJ ĘaíRŔO“i×ĹĆĹr ¸7Ü”OHT¸Y™lÔpkOmęűĐ´Ál¨¤FŇÉ]N« &ŁKŇ ŠD#Ü ™ŠiÓÜ°ýŞM5/«Ŕ|O…¤9l1•oTHúŰTHţżµü­ű݉Íc'ć;¶ĺ6“Ř»-÷ńéOoß˙oY?#Ő ŕl7˝8´ÎĘžŞ)ÜŁO'ÁH›fµcjn+ă(WSŹ®ÝžôâIĎ-“ ´âëNqÜNŠ -9şľ:V¦§:îů‡?WĂŢt˙´/l»Fyň¸vqZŤe×–¤U˝DqÚ^ÖŽË ];÷oţu`‰™)KĚŕôu^ňÖKĚvP~(ĂŻßR­1üŢęi4UTAś]č.Sé”Ćęîá`Ĺ;hô¶ŘÁ$y­3AŮétS‹€ŇŇŃ)±†z°ÇetHâľ˝5+"î Ť¨Ę ŞŤŇ´ú'O’r@ľJa•ľ#rUťO…\UçsäîĆReá«Ńi‡€\ą€ŢtD¦Ş{¦š¸Đ»Ó@&¸PÔ•Áý1ÂáL‡š2yďů‹ý¸pP·ĹMW*Ďą3n'×ŐłTl"rĆB’vÖ‚ÂőöΧdťrQe ˙ĘgbhŁćĺŠŇË•]/·ň‰ĺ媆—«oáĺŢ_ě`ĄJUˇRS(¨h]Ę"ťŁÇÔ–oëqSљ޴ŇéĆŤß:Ŕ7ÝăŹ>zůńŐÓŹĺb{4Ď×7öu´éú:Îw|ťˇRÝbý›•ŢďÝôŠúž´ŹěU´ użo~ŕć3۸ö‚nďË>áOů3ţ’˙Ä_ń7ivÄŹŇ„đÇ«ÉtşžÎNňMÝ?ŢÖ ŐjŽę5DŤ’ Í±†Éââb źňd1”чô¸8épĘO§źs~ ĂÂĎřŮ2‡AY¶·…iC/ąŁóé<‡OşŔw­ŕ¨VlDÇ#Ő1‰ËŮŐŠ˙É˙ĽZ¬ó“ăYql"˙ Č«é::qľĚó⿚í&‹eÎ?ĂÝM;ĎůrŃôz7H1´vźmńŘ©ľJB[łĄŰ»Wëľo:z´s#QßčŶ˘đÝčhôf_ĽCgR ś·ŞßŹşŘR}ÝŽnë+C¶ÓtD™ 3ꢬꢜ8[ÔŠeë•V’DÇ N‹Gť’¤ťDš\[ pO~•Eű”Č6éWÄ&TáŁ|:Šđ]ť0,ŠMäx*š==ťU1nĘňŠę·c8R˝Ŕ˙ĚKŞůendstream endobj 389 0 obj << /Type /ObjStm /Length 2804 /Filter /FlateDecode /N 96 /First 890 >> stream xśÍ[ŰŽą}ĎWđ1A`ŠUĽ‹|YgŘ36˛7řA÷Ž…Ś%c$ŢżĎ)6[—µÜ#µvćaĐÍa“<<¬*V)›Ť2ĘfR재\ <­ $e§bÎxz•#ăQů0*˛NZ&EľTeE‘łrĆ(Ędń‚NŤ7xaĹläĹb’ośbź0ńŠS© ŠłŹx‰Ęb Ľ`ŽRŽr„ń|BĎŁ;ÂŔ X\ĎŁ•´d’*Żś R…–6Is‚“o’r±´”,­Ř(OčM•giŬĽc©˛Ęű$UNůhŃ”˝ňeP` &`dŽ*0Z8N*8‹^ADđ`ŐYŁB”A-©PZYVŃ8|c­Š&X¶N`z=HpCŔ,lT1µ3ŔJD©Ę*Áů'©$ô;Ç*+^¬JQÇŔ){ á°€FVĂd.ßD• %XN„Ŕ„đ Zćč1ţrFSçY‘!¬šóVŢ@Šod8ˇ+ €:–ď ¦ĚKI¦`Ŕ`d˛‘˙AD¤Ë`ä-¦"mD\ţ‡1H$ĚRH@‘EŚAAČOD ââ‚Č`R‹1dĆ`ŽŇc°Pë :č8ˇ6b ŽB0oÂ9¨$Î"$:Yş1¬·COd9I­ş –¬7Evđ„—„1l’ĂŠxĚbŤ7|ă Şé•˙a Ć@ź„ĹĚůî;5y:ź/VKő[ŃŁ.Š´ĎXź©>sű$SźTź\ź¶>]yľW“ç‹ůŞ™ŁwďŰľ'Ż›łéłĹWŚ'˝řě5ä59Ň -ŢLoĐ@µ=L.šĺâËÍełT‚ô‡Ż«Ľ]MWMQ¬ňÁË…|L-ŕÉ››ĹĺŰf…ľ'o^ĽT“wÍ×:ýţ{Ľţńą‘ŢŻoÍ›ę<©Î“ę<ąÎ“ë<ąÎ“ëz5Ý|óöËWe`ž:í¨?Í>¬>Ę&¸úď×ËşĽ”ɸ«“çÓĎ?6ł«Ź]ťĘěţ:y÷±YM˙¦&2Ľ|ý>Éäĺőôj –J÷Ď:>Ą*‰KŚŢ·u/g× <몣ĺ_˙š~jzyřçjz=»|:żşnĐbňz¶\‚•_"ĚrŐ|úŹř~Űܢćá?üôËëź˙Ý ž\4W_®Á؆r°3:_Î6˙Řpźô.ůîůňŃ öşĂ>Ds›ýR\łż7[Ü›Žů/(ÝbŇ ÷RÚßâ>Ţćľ—’ěĂ>LţâćCsSA™b$JÚÚTźoňó/ż*ou” Đ»¨ !śąľ–o(ŃĂËUq#łŽ~śh­ÄX)ë s o]S.ú»^†Włů˙:”Ĺ|ť\v:ĂĄčŔyJ:"x:¸ÎËÚçŽ!÷€C,§YâËD`NÎ:I4Đ­Ŕ<66^—¨­bcÎZśüń±ÝQ™“năMŻ -6Ńg'óŔv)®-\]`Łlµ+xxr˛ĺCâCî•;ôîîŽ=[ ôś¶Ę!ĺöČ >›śČěŰ$$–ńNňrŽ©3ćFËD ŠËíŕרĎuŚ€ ËŃsK8 0×É|&áÇ^3óäˇßIi‚X9 sZNFe,ě2Ź ß™± Ć…ŕKą]IÓî~˘đG¨Ë‘÷ZЇ8p[Ň›doâŘmťnÔĵ­‰k[×v_ÂwĽ#™cľÇÇŚŕ3řľUň î„Á‹Yî8ťŔ|„”…|öŕć08ÎŘyáěwŕ,mˇŁg·×±‚ đ¶×yŇ!®±9l8âĘ? lqFbŢ€ ®x¤÷wk[ŰŮ®d“±]%ňNAvôs¨N ¶¶wřŕČZąôKíű¬Řs f#»„^0Ł)IPŐ®ű‘–Ă$¬) H†ĹłZÔ¦OŁ:™rMeŹł.WUk/W˛dË˙‘µ¤]¬+>››>; +ĺ¶[ Ψ“kk÷A÷IĎ{+\SěXëD7vP¶D÷hqÝňóÉ2\°đ­ť@ĂrĄb›Ä݇ăŤ\ŞóđŃFK4Ź"böTŁ9Â}śşŤ`4oECł5GĐ1ň'Xé)E sűÜ%Ž% ÜÍ’PçxŁyżôq*€@žQrŔ'äyíŇIwaídą Tö›^;Kņ˽ö Í·‰~ĘöQ©î-qlűÔú*Źpĺ¬ŢŁ;ć*ÔPU>·n‰Är}Ű ĘěŤ  s®\¨Gp)p\ÔĺľKđÎťł‡öcßéĂVN‡BÉţJvG>–ŰäĺhëěWca­ÁE«ŮŘű»÷¶$çyëÍĆˡíý=đ™éCűÎxW‡Źąůzî}gk˘#\?®=ćÇ.»=ď6şa‹łčN˝§Žláă†v'›¸ … bB°#Ph2ĆŽÉ.íhä C’}„Ç˙Mż5Y]~w(ţ8¬Y.9ÉŹZt77z ş;!Đb_OíŐ«\ÍCo—~Űzí,Ţîńî!{5xńÖąYŞ?mˇý‰m”çNn6Žú‹6ňŰżh#ş’µfG%äű+ę/fż˙Ţ`Ú2Ďßäúą§/l´¨×_˘»˙wSËendstream endobj 486 0 obj << /Filter /FlateDecode /Length 4551 >> stream xśĄ[Ks丑ľë/xˇÓËŃĹ!Ţ€÷d·ŢńÎŘëíiĆŽ¤–hU‰2IµZűë73ČŞ–Űч&Y@"‘ČÇ—™Đ?/›š]6ř/ü}Ľh.ď.ţyÁčëeřďúxůű«‹o?uÉLÍ™’—W/üvéLmŐĄá¬ćĘ^^/~ŞŢ?w‚Ő «žíÔ}Â'¬«nw{aTÝ4¶úľ{|oRU?ěöMÝh­•ŕUßa‚u˘şą=Ś8JÖNÚęăI§…U?„ďNWnşÇö°|ř@äŚV¶áŐíÝp;âLĹ%T•>wýăîďWľp¬ÖŚłË=lĂ1 Ľ}ĽtÓ=ńXM÷·4„`R!Skg-&Ŕ˛W˙XËÉÖJ)ć‡üTýĎN4Ŕ#U{˝dÁ«b7l¬˝›—rŮR˛6ÖÍtúá†ö!¬u¶ę“D ŚŔ~”âH`Ď„­…4—{Ék´ó„>C‚Ăa=ŢZ[ýWűü ťCÓMGB?Čę÷‹ßßÝ"M^M·ŹéëícŕĂ2PĄÚ5Ŕ=đÁkŕSLÔJ‚đŤ«ť¸–B%A–Ym«ë7°­Ş{żCĂW=&ĎÝu:ž´@Ô˝˙őŁhčÓŽ[řĘ úĂŘM¸Dä¨^Ă\PĎţ#>sTŰęa†§”®}l‡Ú#D'ž'uřT‡˝4µl\±Ű÷én@SĆTĘřXü¸bŐŹ … ¬lśrIŚÄŘŻ.ţ†' .ďĆ xů6ţ§ ¶­\Ăj#/ŹŠóĺőpńăI–áj§ąN=7®V–_*mjŁÉTżűeś†özň °LŰ3ĄkˇÄÖŇ6,(€‰b Č Ôj/A]ťSՓߨc\WíÓnŹ Áµ™ĎŃÂŚjđăćĐđ@•­¦ô–kص2ŐMBć9yľNÉd4‰‡Ş4Ý'nĂgéŞűŚ9Ż¬śŮę­\ü Ĺlωđ´«5haÎZh8ŰhΞěa1ŁeľÇ©…‰ó?&ú! ĎžäĽÍWxg‰[Żüô,ĺâghdÉŇÉ2”Řh;µqéLĆc6ďŽö®$`ŃfĐG_˘ŤdÇńś¨Ä‘„ëxNŮÇü´ž6Ř4QŮ’á&«#ę„Eż›ëD8zKËę0Ö»˝– cf˘f.2lčőK”ü4>;źˇ=¦ĘQ˝ě"•~đŚVÝ1U¬CFń˝=ŇdlNŮ÷đŐEd‡¶ˇ‰ÜJśőőš(A‘ŤółŮiŇ;)°1¸1ąĺSÖ‡¨dk#TĐH:zčGŃĂÔţ1Q%Ż¸šÔˇ÷ă\#3–n’áă;®1¦ ĽÚŽťöSúËP®é$ĎŤ25¦?ő‡”%ĎŁČ;f«¶˛lpzÚĺÂüU¦h9«c`Č ô ݉R ›¦úő©#úÜýRh'-®ř†Ő‘YĐ˙ÔŞý“Ę2YŘ<ŘŁQ`Ź€SJ{ś'ˇrĚ*ńýĹŐorĄţYqüł ÔÔ‡±÷o0çň÷”čÁ“&Áç„ămmĂcůą_ôX`_‘ ĄgŮyĂ{ 4ç<7€­`Ză2< VÉ3™§O§÷ǸgéII±+ŞLŘĎuŞ?ÓfXS˝Ü''ÚEĆŞyiĐŞá6per!ő~ű mĘŠ@ľňbHMó‹C,oÉŕů¦~5ŤSúB| ”ŐgŔ Ŕ0  Ş&!ňý'5ŢÜÂHÍrfł‘Ęö5,ءż§ 0wČLóеĄM3Cr8wą& Ý˙ťD/q)°Ężd?ĽLýăÂFî}¦îŘ’ĺ…ßŃŃ,'{Â#łĆśŤúž¦]Źiż[L×EÓŤpÖK—€˝Cg˘Ŕ‘«Řş8öj62'Ů*ľ§Đ.ó4ij'zEH>uç˘RAxpl?wÇYŁs€,ĂŮ>řoJlĐeŢŢ[9¦(YPŇéŁÂ퀣ś…Ć®+‰Ö?FD ůŮ9ĚâEd‹ŢŽ„‹|V¸ňĂ´†Ú°1 '«ĂÚmxë“x,ŹwÄO•mGJ¶Bľđ˝)~´ ’– @[N)†_‡ź^g+ň0"Źd ëv DK``~‡0řH‡çŞŐď% †ă™zb&7ÉČ ř·ă8ĎČŻ Őč]-ŕîöꆣ$v­^P<î•’2S—°ołqŚć«„żŁÂ&P&¦5rzjŁżÖĐ*0%DÉ Í/¶óE”»ĄďRSźn¸».Ý ˛‚‰ÇČ=sćAă!Ľźöc^Ç%8Ă©ű&ÝlŤşp¦ä^#Kˇ —ć4"÷sŕžúăfđŠ±B° ő¶| ÁC0Ţ!V4y›„DGę/X&¤ékÜÄضŞ3m8ztÇľ_&Ż˛ydŠ™"Ĺů¦`гΖxŁŘ[âŤtEĽ!.Ŕ_çŤä+QŘ߬|S±NŘG Ř)Ô{ Ë‹,v€AĄŃh–ÁSj¸Yż&1txĆ y’ÁO]{ŽG˘NdZá˛Ü:Ă’±Tl $NľŘîč5 GT°™jőîÄ*¶|·„ýďđ«Ł[ü19äŢoUrĂ/Ć CÝU_†BŤWŐĎŐŇkjEę3śîx»fKŰw5đu)¤­9Ôďşź¦§ń·ß~űňňR˙c„mŤýǩogŤ?×ZßVkhÁp“-ôó®^şĚ˛ŕÉÍBN®Lßx mFHXQߣúî14žC[ŚúóXxľžbĽäcĎ´®ycÁyKرöD˙š9ÜŰÔ†ě ˇ$¤^ŘBͬĄť˛awý[•ç™ÇA7™1µď|Ë9ŻĎDś]ëAs_7#i2ľ´9(Ü4|(]×Ů’„°zćÉ)¦Ś×5â]ą\…űă‘*ȱňöă…#Ń!áśJĆşES7=źpôq=ÚvHSžýÚ{Ą}lŞpHŢ –űFµňÍCG‰ RjćŮ°ěp)©qŢÓĐLi†× >ËĚ/­ślť‡0Éé”Ŕ6ñqŹA˛$ŐŤĚ‹Zg‚í Z™†e “őx,îĺţÔ Ň\Óŕ˝ĘŔ™Î6xlÓ˘™Füć"łđ}ăaÔγ݂Ž˝[Í‚Ę8fo ,ťOŚ×ľŹůŰr´ă4d;Éô!$Ë+,%:ěAňÇdţç6Ó×ĂJźµĄłÖŔĂ9cq¤Tئ6Ďn–D ¶ŘÂZ 1wC{sňÄÁţ•đEąaŽ_ز>úĄ±uBvŠĎ üOëd?&úV*Ď ) yM_gĂ6Q©|ׄÖR6ŃÚaéĆÁ @{sÚwC‚3Šp#±™R01éŰŢ‹Üĺ!ŞČś |ľšŤýžŘĚ pť3çłP8€ą?…ň©„ű4»ŃŚz®ýÁ(Č‘ Ł şLÎßűůáCŕwvlsX6&š%Węć«ü;8rÖR˙3=ž:éq ĬËËĺQć°‹GŮ߽ҕ*Ě°hĎyő>;^_ĄŐú ir ^¤L{âÉCíČBB·uĘŢ ú˘©7 Řűďřy‡4U,ČŁqAĐ›Ŕ95ĄUµôÜByŰĹąÔěHm%ŰͲʧ.]BÂg_ř“v @_jâ×ćÝ—…–ŘĄ™B•¸!ČňŘ)ó;(Ł)Ťŕܧ°ĚbÖÉđzÝÁéJë{ ‚6$č)w÷“-á#2ťë×0ʇ.…šlS€]¨TqŇ\§ćţeč‡`*”—§ű\źü˝Ydüç(q!X†VÚ© {˛aşxů„ń\1>g©ďVWĽkłö>O •Šw,ÖŞ8ß± 1ÖźŔÝP¸ŚĐtäň?&ŽzľvŢ_ćşGĽvDűn‡~v/ăîU öÓ´kĹ3“€ý†ŤůCI%I5SČĚPÚĽró:fłBu‰Tš3ŔUž/m)’±[rBĽ{›î’`0xO^?Ďk˝˛{˝ç¬YĂ]AWŐJ{çAËĺŢ$7…^ÝÁ ˇŁČ¨7Ssp•‘@¶ď‹°Zh($Y$Ăt \ťK†Oä¨8pÎlS3ĽËyô×[ —4ŤĺŐ@I˝żIEź­¤Ëj3I@ĚĆmWŹ“xĂUĘíżĘ¦0Ľńçlb˘@{ ŻľUí‚$X[ˇĎU»ŕŃĺÂđ’üYľv‹qČWj®dĘř–†#č‡xÔŕ3Âíjer'ÓĂ€R áćß‘°BŹÖ¨Sv™/ ŢKŢФôŢôO+ÓxCQÚµ‹ “'ăQ5>c©űlM‡qş˙±ŠÇ´Đr…ĘúŇwת˝=ˇC˝†Pž]§ŢM0_ÂÄéŞ%DŢśđyEÂđfŁFM¶¸Xh’-řűˇ2]f»´ € yEőiHú_v[îN6ŕîś,Ý]Č´ßŕîö‘B~­~L…§ě™řŕşűÁ_c3k5“xµ ÇćE‡,!xR7©É9 Ăôäţť&ěŠÍ1ě‹e5Ň8š™·ž}$oËô:ŻÓ?'0˛ŘŔŠ€ĺoĆ´ěĆŤĆđJâ^("ĺáZ12**„ým"¤©Š –ş†Uˇ¤IŞË”ýV‚®ĂÖ8™UźjŔ*6h}›e„PŐÇť9&™ ±źŚĺddľ‹+ł*‡‡ăV }SŞQV»<ď‚ňĐucHS]oł/äwbB@+úB pA5Ŕ ßXAÝh —şpżĘŢVŤ! §RĽľUM3ďp¸ B@†˘:§ÔìNOú~Ö ›źWŔőקŠkűźHÄłŃěĂżuifŤőR.ÓP“)S©xÉ”{‹.:­^«ÚłÚQbß8QśÍÉ’F™Ň99_/őú/oÍ?’@ĚwÇč€ďa†µ¤ 8âemŽ˛đ„ďe’9fď ĹLµĚ‹-Ż&äYOşŃIŠŔ‚şG7ţ*\lúŃó"vš›&:T˘üźŁ0F•ĺóA…Ö żÜĂŚ8łŁc ±”˛SzVáĘşźwƉç&>ÇqÁ\ÚN VŠŚOżKµśélEtlU5âßI``~ňçŤ Ś°zľ=I—0 !dő—§ěąţ4Ăžvűřw&ş†Ě¬@§ˇG#uv‹`Ťúđâ».{›­)lłád†Í»Ď·;ާmJŠîĂĎŤ¬YíĄú€`dkT€űáçÝúűôčÍ"€aţ"j0śngíęávţ†Ú˛a2 ™ÓH%ş.Đ °ĺďVĹúř÷ "Ţ~QýŞićśU`Ęrţvń˙’@Łűendstream endobj 487 0 obj << /Filter /FlateDecode /Length 5831 >> stream xś­\[sŰHv~×_Ř<čm ”‰Aßµ)Źk3덽嵕MĄĆy€-YĆš=$mGűŰóséş&E‰Ş©)‹dŁŻç|ç;—ĆďçM-Îü/üűquÖśßśý~&čŰóđĎÇŐů/—g?żőľ©Ű¦ç—źÎřqß:ăęV™óËŐY%/.˙mEŁ˛ĆMS[§áË«łßŞß.šş1ʉ¦­V÷ÚTé·Ën׿~1˛şľX(ĄęF‹ęU›4ű‚?Čşmuőz}±ľn„m««¤ <‹ĽđÖWËmč©ńŐŹ~÷™?µVUđwů™˙ąü -Čd ˛¦n¬ŕUo÷,ş¶ľi㢿&ýwiŃWĐÝđh¶ŃRŁą´'-j)äĐÓzĂëă%eűŃ-/¸‡ü°J¸ÚB ejo-÷łĺ ×^¶m^ü{ÓS°ÝëÍ÷HŔľęjý‰˙†_â~ń=m+Ś×Şjµć§ńD÷źChďuő‘żoüǾ݆1ĽZ.ÇŃÓu®wq@[}ŕń¬`1‘uătuŇăđwźŹ|T®ú”tČ[aZí}µŮ+ Ő&Śßď6Ů/Ýnu}AýşFÁ(0xŁ UcŞýť^‡F“Îi‚p‹±Wĺ㮺>.IëŞ óľÚ­S‰ë?†`›>%ҳތ'Ń‘ěUÝĘóËWg—˙ú[hĚÇäEşÎ?žMTPgs9’dĆ%ó9ojË‚4˘ňX—©La—6Ńdß­˛~žEq·©¸r)˘ľ|ü¶ú¶Lűh^4ěeúuűż$ČA)6¸Ý­«®®ÓVۢ‚ Ř5 ęF$}ŔÉŘv©dg˛Ëň Ám&—›őŠüÓĺŮßάÍůćˇ Ť'ěZ{{][#©«žßä’´ÝőéPöµ22Łz_!2ž8wŮę¬_Ů42éůÁ]¶¦ÖBĺŰńţâś@Űfř‰&GFçŠŕGŞŮ´>Ş%Ô°ň öáAC?łďűč'•ˇEÇB(®iŢ ŇQďYŘ"ţRĆqś‹6…=Ť;ˇĺ€¬Aźr•KTt3Oî6aŤ#(ĂŘçîÂĎ­©¶Y7ĂőHLzKĹťš\î×–a .÷…[Úß&ťtKăYZöąęmş]zČůÂA*´ŃXr 6ßĘj8&ÍxJS0RRŐŇ'Ć›€E`)×đwCäĺšŃĆiÚgŘ1ÄăeŠÓ±ĺMż -@LJqgió=(4LQ SéŇMĵ´ RŐ@P&˛WÓČÂj;A e‹3¬ľĆ¦°¸řaX|yĚ6şĆÚőč"< VëĎ­Őµ1Šˇŕ×MJɦŠ4ÔüF’HMö’ľoąţ9<̤Ť¶źóžr’Ń€1€N4'2|çéŇ彿 ůevf= ęfjĂk€Z“đq3]X˛ ­űš™ŻIůi¤ë`yg<o}ĆNRť»ÍôŹŽGZ+aşý:Ű×Vd\"ő ’é"śšŔRM)Ίq Ž´ŕ¦ ä;Ţ+‹nJ[XžEZv<;¶‚T)8)đp Ô…ŔęÄĂŔ_ZągĽ&PslŘřŁ/ ɸĽ‹]ËęKĆ´iݨŕ?năD,b]ÁÜç9MĐ°Ó«  €PÔŕČ8p¦JđÎ4Á_Äą+2’†·˙ĘÍ×Ć#§;ń픀… ¸‡Ľ,ŕÉČÓÂĘL{n•«µŃ¬™Ż3g(s“—Ëî&ˇÇ'`‚ĐČ&řiÔ€ťkUÖŻh}sOÎÔB|Ź˝dëÉ× Äzľo‰µ†?±S–}§Śp­W)T-s·jú¨ÚV»ns‡“ţ-ŕ˙0Š·S D2ŮŘ–ÂG a„Ěô®KZ©0Î1°Ę% C<U‡Ü®óYíú âŤ1 óiĐDŽtÂ-X[ř{bó‘ţQĐ…pŔ6Á9•,á€6µÚOp€Čŕ€H!ŁK@Ż>w˙ě bŽ‚Mۆ_9öůjE€‰+‡ťYŔ°¬›Í:Ő˝Żi„!÷Ř0zPž±ĂÍw° ŕÂŮąŠ– ŘšĎŚ˝ŕ…p®öŔË?LQ˛WŻ· ĘMŁŽ7$1ëŰ|§©Ťăđ b8hŔń$ś;…ă6Ő]tاśd‰ ĂPdb4gĆŢtłLő·a¤ÔYŁL3ű™űfYFK…śrďĽ`!Íd&ë}Ă_…5\Ě„‚6¨Ân1Z‡Ý†¦Ťş]lÄĐ\tő|9q;˛.vű"VŰRXfGŃN´‚6Šôšp¨źĄ\K…t˛uÔPžě5ăžÁ8V?`ŕ·|ÖĐÇ6čGőĂĽü±Âń aK“g±’äÓä™6+ŹÎ9MčP.3ů¶ß¬ Ăq’B>f’ŢKc˘ĘMN7ű´Ţ]ÄŔŔ]'ĽńňČĐËÚëźN4×0¬ÔŇžFFůJĄăťµŽ‚ă஢2Om.}Ż«˙ČígF:őşśRĂĂHBëNńq¤”µw*_ ů8R“â ćŕä‘q¦gJ# µăŽz"\["çĆ;u––Ž¦,ŹöMâ?‚ÓqÚ/aAŕÖ„¸8ŽB±Ş4ţŤC śňę=XŞ‚Ě˙,ŕĂGž§Ř`iA[žzN…„€¤ů=$ üó[gÎ1’cŚdwˇ†}D=Q ÄS"s˛z·ć˝]”°Ůś0°k)ŕ¦P`ÚÚčÍőw‘Ű÷×?Š1‰–MÇ_L|Ŕý©ŞŃÔČFKg>™&çX'p;>ĂŮmřA‹üěy\YĄĆs7 2óŁ(6„›°Kwq ‰ć5~GĎ°{¤®Ý¨)FŁ­¤6ýŰő§LѢav|*Ô҉RZLÓb,›Űđ„Á/ŻGU?ŇéöËa?¦´ą`Lălů”Ălť¦Ů’¤±ˇŘöŢ—ČK>!Jy¶ŚWŽy6l]m'”'ns ůĂ~µŰ˛˙Al6›0đjb+45; ÖDväl ŕô«ĐN2Ç!Ź =¦Zuć3dÇĺĂg·ëřôÔ2ďśpŔĐȡň@ŘQj÷†‹˛nĎř çKIFrčrl˘˝ľ)oĺ¤}ń\ř'>ˇXަ–Ď ô7 ż¬ćD3¤¨Ž—Nmŕ 0N›ŞIţX~0śĂ4 'ÎfÂvŽhďľdjŤFď5ŰĹ…µ…Ŕ"ďË–etŞv›ołnc4pÉę+žk‹DńsŢ&Ĺ™ô§ő2—č(*„’Ęć=IĆ;¬BÁ/ĹuDI™äWqýă-Q‘–p¦ť§Çi~U7X&ôI«®_v)ZĆłq×JäŹS;Ü—ËiR|RA|„Djä\đĄpćU8ňB~†ńĆ4z7¤ĘPtäĺĺLŇÜËĺz ŕ?2ľÜ+íÁ‡tëű,©ö SÄ Ĺ@‹Vc$m:ĐÝŠžçi·ď}öńw ç…̉y1@=zV««0˘®ü§ž±Pź&7Y©Ä}HuŮçŮČ»0ŹădGĘ]— @;sÍĎŞ ľś@  Xą {u\¶dšÇ@MwŰ8k5DđąÍ‹ÔŽ|îü§ă„}M§)ŰZą!2úćŐ¦z˙şčł(‹u ň ŹË¤›śOqqiz‚·D™˙'ś(Zí]<#rćrŢ,°›PŚ}ÁíęP¶ź+-Ľ¤ńóČw­H břOÝyŠ@§†€ĚśkgápřŽžÔ;ËS‡Řŕu»+$ćCHfsŐĄ”ţŕĺ“P±°°÷yĂOIoh=ç"//<‚`ŐĚ. Ď>E“ŻÁ|źk¸ĆQ‚IťR¤5f$ýsśŃ™ńPüC(÷ŚÎN9yż '§íkčĽţ”îý®_ÓÇĂq(Ĺqľë{Ď5z ią¨$ÍJţVý{č+—čĺ–Ĺ»}ÇżŢLhĄ ć ĺb$eԌŤm»‹i™vGÇN…;썅§ućŽMüŢ·­ä͡~Ź"şŘŇ  ;7łxµŻ–ÁÝmü4®śëÍbEÄĹx?fűż?ÝÇ+—…@Í ú°»W^ŕ,éyqŤ¬J˛Wëí¶Oé őŤ|ökĚęMX Käu`áđ1íµ/˛ę±YEŮGFWŞť=Š&Ądh×Í?ěĄFä&ů§dFp¦J`á#Ř ôNu¨qGä(dÝÉŚHxWűVe#˘lYL)…˝=RĘ–hń<žŮ‡źß¶M:?ëkGÄ{»ć’*µźĐTΑ2®kˇXZ?ńuCµi…1´Ş–·ŞůďáCčµl•7Ĺ­¦P¦­B^8lhz‹APU(ěÇÉĆÂôüX˝g˛mb[AŃ~OŇTŞß Q}®ÚŁ űŘ^„B?UH·D™‡@ë39X§ű14s8] ±€iŕÔ’î'4d‹f¸fT2Řř“Ő ¨†qŠ°Š6Źîć0NŐ1”6ßÖĘŁt(@?¦-ôť•b± ˇłń­şdQ¦5ůíD[ÔĄĽ4ífÁ aE~Ŕq±ň’ÔúZać'(ćÍrUŇJnĘÓˇŻlÚÚŔBmj§CmřőËeß­B–ÝűS 3Ąóp’ CĄMž"d3WžÉ7OFq<’ôfżA­ÁĹ-úQŻBGz¦áqwz…&ŻfžGWťÝfĎvËif!ZC{—“ß,Hó‡ěSz·’á`čT$±´¦QŃVüúęŐóׯKBit}ě˝/¬oDö’{ş$ŃF# LචL˝í>0XZ9±Ę‹Ľ6yűĺ"¤ĺEféŃ M•tďFűesAĹë ešĂťĄL˛–ô¬"Ď`ćXyI÷&1=o"}YÎL¤gţ'›FźfĐ®ÖŢć;FĚ=ŰÖ†ÄÍŻŐÓ;ř})»¸PÖR·yôŕ×í$ťĂ,Ş@`°˙Št?ŤîĹä>x”ÄEVÁÇóŹ·+Ź·¸Š<…}t›˝ł^EA>Ŕř>Â?7’›"kýt@ÓItăjč€uěÎxűód~{§ä‡;d/3ČÜőYBý1©1=×ć łRŤŤ(Ň|ş˝¦ÖÎä«#{Ą4ĄÉ ‡6šj,y§Oŕm†:wZ¬˝¶ń=+R™2}á›oń§ëŹXš§)°2đćŇÁ8W Ôâ˛{Á3ŐA/Y˙[Ř$9­›ŤL/†ÂČç­¬LT"} •Pé'řm9j şŚdN~ŮŽúxďć(P%‘”ăbe3oŽ©n®oWë«âÖŘH˝ę`3ŐKÝR·yaëëĚ˝^¦ź>”ĂŰhďĂű$Ę ~_Ó a" oź6/ĚČśTěîkgm>ĄÔ ĎĘzĐOěÁnµO„ ‘µŽBP­n7ź¸Űj 8Ź 7óŤž0ÝY$’mŢÜΰ/Lčđ,„äÁ»GĎâc¸°áVX˛đ~˘Đ«Śd†„y¸"ŔR'şąľY°]ÓőhçQV‚?^1ľţü՛»ÝgŘěźJ#-ĹpEzĆl4ËĆú´ˇpÄă]9Ŕ+ô0Ö*+¤.ZBđ‡Ą{J§N6@ÉAÝu3–ľ*T÷ĆiňŘĚÍzŰ-^ţsořşĎZo&©pŢRňÍIWú4pŐFäk!śĐ\˛:ÓXŘ{ë×5•Ěî$ŠńŁo4źÔrNëµ& ˙šď((çµN#á`y·!ę¸[¸Î¬Ć4 ‡¤Ë?ÁJIS~'"ĐP\-ĺ*ʶł™Vdű3Řë/ş¬¦żO/‹F0ĂÄRάđé&¶É[†ÍË=Šp ş¦ű¶č@ 4úŃAAźĹËę×H¸č˙!Ő‘/ÍŁŚĆ v^1M˝ÂQżČA:×Ë˝ił˝Ëkt'€5Ů2đq­9¸eđ§0fŔ´ç›ŕ®Ę\h•®!ˇĹőűkćwcýJ¬5Q† ˝ů¦__Ľ}ţW …ŰŹĄÚáN’…h6rëżX:®]˘pŐ×őrł'ěff ÔK…VLŤ€Ä8—yýó§¤|Ę(ź’ĺ…>-p÷úýűşů^Ę\şł+{ÓŰŔç"łoűýçv7FĽéŧ¸i(ąŇdëbŮv>şĽ…"é!vH¨ Â$ç±CÎ!DŹ.ć Š‡Ę7§xÔw)ßŃđ‹lf·(8×n‚ťŔWŻH3‰ľS I}§–‹řćEt…÷ޤANţ>/ŘśQ´ü:„C÷OB2żqM$ľGľˇ¨ĺWapz4ÇU˙»ŰŚ şL–łÉjÇŰţ_rŃáľÇˇčĽĄ]ůűP©÷ëó=uLm­|; ęáĐ)nťO:Ő˝ńř–‹Ž˙ď ©Ovř:śŹ==  ÝÂʇ%}mĹĚoż7óZ(zšĆÉý—vqdy¨¶„?yß]ŢIš¨môżďKŐŕť(Q2Ç«ĚŹŤlúČv (ÔČĎßcqĐůővhxŁ˝2ŠßUXŠmjÓ°– †”Í+,ßS·Ió$­l•ôý@pĂŮŢܱµĐŃ<Çă¸Đĺôs ‚í¦uJäa’Ĺó*ŰpW5¦T?Çćroę Ĺń—0đ!šě÷d€&đt†wHTËMů ›ÚŮÄXŤ †—ÁÉîď G>Eµ_xEĎôĹcCRűA¨ĐĄŤ‹Ó۬¶s¶-&‹¶É›ć?–ksÖţ‰ 3Ż­=Ăě2ĽçĎÝäµW,‡LPţBązG”ßź‚üF¸ÚťŽŽŔÇ˝ĐĘŇOÓÚSľBĄč’Ŕ*Í=Ŕ hŮÇČߪ¤„D¶DŇńÝfŇ;®g¤Vŕ­›ĐS…÷e±ť*T¨Ňꉠ=Rfă\+ľ°Ýî©6Iš)šT!ďĚkwĹDUą¬“®ÝńűKPSBŔžÝ8J?¸§t(÷|“†ˇ$@f±óVŰô§XóB"uĽłiŞçˇ3řú—nĽ­Îř,&Q˛mßÝĆÁqłî}łÁ؉ůĆW$ńaC§ř(żd¶ăÎŚJhě0ĹůmÖ†¸çÔ€a©Śg ŮCĺĘ}€†{áü!š§{…çx@ĘŁűĺ˙ŇÉąťíBĽüÍ[7tK0®/> stream xś}WyXW¶Ż¶éŞY”˘mżjE NÇ}šĽ§â’¨(¨¸Ń˘˛€˛ď˘6«Mźî•]P¤Ô`ąa…{drŽJÇť+†0-97Cǡ«]éĆ30śJQyU:¶Ł&¬Hv͢],¶-Î ˛mQ +%WtC  Wj’Ń‹8˘·FŘĆtyá\5|?˙/ÄaűĂę˙>áoO˙Ž »ťu÷»oűčä¬ŔčŃűâíGZň!^W ™)±ł&ŠÄ+q0+42U€ô×Ö‘oÔ°2{íĆä¸ŕPČžxa'Žb…Éúh†z]m(,„lŢY6äuČ‚U±›4Ý”r4ĆŞqČŘ{d QżóG2ś »?tżs‹Äm«t°8+2+luR¬†đ:ý'9-pZA‚#ĄÍ[Űö×ď‡CĐS]A°ś§gż<ŃKňŻ’ëgčC›đwI#\íňÁTuM®)cc6dEâ>tθiÓ÷ž]-®9ťwîÂźáˇtţŘĹ«‡ŕ:|ďWKŢ2Ż/†JŕMćF-FsŐPšž]P›#,Zޱ¤îcđšČňq#)$G .Çń÷Qó\Ű;c˛HÂ!VY!Ew¸Ţ¤S^Śnˇź\Ť‰jôý-± ^µ!fµx‘é¶WC ”T Růî-˙4ęéÜžÄÖMmŔŁĂÓk8RKÜÁ‹-[±¶iOšUśŕ¶·a_C§çńŽŮÄ…V h>cŔy+ŘPv™›č¬üĺa˛ťú3˙Ć ĺ«?JŤwYzŠ‰o¬Ť6ÄjđŢĂ™tĺ+ŰQuŇ2bBšS›ššk;Dşľ1žÉłbEóăfEËĺ'—+.+±µj8˝v¨–âÝÖŔ­p”?{ÉT}«hvŠY4eš7׿Šęµßö´4'Uź»QĚŘ[ĽďŘ„!ËvĹ—oŇ6G·ĺÎîČ9» üx˙ŕĚ`ßé‹ qó6Ł% řDČKŇ—ŮUĹf(Ż‹ ·•Y:bÂvÚ"—¶KWh ”®(0P’zŔ€qčĄC/Ť0­+‘RâV|!”Âf¬°đ:ě˙'t~đńĆ  •W‚Ä°?|ŕSř±ă܉7ĘÁ5řÁżŽüá2„aobCč Xxdţ¶ĹŕAtd@’H RŚŕŇżv¬Ý®mJ8WLżť¶ *¶kq9G;™?“ÉëŔˇ©+á‚T×Čę¤;µĎńtVźÔrë×ÄĂůj›ŃI"N¸@ÇÇÇö­Í|'ěýŮĹćzĘůŻ›.ś{á—g]'µ[±QŇť|-2Q6‘áürˇ]+3śPFfż} ç»fîě9Ćş˘ŕ?rÂß>ÝČyű¨ńS¸Đ&šf˛t—3LeŠ<\RČfyífBAŚ1˘a…y‰Ęcń'F=@Áć,í{$e$ZT§$–¸ťEĄ;ÇáĐnű­ńe;ŔŁ ˶ěŔAř‹ű––-g’Xqw ]+ö˘ŹUQŹöřGd•rŇN5Ôd™ő&ť* –ǵÜ)ź—(˘)ł˘5m×ŢćÚÍIU Ö–÷¦1h¦6‚#Ă D^ü„űŃWÎhí¬S`Ń]ń [S;µd˛ęqł’cB’´at/o4‹˝¤ zFX2@šÉ-ßG·­EĹß‚‡ÄE„ÓaĹ]ÇQŢwdMŰ}22ŞĂôś†p2E=t8t#s‡áҢ¨šyč¸=棦rxjp—¸ÓfóĆ’ëhç~“¸¨–ëXěkQ˝źěfĹ€“Šҡ¤Â‘ FźW"(,3.RÄv®W7zÔýčwDŞKě9 čôř:zS‘0©)Ľ—e†gFF%®¦ ]ßÎc-×r¨}[ XaObyxy,€PŞÎŹčiSSeµ¤ ú쥔?Ĺ]j›ë›AEîmŕ?–oŁÄ†F@0ĄŤ¬ˇ¤éu ˝ ĆG© tČ.ŠúąöWĘcŃ^˝mden6nÚ,ć¦&Ďž°¶.˝=˝ÝŘ Gřs€ýîU•vŮ9úőÄżśâS? îăŢ%ÉG“črö˘]™čüë,VHň)Ĺfk'ärěŻJő ůČ·ďK$ŚK±vYĐ îÂ`˛@6Ş„%őŮů–8ONË=ĂB2 Ľ 7$§@®gŞŽ:ZT‚ť¨Ö¦ršH1çš,`‚:^Ţgâ0©ű¦JČÝXT¸©Öł +ŠĘ1C~ânęţĆÇö˝Ąő´{ úvřZ ükŇ–~EÇh#!mËudÁFĂizŮúŠ‡żpÂć7“$ţ\pk%‘úh_ďIdőăˇň@{Ĺî}ÚNĚüd'´ë#’VÇ{®††Ťmú}pšzbś(oÝŢŃŇpö‚5sW¸ŤH—÷ÚÄeN N´şRßýŰx ~‘gŃŃTĄA~FAţ†|1qn@J(ÝĎ°˙i-Z؆bÓîŰhO'Ż3–ařOăP;źÖjGá@5™Ç kŽ›,ČÝň|dh’ÍqĆXzů‚qVĹCd. «Rö’»Ô×túľ3,„°â[şĎÉłµg÷¤O9´˙ĆTf)cˇ•»!âů•­iŤ{škظŘh[»äí‰3^Ó¨ś;ˇŹFŘßĹʛԨ˙ůHH/ YÁ`i˝žpÇ6‰ľňÁtgŃĺÉ%ě«%>„µăŔŹ8‰cńč-ť`î{ZPČr+Žz¬8áa„5â€k# D‰JQ©ú0r:»úĚÖĚCd¸(Řéw‡.-Śő$NţÓ?\YÚ”¤]jXM#˘ŢĽ´=šęőy “ć\vř?q:ŽůňěEMĽ€đboŽŻý|}i9‚ű‰Ü kúiOtţüňŐăq­YeÚň’˛Âm…FCA>dń •éŤŤ•Ő;E˛h”z Ěť1Î…S“ŹĂŮ‹Áo©ř°ŰIµd¨wřáĂg>Jń>{őPF°öUć<^€ń•#Ô˙Sě…Ź¦APhěŢ·XáĐoćŘżdĎßMž uŹh>ˇ{\Çw]Ďŕ⌌FhŔŞ’źěÍ §ČTŰš§_Ç gĘ=÷‹ň3 ëJ]txčŞÖCRs[Ç 'Łiî=Bó#ĄĽW¨áLÚá„}«N…•ľ_[Y˘/Ś¬iŁIăČÎSWĐ»† /-™EÔ]złÎîőhŁ19IŚ‹ kY^@ş˙ô±ÄÎżvĹ®(mG5çVr}~{Ö–‚ŁÉ•K!„_–:sâ4âŘ„sEc%ż łz‚G©ÉTW/îŢýůŠKąíTr|ůl­>O; _Ł*ÚDU´k¸˝N0oLÜŃŇ#‹śÍĚ ˛ôÖ–Šô;DyYI°Aěy‡Ţu ęŚ4t)âm{DUş‡¨xé„FÜ•Đ%¨m•GŠĘ˛ 5śpµj ŠŤ 0B2ßÝŹ##ß^ůDTwŠÂ»ň”ű¶o kĆ@¨§Đ c^xÎhŽ z:§âčĎQ#Ę} ęŔ´Ó -uµPěůŠňm[ĎŘZµ(Ô»<9áâ§ě˝6Ń›`EJ—§¤čŠď©w¸ŘÓJą*Ř YäĂîw2ERÝŘĂ8j‚aŕ ´¤ëfý_ź-…9»Ŕc7XJŠ+1]~č^\iŢň­-Đ(§ľĽôŃëŔ öő2đ»®Ëżaŕ´ °ĹqbÚ­I–hşö’yĽířřßÝßd"ö˙w$í33đµRď@—@dŃEŮ5ŠŠuG”4y]@^\¨Ú 4l–ô!śÖű•vÓĺ]z–†üŽšß—Ľ©šó×ĚżŻćäčAuv~Ňz„Śâ”ŞMü2ő1wéŔń»[kŚ9Ő˘łľLö/ĹŕÚ­e¬ä€^}E»…±Žö-–B“ąĐT\\q~‡Ł#Ăü§ňčÎendstream endobj 489 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8937 >> stream xśµzw\g×ö¬ ;cWĆ•Eͬ˝÷®Ń(j슢ŘEŠ€Ň{XĘ²‡]zŻ KqQ@{ď%&jŚ±b –$–ÄÄÜ7ßó~÷,h|žřäyż÷ý}ęĎ?vgwîsťs®s]gVD™´ŁD"‘ŮŇeÖ^öžăĆŽ˛vr p·÷^íăµď”ÍѦĐI ťLjúŚŞ7C÷»Ł‘]/vŁ„?ë,=×ÍńZ?×{Ă<ź/}çű-đ_°(pqý’`‡Ą!ŽËB·.w˛r^á˛r›őöU®«ÝlÜ×x¬í3ňłQŇŃ?Ž;®çř 'uźżä1řË!ý‡x Ů?tĘĐŚa‡Ĺ ˙lří hW—ćh0 ő~s¨Ůľ§!„¶‚đTĹ.ěŢl*‹ËNH 0P)ă±cËO˛uŽ;lÔŚ;ý«Ń*S˝ŢW_¦MĚHÔČ"sS’xTbĽF ń«Ŕ›s§k´×`0¸J—â 2A·M»üW»Z Ľ©Aˇ3Cí®"§«ćl%_ŐÓ@Ż_PďdĐ*Á˝&<ßµh%ĚMv^Ëßiö*î§0u§ŻĄĹnăbÚV É]©™Z¨€r´”f+»~úňĄLk‡t•©1ŕf‘ATÚl-nvíi&· L4`ô­ }†6ëŞvW5%Zh,V9ÂFpÔZ¸Ó{Őşđ‡¨„„X–ŕ™2,E6 Ú¸4H˛€,]ţľDĆ@oSÍ'Ŕ=µ2÷BúĆzˇĄŘ ĂSq\xÇćÁ@ľ ‰µµp jTä›CˡҵI©™¨?r–ˇń8FŻŤ•D„Ú XWkoĐÎŘĐĐŞ3!y#:űbÎksö@ł-‘Âăi7±8ëEáŐËđóxĚ}Ü“kiç^*ąĄQ¸Č[Ji—Ĺśź;ßGÂú#‹'M?Ęq7ô@şdĂ,ćđ ¤–ěҤâP7 {ëEőä5ňRÜ(ť·vÚ@w—lJHÝ%GehÍšĽj˝PŢ…W)ôüXť¨˘ílónČUŠz y‹;ăîñwÇŇßF ö¨ó//ËMM“‚ Řl °Ýâąě`K±÷Aßýpj N–î/?x¨x/ě‡}evev°ś‰B‰››űJ ´{‚ŁÚ0M¦ëó‚ĘxĄOĂĹx:›H¶(Ö'ŕ ´ IĆÖÖdĐß@š"Ď9ăźdxí{($5Úëäöupťd1řÓ_¨2ęäȆF6čëÚ ç’ŞŔ‚ ~}*`heť~Ă{ď7ŹBáŇ HŤP€2JÍĹŕ}§a0ËńşÝč:ŽÖDMcńŕ"ą&T9Ŕä¶XŽ˘č|HUÄÇCd ·ŢŇąfÝŃ`­đ$<ŰaG4ŹCËŃ”—HŽyk‹ŕ54RÇ[ÂőfoŻ˘ĽFs¶_€ÜĄţ ›Ě´ßÄ]ˇŮx Đ×S•[ä-Ű>”»‰™ţŮ3čt:9¬Áć{`PÇß^"©|jOÜůË)–ŽNEőŢ\x1$Büh¶Ç±Ę#•Çz߸0› 'qěCÁnţ>QĚźAER_I –ŹÂËHgO•đ2ţ]j&ůxŞEž‚¸–Ő0ŐKR‘éÎ{h*ąá8I‹E ŽU€b,B“ˇăí%ä«ńT[–ąGG^Ł×â浨IŠ¬qo4Ďút ·“ CCŃ ůž€ĹÁV.‚Ľ­Wfpk©ň{hc5ż–\„«Çćí[‘> f =Ôőü{T‡ëE»QŢU1_Š×HŰPâĎĐNc#*.}N’ĂôŽ{âî/#ćZýľJť/ř\SwtW n!^~ánŢ›€™łĽ ѨăµĆďî6L\#@W)đ:oxd@SH}šĐ=ˇ×ęĹÍ}Q&ÁŃŹöźg-Úş¬č ý"Óm˛\Ź |%“îĂąq(¶­9Ą4 ĘWça9Ł—xˇÓ–óđ)ţ€ĎwYQĽáĂľ˝ňö‘9Ű—§řîŇ*÷J»9. íÂ9ÔN`Sů§ŘT˘Ý ‡`/ˇ¨@Ú2!łFŽFÓěĐW Mߧj@­áTę HđaĽŠwč ôYU 4ńĽč!:H¸©O“cÓť&_= 7gků?řŤRăaţő°6Q[}ęz×ĂScşŇ¬őHČ®–#ő#úçŚ÷@L‰rÁMB)vX+ť$h8čWĺaŽ¤U¤öˇ:M!߯Đl×aäpŘ˙°9;µ R8á±32˵jkš}ÚŞĚ…Ůp–©.«„Ú%Źs×p‰Ń™ŔdCrˇücĆ%@d§ŠŹŠŽW9U8Ŕ’š.N WmËó*WůT(ż gŘşřűas{­Űć8sŠË™‡Áś*[ťLĆȱŚ…ŘĚäÄÄÂBNŁMAá~űębŇôÁŻż%u!îv 7đŚĽ2ąIÜě‡âHâ.dčL2tŞč'Z…ł| ŤM0íµo¨6Ěú]ç˙x:)âţ†_ÜŞlN%%ĽOĆă±=¶Gńd}ănŮąÝň쀽Ž™Ŕ¤CZ®͡뒒ż"9Ĺţ@)ôčó c@KĚ~»J2Ř‹dđzşIĎř®¦-=śśÂÓ|Đ LÚ‰ľő4ŹľĂ♚5<Ä•ÜőydÍőŠë—ąVyqŃ€v·˙q§]Oý…PU|)]ŁÉĽĹ•$ŰT–dt:ÁlئeÜKic•ŕ|Eüý5Ň‚¤Zű”{ŕ&T“:j»ĘEÇqi%Y…Na8l@ű î ´ČbŁů2&ő!šÝ‡‡üŮ&óé‰Ě™č8ÇvBi¶ľőÝŰ /ÇĂé™0Ť<˝żâb%7Ž&¨nďóžâú4‰ŃŁžz†Ş-zmć®Ll‰k+Ě0FVFßѶE¦RĚŕ|„Sß!g®;m§&$–ČŹ1 ůp1źĚ$…ăźŕ©ö‡‰Âh¬UgúC0D'ÄÇ+á46AUĘlH°(«2±Hĺ Ž‰"H.A’2Ű ÄH–®‰ËrezR2G·eé%ůű®$ ·ý@č™Ř “h0«G&KÉ/„XÖóNĆ錥*{N¤tkč—±M޲‰ł~ŐŽíŻ„ŕr–aĎÚYVăUä%gçlß"gÁňşUÓŻ7®ÝĚäÓČßÍđ+čú¸ÄµÎ^¨Čk4[Š›WC ˇŔh!Ôµ.›™]a!˙JÜ YĘvîŮs¤´ĚPSź{HPÝ> jđ€5šDrl¶oqBZDX/rđ8岙˛™żD Â0ĹrsÓ‹6›dšR¦Doˇ,®A˘úŐ+,•m˛‚„MÖW®HňMeCbü¤’‘űĎĐĆfçö]ĺ® ß~?D–¦Č#U˝Ă[Í°*23)m9Ô©w&XĽg• čś97ń»¨iv;Ԧ݆˝Â’™v›BÂ8tŤn•nFjiy®§k.ćú7¬˙,Ţk´D)8'XyÚş;ąÚĂ:Ű‚K©_-‘kZ(` …™WwúTZ)€źR§2­58mJ  âÇ·ŤdTCęń+ţŽQx(…•>Ź”ź„Ű*švŇ»!ç'n—AÂUąŚ‡Ţ[af[†Ů˙ŞÂ $mrĘ^WđtüYábGţĘGu^(±uQꄸČÁX-Ăb¤‹ĎHH"ťWV …˙ÂG‡I@9ŰĐđ‘ĚwEŔjŻůKŔ‚˝GÜWp!)MyLYpžP@„‡mËŃKőgΔrh?«ěұÄřź=eč’Á¬ú <ŇľA«Ţł4›đJéˡ?ŕĎ8üöŻďß h4“Fťuďµ|`ĎM@:sÇşb•´úŁ& šý6Ű ěP‚¬Ď(É+APYb†&Ü$_vÓśĄ|?TšYµ5h‹ŇÁžc±b—˝˝6 ÷čůóżŘ˘sŇĘ#v„¸Â6pĎv2Y…şŮ#3÷ŐjÔuříŘíęđcë*¸5+a9!5;MtK 4@ŃW%ůEu^őŞB`ž_˝z«6¬Ö·D^ł»&ą€đ¶ą ´jE|ś"™ĐěČĽŚÂÔĎĂ”ĽŐn;|c"ý˝™ŻKĘ«rőrö˛"+­¤boďÇ0Ä_ŽÚµt”ÚĚ[?lđüc'î©ÝŻĺÎI!ÔV'xÍ›«ú:ÝE_©7;ýš\´˙uÎśU(šÝ˘¤©VÇD©9ĄŤ˝‡lßÝ~—ö …:śxz ˝ţRX¶h± ‹ Ő)é•\îČś1ĎI(_(~-DÇäýĐŻR‰űő›pÚíč `ÖąŰ9xg'&ČmŠ°É @ˇ ĘF}ď=ăX?ęę3 §Éń@|Eş=Ř->€\s0·˛xWÝIťýĘLů‡˝ EĂĽ—ă7ţf58¶X…ą0jô‹äý¤uć˙Űĺŕż[ ţW»‡}•k@'tčxkÁ©ÖÂfď¤)ˇ€čX‚ŢĽm!ľ°bŽ…?Ź¸+ ąĽa×ęÂĄ·/Ŕmćg,y€‡přëŹjšőüôÂé}U§ šÎ#Š°zűp‡…°ëťöKý)ĺÎŢ·óďWČq?A:ßo:Ę‘é™%ČŇi34•PĚdŹřDŇó­ŤíŢ€DoÍţ1ťđłoQ|rťśÓěÜWŔč«t%ág݇řŰi«ˇ:a·Ú‚•­ć‘–ű—ylňňő.ńŮą»¨Bϵć†xÖ/ h–á‚MŻťľüőe´ô˛ŹGËĄđzŃý)E¸‡A¶,wëIⲯťĽp}®ĂSmS¸D%(3Űl6Úl4ޱjud,·Íڣҡ~\nRQ”3e!E^^!A>kO{ťąyńňSŽíŃÜßäSżBđ_ÖD5z”Ö„ŇôâfK~ť4XŘ I°q/–&ĺîB# Ę #ˇ8ŕĎJŮáý9GwI˝öW8HţľzR'ŽtČŮ-¨ ’ěś‚¤LM9‘Häăą®9xŇŮ,đąŹĐ5oŻÜĽRG˘käÓHâť!śN`-©5q)D5&]?ź‘véX¦XĎžŞđ"Ş™&\Ď…ę D@Px$QýýpďOłŐźî+‘µűĐWoč˧nőkX!ÁˇńÁśQWBĄş’HâćčŃp¨u 0­éŤáĂĐî Â? müšĆý‡>rî GÖßý?8ŽÎ4î‡LľŃOž#I>§-‚tŘË ô.8`śŐŇ6$đ‰ŔR‹XZ·}˙V`źŚMl|T lžL\vóFqłç‡ ´`‰ kŹ«‹}–‹Q)”xIK  Żâ5ĘŁĎ®<zăzľđD€.˙JеNhGË;Yjp˛*ňA“śśüř‡˛śÚňĘoź-¶´ů—#F<Ň|ňo 0Ô)ü±e¦íGĎIîý7ź“ů4ţ7 ÓD|žRň/ ľ†YÁ;?svÝ;Ą)ŹwµÜ’ĐżVąB0(U1©á-2<‘ŹP'%¤źľó,”‘Z ŐE¸śťzŠ!ËE÷Ą Ë[,ń$^ˇÖ¦ýäĹ'nBR\–3ÚÔŇ,ÓFkŁ˛!4©IŮhź,CÓ[RZ_´h}•a§˘Uü‚3ű2ęŔâŁ'QmŞVĄhĐ Urʨj[«DLcłč0u‚š$6Aťá‚žE¦¶ĺŐŁ˝wÖDůq J/c\Ë" KJňvž[Ý`9w\‡E–üł”k‘řOpoˇńôÁÔ9.ů§Ú3Ö-žlŢŠĐ"ťmI”^ö«wÜâíă“ď]“›“’‘Éifx-߲I©T«!ž‰MŽOÎşsŃÜÇaĹŚaą ^|Ô?he<¨ă5n9„ţX´j€ü?×ĺźŢ3uĺgK±«F·çßüŽc·¦C9TDGLJE„¤íČW Ćd™ …¬ÎŠ2QU[r¬¤‰NCD€/Ě4©®%>€nkŮ·˘GoĹhő iĄ_©§§źź§g©_eeiiĺżčďĆ@´"ČĚ(ÂÍ٧˙d8+SńŁĄ!!; e<‡;áQů!h$ę’žš– Y‚ŕ |·#Htš7óVÍžŇĚčtEx|T”ŠĂ?ţcN\Ä‘ęQ¤Ggć$edh9ôă»9Éd’ɇtÍ2ť¨®Ą5Šy;tC wăînűnóĎÓňěÁ ćř8Śv›7>‡ŮIăęgí›~#čś„ď‹÷˙Tu5ů6Üa¦fI 7.P,Ů1ŇÚö }ČĎŠóđ ÎÁe¸’v˛uĽ™®‡]p%¤phĆ*K…Ť)’ZĂĺ ňţNĚOéipŁÇ©2kĺüYş4ţܲ%ŔMX†‘ď9^Ć´ä’ć‹Çą ý1ě%—’ďv3ů.Lü.LČä?„ô­·Đüß1ýýĺďđÔś}ÇŰ 9Ä•ĆyÄn‰ÚłĚ'/”Ľ}Ć"îüIxm$ăîâ.ŘÔrĚřUGA›_ťU_R¶-&Ô*®ä«“µgyşoú49ű|ľ~Ćęex5v•)ËęÇđ´D´â:ńëKP‡_.ęEhô3Ä31żÍ’ÂýĄ·ß/?{ŤŔvÂégYÍrŐWŠt•G7ÁÎpäJv 0ő§ĆE&¬ôŮ"÷ظ]ĺ«ŽQű%ÄBŚ:V QŚ"ňąý’űµ †á>ó=·ŘÍÎ?·M^gĐÁ¦Ć»ČÓĎ-|ËŘç‹uyúôWÎ5ęeŕÖ'® OL§I CřŤŮ”°h•°µÇç[¶›şŁÂ‰‚ ˛ä!pśĂ8amÖë1=Ď Ĺ* RńíMŤ±˘v/G4˘ő:dŢřĺKŻŠ@ť6Čěč«Ŕ¦ÉŻ´ÉśíŃŤ`ľYŠ:N{Ť©ŤvaŰ\8´–f™beѮتި뵧Ů)ŞäX9Űž˘«âTAŃ‚ĄßŽr„Í©›Šc´ńÂcvĎĐ( “ă#tÄä¤j´)I\f^íÉ{pô›ÓBňś5[I»m+?{ż­Î>›ÉD˛>zŽagĎVkµęĚŢ»ňőĄĄˇz×đm±›ĺl±lŇŐáČ1żţŚX‚‘;˙ĐÝRšMĎ$=ďwŔî=ĺĺd¤)©Ń$’Ł€&<Ţ-vîŇeňČH’w•‘ý2żG8´¦ç˙äcF$ůţ%ŤO÷ęÍž Ë'^OĚŮR3vRÄŽ˙‹8ŻŰÄ•ŇD±w«9VÚ Ü®ăv8‚­{é]ŢÎôşó[OĹ=po,Ĺ>¸1óžËŮSHüÓŹH&—(…Ť°>ÔĹĂj3—KÁăĽ27äÜ…ćvŐë'ya™+p†u°AčK2UÝŞ"µ2Ź”mHłLŠă%¸ $dÇ2ľWě@d¤6/ýRvVjĘmČ&b×Q‚Mđřq¸·+–Ă ‹(°=xdpÇh8Ą=•v2©$çŃţ‹¨7˛–Ą kďbĆqsW˝¨áhńQ¤:*ôÇ )Ô(85‡e,Ůűmí‘ăp…y6ţĚŘ!Ó-G‡hl6q™‘µľúĐ•ž“VÁP¦ßŻ G¦?5ţÁÍÜ őÖŤVŰp·»˛Í;ăwC>s᫆ë7.ŻťË·HĄ–ł×N›4÷băŮŞËq¨ëĚŠŕC°Ľí!»B÷şt7‹‹kžĐ™¸Uu8vZ_ţ°yŃ{^WLJĹq;ÖoŢ´ (ü 9*3R:Ż|E[V…-_'÷ń˛175Ď”\ŇĂ34NżG¨Éâ'¨©É×'H˘îK‘Óߌ_˝!ÄÖŽs°ő·‡Ů îţĂ0drˇľál çFă›W†Úhv{sűÓ*ó ~ąaŃ[žtx¤¨ Ínň1ϤS·źŔ±ćŠ0Ř î—Bjá(ĂĺPqmůŃ=ŮŐćěÚžoË° •ĺ–´tsŻ÷yµÍhľË_‡4ľmň©ÁýAÔü퇵-Ą• ßŮĽoádm"p©‰™š´TâUf.±ŚŤůłyż˝‹ˇyé®ęř şGAfŐW·\E…D6Oĺ·˘íRxióµSĹבg-ÂŚ®S®1śGôĂR9{>ß»đ¤Ó2LÉbŁ #żAJ"jĂ„üĎŻQ796C ¤dŔ<2e]ťâÎśî šÓĺv?š_CĆź!¤ Ś9çKÁ¬<7{n޲•čôí©^Ąhz(«Ű¬™#,ăŤŇ~•ačV÷Xgvúâýoz4ý"˛Ö›łÇO4/j“ Qq±±Jný‚…ŢsŕKX¦_}<8?0—ŚáYó¦ŕö¸ó·ÓoŢ8Ó„LrŕPŕqůWÎGăjŕ{8fHIJTËZlţϸhbŚµ‘ť‘ˇIĘLăxmł2%]Ł…‹ĆR9ôŠÇóţĺ˸–müP)¦ÖÎ]´(MGź•]|âeŽ·jňŃáň?ßlŰPPá:Qš(OgÖиçR˛ţw=şDÂzu˘ŮÍř<`¸JSZź¸Ôű’Ő*ůęᶠěÖDä÷ŮDź<˙Í÷„n†5Î[fąşź}ĘÜęńÜŘᶛ}ĽÁĆbâýĄŻžŰ·«–»ju.ě0 ůŇÍ#†ŞK\mÁÖsŰsđÄŢoŢ©»R\ݔȴ´C+¤ě,š>ŃĎÇű®ę,{«ŞĎC?ŕJ[˛H/‹őfŞ˙‹“÷vל<.×mĘőŘ·¬Đ«fm­3Ӳ؋Fďťn%l__K‹‚!śkůY AA…+ç”äB‘Ż1!ďíŕZ~”ěh}/GÎ˙,ÉŢk­}~b« _úżo”äŢ"› Ń·­sr5żJZZîĄTręÁ§0“T•úíĄ‹ň,ěµLj\Rśbę,ÜÁŞÔv_uAy™0'˙'kýˇ@›Ü}uVŚŕX)hAšŹ»#37´Đ(@sö 9¨+ęžÝö=ńZeÔ¸]Á­Ăí"±řÖ™™¸ó)lzw}´8”$mŞ€Ó­©„\~ D‡žn|ú i“gĹo7Ľµ~¶­ŃśEńřŻĄgoáaZ¶`1Çö™˝˝$ĽD řö$/†gs}‹`Ńív X˛hnŔXÎŘ٢Ěʆô®šdöâzuĂFĎ./*®ič…ű¶ä|Ňmü. #ń6 ­n+PçŐČÔ uťôU0ĘřxĄ  Cä/‡žÁ{:ËĎĂÝ°YDk•Iń)OľAě9îj—…Äđ௿@@ôO‚ďwzqď…!°…ł˙ů‡uł˙Ý/:PÂO꨿ů-kŞŔŁřii`‰·{o€o±ąˇ@_¡ů=˙ň9Ů‚¶UJÖ‰–¸b¸"nfš»Jk¶í^µb‹S|çY»*Ů‘Y‹©˙hť˙ĂÚ@l5C7>tŕÓpdĄ4L$,¬”‰ľĺŃŞ†HÓx;2Ą_ÜořęHE0p­Qűl—Nd´żäź¸ůŔG¦~«ŞL«ť·0Úůż5ó¬w„pţŐöEë…Űg˙˙h•˙®hî-ÝšM4d…Ä1¸§`®é׏ëΕVÇy•s]tüÜ|ä™™˘“:\íČu0YíŐ©˝.Q#0GŞFŁ˝Đ©Eý_Á”,2endstream endobj 490 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2093 >> stream xś=•yTWĆ«ŞĘ ˇ‹A©ĆÜ'Ć$ ˘Ł¸DÔV@Q1DŮe_۬˛Ę˛ÚM7°pĹ-.Ł2.Ç8˘qŚĂčÄç–ó8Ç)Č™yďż÷Çűî÷»÷}OA™Žˇ Ĺ$Ď ^ˇ‡B.pv ý6päČR>Üů°Ů &ŔÓŽil‹iËG“®XP#KąňpDdŔž˝Î .ZĽäłĄź/sˇ¨O(oj+ĺCąQ«¨Ő”9eI))Ž˛˘xĘššBŮP¶”=ĹÉ‚”)IÝWÄ*®ŹńsÇd…É×&gMMMÓÍśÍi%ťÁŚcrŘńxĘüŁÉľ0 DtĄÝ1Šw&‹łRüÁ,Ą)Ž€M(MĎ#Úá7S4 Yé.ŔF«i›g„ËĐ‘e#2°ĘUůeçp˘ÖŃ׉ŁŮ\5mČ{ ÝĐ ĎA—Ĺ’GÁ“Xil33˙¨x\5˘÷/QÝŻ|Ź y<š[sNŇFÉ”żčÓşÍ}ďvĎHÍn€|‘n¦fnA ŠÜXŁfP™g€[ —…—ŕ*ćî 4 ±GBö´Ç´¶¶×u ňőW+)M{°^šÚ®4ÜĂä{Ö\¬´íyčŽŃµ¶./ß_´®DöĆ+¨y`ŮZ h´™uŔ6BAę SĹqGł!6P/*Ü ě!2őŢÚ°Ú#ŞÎ ćQ˘^ó 6ł®ó!jzř@w˛Y‘ ‰ŔF€&REL,¤UĺÂń:ËjŞ:|jÁ¦ ç:Şä"/|Ni:ńŁŢ1ĘwH«E'ZsC’-ř‹j_Ć#8"t Üj°Uî qDo5“3s‡“S{@ćň”4Óö?GÝ{Ř{e@0—.kô‡DÜtťőĘf‹H[sjé\#ßIÂF-”C‹ÁĚ‹Ő·É,/b~t±ź.¶ą­˝î»“±UYąBKa»¶ ŘşŐAfu)JâŔr)sĐ"îÇ'b×wőçú-ěú]čŁkË QEv!Ăs§ćĚO:ě»W×.Ş8—'ó“ôśŇč%+=né/ h…heÍ…ICÁŁŤóŻÄÁm{HL„€gâţ˙‰LeMUue ËÝN?vÖçĹTśőîT©ŐdPĂÖđŔ=»R‚Á/Ąg1źiÖőµö‹ć@&şŹ`ý8MĆ*MęTРв-˘Ą5÷J:ŚcůŠDHŤËÉNĘÂ=wĆúKT€3Ď\śŚĽ®*+«\ĹmŤ‹ĎŽNłýťAÂn¸:â±’0„%6żÎĹyřŮId‹Fä’}(tR”ăUĽ‡nüą:›1—î§čĄtýM˝˘Wö‹V&RŢç‡r0ťh&‡¤ÍrŇ’xÔ`F.y+«2ĽaAƶÄyž‰‡ŕx×' ¤]€ßˇîĂícĘ^Ü-i„芭ń«ÚÓa+«€(iÄ[1 LĆń&RÚd‘ŘKL=”„§dCFš°ÂëS6F]KWBżöZ ;\ATj¦'ď=ś•÷{čÉ˝-ń N7Ę+(˘‡źÚŁ`ÍUIxWÓY1ië3R4®/3›I‹Ć Ý˝§Xî?H?»%ľ¶EfĆ_Ét2ŃyĂÂÍ} Ťíťőç.T&ä ­Ť†R=°g<\×ěóp_- HJ†l±‰c¸ i%=«»ť]Ś8Űxí FĺT9ŁĘíí¬9ÁUjŔµ<ô‡ ‡¶ë®Ŕ űČĺ†,8~ůú/ýŰ ˝'Ú;®ú”Ő ş–žcmŔţ-oý7I9Äz†Fµ';;'3'5';4,g‘WŐg zhTŔ,_58Ěß–r§ęTń‰ĐĹr—¨Ţŕ6ż€ 0ß…C›8{ =ŢľTŤG…(m—‰?CÚD2ĘQ‰Š!q¶´ŚiÎ.ŤÎÉIHČoĂ6ScQS5cČ{9„?Źáôă ĐxÓlÔ9ŢD‹Ąú>´h2*űPŔŤ#Ój/;ŕŃŢq€L¸µQňl¸°5 ]×]tĽQĽ¤˙Xî|5śÎj<‡Ř ˇFcc“áFŔÍédYö'RđUń—]kŃĺaÄ]ůŤ¨ţńmUdZ.ď+·…+Ó…řv€j-/‰ýŻÁu¦%÷K˘Ąf´l—Mú Ą‰Ô˙a OüéH 3 óŁósŠłKX5DŠĚDşäayy~niáOP%+,§ă˘bŁă˘ćÓUd*'Öý2VŠÎ0Đ—×W$˙PwM×…óqí”’RČű†ůFÉÖ¨čĽ=óMd˙›x@j©¸Łĺ®ľ­®˛ż-č%4Qą5ÇŻÚ󱟰tżź¬dÉD¤|‘Ç%?=Ç1‚=đ°#ü _™ýlJ|qhśfďţRÔůěܡnx<żÔ9Ţk–×ůÇŹ/vëj´sé9Ü ;mF«¨CËłz|oT<’Ä&´©ă)˙`I%ź8}Al‰đĆ'éĢ»!Š·´Í Źúď^qp ÷PmY^Gô˛§#[#Â÷yś÷B9\>ĂbŘ˝á=Ă–Î…o˙ Oţ}­áëÔ|ˇěŘY96UĺŻpÁËhÔŁE›^q -»Ĺ{#ŮqXşĂ#OÖŔ~˘Úäą~gGü‰ö¶ú.Ńż<[+4Őt•ťöďÚ@µ_z|LŚjúаŽÝÇDAfC#6 Í Ľ{ő˝ˇľ¶¬Żn˛Äa8•ďŇůűůűë‚ş»uşnÁ<ĄTÚ\Ś»ëJJiqŇă…q¦[C'Ś=•—§Őććk‹ŠN_ź0˘ţ ±@@Łendstream endobj 491 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7814 >> stream xś­zw|TuÚý C† ((q xŻtpPĄEştB3˝’Ţ'™LI¦Ď3˝Ą—I&mŇII0‘Ž˘`¬°«»ďęî~ďxłŻďw’PtŐűţ^řđOňýžç<çśçąń!†#|||߸i[RBhâsóç­KŤŹ ÷ţpR kř‘ńäűÂ#xdxë¤Ů˘q¨řqÄ{ö1ÂűgĺŠÄ•I«’W§¤ľš¶&=c]ćú¬Đ ‚°ŤŮá›r"^‹Üµ%zk̶ŘívÄíŚß•8iîSóxĎÎnü‚–ĽřŇĚYłź$)Äfb*±…Fl%¦ŰÄvb&±Eě$vĎÄb7±’Kě!Vó˝ÄjâYb@üx•O¬!ž#Ö uÄBb=ń<±xŘH,"6‹‰×%Dń(‘HŚ!’±ÄăÄ8BCřă >1‘x’ ‰‘Ä(źQÄ* 1śpůĽîóÓ°Ŕa×8ĂyĂŹűÖpgsŃ4r)Ů=2fä­Q{G}8ÚőČKŹÎ{ôë1‚±>cŰ÷ŘwŹ7Ť‹ń›ćgńűá #o&ŻoĽdÂ˙§ýŰřůťxýɶI{'˝űT(µŹ^ů4őtđäÉU“ß™ü·){§\ź:|ęŮi’é~Ó˦ߜ1eFîŚk3żCMc~öÍNÜhŻ›ŮźĺsÚó(Çł¶ŚW(a ÚZŁˇB<\­Sk_*ąBĘŢě˙Ô?ä•UŚFŞŐfj]ľĂUo€Ę Ťę M…PîLG+tŃzpÍT`+˝ŠĆů#×Áľä›•& ‘J@ )C[‡Ú©hU7i.€2š]Ť”<6’‹^Cűâó-XBHťĚ<§ăw˛ě,‡ů MĺŮe &WEÉ’“go2S[\ä˛×X«éŠăťh8ś"?ÝáÜűâľÍ1%#¶!˘!+] ż†ĎśgSˇNç4QeWĘßpY‰RˇZ ŇËŮă…V jľÔš[QPj)·Pčy“Ó\irň Ź‚®´ľ¨şűÚu ë27łŁEá´8Vť™dp]ô‘ŰÍh¶‰Â?ö…Ř·ťč ŰÇ3ń ŽçE”ÄĎÖö¬˛ˇ1µďß‚Č«[.°>{+”b8¬Pî®…5hT"š}˛żC«­ÁČ{˙Ó%4úŚ‹¦ hÄt<úś·čĺé,—býąçÁÖj&ŕŁQÜö5ńôVö}Ţ3K§˛Ă(ö1n<,f]g¦Ż f_´ś{ŰüB =ć'źź& A‹†]AW8ŚąyÚrůyö1–ÇNagL;żé3ôâáoťIäAHĆ´¸Í‰;ví2"Ę}µŻqOĐmgŹ4ňŤşŕ-řs‡]0nĎ<·zćsŽç¨gOgÔ™ÁH‚ÖžrćSW„\ŢZ˛řlÇf°vÉ?§! "tŕ~•R!™šŢÍ.cß°ČĹ O˘)ç\蹏Ń0úŇ7ßô|ä?Zç<ź˘Ś5í-¨Ă +5R×bwąŃÜAÖl~‡ĂXĐAŢ?7ż±yoHtl"%9Tú„P€PžDłÜţ YĽLˇĺçcŇĘMJK-¦{ÝÍjüJ3¦{AvŮn¶ÔKčV4Ă’ă ;†ËáFŁYh6ÍŽe×ň$©!»ÜšwÓjĐôVşmµ6źűčMŕwŰ·Ĺ…&łŁ7Đc<*p{|0gÖ~Ćń”0ëyhęKcy{ńair†‹¶˘í(eĐKÚy°%‘ÝĽhćŢm«C—9í: ŠéłµXt8ßr?ů(ť@ŹaBîc‡KČ|‰Ă¬`Wńî^Ѣ7éĚzŠéÂW°đm2˝Z“$¤$ő)-ű€d9ě(v.;cQOŔµÎ¶šÚ::k™˛ţ( ŃŞ6hI1>fľYmil1@Ý„;żqDzęăÉâ_[şČý˛Ó }n4˛ěí:ŰÓ× V¨Ň–%Ů…öD€Z«Ň(HL´Úí:ăľĺF‹Ý>ç<Żp<«đPcuJϧ¶˛TĚzv!>Ôî}Őů~νd&˵ą˛D42µÄf‡A_f¤ßDÉCW+€J ęL%X-Čx Č—¸g‘ÖÚ4€zś‹WÂędŤXťFk•Ú|P“‹tĆ2=U… 5 Č~47'˛Ĺ¨8˛|™*—f'ö7ý˛nL·t:Kń—(É_§7ŕ#ŕKúÔ¸ {&úęŁbLćŮ78ŚË;¶ŢqŕŐč=BJz<˘üŔ˙RÝ,őV=uë Ýw ř&¨ QŚTJRlÔ”ą‹zµLwĘ tŻőxa^Čń2)Ľ®¸ď!®čCÇ!tĐ=Đ«îŇV€'„tw%X Ť 7Óç‘É÷3îE[nrŽJ¬‘kUC¸âţ.7QŢęu&0ń˝UkŐŮJ*{µ0KÄ2îTp·:#ą˙tĆżš¦¨Ói­Đ÷~a0˘…_`Ý{ëcôěĄ>LňgO˘qoq§Đs<ř|YY-Ém….˛şňŇǵmy*N%K†V qTB€”‰!Kę€bÚĘ-„Rmˇ¶RmŐ‚TŞI 4Ň„¤’H çľř6⟪F ?AśßÓĹłH5(Âüßá~Ś¦|ó^O[=mKsF;ŔzłÁqm÷7Wéí‡,t`ŹĆn°eľfa‘;ĂAĚ/K@›-Ł˛÷…/ßd2¸J,Pb©ŁßG}ľ7ąĄŽˇš/嶡YĆ"ĐăBVćňRó2±›G° }qsî6ÄÇÜUl‡VĄ‚ż§)üزV÷]ăúĂŮâ“ćÔÝďÖj3”h»`c,)P[4řÝWQ§ŢŚ9cŕ;dĹY ňD™†ZÉv+łA“/ć ’‚ Ę?Üt¶é+×%ÚZi*‚r˛ď€;äŮv–b°źôEFĘę®ýÓ) uJZ^˛(‚N HYäó§Oonh¨¦Ęvv)ʡ *]Ĺî˛ö‚3-ś§'5ý-f }]Î+AÖ&°8,Ćb =É´YͶËŔŻ´¸‰*dK-‹··:éNčRwińę)Öň!”ćź-:‰F~ÉaňGx-wbzjzşŘ"7Ë©ęCN.IűY#;b§´ŻéTăçµW)S‰ąř!1_”µö“ó/$žFěA˙ŞˇĆ0Î çĹď‘ŰçÎ÷Ď0ĎBžMaVC,ű nŻ—ą€[ S§—áą^†«D,Ůĺ/Xľ-`„AŚKÖ©×ę1Évgł«&«0S˝^^s"üÂťo®}í¤ŃH&ŢRg±vżŘá˝÷OĂ Sîäął…'ožE«ľäx6ýĆĺ! gŕPgĂ» —˘gá8ů`Hű;±ó÷‰~ ąč©8y¬RK şâJâ~îĘ­‡+ßč {Ű2[~NUvŤ€'‹ŰôŇŻ90yŘ ZąFć·†}ÎÓÎńěÁŚÎ‡|*Z'±HÜěôW´Í«*żôÖŰfľUg×A)iQ™ä™©jH§b Ҁϭ@jÓšč"m‹[vN®PĚţťíń˙]µ6Z­çq?Ř Ě!×Ë#ĂÔA‡C!b𫿰״wŕ ÝťjśL-x˛(”CÖV°ÚĚÖFSÝ‚¦!'i¶Ńś lq‘Z±·ŃĽ˝ÔzĐmTžgę±OY±/áB\ňşFɇč’Óçř Ô‡ť8÷~5„J*ů…=ˇ@f%«vtY›éfôTѱÚ7{o”Âó |×WŹn-HÜq`Ż ŹĘ8ł×š äĚťě„ô怮ÄD×Ţ:v·r}yzxšdo~ť>_¸>séfŕ«! rŠ¬6“5™fqjjćCé=GšÚJ©ŠmoHk€üţ(šXqOPÔ!4â-”ŚăpđPŽŚÍŚ‹Ą® ¦»Q7©:O«USłd­T ľÔEGôň<µZÔ¬~Z«Î HţâCkŢCĂŃHô   ·©*Ż¶µÔ#.m©}qE}G{s;Üź†Ą-ľËć4Ç3iy8j©%Zµ@NĹ-aIvľ7l=T'1ť¶łýŕŰMD Ş ýjxkd¨!üa81±–sť8b™KŻŁ8\ÓŻ ęDË˝ŤűËIŔn2Áď[fˇš÷CéĚú_zFŻ<1|óŕ˙˙šEŹ»ş°Šd_\ĽČ}˘včôí6ÔB Y)tdS~&I„b{`gě›?|ýý_\•DíuÎkˇ79LĚ<“Ě!Siµy2jĹĽŞ w¦vź:^ű÷š#tëĹľ–n¬­Ýšâ°= ÁÜ:„UµŐÎö7BÚ6Üňfť^÷zâłż{ă‰Ô=T™·ü#Çóqďn×XťŞýÎ,”AÍ>ÁÍ5HłŮŰýçü·3§4N &(źĺ˙ÚĽňDh{¤$HĂ—IµŮŢA ˇŮnt¦rô4sÖżäÂIC˝Ž4čJ‡z.ى–â¦ă^FĘö_oşőŇw¶Ű»-µôAnĽc8RţQ#\ ŮupĂvę 6ŕą#‹ţ4Řf!Čʛ̾¨LnZň=ôČŽŞäXŻ2ţ·›Č¨ń,qů Y_1‘79žzf -™ţ-;Ž eĂŮ<6—ťsçi4 íGQ()¨E‡x°0šĺďšżžĺ,زČůŰ?EŁ{ŠĐÓWĐúřťŻßűČŻnf'zi´ŔíUĽňŹÍű°Ňé“zťĂ^¶ŰăÇë « ›ťĘŽŹ•S™ě0ßu^°ł0SŠésÜ•ý#%›ň™|Y¬80ň@`7ŠŞˇ‚tfŰ…©©Y1A]™m?t˘¨V vÖ÷Sn©}H$–qŃ"k›ăx+đ­P©)&(EiEf”啸\-Ô˝qľ˝ťwűxĆÁń$2ŤĽkvdÇbůń{®ď/‹čłHç‹ţŔEăĐ“C#é…µ<ČĘť±G°3{÷ŞÚĄÝâ^9š˛a`#‚-b“™â^ÜxŁ6ňłŢXŚ“–q iIŇe‰*JTź\‡g7v8;‚ťĹN^Ô»ćÚѮ΂:s±dŹ"3)–ľ?G\1ÄC˛ŁÂZP‰SQa~yJvĽ("Ľ-űĆ߯ż}˝ś˘@Â^[†Űk§ćşăHYŮK»NîĆW:c[,ŁŐ"ßAŞ°»î|čBcťL˝—07żt˘ţĎ-Ϣ4)d…\CĄěIŠ‚XH+Ö|Ť^ĽŠE›­!ŤR--VK%% Ô$‚ÜQu ‘ťh'P6&S,Ő±/L×4*Ţ_äŽĐmű„ą^IŻnJ˙®Âšs Ť8{űć›ďůÍé—ŘŃ4+ěßËK“ÄI±*J Łµ±÷đ x=E­ěß$íćŔv·ńá·»kcbâ©÷P÷CŞ;«˙s­F+Ĺ/•ÚrË+ KŞ ­ZíÚZuú˛ĆŠĆ®óWţź«ÝS '¦ęq':ćÇd#źćŻ&ř•z˘żáY4f±X«”¨©śí qXŘÔµŤ5†jC m¨2†J8shwšŇzésxŹüč•Ëěă[úěöő‹‰•a‚?yŹßŢ}9}đ·ř}•ř"‚{čp•Hť/ÚNK÷«D ý:WśŤ;ŁáVj.Ĺ…ęŮť;÷¤ŻrżËŇ`Ő[ô|‹ľĘĽđĚ‹ýăăĐ'{ßśŕ÷şńó %&ĎÁ’‰tµ5…M…môôŠ˝^Ź/Â3Ň5/–ť­Ľ‰lM5·"‘2=Mš(Đ K˘f‰"UXfřŐaÇî4ˇgŚ”ßÓµL Ż2×™—Q’YßŘčn¤źd¸=óë|ĐľK(·b ĘçA˝Ľ3Ą1Ő-1Ě­âmJ}lqN#t’ź~đĺÍ;ukV¤hĺŞ J+ň˝ż 9†Â؆(µZi>´=âťŐş,ě2cYüoD sשdÚ¬v*ŠUoüŹĺZŐĄŮ‘#˘ÉůËf.XľĽő‡*S­Á“˘Ż#gŤ’@6R#תńHˇ0©ĚťŢnĄ5Ťö¶ťrŹ‰Ő‡&˘q÷ĺů«â(ćŚâ´ĽŰĚ(ťÁXEüŢ„®íłv±3ĺw'3ĺ:ßqŽKź‘=¸Ö›ÓĎÓ*âŮGW_ 9moqčZ±S{Ĺ%+1'&訨őłË×®•clŃ“žgÜ ¬ľ ëöA«<Ł˝›ç^ZŁ3‚ Ăä]ÚPývnNzŠě-ělŘ*üŇ0Ť`0Pz˝NgŻéE“ë*Čfn¨ärM>ىýÍů1ůy ±P®w Ŕtô¸ŽŇÇŕ„účŔ2°Â‘ąt.Wńz5$”F(ÂfŤiŤ&2-ţ^†ZuV}-”ůC•h“y[hŤtŕb/8zC™´ěKźĘJď…Ó8( ~–•Ä»k‚LÖTUTYęt&ÚT :(„KµmUE••µîc§öôYn•*WĆ€l`nsÖ•µ×d7í ŹĄ¶­ crţĆĚő” ň?” KťMOEÁmĘ ™°•rP©E8OČq*\Ő›ÚvŘŮTî śíEgÁ0”Ł0˙'ŕ]»źŁpŽŠÇ9ęŔoć¨,ăÇň&ĎźdŕŽćŻť¦F““ţ+3ă?›˛çôŹ—ĹAäńŮGn¬ąü0ŹÇŁaµÔ×Ě°ÁÔÄLM??°rxx‡|îśá ¦!ô• PŞ)yjN€ 4 ř˙«¬Ę>ŢŹcĄ2 rů»ZŁŽ´WÔş ©Ň–˘ ÷Ňfza„"=39Ćó<4iZ˛R© Q"ľfŽÔ V-]˘­–ăQE,ÍRÉŮCýYţ»™J߆ă:{Ńŕ©Ž WC$ 1†ĐJđYúôů©zúLż^ S–sYç(CfŢőďx§ĹŃf°ę€gB´0ň Ď5v¤˛äŠvr2•=ĎwýýMů9ç6‰ń®hऀ¸ěá|˙aAËW‡Ń 4˝Ž:ŢńEűXŻ{{©­Ňĺ.¦îo­˝Ţ´<íü‡ňEJďĺ5‰jâÂScăŞň*+JF•űňž űĂ%řŽ "ŐąĄ ŤĹ!s´×Q6śyśyU8ÇĄŢ`†ťÉż1Áo2Á0żŹšÂ\Ô›±˙řřUB*—› Z­BăďwMŞĺ‚]ëŠ(MuÄ’] ‚™qěJňg°?ĹłOÉâ˝ó 6Ć ť¤ô—t šżěFSŃ”ZęzĎex1ńő{đâ"šřo°LGť<6‹[pľřłâβŁÇŠant G,iŠ\ś!čťh*J í&JÇĹ(Fž!Đć“>·™łÓ>žŢlv‚‘0T6ŞTbŤB)đ>rłB…vp˱ç †¶żČęôąÍq#¨śçőHŞ.77¤“3—[lÇP–€ZůpPęyžSX™w á@JYNMł»©ačŃx†Ó㏙‘ĐĹs&-áuŢnG ŕ˛C‰ĆłĽUK÷łÜÍÔŢgCŘU°€Ś–FßľÓ‰¦_¤ć¬ăeěßł;ȸŠ?˝†Ž´\ĄŰ®ťp6ŮŮš°aEŰ2w(Úă‰l–óBą÷ٱ’qĹŁë2 6vłŢ¦3zu˙®wZF…B«Í•P/O 'Ş•^ńĎ!qR0żanéĄŘQý‰˛8YŢ2ŕË«Ś‡ö®ntчˇG}řîSŹź8˙˝h44úÇŮś+ď˘ö/t5ş‡š’+ďZÄďy±=âDSßĺ0hń˝í.îÂ"Ö®…$° ŤŃÖ[ËŇýŃ!ôH{Y~‹XˇÄć*ť†2KŚb‰Q“_“ä™ę.^C[ĐÎŢä%ěôçĎÚB%‡¦…,–®Ň÷˝*Öş˛Öh„ş,WNM¶;ŁçČ=hĺ˝;Ô!ňÚćDÔu7Fýĺ«F‰Ęx_ţő°śÄ(Şm48ô:đŞěęry•¦Č°/>+¶(ôjµJ«QŇAYA˛†{b‰Â Ň«pŃ(ÔŇWŘ·üµjmž÷Lxıč  uôĚ›¶z\ůŠť;§d†ÓÁ/mÉÂőZ…ö[VŹYL6—×WU‹Ň[âVv­»…žŔŃ÷I4÷ޱ=c]>ßöť˝|ş¸›ĂäŁ4ć7fŐ*,Íé9ręmxźĽľáP;lć´™ŃEIv1e–é´ÝáěË̆ rń•]7q¨&˝żCŁ?ń¦°ŹŻQŕƲȩW.dç9ˇš˙öµ·?8~đŔVjE˙ĽĄ —ţaCp×…÷Nń—^ęÓW]Uâß=SŰÇv2ÓđLŤfăEÓÇäňjÍaÇłX?v ;+ČĹG#ÎîčuS)“S7oĎLٸ $Ö"®?b4t€‰,’•ĄÄf'FďęI>÷矼ÓKýM.Bp\Ž·*ŹŢO­†÷ŠÚĐ“u}TłëŇ»@-ŮrŻťQ˝pG'!ź ~7µ­?AňŞ„I”ß–Řř¸řô’¬şfwŁ{č#çĽůr‘žŃĽJ塻^ZfłŰ)éćČŐëvŠďKx9z ŤF#‡•łŮ™?ćfů ą}TÍʱŤQnßů©ě&\4é43ÉQHQ‘N‡#EeŔ>â%vĘó;Ś]Ďa‹mcŮ×Ú®­E@šŤF3ýóOľŮÇaĆ1{xp:˙|v_ę;!§D8¨TŢŽ±äŃ'^´.‚`'méÁĘŮ‘źTMĘŤjłŤřMůśBĂĐ:7Ú˙ôzräÎV\8yÎ ôĚ 4ăÇŁő.ş‚«BBC˘Tf<:•O˛"nZm+±–XŠú ęŐĺąRub.Äě¨j«śŤ˝ŰŮIqłWŠ¨¬iľëĽżóp×jVöŹŻŞD|Eš(0~Óoö  č ÔYtŐ‰¸kŘďE+r6HÓřĘĽč×vCds‹ŞLĺĺŕx_rzFÜîSÂö˧Nw:)בâăöă—Ńţź >ÁĘJżĚ-˝ˇ”–Ý°víŔ˝]%ŮéJRN^]SŢJŤÉp2«(M_âä:GťMŤľ#é‘‘NńߥFó#ŹÄ˙;7ż˘endstream endobj 492 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1371 >> stream xś]“0ÔiÇźďţřî& Ű.[Íw#7§nşQÍÇŘÂ’ęFjvő +•’ —ę”&eĄ)QI#©K®N6wčBq«ÍĎŽéúˇšňůîT=5ΛÁŰĎëçĎ?Ĺ7 AĽŕµPW¬>ó +Ńů= ndý“¨rvŚo˛•ťI)ô ‰nB)|J˙j!ÔŃÝD-śR’M7ŔÜ-ŽÜu^_٢ZśM礞H( sÝćn,ÓL aŕł2hµĄ +÷€ĂéL‡ďřdŠÚ.ôvżĘöÓ2¤N4 ˇ¬pŁíë^pí2¬6ÚIęŮ1PIń g‡CŃpIWîŹĚyNrpB E´$ś>ţýFá}ŇżÂ0D liÉŕ­ T”’^©·G(A q2ř†–đ>˝ ^˘°b3ŇZ`´™Ş0Ŕ53vHać·cd*™>źđ±ď SŔrôČeůRb ZîďŰÓ`Zw}k{çZbÁpŕ? ˇ´v …j{ÁgűnIÓÇ'ĹďŤ9(צEgĹ`%VUE5¬×'>Ĺ]¸«¸ë¶ţFľŞWŕĘŚK‡*•§\ܧ{nżít\ľ6/.O›ŁĹŘkŁJôÖ »b×Ënżűë•ĆŤC¸ We_Íżz˛ňlĹYÎi*f6§ M I˘>tňˇżLš¬ßąG{@‹ĺ[R+î) šHü‰Ä3´Źś…č~xÜŢpˇŕGNIr“2)“¨—/ř°BfR.śPrŁ úsQZ38Ýzę~'h8w\dP+zďÓľ@ą!yG$“řkőÝ‚z,˙Ąfăr…ZDćg‰{Őe^ş—9·š­˘ °—â˝8!foüľÍYiXĽnCIm;,:q3G1ą'śĘőćĚf8śdűĽËŰG v’9ěnŘ%ë@.ŚäÇM8č`H„Ľ96‰Ţp›.MĽý‹GFa¦b™ŚČ«7Ĺž˝ťŔŔN‘ıô̵Şßfé»Őd§BµÍFDó?~ŔÚ%ŮJŞŮ0V%ő¦‰Śtd®ĎÚ-΢Ó-ŕŁ'WŤýRÖŚ«¶şď ÝŹS±<kŹm;ť§´/>RžQŚĹU®>}ă˝ŘĘôyҸQ[hŕ› 9ď-⚎D»Eë´Hy}äüę”ZâÎ.´Źá„Ň`BŮtž¶†PŔy\n˙„9Ľ»’üKeťÇKäŮY $šÜ).‘µMP×H˝€N#źíaÓ¤cÎ˙ ż^äĺDá9ĎY­ÓÔhµęčSű÷äg”'śŰ_‹ŐâŔđ@·(÷üŽĹLŠ×PřłÔ?°ěGŢŹSGo‡ţŰwcܸ™™˙m•XĚŞŠ`mń™bşŮÂ0•±„o·śRSÍUN.wň--ú‡#ÉÜendstream endobj 493 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6958 >> stream xśŤyX×úţ ěěŘ•qÔĚÚMl1¶(6 Š‚bAEE‘Ţ–¶”Ą÷Cď˝w‘`oŘ‚eQ×z5Ć$*FŤ7ć˙Ť9äyţgwÝÜ››ç·â™™=ç;_yß÷;«G  ôôôF®ł±ńőńýdÎ,[× Ż=RŐĹqI8T8řŢZ„†čŁ!źŹ›śoWGÂäኔęµÉÜg›…ďöĎüVúŻ’Z¬\dl˛g­Ěy]č^›°}ë]6ěßčęfëľŮĂÎs‹—·ýŚ™»fÍvúxÎ'sçEÎ_°đÓE›Nž˛tŮňW|d6}EM¤6P‹©IÔFĘ”šLm˘¦P¶ÔTj35Ť˛Ł>¤¶PQ[©é”=5ÚFYP3©íÔgÔ,ĘZIͦvP«¨Ź)Kjµšú„ZCYQó(kj>µ–Z@­ŁR6Ôzj5„J-§†QĂ)3j5’2¤vQ,5Šr˘8j4eDS&”>5†K‰(šú€â) 5O ˘&P©Ą”-ńe@ER‚^ů€8¸©o¦ŢŔČ A$ŠžÓôźââ§Ě¦r =Đaŕ»AňÁC7:Äq¨h¨Ă0nlŘ»áĂŻŹ9"wÄo#6ÜÇgýFŤ•?ęW.š{6zÚč›F‘FWŤ)ăeĆÎĆqĆMĆ_›L1‘™”Ž1Ó2Ö`lŔŘ—ăÜĆ]ü`ů©Ľżś#I“Üo<~÷řĆ 'xLřybÄÄÓĐ:L¨FŠß„˝Řđ 6č Í*JĚŹĘJČB*ŤcÉÓĽ G±.xhO•±˘„”č„„Éxף2ţ-]^‹š[B«¤ć7,¤k&‰\C—w-*—ĽĄËęQł/m6¦ż„ŻDꕡKa§0üY vJ#ö¤×̵HQ8ďôŻŰŽ/]ăč.“ń¬ň*ŮË[ĐáR2]=*–śÄ]NÚĚŁ‹ÉěŞOJś`Í6˝ąwčÜ…bß <Ů'V?× zn–ú9‰zeA®0ll6ö`cNţš6Fě]!žŘŕŹ"ř@O€rA ¨š.QÍO®J&ŃRäíUj$+ńÔĺ0UTYZšĄš[ţäV=*‘ÔĐ0a\& ˘ŮŞđbAąÎ&˙F†ęÉP äl±ÉŻ1yŹ ę}ć7őb#!XŽ Ă”ˇÜˇöP0,árÇ ÓŠëŐ'ÎŁ.ćîúÇXźÇÁ´\µx*•4ôČýtś“Jł şÚýPň ĺś=­¦ó“ÁFŇěď«m<$Uř0ç°oă|ł <Í|ßlá¨Z?Az—”P§Ô\Á‹‘ł_cl0űC<ł?Í„0ŕ§W`Č[ćpłmĚĚÍmîżüáĆŤŰw®[ĎáűĽ¬2ňńtáGöÎ÷:°ŐJ&âhů9SXSeR[­u˘ęv-ŮG â+"ĽV*îżé’:µ÷Â%RXKĂ4¸"ŞR_SY­rzG”p…,)Ą\kŠŽ D>)|üG¦Ιłŕw=ý˝űę»L‹%aéáÍiCU•KQťwhbL|"ź’„R"ĄŤ»*·!sdŰc°5^ ä7ŚćI÷sŐ‚XŞ€ŹpS“Ĺ'”0žDÉXP9křÜ_&ěp őrçŮ×M)Ĺ.IŕžĆ˙™ŔÎôŃ=Çc ô~ţ X‰ĺ諬W-s{v†ż+f Ż\ľpíŢe‹ůZ?VB9Ůo(\ä`ţŽMxěÜ7{‰¤şG¤‘éÁ茇db™« Ńa¦ţ@ËOß{űgđiaéa-˝ő T—C@’<>…wŞrB2ę%‹]?~öB.é{‰¶2ű÷{ĚŮąąŕˇ”O,O*đGŚ*\’éâp$mÎ+Mk/ä;\/¤4’lž{ŕŰ3š"…y 8ˇĐ;¤„z˛űxçšU‹kťyŚŽÂ;·"ĆtP¤Ěg=ú÷ök*“¤‡eGŐ˙µfŁÝ#x·ć˝%{‘C&ă±Ř Żű ›ŔŕKÇšk*%A(Dă+X*®%Ý‹o7 <‘Ď%flC®Uąy¤‡ń©6¶1YŽÎ×I ‰ű]Ź=¦űłrń| »¨pűN¦gÜt˝{ď›ăÝĽzë=U‚™?µYSARA^§Ť¤îžë°#vÇżŢí玺ąT;ú+–Ň˙ “šMÚ©’Űęa¶ĄŇf±B^‹ĘărŢÓę´ű ·şÓlÇ'¦QžKQëjÄ˙ýD=Cp÷čŃüĆvžÝé™V…ĘÇŢĄKë4~Ő}Ű^2Ĺ” J§>ië¨9¦tƇú°,X¤Đ«…íŹa»ľ,LÖ¸Ônµ‘Ćzř>Öű˘FÇ ÔşŞ™1~Yč^‰ŞIŞA­ †Ť›ui#Yˇw»,‰ÉRáao:ZimzÜ3›^¸8Q·Őűđ™Y™Y¨”©•UJ"<×}ąóM÷7ŕ…ůÍâ>'$ý Î)ôJaÇŹ°C_ȦpÍ(”Çb:4@- *$ôv|N”J'ŐGžŠ:z-ąŔ Ĺ*‹JŽß‹ů¤&•¶‡s˘Ť˛ D2IßÇ«áWqwf`FÄdreä•+ꞥgT3it–};WVŽ Q;Ę(ͬľ ÝĆÍU}iO2â¶Âđ¬ ŇĘ„R’ „{÷ÄdeÄńŕ%ľ˝ĺ;ŃâHަćS2“˛SÓń|8d 3ÁNô91»ŮÉ%óTáĐ(9ěŠ+DPQ-.éŁÍišX©ôŹšďúGočţg‚Ŕ„~ a<Îő«Ąűşr«KĄ °8\ żÖű _îĄń(XD•ŽĐĹ }™<°OĐ4Ḩ®řUTß'eđ@­ÁGh„?Ä#đŃ^š­ëż59ŚĽ$O`x7.ňí‚äžj•^¤ş§‘BŹ0d6ÉŃ˙Đ`ýß5Ú“M‡ `‚y•uü?č‰˙V §„Ő*ţ%5C.$đo‚ ďk·˝P[`í=ňýÚ‘0„îŁU,S¬C'…°CaXŰńšÇ` ŰŤŘ1˙«”?Ăî‘űBă˝LRéÄŠŘŞřŠŮo\÷÷uÝBĂDü>3%#d‚ôÓH)ĂĆűŘą¦D¤2(+ŻHšՅ–Kyö¸_X¨˙ž{;Ţśă‚L |,ě5ë@¤Šď*! [_Řz\ŁJŹI ‰ç"e;Íłđł[?śi$¨1¶ę0Š•¤ąUČkS[UÖtwrÄfđ¸yxČŹSŔ$)ëͦŠ(U^ęÜÝů¨Ć‘_FlŤI˛)yň‚\|@UěU˛đ› ›'Écý×`Gă(×XźRü1§çAaJvL­ÉłYí) ŰDŞ˙ß#{Ş˛†ÍR9¬Ů ű•fr˙4qÁ®ëŘ.327°Č%+>;®0ľˇâÜÜâŚěď!»đ“ÖăO«¦Đt&1Źűýˇ.˝%%iŕ{”»¬•a.¸Z 7 ŁŞ2-•™ B2ż¤=ââ<$»Äý˘ŁŇĹřîIMFa&îŐ¨‚†ÓŐ٨•0}tS•ŇşÄ©%&!űoi.íŃä\ş›0ĽŢ ˘8%lń|úďťÇšyv˝+’á{iφO9¶młă˘ĺ+7Üî~uëĆ­ë›í´iţ˛‚;‰řčëK&č2­o*Ť× ÉQ­~ČdµE«H¸ô» ľi4¬ëI.r+M­G&Í…‡$BvťX›dčęż®Â(…!ë'ěëM˛Đ¸dY<´mK¬/2CfgĂź0pŽ®Ş@í@ŻýŹĆgLĂĂ%l;öëTŕŔřôó:~%Läp]|÷Ę·iĄy“™ţާS $jnp™cÁŤŘŰűáăřX•ŘŔşę8Ć[ćqČ­ŚŢ˝Ů?x.š‡¤UQgŁÎˇ§č Ô…nś*şŇRřÝGm±%v…;‰e뙾´€‘!Ö)~Ş/X ą«KPř’ĺ»ćó[§i•ĐŻ¸kŞť×ji*tÁ0ťjvš~řjć“ňöµUÖ”6öę¦u HVc] ŮJ `Ć˝4ŽĹ<ü_b8íŢ°Žho`î>I nënËüHţť~uÜr«”BŻ‚ůĄ/®ÂŠ«ŢW ›.Ë”¶JXŁôżś¤ÜtŮA Ů‚1W#kŮíęľ‹gQán»ĆÎZi¶pw™G‰LÂęQŃá±AŢc[±4/Š ÎsG´:zĚ‚wëaŚz×ő=ĎšŹGíˇg·5Dćě©ţ1«č8‰âŇ#PŠ*f؉ŃŃĹ©Őh ĘL/ÎĚĎH9ŘwďtKŘąf¨9¶)¬±Ş°6ł(-ŰŻ&>1e5…MĽës¶NNö[öśľŔł7˛.ť8qţⱝ[y 0ćśĚvO›fvüDyŢ•|]iş‹nˇ˝e}łŹDěc˙ţ°Ö˙ —Č˙á´ĺ˙pÖ˘éw ‰¶RîQVŃń“Pń’;@šs˘˛˝Sů¸”ýaľčÔ…k(7¶†Źj ¬’0ě»/Ű+GÇzí ˘ş°G“>ŚÓ˙‡"°S^č„ÁŞ#¶C(R W‰Jz®·sä>_>â oąňDŢň€ †ý¦9%…ŽőÔZ…>—ŕ.±kp/F<Óx™L"Őb¶ŁűčéŁ5ĹaÖ<–‹e}@r˙/ýĂ#*;ăľ|†0?ć·Ŕ|#öĄŻ"x•S—ęŕ턟ĭŹ·Oő%B3áúNpHÍŽ­ D±¤˙ A1¤˙Ú‰w&Ú †˛R+â/Ú ăuUčRŤ°oDy’4úNOĄ}ŕ–U‹ Çć}“_™‘s"3ŹN,Óń"MKÉ‘ÖŁŇ‹Ő˘¬¶;BĄqAŻ¬‡Ú[zrK_+\›Š"đ“čBÔćć†ÜČhž(Ž"şµˇB Q»“č(äÖÖ†Ú yĹ…äOu|`¤ě„©úđşŽSě;ě´7ĐŰÓĄIÚšť“–žĂGŘě ŹJŠIMD!LDIXŮ·a€Ş)ŢO"É!WęĂ{¸÷k{KŰJ'—gţ9 ĎÔ[őË{•ůDiô™~›Öšz›ţÓFęĂĂ.®Ý»ŢÓEę嵿Ů˙Ŕˇş–• x‰jlüŹłűßOăĘ#ĘB‚â#"xüíź–ńá©Ĺ™„–„UVç”eóđí{ËśŇ4„rMúĺéq“Ä÷QɡőSŔŔÓÔ'ąëßb#o` Xó–ţĐZ¶ĚÁ‡0UůúŢÝ[ái˝x4LĂBô ‘̵ľ·će´ …e QQ‰ĽËBűhYJxjp ňe¤ĺ‰%Głťŕ{LçµD•Ů_PިĂYWîý q´˙\!fŐdBÝ UúěMĽŽrő˝J\ćËăXšqĺÜ«űÇŹ0ěËkť§®?C¦ŢÇĂđ Ą‹îoŚ.«Ş)k,L,ŠÍáKNťnů1Źěš·Ęa“•ťűăő±q ‰Hn˘ę‚y6 ^Đ,ÓŮh¤_…á‰î ÝEÝ0Hą—ŕ#‚‡nďĽbŐÜůyă%t‘ągńă!«vXzÔÉ+U 'ä'gđ--·U'7Ďş:zG¸ůI<ýĄ)®)¶Iů0ŞDâOŃlţësk6­ßĽnÎŢĺ§ý%YY9¤Ač?V™űó&ĆFßżx©r‡` OąŇŇđč„Ä„xŢŰ×?\NŞ5./˛0˛(¤Ęů!ßđŔ°ź Ę„—„—dgeçđÍŤőĄĹ(ź‹˘¨˘ČĘŕ¨5–Ö”U–4UŁň^]K)„Hxďuv‘– vh"Ľ ŢŃ­ńąîĽ/€S#C° ˙a‰RHyäĹ·đ…)%˛F‹6@=ě=÷¶há°”)Ľi|ۢ€ ˝gJH%ůä¶ÜŻËÁÜśâśy°…xťÓĆjÚ#>ÖS‚+ġ(đ@yfV~.ßpŕhůeÍ“ÖKVnřÔwmîľÄyą9ÄyMĄÁޱű}· `äëç ŻŃ0  şHOjxáöĘŻ!ék{ŃÓ‚'lသ׍Řۇ9;ňĹ0áÇÇĎĐATť•H^ Ä™ĺ!őu•eÍ®§“Ú‡bGŻyö9čýň !J{•ígÖű:!|Lmz-*fş®žý×7Ö«ÖĎ.+ôN(/©}oË…żĄJCQbÜQL˛§—Ő+y(Ł±9^çŽýŔČ‘G[YYAźí0 ,W*ËÓÓÉ ˝™Ş€]$S•vŞŻ*Tß#ÎÔäé}ë+ćUŹNv KĚă…ń`<äÓĄ¦¶§¶íĎł·Í‚×n43ýĺ< †/žýĚ/‚#ś­Ť“϶ZŘśě<ßyć뇗vŘKŠńaÎŇjó"žµ]dŐ©T\ľöĂ‹KëÖ««ř8­'H„ë\Ći÷ÜH$C>ŃNEŘÉ8-"#¸Őˇ¬ň´2/‚Ý˙ü„f#‹» ť„G µWŢ6bß‘ŕÜŕ ë+gbý©‹ŰégsaŔůóeGOň1xIJgĆrM .ÍĚĘĘFeLmhĄż4$ĚŰł|%iCŚIőŚ~ŮÎn‹í"Ó­_Ý{z»óÎńĆŔRđĚ}y˛•c4 VZ” ţ¦ńżîË×a€ô®«NMVp¨Ă÷5žŇŔŔ>qkŇYy鶸Ä(Éő×PU[ŘţŔî”Ď·«µ«’†ó.b< rí dŽ˛1K˝!vĚv®Ž8—ť™ź‹jĆ€˛Xפ]‹./&šßŻ¬-ͨ®”?$†açž [ Ž„ŤśmţÖĎŃ9tćĚ‘®|–÷qh›ăÎµŃ řżŚ<śĽ¨ &vArLęŇk#Ĺţ»ŞŕÁE¸Ä=Ü׹ĂÁe“ٲÛĎtş|źŮk5áÄËĽăú?W%Ť$˘xYixEmNyA& ďWgć§gˇ“ó=żs÷ö_Ůľ}˙FsóöŤg϶_ąÇăn!—s’ůFEÉO-o.**÷&ŢÚŁşęG®6ś8QŃPXXáç¤F8·8T™ťŹ€•1·‚ś˘\TaR#+ ŹMNŤ•óř1Ţ›‡d&<™O°‹qqlF*AŰŇŠÂuZÚßzL85L0äÚö#ňˇ×´|?áÔV§ţA¶NĹ3 Ú3´Źřn 0@oĆüPZ“‰JÜÄJĽă<<řÔ'mŰů ÷7×"¦>«2W-"ŢŇŽvuw>úťTřxÁYáÚĄO± Ď~'8Xmö¬Ť¨Ň^~b¶¤®ńtÎaÄĽ=ěéĺ%‹‘ŕ)KĐ\´—ه"Ź4çgäËÄčt饗çšJŰ›Đy/îŮđ·Í|N´Ń;•7`đ®çng·Ţ5ë @Ś4!$.˘ >+Y‹°^ ^@şĚiű±ŹťAňE0qŮ!uM°›”ažćK¸s h&oz':č„U„hqŤľ(&,ĹÄđnž.ŃŁ¦áŁ_ßţ»ńdĚúIrşJQ3K¬`|Ëô^Ç«c`~A8^‰ÇáŘŻÁ«a6ńĎż»Ô$Ů Aś©Łíîť{®>üîÔÇNžŘdŞŢIč—úÂNđŕPYT^Jš´lu«1PWŚ sŠrP“‰šöňxÄgéői_˘&“<Ôęá+€e™´br0?ČŔÎwČŔCĄŮiŞWVefö!ő˙\(_endstream endobj 494 0 obj << /Filter /FlateDecode /Length 4183 >> stream xś­ZKsÇľó¤”K.<ĄUÂrŢWĺ@R˛dY’eŠJR±R.©•,˝e3ż=‡t÷Ě.f–E‡,¸Řť÷tß×=óë>ŻÄ>Çżô˙l±Ç÷/ö~Ýôv?ý;[ěťîśxoŞŔŘ?=ß‹UÄ>ĽuĆUA™ýÓĹÓrtú ®ŠŇÜVB¨q:Ýű‰_ŤxĹŤr‚¶I¨ď•fůŰůd]‰_\`łŃX)]q­Ů«z™űŚd‚fŻ›ŃXúŠ Ř4+uń‡Ţz6_aUqîŮoőúcü¬bđĽ˝ÎżO_Ň„L1!k*nă|ŘÉŽ9WÖËnĘ—Yë“3šĆńO.b_–k©űľ\Ţ•Rt-5mś]śP±“ů(¶PîŐXI±Wűce*omlgkj鸆‹ëh42O« kôµa§Q¬RuŠM\ĄBAAÁŘ,¶lŇÎŇ>6éwůËČŔĎz>ů%7„ľd`çŮű¶YlöţřäđMj=Ŕ Ö´ ĎN÷~Üă•!KmwvŕŰ [IX+ç÷ť”°;­ű'öq˝ľ\}sp€ýU'ăŃXě_łË¶ů4;[WM{quţ‡ÝI{,ó^YÍËęJi+iOĄp•„wcĺ+C{zBëí4 \±Y\.°\đ­Y;[žÍV›7[ ExY9ĺ Q[ÉÎP/ÚbWëÖ: «)v×쓜ˣŞ3B›·DĄď Úž—ěj=ś¶ě˘iëł‘áhJíy¬ažz}:YOâ/.nÓ—şŐo`Öú6çé6ęuᵉß⤵âĄeŻşvtOTzšŢ«Ŕ/łEÉÉan› i2p’Uő§­¨ x2ť3~‡UŔb•aËő¬]R3¸Ü V áesŐn~Ă*Ń|q%{vYOg‹ş™gěŘ”A\\ołdWśŹŤs˘zŇ“ŕŚ°ŃŔr8Đ7H?Ó¦ţŠB·ę ţ4;¶13Ář?iNit’PôSmÚűż9C­vŚ=9› uśUÍŐeuÖ,h*„Ň‚Ô±jŕb“v]źÍg‰â=Zűôć~`pîPÄ&Ă+ü]Á×űđľÔ0ă`ĄŤ‹j-'b‰÷'ŻBÓXQÁó^ú‚m&ő’ouZźPą™<„ éT Ú3×ëm`l%~jj”áń¸ëôű?°këŰ—ńů)Ć+˘GđíŮ#`<řÎ ÜžeŘöűş€Ře!,šej”"54Ś!4Ş8§Ů۬vŰ$Ž€ňMŰĂd” “ůřŽ>Ň)+( ŧř!X©$B5ÍgqĐÚ-Ä×—?Ďń±MőóĽmrížFiA’ĎpŠ#żLKÝNO(ŐŞ‘PÚÝü  >˘éQÝ,fk~«m¨ RĎ@|p8 ŮNÓ1vbłQ6?ˇxÁD •žŔ5JxŠ(T€§…~ Ťâ^űŔ¦ €¶č!şŚtžľD—‘˛ó™˛iŮ®đ–µ2Š¸äű—91{ć@_@Í°ÍÍţU(‰«ô$ĆŹ}!ÉľyI ±ěë—hUJl„$ű}ÖĘ«É(é”ëe9~2T|ůśŠkâËçd©¨=:%ĘÖíő¦ÁĂgéś ăˇ ,:łĹ™lŚ­°Uۇň·ŕ‹:w°ŐŤDÂŔ´=¨€>Yh¬˘U8\Ţ,>Ż“sČ EbÍiEMéťoŁD(J˝ýŤ=ŠD¤ Ć­ńś”fohb*&4»‹lW üČĽş{ÖěE}‘é¸Đß‹Űáx0l1ĆŚÝŻw»<`˝®ó/V^¨fxz)ÓËĽăĽűe _ „®śŃäĘöĽi l϶ǧ`ť ćnE;ŘYTŁŞ$eˇî I;Řóî±ć!`„Yđ@e]{Z€@:ţîMőNrĎí=O’>wE' ů¸¤/ůD2ňŁ¶ŁŃý?&´j‹vxňź),{!ßť!ÖŠXSŔ,娤bÇORU10ózÚ•ö(Ďá1&DÜ®„Dč•ęAĺpDI Ä{™g4ęáÉ}¬ťĹÔ¶±luM‚@L©-.)¶µŘ˙šŢÇç íĎÇ&M0ŐÎäż[_MëŮ*ľ!:$=ľ[ 79“~y`Őg|Ą]˛Cgňn˛(f€¸b<áó»5ýj§ĺúéz†Ć@ éx˛IKńSžShë‹.ş,ˇcďs_ĆrÚŃ’oVőzÔĄ ®SľS”Bm[4d·%Łâ‡ŕ<7coâ‚NË5ĺ)‘¶›Lü‰“‘@ź\CÄ‹Ź„'Qľ â+óytź1wĆŢ4뾥Źb=ŁŘëÉďuZB‘eękłWőg˛ď í@5Ö9 7‘»tVHNAвĐĎ°Ë‹ă°ňF¦…Ş?Č{l§ jCÝQë®Ň:ĎŢŻ´'.ş%©˛C˙‚Řľ™Ĺ–$Šî˘saÜR+ÝŮô&aycøÂe?’ËŔ~ ĚN «X“'7ű&`x˝WRl>€íĽkş,éY=[_§LGŰŁ€˘ĂŻČě 7éÝ„Łűł°Ú!QL‹ÇQ“kÓoĎqD S0Aj›< ÄtĄUzÔsŹúĽĽiq‘”ť¦äő۬Ć1ľV”,"aS‘ěv»(8Ď« dZ|MőI @'D&űśŚ{×6٧€Ta-n“}0. DŘ5ţ¶ĎČŢ{´ ÎÝp̸–MúŁąk„¸Ň;ëÉ2•»}]ŕ­1çŤ^ë Ů—í ĚSm€·×_«ĹíľwĎm÷íá6I µŮ§ÜŔÖ“›»Ü&‘źŕ%OłŮîé$·µÂĘŔăMňř!FN×fŕżçëß&m/fŰÝVcđŁď{~§Ěeéµâ1XŃCd ¸í0ÉZ.‹ŁÇtÚ' Ú/ «šß'RÖÚwÚ˘ź¨•uôĄŹăIŰ6óy4. ßĐc„ż‘pŁY;mčVŤ5óĹďiqK©ç+ç]é˙Ď2žÔ”ÇŽ9mí)ŇÚMH žY8&˛t. ±,(·çł%aĹ‘XýźYÇYŮWőrsč6Aź÷‘o^7ýéŰt–+ľí’M]I—ů ¦&)t’uű!˛¬Űś}óGhÇs†.dM‚2J8.uN¶)Lç÷ ýŕoŁů“NŐŮĘžŠ¦+%&™o9¶®8ľśśáT˙Íă>‡ĂOg}6‚Φµ e tśçiZ€™‚·śNőÁuJű€4{qDŮ•č;ĎvlTîAv¶\uůŕ]e]ć~@? (ĺîÇť-D÷Ătz!ą4qńéô}§2…1ÂÓ•Ű“vŰüŐrÓűÍźď”ĎĂQšđnaaPCń©ß~öž>óŚEřĺ7˘Ě—1Ť˘{4·éeÔŇu“˝•«¨cđęÄHUäB3”c<’t@ýĄ(Äť„`,Ă“”·@=ű0,ĺ ¨PEÖÜŕŢŇY;YVí×xŞťÖ XďwŹ (JšbWá—âpﾢŤ˘|SsĆ5Ď‹ň;fC1Ńť?PUÁžS+šN]ŹÚ,ߌ0ďs‘ůKC(ÓGG±”BDž1qăy 1•H˘»üÜoŢ5Ű_Ć…§é=PăéG˘=¸:IĚşI7GŽMUîš@ą™&é¸mx6ܦĽ_‚Á%ŹůŐq>řfŤčŠ^|‰uC‡·Íş»ťB”™Ť«™oş‹—7±-Üü+„ĄŚŤĄ˛îóeꆂIĐěu±’;ińFnPŕő,Ší±!ťˇó^&;r6ĆŐM/Â7O¤‚ÝdüńŞÔňĉ§Ő˛“KE߶˝2šťĎÚNńĎňÓíŃ#Ś[vA/&ČĐĺ…¤Ü}¸Z䎇‰Ť–ŹÁಎÜXfoHüwU„=řTť7ÍôWXÁ ÝŻâ(Éîuiba ěžwÎ `ą­¦xŹ›UžýMĎĐŽé1^w‹ln5§<čŁW)ĄJŘß.2Îíu€łÔ““ŕ–uJ ĎŇ­DÇ~ČůwpEŚš‡ ęÎLgľ…éCLbŤíC Dş§hÂŇĎĂôĹcŕ›‹óťnÚNćuq·˘¨–ťéîÎż)÷ˇĽ‹^2N0ťĺö+eü­74bůţ’]—‡Î±±“$Z”q X"bě¸fg°lźmŽaĆ nęč–ž%^$ĐpŠMë3ĚlEp(ľ‚ÜĂF¦"Bßń|Ň ĘQŠÇBB7 ‹´â•˛0:Ś~´+Ń‚ËU˝HúŇ—e vSnîuÝ)j< yô`}3FO‹\Çń¤ť“Ĺ{ĆŻ0ľ ŢK4ÓKĹÇă!ÇiS“ĘH±ĺEqąwŽ5şeôW^|*ŕĄ;ĎA?śîĽRŇŕ• éă…ĺ!7SuŕŁç;OôďâµýĹěŘŹ1l«3ö—¨âdąą«úZ¶W9A`#˝]]çüqÇ-TJi漞2_@gJçőlý1)-Ůt{žjşë·d€;¶žŰ@äíÔ$@´–`oăĹň‡¸(…!0wđ•Ç8“B”Ţ•;ÜK RŽ@ł¬ůgĄ*‰)â{]˛tH:ď7»uúăŢ˙I¸´¦endstream endobj 495 0 obj << /Filter /FlateDecode /Length 4640 >> stream xś­[KsŰĆ–ŢkĺYxÖÜMłĘŃďîTÝš˛e;±ÇrYI&ϡ(‰E($_ĺGÍ˙ş˙âžsşvS dG*-Ť~žóťď<đç¨,ř¨Äżřv±WŽN÷ţÜăôë(ţ›]Ś^íM‡_ _z>::Ů Żđüjµ-ĽÔŁŁ‹=¦Ôřč34ćĄĚZ—¦ŕÂĂGÇ{żłý«qY”ZZ^zv1đľ“ŠĄż.«vqžXĎć㉔Ş(•b﫤Ů9>…÷ŠÔă‰pEÉŤgÇIxowƱe/Ȣ,ű˛hĎÂť7’Áőđ;˙wô–¤ł]”&¬‡îXsaśč–|™ô^Íha ç_ť†±L©„ęDziGŠ‚ ŢőTŻĂꂲݨ–ăĐC~V)`ĹNŽ&RÎĐĎAµná퉴ć˘Řó—ĎđĆÂŢöSzŮÝÂł˙9čŢŕš}ăćK/Yµ>Źmśao kö‰‰’óOăb<ŃN˛TěIś¬őédEé Ău·Úýý˝“FÁŮ-V»‚kŢďűw0žä4ĂśŔiyËę^¶®7kŘOe ę7G®­ĎHĎÚy|CĂŐzYw«ÍO#NÎe2ˇ}ˇ…Îĺ&źżE)÷ýü‹1—&'ŮtË5ŮŮ*8[ĺühÂeˇńEzím}µ^8L”Qpş°ŢĽQ‡úŘ‚r5íb6Ö°3%'Á -Ąeë“öKµĎ`§ćŰĚ•-şu<‹ëPiWôëTbhˇ\Ŕ|M/Öź˙4yRÖ‘ QĐŔŻŽö~Ú+i¬r´Ţ Oľ‚'YŞÂÚŇÁĆD׋ď %hŹ´ÓĎMS\ę‹Ňă$Ăhߌ‚Jˇl¨d<ą‰už$ýçĂwŹ°ĺla¤I×rÖ¶—Íw8ń‰ôş°˝€ŘáÎO§_ľ|)>7pŕ kQŻO§×JLaµÓ,Wh42$ĆršIA“ŕ±j4Ă+ą‹<‹`jAţrč_.«S„`Đ,ŻBâĄiŕŢ•J'‡•˝„ÎŘé:ö¦YÔ«î}ű Ć_)?IŐkü=hÝŹë1ę0Đ ĽęŤâčR/eiŘËŞ­Pcńn—Ć öĘö¶°×T©A;'M•°Á'íbŤxy8Ö%Yşúf{x|6pK±%>ĚđöD\Š-´řXw/Ěóö;´d_ ęľŰ'µżKűMaŚĺţ~PýF<#[Ě`¦OąŠĘ?±0”‡6A˘L©÷‹y*SË&;VAóg?Ľx®qűęu»Őnł‹M&[] ¶4iôĆŁőÁś”ĎA“Ťô€{Ő--•ůY:…‹L’‚ jÚ;$8Ŕsě]bŮ€2€höý|5GŔÎΛM>\­/é`a?YŤK.L˙çUŘ_ŻšvD ş«7ďoŽăśł÷őjňŽžák`}ÁBôĽl“p`°¬Â&€i:ý‹Ĺ_ – ť2 ŕ˛#IC¶M¦-„ń\Ýe2áRrŐ[’;©–,ń!«O*+ËN~`Dx/9Ć >Q(Ą†áŹäÂÉÂh5,)ś´Á\(źN÷źż/'p¸8¤±ěr]žĎv_V3\Ć?®f 9'ÉTľÂ5Üłé"„+ińAP8"’;@¤*đ&§>W¸gĘłßđR’¦ˇr”|ŁąŁťBCOë ťŕ‰BµS‡eĎÇBŁÁŠ"xĄ8'âůnq>_n”…-Î"€Ałşěă˙Lđ°ď®Đ°ô3wěxÇQŕ$Łľ§ńk_onhŢ€ RłŐÉ<Ň% â´ Ł9˛y· Ă~î¶ÉşÜ¬$ŽwÖCq˛A–’ÜóTw,řY2#żł˙E9kň‚Ó»ősŠ?Áá|𷔢%ள›Î2 ›^·­1n…t“˝É ô}ŰYć­›ůtş´xqÄŹ˛pĘt€FeKţ2ŕ?@duSMŢü•ţôçUŇz‘/0ĄHç‘Ř€ˇ}dÚGĽ×»DŽÂžłż“; [:]µWëţ@I.$6aŻţÁ×Y0×3ÂÉđĐ‹Nŕ‚ů˙xuŮ7śŻŻÍĽ“”®·ě]hâu7´E¤^E™Sä÷nF`'‡‰ŁEášČV\`űşď±ľG m­Ţ˛ц”––1Ű(l˘ňe¬­Ă5hřQrgŃâŔ‰Öë›Í!©‹cdâČűLĎ’ëâeÜL“îtđA%ÄxŕxQ"ŞÜR‡Đ|=ĆÉjç€6'tŕ_-ÚaŁčć{ÉßE1ĄŮĽÓvL^:bř©‹®gĆ×ywĎB3”Ő¨"HŔzŃÄ×KÍ~yC›ä¨ëÇuD4°T[Ş»=‘Ŕ1ÁąĽiĎęŐYÝ´óc2f€DňB€˘ËL8Č\ëÔ w źä¬q´ŮÝş!7,ňG ˛‰žŔŐ:ą%1ď’˝]wŤ,{ý*\ŁËŤ>ŚŹ>Ś!§'ú(F_»ăP.—™u} ÄBkEL Ö˘¬čI2ýăqňV bM§tß‹ťž$á%r…Ŕ’}Ą‡ŚžšĆË\ ÚVFÜ\x]zôtš´Šeţ=yüťý2vh.„@ą®ţH´{™axü.”ňażKëB×łÄ Ĺ¸ĽĚ,đłŹ#Tr±ń¬šA[Ś^•°÷9D¦ě®ô_‰‘(őSÁíăDC8…an{˛´S!•µ¦|H ¤Dâlł‚N’Ł­nËÄ‚Wm‹P%Bŕđ×1Ŷ‚·4!-ň) îGĄďÎRQ¨YĽŽÄ˝ ý‘}ÇŃî–Y 1{WźĆ6ĄQŕLr®5 Ň lřlŁ5é.H gťę)›©^'ŞvWŔÂl"ľ›`žDX’aţŠ†!şŐ}>Ö¸=Ú°‹ů:Ą˝hňÉ×ň_$6&­Ú2đĎC{đš&rS@´Ů"řvˇXU@—_&°ć+Âź´’"…]ź—ň)&"ăR•QÎŹ Dvě$¶KpŐńÎęČ çr¤ ¶·őJ8 ľÉCôJ"jňl„Aw9`°ÜŽÁU‰®´ËôîŹaçBÇP‘_A†,ć9˛TH2–ţ|ľf¨<¬a`ďTÖ¸žGśbP ¬ľpŁky8ž¬—’fU}ǧKŚDö*„m);%•4¦PS5đÜ/2€×ësb†$2ěM°] Ŕ޲"Ę"ęóű ‹2€açĎ6ňvP5MµytFÜx@Ęî2ČÚ¶éÝŤüŚaa…Tj K?&[ý<Ţ’¨ˇíA`ŰDLŢdˇ°vѦ®RŰqQ±¬á¬ă¨"xün§{Tâ^Ůn´Ł¤Źß, ĺÉ瀓5 đnóóŃŘÚXşI4[lž°–6%Ç›˝‚5\T,·¸ÚĆ5»Z‘łE=|ÚÇň2ůÇČdËKˇĺyz3MoŽĆN˘4)€MĽ*µM×Ň\o”Rv®˙ŹĘťm¤-ÝţŘ<‰nźlaŻ˙+ĐĘKą­xűţjq<BZ{!ĺťŃ8đÝŔá˛wlĆNĎ óTIřň~™łx[ć62@ŠGé"‡‰¸bŠ>şE6Ć-÷1ăďGr0§$Ť)x¦¤KÜźé´ąşĽĆ^4USĚę‹éq=»şŻZ2’äě€ň‚Aă6ŤÎŽ—ÓůjŠiš«ÓyŢůÔpkäôĂË×ÓăůIuµl·[—Ç'2*şPNŽ¤)IÉÚmŁ¦[>ptąIËŢ{úÂ!˛Ü:üđłń2ŤżgŞäŔ(îţŽÎ¦ŁÎR¨DFťMBňŰ:« Ó;ߢ´śśšmĄ…ßeÔĎA7CÚš{ÂĺĐŰf´]+ßyD÷ťP¸ßśŇĎhŔP?…Ń«mý^j‘~JJL?’zzśHi·…řFőü›Ş$Áď!UJ ~pżDu";G–|#Ekťü{µç!ŢŚ>űť*W2=—ť1Ž’˘łéĎçë:=ĄčĂsСŕ·Ó+`«ş×+łVŕ-ŕбóe:‹Óphčâe¤*fo)Ü÷äűÔ[č|+¶†H--ĆĄO˛fÇaž^v%”Ű̏؆Ąş^›ŰŠµ%+N7©]ßÎÓuT,‹Á…ŚoXę«äÁźi«ŞŰô —…7úäkźŃîŽřLk9ŤU!pą#Ö JŐéň‡&‰Ş˛ŮY}1o׋ójd Hroâ‡Ý6 îˇí©ŠŮĚHÝ6ś62Üاܗhś˝ŁŞ”;ť6§(˙{QNJďĘGńÚ(?Bkcř°« dšľx Ž–}{HaHLłĄcěÎÔöcýÝeqRs5B#J“ᬏBŻŹşF°Y…ČÇ‹Đ®ŹŘöR«Ő†)dśŠŞ”1ě-^ŞůńI(“Pr”†řçÔŁěyŠ*Őň¦Y4]ˇţ‰®s`Ü]€™ř¶¦şŽxçř±¨Ż śŽ® đüŻ8Ŕµć–ańymcÖ ÓíÝř;ÂJ9btA&˝#Ŕ |ë©ü‹E@…Ů&Ăż’C¨Ytös MÝI,Ŕ7vVČ{ĂŁ]ĽÁá‰)„Ó·µŽ?µ^>p őŕ3é·đ@L˙X\|.¬QňŚËCFˇź› 4L»V™ćiŚť:©€ŘŻ)ÍÄQJe䵥ڢŐ6±śŘDx†é4Ö+Č.Lw8Ěrł˛Ĺď0 )ŢĽ@ ˘›ědµ:˝ ő”$ć!Ő)•bŻV׋5…1ąÂ|Ňł®™c'”PŠR[i$3ćeö÷ÓtîĹĺU‹ůĎAĘkEaű…í Ô Ĺ÷Öźč$‚őşçąuJr–…X9¬˝\m±¦ ’ě*„ş<~vĘYL·'éQ/ű Ö>ěGŇú*Á©v‘˘Öi»Rě—ĹNśĚ0·„!Şęn`*ŠĹ… Ř#9ä -~·2Ż§ÁČľś&+¦yPůL *|:doŘ9=Éř~ę)ĂU  —8%Ş8 άݭ}¦č™\~ŇYŻ·˘/[U‡…6żk¬´”ëQˇAR–2Ů]•ˇ‘lŢ—µČMU‹ {cPsuuús ÚĘĄ){GĹ/dq™{ #˝FÜ’é@¦Cˇ– ;D.vôżÔ =nr[pŹ‚ý e¶ś©Č­|€mŕN’»(J Ţxʦ8ÜíĚ&=šĄ±ÓÜXLšF)w/‘ŞÍřő=±sr6ŮáârŕťpH7± ń‹—‘Đs|>±3l\aU/ĆYéŐšęQlL`QVVů;ł˛@˝ňTVÓý&ÂWĂßlL`Ôü¶* şAřMƦ„ÄĚHE1~Eη§Ź^¶ÝŇdĆą˙‡„m“™h§űĽÎťĽ,°î¬,“JSäyUÓ˛Ú€8{ź=ű˛ILüÖż]ŻĎ…H9ŞEqń ŕ8ő¬°đ ż7Ŕo8+ńZ…‚9élňDp[šxľAl4<ťSç¤X^lWŠüşX.ŐEât^>Ś—\%ˇÇ f»źĽ^´m~xŘž vťhdso Î>˙aô?Ľ™D¨ibç@›˛/VęĹl+bBse:črŇJŢSB“öA‹¶ô#˙NG– ¶űŞ>]^ ¦€y˘¸~ĺ×,ëx4@ýFż KRaRog#ů4kKoô>FşĂŮP®tÝÔyyořÎ\aô‚ě;(wr‹¦iU>ŐĆ‚l¸ ŔW±näqlđGH2=ť¦ŃŹn#,4š-çĹY{±üďx󏦾ďV@ŚżątN=ňô$c@ż Ű)Ę-rĘóý®Ń[Ou kęJsŰíďÁlH:yé@ zAú%Ä/Aâż~0śđv@!mď '_łĹŘ'hN¬ ÇeY=đĹHI"űU®ă§ő:×Ë>ädKb`·ó·#Ń‹w|—ĆxJĎ®6_“(CŇPÜCY±ű+?0,ę´ŘŞüHżĂšŹáä„ń6âŢrŹŢË—»? Ń=QřÄP z+¦ ňö5řĄ-$ĚŘ‹9ÚőeŚşŕ)Âě,ŔD6NŃ÷÷ÓŢżűm.endstream endobj 496 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3284 >> stream xśťW TSg¶>!$žú@ĺ4ĺśŇŐ;UlµZ«u«˝˘–bk}ă«‘·žIŮÉIB €`Hxž˘(ľ@«­¶­eŞSGKµŇi{Ż×şl;˙ˇ?sďýřčÜŐ®{oVVVV˛“˝˙˝żďŰß/ˇĽ˝(‰Dâ·ęíő‰ń;6(w$¤ÎťóŇúčX•rGŠç+=ŽřY5"ńRďÝţ̤iľč…ÉßMě›DyO',K\ž”˛'5X•–ľ#bUäŰQѱqëwîVĆSÔj*µ–  ÖQ¨ŤT5ÚDm¦¶P˨ĺÔKÔ j6ő:DS+©yÔ›Ô*ęmj5ĺO*˘Ľ)ŁäU‰ĂkŞ×9iôgďHŮ,Y©\!ż2&“–Ó»éož(ű‡±­ă.ŹŹ°hBĎ:ŰÄ-¨Ĺ翼f ¸E™[ăňE/‘§ă›ź˛¸7C ›¸f´ˇü¦ŐťŇΩ+ŞÖÁ2 ŹzűŔŹ,s OŐ蔟BQAŢ6n;vć‡i 8ťÉ$ĺ-î`Đ€­›kB«dL㮝˝č˙BňÖGálö~´NÉ’h©ă\©őąP§ŰµßFĎÜV~tŰŹńZ‚ŢR”tKJżwüőbŮešiüŞ|ńř)˙a/ąN)«‘ ŃĆήaµ±zÍ ÷x>ź‘3©+ľŁĐ— Í[«`)Đxšü02X[„˘ăŔˇIrć˝ŰŕüCŢ&Z‰ę+ÉňP0Y[şQ‹ÖĘď;P?[LűĽ¦Vśă’f´KáDO.ü O<đ,IĂ“UXqk&zĐ@c˙ÉzˇMˇŤÍ Iض-a+„C¤sﱌŁ%¬íEťĹgÜGŰŽťr‚ŁĐ©r„;Âs×iŁiŇ‘ţW)•{č%·ÉîI‡6˘l…©ÄX”CšjĐňą»ńT<~!–ŔjŔZOˇžS¨…¶^$Ësôřy:ŰŔ—W§đě!”kŞ4i€ÓrŐ«YeűŽS3ŻĽĎۉĂwâHäŹç˘Ő€ňA˙â@4}x“Ír‰ś;»Ö÷ćĄ5—Ţ@GüIâ¤$çg^»˝a1lÝžŞ˛÷±ĚüĽFĆč”ý`Őćoç~ńp\ÁClx H6ŠŤ˘nŽŮĐ€ţh*6ík ů Ĺ8Ň5Ň2ýęSéx‚ qUé‡sť`Ş:Đö`Ď™Ćř ŽÍŰ‹e¤@‰Ţýż-7ˇođ¦ó;q©8YaiNn 'p V…;Ëăç~WS–OĘň'UŤÁqčä9‹[–&gfŘ­íuh6[qçÜŕ_ L`2đ•Z—¬O<ĺ‚P_jmöT`H¦4.“C|Î!AvB*NFO*ŠO§4ĺ–&5GŰ"l!ö7ËJŢ·¶µľ Č rçę•tž ĚhqĎVŢ*Ťžáč ˛Ôz˝&OÇďj€,Ŕ>°-8w6®4±ZŐ\Ż˝”íŇ˙uźzyţ–‘‹^Içô7 es.䀡€ĎPa–ĺ3 v°€ŃXí0‘şťŽŽÝ' 1pîăŇ?{j.¸EijŃké(ߍVĄű˘˝dŻí­ÝWëǢźĐ$Eń9YŠśéÉۨŚ‰Ž.*ţfŞ<ŽÜ,š*'=ÂSĺä‡$&ká;ż›®çUě ů»¸1 Oü›ş¸~8ÔożHű ĺNčF­„Ó3 (–Ľř1CáD`d{äKFÚL3»n‰5ÖvłýsŕjČßÇň \4,…ť‘ŹÂ9,î•w˘ś˙E0Í|Fáľp=h.ĂAŕÂh%d¤?Šöł¨Wľď˙µŕQ"h\÷ 7:âVvů2Á#"ů:źä>@HĆtŕŹđ•€˛~żöŤeŔ-óq[/ÍĐgŃŤAWÁŔg˝ÂĄŕsgÍAł€; ':?̚˒TĎS%iâËnß›böđ^1ŰŹY+ţY PXÜ©…ń†Tŕć“svŠRů˝\aŻ×iđ4lcßDÍú20p–şN‚OrDěĹ'A”1ŢÄ17tĘŹ@Đڔܗ™łŤş2ŕĘŔZl)A«ŃU¶´şöHźqTvHv‰{żŰ÷ĆPŕ?ţ8čÇÄ ŮGň«H~p/“üíG†.3h …9ĂĹě&Ô\Xj0-śĄľŞ<ů§đńčIOę…ý…¶άµĆ›÷b_¬c· *ľÔhóŁxRďËi’Ny ě|ŃnîcüwS¶)¤VÁj+GÓQ;{w4ŁZ<XŠ®łu§ZËÚŚ#ęěĘtŁŠŻO¸|™$Q7¨(>Kpš·!w]˛–l»Ť–ĘuY;:vu†VĽ aI¨fĄ.ľ2łŔYe©3•B˻Ɩ¶{3ś„ž¨¬WhmĚfţuţŤxnŃÎť› ¶ÓŚfQö·)ů÷ÁéCőÇifi$_µă¸ż>*/żNăy= F3+kńÎ0˙m×f;UüŢŮ´ČúMşĐ.Ó%A;ĐęéA]tˉ n Ý›q}Ę=}«éĂßĘjĺÇ>,MmŮzů‚iThcÔkbĂ’”á»B v×dtŮ„­(‚5;ŔXVqňěY[ tCsretUDÁú‚BQˇhzşř Ů3ą¨ľV:$CvEŠĎâIâ9ť‹Â;ňĹcvăŐažŐ%凌¸±˘‰Ş€í¸ĄžŰeF9zö^BŽWśĚ6«ý845Ęg÷?&5…O ¸NřÚ—šłnô‡GmHË‚>!K7J#Ö<’ť»â2¦Bó8@b±2µ=ş.„;–¬ŹiX‘†™ëÓ‘.BOkSłf%Ë,Ą\Hˇŕ3 …9™4sz'z›*Üź`¦.ó`úá˘sE‡­ĄçŰ»ëÝGZÎ@ĘŞłeB!źA?eĽ-#ČżO::Ĺ|“Î3E-źż)`.äÂVkÚס:aď# Źšĺ.@pVމľí™ X@ÜR*~zđE˛\DRÁAoGśç’í2ăVm+Ü5ö/ňĐGTŁőďwWWT#¨VWűîďíşveKoXďć+Hv%©zýo/ń¤8]!Tj›Ł ´Ű"hć Ş%&BPůφEA9KhfŠ¦`{E´3-+kĎ.mśNYÝľ*32\I(˝ląúëŤČÇŤäÝSvŐÚ¦ë m ™T¶áťu°Ú?…ř·ŁŇĽĎmi6šÍŐUU­‰‡y| ×.•}níČëPUwµvX× hµľ@S¨ć3íę (g‘PMăMRč“´»ÓSrŐI‰‘@3ę÷Pń˝ąšf ĽĄŢÚě¨-)mh8_Ać úTúÄđ8E^Čk[gŔ󰦧ř4›ĄEÇş;Ž ä]Ŕrâ+Ľ!{>ýĐĐsŁČyŕé/ý–§_!kT±´Aţ>ş+cn?Ž§ůĂ•żáëü@L=pżîęou^žŹ}Řkb*ąśýęÄ˝$y4ńĘ{ź˝÷Ás-ř Žß›ˇß;2h‰Đ †ĆBîA[ŇzĘśDjě@žG}OüOą4ţZ*o`¤!˙t­˝“ťůmüî‰6~µÜö˙˝ź¶ýÖýô˙†z•K\^‰ěV—Ü=vpÜłc˝7&ŽÂi4šŚ&“±Ř$\?ž˘ţý~ńdendstream endobj 497 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1254 >> stream xś=SkPSGÝ››»M)EĚ5ń†Z[‘N­-‚€ťŽVG‘"Á ¨3ÚÚࣾđ…% &ň* YHQ Ś Á˘"SuFJµj3`Z…Q,6řŔ¨ŁNŐľün\¨˝ilwvöÇžťsľď|g$—!†a†Îš=/mýćń‘áIKÓWoĘ\á» !Ôülś·€#, ”Á˝§üchĎŽ`ä[AÓb?צ-ť5;yîĽÔô„BŃh4ŤE±h: GăĐxŤbĐ4Ł!’ ’ŁyČĹÄ0©ĚiY„lě «błŮAyś|ąÜÍAĎeµM¨N:‡źĹź˛^ĄšrŢD.„&rW0‚ŽVÜLuś¬*Z†ű`tR¨t4wśşY{TQ†MĆňŚJ­ÂOGĐčâ``Đ Ľ›őŽ„dŐžţ¸Ka¶‡öţvŰŐ˝÷˘úh(QĐ|LÇH`ĂF řNÝŻŠUpC•›4a)á Ü„%–\]`Ô*>ˇ×U[§ľťB‘„†ăvhäŕ-üą9'g’¤Î¬ňÎĂ­vŕł”ŔuĎí6t»»‡ówánŁŞ¤cť~UîZ˘ůŚ|q¨Ş­ ĚŚÂŐí…çâ1ź°‘ňźsS¸7ÍĄűr“L]$qě?`őI¨ÎI~yłűž 3Ő0Fr+Ę߉„ß4Ł<'„µAD#†«ťĐR˙[Š+‚hÉâ­ 6j…sGż·ž"'Éáe[§č:¶”ŽHËŽ.ĐY&ö“rżü§o W űAP•dg¬Č^łe…)Ź,&Ëě»Zj]đÁÎoĘ}NË›|BÇśĄN(ĚRöőşz ¬w8˙¦Ř›UŤĽP8Qđ×—“™ůq‹ÎĂaŞżČ^l9±7óČŞ.˘yLž>>!ŠÉęŤT=N7‡,'ëöNś„MÚP×úőŮ×:H—nćS|]šíyo@ĹV,Q×tŇ}ĄÜ" !Ţ€˙đ>÷Űó¸W¬íe˝µ~(ĆôSzo~d, Ö¬1aS]ÉѢ–x1J0ôs”űŻ2Ľ“ň´ÖF™Şťá2†eđ¤řÝ[ş-vM™‰ HrZ¶í¶/ą-íĐę`ÄߥśMóTőO'?ř7;ĺ~J–&ŔÁ$ Á”w@®¨ÎůpŠ–ľ$=…€VNŠČČŮ9[Ţ÷uYtĹGër‚ŐÁ<Ľ™nćfĹA5UÁ5ę»dskęŤď§Ł%‚"żĘ-Ü.˘0ĽJ]Üm±Be›’L¤aŘVÂ0(H[˛!Î'ń®e^„ĂťPŐÉ ×Xń¤¨j.čżËiXy:˝2ĆžZcř2㫢ú•­Ő]çî‘äřš¦ôĂż‹›Úb }PôŽ~L®"­)­yÉń\‡Ń­ŻÜnĎŘťS»¦@gÔĆk#ÉRm‰ż¤X;ńjęĎƉř‰dľ"š}Af/(ᔧŐC<Ăů'^›—•ęŕţÄFé[†ŕjb-«&Š;jĺ’— ńĘ9>Á#U& zŽÝ~ńÜ=—{XôĎűEÔ‚Äít‹ţ™!‹x׫ĚU…•yÄHŠň‹óŽý+n3Rš·ł JJţK…E<ö,VŘe-« {f˝l…ő»ë±3ŔóĘČyę†Ŕ—Ď–I«Ü,m‹90ˇ;őíendstream endobj 498 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2300 >> stream xś…V{PTçżËrŻCDůÜě®ë$™FMhjcµIDDŁ‰Ę#ĘSDA@AdŮ,{ö!»,/A^ +_É&¦Q›8ibc22ÖDkŚéä,ýśiż‹µ±­ťÜ?ďýî9ßůý~çwŽŚóőád2ŮSËŁWeoÝ‘ş5#ô…9+’¶dää§J_4@FGFcyđ—żďŃ©ă/â¤Iß\ČIÉZśž›—ż±09%5-}SĆš-[9n7ť‹ĺfpop«ą7ąĹÜ:.‚{Ť‹ä˘¸%ÜëÜRî·\4ĂMfą9_®D6[¶ÇgšO˝˙VNŤë ~Żú•ŚÁ® ˙đyÎĆ<˝žlwŕ]đ%”äSďŔSN)śŔ†Ú+»?¦rP‡Ăʤ”˘YhĽË“›4LŻŹRÔké0;ŞŹGbĂI¦±˙ş1•'Ő(oúÚ3 Ů űĘK^L ď¨–J§&Úx–řüT)qĄÜŘč Ä©¨ĚDeŁgQ•d˛v4 cő×?Łăîě®ű¬adŐWt&÷'†xţ[âBîŹđsX\Ţ"ŕ,¸6˛÷¶Č\UěK]şDę'°P'°‘Ç ˇ >:IÜLżP6”l)ĘI—‘ E,śĆ“<ÎH× ťĐ_ź¬[]©'xMĆ>/qËĽ{0[цÓÂoŇ)@ôë<:3ŹÎřr@üřu;‰”¸úxý[ĹĹ)IŰÓ! 6µšNş\CUÝNŹóÝúÎĆžţ¶ŁpdŮ2í›őqú‘Ary>§őx˙î‘!ŹsĐ…säŁoŕ…­Ů`)‚Ý SQ>UŃqËçA,=Ľm(wpĎ…†5í˝uîÂĐĹ/ęŽĂUř,ÚDźÍĹh„°X÷t¸1SeŰg©ŢÉ"TVę KŢTĄôŵľt-Đ:9•¤ŃV=đt›ÔLżaOŻÔA~D_TžeL:°ă wKUź”לĂÝX×y§S†ë/Ë˝źQ¸s—ÖmëÚäHv&şŢr9O»†.YöÁu(_VY`Ţe©h†v°ě±·Ő}Éʵ˛rőŻ-1»rś©ss‹¦é×·ć¸JßÉ<Ş?ˇëŐ–jŁu±q»A ‡ŹńăĘz°BŤŰwR™ĘTX©kbĹXˇą¶ĘŢP]eëÎ> €0p©öŠř Śî­ž^7vxâ?$›Ć:' PŐ«ňr<ŮC—˙ŚI&]Sžł ÔËÁÖZ}F$â‡řWž}ôP Ý]ôÁ)µV©ř€1}ÜóČĽNÉ.˘„`LÄq8ą¶®Ęń%0ş3+“Ě;A=æŹo†s}™zŢŻV!Çźś:Ţ” ›-éV5ëÝO„Ű4†>Egn†x`ŻY,µ ľËü$ËRaŐ:ŐwĐ÷ ŕ$IůK";ÍtŇç č“aKŠ“äŢ(ôSXëK  vA…ŮXŞÝ‘ą, Ň!»UŰ[Úë8é|×5Ü‚oBÔT6Ęô%ĹŰĹG‘Şů8˛ă÷ @ůÂv”KC®-Äń€Sa}­5ŹPÎ*˙ÔŤ+%Ö/áäă’mFxÝ?“˙÷o<ŮKŁô†‡Ľnˇ±)ÝI¶ś÷]ď4…˝MםÄdfÚ!’î@úz{¶†> Żí~Ů°ˇ.y˙öÔd]ši—YkXw$łČ»˝l•~}×+ř`(üi¨ćbÎĄÁ@EW 9ÖüÖŞŁö¶šZ‘LÔj»vjp\ş\űyő{Ýúš:g­˝Ţn6™Ę+ËD˘^”[QżłCÓÍű¤FJ›­ĐŻ-‹‰„Hp ;Dňˇö˝j×ĐEÍE(‹Ö­»î?©0¦l\;fÁÖSÎS®ó'…‹lĆq‹>‡ľ"}˘řďy}ář—ôÚQH{8µ[3µÉ’Xťśľ–ôYĽÎ“ÉŹ ’čžż?ŔÎĂ#Ă›´ŹŤď&”łŮ ęÇ o™b¬ńď˛ \Ĺď!·C•ä 6IůŁ…?xgńd†3KüŻY`cwŔWĽ÷X˛ÜXŻ§¤“ ¦ôô8¤ —ĺH“đ¶çm¶”bđ] ŢÁÔďLÍ% ýó(Q8ŘEQOfĐ'ml !Í9ŰÍ•ó~“ŮlĘ_v˘*—>7}Ăď€> ­¨pśÉü?zĂŘŢ0ö»iS($kH_2„Â&Cő­yn>ťzm:.5Î…ďjEĺG^ÂÚŇÖj±´ŰDdkk‡ć!މ…{Ň`ä$ö?`ąQ O.> ö¨B([ópńĘě{¸x= ń«ŃË˙Cc¬II«âúB[&üÇ"vç—±˙Ë$Nüĺ3ümŤ7¶[\5‚g<?ńôxßŐŮţ~]6»Ĺj·8Ş,uWýý9îź~Ô4 endstream endobj 499 0 obj << /Filter /FlateDecode /Length 4340 >> stream xś­[ËrÜF˛Ýsĺ»đl´ánŞ#Ř`˝Ž¸ Š’-ÉÔc(ZŽ {0٢ ułi iYóÇ÷îb2ł čŞn4Ĺ1Z$ őĚÁm‘^˛}ďˇčýUS,wľąúř‘ňěŮăô$ű•IÎőŻ“j’öÄ{gku{ň {ŽëŐA*Ă®VíÄ@Ă <ĚŃśb`7ç«f‰CËVKúÚXöęf1k›óř‰7¬ž§wšg§ą\\ß¬ęľ CźţŤf6•NËý©P•9ÄŃĐ\jv]®ŹćKÖi×tŘ›§]¬Ż.ŇJ7ůR­®W˘_ęËŁ‰—`yJ±ł¬ß“ŁÇŁĄ]eŮ'X§eÉćŮ”nş´}ŢŔ”p˝ÝdĚ&ÁĄ”Đľď·š€A*ö6ëiu“ŮűEé_ůᣠ‡2,޵ő*wż–Ąö<čń«hiÁ;śźˇ5WN:Mg*<ŻŚ±űS©+ĺqţ8ĺďiˇłşíGuÚ*ögĽ6¬đ‡9Ú…Ĺ#5ěÝŮAúlě ¶ëw°amôkĽN+S°`]YGłô©a§'}/¬]çĐÚ§˝ÉöÍľ–4âť6öËş»ĺűř´dOÚć·üóŢФ×?ÖĂ2u1hŽlő5ą>xąVŰŐ\Ą1Ąe'ÍűÉú űFMÖ+\‘+Í [5ů,.«‰PNÇ°˙·ja Uo~gG{­ Wr;§Ůů‡i<~Íu%ĄMţé=ˇčŐr1]9ďL7Ť[¶„ľwvščÂ)+kmÉ"Śő"$ ·†(ÂCĹlřćJ3{z¶÷Ź=0M WíîđřXt!TĆĘ}ë  /1ş±‹eó4•Š»C!­—ĆáĚâ@·ĐŤ‰§÷ŕ/ĹĹ §/˘?ą°áOËč@ŕÂ’¬f/ÖĎĎ’ĹEŕşÄäqě=Fää –"«bß<ÍlţQa:çů«Ř~fM® ź9´ c¬¦pĺřľt}sÁrűKç‹€ĂCŻŇ‰źŽ¸¨”sýyżĎŁG»čeî}óŇî—‹†6 bQţî"í“FČÉPq™ĽÖłl·Ľyúú˘č# >iJŕč'ËËf•‚,ÓŞťĹ¤ˇ”ąČçÝw]®r.ňçŞŔŃ|z]SXÎpŹ˘ł÷„«;Ć‹G¶—ď?aP=š•¶Ńm}_ž>ěŕ°o)"¨ÔçdŇ"ܧú2NĂr-á(¨ťë8PÄŕaJ/–7-ŇŔ$XźÖ„Óô ŁĽE~Ńa´ŔĐŰ7}»|żú\·—™ŤFdˇMe–8 Z®ŇRůה܉Zv —~ťŕ\$ą¨řś>š ôkďa?APç/C›đ•zß ŘÚ@Äť}X­®»ď?ţ\}ě`«:Ř•jŮ^ţˇäaĂĹá}– ËńŇIÁ‹;!ť·`ű""ť×ÔŕçزdM÷[ôXmuů¦˝Lźz¤Rđ<ÓF&,|ÄCÎŮ7ďšî¦pňćßąť—‘4vú}ł˘YnĂ Žc;IvŽm>ő ’‘K`^©\ť‹źľ5ěrńç6ü™ÚĎN“÷HkĄc—mɺȯÓ|^ö)†·áY#Ş×¶Ä­ĎÍ Ěţ ·7Ň”Ăć}7%dpcÜä ö¨8·‚ß­Ąçľrľ\uë7[G`"‚gXsDŢ~ßúŤjň9—ĆĐ!$9˛ˇqHŘŞĽw[¤\Ŕ¬'7§,‡$ĚúŘĐňǻ¤/ú+°f6Đ-ďvÂRŹíŕQ‰ň`8pV  ”«‡¤¨Ś’űĆBĹ}N±ŕ”;üŘuŐÜ»Şááđ#1Ĺ*gH©PďOÁÇl±’[–txż%éÁÁKJŞá(ńM‰©?9Řą&±‘b"a Zż‡&ěř ţĹ—‘|Žľą5ź3ä'ďÎđ9r!LÄĽ‰‰F/`ßüř~ÖS!í ظÚO]7]ćLpzRŔó§´ !iĂŠŰ3ŁőLcľ…¸Řëö"#Čé‹ŘAĚ襅›č‹Ů*¦«rsŇ“)9µ±,"2cÖDpcő€Üs˘]4†Őg™`őa–qĐ`"„ÖWőES_ő/E](ŘĆvÄftj\ŔÖW€ZwĎńÔWaiÍ–˘ˇrßjýÉ ’‘@ĎÝV®§”0šűř«VÓ2 ş+*řbĂ]KÍdDÍ,)peöółüAĐĆ<ŰťŚ0ţÄŽđsEáóIôéŔŽR˙BG–Äwé…LĚyŃ–Fx1ËőŻćęU^C&ô:Ia[Q  ÁÚ^cčSÄnTžr±đòŕa^Dg‹ÍeoÚf]ŽZ¦ÓŔ~M&­IçŮŽëEĚ]a r=§-čŔeżé@Ę·¶ůcŇ{o‰Ş°:z!˙K"÷ś™o!jîćP“ŘÖ;7Ů Đ úđYÝ–íç”ßDĄ÷E‹ĎQB˙ţiú˝rďíuQW¦Ű2r™üł]ôRNyîG SbŽęŁ>pOČŞěš%2Ş%"ˇůŠĹô­Ţöâłfőj6PŁËf¶…¸t⪴ż–BČŻéZŮŻń:§‘Ńk 5”ąŇ>;Ţ)ŕ>lš-OvĆTb*1űkŔÜćaČHŃD8+R]¦g#ǧGŻŞÓ)Ś‰ d×íňăě<“ëú—ńżxŘëyüa ,ĽĘ&0([žŢ”Rńł¦Ą@Ř)ŽÜž-Ű\˝hbJĺ¤fž¬ű*žŕŇź‚iÎNúţČÚ%ŹÄĂ@–7•8ś­¤$Šť.$’Ůy.Ű FeN2@î"R¨ŁíBT©ˇç|UăNÜECŐW¨oédq; Ó\<ć˛e·$´?&FGc©Ű†t>iÉ˙â °=ŻŰ"ÉŰPĽŁň…ő< ™ř—!ďŠ!hČW㏠"°`%CľŞä]č‘ÜAŹPüłĂń G˘=*"Ç‘6 ¦ČqHăŚ$ŽÖÉDŃ18®ˇŃú·çĐ Z]äqś$ýń<^÷…¤qľd bŔľ¤&a7aZ‹âż2M„IRIÍAâ¦ĹđĄ`÷±FŕŤŰ•µA‚ פ dĂő=ČzĹłQ4SEňŢ€ţ[âËóţ(Ń6¨†ňR^ôĎE$.ëKĹË9}.Ł"Nź‹˘®Ó,–›µoŽ. އň.C¦ń8€IóA1<ţ)7÷ń˘$¬ž«ő'AJFÉk^DEJF5'+Z iKŤéIl ?a ¸_óçęfżłˇMŠÜ>r'ÎŇËŢđÍë·ě˘‰©ˇ{RŻęQżheŞÇÄ”âÂ7BŞM(IyLu3Dă­?#’\;@şÜ “H†]A˛¨Ňé:Bx(ą@9tÓ}lUąŰ´uŁúř§Ç÷ ĐÚD-{=~źŤ7Će6ňüńËı˝eÇËöŠ †8¤Ëm·¨­łµˇEriî%oňŢnÉRńוä˲ЩVślś¬M+AVţssu±üÜ!ÉҲŽw Ü31Eî.až;’FgÉ‚őČŐ\ľ)>nĘz ŐAśy\[BŔ§”Wm$ěŐ?ă1”$ż‡±uLË$Ţ™j” Q4ŔGOIFŘ $đ÷k®~9+©­ç2Đ[vóŮb\ 6:é2lq2“~X”ž(kH¸š!žŔ Ł¤Ź™ BHěĆx*Y‰ą[uëFń0é l®GšeĆýI@M™>ďĐY©z,íŔ˝» ĽFŃČA¶®BfsGŹĂ¦bx¨ ßd9×yČIE€©Ź­aÄ»â‘Jxod< ÉxJz_éŰS†ÖD&´¶›żMâŁâ“Me€}NoJŻřń&‹í˙ŢJâ®[şę–h ÜĹĽ „â[ŚGH™0­€/·˝*' KgÇ=űT8Ë#l˘‰Ľ!ťQeôżt÷¸ą硉0ŕ#ňÚ5č’|„YĐx:#5¤3zËůbÖž‘Ś+ŤW(+űcö'.×řý•ŠmT=żKé¬Ř}Ąëwš¤Ô¸BĺY)ÝßÔm yH1ŕF:íxe˝ÝpÁ»V—şľ–öPéĚ:W˛5JË6•¨ ČH‰/»ťB`|=ŁKµŁľË…“]’ëňÔ®‚‘r~ČEüî:vžhĄŮŕ —Ä·Ŕş ő ±řţ|;ÂÇçW}˝  Žgę¬ĺ‘ˇô"R-~KmIVM”ž˙jmIL9ňqş¶dăE¤|%·Ö–äáý–¤ú&zĆŚoJ>)<˘®ÓÝ«ä–Ö/őjvö˘ţš đŕ@<u{YF7ę~XŞĺ™"8YN<áeݡ˙2ĺ"T%öěéŁÄ ç?ŹeĺX߉y @¶Ëř5Dč׿}ś ×]ńóq^©Ŕ s ć4±Ř‹•‘î ¬S÷‘‘2kĆ U©rU'ĹÁ?Ů:Cuëűś˛§°:šŰWVŔ_ařŔ3g‹Ĺ¬.ď!Ť^9ÜĘYµĆŐöqAroş7{ŃÓźńSÄWđ;}ŕ \]uD™¨Š™ŤŠ[VâvtŃ*/qżľŽi,›eEń·Ë›ő ţóLŐMW‰Ü]_“éĐ» äŘĎFő^ŕ÷N¬/MÚu…6ĎAÂúzŻŔ"38Ľ˛•Óş( ÁÍáÇ%Đ)Č°ťĽo‘ÜÉb”¬JîäFŐóe}žCߢ™Ďńú‚}ěfqřŚÁú¸¬,”WUĂWxçĺIzöQPáfgÍ; Š7Äđ'łľ"©‘6 ˝ŕ,Ż^ĎÖ2I›˙ą N+ă@(ŽđÓ(8ö1¨›µźô·FşôćřĂMs±ĂÂŻś.ONű’×ăâŽéŇĄŠŠÎĆĹçžM€Oh/6|ę¤ŽČ ÎňąÜöślýŃqQţťU^…ŻoH¤¶ČäbŔŹş.&jT§+p¨©Ë<»; Kö&˛ňŹĐ2UĽ»-Ń“¬ČŮhÝĐMx)\ö÷2ŕ~ř÷2ÜĂ7Z*2OüÇŢTQM„endstream endobj 500 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 387 >> stream xś=‹˝KqÇg&W˝‘wCóA5Ú ŃT¨ąFĄKFĺĐ „©—y>žwVhqi/CŻdEDCQPA[sKă“ý†:zľĂ‡ď‡ďĂł‰0 Ó20č NŹĎtuŠýsăSU¶Tśg-p5Ŕ™Ďń»őĄĺąé±™TŹ9#䀌obf> stream xś­›[ŹGvÇßç3äŹÍětÝ«„ €×VÖYx¬% ň>P3Ôrh“”´üáó?—î®"9–˘ CäéS×sűU±ç—ĹĐ›Ĺ@˙éż÷ű»ańx÷ËťaéB˙ąß/ţđúî_4¨/C1‹×ďYX{cí"…ÔŻ÷woş—6÷l÷a9ôCpÉ Ą{Ş>o–+ç|?$Ó}ż®•Ţ.W6˘'ş鸾äÜýA>ĆvßľŻ´ŹŰÓ]‘ ›łŽŠGŁÓsOţúúOXP6őzl}Nkzýp×9ł|ý·»—ŻďţBŠnńx˘}q.ő©,B CŃÚŰ;ż06řŢ.Ž›Ĺ/žî|oświń [ô'ü˙7ěęѶ`úmK˘÷wĆřd!{¬Ń-vXĚ'A’ é{T S°ř(:>÷9B’bź=K˘ĹĚq0ĄO˘CĎ $ŃĐ$)Cźâ"Â$}ŕžĂŕű Úű“ű ɦOÜsp¶Źhe鉴ň±'A˝ăˇBú€F¶ľHŁä{¬$Čą÷RM$‰KŠ§µÄÄŢ•Eôh•y¤čÚŰčáWŞă±Ëô§ý„Ü[·Á¤Ţňb˛"ńˇŹĽňáźh’Ó5¤O:űĹ3L†ńX)–Ţć“y{Rv4{4*4w’ŔţNÂÔwśŤacĄ”t¨Śi`b1• g4Çü˛q}ŕ~spl«ŚyFiąydobĚ‘3b»dô°ˇ9š$$p}2}Ě4I‘Xdž!ÝČ›^ŕňó-Cě-/»#lš¬ Dö†H­eľ%ńr#ÂżÂ÷‘"đ5Óż»;;Ŕ÷±Ó±`¶A$Ö¨$÷ĆłÄÁÔ*Ř>%–Ŕd§‚ťD'RR IO·|ź¬R°n':đ}‘`)´kŕűĹ4ĂQĹ=;ËŔ÷s=8⌭2O~¬xĽa |?Őë„účy#dC­Ą,´Yž<ž$đ}2L1ü’$đ}– ˇ·Ň CřL†ń}äéX˛««Śg-|ź 3ŘZřľłâ·rđ}–Đ”E3Zň-[t/śĺŮĂŰ8ŻľoČ‹KÔ9»€¨R§-ĽR—‘„2Ž•Uµď[W2[+a· ŻËĂůMCŇł‡ó 3`ëќȹň®ź+™ő‘CŠâŮ‹Šd0Žyń O]$/p¦°ÎĎĂţB¸/ŮŠň‹eŁČP¶äÄq‡Ľgčç)În6ŔůÉ2”ßłôçg ˛Ż•VxF¶šr˘Ťđř§MË»…$Ë–ˇÔ*žá˙d™)űZĘF$ˇ =ţo5‹ËŽÂ$l+3µ ‹-CŐ@,śŕWC¨*†MřÉ\UlBDsŮ‘íJđ~ ąVÜ= y¦*ˇA®µf UxËZČŕş«QPé?6ĂŤ‚Jçbőśf­ß#)Gu MCÍQ(­Ř4”zJ*0 sĚ4D?ŘĺĘP 3JT2çŔW·´,"ÖL‚Z 5<“5'ĄQĐ(ÁŃĽłŽ|oT<‘«tTĐ(%;rҬ¤‚FI—2+Ukű"[VdäŚč‡1]Ř«°YŤ´Ń­\őŐřneřűŤ-żtRh”÷Đ!RwFƤ:˙[ Nťç= č%bAÂF«0ľŮ­ĎŰŹKK~‘]·Y쏫Ýö–zŔ5`|·}8<Ě“˙ËÓî|ďýŕh~¨L¦,ţŠy<|ž‚G«(¸EŕLIôf+Č«Ř^ đ ´3#0ŠCKŔńĐ0ޤą$`é¸"`AĹš€9×Ě.Ú0űcEŔN—9pPŠź ©7· żn8*ÜÖ<¤€GôŻx(-+^4,[Q°ŘaŕqĘ5 üĎśĄŔ×lŻi§`Ůő €í¨R0ך€ĺx0pQ»B`YBŤŔĚ}{]ÔŚŔ0ůË©¬F`sŔĂŘĎDÁi$ÓŠ‚‡ Nä¬ wŤ r}ĹJ™*!|ˇB ‡äë~ _¬dŢ :„/V®—xĆQé…Ňwb3DĄ‚GNń>˝h“'ˇ—©Rx˛P1RYÁ||™ÖŔqŤđeţĺĂ'— ×KĚI> ľŚĹm*:Ó}Ĺő’Łł%UÇ©*ű„ÜeMs˝t­5Kć ”ĄJk’TZ9sJ¬´&ɬ婂6WLł¤ŇrrLŞ´&IĄŕŘÁÔZ“¤ŇşXw˝˙ŔĄ–łÄ—ˇ˝ÔBč n(eą‚3Â0Q$€5– můQâ®tÂ|I1“ňFá˝TI}ńsK O“RI­Ĺ—XĄTZŁ¤Ń˛‘svĄĄ’F‹.˛%4:|Ź•j%•4ZÓÍÖ¤őŐW[ÄL)†Ż¶F“Tw[8OÄúr d_®.·nCjřúË-Gu ĄşÜzÓť7űź?-‘ÜĘ®[Éş=Ďb^Ľéî˙ĺĆëËĐű˙văU!ůč~3’;a— ÉłTţ ÉőľBr)ý3‘cMÁ´DÎU¸!rý1 "rŁÄXypDî[ ךTą * I ä2»šČŁo‘<(ĎHžä7¶ Éő7…ÉK‹äz4o<–šÉé||Ĺä)_2ą·-“;90WLŻk(ŹćĘ}¸„rZ(×» ĘĂ÷”[:×PžżĘőşŁˇň!·X®×&źÁr.±<şËť×+,FPź°\Ż,çu…ĺz«TqąŢ<5\.ü<ąÜ_5\n}Ë哤ćňĎbą ]aąĚ®ÂňáËÇEÎ\>nDÍĺ˛Y3—ë†V\®›^qąű™¸\ŤWą¸su‚ ĚŐQ0÷ćĚŮß*0WźlŔśý¶söí ĚŐ˙+0×™Á<Ś4?ą†ZćŽ5§\ůÔ —ÇŇ‚ąć†ĚË%ËVÔ`Îy¨ó|ćśĎ*2לW‘ůx,¨É\%™ŹČ_“ąoÁ|<€Ěd®iĽ"sMő™k9Č|¬ ™_ą- kijŔ\ŽŢ3O<5Ţ{y#·[ ɲäňŢë6,´ďhŤ´@:ýčëf˙±}¬_!;n–+8žŰ.˝X®b¤›ŹÔ˝ŞtvŰűúĺ0}S árwŇćĆu‡wňąxŰťĺĹ3źmá÷×Ć!~ş|±mîöQ0„‡x„Ą8gmę~ZR{bžĐŤlBy‘†oz§Tť€@ 4:ţH÷©{ ľ2|÷®RţP˝ WĎ°Yřy{xŇ%L«;vۇJY&ꉣšÎGmUB÷s%_×űfíëyÇ“ÎT¶­&%o䕡¶¶§ˇˇčyďöüJŢŐk{(n0˘ôF§(caŠÔíŠx« ˛VôöN4/­éŔĂ(DݧíĺkŠô †®Ţ•őyMČ©ű(–łľő˘ăŻłĘ}ý`w8MÝvç~Ň8Ąvdßýů‡—ÔĽx°ďNýrE¸apÝwëÓűç\ďAG÷>ô¬žT+“7jőr·§s󬉶-ú@,ĹŮ®žÍúmnărBnlt<ěőńϬ?¨OĘDmąąśż"Âęw%›łĄÁŘŻ¸{ýĎoĆ…‰­ŞĎŰĆ0kňU‹ăć€MűĺCĄ·®wă ľńěçJ±…ăaIž‡ÓĆß·ű5ÚüđDPvů|íČ;Ę9ú) »Čç$ ·ĺäLćW‘ľ™Ü/%ăY°˙ü,e3GaG·ý/y=XqúÝoÎä\‡:Š\Ó­ďůh˛»˙ j‰Äż.oľÝlč}–2öü Ĺ=]hć"Đ›€¨CŕÄ9¨ l—éĹjѢuÓËßSş~öJ×5u=ťÁĺeô°8>Ët› ˝G şó„t™/şo¦¸ďÖęvv 1uo®łí_č.ŞÝe$’oŘ0íŃm/ľ‘–(1t7Ţb¶ńÉ4n4Č'4nˇ÷ÁÚnŽÇĂQ—`ěEIÝ•źz#§qFů¸] ×ŔžO‡ëlűęcʲ~‡pjßË?ťö+¤ňţytŇ@6ipQ§™h5Ąú›E=ÓŻĽ†˘e   wĎzřqÝ<úU›|>mŃ1ľ!¸‘đ?˝çĺ†\"<~9Öľ{Î6SÝpŁ¤SŹčăĎ?ĐgĎüw{÷«d1NÄ2Žr×ńFµÔ®źˇ1éëšĆxŘ–¦tł †G¶ oT5Fţ ń妷¦?‰:áÇł>~1ŢI»=e‘ţô ]ú#šÂS­tµMúź¸O’ß?U6?ź6xDo8’Í×»ÇĂqŰ8ÔčE·n„^Żß7i“ÚÁ!/ކFőhŇsQFO}Ö>"{Äv_q×4Ľ Ýv3tB^s2}ĆľÝئ9¦.ůŰ–Żi…żďO7ÇÇÍÓýć‡ă•R1ü ’˘ś[xbŽBŞÚÍ{.Ó6H$©ĆMôáT@‰eÄű ă?5Ĺzü[¤Oú7G@íínW#Ŕé|cĐËHąÄ;ŽŢ†@ú[Ź…”şýXřÍďdîÝV=MtÎ/´0;ëÚż;ę=ümtÎ˙xo=Ş-˙‰Î? ·—v˘?ˇYV°ńžožoOÚUá3ć`›Uŕ+ńŘ=m™&]¨Ż˙Ţ?A¸:®§qúďAőÁ†ŃĆýKvçxťčýdzé»˝Ęôűâ™LéŕNź0˘CO§Ďn9â©ý :!Ô©™z ďR©Ç0¶ÝĂ•í˝‘=xf÷›×A\ďcjRRž­¶ş´TîVĄw—ŁfYă(ôR˛ŚÂťŐŁ$dňjúŐ]úfkľhţqh}ÜĎůÂfM6§fM!K×Óht÷ŮŃÔÄ×çőýů× ťWĚ z4Rc±«e‡Ţűz•l±>k±Ńďeŕ—[$‰ŘŹë݇Íi^QÁßoN§íúéĹ­8Ĺ! eź~ůG†Ż2©ńs0…ŢnćµŔ/€QőZł‰·¦űmU.¦ČŰcrëÇÍ<Ţ;>˙ŹIę~·q˝ăš@F›ť>Üߣ›wvUĂj°˙?źćýY?> stream xś˝[[Ź#I±>oýV¨…(ÖEŢ/ËYX 4‹ÄŇ< iĽÝîžb}™uy¦™—ýíDDf–3ŞĘî8¬úˇËĺĽĹ%#ľ¸ř»kŃĘků˙ÝöJ\?^}w%éíuţw·˝ţÍÍŐ/żŢ´QDy}óp•¦Čkxë­oŁ¶×7Ű«F«ĹÍ?`°šŤ®•*ÂŚ›ű«×Íď˘V{)bł](´ię·›Ő±{źľń±Y/–Z›VÓĽęvŐ°oń ŐĆhšŻö‹Ą ­.6÷Ő‹‚ .4›'čVĐó҆ţˇRę&ÉČH7Ç@ÁYâůAGb«@q—R·ÖD•µXj”„}MÓwŹő‰şOŞ™CQĂŞMÖăr×( 6ĆÝî±;öyĺ`ÎńP ŮĘ2˙Ü=¶żí_Ćòişě´ŹQÍSÍą.]G}3 ™2ß /ůE>¬¶™…ćŔ$ÎĐBYVĘΜׯ#[í°e+ ĺśňl‰v±ô"‚lmóű]&vattEŻúá` H˛ K‰FÇǬŔúĘĄ«]Ńž„}dźv)2Ý "JđžÔA(Óđ±`#ŮF8˝µN8®K諾+ÎčÍ°@řhަŹld˝Ä§Čś‡nú}Ţ%Äóޢčµ21źav-Éa!Ă^í˝Đ \(ÂŐ†Đh’$÷eßlö¤­¶z";)´šBt-Ćŕös‹l­›…#őhµG¦w»é]OăęQ¨Bőxuu󿯄 _6µ$P&i¦ ŰĽúë›Ëš›  ĽT6›ýă«îŰv}8ěsvFăŃĹpôo°ßJ7O„ą9ÎÝŐ1}rłťŢSăÔă9ŇWŇŁű„gNöětSß‚Ny¤Ľy- µ®ô»™t¨íü¦ą¶Ütß&˝°ŁK˛é8“–«f‘ĘV NFĹ&VăŃN‘Ť.~IŚěCVů`,¨|†HÁ1»ŻZ«|¶ŹöÁ4/ Ń×ä9#Ůłćň8Şq®µlÂh-®.x+˝ëX­öM…vh„¦îĹ{źň&ÓŞĂîâŻ?ŕKMN˙ů™<MżE#ŤĂ¸<}©Eţ8ě*g´–vkHĘ÷­şAë„›ň^¦9É°źäňč; î+§v#ÇŘ őQőŐ‘ú‘“KŁ@˙Ѧg˘O˘Zân!łÁ>‘^d‹‡¦qÁ!dWçZt9ruä·(R°č“*mdVŻfôÉ+ÓEvеAéb˙¸Ç1Ôý᱆ŕ(ř‚żÄÁž¶Ţôlůľçţ7a-usĚ;ä[ŽĎŕa¦ÇŘgŕâEĽM+ČĽ °QŢ&ŻMçDÄŤuŠ|ĘV+˙NÍÁˇ“Ő#2ŐyßŐŞ•Á;;N6˝>‹tg–+H4}1ăýî+‘fČ« Ă„4Ř/°°¨ä§qČú<ňŰĂnőM=pť°íkô®ŚĚĹqŃ&9”Ó°›}_–l $ťGNmWŤŽŹÝ6kFš•×±©Fěňł dV\mş1ěHŚ‡NŽ*˝ˇťä‚>ŹÂRÚ”fő¸bĘ…!0}7vő .”/ őt!łU»t!)}ˇňCÎXX3ąéÉÜ`˙¸?těŰmY#˙î>Ż¦G€vÔłXĎÂu»„őčpŮűZfwgŻń¨fůв€y`}›ť¸·×#J«(P­F§šŻŚi`?+zţ]w<®‘XŹ( ˇŤ“”OxłĆäňŕ=, R;¬ď»;”sź"€ésů—‚7Ăeý3— QçŤÓ™kÓčíaµAéHˇŹ0¤ůPĺL¸ÉĆ÷6Ą'ŕŚ¬];ą˙ŔHÉŘHĺ%87¶ôĺ3ZÇń{5ó¤U»Ń…Űł›‘w+ĹjwÚ†y íG1Ę?Źăk]™ýűĚ0:5 :ě·ů pű«ÄĘ/^}U¨vç-‘Gq.v'—îԮ˛ńŹY`»Ľ±iF‘ę¨çÓÉč#€HzÔK®Q'+Ź™FůŢwLĚOă»X¤ŇÂ1’h~óańsTc‚ĄoŹ ŮŹOPť,Â7PRĽ–PZó~µ©hŔŰ3w' \ˇ4µçůÍMQeS&~,žç‘ĘĽj“™ ú”"’VŚSĚ^•Q—ˇ=çŚ> D}ŽR d–ĺ™ECş8LřŐb)ťŁ4Ăgřh Ű~6z›u°›ĺ0Ř;?äoł^‚)„ëĄR­t*ŇŕżăXřěá˛:|OÚ0:;°ĎzŻM e~\v0,ÚQŇGŕ·uÚyu‘y†Ô Gb€TX¨µ¤ÄÄ÷gX([+­zń!ňŇgˇ[ćŮ«‘ 0Ô· P[¸†y„óŁ0äŚÁ+i2µ{=»_hťwŃŽ¤4JŻ+ 8­Ö6gL§ŕ^#ÖD[€I%ĘŰ)Ú×ĘŚĹ?ávb vSgŁb)tël ‹żĎÎh Äwö9Ei’€ŇJ@#Ąů<Ĺi ĆDnpÜeÔĆ˝ĄA®ů˛2ßŐ„Ż¸B‚żĽąúÓUŞ`ŮëĂÇV®Ä ľ2A´RęTľBšň˛˝žŹ­>Vë˝ćVŚd P׌LÝŠ§&ﳪ€cJj tLÂ7Ň×|őŞŚ±#Ł |”(íçÓ'\ŞŔxwĆI¸:ŇۉIj'ÉžMä5}ˇËëś9¦ÓlĽ¨SŤ”0Š'–€ŮR´m”g–0 ŽÂbY`żăw”A4,A4–Ä1Á×2›Îś­r€7˘ë‡„xçîčYĺ”FXŹÝńŕEBšmŃľOz.-[ŹŢ'ďô ‚Ă”&q#ŘfËĆf6ä0d6?XD‰ŢI4Ž"Ň Ďű1fÍܧŘ1Źş¨)c~,•ĄeÉźđ%Ôe&–ÚSđöggę’F!ŚhÎĄmI´Ú pwSŠâ<şH(r™ż$8‰xr®¬1îňft‹(릤GÓ#%Ĺ%©űŚGâŢ°‘2F~<"ůÇśŕŃęIůĐŔEŁ¦Uö3‰Ţ˙˛źQب®Ťv-¦¤ŃϨ˙ÄĎhJ4ŐëĺrqŚ)ţMźCÓťÉĹ AŢ´0 (Í„>‡žĄĽŕsŇŇýéd©ć@Q· ĂŇţ\}µŽaŐ¨¨ÂHŠo›®Ą<°Ł”Č|ÖĺIh(¨çďç± ?ý˙¤ŻQťŞÖ× )—(Loó`EŹ)ˀᵶCd$ĺÍ,D©šď°AľMŰ”Cbžg\ Ô_H¶×)‘h,ͨ‰ĎSĎć'N•&śmä‹â7=»TĂŤÄŚĹĂ÷ÓĐŽĘ,™tdÉşý¶[m(‹I‡ćá|˶Q+ÍAľÄä9`|Ű:cbZţë_F©Ôąőf˝şżĄ“•w±ůżĺéű|ćŰća+?Ĺ×–q·~ş_Wů†ĎOŹý»oú5ĚxęvëjJżŢ¬řáó0C6K¬1îo·‹źdK:ÇLÔe Ý’':$–ÔđśÜđđ¨i]Ńüßćâŕř&ȲżjD«„óź ‡C8}áE€W`§~%”v2UĎňśĺš+ ©h[ÜK×{ŞXㄬghďŘ°zacŕ‚Fľ\S%‚a{ÁuU`Ôíî˙7­r´–m 3÷l[—FZĆW0«Ö[[żRBhç«·`TʼnŻîÚkRŢ@í·q\‚6SśJĐş®zťSŘ)€VíĐ=Ž›NÓjŁ <]tZ Ľ>Ż”Ń6)ť›Zž‚ń<łÎĽý}nFţvuĽPőöĚó¦űz:š¶)v¤îÔ©ó¸l¦ÁŰQ2›Ĺ¶Í™iŰJ;„ë‡GV =W•-˘d¨Ő‚řÍ°%ö4îßÍ{Ń:{Jß_NźĐĘ`¨ă“ÇÚ}k xwÖ’Ç‹č/j”p)Qă Ź üsIž™O‘v¨J4ÉţϦHL«Ý©ßüvhČÉÔ ř{tËQ–NbŞźˇ=††×ÂĘ dÄř$jgUX5­Í‚"•Ô«—ćČRLžrŚ˘†úŇ:~XXšě›użŢç« ˇ Ń wŁvÂHÝRňĽî"'Ýz®€8´<]* ¦ś]pĂlŰŤ´djŘfľ9aę~‡ó]„Ą&hĎŰÓóf`’§˝2u_óHŞ/稇ôŻŽ¬đ+CŃ /Ťň8‹ű“čćajt¶sĚKęC¬ˇ®ĎiË)-ŕ ”>©ç) ;Ľ§Ő‚•b oÔ´ †¨ÓĚMi'gŢzĚŁ©ť­r©·ZCů¶pÇMŻ2Ô^Ž5™:ŹĐŃË“3h—@®őe­ćöÇýŰîa·XÚő7_˙ĺË[ěn×ß˝[mnsš0îíâÓâŽ!ŞNČřvńzÉýôXP>Ţí7etÁ¸ŞůüóÓ˙¬Ýż!ÖýtŐR/:^ZýßŔćx˛ńof !˛Ít~±Yő¨ŘŃFů8Ă‘“đ“ÎX-›čS‘ ĄBhÓ¬† eŤP0ĽŰL˘xšmüTß#f“ő™n´ONo/őˇĄEds6čÎobJµÄ™–âaŚů8gäéG w§6‡Mî*Qz—yI’üë'äś™ŰŰQqé͉ćSŁĺcHfŐQqÂrÇ9¬]˙zŕŔ à ݦ;¦–kmšÜ4¤ u×&ű5Ŭš.‹J•UMsýÔĐ+Ö ]Ăöă«QůZ ĚÖń¶‚qÍÓŰÓ˝~NlU©(tŮ[je‘9在к´·ŞŕmJ“¨ÔÎ{óŇí*wú™Űu¶Ż'ťÔĄţuĆ:+Gµ€!˘'ż`ˇsxU őďćFŮH¦Şâ:SŠÍNë—›ó@Ę{ę(tÍÍ" W+şĎT€‡e"áɦŚK\üřçO,›yO )Ď÷T˝Đ˛ĺîľq2é2řág Çoק¨°˛ß?˝Ă#˙tÖlĂý‚ÓŃIJâÁ%d]ýqü“›’ŠÓ*5n"3.4ř°¬ď&5ôS·ůÓAé”Ö.}î%­w>›ÓXTNůÓŐż$endstream endobj 503 0 obj << /Filter /FlateDecode /Length 2993 >> stream xśÍZKŹÜĆÎyN K€ş¤{ö»[‰ ;‚8‚XŢś´IŔťÇŠŃ<Ö$Ą•Çż=Uý »93Ú•%â4»«ëńUőWÍýv^•t^áżđ˙r7«ć׳ogÔŤÎĂËÝüŹłß=3FJ[Y:żŘĚü:‡Q-uiąś_ěf„‹ââß0™V<›]©’2 +.VłçäŃ«˘*+É5­,Ů Ö.H:ş­ű浣-Y ÎEY Až4űdÚK|ÁJkyz(Ě”U–¬’)°j”!Ű𲪠ąmúţ—UśŔóé5˙¸ř‹3Hf)YVĘŰCžť±ąT†E“oéőŇ&P˙úÚďĄ*ÁÄ°—N Z2Ęh”th˝uŢ Ěő¶đňX-8‹ ź/¸,ŤR©FÂ0kI{¸JĹ\%ŻšmÓ;u-Dčm±CşĄ÷‘ĺ  ěĽN–A[ĄzXĐ‚3ĽvÓ®WͲ/—Űť÷_®´2%—ŠG«űúeŠ†ŃŞD!ě&a3ĽP¤N˝ź>·Ś…řN^ăx őę*Ž“eşńa—JJ±ŰźT°ŇGsă`P×O6LbŃŰ‹Üđ¶=´á•m6űFe   ~h1_P^Ja™ Â?te(ŘEPa„ˇúeeÄB + ’IČ+—V¸™Mś™í­@ŐlžĚ|N>tŐŻśl×MIh¸íĚś•T”F%‡'3ňCń›“JK­5ŹJ˙ęŚŇT[}ĄyÉ Ă”Nf^§ ŞKŁŤôŞŔ2$woCŮ‚8ľu‚čĄőË(Äś†@Ŕ¶i7¸ŔJα~5…tĹs0Bµ<ěC1ă Ńŕeqs:§‘|WŤ,0ĂŔµˇHg32‘±ě2™‰|Xś„!µeĹŚ…RĺQZă]ÖeN$,¸Ëu}’Ç Ě­ wÁSč{GÔĎá ˇř¤žV¢›`K®­˛~ŐĹB*Ws®ĎŘOÁť4Ö@°Ąaŕ˛cĚżčNáźčŹ/f_#Úůüşi­[ š¶ «ť+SÁbć»0bŐ0˛ť}s–HLÝč[2 B•-eĺéÄgʉŐňÇV™ô‘±TXÖ,†´b9”}¦„˘xµšţ?EřŔ™-¤1Ú?ş§9Ěó‰ŹbŽĄÂ›Ł8żĂś ‡’™ `!ďE©Rtr^Y8‚î‡ÎIŚ#: >ˇçJĂ®Ú8t~äsɨ\µ‚¸Đ8×dÚv ؤßůgçP,Ś¦›C0ď6'szĚN¶–Ą›92CúűbA©RxHť)ąŚÂ|6­¸ÔzÄÂqw>†'‡1RGw¦{ó XbÍ‘’iţW—OH;Ŕ(É'Áé=Kýéd‰ŘŇdĄţ4€3jőľľ_j~PťÍĺ “ô@äfBnăŃA󙤥†™ ˇŔBJ=DiK U…L‘<őŤˇćŘ°,ŽLź ˛Zo‘ ×ő6«őľoúć×ő•kظk842P¬ŢĐ˝rvŞ5dU .˘č˘‹ß>'ߧťß †č ÚŢ‘YĹ îx®qÄŽC%®” ;$‰Čč„ĽďěÂBŞ ¶8\`ż®˛+m—@O$ČB)‰ěú2ŤZjh8íi%Ă5Ă:ČWy‡ŢÖ‘ńzž·tmÔŻ/ę"Ţ: Ý̵c)AžtźÎĚęÜř˝×Ăr‰-˝—#)yôäiŢXE’oô pÍpH+(e`÷kŻ (WşŢFż Ňz?Iˇ$©;ç? ‰O=ŰĹÓBj"Fşş†SißiŔéŠ]ómÖűK¦6Ö~ Ç®ýě@şŕ Árxe7 ŤSw«$éîů¸§A‰JŤ8“ę]8 ňhŢCmë®ôKľÂ0T p?t#š’f(ÉÝ()çI™ÜĐšˇ¤&·ľ„8^äçuí2Ims•ÁÇ/ÄtÝ«ł‚wŕ,©ŰCžCh“b`Č**ččB.ŢĺB˘! źňqŽŠÇ"ń®1Ü-a]Hšĺ:-C«ĐĘĘ<«ĺ€ĺ۸p¸` Ň»x9ź±…áynž»wŮfö:¬»?uÉĽ˘”4ž(‡vŐěëíÇçoą4‹ü¬Ä cL08oT©šó´îłi}^XcŰLήnŽ]E3쇂!&\.ŕ&€Ł+7Ż‘¸G> 4nü=Ş˝ž”Ä3čJ¶}W‘TXG±´Ńý4¶Ż ףS™‡™ŃŁđŁ]b Amáé¨ŔŔtW°&`órŔźŻň3!‡ú+MĂPŃoăÍ*c,% ‡4v¨ŃŹ»›íĂe±¸)†Nâş-¤Ł*ÜÝ`%dď $ÉŇ7»{nßâ,ę®ÖńBŻëáđ#zŠşëüg×9H¸=¸<ŞîN†:UćܨźáöÓŤrŠh 0~oč–…t Łńw›\µy—aUĄÜąM2“qn KλÍ*h4Ć+D¶3ÉŘĽę'HŮ`»—űăę†O‡ńxBReőbšyŢ÷ĚŤZ»űGTĄż‹ýQxz‹)ç|ę¬]` L]Ź ZąIqŠUÂř›»,Ŕoęě˛Ü±.e”‘făźń=¤ ÇwÂ,ůy»±<ËňŻűEÔFÍOsfń¸wm6)ž›m ¶6“ťHvE/JN©e¬€YíëÓź/VÁz8ÓÝSOÖăfGĺçDĺ1xŘK_ĄqW©„ľÍ¸bÝď&aw‡¶îfÚřt“\@×Ëbxîm92Dü˘0Ö Ž= „7X€Ýô<âŘŁŔytśŐ,9 ŽiMďĆŃ­rÂuë6h`&• ‘/§ Ě×Y&ďŠÂP±c ›¨.8ĆsŢ—ěÄq*«śŐÇůPQsT|\OVdýE< ˘ÝŽě ěÄ˙Ľ>Ŕi`°9vŠ–ćĘ!é¨h ćéBţ1qŹ,íł$^ĺ†ř ¸ŮfąŮőmÝOťĺL>*wىu¶‡ň|ÇÇßśá1 ft¸PşmöëSĚ´V`P< ˛ozřaĹégř„(őÁH X˝L~|x/đé×H—+$ZŠ­`°ź×Nżŕ¸qę¨l/ĆĐ­.,ţ—•ä‹ôM˙˘Ů_şźâ°tçé†J&ŁĽO{•gŘ°fýŻĺawĹ㝉ÝÔK¨‡—ać§ńPĆújŤv7ú,<¡ĽĽ$čD‰l!Ţë·|pY\§Š0(O+d}†ü7ĚúhÓ×WŰőĺ)ă@ąĆÇ~˝»v…nŃ8ú6±]ö:JănĎćÍ łÇˇ ß™VŇ1z%2öF;,‘‘‡Q q*bşĘtŘBĐЬŁ49:‚ÓQXuďۺݍëŞqłă:}ŠŃ¬c(nvĺŕZ?’âĂăxĎ~X&×6©FÝ«Ýřúĺ Úą ĺFmíîŐ¶~8 :ť˝Oi<Śée|¶â4 í0Ţ "LŞřuxŰě_zt@}j×Ý _Ż%űĂU7ú:Ź'ÍË1Cľüę,•Z’}ÓŻŰŃ…»úMyÝÖ«1Q—‡ýŞüó1,Ü_'¸…dł]żi®… p`Nî­«RqGĆ.I…·üqŻ׋ʎ*Ŕřúp8?á hěÖ›MłlÖűľs7ËĐ•H!ě„”?†ćkçŞjŚÔ7ýŞ˝ôŘ˙ńHTä»1`Żëí«őřćoPŃ>˙ţ»ď@ův±c”}ň0ZU„ŃŇ€QB;™äŻ_bOĺSŰ=+t—Ág÷ŮŃY7 ăâ8ÂËĚh÷G"˘äJЉj5Jv_<ľžýĄÓ´endstream endobj 504 0 obj << /Filter /FlateDecode /Length 2693 >> stream xśµY[oŰČ~×_č"Đ[G銝űA»€›mÚ4MíC±î#Ó2Jô’TF{Ď™’3”d' =—™3çúť ťÓ„Í)ţü˙z;ŁóÍě׳Oçţo˝ť˙i5űýEĘŕI’ŃŚÍW×3·…Íá©Q&É„šŻ¶3"ôbőoX̨VSť0žÁŽŐŐěňrż  UÂ0š‘í‚ĂţTH>­ň®üěŢŚ‹Ą2ˇR’7ĺ.Xö _đ$Ë$ů{˝Xň4ˇLgä*X{ń&e©NIŐâ‘Pš’»˛»qw™®Źďů×ęŻV  ¤UBµ“‡\ś9Ń)ďEľ ¨çk+DţóŤ;KSÉĺp– I–pĆYO©nśtN Hyµp2Xr kR1_ •¤Z;:çmWnóŽW\˘ȇî*ńw™"çMS7x ’RNľúK&ČçĽÚă›wÍ%ůéáëĂĺžľÔp‰’w'­ë]—Ż»ű”Ď^a‰Ôj±”ĆŇ$oĎŔLŃáZä Ż‘&¨‹fé|őf¶zţ YÝ4E{SWW=ëQ\_—ë˛Řuí »%c‰*s¬¨ă"ËďŮŠ–ięHłž\’×»®hÖĹmşX2eY‚ń´¶‚ö…‚"ĹAWN:ţ ¦”FĄ1*O* i!ń O‰ń̨Ł˛€iö´,Ş—uŇŰŰ»ĽŮš:8KŞžFvRięc¤‚kJ”x”‘^‡;SóôNÔŔçDŁŹr>I€#ÍM/Č™ U™ň Cőľ+×f2ŃŚÁ»ÖëÍiüęŠpK´ż+띧 4©ŻńZĘprç Me UR:đá™!7~ą=%w),É@°čđgŃŞ2z·[ öJ|´ž,`rBúo˘ ŤăŹ2N®EM˝őŚ’ÂÝ!Ε'őăŘĐŮ]ůCŚĂíUŮąÔŠş÷|Đ8kěă„Ń …čęŢĐ:44¬K ňŰzˇŔÍ©‘¤ŢŢVZh?‘)‹=mqk×1ü-¸ô„bmŕfŕ‚äÖĘÇ| ˛ ô”}žcŕX>É_uőmŕčv‘VŢî9b ÍŞ°#|ę¤ŰŁÚ3Ĺ›…•Rj§›Č.mt—7Î řăŤ?K0’‡6ľęS3;ťš'‡„~T7…N™“~”[.2ŘúyˇÉË*ň“j ‘ažu|?Q„´›ć3* năőÂś„1§Ä’´hŘ‘T;6őőčAÎň&‹,ŻMÂĆJă[ę‰ëDŚľšI\5Ă9ź36RÜÖVqđz„­…q‡ť-¤fI5©ĘŚ,3dYZëYhÔ pA`’˝büä™KŐÇQ“F1Ŕ¦Łčʇ1"lipZ-I„’ϢUeôn‡@%€…-ĺ˛}ŚË;ś¤/1…Žťŕ´Gř˝s¤ĄCTý I>y9|ľš8]äńŻ5'Ű^RŞ řLp™"”sn\•«±ĐőÂŕÉ»‘źŹ'Đ®¬ý‚Ŕ»ń:÷ ˘Źä§¶Ü; ÖjĘ/#/‘3F:«öQčźđßͱú *ĂĽÚsc$Ôô9Şźk[ío}VKĄz˘=ŕĎ`÷áZ’;´`ąČ{¬í-ßL`ŕzĺUů5|pŕĺÜ%đŞJjWÁ}~"›ăô!ňŤ0ý'« 1ÍvŞ«ČľÓÄážCTćÓ_ś<ń‡ÇŐPÖC¨y8ńw'ýűŢĄwđPV5IďŰŻŮ­/K̆=pn·ÎŢ>îGxh#”Ůř5ŕ¸S%Ů#ő’–qnsi {íŘ«IŔúc$)·a \E»¶ÇJIHť+w DŁHQ(×ĘeRË5řýű‹ĺˇ®Ľuâ"ř±( 5<©Ű˛?IÚ+¶0‚»ÇýzhxČ›×oßť˝üŰâ·n-Qˇ”OÂĆŮŁ\Łt±ó•mX¨UľPüąoý†L8‹Đx5‘Ś‰›ä˙ZéSL[ZIź0Ećň%¤ÚĽ= ',5‰Qý„úŁcp©”l@˛%ç«Ůű™J©yszĹd:Ć Ť†Q0‰2r.ˇr˘XAlgDdżw¸…Ĺź z..céýBp^ 0…r˛ C§SŘćĆk\3şŞż~ x"°q>‹Ł#¨–źšŰč(×p¨î<ö(n…‰çűŔ…|†§Kü#Ť‘ŰĐD©wă7€bʸOm\'áRśÂ iý˙©Hc`ÜľĚ%ë**…„c2<ŕ§óG¬”öxf« Đh­…”,e ę šę!' ¨ę¸űž.Ç毿;oąŰÂÍŘŃvô#WMţ3®~wńŹWŻ_ŤŻžŹŻ^ťýóÇqj{eÍŃßýq\†§űˇôdƲŮî·ŰĽążěůő; Řh–w]7Ű}•ż†ç,îÉ B–c] Ô9ĹŠ1uNŠË ԸΔmĂíHµE±Ś* u0ßŐŰQ?U˝yS~˛];={ýŇM8qŽąŕŕŰüK˛iň«q^ľ®wWÉ_†9)C`…őäş*ľ”ŃѵSÂRiĆsá č–Ž´N ™Uˇ/ łĂfÇR@ʸ>Kdń;Ę]6›čÁ+âeô` tGłěꮿś)®Ë]q5.ýX¬ó}[Ś°ćt«ÂϬŢň­÷A*1ťŘýß>®ÄÇőr;˙â€ćĚů …Äď+`X;¬¦€RŹV¤Úi펖f#Ďź6v´ĹHPH˛4¤ÍL*GÚ€†*%‰ä`H>ňą§nkg*{—wÉX“ĆBd&‚J Á…9bYîĘĂX&Łc$Ąă1ç]ˇ<ŚKŞĺ©ëşPTDÔ…„G6¶L˘PĎŽS°°ztJK&¤˙@Ań k:Şc‰Injc)±1áč÷¬y‘Ńu•Ša‰ĆO9ÁĄA<'‡ź„Ľ3ů„6Ăw(ü&őÔgŔ Š{‡9ŕZy Ô:䚦"äš›4s¨bŰČšbľigضÎď křó,e 2žh3ßθ2đÎ OŞŮ‡Ó}ŠâsčŚŃa_5©„Ä ‹Scź‚ä<…Úę)ěP†Iç`Ë”¦=Ü—8 ”ÜIwSřtÍj°dś Ť{äJęOGRĄ$«‹źĎ:!ĐĆĄĐîőtînđűĽ6PĺcŹS#Т­ö,K²7Ě&Ř|_uɨß÷ł˙š˛M÷endstream endobj 505 0 obj << /Filter /FlateDecode /Length 2698 >> stream xśµZŰŽÜĆ}ß_°a ôâ¦âaú~â¶% 8–ç%Đw.ZÚ3C™äj˝ŽâowőŤěćZËA ‡ĺ4›ŐŐU§ŞNuëÇ.É Űáďöt…WŻŻ~Ľ"ntţlO«/7W|I0ˇŇ`CV›Ă•˙†¬(“%ˇtĄ„* «ÍéęzYP]b‚)ş+p‰StNž÷Ĺš1^bEĐ_ŞtŇM±¦$;‡•FkôĄÄ„˘Żn“ŮmÝő Ęh˘ĄkĂáŁnéÍż6 i’î‡jQjĄaO›ÝbŞŘ|s Nç¬9'«5‰RÚiŻĐ?^~óüŻĎĹłç_ü“k"u.™VÄn„ÂocS®Ç÷¤$ĆNÇT"đš2FMaŐ"¬ÜĐŐćë«ÍÓ(_^ČXŞL>8•/Kĺ†vňŃz˝.>u˛ż«_źëCY¬0ŤˇmłŰwĎ’ď o(FEćy Ž0$XęÓ9C‰RQiDňôéS?i*H•DÓ÷É!¤ä‚™0”ÂdV ‰IţA*Ík”­·¬’ ŁJóţ%ď•4ŃhVŚťŁ ű ‰e…Ô¨\Thśó›,´` jý¤W ( ŔŁG].4ťŽśÄ5ăĽÎVkŞŹZ{I›ŰvßÝ6Çť•hŁÁ®÷‡C˝­÷çŕmĄië!Úě—/şľ>U6ťřú®ß•á—čEŰ6mĐ2ŰĎc༭Žw{'xťIŽ:‘w4 ŐhMŔXK_‚±µVŹÂ Š!,¸gĂ”ľcÉǸś+5|ŚŤÔ.•€1 ňײ”I&1Ź°w<Â5""¸L„°’*=¦#» /†ż™,$穬1¦Ě¸ńnXÂf,I¤Íă6řŔ ’%3¦MÓđŠłAˇŤ/\Sj ä&AQ×Ü%/Ú­/†A1JŹ0¨9ŘgpS¨źePW§uëu*÷Xµu_ŘrĄ•@á¬QÝĹzĄP›Uˇ· Ő.Q6\ĂO_ąvˇňI†`uŻ˘$QŤ‚Z:$ĂÍńŘŘ50á ÝçşI6[Ý$/Ž™.φ´ź|ĘJźGËżüó'÷u{mmţćł1\`‰ăţAĺJ}=».®‹Ů(a=x‚Ýâ">ľÎÂpŔŃń‘ŤŹ|| Ř<ŇCÖšDnŚKŠ4#~ wou|ÁĆg­łń‹ ¤‰p…ÇŔ˘J„á1š M„©ä™ÎĆÉzŘŹ·ĄßÎ}Šńzë°HG·oŚŁ.ťŇx´Âđ}Á#ňH©úNX.†P6^·»zł €e¨ŠĽ`t˙t‹LÇęqďč&fU]Ô†etłqZ2ô&ĺŽę§dŃJ” tĎĆc`r6Âi!0sˇŰôG“ŞĹ2”ŘU‹~(´M,”Ň—˘°łŃš@šĆÚ—Űź3âÔ¨»î.W3řÉ}´Ď†SČAuö™ÔâÔ¸ěeP ćÚ lú'ŮëBLŁľ KšIüiŽÉGűŚĎásŚ•ËŤN5č«Ż˙Ţ…Cî› şÎŰŽć”eÄꪳĹ?ZvśÓߊ6tR˛iŃü\_ Ă©©ýű"H˛Y[čĂÂłŤçpňž‡‘Í(@_Úú§qO‡4–ŰŃ$GëA2Ňäž­úş9‡y`ÔęśŘą’ý?Mz_ *vBóŃ r0»/–ˇ$®¨+É^Ő‡ WČ'kmÔU§!”gI¤­çĘŁ¤RR…˘® ]Ő¦A¶…ăÝ”ŚŚr'YqÂĽ<Ô5Şo‘!ü$ć×ní¸r©űQŻÚď]zŐĘŐŹ{Ő%Ůśm´'O6(ÉZýc•y»śçô@iR!ŃoŹ§ą,O ětČô©«Ą ‘Ó—ŚŁěę.ě tăł‘–ÄąAŁ.ę‡3łÖ“8t=Ă”fyltĆ"5e®?'H72 ě]LHPÄ›âťCz#ĐŤ’˘Îrwžź]]łt‰čRq užĽÎŔĆÖ6¨Ł9lÂz†‡RřĹO×·ŐLM¦._Y"zˇńeöśŁR%äĆĂ©<7':H<&GDž˘µŮ{˛ő1š}śLé‡ŃŃÎ$r†ŤĽË·Ďî¸QĄ>ĘLŮŁ;ÄK·é ÷C `ťöt Ž(Ą+xi„ ţ$ ®ťimÇŤ4Ţ߼ÝCúfÜW©7…;‡˘ĄÖ=b*¤ë~ßÖ?{tͶ` ÎÍb‹(Ś«Ę]NiŢx7R|7 Đ©¨oáŮOCťxŻ§…EęÝeIđËőwIk§ůĘ©D  ˝ś1X’«ĐđÝ©«Ě2ĹRŞĄŹgZ ĺevőC}© O‘uď”EoĆ2Ýtv.ôzZŰŢů&Ůç1V8~ć„X;ÓC!E3!B}H’äC´˛ţŤńŤ %ó>+ˇ‚Şx4‚ÄQµi †´ –Ӵ뽣aŰo} Byžr-Á†xÚyT­# ö…ĺŕJA/ŘžśVä„ÜŠÜĚ2C˙̨*1čÂk3ˇ>¶máX^°ËĆ‹¶´ú˘đąńi]­vačvX­Íęňa5Ě–˝óńe”xŔ̵Â-„Ő4}„ ™'ĆS~žs:§>ź˛ ooćË‘3ťÇ5uô‹¤äd†Áy˛0ÂҚ؉¤Śz ŰaĚsgW]}´t„ús¤ĹťöŮWŰK\ l•Ţůe ĐŹH 'ń–Wč¨-ź­>'ßAęfű 8÷*]¤/ÇgY¬±-®@_¸ţŘf8o«SCǸěÂQ9ű‰…ępÄ&'Lí4•-ń4nZŮbëÎű¨˛îö‹B-ů_ą7ś’Ną=ł+€«]ĆŮ“ Ö×!÷çN|v퉙˛ÄLĚłQÜuÖ UęÜ]‡řŽ-3şÖ×™Kň«˘fDšQ3 šuůĽ<ŻŚÚ|XÉ(vÜň0Ľ(…Z–RÇ‹ľmsî«mż@ôd,†iń±Ť´W:ŔřHQÚ1Ö)Ł‡VʶOvž=Á™TűXü”ĚŹ„ş‹Ä€2QP<” p «KŻ*i[Ăét<č˙§ĘĄ'Ř}<ł¦‹üľîBE‡ň—ßç“ä_‘őŰ^úŘ5A ×,n}™®ĐŽg‹‘Úű“đ“ËOń­ź´…cřKN›ń sÁ F_zÁ_  ¶]fe8‚^7m^©şßs„~ŢŹÇäZç‡ëőůÚÍř,^?Iôźąű™?Ŕ6°qç­íJ_˙{Űśnâ93”öTđpß´×af<¤.s¬nö–1ĹĄ>O®ŻŃ˛¦O’Ůăo?ű [‹G7AëxĘýßd85Ď!Ü&Ěě ´ú%˝Ăvńśč·«új´l˛kĐ…{.Jđd8;çÄGÚĽEa÷ăÉ=lÍwéQ@r™¦šěŕÜř+wŚHra@ôÜ˙xŘwq˛­FŐŢň˲̠§rŘIˇÂĄ­˝ßkënë’yĽ"ýüw¸Ť_‘ÔEC¤{éîN§Ş}¸6>qMě·WżV*ÂLendstream endobj 506 0 obj << /Filter /FlateDecode /Length 3088 >> stream xś­ZK“ܶľď_HS*0ńCĽ çQe«Te»dW¬l*ŤÔÎěj˘™áŠ¤$+QňŰÓÝH€ĂY­,K‡ĺht7>ôăăĽ^”_”ř?ü˝>\”‹Ű‹×śž.ÂźëĂ⛫‹?>㥄G…+_\Ý\ř9|!¤)¸ «má¤^\.žłgKQ%/{ł,‹RKËKÇŽÉővą’RĄĺěŰ:ôbą$qÍ# WUěYrÁżLF·»®Qř â•©ÂÚ)Ôť{óóŐ÷`PĹS{DĄ‹ĘV`ÓŐć‚I·ĽúŚqe:fĄ_¬$ 4‡=gĎůĎË/•+śc\î´Ő (SEµ\iˇH˙7xËK]â»XîďŘĘ"^âüYÝT!+µ¸zzqő‡çěďdŞ,ą;ěöu»ÜSV÷ÁkŽő/“‘Ű0D;öĂÓ'x# §ĹÉ ĽqśĆއ-}ë6sĺWAK)2HűieÔóŮ_Łý’µ/›/®÷‡â¸ßŻńć2Ľr†ÝŐí觿ŕ%şO˛ëf{łf7ľ^®—aÁ|;Č-ŇÄőh/˘ ĘĘq'ć5ťŞw×îŽýš]ŻEoŰzCw¸ú -Űěnw}”o'úĘű´Ô"Ó2"¶]q‘>áÂ?ńş) OU‰óTňHş‚GrĄ ĄhĐÇ!őc§HZÔ'GÁÉÂ<§Oń„ăµdč«“ŠŽ dH 3JĹn’á§ÂźŢëqý®I˘Çś›ą6…Ô.śß¸…ţç¦w*ËĂČç¬îşT…C†ôućÉaňŔ+s:ť…09ęxźUA\©A…LtÜÄyŚ…PiĺoŚ0FXđ™WQUů ·K­Aq !a˙&Ó=›ľ ÓĄ{ŤKëÜÜtÚ˝’ΔYŢ ­śđfÄłĘČ°­~‹ŰvĘ)‚„Sč¸KUlëC6ŁĎîZśečü‘‘%ú*72ßýÉOp•eÝ1+ ŰĺěNrpV<ŮÉ—Ű®;&…Çűˇh"ĹŐĂठă¬}¤UeäY<‘Ź+ÂdiĂ?'nÄ ś0N=&ś ` FÁ=d8 RU^Ă“PÂK%"„üľM!öj‘đc!¤8‚ŹĆmüTôŕjܢM¸ŇFůĐ“oZQ¶ÄŁdŮŐäTH Ő8öă3 bn›v—íí!ę¨Ůî$„Y—Ĺd§í°‹M»I䤓aťŮ žVF aĄŻ_ˇ§öŽťŕPKĘ.uş†÷‡ă_{đv_ßFK5Ôd7a®žÄ]ŠÁŁĂĹ@şĄb 1¬jXßxl¤™€ălJś§ű—2§ŽB$Š`y)xY±ćpGĘ(­!¦Číë!©ř]§úŞČ ¶o‚c¸˛Â±‚Ô… §ůPn|‡ž>đî’–y:|]¦@ÉAţ˘kÚ[-ű}Şbźíú-Ž„Ü:îżÉ˘‡˘S«0Ţt}s €-‡őřéay0ü]ŽŢK|#)@w5Ůč+ĂŠöTř÷ŠęźĽDěúvwO'˘-¸EŃú±Ž1jć|5ÂhÄg€ÚčUP!›tťŽĘTŤ6ŚĄO‚hŇŃäĹHM†@Ú“šPĚáÜĘjš c°-•7ÄdA|Ş•Ě˘t^3˝őÇVé<ŹapšA6ÁŤ*Ň…ŹîuXĄś„QŔžĺ–|q6 ĐöxQÚřS®±PčÍ4TYľ  §“椛żöÎűGYX®<$X“Îčéôăů5FOŞ 6čţ¨S]˘›(ÉâŮ•ŐÜo‚ĆŮP~âc ą¸:Ű ŢŢąt-­+l–®ĎUĐç)3 ąňYŠX)8}J¨I„ >RÂb)‘+W™ÓOăĄä)' ĂĺUÔňź’Řăöu¬n|ÄÄ4 ŁĚ}“¨ĐŕÖ”ŠB}ł®ŻĎú8Ę‚túÎG©‡‡’WéĚf Ţ…35Ux1Uđ9@;Y·“Öů#vłőiŔGĚ.,©p8ĽŇbĆ$ßL|€š)>I€™ĚM)}šňr`öÉţR}`sLî÷Ť«Đ,Ľ;É«ž1É4mĽvj—łVŢË„Ě!†¦ýĎ«ńĹÍ›ă5žä5"—#­°=ľÝµëĺH9üÇ×"1ř%ľ]KGm?Mř"aU\¶ľ@łłŠ&®šŚô´BĹţ;ÝlfŤĐ8AGň"Éź 8Ľ„őô]ŰÄęz;,’nŰĎň]ĄG.˛< §×„[Ď+ @Đč’ŕĽR±%™ŕÖ€B7í˝Đ#O®.~şđßŃô˘=˙ý,÷[ü|&Ť) ŚYá aŤ˙|ö7jجĐlZebۢ $˶kŽA'pá´˙‰Ďż…ČΉљ»űčc¨›żo‹Ô’O5^ÝYj[3ě+>Ď5OxVer9”c‰äO Ă€ź«ş,P"ô8’ŢĺťÖŐLťě n¨° ć°˘ň@ĹČ8DíĆ‹ŇD°M#¤Q†fő”DA °ĆF4đ™rDËĽ˝mÓĺ§C3ť)ý»ě.oŠĂňe9isrw3ńŃşť12F{>Ś´Qńnŕm>ňMč3ń¦ŞRńBp¬ ,Câ3ঌ.¸1©Ä“vß*+˙= ŞŘë ˝ß‡Ň †ˇŕ<Św)aľ;mťđ =·'R¶˘f‘Ş­°]zC´R îŮÇ9Ą9miľľ‡ŻGęq×Ő)á´ćŮjŇÍqĹAb~·A1~ÂťpŚh3Ŕ¨püb‰m?ŁHÔž‹ŐDŃE«Oż’ĚÖ JOH·żľ°….VhB^˘úÇ«ú6;řq‚WD5üsI¸Ěi2Źë Ťen۲ďuMĘąĎÚhđAŚ˛Ž?˛ă·"?ć—ú¤đ#`ő6®Ň6‡ß " łpź@I}ĹĎJH §yÓ˝ęsó&rËĽJ˙MŇ&ň¨ éDîg¦M ‘Q@Ąšů[wź2Ňx}Ň9ě8v~„ÍÎű./łę!©jä ű73Éłg7f«>;Čé„}= Y˛X cÉŞU > stream xśç˙LMSans10-Bold‹‹ů!ůJ‹ ‹ °÷TÇÄÁR3÷¬˙ľČ v÷ËÓ÷uáć÷$‹÷$÷÷,ů!©ű>÷¶Ęšę±‹÷÷Yűm‹^ű„ôg€füęg–°»±•®÷›÷÷8űł™s–‹ˇ‹Ćźś‹©ű+řfP}Uűű÷u÷÷ ]Iuˇř^ś÷i§ŽŚÓ ÷  To Ŕž‘‘ŚŚŽŹŚ‘ŽŚ ˇ…_Łendstream endobj 508 0 obj << /Filter /FlateDecode /Length 3100 >> stream xśÍZ[oăĆ~ň äARtÔZĚÜ/iIÓ¦EŠ"·}°S€+É6 ÉňRܵ÷%ż˝çĚ…śˇHď.šE€¤fÎeÎí;göŐ’VlIńżřwsXĐĺíâŐ‚ůŻËřgsX~uąřěŁ>UŽ:¶ĽĽY„=lÉ…®çKŁLĺ„Z^WäĹŠŰŠ2ĘÉë­¨†QGîłçÝj-„¬¨aäŰ:_ôrµć(1EŽ¸FTÎZňUx¤Ś“Żď˛Őmsę€~°Ějy('aÓiî—/˙ Y–ëĂ­Ş¬± ÓĺvA„X]ţÖ^(˝–’-×VjŤë@Ó/WkĹ%)ČýîńuW㢠ň»őđăî顾ßV·mł˝&Ýîđz2 "1ňĹ°cż{łŰź®ÉcsżűW]Ż.V(.•’Ž//ż[\ţúŠüfµf‚qE6Çű®Ţt…9bqáőęzĺ "•\řÍËć$‹:\¤$iŹŻń‡‡v·m`?ą9°‹ČZ\ż-tÎřGZ׫Ooš.í»Š¤TÔD2ç€ůdłŻO§O&hńiöú}ŘgŞtovńÍ©|iä$ŤôŮ G ‡g•T ÍO+#ś ö–L${kp ¶ań/ŹEü+ă_5ŕů{¶ëžOoräÆŁŘ÷[&áĐ ¨Ž iĹ©ń áQ™´ÂbÜńü•rYĽâ> Őy“Ç©äo|`˙X·‡9ö”łÄžÓ‚˝˘{NiÁŢč˝ŢÚ$€ëV[ňvwJX¤¤d’@›óR,ť.^K€lĺXď9¶T%¶I‚HXĐňUŻÜČ­\M%¦ŢÝÂAü­ ůOZî|2\ë“$Ů–ivřýă™\ÜtÍ1? y÷xĎň±!›@Ë  GĽżĆeŽ<ä)y/NCrŕ Ęźąŕ¤Y1ĐŮÁÓ&—ižu±¬ľŹr(í+ÔÍBŞ ©sňç}SśA~8‰™(Ď©ş­.R˝­L¤¶x=uáô»Iąµ©úĂg$”ÔęěŚ'Ď’PxD¸JSA>Ź3ŞRp:ž˝ÇäYţnWC.ŻöoCJOŮŃiÂúLÉČÍëű ˛˝&O{‡Ťµŕq×ÜŢu»muŘŐ°„}®˛”ü„%¦/3ă,ŠŢ,i_Dz´–Ą,ŘłTĂŁžJü]´ćç˘.“ó1şfłB„Ř%wŃ…„$MojFŠmNńx.b¨>%¤Hj˘/‡ÝÁŰą3$8  3˝ÓôÔIwŚŹÖLI3›îQ#Ş4iĘŔŰ'š˘ ßÝM€9ĺć“ĎMĚ"ŕcŇpĐ®W ŕś2Lŕ7Ę0g7Ďć–*xŤÁłč˝ć‡ě¬»:_żÍ~©Űí`Ý]nĶ=¶§¨?DH¤vĄ=Ę–†?ć‹>>c9iźAÉBÇd]ĂŃŃRuĘşđfĄśŻĐ`ÎŢ]dLîŕ˝ŕ?Çů¦ś)Cnô/ Yăů@šö‘cŤ# “Ć™š}ý2ĎŘ˝ćZsÓ'iđ˙ŕB÷±í˝¦ö©><śÓŠ?~xľŚ°= Y0‡ő3¸ô´«IďÖĽ|ń÷o.bÍ}·kß`%”:Zé¨8OęŰcµ©÷űkłĺ?é3{®Äl^Ö¶2ÜŚŔ­Wˇ*š.©$yčZöŹhm<‹×m@Ż‰N^ŻŘĹŹHFhJµt†ćß(HX+óo E3ćß ×NJÓ#´+^ŇśËA©‚Ő@Y^|Ž_ĐŇ€ňn -JÚ!!„])·qÂUđd •=ŕÍ^gçÝ9´ľ’% é‚Óň ¨äĘ@ň(ľNF]0fF0ᦪă•*Ů€Ą“´< Ç &–âŔŃiZÚEKˇńöç¤˙7´ß…§0śĽ }úŃd —}"Ňü]…*Vâ×ŮćˇP1âÔ/#€aSą=äËź!·ăŚDŤňŘ›·%Ťý0ů0Ü PF#ş%Éóúí¨ôuđ±éîÎ0Ďą‚Ó0ĐV–™8mńŠ0pśC‡Äă˛+(+·ů¨č0†0­ H ýZHĘr‘ŻřÄ·g~¬ŇçŽâżC-=˝@¶A$6‰ ¸uŢ­±ŇúuP‚sźčşńŮj Ë#–Î×™o”íF_ ĂłzŻFlăa¤ĂŞ^Á±I“P„.bł˘TjŔwÉ+főe‚ü -×řnA~Zý wŞÂâkLűÚ)mţ‹`ď}Wip™ ţşŠd€hHŤ§2Š)ţ,Q]AŞ7ÉŮ® .2—Ć+bŤe|Pv—®şĆ WÔ.×ůÚĺ$'[iÔ1qZMů´©$4o|đéäk’GŽşş9o>#*Jž˘8„5ú=Đ$o#!ČzĎ´Ă›śN]z@? %\!‡1€ýđ„şÇů\Č•˛ŹŮ&EÎ8bĽ` S­Ú8“ĄáFĆ÷X."bů‡? ß\…t¸¸ťve¦*c¬+ĽBUŇ»Ż"Z1xEňé‘k0€ÚÜܡ:÷ĽšĘJKU˛;¶ŐÜŘ0˙ŤŽŽĄ)GżDG§ńb$ďťéżTEôŽîŘűE\ű!A1"(5g#eË-ˇbÚëŠF‘•˘"rü2.,“ä{‹8ať/ýí$_<Ŕ[#ľŁŁâ•2qÍ“,q Ł(®0N;żň÷3~éC—áBJżô§éSF˙ňpşXüţ :}Ě.ĄÂy{! {}sąř3™XŢž82[>.čňO @ĚĽRvÉ©čĆ—‡…0ň­îżě?Ě_)ŤÎ0^) čVđ.!  ´9^)őg9ęZ°Eču^¦ŃK‡ĹNÇ(ň.é‚A Ŕu…P‡’`„/XApű˙ˉ Ç-!Ŕ¬}8?5臕 ‰€#÷8GhtÖJ*ÎKĚ°bj0–†•Ë©ÚąYÁ ;Vb.„ýó@¸O·“yň2j8—@ ˝ü?M ĺÉ8hÎúüqĺgnŇh?s,üNŤ(Ű©kuBcom# ˇňaEŰpp ؇—uńÓqŐöýÉ@#ŠÍ Ô6× wd’!€Mt{Ľ‡c2h °qĽmŢřöËI>n "R•đÎkŠćO_‘ r%~<ŢÜľéGogýv)€>˙ŘśîćúŤ6ImÉźsÇÍÇşÇöđd (Ś÷_t:+ iž˘ü€GUPşžąŞzż;ěžč4/ĹűSđ:©Ł˙Ř ű..Mf§f»CW==ŰͦšĹş§®­ËÉčdË,E°ľ'7aDOÎWE´ôLa{›02HsLăkŠIîŮS7őm„ýaßOůÇăÔrîp(74Ü:çtkqw̆´ÓőFK€µv˛ŕÄ+g ŽĄl Ř%ĺâ°OôŁĎa«Áî3¨„V.Ź…čTF<ć˛üʡɽr“—nźŘ° 0rz{őM-¶qéçą[(0BŘń\x…ÓS·€Ć¶â]w (+§h~VŹ„(Eş*îš}Ó•·ž¶ö7Ă!$Tń\ziŃ\Ü‹·Ć† §šýçJĺťÄ) ăXşź®…âąL\č ×$^FMšQ°ŚF¶“7ýŢ70Zć‡˙á0,ΰF·LűŁż_´ÜŹAŹńž I»+'€ű›ČchĆ˝ŠŽ=?@·ŁŞ53hcţFrν{8‘†—/ókÂÄłčĽmë0Đx-‚ >eĽ‚µ<;5şM:DęŚgŃÍŁ ÷AŤýçĘú¤‹wŁ#ě‚FK‘âä)ŠC¤Hď2>P$G "ĐáYŠs¤Ę±¬Ł%oĂÍ‹őD§ňyźVšóÂę·Ś-c¨‘ťĘ‡wŽ$ÂŽ˘<#^@Äčöţź{€ `x)°pĂ׶ďT&‰WăÍúCý“blůqfÉó)T_­žAŰńô† ůq.lËHö;©ńŽĚs®@O|#ýýâ?¨&'’endstream endobj 509 0 obj << /Filter /FlateDecode /Length 3163 >> stream xś­Zmoܸţîżpiáo§M#_E2h¸ ZäŠôЦţ–Ůk;j´«DZŰIq¸ßŢľ¤¤]'EáÖjÉápć™á<ĂýxN*zNđĎ˙żÚť‘óŰłŹgÔľ=÷˙®vç?^ś}÷šŻ*C =ż¸9ssč9ăuE;WRU†Ëó‹ÝŮ›âő†éŠPŠ» ©äŠSě“çëMÉą¨˘ĹË&tą)Y ’¨,zĂ+ŁuńŁ{$”/Ţ%Ł‡v<€(|ˇ©®µ_C“Ćcßüë⯰!MÓý0-+­4ěéb{Vpąąř7Ś1$S AĎK뇽)诬›’J%Aą˘¤•frS Ĺč]üüčM%ÁďŕץĽ’°ó‹WgOß0ýW0^qJN X(n*¦¤_†M+Qób€OBSřlŠ3śĐĚXű»÷Ĺa¸Ëýbß‹şřŰ+|ĆĄEá…‚‹ńĐîš`voj? ÔěoÜ4ĂĂŠ3Éş¸Jý^fS3ý>ŐÎ|‰ř\‡ŃŻ¦yq“¬ÖŢXą™ä• ;/®wśźçX¨¨”ÔŤzS4)p·~=ytwv5«k¦f{]•$rQC6Lżę»0IȢ™ś+DŃě~Kź5 ˇDśI§»O˙$yöď™"˘hÖ¦¤6ĹgŔś„4 ˘1.~—Ě<ŕY™%Ş8ä@UÓÝöC›}ąsb áA#+wÍMTŔ×Jy7]u»U/ÁÎkc‚—ň<0ěŇ5Š&˙v ęÓâaćĹdÎ béj»xßµď]¦«gs»6s[„8>âˇĐ˙V YgČ˝K2Řeâ“a$Ś)b4ŘĽírśí +‹1ŤĺG"ýzşĎŃżËlV9LŃšV °Ă”Í]hď‹Ô·VŠ  .vY˛hRđ…QĆ3h4÷…Ńb (ś x /ö;&d™~Čť‹vEpVÜo$B15é8ŽiË>ËeŢr*Đ˙wŢ ű’ĽĄ>?–·ęŠ~4o9«¨#Ű«ż&qYQ‚˘¨r‚%xźĄ¨%Z“2Ŕ|‘żě\¦]ţšÖłHăDTŚ2Ź4­ý>†Ëj‡ˇ˛€Jcę`[˙ľfĹCŰuţ“ĆÝ ł8Ń™>ŮÜ[4EÍ@!HP7~*@ma.;fŽçZ űşw‰”ňĂíJ9â„f’¦dţ˛i.Żm‚¨łĄť§‰ß+5k{un‚Ĺź·NxD»Ćąí7N†„K¬+ĽB´.úÉt(Ú˙¤›Î˛ó`V$…Śâjš,A„|ʤĄŽ)‘xŻ˛ tĚrHş© ŽR[­ď(¨ŞôDxúý¶ząVἾÂC †”T ]ĄP4Ő•ÖµrEÓĎ}Ž˛g°9I­[sjbŹO řÎ-@ü3ýďm1a bĎmäł,ĺ'¶k“q«Źüϸ6đ=$Ń]ČN0f{,(:?žčcaë= łŃNűŠÜ¶‘ă‚qäťÇ;[íÇ»ŁŠ#Ä™©Ś9ľą/Č ţxMELŢX®ÖTBD®*fgČ*WĹă!㪋sŘfŁŇţEĚŞ+ ć܉u=±ăÎŹ'ŽFZ™ĆŹŕ±łĂµ-ęs‘6M xýÄ?5x2±âB\-h’{xĂJ"çŐľľ†Rďť-0ý„ŃőbÓRŮ)ŹŁ‰ś­]éUĄ‘xőÁj+Á„‚á,řşîÄÂăÓÖ˘§ÄĹ»$çćDŔĘÍÉďDźđűčú ¦żl4$Uăů‡íôÎüţ©É,ÓÍ“[hg°±i[ČĽěłŇnëzÍfŁ–Ž ]m%Łí{?pׄGůĹyĚŽ7ą›D|6ţS†”¬«qtŤq˝ť ±u´l'p–őřË0ťI5ˇîhyýý¦”¶? §˙®şęw—ü—K˙ÎČâŹeüţŞŰ˝- xűŰ_ěŔ8ě7|”–rŃga-¶Íˇ‰ţ=´űë·› 2©ÍľżoŢNĘLŇL˘źźş0EŢ>Őľż†đčűmÔŐď­`Şi•U‰0Aď«»Ý]#ďŻă̮ݿŹźvýöşź[5j~ŽşŘŮô¦púóMYsB°ÝŹsźÇĄď†ëń]ßmÝü$=Ţ5?ĚÍ.-¤RłH)!E×ß"¦ĂR7Ýő§ö"lĄ† ëŘ+ \ćńU,Ľ˘IN¬5Eů"fßW{1bě©ůĂO/`a(ţđHoĹ%_˝®€˘âÂŰÄ;Ţßżx׎=&N ÍÔ„śş5XĆ -!h\®¤’†n#šH‚•ÂŁE*ˇL"$ěJPÄ)Âđł»őˇń+¨ýż.‰ ŰŇĹÓ§OŁ—´EqQ–ĺć[«É?ŰŰ}{SE‹\€“pâC‚3™UŁť Uć·kWa˛R¬6ŇA5|É)°;%8›S&¢Ž®JĘ ß/Ri]Łl˝ă*…ŰTi]#8fj.OJši´*ÇhĘżĘFň¸Bę+LTU(Žů" 1‹-ë7 ČŁÂăj"N†tŤü”â€Ű$’öâ"ŻÄ„˛=ܵže`/ŹµbÝ°IÂV <ăihSXj«e}zęć‰&ĐĎ­—2VĽöަ1żŹĎ¶ó“kČd‡¶éžá ±K(+dŽLU(›íÔu‘´š˝°v~Ł-‘Ş!+÷›Ţ§»ŇVŻˇTÄţ´Ý”FIKĆ–x k]ľš.mÚĚGCÇŰI;’şÂÔrY“ôb“áZ5lű†Ác±ˇ¬léŠa^ˇHä4ˇć›Ý+NĄ›NKĆe׏óŁw~Ý“ôC7#ĺ Uâč)ć;ÄVŘwŻ©ĚŽ@ÁÚ«wJ¦˘L† NšsóK5« P˘üľ:EôTj‹5«}Nµ]ůô˛yż eqEë%şŞŮýZ$E[“µ¤K”\ŮËJůěo@ @Nt-eÖÓĘŢŁ­ňO7NôËüvbÖÚpwľľ ‡´á.Ř\¤ÍÔ·z űn&ŔöS FÖŘ»1Ȳ›t©*ĚěĂ–`ZŰk@ sp˘JnUô—véT˝o3Śqí±ÍÚńČËĂ6+3¶éţÓMŽ|fęENqÎ9Ó#´‘éâř±ôq“ć®ë ™FZ’Ţxš/î}¸áî$p$vvyŃg7číQY‹^ p8jëóţíŇS®Ś˙qm“ÜFć:»Śž]±łW„]čYKw~#3ÝQĆ°oÚőG ´şF<~ő-…?™_UŘ<¬0nîćßĚĐăěő‡ÍĂ-sí•BęůTCçÜ™C® ĘsgĄÍ*wŢ÷;Ëó#Äy•2_őűCsu¨®˛nA_„! wžŃ±g‘€Ąt;™BOŃíńn·k†ĎoĂNQë:Rljâ9q{3ŇČÂö–ěĘď2‘ň›ĹÄŚáPÜÚó@m :š*ÜŚ€;ŞŽÄ(RíŘFŘ÷—cĆa3ćii)2iäT{¨†hß]ó©şšmô“ďîOuÉD#ž8®b‘h—ţ‘¸*…4šRFŢ\1- ”I]4qiQ±ë?PÇúĘ™¬ŠýőÍM{Ő^ď@!Đţ|qöřű/ÇŁ…endstream endobj 510 0 obj << /Filter /FlateDecode /Length 2299 >> stream xśĄYKoÜČľĎ_Č éY{~?Ś$€łŘE˛p€¬W@hi¤ť,2IYqâ䷧޻IvĎP–´"›Ýő®úŞz>¬iÁÖ˙â˙ËzE×7«+ćW×ńße˝ţÓŮęwď,•ÂQÇÖg׫p„­aŐ(S8ˇÖgőŠHş9űlfTd»©.wpâějuNľ˝ŰĐ‚*au¤Ţp8o…$éjU‡Źá‹qdżŮ ! *%y{h’mżŕ^8'É_ŰÍ–Ű‚2íČU˛Îâ‹eV[Rőx@”Zr~oN ĎËg.Î~đ ©L!­ Ş>äÝ:ÚňQĺŰ„zyé“(yxi*ąśx™”dgśŤ”Ú.hʬQV›@ÁєņąőV¨Âjí…ľ:ôű˛ßŁč[0­Đ’­·LJ:őuűËľŁRçŔ„Ώl~äóŁ€GF)‘›-Ł–,ůé®ö"1S00F``m`Đ€Ç2ҟҿ(âÜxř0“Ľ(·:Żá‡Qô·«łoÎɧ}?ď*9 hBSH5żHË" [Á,¶p:5Oí¨8Ót: a$-w1l!Ř'í†k §%¨†(Ą\ŽQć8“teUĹíL1–…Îbů*!Ţo;Č‘vLFÚëÍŇ».‹Ś›q'‡>j#xŻ¨®ŁýŢýq´€ ×őüüűíü|YŐ»)Ž`UˇZäżń´ôj^¸ßn~úyáóău·˙đj&sUedĺTşŻě†}÷i·™˝Žńt*őţź·;ýĹűýPĆÝlj1:îí*ŠŠQóŰ•* ×Neé@xA°g!׏"a:á)Šß} ­ĎyeîţÄ3Ęz‰‡t9ŔM˝-ÂYë‰ĺŕ›ËÉěăşRSLIłSṏ»1ŻŁ`(q`+€F׏5ĎŽú¬ĐúđňC9î6 Ž¨ą± nĽZĺ‘źÁ°śxŔĚt™Ů€>Šć I«6ÄVü ąNŠdŰŤFÖŢŃ>X€(ŠBŃ´]äď¬$ă¶ÎjwçĎ@ĚąL˙1ŐŠĂ™Ŕ¦Iă uţ¶÷Ć°\‚5˝` s÷öEv] @9Ľ©ŞÂ-•D‰h‡Č»›×Óím} #a›·P"Čo2_&ŔE0©i•„ : j+…ËĂcü`tĽ>ęeÇ"űu@ꪝԳO ę©PĆ3שę‰I«fÔ) ‰*b6ך‰ęÓ¸‘‘€í܇&úVsÁI™QÍN÷łÂľ!9‰¨ÔŇňżo†‘~(‡»*Ľ$Î “W~Ű(Qř~C\|Z°ď˘š†±s™uŃXظČ;­Đh‘ľťŹaęŹíVŮDžŞeU·}$Źu°Ęś«ŮaöY𶷹—Ť=Üîe^ëŽ ą(Lć %©3oµÝëçăeŃ´őeúyÉ^Í­G‰‰Ů¸—żfY„Ůě|ąŮZ ÝŰ#Ŕ›°é7M‘ËÚ&'ľnö7ŘÇￎ|l©Ëv˝‹öÚmÎŐk{ńP#ú™3^Ď–űĚ—–ůg±´,>ËdůÁ€K8áŚfˇą…ł{%!pKפ–Ú nŇ5Ş•âVrO˙»łŐŹ«0p©u÷+-aAepĐ:'óEVX;EĽ‘8Ćdo]ßbžHPĄOsŢ ňç˛ËSĂ7Ćş"üąsĘ ć\*6Ůěźţ?Kp&Ąä]ŕCĘĎ& ¶ä:70„¬·6'}:šŢd#ŰĚxł]ËhyȢ:VI«ôfÓx ă>kk2Hń$%;ŞfýĐÁ6PL ˇ#ß*Ž}Ć]Ô Ůy56Vp #ć„ú>Í!łˇ}”‚η7QÚ÷A9ÍNćć-ŕ2v[#̨±şOýé®Iąń=ÍŁU=6GY‡2Uő Ŕ=5čŐ´ĎÁ(î ť+îŁ&Ň©?†/Otgu*Šo‹ňpŇŘ7ątó8â9쳲”'5řpÓÜVJŻ y3ťđŦNć”\đqŁ4 xu÷ýĽ˙>XŚ5ÚÓ;/›k§-ďSÝ›ÍqI U`ˇeL}^veť•â!{Ă1KsźŮz?ę2ßÚÇ­LfĂk×Ö‹ĂĐÉTÄ»ŘŘ{/\Ň 9@§;čăb%4óČp2u˘(m_JÂqƨű~-ßŇ2ꇙYŹjQ c-´ŐŔqN‡Qý!ŤľJ–ó1ßĎPŃ+m†‡úđŻFCČÓ‹rdÇň­Wl ťJa?ŞIfmĽźĎPĚÚńžl/»˛Ę1e? ‡*Šąt>a„>)0S°-:"€cĐlY/řvD4”-Ĺł¦Şř2]ß5—‘ÍŽÜ–é$ąo@ŞË4ů÷4Ç˝ś/ţý®· Ëg^Oőś˝–É/.©‹™ňË™+~ŇɧoćO~nNnÜN‚Y»•w“ íĆËů·Š˙,Ž¨ľ*{ţ™NwMőn‡şˇ˙¤¦˙]#i!Ô?ą18 ă‹ÍŘ4L×ďwAŠÄ/čÉÄ–^Áů5ÁďnažßŹâMw ’\µß¦GGůţÍŰźľ{PÔ®˝k®v(ń ďÁ×ú"‘‹?zÓŽôÎŮEňłô*sPb§Bç©óÇŐ˙@É> stream xś˝;ËŽÜHr řÖţ{P·eS\ć‹™ś…á•4ĚzđjzíƨîV‰3U]Z˛$Mď/ŕ?đŃ‘I2#™¬nymŁ]ĹĘŚŚŚ÷‹ÚTĄŘTřţ߯ŞÍţęOW‚žnÂż›ăćůőŐo^:OʦjÄćúÍ•ß"6đÔ[6Ęl®ŹW…®·×?ÁbQ)¶şŞK!Řq}{őŞxń~[••QVTMqÜJŘď”.⧇öÜ}đżŘ¦¸Űî”ŇeĄuńmw-űeÓčâ»Óv']Y‰ş)nŁ%°ż8ájWÜ ĘŞrĹÇîüÖkjUŔçüžżţgşaŞMYŐţ>ĹË•;—µ“ă•ßEĐŰşFüŰ˝?«®´ÔÓY6¤E)…#¤Sďoç/ĨѶçŐNI¸±S›ť2Ą«kçŘžűîĆ_´QŹSjřq»Ýi˘­+Ú×řSŁś“˛8lĐŻQ7hd‹1Ĺů„ź”Íęźďâăn`Y#ť5˘8‡Í®ć|č†p‚Eßô6ŕć‘Ořĺ†qŰK”i´s)V¶^°Ѩęšó«oŹáęĚÎěgßD»úÓ1€«tć<˝)Nń9çîŘýŮK¬ki ĐÓ} M-N=J{ 3˛`wľ‹ÄwŽµ«g(Ij„*ŤnäćúŰ«ëxUüMŮŔ2§ž‰}XĺTÁd©Ř2䣄ŻÂŽ¤ĐN6žřÜŠâĐýĽő—í=tńĽ7(OS‰bTxmI ­ĽĚŕçF‚BOĂyţţ÷1WĎ#NµČŻQuqşOX…kŔđśz˙ąiLq„/Š+¨„_#H bzwýVpád|"ÖΫ‡r»ł•袸^3EĹ0âLaĐ&r‡uăŐPxÇ=µ.âOgb;ňú}Dßűčóx„Ő` OÇ# ŁdBÉŐpÁl“k¦&F I¸´ńI·#0[tçpÓÄKz4Op÷p„ĂI j‡ač^Ç>äÎCŞjKö‰v€2ré_ęWňT«&H wŞŐŹZ ¸|!ěçű ‰[Tw<ŃÖĹëé† ńŘŘśú°¦—Ť óűIRµ”hą4¸ç pN› nµDýA·`‹ë­#›W“~"Qď¸mHm‘$/RŻ"±zđžórÚRśŢŕG‰†ď8ľc:Úq5:xOt«‡Ţ“ť2 “çîďbĆÂ×@‰ppŻ‡ŕ—›*öËŇéR5:D7‡ŁŹ#’@«)­´Łóç× ˘Ż Ŕy7vÍBF‰(©§đöLľB΢—µ`@Ńż ě ÷CQ*\[‹şH·`WÄ´§»ď7ŚbvčgLe€IJŁŮ^˛^™ŠÔíkîG†®˝›Ŕô~dÁ‚«$čâŰ®· řqI‚‹÷Wą©Ś®‡-‡¶ßs{›ř°ex1Žíá‡Đ$Űí3§Áß~Ř‚Çiď×Äu˛QdgžÍ°ę#"$"B;«ŃdT¤`„âůJw^űĹi̠Ꚍ:?˝”€Ú’ůËKn±ń‚[ŕ‡ČĂ°Ô$á–.$ó|Ýcs¨CŰw‡‡ń&ł‰ †dBqűEŞ1ŢDŤ•`Áîđ¸JcľÔ»EfmŢňü¦2ROTuł]‡ÄkÝ®¬A#VÄgÇ2wgˇ»žC :5TCî}a%<[QXkMř“°Vbx5 _Ż,”8ńř!˛Ţlů×­˛ÂĹ @”Ůű3Ě‚2mFĽ¬™$Ôűz/ˇř¬˘l ¤ˇ–ĹĐ&úCŮdě@~sIJ:ŃpnŇ ňĄçEČ ]űeL IDp4˘ ůŞvb«1]…ĺ…úÚ8Z¨sţČ•Z ©d´˘a‘ –^+Ű|ę±uîX]Z%+ĹÎ}ĺI+(ośXžĎĺ}đCžHW ˛`ĺ=0,ř˘ÔüĚâŰĎ5„#<€%?é“VZ/Ľ&“OÖĹ>“ą¨ÚoÄL2Ü#Ęł­­ŕX–ń.ÂQ<dŹ ÉyDUÍG›âăÖ”‘bv«J‡4÷Q@śDÍ:i¸éĹÜ%úćÉÓhN‰Tz-|Hś_85 âÇ’ PqŐÚĆ)o]:eš1ĺ}†\ÁA>­dâąp… T2g˝(Ř–ă¸E…€=¤±ýřÜŤô?Ěńúxµ…áâ:q3ŚůÁ˙U‰9­„†üˇ‚‡N)‘iDÎçÓŚĺp>˝ ßĐŇsŁH˛´â źOWO<‡É„(Á÷}đL€ô.ÜÁ,˝)=·r-ýâ…§€í0<ĚČ{¦ý¨FŇ:JźXĚęŹ]EH ÷7Ëz6Í‚ë+jËÇHIZ2úKHË2Â8•˝'«âłĎ›ŮËÁÂGxA˙ŕË>ß/LĆT¦óŕÁů´ü˘ďůc©ŕgĚČukIW¸°IĘĚvł“Ż{ř'¬r×o‰6Ć:­Ů]C!•94]ŮRÖS2vĽ;ż=m –'ĚÁ»ř5»©ž†K»űŰ»w´ÔA‚~ßî±ü¤ Ů’»ľß̞њb™IűBĐÝrŃ‚ ĺŞşrf'2ĹŹzÍŻ®ŻţpĺkúfÓj-_úĘŇĆ@/¬çż*ľŠÄčp}ůOÎś™Řŕ“µńUĎëÎg®“rsŤÜ}Cö» UQzŁŽéíŰü‹š°Ä řľŁXÎ3KţcB…x÷a5$¶@‰ů>•n$KŔ‰nT=— …­IÝvĽÝ‡ő Ă6Wݸ†A|śH°‘ˇöű0Żcí3m”a“ř¦ ćFÚj¬UyÓYJ\ńÂ8¦$Ë”\CŹ© 7|=I,ţTY_HĄ|N,kŢ´Ý|jiťr‹”>A/â¨2`7Ą ?¬¤*ŹŰ—3&LëtmHy?á4ŚäńEş’Č”÷qÉZh„ŇźygiŘYŕščżg1ęÇ3+'ď^¶1Źc°Ź”•7żÜ‹˝ ń|Dh3!ášt•[6q|“îq.~1%0Ž÷ҨֻŮI]Č^Éäý”M:Ŕ(‚ÎYějâJAK˙#,ĺő70 1ÜěŘâżÍĺ)4ŰUfç«FD61ĐŃJ´3»Üĺ€ÉŇ9%GË˝ˇ°+ץ„Mzł‹OüUöř(ŕŤč¤pôk8 ö7Ůs1ŃÜرŇFŽ!ŤťĽa‰|DÚ»±Ť™`)J#ĚĺŰ]Ŕs: źHd-ôcDF` • CJ•–HÇ®űŰ<•MiŤ{HR˙/…¤ć,půÇĐ˙Ç<úH~8ŔĂű:ź°‹˛Z°bH—RK1fő›Ľ˛Ô¶nžŞ,˛±-Ťî)\ó QŹ=¸‡5ŞęY¸¦#™B!ק_ĺ°ŻK0Đb$©XÁ)Ô6bhűÔT„ţ%MDý˙áPFÓ2,zš¦!Ź)ĺŃŚÖxf:÷ ´Mp.Äâ× =±3Ě1%°ÜĄ±ĄÇ….âůHćăińĹx âň˙˛ţpi©‘nB®I˲UĺIÚdHZa8“(éËQµŻ¤ľ™[?yO^ąŇ Ĺ• Q=śÎ±¨îQ»ŹŞ“Âf§@Rµ3©ÚŮzŠpşÜ‰ ˝săĆhä×ԉعZR–PRSŕұ4ŃŢGÓMQN–˝`î5›úBŻ9¬ w ÎáńŘÝ źÓą'S Ţ3HšQ¬HQŔq Ń´›.ęî$â1 É!T±Ć)ˇöpät‚;HbaZjeJ¶Á~λ¸»ÄYâ„­ičŽfS¬öF!®Ąĺ^ôŰ—üµIHMA?5ŕ ‚t`-3ŰŞřÄ‚ @~R1ĐXAµąçÉläm@”›‚úś™“Ŕ»Ő©Ew»„Ĺär“u?ĐŔŕĹyŞşY›” ţ€ŁV*Ş}6Éôí©çŔ~ôőMíkĘ—Ú[Ř3’Â6™ć#'ÁRb/»[,É2SÝ ČŮíă_؜٠d¬iśçAöÝyď¦iŐS”Č\îöÓ€uŔxlĄîĂSúÔ8¸Éۢkf¤\˘Vv­F×é,•Ş(Áj‡d.{ŕ°Cô~ŕ6UÁÂcŻD6Ë!-l>hŚ ѫ橲<«3u/ô|Jěc߯ˉ˛’ľCŤ‚EAĹxDŔŘO“dÚ MEŮ+˘ś‰(({âëś,ű «PXŻČ2GÜÄ4z™ŕt)™Ń×ç±™éĚhÇ'ěç!a%ő¬7߀ŞŞQŠlńÍ“SśüÂäŕŰă5]Ó ”"Q˙ÜKČČšŽ«ôßf¬.˘ő"ă#ŰS.e:źŐĚĎ‚ŐĎű‘dT¸ä5™ó)¶s©±ťćRl.´*+Sů_·GźĄ,ţŇţ‹ËĹçă21uy퉨ţ«±Ý±í_DăbĄˇ1° ÓvI÷$LŤ [q˘â í˝>˙ňýý] žíőéw{<§Ľ9ŁąľOčS e ;á·3¸˙)âR ,•/˙Ý‹·$I÷ĂÝýŁD ĺíĎÓ‘¸úoŽQ,endstream endobj 512 0 obj << /Filter /FlateDecode /Length 161 >> stream xś]O10 Üó ˙ ˇí€XčÂĐŞjűŕ8(NÂĐß—čĐá,ťďN>Ë®żöěČGôř˘Ö±‰4ű%"Á@ŁcQ+0ÓÎĘÄI!»›ďO X d7~×Éç©ş”U˝…ĐšFŠšGMUµŤµ­ 6ŇěîTÔnPgUü‡’ŁąÄqp‰‘8•¦ĄI.ŕ~Ďr V/QŽS—endstream endobj 513 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 258 >> stream xś÷˙MSAM10‹űvůeůp‹ ‹ ’÷‚ŃÎËlessorsimilar.‡ŁřůťűvĂ÷ Ă÷& ř®źçřő§ů7ůF—‘’‹––‚”€†‚‡‰‡ü˝ű™z„‹‹Ź„›„ř˝ű„Ť‹Ž‹–””–‚Ź€ü ÷‹řĎüh˘„”„~Šs…‡5MOC‹K‹\µ^łTĽWąE‹"N .t‘‚“–ŽžŹ÷۱Ŕ‹Ë‹şa¸cÂZż]Ń‹ôČöč 7ź ‚!k–endstream endobj 514 0 obj << /Filter /FlateDecode /Length 5740 >> stream xś­\[sä¶r~×_S™:OśÔMÜAźĘĂZɱ7±OŶ’Teíę˛#z9™Cí®ňëÓÝI$G#ÉĺríâŇčţúëFcţX9[řź˙÷jwV¬¶gś1zşň˙\íVß^ś}ý3+<Ęˢd«‹gî¶âBçŚó•Q&/…Z]ěÎŢg?ŻąÍ Vđěa]ä…†ev|ľYo„yaXö}6ş\o¸†žĘöŘF䥵ٷîcÁxv~´nëC]áˬ¶~ UJxé°ôÍo˙ ˛,\·*·Ćš.®Ď2±ľřýěß.Î~Âvbµ=śáxąÉaŁ¸P9lňżÂ.´őeđm8LWďď˘QQü$ŰALłÜ°PţÉ1A–ĹQA2Wř ňŞŮ­7Ęrh^fWű»O7íöćî VĘD!čałăÔ„eďďŻ˙h·żmv—7ÍÚé “0§Ľ4Ť%ÍŤ‘+xSYP Ô+ÔtR›ľĺ†ćĚ·lv;×8î•s|ďéNÁĐŚ«MĐđ}vhj\Ž”Ş_¬gnî¬=×ęEĂ h¶ż5Űj·«ćV Ĺ)")L.x(ÚźüCÝ®·G×íţ>żÚß|%Ă’8<şëÚ}ű¦]ĂíhěěBąy*}ÂŚú–“) ŁYS€˘2'Ö`E©łmłßÖ‡…)Ř\ŰS„Ň·L§° WLŁ]UW·ŹóĂY™KƦĂEƦ…”9Ýhlý“çŁ<ŐLĺLxŔşX[éBę¬rh 9ŘaÖ Ú+hŻ2ö h)Lˇü?<Ô”ŕ&{ôŤ@ÎÜË–—eâA }) ¬ > Î ëżRŔ؇ľ#ž…čéDfĘh!Üä`s…řľ˝‹·ę‘ ř$]€ÚűUnJfż, á=h4l™â10·1 ·kó7°¶úžV¦Ś“ˇ…(Fń/ľ˝suqK.­Ś§­'ˇŠýćˇď@gżf!ÎWmWĂâťDČ7,Ťß%÷~¸Ä¦ůu=¶JÜF4ę.ńĐČ$uV±Ó@ŃŁäÔ0;ÝđFâ—KşâwČĆ;ś[Đ0ď×ĎťőĹ›¨Ń‚óMr×$Ö“ + 5Ŕě8 §¦űmłű2×#6ŇĽô×l0BÇ·ÔŞ]ćY ü‰*ÔJi›pćv^µ °9˛C.yĆ fG÷zŚÍ-Ś0ÄŕQ0JöëúÍśD¨ˇĎć5˙ÇóĎ#µąZŁš -łŹł–Ły®AF˘8x,X,˘QCRř¤j!űé!x5rh˘„ĐţXPlVNäRf˙‰ë, W`)H°d°íŹĐ§ {Â^ł'˛‚ |ęžÎv´%¬áYVÁÄqdqł&s Şô'î‹„}á*QÝďëöŁ“,â\öýľ ĺ[ĂwdóÂhz—l^ąeůťp®vB Đ<űoâ°–óˇůŹ [šB@Á ^ĽĘ<{µ+Ą@HĹń­(rhÜoĹů…žîŰY‹€ÍR˘řSAŁ”Ŕ&d8ß÷Ů»H“#×Öű7(-ôá4Ť€[ŁXV“?w›EN$úc߸·Ń·Ű‰˝¸]‘_¬wű4&ÄťzýF @—˘LŽ;ĺvP-xÉ9’ D†=T˝ŹM(e Ű]şĹC  ¬ü3÷\‚—TŔŻŁĄżm2ÝĆ(I}¶s|ph,@Ü`‹%őűß˙˝ l- /ßôˇ#ĂËđµ—Ž ’/Ţřp´đ‡ĘaWɲÇЬŁ|űE¶í§Mľ›ˇŕPł®}ô© °ZľFď¸FˇVKF°ĺ˘gjEŤäPel BŇăŘ:ĽĐŹ±1×ĘÖ¦d_„O1ôzŕ©ńh0Á8ë;¸÷,Т­AW…Ż…@äܢETo-Đ—ý„ŤKŚý¦ýäšC `Pß|ž…˛ @=0sXŘł„©ąa/n§hŤÔbÎęŔPąd“5?›Ăk6póv><űHK–2OMd_3P…¬Pď8kN.ëľ#Фó~¤ż`KhCáIYJćČŽN­Ćf45ű4Ű˙|®»Űţ•>4 ㊞˛ŚĎ,˝ŇÜLÓ/D] H›ˇ4hŚe˛ľ.DŚ=X,fö¤‰B‹`©Ýޡ…ŤCRŁĹá!Đ€ű賉!†9°{ÝŚĘ8›?P V˘M¶Ű»×­TŃĽâĽoFvÔT‡Ă$˘áAD˙%‡Üv;đ–˙·»ö]HŞę?÷á±P}x<čóB€Hh ±’Ľ?ü‹ ÄÇňüţJ3öG‘®D' čp‘¸·) 8€±Ůg‡ŢÂgsÁŢ* ěqÜňĄ°ňN©ŽB<ţÂŮ=ű<ĆĐriúŞö&{!ÉôHŔrÉĄ·‹’÷)Áą0ŔS >@`âÚ’•Ĺă€#/ĆđjL9N(§Pĺ0Ŕçp'k‡‘ÜČěvD¬ŻÂÄn]Ľ›E–ďÚŘě<Č21¦evő'š—21ďÇż®g%‚6˛%Á—%‘HzÎHÚ‚ćĎ!q <śíIś„9—ŔĺdŽěµ,1cqCÝG`ˇ?l÷ëÖ?Ő €’GÓ2ÉÜl«Č{ŠČh $Eł ‘ţe ˛jđ)ČNŁ™×ÄÍŁűBíD©şŞľ[rŇݲ‰Ľ*Ą¸h(–…0’kŕ=Şö:ťĄE—źRe˛˝gRô3XŮ(¸tt#™"şÁ4âVG¤(H“Ą…°”\Äp™Ĺ[ü2ÉTK™Fż:«\TÇҞĀ…ví‚‹ oä÷ĽfMP—ł=•[»MßęX¬Ď5&· č€HG›‡Ţ˙—±kŻ“,gßćGRĚăó¨ŻAߪÜ$ď۱_"ÍqD쬊« ďEzşGł+{úH}]q ĐÍâŽwžNŢo`ľŕâ0>=Ú¦ÍظĄuďĺ9#·]Jâp) Ö]Eüe!yČćÚŹľčôíbű JÉŕäfčĐčĚÇüšĹÂŚíŢ`*Ą>-ÝŢiŢťPhäg˝ â7"1qv±ŮoCý$‡Éč¤ËGB錍ÎŮ@ę˛ĺ˝6lÄ@MC¸"…“±©ŞE"­ZśKAĘM’¦7–ă#Đ®Ť– ŹUSNŹý@˙Ň +5 Ď>.HýëEunć%Oäŕ—W¦ôŕäP”§Š™©lďćXt‡çmÔĄAgî4ŠI:Gyüűaµ„N{źeťńřĎe’čÚΔ¨DrsíČ~P«ŚóGMř‚’EQµĂÜŮ—óQâEÄ·@ŢÚ3_W€0g|‚Ńř0UÇeɨ°Ąe 5ăKÝÔĺĺč Ĺś˘\9Đ&š5ĺs(˝‚'䬂hŔҧ h¶Ą7gŤĚ{¬Şm†yÉ=,p±°[çű6ŚŁ®cuĚ«Çp{5L8ŤHwö "˛…Ńç KŰ%ä‹pSB i÷;×)ÖWřQ“[¶Üz{绀ßU][é».g˘ńËM™Ű>J@f”J1Ž” łtÖežW‹Dd…†Őbń)}ř9NMőËůň$ŰSň˙Š<…ܢ” \ÝG›}$†R:3é»yI68.  Jˇh‡ľ ;Ůa’h4Ô˘N ř\‚űŰo7®‰áÁS”&~V].“2~Ô;8Š‘î$výÄ|kE­·mŤ=“%6°×ÝaýśßB‚‚Ld4B—ąŃT}“ń×d G2 ý)Á\‚\ž[¦J‚vW5ý™PÉč=ŻVÚ©UDuXo"%‰`B®%Vé©ěĽ uÁÇׂěóŹľm˘oíţ2$aá׍‹žKôŹ4…eŔŠŔżgŐđŢ«ůş—päŮÜXĂm/ŚŇe©˝Ś gcşŇ‹ĎĄ–˝$SţŽŹ <¸ŤජüŞwi†vúe9˙™XíE©žićś“Ę_@@É +źäţ–˝,…Ęr>ś™-§P]ŐfP;´a’Ă›čÂs‡ Í·Hk Ä{ăčâQ‚óß(BŇŮ9…b…Ë€LKí"‘Ó»Ż?K`@™@žËĂ˙ŻĆ+13Ałő:—Lh“zĽgśţah2–ö=‘ítf=‰Bh»ä48Ćç*f™ŐŽH«Ű¬‚™ ú M™ě‘šŔÎ!ÂŇŢ “¤ş6ÎŻvDbqX¦¦ĄŘ¨DśŤ˘÷*CÄš­‘:¶¬3r,źâlĆČ7L›ś%Ü!‰Hg 9é'ě“avy8™Ţ÷5@˙>%˝Î$⼕.˘ďĎ>†Öí7™Éě3šŤRDżSz;7íŇć¬(Ć}nÚ¡_7á‘řpÓ`»Đ?Ü„SżĚ•Ć¦‘y °7^úô€)rU$#,ˇh¨ŢSú ř“ůšŠJ©eśćtsQµ°7)‘QůĽvĺ|­)łÇa%ř`0#˛"ĺBŤn?~/#rŠNKKřŰĘ(|Š–J3ý¬ýŘěŇ•g¨)Ö[L]>—ţâÓ#nËĐÉéÖ—ĺűˇŮ»Jhęa˙á¸&·Ě5ë“g»ýőM“ű mFX%oÇŚÔBCă¦%G1!jš„‹.ŇT˝” č>tţËTâg0†Ó~!ŹźöSGĘšOťYl8jYi§‰?Ú1lÔÂI`PGÜÝ´»ĂBq°ŠŹşj˘y‘aŇ„ž+™¤ąSůúfďÍD% přJź´!&¨mµ7‡™‰ Ö1F4y×4WCÓ¶ÉéB˝`(BŃNעUö‚Ü:ŤĄÓ±vĘ׫hdŔ^ën L’˘Ř)rěP—ì@L˝#Ą[Ś Ň‚ R0eÓDă𔊠äŔŚŞZBP¬â3ž*GQ ,ćM_%LSç ¶ęĘ:N­°N]fT\nb*­' eÖ<ÍąMO…ęDAXŞďϧ5ů?uX·6Ě }Ş«ůC+Á%ô–rßî?ÔÍlTŠÂäfX­Qc"÷C}7¬˝”czS¬TâeÇŤ‘ć„ŤAo-ś@ŹÜĄ•&.°(Ťů6Zsr©juß°đôš9 p}ŔxOřĆOXcéVZÜJŁŃÇ=8ć4†ëIŹ÷aIýŔ&˝{ăw şç˝t˙®ß;Ót&1Ó’–ť˝óèäŁŐ<ü¦ĐJśJŐ„‹Ţ¬7}!Ö¬ öyąÄw3g'en=ů§ţştĚŕśPx_w¶8ŃćBHc’+ßsVĽ}Ó¸cN&q’‚#÷Ć“AB|§b5€…AżĂ+=oIĹ’X„€Ői,jqHřî&XÓZ\Cáť™ Ş»ř4oĽ‹Hęç˛íłâct„ôkö¬#šäÂi¤„Ó*»âŚŁş»3•çŠîâč|Ľ‹VÝŐ]t–uăĹdüÝ4¶đđžű%xS´xŐMQŔ*O V×ßtdô]LŢáÉ°QTGô”§ćHIŔźu{÷™ň©Ý uö1L{íűVĺäŕëΊSr!Xţ\Ǣ6kČ‹¤ćC“Vü5—źý‚âU䡇hm´ˇžM‹Őş 0«šK»·4ťň“ŔőÉÄ‚ćieŠqŞ…+Ák´‘Ánú”r‘sťÖYĹa­ďÄQcAEcî?Ř uľN#˘?¶ţuF~ßôĺą3AÄܱ™ľl1fבkž¤bSY(Ç­ô‹ž‰âg1E`š¨bĎ6¸żDäđžÂě)ŢÓňMźüw·;űŃŔEĎ;z5iűMpfI/p€éˇ˘¤óaĂâ8ţAŐÎźuůnZŮč îpq”‹Ě?©bFŇýbČKtĺŤ+´EŚLăU.%­®Ž‘¸z"—ă˙ ŽůxËA°Yţç-›*Sp<TĚÎ8GIż”r©h%dŕ(==̢6RK ˘\Así;eňKŐnb9AÜtp©Ă:¤ůŮ™JÖ»©Š¨^Aâ^·É gzx+–»0sźJŤ«ô¨NV …dD= SÖ·˛ÉV%!Üć°P+ÂWńÎ öLT cŁ4˙Gt$™ä fęV„ĆŰŤą/‚ ’łý"ýĄ©´ĆU1Đ°:fnűnlä.Gř“G*GP|±H>‚ˇ9ë.ťĺ,nő&,ő>©(®KÉ)ý–űM—DINŁD+Pý{î‹kW”ů€>>(…üéě˙”SĐendstream endobj 515 0 obj << /Filter /FlateDecode /Length 4512 >> stream xśµ[KoÉ‘ö™Ř‹ ř4cŁoS˝p§+ß™#ŘŔXđc´Ś=K`±ĐřP"›tIÝlNuSŹůí>lDdfUfUu“µĐAĹę|Ćăű""ł~ZÔŚ/jü˙żŘžŐ‹ëłźÎ8˝]Ä˙.¶‹?ťźýţÇá óµç‹ó«łĐ…/ŕ­Ő–y©çŰłJ-Ďß@[^ˢq]3ct8ż<{U=ż[Ö¬ÖŇňÚWŰĄ€îNé*»ií»Ą0đ‹Őzą’R˛Zńęe{“5{‹?潪ľŰ-W±š_]fM /ţá¸3®ÚěăHµ«Ţ·‡…żĽ‘<Ď÷ůçů Ú.6d4« Ş~8˛if\íÓ¦ołń› Ú´Â4×a6S+ˇúŮl>’âLpŃŹ´ëÂţ– y4›%Žđçół Ćäâzűs‹÷ ÚżžqĺÓva%H Üž)­,SŞł9űďG׊ #XĄrhŻŞ?Óš`6難öKőV]v]T›ÓU“/˙2éW§×Ú+çŞö޵ÂW‡ĺJyäŐ·y׫¬}ˇň®ř+ďr‘˙€&¦%hUUĎŹ™BŐ¦eő¶űő ő^Ä\r ČDßś±ŻOŠ¸ćĚÔ"řb·ľYeP· #ŤµĐěŕf÷®?ť¶Ő~Ó^¬iÜ0ˇýâüĺŮůľŞ®ÚĂaŤ瞆Řßm·M÷^XA\v»[ąŘÝĽ[w×ë›8°Ů]żlßlw—ë »ęš-Ť›0HsyÉű7»×űa͡ý¶9tíčP{Ť`¦+ÜKęóîb÷nčsw{ŮÖô7µľívWí&¬©úćŰçËŻ¦†jw"şęď‚«–r6Ěă’{ý FYyďxëú˛˝«Y ÉŘ×b•‰Í×dßś{ĺ”Őţ°ľ]?/D0ÇýCWBá°Đ®0-íťg–g¦•Ţ<Ţ{Eí™^hWóGß=_˘{Ő|óuŽČ „Á9Ĺ× Ą@@şúŻÂC>F\/ŢđŠHma O‹2B‚Ü–G_Žm»(Ë‘k5ďDI]l¶Ašĺ&ÁAŢĽÇÍ×4Ż—ÎToŽ»řj’ĂžEÍ[°>kŕŚ[U˙}ÜUŔąu`3B#Ý ü±Ç>öjgP*@çć®@ËáyŽ~˙őĄČ@a¦'áőv».Ŕw?!˝Rš`jÚšäH?V˝]†B/şÇĆBćµ’Śců˝á5ż®uEd [đĘW˘őąŹZ$X˝É&®~\FŹI lHú!ŻŰGIŤ3Ą?«Ô¤1LóSB+ţ¸ Fo¤±P§— Nîž"N…ŔhÝĹ)Eçőőú‹uÁÇ{Şâő稼“ŕĄD˙}ÄÓb´&Ś6Ö@$Š†Zs9 WŞ4ţŠK¦!há$óaéŹ]3H° D.ČŞ†8cÂđ°Ë¸$;ą ź~ÍśĆRFu(HbĂŁ+^ĹGŁÜ0RÖMż8ΡÝÝL×ÜŞrUOąŠ¨ČkX-Jý\äöBsH'tigż-ÂĐ6·ˇŁ)śś„@™˝Ş®ăXҨ$vi ±ß1Ëjż_í®˛W_f˝)QđUiýAĐ!ýÖ Śüi¶A%#9NLŇ\í¦Ë÷’®Â¤/‘‚đdôĺń@ţ ÝĽpđ%Ő>€ď¶I đ|˘”r@JrbV>—’  ç\]Ć…›–áęŁů0WŻÁ‡Ś> ĎŇ°` u°Q٦|Lwśö§»RpÔ°ˇEµÔ50‹Ęç÷ vFžŹ°‹‚űwŰbŘbG K…_cáí°…ĎÚ"…pJ,ĂßďCđ ňŘuoă^ą+şąŇŇyąŢI- ]Śj±«kŹ"zâjkÄ̱0jŞÍ¤LË1×ĐÁ¶Qůüľ2měPŕ‡†ć’žđˉÔ8,±U|›CšQoĺX†¬vGË”?QSíwą}Čî}P‹­2WhY[ńŔ"0A®’«TĄć!ńmýO…OÜ-çmé4›öĐ'-‡Ý»üPRŮM6ĎѤč2ŠOiäu0(éa|ªǬj†2đľ”mI0 ŐťĚ${™GˇńÉNxą2…ĽL¤Ňs$Şá‹Á[¦=–ę/zŮ—×ZŕX+ΑEü6Ŕ¤42 Ę™dË•®ˇ?8ü÷ÝusÓţśřI°¦'xąNÁŠŞn›[tëxJŇÍb´ŕĚ9厄âžjz]!ňmÓNÓˇ˘î°‹K$§8ÄÄjŠëÔĆňR‚±2ˇü¸bÇq+ča˙:r:”üóŃ’ÇeŘRiłŹ;,ýe·ŮDĽW˛z [Y0<:9<­Ü¨Â«Fg€ÎĄ—)!)”–Ąm9ÂţPZŰýż–㝥P2íF ÚšŇä{gĂjCĐ{ ±ßĐ×uČyŹ"poÝśSMR=ůz)žz›‚Żä™ÔĘkÔĆ>ÁżŐĄ|Úć0ÖačĺńśaµißöWRE;­,÷!g$ô4–‘3 XţčąĐ8čĆ× ͆Ú=÷[>*áýE‰xŻ`xɤ.Ścy=™„ŻőçAlT€H±Ş (¬?!˙ö`żŕ2AÝ´Fé%2iúÜ» +Ǹ(´ÚkŢŽ¤—’Á‰IĐ`ş°ÂŮR·±xRó„¸1q8»ť+ČG =° Ź"9n ‡¦Ýô˘RxîŇTěň zŃšd>Q Ę“~R#˙řbTŻ,ŞT`ĚZŐ€]D”Cľ†nd9…"V{丬ÖůŞ4>$¦Är_”79ŃŻ)şPGwh))WŠÂŮ2ŚO¬˝ëzď ś{ő™ž*60Éúđ„«žI%q^píߥ„vrp†C!”MÂb’žŚIŚ~)RÓM¬FĐŃvi’'Κ5„(I‰ëŁ V#üçúP'R*”ßg=ﱸƉĺ¶Í‡vŰ‚Ë\e%ť'şIäŔÍ(:Iä&µŤ˛†xňÇę»—ˇ \Ź şÝ¦ +Őą‘ą ń—„yÔ sÇ"üDĚŁiîÇ<°¤áśű!—D&'™GI€QĚź*Ç”éeąµ,HëuvTÉś—˘´5JXÜoz1M¦'ů¸žÇňeMÓ,¤őšb˘¨NúKÄô ˙€ô«¨BÍÄ+žŞ=ĽĐ!č;MC0 Hµ.©94qvČŃŠĄ4e÷ŹűŮŐhČÓ–-ť|‚áX¦Ąú$®ś™$^S9~|hvżĹ”řÍ-y$YGNŕeÔĽťę»p^Ďs“Ć«LÄQÔ#…»%J¦ńŚźĄäŮ,ĆĂ›3ΔU˛ĆˇĄ˝[jZ6`÷ąiŽSÚŠl„‘$ ŕŇăµÓ˘&{o8$>ĽŠ*PÔ4PV â৊ćďŰ}Zě¸Ř1ˇŹ^ Çh.IÇu0Ůňě¸îqĎuîŃ1řµĐúiÇ`é2â«ę›żg=ľeé´KÇëÎşü\çäů=vĄ†C+Ę©îÍ× ózÚí aŘB¸šIîué'\Z‚·°jćT¸‘.ŕ Şň=ßĺEĂą[ŹŃ&h?Ű“Ęt?Ô×bLŔśNwuEŞ´óęůÝv)1ŕ˝ _`]ë†ú:2ocĄ ˝„ÚŁń­7űPU€U¨9Xőó Ĺ€łx´ Ü®§úÍQ_ßöuΙď!âu•u‡RÜÉ÷Ž%čÖqA:pöElĄ×ĂY݉Bq6Âôt<™OúÓj.jĆŽŔj»]ÁĆHiÚCş5*ň„˛§łe…·0ú©YÁĚŕ±ŮěŕCZ·;=?$ÉË"Đm6›ą“/rhc(%iŇ3^莟´Ś8ˇŹĄĐkË„Ţía!Ę”ę!Îč"ŕłV%Śęń×»ţP.R1ú’ Ęßw3'ćáŹŮZş }Ź>±Ř`ôTźq€zĽŔ$7‰÷‡Â%WĘܨµ§E3‘e:T™Łz=şÄs™”$ňCÍ(FOcBžÓă{H8§°8c°ÖµVďUż ŇĹ%x°dÓłÖ˙Rkâxl @ B±uü´@âĹŰg~EgžíÜ™§aV€é/˛†Ż¦%ţ@öŃ4o,;-ąÔAmM˘@—o÷hž0»Wg™IWů«7sëvLU÷]Ű«8«>qR3;~ •j˙ó"’říëKeDc8•t÷yH$ţSˇ-ÎăËÓL™ţCÁÂÉŰ`“ŤăWmÖúSBÖŚóáS™Ż†ťóűĐăă°Â÷'.UÄ0ó^%At-•ĺĄę¸dčTJŻĎţ€XA}Ĺ—Gä~îűÓźgř5SXů×ř¨‰#ż˝ ŹĎ†/ćCE@9ŰŻetPZÄnS»¤Ď“ĽH{ÝiČntUżž•çxy9}e$ćŐ¬´Š%ÁŠ=ć.<€ÎpÁ[0%!B3 4ü "Iů”ëďŢâ%Ő‡$ŮŞřEÜ7ËôQî\Í«Râ9:yőéaaWř u&ěRV<´”WÚîçMp)©ć/‹ÔĚî‰wIź9°kf”5& ;^î$ŘšwŽßy™€í©ébË‘ ‘čô™Ĺ_Ž8–†Ń’±…[ěS’bB źnŮür~Š[î´Ë„QĐ;o®KOf¶ ”&s/^ ‹#Hp/nĄű˙cďlżšß>xu=Úţ›Y÷†ä©¶ř™qÖň±ĺč9zŚÓ~HMD6-~é/!A`&ŚőÇąőČé)v:üj:P`¶] hă,ŤôǤ!j5§“¶×I!h!Ýő»Ĺ)ěF = »o˘CĂéGĚ›cCęţ—¤U¸~!µĹ,łŮŕ]*Z„íÍĹćîr}Ɇ/Qţqöa(zŢendstream endobj 516 0 obj << /Filter /FlateDecode /Length 5069 >> stream xśí\Ëo#ÉyĎŃ} ä$xs3^¶»ŢU6Ö€˝~­± b[€š9ôJ wHQۤV3>äoĎ÷Ő««Ş«)Q’ c)˛şŞľ÷ď{ô|»čZ˛čđţż—Űłnqsöí±ß.ü.·‹_źźýěϤcđUk:CçďÎÜ3dA™l Ą %TkXśoĎ.š?/©n;ŇŃć~ٵť`Št¦ąM>_/WŚń¶S¤ůCź.úzą˘v"˘ŮáÖ­›_»ŹˇÍď“ŐĂz€­đ M´Ôţ a8<´źűĺíů MRz¨­Vh:ż:kÔňü›łßžźý ×±ĹÍţ ď±xýţĚPÓrIŠ•Ô,¶g‚t]+xüfsö—Y>ćÇ6ÝĘôBQÖîŮřźýHPĽ#m§›Íîf}X®Ś„ł:ŇÜĄlŘ}ťü…«$KűĐ ţżD’-=ńňDëî’\Ţó‚Ëw¦…MÜĺ˘Öé˝R1Ö»ŰĺŠK ÍHKÚţ°ľ\®4×´íx¦+»aŰo–+ˇ8EÂźîłµšÖfTP’&űfÔś7Ͷ˙řfątâ'HnŤę,)xŔ¨Z€…IŁ|ŤJPŇĽ +WDµ˘SvéEó—äNNAcšţÎ]‹…÷RÔŔoŞŮÚnłk«€zŐu@Ťű™S‰&ZóŢŇ͉l#űK´ Ę’=ý`I& ¤lčâü«łóżhľZ§<ţ€»ĐÖÖĽK®?5_÷ýĄŰŢ08ÂËŇšŞ`ŔĺŔ`ŃĄŚS´ĄŠyűúťc-ëŚ2Đ­`Ŕ€L˙ŕrť,”­Đ`Č~/RoĐłXĄ{čÝfZfZ ĚHăv»@]\®2TÓć˘N žHNÂ#oĐN jČuóyTŻüŇ‚uřż wFcIQpĄÄoI/Ž¶ĂFC•"ŮRÁĚx˝ĺ[¸źŕ˛ů^¸\Ćw%Z)Ô3Ů^]ĺ{SĄ„·”}%‰3¶IٲŽł‚m˙Áh;°Ú‰……\H#ň±m©n;gD˙R~"áo«ľÚ ľm[{_ôĺ­u˛“ÍwÎ=R‚łŘaâ/zČ©# ŕá9$…0ˇsKÎ/f-*Ĺ–‘ŔĚÎę”%Z.DÎúĽş®I´ýtŻĎ`ËĄ2tóÓđ1wŚÓ :G.DĄA§Ý~8s ˇ °8NQšďÍzD`“ěŃŤŃŽâĆÚ•TO"#Wg ŇJ©SÔůôChęťęL·\ "źÎN :hĐDýe+eP mxëßdŞžęöc üä ŕŕyKDű»ęE ś‹çúYŘ;iGz|–Š¦« Šhđ´U˛pθ ŢčÎĽL’ŕ%Ź*uDié ŽD‚y#ŹŽŕUŚ<'×ůăÔžŞ¸okqT!ęD*nZ×Po­H&ď› "b‹Y=UTYĘ îÂŐ“”!|)C\ŵj!LVůožźXHf@‚¤–]f`?ÉvJ„OŔś%är)2é«Á ŚZ’a‹üś,c˝\€˙>OÂ&9—d\A’™˛ĆóÖP0e'ç\/IŁ2Ä0“Q%-ŕ4ŁÂÂ&¬ŕ÷žÇ„CÎäy qx ź:fŔ×NeÖQěÔËjđ ŇXHîň8Mź•Çm2&˝K™=/0-C…,Ó˛•RČTÚ|H…1v6Ž+cö†ď˙ł·Ół·WöšÚô­3Aă˙.Égšt›C˘Ř,”žKM`šç4˙÷Ă•?Lđi|u·ŕ|ľOúx·Y˛•ş~„®‰;k«)Hfůx⇷d‰e+v3U`Mě`fvËÔ”¤ őr &ŢU5»íÝf9q˝˝ľ=ôJ cMúën):ËHl'_k]Hv 5'K¨đ5gů/Ş|9Ŕx~^Üt€fS6Ž}Š§ÂĎŽM•Č`_Ë`҉Ú±Z٤S!mrštşXµńBŇ™jS’äNóźäL, [€álö;üË`$ţ5c»ú!< †Đďýę‘ž(yGOY†= ŮßŰ°>·´ "Š×HuűÚź!9ř5Ť ,˙t—rÄnÂYó%z{{=3Ç٬ß2DxóJ4X=XEif°!˘¸d iN2HăĚĘ4Tś,Öۢčđ· Đó¶˙żµpeKwÍ—˙#Čĺä*/'»…äyWtB×ůßöAn„+˘§SŞĂ4őLýîkF),É%tĺN5’6‡]¸ ł’w瓉äíЬż.µĄ±hµÎŠał©}“0F٢$—ř \üŻččŤéř“÷őő—˘˝{•ĘäQŞűHq†O´wĂŽ”U@—¤ě<"ó+­gŕĽî\ÖEc˝'T(l˝‡‘flt„JNŐ}[ńÎŔ±@Éf°6V8Üp¨QČ0v2¸ÖŐUbÍOş Cš‡µ ÄLŮëľf˛ŮM†dőWůףbÜäÔu·­ÉĚŢ?XAŇÂĄ§ě¶.ś®(A`€ř‡a×R=‘bgě5s/±żsĂ<Ž0‹C´¦ÔNć0uŘ°ľuź ăłŰî†őÍ­˘ŤĆZn%)Ł †°ÁUł\Đď ž‚Prž•i÷ţP«ś“ßĹč”ď´ź¸ĽĽ™˘wyŔEë›[I‰B‰‹B/>G®`ţn˝ţ ¦ř‘ń,ú@i\y‰˘x» +¸_Ťá®~aď Tç/0ťŁš*ł˝J á4ČM@R‘U­¨Á¬RfÁ'&—ÇĘD? `ťg >„˛V2,âăĘoŞ•…a}şň¦Ćn ě="2őŮSíő®młţŕ†4ľY§Oě\Č×áSGe¸5a>z54˛G`·{žZ iĐ;D§ĐĄ_Ç)ć‡řĽ—ŽĄrjşäfÖżďÂ1»Đ 1p¤(Y8đqč×›čşŮč×j÷d·ŹcQ$/wď¶ŰŃ «ąbźxy22Ö˙ű!^mŢŹďłÍ0ŠXm`Ä”.ÚÇ3ÖD{őů!X~źĆź¬?űQnęS,†ůiĎzVĘER0/Ě`¬¶×°›­ďÇ; IĎökqżüqjˇ|%÷ĽwÔç[”É<)m‰ˇŃns‡•‰‚H-‰bhcĹ(-ŕôŁęčQDZô†°°ßlv.p€÷{@% S}˛ččřÔ ă÷Ş@{@˝˝ÇŮŞťŕg!ĐâÜgIËŚ¤2;őĂ˝Xˇß›~ÉQŮńٲJWQäßn€’¬€`I–SÄý5Zł÷ŚŕgŻ Âúa@C)’4Ş1n’Âűî-pü}X2­P XMŞ&5­~Ź=:ű‹ŻČŹřĆXÁ_fŤ´ă-ŽŘN¸˛…"×5x¦5R¬_R™îç ŚxkM-XrźÍ«č™c·Ž2ř±,b°‰oôN5 éLźz7´PË}7Ł>jާ@Ťą;ČŐţ~†ě‘Ż `ŰĂpź í˲6ošFvd!_´OÚmŇëě?súŹsß(D«˙"ő\ľ‘=Ö4»1ĹbŚÜ—¸äऊĚĐ=ĺ˛âˇ”ěq«á>°ZY—ǶŢb&<^ÉóżdĺŃ5ú3EBx)N›Ď©ÚÇuíVÜÔ|µęý µH›p ´‚¨e‹Jsžř»¬ăè6(k©Zđ}¦ —ËX×­`+(Ükły¬<­(+űW‰C,ŠV—2Éů"Ö)ŠyŃGÔúP™˘ETĘ=ÖŁ7N#Ą=ťň ZźěrfŢ|ńŐ„Š0x3¬¨ ě]+©6´e -ŻU€ýţöŁ»&x ČT×·űĺř'\o§¸ övř„vyż]2ëYsďBţ)\ţČ°ćEPÝ>ř?+`Đ`č4˙őĆťC€BZ}AĹúŕpç_aý¨łZqSákE0µ_¤"Ó)‘Ý°uŞGÉ$N;¨¬-˙ť,Ś ůÓŞX‡!ŁŠě5eň¸táRÚ¤ýX@wë±]–›óó´Ý NfóĄÝÖ_—śŕ—0@Z¶ uG _y2Ö¬·w…3wŰa4ľăQ„Šř|e2(­ĆÖ`185vîź…Š)au–\ő1iy€~ăaXfý@}¸Ë 2z지Žă(yň/ąî„Kţq—®ż™kŐR¸Ű"]z¤]=V[~g/Ď% ¸ZˇíkĚ[ZĄ¤±¸ů§ąö(ÓT/Ň•§MoćĢ`áő Äm‘6]ú„ŃÜ‹ćË…6ůĂzŻŤ´Dń§ÝŠ@¨§T–ç0ŤsI©«g)h‡cjŮńßź›•87™ńŕ÷Ih&?^w ŰŐɶu'MęĚ/^lÁâd;ŻfăUkÓ Ň`ěćĄýĎ_Ö­a±Y/2= ”[3Ř ĽĂĆ~Rˇ,_6ö 7¨Ýě8(}ěć+7xAÁö#¨x33*6ă ßľť˙ßŐ®hK:¦ ÜŘUF1/¬ě[ĄŘdŚ|h5[Ŕyp<]lĎxv§‡oŽŤ”†Ş1ŕT @}ŞŽ(¸|í)C'f~čäouĹř«eaŐU–14QĽn˛ňçćÇ8ŇÔßđ =Ä«đ(Ş7Ťr‹WQ Ü p–MËłd›ő&ęS#˛ĺÖż|…I?9îÜă©sź”č.’uIűIĎ–Š×>ćL9>ŞČlkˇR˝t#\'LWÓĚ^¸+ &™ m¶}Ěż?…R©®Eúüőä~č˛qYT^.Ö+ZXy5Ę–j “uÝŮsIÁŢ&š‡4ÉvűM?ŚeŮ™z~U…Şľ0…oŤÓ™Q„;Ç‚şž–  ¤R*Ó2şMćÁýoŕĹpĘ>ç@]ŕ˘čÉ˝›ÍĆňĂnf¶Xµ2ÎZÝă­@Źy| \Ĺ· IŐ«ëŕ~UęlËĹŃYp?ČĽ¤1ĆXěőó9ß^ŠĐćÇ××_o e®±¸É 2š™°oK4ďîo/­ĺÔ€˛‘ $ô’?«B‹ĺ ŕ8Ă»¬ 5Ĺ6Śü=° y´ĄF«‘­m|K­„6eO IGćϢA!WÓő>ű‡t¸+EeN5ďg+śÍŚ{R4˝08ߌďĎăBŰÝŞ1o¶VVű‘XĄe<°.óŠČ Ě7'ăJČ!©BL!¬9’Ńî†:NP0$ÎGżŻţŹ“šűékRͱĐn/Ęů$c®Ďšv`"&đyŽ'\Ĺq·BöîOČj‰őwÁŁ8_Ô‚îćĚĺ1ĺĆQ%``w­Żx1‰x\׼|u®ź”%BΞücŢ ‡XeSÜ5łlH-´ęŰTúëbf§w@G(ÚÚ0$ýT•IÄl(›ŕ;$ ęP xT˝?vÖ1hęa¸ż<Ün¬R!%a\óĘĹśf8ĽâÜĺőţý.Ť Wűz÷«®·9M3Âę™ÉŔ\.§qřčur9|w·’ËMlş o\d˝ě9jJ~ř,ë! vËI1ȴߏł[’ťPŹű¬î˝ĐT(‚ÇdfI;ý›˘aŢ{>í¤đ_?í„löEiç4âj;ć’,ôŇ´Ż2dś‡łN@"2%÷UqxW±wű#Ţ®ö]í[łn[6Jď3¶ŇÝdÓdVÍ=†ťť˙|¬žZ[FĎ»‘°'NĎÝú›óéôŻ˝!¬)469!oÇD˘ eíó,ăf7|šI4ľĂBSUľşĄšłq(¬JÖtÜ`¬*ň±Báü,b…3{XUňŹ<*BQł.ݱ@ČÇPçÎz_Bb»˛|8ŻHCČ €Ă‘ăŽ,śWщÝînWwΕHĆwwî#'×ô´ť,sBŮĹ«\͸xb'űĆŰ'éŔ?wĚBŁb@ˇ-ľ˙_6`2SřÂ"QÝ[§ÉítÔ¤OŠ#ÍÜ4č‹1čt6ůŹ8*i70˛!`{é ÂÉó=ŘŔ;etŘ~‰}¦ąK(TÉSQ}멬Ç6ŻZ¤ČţßJcÇ"@ĄNŇ ;•ăĆ?…ő}Ú&ĎŔĐş˘Ęn™íňş·WΗÚbŰw{ĘçĚ\űŰňÚÍľpâf,Ýý qŻđ>MF‡c¦0•±Q|˙H–š˙#;ȧ X¨p¬“¶PqŇĂ#ĺg– éFţÓŮ˙‘tendstream endobj 517 0 obj << /Filter /FlateDecode /Length 5084 >> stream xśĄ\IsăČ•ľëd_ćâö„nNiä†%ćTîp„íđ¦G·¶pi)¸Á‚š`•Zóëç-™@ľD‚˘˘C‘D®/ßň˝%ńómyP·%ţů˙źŽ7ĺíÓÍĎ7Š~˝ő˙>o˙xwó‡Tiŕ§C[¶ęöîń†ű¨[mŞŇú¶vőˇ5îöîxócńĂN7‡R•şřş+Ą3µ*ŰâKôůa·7ĆĘZîâF˙Üíu#)WŚŘĆÚ¦)ţČKĄ‹ď?G­Oýt†ˇđ‡F5Uăçp­…NÓÖ“Üý6Ô¨x?şq‡¦n`Ow÷7…U»»Ýě­U·{Ş ţ±¸űL;łÎůťŮF·m1ÁňjSś?Gż=Đođµ*†ńi?ňľšÚ÷ŃîWŁŔ&Ťh"vń‰ż´~(Nń·n SÖ0eżS0RUŘ84j+m4 źŚŃş.şÓđę›—¶xŚi:ń>´­*`Ťß|«Ełńä[56l|9Zř˝tŞř.v:‡a›â d,^v°ŽŃ·V’.˝<ĽeoUhŕźČóO=˙P骂ń§0ľÖ˘łSUíĽ<°ŹŞxćCr°%1ęi‡,ŁĚÁŮVßŢýíćî?G—].2,đ·8˛yąü–űşkđĚm]v̵»Uö`lĄIĐŞćĐ8 |V·Ěî°Ű»RĹ÷ă—OĂ׉VŁ€~¶čÇ/Ń×·ďçQµ9X­Ú™˝ă=yůk-f9š©kq ozvô2­ę"ć‡n ż7Ű|=IĆî˝Đ­‘sÜű5Y·f:śĂµ’=†nš·QŚŹˇ·’­bt$.Áąâ_‡îÜŰᶛz™ÍZ´X­ýä”Mq™L (€Ím3mÖ˛ĹkŢÚeOŰ ŻÓr\ő˛Qc ą’ÝćŮă6Ýą›ůÝn÷óY]ĐÜăÖJ>Őyř{YźŁŘő1QĚA,Ď@äńK›·Aźť-¦ř4>ŃIĘŁq Ű2ÁQĹ^PźHojß)|_˝˘ňÜĂ O#L…ŞUmĽ©ř-E*_-CU¶ÜäG)>Ľx‹ÜŇ=y]UZmý\ áŃ@¶<8]×a Ë‡™“tŕ‚Ş¬LÔ†ŐhSëâ/gZĄ#Y'Z€nžbZŚ´ŘV›âe&—+’ŢÖż ýaç ŃŤŽ)‘Đ+@¤2„0 wBŇĆ}ěM© `Žý¬vqýSlvźĹg’6˘=žÎ¸‡rŘ.rhÝľŔö(;@–6ńdý°Iú'ž e{?*X^PCRßM9!0 îÎ~0 ń?ĆáűżýwŘ€ —)ĚŰYyz㦝# ,&ů]%đ0« „ é…BQÁiüq©J×éÜwC «ĎNŁ'żčäG)–j†NćžŘv´†Aüyú°X[<Ż¦óék¤„ą8Çşá´˛MđGj*ŮjŠŤe@[j’ßo±Ď/}Ě5HÓ´ŔÍMĆ<´eŞíżF,·§šĐtňű‚.ÂĚűUŰBJk{—…‰ɄYy&Ç˝¦9ĂÎm%[Ź“8Łc˙1F†X…‘‡k[WL›YĐVDěGęq®ź G!}‘ÖŠ׶2ň‹`T™¦%R„ő¨Íňb´ÖŘAU I$DRHLË63•lóKw|N¸)Ň4€ÄWóŮ~cč˘h74Ź]/„ÇI”ŻÄ™âÉŁśv« Ë~âMd‚ÝNôaŘĺ ¦dvCŕ|!‡{˛`—˛^a?–<’)YŰȶF,",ČôOĂ1gŇ÷ˇŐ~ÖLhE€GErŰŁS—ŻĐXâŔ÷«ęP[={w ®˛čM€›ú§xCýwk…á= ϢµF“bŤ&ýű¦ Ć® Á`¬×Đť™?®’x+çb~ŐpşłöÎi¶X˙ťRţ ŮÉ=öţ¶sż®Š®şTď2™$Óäp•něˇrÍŻŔUÍÁh«Ăý˛TäkŔa6Ĺ„ë##«.ËOâ‹…ë@hU1ŻNŁŇ2•¦ŹÂŽüű¶N™Wk‹źżnqŃÄŚNc3'΢[¶.ÍɱëSOˇâ(^´ĚóóJ'Ť`aŚ$śńct^±vŽuĘiŽyV©{%Ł'vüP:ŢPý·_cëš–_W´ü—ś~XgHÝ[‡~9K¦vť´·m1ű¦î dž—“>až˝¬V!Ž;bŕĘÖÚŁ\ËĘť‘Đ˝ŚSʤEqšü\ŢťDę+O‚€ Ŕ+4d‚>. ‰±Âs ‚gż&0?ŇM]Eł‘&•E¶Ć•[0:‰X ď…´ŘÄ™Ý~>Lf[ł‰Ę'™QzÜJ-¤Qk((Ć s)™K̢éĚq™h=O®Î-â@) ÖF{CóúÍ;†×Äŕdşq*Ćô-UH·EÄý¨™ŤĚćT{]Ć^ĄđwŔ» ­Ž#’óT.u’¦].Ü>ĆŽâ>K@Ę82&Ă7Ó>H+Çč ĘŔ10 mŕ2ü™T>*S<•¦ŇcbmŨ5ű/ŽÓÝVĆ«÷’A%Tš™ű4Fśéx\‡Âqmů,ź—̵ĚxĘ®Îgt™ZśdC¬$ţ2eĆčNkČ•#±v4‡8Ă,‰ýÉ“Ż7¸®(H"cŇG\ĺµ%ű‚…‘+ź« &dşuSs¶•·’ÄMÂ|ľ.MdćDZyň“`Şb+3ůIT…ĺoó˛<Á'eâbŽÂhđI—ÉŐâ(ăy›MXaN–gOą…˘ÎIÝžŚcćŐ’‡Wľş&“çR68|Ú!ä`őŰŽf\Z„‚¦¦¸÷‰k¶1Ę)¬­ŞV©~Î5ŰbžB»•›kŘ2rJ ´{eŢ*LI’ĘjýkŠEęĆŕË»ĘV|ŕfŻ,żjo÷sÇ ¨8ÄŮĹ™S€Řă\ČČ*©śEAŃóap’PQdĂkü4g:Č´jÜ[nŽ4MR ±•Ű Íď¤uąeIq€|ů®"WwPSÓź„ö“?˘™:ŘgEuIJűşfS 6S…ܧŘz?É<*BMEžť0–› »Ž" čËPĘ4Á€˛KŠűBé¦˙š©…ł§\ßBđ‡Koę$¤ążŹă»»ŕ5˝„Ĺ‚réâö2üqűg?¨…>t6IŠ©Ź);7ŹÖö›G÷T% čđŰĐęúÜSUqŐőŐ˘Ôö|NU µ2íĘčónjp;…Öú*EĺućŹ))ë“Ő¤ŤĄ°-eŚĂČiŮ6¶ á—±ťi:vłÜÍ)ÝZ‰SÎ~\tÉâXűŚPÚbQ™s×RĚD6…N’KĄü(.‰ů“ŔJĐ?őóÔ ś¤ę$Ŕ duČźß•ßZÜ= ¬ jşśßâťkC9ţ|ss!53{ń¬š,aŐŤĘ™Ĺőľo]­°ž„tÔŞBw=|Áít‹ĂűV!=ďţw+#ł&őÖ »Ë­ĄŇőČ}ňń¬'덟Á_ľ $¨‰yO¨Ţ/|mp¤U¶^Ulɸ¨4XÁËé*J¶MJGNfS;,(jŃUü¸öŽ#nÁ˘ł.±ÂO^X0zĄUAˇÇš©B×H{K8Ť\ÎĘÉłnŞśŔ¬•“h§%7m†z]INĚ–\ßo;ť»8Ŕ7L‹±hŹjťËeşeňdĐ!q`DÚú)ĐĐČ*Ša$ÇĚš’Hz^©…Éâ"Ď%›™3"®Ą¤űČM“ ŠP‡eߎşľŰr]ß—ŐG‰üĄ®…PşĂJ¤°XS-a•Ľłu¬˝/b[¤©tÎř@ĚňQDű5]ůRŞů÷^˛đéaB?=oh‹îíŇ;_‚ĚwZ×üůËZs4«lÖ•a„€†(׫fđ#ëSĚÄĚ«'*cž“g\ĹfúŚ)łÍŚpđěcňęĺş%Zó8®řŤtťń•Ŕ˙·8BłDŻ© ˘Ą+ŔřCřFuT…cµęJ]´ülĘB–VŢ슋¸lSŁB˛ś ÉëŠúÍôŚßÄúzNŽ$rż/f™Ě™łŻÖ±ăSÇIÝ5†`~âV¤ňVéÝŤîmĐ`č óŚ}. |“,éÓę`ę ÍŢ%2Đsďşbh‚±éQřť4™kWD\5®ĺ &ćg˙ľC¨n( )Îîç÷‘ăí4%4Dxhé1 ®†¤`ëŮŹ ‹ xË iŐדbŕ&¸Čź„Ű°TËńŁ€TeӵݦD·}Š‰€×(ix•á đTh^‘7Y­Şď˘±0>Gř9,ʬ©®}"˝ĽU_&śú91Ëqpę‚ń×1̧ĺ.<|¨]Jmż!°_°Ť§0Đ<ű­_éR?^c±†ţ|Â2ë÷†•h”6ÍKdőm‡>=‘n@ÉA|ĚÉ[ľßp—:±aăý´Fć1ŘŽęgă$ś×Qţ®1E*€1DFç`.=Öęäl8ž<ĂIü¨áH<Ž›ż«D#«ëî*EyZżĐkî*ĹÄ2> 0îŁĐĎiÓzi‹H‚h4žţcňýÉżš±Ň/[őhňžsś‚IĎšfÇ4Ýŕ«cËhŘ\$ŢŞf§¸,~4*˝oŽ¤jĚĆUŚ†‹+äÍ*TcůŁđ‰$ťJ5ŕ·~ÓýŮĽ'Ʋ|}Žf©Tš˝BPęŚöűçh ć Ë(Ď 'QŻáŤ@…j}··áz×ô~ý\í&ä†OóžŇrň ţŐ¬ŞăZR»otĂőľógăo}#F]EҸ íi~řŕ‡nIĐÖŮ0ľ'=§)<©s5­~!ףÍ©[5Ço.Ż đęă“źNć×ńEě•Űu’' sĆzD…Lť ţîWł…“Lb #·9nEŕČ–t4˙»Šý”xĂĐOµ+ŇD,Ő‚×ÚĄiX\iIČ÷B®fH ů›ŻÔzăř»«ćJ†Ä“ç"…ëă|Oměć;nÍî“@%ąĚMPtę™1R@~sQíá˘.ĆÓ@%Cš_CˇIÔäEŹ)őe7©…˝1í+‚kK&9qÚTŮvÝ3»!Ä]«qĘÓ÷^”ěµeł^A ”V3­c%ćwZlŻ®ÔĘ^ů- üąß4(â®ăĄ+ŕA˝ř­ů†µÝ ‡iJ}‚:o•khľQ/ÔE\Łźá`ěBŐ‚B>ÖŻtxŽÔ†¸»8Šo}ňŇ’Ť÷”X}ĐókJgżMđ•ĺ’Ωć,ĆýĂąë‡7ßQâG¤W”ĚJ0iďvě”˙%HoŔvTřĄ*~Čň¶=ż& ůS_őäj[άśzšCH±pžĂĺŚ ¦ąK»âkúF wPş˝ôF ;™ů=öŕÚŻQyŰ9Ď’}E{pż®¶@ľâçŹpröČĐiŤC/pá Fü.#ĺ(‰Ç§dtˇKŤ»>·g‰Ň¶‡¦ŻÎ¸Š(ýY^•%Mţtwó?đ÷˙ő ăŚendstream endobj 518 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5549 >> stream xśťX XW¶®¶ˇ«DÜ(h‰Őŕľ‹ŃÄ-Ć7Ś(**. .l ĘŞĐ`łtźn}G6‘ĄQi\Ä%f˘I4qy“¨YŚ3uŁ§đ2oŢ-ŔÄIňfŢ.|4Uuď9ç?˙˙ź’1VÝ™LÖŰ}Éň źŕńŻŹ™¸Yúč5 ë_d·yX­l­Žľć4ĎŁűb÷Ţ—ú0Ň×äYÁłCćěę¶kÁî…á>‘ľîQ›–Do~gËŇ­~Ű–ű{® zmô±®ă_ź0ńŤ7'Mž2ŐI`ĚRfăÁ f–1COfł‚YÉŚ`V1#/f53›YĂĚaĆ0k™ąĚXĆ›™ÇŚcÜWf>3žYŔ,d&0‹‰ĚŚ;ł„y‡ bz2˝ŢL_ĆŽá™~Ś’±gGFĹôgśd6˛Ě$cĹ$0Oe[d-Ýćw»(!O“?´Ęµú‹őëSÖĎ^Šgl4םÓq-ÝçvŻ±™i“ŐŁGŹC¶.¶űměůNŻń˝*z/ě]ÖgEźňľ+űî·›l÷>oĹ«ř·řü·ýĽ”Vʵöö‡8”9qôQŮŞţŠć^˙/Ó3`AW‹¸!BÖÖloÍ’ě¶^şbýţ0P…‚>IEŚíĎu1 I MI†ÝŔEiM@5TÁ (×sv7lśÔ,0™ŇZĐŢK—‰«őŤ˘ÎÔ P?BĄž#c’’ěU`wDŃŘ(o‹ÇHeQ˘qO|ÜŰ®ľÚ˝°5DH<`0F)»Ô„e#AWa‚ÂÂÁ’“ŰÎA1¨Îcß\TŃ’Ę;:†µ g„ÝŹ(óiÄž´ś­˘ öQ¶řx± ‚—Â'ĺĆÁ2=}XĂpďáĂS¸í”îZ…ËÝ]×o6]¸IÓ*)•ŇzŇ‚Ĺ]i˝ŤŽň¶»ö±ő™… Ö;]Îlâ4ĎH1ąŤĹż˙\b¶ÚôęézŐ´ž.xo““żýśvD˘y‡Mó+´¶B˘5v‰Ž©E+–7·_±˛šť±áťé3“+Ď Ľ#>důęW˙Ďű$řyĹM¸cŚS˝ÄI`[i0h ˘˝…X‰­heaýôĂŔ‡®aŕGŹŚVí­ÄJĂÖ›ž@#]O ^˘ŔnËZÂpq¤E&~,QJwéÁŢ09jŘŞ˛$PÎŹW“î$›(ń°őy‹b—~ě€`X;éc/ł8·Ý.+Ň”TŞBČ4eŔ)řwÇŚ‚´ĚËĐEKť´Uwl¬ŹĄyô…ŘŽc±YďŇß@źŻHň‹ Ö-Š0˝Ýc0=Ä%6ußţŘ´„ÔÄě0HJŽsśA–K¤«véçÓ«Ŕ‚č“.±8¦˝oFTš® T9§™ža±ă3Rµ[úSU©éĹ”ć_8fĄfĽ/ť®ŰŔŻi'ě¨íŞiu|ĄÚśĘ”Ą °Wp7B!”sČ>ý!qń$6I“|ꢪjŞKJtĹŃ9‚9«J€»zbËő&–ĽN&l$rWä"®ýůÝƦj~őVĐüMhV”fB™šxawĺIQk}ͧţ‚LíŁýBg (&_ĐÜ°·ĚcÉtÔ ‡ŞśĽ¬Ě/AeaÇéA!&•†-)Ą5IJĐëŐG ÇžÖŤ/Ó+éść3]Ér*#Ăâöęt“Ţó˝©šüž>)2|€)#Sý­QNś¬}4Š Ó'”—j …^Ó‰W‘kŢnĆ•Í”ß0GâoçNţ0ć;2@ŕďxŔşHßĎ°ŻRřß٢’˘’ÂÍ«ÎkŹSÖž}…C(k•°–‡m ô^óaë™˝eśDßĎ9[Üč„}€đ %ţ®xÄtˇy°Ô–\eëÜbhbçL­˛(§~+íDU—żĎvf‘¬3‹Yde(“wÁŮ_źüÎpbSR )ś÷“~X#Á9Śf/„ÂŮŁÎWX\Ň>$)nopRś*|C€Űéůi™W@ŐKLˇLĺP/k Ú>mäâ6Zî\-ÄÇ qI‚.rÇ‚qTx\GźĽdDtȸ¤O^oP§¤ÄîPÎçpteiCŢ黄M_IÜćQégÉk?ŚĂa8ľą «Q_&iŘiń)ÝçEv}6 !śčÚŹ8ťx$â8ś ¶?ÍÔ' Řm0ěLŽŇG˘€ŰĄQ”›>ďÜ/:w»ô–śf0B'ž7˛XŮţ|ż6=ľTEž˝?kÚş9Ą¤+ŞLOá0]OˇŠÂFLz±ő5⹸×ŇşísŮíIě€sU`Ť¨Čʤ«Jâ!R ˙­Đ’™ÖŤŠôĘšPÜw RŰÎ&héţ:UDÄŠ.ęm(%ö”Ňš.5č"ń›_ČSdyË+ $ŘÝ%«Ýhšť@śÉ Ço˘ęüéó1µËĎ|nĹW˝ăł:Öωôä?¦†Ş¬A]{áRz9ś€¦(óFîĄHtÂđ´xšęC›Ó.ýtŠ•x vQ¬”łU4˘Š”ędŁvsío˛íĹ°ř1‚&|çp3+îk˙>'ÎhČU¤—«Ĺ;,”ŤÓŠMŚĹŚ%[Jő=«ńmłťd"‡>€üźĹÝk{ 1Ć›(ě\´0Ü›&ať.¨ńś‚˙ą<*kt·ÖźVű4zć-“Đ›CqţÉGᨓϊÔăPĄ$ Ó ă±Ňú’ş#e*bY´×HYq˙ž‰khëSßa-ˇ‹Ľ­żWâ6"ŕPJÂČ2Śř?t&.¸.gtA?¸ä+a¸vň·P˙šéÔzş×nąč}#éŻÔčý)ő«W›>˝^y‰Ú˘4ŐŽ.Ë]Ă$“âŐĹŠf–ˇőÓűČÉĹ©âß•'üçşů Cfin’`­^ ÂBzüÄ>ý¸Đśc2čÓ…=ń ŃÎmŞ‹:XV_Đ$Y¦ĂÇ4`KßđxZŠi•ŻDfô×dŠĐ>ş“_żUú|›Ĺißý“š¸Ř/„Idś@ÔŘ‚jŽ)ó»Ś>Y_‡Ż?¸U‡Ńu!‡íjď.†łźĄßuŕ9Fl++˘ę|4ľáQáoÇTřnÎZíD„oĎ ĚömôWGGFmŁB©)ßZĂńŹ´a‰Kv-ďďńŃtÇ©_ť»őí˛ęĐ\Á»b1L€PŘIFMF\ŁLcANŢ™ť @˘ŕóţ´9¸>.[]]X‘VdJI˘3[,žyđ`~I©@¶ŚT®·‰źÉL„k§NÁµ{÷Ŕm˝šú…ŢĘmŰ–Gź«%Ž~®\†5*7>ŤőRwŽk…–«]Íů«µůáź&¶ˇkçI†ř‘âźú´ýý?śŘţÍĽ6ß™‰3‡[đ¨ë; >OGG—*tqŕKÚţë˛h_jl¤Ak’Ö†‡ŔbĐ}˛ďAb‹î&aĚčToľç¸'ż"K„vkÍ3ż­ËČ=í(ďĎ]ĺ=Š=ŘăPW¶łĆź¸ čňmöçřćmgďĘś~Ěý._Męıʆ‰dš@şc=öPŕ¤Ô)’cťÜ5hšżÁÁvT ÷ÔŻÄ:{ËqË_$oKy¸ôĘ`pŤÎÎ‡ŕŠ„^ŢqŤřłň„í߀í›}6ś¨3hľét7Ă‚^ÇŃí¸ěĂďĐă»Ćďäâ%\§„ż.ůŽČ*É€ZÇáe)×!źk6_jm˝·Ž8” ©á`(é2íčŃáÚu)†řAł6´tͱ‘”«ÍOd ę×ĺďUźő:”řtדݹú˛đĽŘęXÍiÂß"Vş‡î ĹńŇą{t:wŁ1+[ČÉÉĘ«¬|ýÝXi^sýřŮ3š yŻ­‘~KűësjµGIš)ş+#čüň÷aŠO5 e™_ă`ŕî´KFid ˝µ…Śż˝ÍŇdNĘ"ݸ—>É·űXpˇ˝%Ř=Ą™ÍŻS9Đ÷¦&§jóÉ4 tD»słs˛®Ij§>¶ÂNđě`n6·"e_rb2uQdj-jXŢđ[pň3Mĺ´,N|i\ëh¶0· Ż¬{WG~fĆ>HţĽ6>‚zĹŽ;*>–îĐ6C>4JíÄU©C¬éYŹâ1Úmj–Ž‡żë†Ď( Şŕł.°×tŔ¨ĘĽý•W";ř«/†t6ŮÍg‰ŐĐuób„Żç,†Qŕµ$Ü›ëxGŇôxGrewÎ^>Z¶{úô\gSţ‹ :iŕ…EsöڱܖFbÜL-“4ÚMKb’5ďžL?a©ĺ´É>žS5B`|lěäř>[«Â üUóˇň†óŢJd´?é©ú+µż’zž8Ź­L7lS“[żOš”o2+Wá`ŮWč*G]…ňJĐ…wlßěWéwşş¸ -M0„$Mž2O—HGť$.!7>=ďńWŘ_č%öŔądąŘ"ÇŹp®ňiÇvŐ°ăyĺy]yb{íćÍŰ}}ÍÇŽ™k;†uĘöqfń±YÖDyŻôZ'Ż+&-‰˘9 HjQkÄ=Źb›«˘Ýł7(("bG|bÂň"JC+c ăŕS¸’y6˙ńőŚ2¨÷äOĘZ Sá®s#Š§TË•ÝÇZ.FĐoµ Őzf-&réŤ\¤¦DqZŇŹçqíeD­aq•Éşën´Á+¨j¶Č.  =°ź\4auk)á:Ź=ńűtÓaµă”]{ üË«ÍđP…6ÎźGb=rńčU–=ĺµőĄ§KÓ„ă§ZŇJ{Đ4sÎôUs|5jD"⨫‰RE‹“Ů®Ô?†Úů ű5ÖŰQ•%Ý°Ű~t9†Ýčo”Ľ‰VĚÁůJx7ô2®ęŰŞ?}_p·ć\&jb5Ĺcęšc1«Ź”ś*Ź?Ľ.Chę—‡Gb>‡6‡¤âń„GzTTnBŢA ç«Dç‘7IŹĹđć&ˇŠĄ¦îĂCçĘ›Ź}DíH}JEč–äŘÁůUíŞ;h.jú`Óź’ľdút’żHŇ@ŢGÇGźŁłšđFĺp6hqčąĚdaŻnC‡˝[Î^z Ó†uµZV¸xmęh‰<Ą)«±ÍQIü: #öÇ™BÓô9úlÎG±ťUţ§E9Yé_ŇIžĂ… :PąÄĆzx.a<¬ĺ4Cfe~^F†WąĐ8&­.ß‘8ß1+›:|3÷2 âýzŮéŰřÁm9ŤÚ] ({ăôęCďĽp>ç~×DdD5wĆČ•UKonőšH7đ˘óŰOŞ}ĂďÝFjXńs%řFi–o'Î_8Fä„”ÓÇß~n*˙ú̆…BY»­rÚ´Đ9Ă=[ľ¸qňÔ™*…·Ě‘–0X­zy† ´9oĆ˙î¨nĂ~´]e¸«ü0ŹÄaÄ4jĹŐg˘mă{źŐ Áě< îÄ5Đ/ł0\¨N/-…:®~GyŔÎíŃçť_ý}ÔŘ/1G ý)çź4îąß"i±ú#’Ü?óWCߡ’Ąoóď˛ô+’Ö ›/hĘ?6d¨éńŻT`óhüIó1Ą6)"‚ *=&_+ ŘţT›ź Ωؗ’)ü˘˝/,›Ţ˝˝ţ"kĘVˇ}ˇzEÚ–j˙Wmăµ]â¦}©nÓÜcWŞ}š–ť‰5ůo¤nó˙WŰýÚś”A {Âixᙑ%ZnśÝý[‡oŐ飪„^qą˘Gn<ť«°Ř ¬‡`cµ"Ķ{uŞ15Őh2ffäܲµe˙—Á~7endstream endobj 519 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2930 >> stream xśť–yT÷Ç'2âB¦Aß ZZ—˘EZ¬ŰS‹*ÚŞŠ*‹€!€ĂBŕƲo˛„%€AP@@@­{«}˘¸Őj‹µÚjëúű󝾉ʳóÎy3ůgň›ążű˝Ëçţ„±!¬Ü–Ż Ů,›>y•˙ÖHéćí†?GVżxđ"Ů,„`aĽĚ°ůbdo58â¤%a¸FË·GČ#7ÇřúůIC>pśęôŃÇÎÓ¦{˙}ÂD‚řŚXE¬&܉5„áBx …Ä"b)±śXAXV„ ‰w 1’°&lx‚!L 3b ďaL¤ Ś‘FöF Ł~ˇŻđwă-Ć?›¬3é‹zI+RM^§|LŤLךŃf­ć+ÍŁĚű,l,˘‘~řF+– çýNť}?ümMwq'FęÉe Đ΢Hň;˙ľqĽçG$0™?‹čř˝D“`ň|NŞ'‹KHďXĆ“‡ÔmP up)©ˇO—t×Óë]§NorcpĚ_ľË{ŕř%=ôč7¦A€®żňAČő`ÉC\_(đqpď†}n`­°Ń$,ÁVŹÇŁ;Zę«XĽŕ/Mă‰hP Ř°Â#6¨Yn@˘K7®ÝčśéÎ˙CPfőZ}p› ű‘pĐĄßš¶ăŢá†K·é|–úx®Žb2źŠč~<î/dP…*8»á/;štÉČßϢ $\n@ÄĎ»)šÚ•ž”"·•VĹ•WU”Ô1ü–U¶D’Ž_-hěC©}BŽF tĘľÁć•)»WçĄ4{c´Pő•ď#cÍŚĐÝŚ*%[™ T d—±÷ČČ‹OS‚BÁdd&'+@ »˛ů˛|o °ťtî†őM2µ’m Ѧťp8ůJ,¦ü½>|_vµ7žI/ĚÔ$Ą€”,¶$Tř…JU¶‡Ńhň 5šö-‡3j€Bt[˙W†íůHjŕ†é‘[´ HN@5ý=CV’cŇ5ä"i€ż+Ü.aMÔóAw#é@©(Óq‹Ă%JŇýwpŤ›Ţ‰é`hŁŻ[N^f_—]ҡ«m(­Mđ¦ě„ŻŠnqJv‹ž’Řám¸]HçµnóśÓu3č曕P:±x9¦ Źďíż«aT3EĽaz^y3ň­Ő߭щ÷}‹dýĽĂ>\ţÉQ©;ą%Vů ň#8t;N˙tŰ’Š]YymUli¤†iŞî>ÜÇŽůÍ`ĄäJĄ«rˇě#˙ť+!˘ť żĐßŢÚRÉĐźúkjüŰFçÝĘú‘Ĺ®G$tí¤áľk};ż:}9j7Ĺ˝IÇ©u-zAĹmTv[Č5răřĘTfŔfH©©`˛.ŁHrŘ•™š–`‡ÓFa §ó…•eSŐ Şdô¤·rDBl€m†z (ŁÔ9áßGyŹ Y¸¨íŠ`łwkóˇŽŇEGFËăĄ>‡ú;źçe1ČŤs®>Ţ”§WŮđY˝2‹Ď*jľSÖ nDN÷¬iŽ[Ž,$ń LMËLR2©QˇłÇµÜ©M@ö—úús{!¦‘ MN—CV­cčÖšŠ=ő§×OĆěd,Äć~2‰ŃŘFdV0”f]ŚžłÔ!C“ń›mîWó=¶„;2”mîI·á‰oó˝• lŢXľ–/f+,4ôú_ßCâ]şF=Ë×˝´Ł—/´ŰĹÝ›.ŞáĺT ĎajÂę¨q‹â‚!•D=M<÷ .Ŕ7ůG+]Í«†}pagąc;Ěăůüzs>{őgŁ(áš[=RH:( šX®‡¬ÍP…1[|="€oţZ>}_ÖR/óČe‚,jU߆vţţZ•CĆľEż>} ÷>]~ßç)yßš®ĺÂŃb‰T¤ŚNYź°cWĘ\~؉sy°Ů«‘˝ŇD/'ç(ó›Ř›ä<˝g‹P6gb2¤űéÉ·I}§IníŤ?×Ü­ż[vךîąĹ'aŁQź<Ćfë7*‚ü´†,LoI:ČŹ]«ŠóSŐiüdHKfýb˝ÖđµäY,-HŇF=‰1,î c ˇ$Gť•Ła Š›ŹÜ‚cPë•»Łtën/đ€Ě5ˇ>;B|Ą°–µĘĎQto˘:3ŔVWą§ˇIVł-iÓÔ«Ždi;;dőěd9ÔőPţĐݸŰR#n»7ů$żçĘŹ‡nCÂ|$ČzÂ],śżÉËSÎŔÍěţý§ę»Ź´žá‰ŇˇÔzg¤A"˘ÝYµ§.żů¤w×TĚňô…Ą¸ ‰]ač-‰ťĐSŘ~¨ĺŔľđ=5Y%uŕ˝5Ü+0Ƈ‡ÁM±:y{Ćyh¦ö]şŇ]XĆTđh^G 9řÂŚwíxX7jě;ľľŰš6â}›-3AĄ;K2UÎ}˝îXíů÷'őMëě29 0¨ZĆ”FeeśöŁčjléć˛Ú!ˇ o>cfˇß$°ŇŰós¶ş<Šľ"+Ť¨k´=sˇĺWĎz,d´/Ĺ’937Ě`h{§ą§ľ˝|ěÄ…˝,=˝$ąg|fóÚ9N…đ8šĆŐH°š†đ´Â8ÄňO&Ż©…†u ™‚/ÖĹI´ËüÓTÁ3ŞŠŮV˘âržI8ĐXmXłĹFókU†5SQqŐ+^g8&ę÷ŘhÁăsBô 'K +S_˙†$Ah µ"s4úHGQˇJJ“žť¤Xż.9…Á¶Ř.»¶,ż‡]Ѩś(řO»HÉ>Ícî+h92óĽëx#¨$ţ ,˛Ă6{ń2ŔS·đ'€1ëĽâůĆ4*MťšWŇ}$7‡A¶ČN‡\YPĂŁ*¸ůĹ(4/§B¤70gĚŚÝC-Lu*åѨvç·° * Zčendstream endobj 520 0 obj << /Filter /FlateDecode /Length 470 >> stream xś]“ÁŽś0Dď|0ěîiĺË沇DQ’cV–Aěě!źŞ"“C…Tw˝¶éËËë—×m˝·—ďÇ­ü¬÷vY·ů¨·ĎŁÔvŞoëÖt};Żĺţ×éYŢÇ˝ąĽ|÷_ż÷ÚâşśţŰř^/?ŇuĐ«îÜTnsýŘÇRŹq{«ÍsůyYrS·ůżĄx=wLËăÓ)ź¦.Ă–|jzÚ9ź¦¶C] Öh»,Á:mź%Ř'Ú%Ř‘6e v˘µ,…0%Úk–ÂP-:Q储U‰´5KaµwÉV‰Ńˇ?1¸:ŚY ˇŻ´¨JÁZTĄ6Ó˘W « -B(¬roDëTßN˛B$dD7QENô,Á’*˘9 öJ ˘(ŞČɉ Š JˇBH<Ť„¤ Ä „2IĄK%”I*•XĘ°Źę»Žî‡ Áxż†2¦R¦UđšŤĚ^ł‘Ůb 2BLA¦ ś˘é$ŤjŔ7µ`lÁŕjÁŮ‚Á…áÄpÜË“tą¨śTŽż†‚ĺu;\TN*Ę,3  Ň étAâÉxüéśNŐcÚňyu»kô4Zś¨u«˙¦sżíÜŐB͸]óendstream endobj 521 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6687 >> stream xśĄxt[U¶¶Ĺć&$¤€‚½&C( ÉdhIH€N'ŤôfÜ7ٲ,ɲե+méŞ7wÉ˝Űqz!Nâŕ&Ť2´a’!Ŕđ`ď\süř˙#'ĂcŢ[łÖżţ·Ľěµl_Ýł÷·÷ţö÷ˇ`ô(P(ĽĺŞUÉňĚeň䜬”ąsf­KË(ÎI.Ś˙ëÁ=ű)aČăD0nt÷4şb2ş4 홀ž›((Ž3~˛tÚĂŹ>ţäłóż˛ôő”̬䜂Ěä7ÓäÉÉąąÉiEY9ůyäלäÜ7S“÷$$dfd$ĘÉĂ©Yééňä⢬Ś\yN¶(Ą0«@.ććmYR°UVřZQ’|Ůň’dĄ*E˝:}MFÖúě= ćż0eá"ćîqăž$ľŹ–ľ8íÉw Ż ć ~#X+X X'X/xT°A0Sđ†ŕqÁ‚Í‚—[[Ż¶ ž$ ć – – ~/X!X)/ ( 0B«Ú„v!B§ş„nˇGčú„~a@üŽ'-8!´Ťš0ęşhłč‡ŃĆ„- &Ćîş˙. FQWÇ(Ć>5öćÝ+Ç%Ž;1>ýÁ=őž›đýDĺ¤Í“˘“NM“Ű'ă{—ßű·űĚâ蔇§śş?çţŹ%ébéő©)SŹ=0ăď´7¦ń¨ăž˙3jóB.ĘĎŠ ŃODü»čqŔ¬XŤ….IĘ^ż(µ)kđ×űŁLM˙~4 ¨K»ű–ĚÝşB®¦-§ßlŰ;@™ŞW•f•­+ĄŽ¨‡®şR{´¨Ú`y¶‚Ő•obÖâRVc–EŞŠ*BŐľZ/íp†Žx˘‘x˘ž¨;>.©hë˙âk ůÓłWmĹ÷•îf r»tÔö®Ě#_ő ßúhú+śÚ†„mÂ!nhžŘgqey,ĐŮÉíĘ\J]Ŕîö¶ŘjąĚja°×âQč¸9€´ţ"¨ jĄńd¶Vq… %ź+Ń <č2ú4â`9°R`SđÓUů;»ŔN)Ťä±&sč>6Á"o2€ŕT3 §Ů !đú»Üu]č!‰»ĆÁůüČz%‘HkkGç»niĐᨦH&ç ŠŰ†f‘L@&q@ `¶ŘŚ6Ú'ĺµµŻ­_©ŢÔ܇N 9uč™ďĐćě•ŻŽßęďo/ÂT k=Ł‚+ Îj7}ů8›×ŔÚí:ýę"CdÇ{XR\„‹±Ś€đ<‹…hÖźßď;ÜĎ|ůIŐŔ‘(„hşolCOŽ´˙ĚU_ŽşÄ_­»¸x˶ŚÔlZrw]úHĄ *UVůëŔţĎJWEŚirVgU3xôđZc–Í´ ¤Z(Ťn«Ż©…f¦:Ův Üa‚—ʶBűŃłŢ&ś×śůPB“ĐoŃŁ ž€Šł^Ý–ťÔ˛ňO=..ÄC›˝MMÍŐŇ®¶oP}ő™kÖdă»Ti Á˛­^ťüĎËŃČ/v[=ÝŞ0Ń»đ´mKđ" đâDţôP‚ĂĺtGę·@ =)±OÍ$“8\ś\q ßĘú}WDü}ře1ɵtÉŐëô8ý4˘ůţë1éRRňÔtńÉÔJҲx,Iy&žńŘŰ«®Ř[ßÝÍěÄIĆ|Łu˝]Z®‡S¸˝‹¦şŮŽŰ 2E<'óśĎZ5ůëW¬ęuëUG[°j?ÓvýÄţ}@˝™o"čOĎč“›a2đýRÄ/ĺÇ‹»ö´n^ľkkľ’6Ęhßţ˙Pá=ËNW'šćŞnGS$®pó‘ú¨ĎŰŇx¨ĆJ-0ą–â"QĄA%©_¬;>ĂĆ{Č Ł#mčp§p(‡—‹kŃK\“Č—'–śu~¨éi•l%ĂŤúT›q!HŐ¤«´!ŕ$áĐcl‚?5>3 ë°ŠĽĹ™Ç±.€ĎUq9%ß$ľç+Í3Ö”ËB›IˇŤ«'śS(— ‚8)Ř‚z˝ÝRjĄ/ČUĎ5'ń"Ăěp)’$˘ ±ěEr°˛Ś­l' gňI'8IVÂký„Tűo ™×Žśo řéč)1t+´ˇ‚ć<÷.†/Ĺ ‡¨–úł7Ž›R+č|{I1Se~M4Z_µ÷Đî}‹±$}Ć®®kZĚô ý l dňgń¸˛EĐ/§{- ­ĐLĹJC Y®bçş”ĎŃ3{ŃřCä|Ńä ź ˛6~4T!ör”ŻaANăé\‚AK`őAZÁcY7 ĺ`ĐíÔ§çăQxŠ.¨'@łÚčůGS“ď~söŰ˙_˛™‡Dř.ôĚÁCţŠnćxmM]u­ż°1=@š×éĆé ôşëj>¸ŞÜU®Şŕ!‡sŔAąŽšx»fM‹o'iÚT"D—â«ÉVťŐYčÝŹl,ĘJˇwÔ;˝®*ć::šđUbm`„VTĚĽÄnô°»Ă×áôźieđö±ľţÇöľăüű´ć+ŃPO‰OT¨ eĹĺłßHu 2ŘYyŹÉ6Ë6ffI°˝ u ŮŰćŠ0űŃBw4ĐC¸´štŻVe,1Ѭi;^o’™rm*Pl‹|cnN*P ŕzU»{ď4 ¶z"PKĘîŮúd:ža¸M5ÎJ7Ýôĺ޶. ü•ö=…ş|“šŮ…Çjw@5çRć{UGŕrݸâćVxžoěü°M…ŁńM:1t'ˇ8íZţˇeěÖ2–V/W­y¨¶±6ęô2ŃżtŁéŢf2đ.iĽGŠ4ĹĹ,­ęÉkÚI¨x žĹżťujهµÇ]W_rWöQč‚X¬˛˝Ş;|žŕŚ§ŁĹ[đf‹ lµt׆7KóÚRvjďńvB‡™¶·őôĹŮ÷yłŮf¶[â/°’Ă7Qrś„[nˇK·DĽéN¤›ŐdŁł§'‘mZÚŢI‰´=čiŚÝş R7ÔC]yľĄ¤ŠF4Ú^ÝwbM$kmćFą–.ĽřF ¨GÖaqaNçô;™Î/6tUÓeX›Ł^šŽ§3Ą«2“w™Đ¤"ÜŕŽÖ&i*öir e{v/9x±ű˛‡ŁCéÝ©@}?€Ä ńaüz©'G÷ßŘOÚEp!8(âŐü$±+BôRńÚëKÍmłs¬Ş’’ťx©UłűŐe ݬ;Řs¸ę\ç ¦rź+Żůžž-˙˝ć_őµ’ }U°§P/3)™”‡Të`;ő»óąoďí¬jn¦Ë7i·¦l”eĄĺí °“Sď­$Ô ü0ÔPm.˝<»të–éçľ˙ţ ”Đćž“mÔyŁ/*Üw]ÄżübŹŮKÔ•Íh¦ÎÄBе˛ŕŘŕľÚo:Ď1m§ś‚Nč-Ź”’CĘĘJ565¨˘j]MKS}ß±í=Żŕ°?‚š{fáč‘Ď~ ĹĎąĚů»ˇ‚Š©BJY^qÚÎEűNő˝Ý[M·źŹˇńď ş,ůü»EÍ<—GSn ?<0(B=C âÚ˛JyA¬@Q×ÇZc­´Xń+תZ™˝zó×ę‰ÄÎ2{˙=ÔÎ@“ÔW뎪ÓϬ´E? “ÂŞgŚ˛ť*Ý­—•g‚ÚŢ™y”Ďţ¸hM›·ksš…(é2Ň\ńÇ‘V ČęÔDä1Ťëw±ĄŐ’V ôSô§Ż?=»ŹŢcU™Ї®ĘEźDů#şÉb·—iémëdG65,'t/‡ďÂăç÷ďxKĂüG~Źá”ž—Î}~Öc+°(Š&Ö»ëÚárKLéÚj]Ź•D†š‰áq;‘}lŕŔÚwËÎą: ŤER41gĺĄxĹćąDËoˇĽó"ţ!iMYU‘H·uślń6{›G$ayŇ-ý/íŤ3ü>«+9_ÔVŐ…Ş‰µvůĂ'zŃěö‚CÖZ¸ {Ő7űwöäüg™E–Ôł‚Oy$Z^"† É­ő G‘C“!Ź× Ai<{Ö¦rzř-ŃYŚĐJAëł-<ů$l"ľ¨ ßd~ý>DĽsČčÖą‡ßBIą—Ô(ťÁ 3¸ÍĂG±c|—™,f0ŚŔÉą¦yňxĐísC(§¬7>WüwQ!O»mb­z–6–*a3$!KńČ€j%Á‡IÓi4[-&3ŤUŘ—‚î56ČűĄşXńńy@­•m*‹S…ßéq;™Š˝í.ńj­‹«vµ/lÇ €5±$wúĆě1 Ľ.ŤT(ĐţH(µ~˝4śÝr¨3M'Âqĺ©í»#ŽăJčóA±×ĚyÂ…˘Úš÷ 9đa}!Ęó[‡ĆÄÔĐVUŤ°ęâík¨swˇąłŹ˝„Ä’¸š=¸řďçŻĆÎľO‡7v䪿íT%“öŠç-Z¤#;ăőÜCŽ5"Aű[Ě‘k'k¬˙đý/¤ĂZ§:ÔÓuü’­˘źŁárÇ&óYçĘOßďhľ­»Ł\\ ôé{JÚ´Ueę`ŔCľ|}­­ű‚‡¨{âÂÎPh*´éZTŃ‚öäęí€ÇÁü`ž†gc‰Ńe%ó›čçp˝‹š$Uk§Ľ p¶ćDďŃîž·"ýÔ2·X»Łx{jfZöv%ˇť%ožşRé¬$¦rYÚŃä‘Ťi'4—UĘüN J(µ©-jCš*-'Ďh2 –źÜ] ¦»->}TŃ>čjhpůč°>Pî-Ąîý}@á’N…|K®)ŹZ…2Ĺ‹†-#ş*.ÎßAô}B¶ w3 GxŁ‚˙äŞýÜ âűřçG.Y3Ńô¦'SMů­˝Íţ~ę7EgSŽ˝Föó¤Wń“9z?—{/ş A˛žâ% W[Ô¦¦řĺ\Ň?2Jç6ůÂľhoŽ}pµ9Ăΰ+ÜţíôXß˝ˇPôöMÖ•µ‚âĂhm4EÓ ůń‹=—ŮÂZY]&/J'PS«ź©¸ŇŮܶ•é(k!áSŤ§ ­>“KSdÚÔéŚ<¤®&ęěżu˙Ą˛ňűč ŃióŽ„#5«{“ȶ,]Ľ»»ĐĹ2k˛÷¬‡ÔňŐ?"Ééô“č±Ćdł§€´ tÇ|uŽ*h—˝ÚŹďolśĆ†&’ą{ĺ‚× V±»š “óŢIŮ˙âÂM›2‹hË@rëÎ˙ŐĄÖ» vz|ço;ÝŮ­l«9Ô`V†Tú'ďţ͵y[‚\|ç%˝!đ)†6•űy?dgs˛.}Đ\aŞĹ»ů‹Ĺ™7ÂŰ"Ä­3úmŔtźŇô nŕܤ՚ÍP.UG´••ţ`ŔG#3ęŮ÷đQ<«R.­,@PŃD’”gä2wÔ‹3ă;öł›Bôí»>"ŠüĹ+_“o &Wˇ wU¸ęIź;ýµ |…iďzgGu{SSěđŢ–úľ*›…dcˇ´^y[{´ĄÁomĚX˝fKú.:im‘&C[űˇÄÓ:î;·,a źŤ,PÓ„­žúvč6+ …ź±VĂr˛@-6˝µÔ®ăČmo¬î¬Ąö‡GŘ~ÔúëĽRö”𛨱Dxěž~GÄ_FbřăĆ[ śF%.’@ʨŐŰYµ•&uĂó,ıKO““—˘{LňYív}ZĽâ^»ŰítpítzęąH/zL‚žvŁč@S),GóÄż~ęunI|'4îs4=¦Đjö}°˙2˝'âĎó;ÄhŢěďđxýŠ‡8Âk—7aqŞysń|FîÍÓ/ŔjX^ú Ď=gš 9ÔŞ"~@7Ń#4Źg‹—¬ŔĹx6ßšĐô}tßŔ±ös@!ˇŹ.‰ ÎýŹ ü ^|FČű~Á§#±R >ŮůŰŔüOř ?K}šřľnŐš`•ęĽĄŃwsG_B_' …ż¤ą +Ţß?źöžCÍ~_Ece"~‹đóřîyożúĹöŹfWÁŃś uűxľ_ ŰKžĎÚśşć Y*P[SşŻ¶†>éz›Ů˙‡Áqźů–ĺÄ3¸.‹t­]‹ ÷_DťEü6ž_T!ffHú]X5«‹ľ@ˇ'Q’ÓŹáĹ8-±ęBíG}WšŽőś&[ńgĹş­ĆÍE3ñn‡â™´%™Ii[w•­hůrżçL㿍ŔĄ‹ë! !ÜK„č­ż?+†^eťŃ§®QzÖÔ.h*uŐ%÷’Vč)tZň·“ŐŞXĽµ.@[CŠ3EWzc ŮÜPGEÜ1 }·I;X5§ňič‡7âßá•€7~č‹Ü«E­:'´čëLűĘ`;U LM—„Ş´ÉcwX %Y¬&ý´ţsG. 0燞Y˝e(ČëĽŢj˛±:~ˇäş66:ôtTřĺ;(§^Ä ţ$ćXü~Řh W¬L×Ó·łôćçaÎÍ89pÖÖ~ü1q®/d¨*8»ćą—đór=˝ sđŔw/zYbcY¬”Ĺcô¸9®ą™öykk|ľŔ–—®AtĹę*"#{!@řd^ŕ…xɶ-ÎŕT8€Ć4ť¬ëkŞ2J™{Š‰ć Ă(7š;x7=vô†üqc˘'Çůť•G…cÜ8ŕ˙µůRendstream endobj 522 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 908 >> stream xś=‘}LSgĆ߶´÷EX[/ř‘Ýf łÉ¸sYÂŘdAťn  ÎeVĄĄŐŽ­•–Ś]čiiřRłQE°°Ňâť™™HÖJg¶l&[g$cS—E6”Ľw{M\ÍćÎůďüń<Ďů=”&E‰DµőŤJł©®©(żr_}ł±îŕŁăJ°‰ńżŠĺ ”2měďtuRőućÔčŃ(Önxţ…"„ÔHV eˇlĤÄPz Ĺ$ɤÔ,cI8ăˇtďj‚xZH’ŔśLôf :&N†µâ&ȉ«Ř’ ő€őL®Al?đ28–ĂéôŠËľ$\Im.óř?±Űä7‚n ’ď "}ČÄ(ŮÎîWt8\Gť¶m`ş]AVÜ‹ ßJŚWç'ŕ;LTT~ť®¦ěú˘üęĎŰŽźýÔ?vćXh78?÷-ŕűW^ŢřÚ»e›¶h©‹š\.·Ś«Ä×˙şÚĆfC´aĂŘŇýÉ°z~ÉşDň‰,[“Äqň ׫~¤Ë? ¸‰oäǨ’¦î|Qn9öGG›ýwáŇč<‘°–h5*;ŚĎćµaÍśÓ}ŘŇŃşĆĺvşá(¶‡~nZńóTe.•Vě.łätM×jß'Ćë Áb:R·–H«†¬˝;—{L™¨ŃxH"˘Y™'%¬@ÓĹmĚ t<ÜŃŢŇĘŃ…5r=IĽ”âŰRĚ5é¤ĐG yąĐÄÉ°öS"°tDAFČCůăÇE"™w ¤&ŮÂźŃ,dkŚ)č5,QÜŁěć]6K#G¶2áÖ(3©¶f˘ý}WĎĂÖĚžtuňínŕť\˝ŁÚ±Ţť˝µý.ďĺ;Ŕi×ŇIć´ř{;}=ÝÜŮĐx$ d}¦Qß^exOkÜWc×A9”źłNééච[ë>ÚUđˢ&Oü;Qq˙ÇÍ %ç=!«gňÉÓ‹Ď-R‘?p¦zұáۦŢí‰Á&¨®oxÓsŃ;˝:ţõ` á ~ČĽż­íŘńs0xęÔ(§ń–Ćk.ćŇşŽ®ˇ ”'ňudĄđM×Wq.>_q^”w44쵚í»kĘJéS@J…ą©›·/mŤCÚ=ÔÂŰ8Ă6 ľú11÷ő („ełËąei;ĚĘôÇëéôx»=ŢžR‰Đ?j®endstream endobj 523 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4115 >> stream xś•X XTŐÚŢĂŔě-"Ű‘!mŹÇŃ´Nz<Ą–©T^Ň“!(ŢPDîĂý* Ămfľąpîwá˛ĹR D%1;iłÔú;Yé_vÓ,צE§ł†‹Ő˙dçü3<Ăó ß^k}ď÷ľď÷-D”­ %‰ś7lôŠŠđŹ\şĐ+08Aákýr:`ýŹÓ†Uvŕ ŰĂ3¦ú¸ µÎ·ť˘¬Żą«"Ł<Łcbăâ“ü“÷nŘ°qßß‚CĽB˝Ă3<ňř˛ĺó(jő2µ‰šM˝ByQ›)oʇÚBmĄ|©ŐÔ6Ę“ZHm§ž§§^ ž ^¤ÖPk©uÔbj=µ„Ú@m¤ţFEPS¨HʉšNÍ &Qö”92eK©DN˘8Ń-›d›‰Cm¶Ť°=g·ÂîžDG{Óď2ĚéIł&őŰoµoňŞÉŻ9ÔLY8ĺ ÇőŽ=N>N…9Or~Ńůçą,s)rąÍnDŰđđh/ěH ÇOăS荠4e6ă¤aZ–[¦.J…TĐää¤â𑛲Ś°řZFA14A ;µŚ§˝t)<Ô€IźŻĎďFR*•śÂŹ3ujČu‹Ř 1ś‚>n8 '€Á2T"ĹJ ˛GŘ9 '›ßäÓĚ.Čö2 şěĘ*…צń4ëí ± ĺäMĂGĐu(ľ9°l<{^L‹b´_IŘÝú]ô@™¶_Ăđô:%śŁő4kúὓçĎ–m™Ă©żëřłŤčJŮ,Ě7‹Z®ŁĂ×ĹB2 •"×Gďb'ĚşĎÄS±ó]ä„ŘŰ·‘·Ä$… x%vwÔ®]Iţ° üÍńŻĆtjűIš0`>ÖÚ÷zĹa€cᵡ ţ:_đ·îqs •Ŕ/äEw„Ü&ńđJt@Z ¦´tČVią,Ľ;¬š Ě_ńş~tµˇőý}óýJü×Fą>]—[L%ä×ÉQ:]¦ŚlµZ•Ăů® ç˝Î¸Ţ‚źĆK°Ţ‹–áEČ-ű=‚&É Îx ŹŃŤć:>ĄŮĺŢeTÝ•ő"…ąĚűŰűlKŘČť§Ů{ŘĂ ëPAÎůHČÂş”¶Ä´‡˝ šŚlľD®ň%Ó°dÍâe~–Cq\z-衆AŃ4k˙FűéÚÎéWźÄ”ś€ŔEQä@QÍäHÂěf—öë¨řú*Rűˇo‘Ž//ś‰ĄďĽće !©ŮcŃcŘłw<ФξŠÓ]rüüŘáXĄ‚fWę»É§ł˝ăGÄčc)쇼ѱ{üĂ·łjçČ1C]ązâio‚‰;aŢ`g-Żčtą7tďSWv“0IxHÚŃę÷˛ż˙ĆxN{WÂ~…gýÉúőeş>@,!˝Z]Ň!Góéc%h.’pZZŁMÍ€8&ş.Ąˇ®ˇ˘•süYTD)ÍHbF–zQ{Jď 4U Ç“šB®*ŹÉ_]L[CçMD>«çtC ^…5ň/Gëť«ŚtNŁQ©rrőŠ‚P« ÂVű†—Ç4$ČŰG˛űT}™Uęú”â,s22‹Ý!mNĚǧ28u±¶ 4ČÚ/ÇSéP•čt5Őś± ¤,?żsď µ™Ň©ëŇR!‘±Ă*–G’\~¸Ő“ž‰ň¦•°-8z*9äI˙j÷;tpGĹ6`žzÁ˙%E]ŠĄ©¦ÖŇĺ—ň&KŹ©ľŔĹň0ÚGł2wm¸gHÂV`XĺŇŻ˘/|täts9Ç®öĎo îšn>_ńŻ>)eÍóWFěŢą»ýő·ţpc5$‚<Ç·’*š 9 š±+Z&Ë6ČëęWEE|{{ă9± Hu4"h|í MYA;UĄĚÍyéŮłßd›4zR`(-)m°Ćjb´~d‘M°Ď˙č5'6}‡Ą˛ůxҶ—˝4‰@@m!]­Ú MŰfµąXş ŠIÍĘ+ŞyK«ąőš»¬&4ĘĚô8k#ěÔ7ęşČşgáU5cĄą}aî0Ł NŃ˝!d&mdÔdť=nc‡5;C˘ă8tóŘQĆŹ|ŢLwśăwżu Üî©N ;s¶Ä$„ďUl?lŚëH«ťŐPwÓ„žş’Ęö˝•G  ŽĆYü-{ô› ÜZ]Ő‚ă°ˇ™7ÄÂ-ŇnŁ$J÷4ě‚×óÉNMa»\ [KormĽ$Dýg€]°ü, ô˝2H>ROi”+¸x…Đ2®/ěoŕ%ďRűqÖÇ®l‹P5ĘůpµŇQÚ C(ó2ó˛Ü±J†mQE107K;ÔY),V«Á‹Ô€ }j4ĄŃhŃ-‹Ý”°%rÍzp‹…”2µžaoéš‹Ú¶$WĆÇîOŤöë :ů÷®7N7rhť°ĽÄR}ě-˝ń©soźB‡o¶4‹HŮýąXxM––*A­MJ˙âć_`^Zzy ?Đ=XvJŰ!OĚKJH&¦6Éb©«âß|áČb<ő±™ŘKďÎ#ł‰Ľ M1qŽ?®‡r?Ä ë>˙8mOŻĐÇęé}É®ÇĎH!˛÷ăř‘·d8^ĚŞŐęŁIÓzFŃ 4—Ž†sHë8­/×ő’FZˇ=eeŘči’ m´N‡´?QůéFU)¸•@ľÉhB†a™Nk7ra˘’AĂ"ó¸ çǹ۩ŕëÍЉTćvÂ9k3í¦Ďą˛3ó…Ž —îŇěÖMż˘Ąs üúź%Äić<,ĹÎßşŁÉď磌–żDłrµ%ÚRHdXĂ?Ĺ®ä€é{  1¦3¦Ks–H¤» ßr´ľíßťp4±)°4´ĚLŚ”cä…•Ľx8zx&኏ć€vl‡tÝf+WîŔŽhůČs4ţY¨Î*UCň(`Í’K6ČG˙!`e´đěČ˝˘Ś|Č·J(Ş‘ Ýtôܱ6Ű7X9ŇVŚNrę‹c¤(Ě-PeŞłó´\čśEš°ö6Ĺ·‡őjˇ“AG$őůP÷Ýć[dĚsXř(~»~?9"ÇŢ{ ň5ča)ΓĐă7*›á4 úëđT’©h™=ÉT°ăQKFX»!řĚř™+;[°v” <čͱçž]şi®ÓĎ(®á÷˙`€¸ŚOFv4;őfďń.ŽťU Ĺšb˘$2MÄ215űÍMŐ5nĚŔńŢ&´áüM(»ÉĄĺLÜ•ô3hĆ•ö3®ěTJČćJkŇř€H?ep]żŻÜžkžńm ®< ×h˘BŕC+›ö3ě—JßÔ€ ť?˙ŤšŠśľďżr,ůµ FnóˇW`1ÔpČŇG$7‘ŠWćWĘĚ©ü2ÇßştńZoT{ząüčán(…\uV.ěg”…É ĺ•Ĺu^Ź)i<Ě’c‹©Eđu}“ľ˝ŞQ^QŰTŃ Ě /GâFęµÂo!Ç®WÎ[Ő}ş˛říëň˙•´!'í2ůÄÝŤłú˙\Â~˙z°¶‡(63ZôĄ„íúµÉVţ‡űÁq;ř~żµAő™Q/:z>;âáěϤPJ†wU––ËÝ SŔ”µYUŞzŐĹśăYoŞ.`ńˇ[MWĎÂUć<ĺC<—Ă—î»Â}›•t^ëfäSÍLX 2 ú´óZŕ39l÷_ý Ś'|-ˇ» Ň÷Ęqýŕ¶Ö ŻLD>ˇőf1 ĐK߉éŘ’]}Č\QI&űĄĎyryą Ŕäd–|xŮs÷sÓ[3CażIě':(G Z]™vJu©$/ ¦^v—˙wÇ{@ö<Ą8‚ ôőGÇţQW§É©çҲUÖÔ¤¦VŞĆ3’ͧ#ßSŇ–83ŃlläŻ4;‚Âď‡ Sîk;˛1–Ä™[8üľížlôy´Úü€ç #“¤f¸öŠ"!. em1ż€8íň žY*21䍂izď rŕĆ.ž89ńÇÔ$ŃíóbôVI!_mČ)ÄRdż­ä č‰V´ ý =l4ę Ďćł3žôÄ"nÇcqłOO–śĆög±Óç«K)Ě7Ęł8Ę «÷!Łţ'ŮlEâMČéńwÉ9S“ĄÎŐ« łĺolE6xŕ#€ŤÁ;đ<]ŁÎË\F­Ď*.˝q ‰Nq=_6~ČqL¨<«PdIA˝„·ż1™ł·őŽrÔ¨Ó“·‘Ü´ ßpp ¨ŮŢŇ%endstream endobj 524 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1064 >> stream xśu“űO[uĆϡ¬&Nť–µ19ÇM4s‰—:MĽ`$l#cĘ t+ rí¸ő Ą7J/çí9mOKˇ”V Ęm#čPt0ćŔ ÉŘ’mYśÉ˛ ]BLóm=$zřüńÍ›÷Íó|ž÷Ĺ±Ě ÇńśŁĹĹ*M]‘FŐTúÝźŐÔj›Tm;…YhJŹ¤?ŘŮČÎśůçęއĎŢyzý™ť¦´VĄV«0 “*JžÂ°CŘ~L‰˝Á]Řâj,»‡×dPW$E’4˝çߌŇ &Óř$.®}Sěń;Hht+ëXh"ťf0ZÂt€ň„ ÍjÚ#Ř…¸\ČB?őDŔ ™‡PÄzí¬CŻń€ž,¦KĽť^Ť·Î.0šĂĐ·ěłiBĘîůÍŕ§ŔuZ8č4šOĐ®÷i˘Ó F;ç R×!/߀b•^őěâú!ÖoťËL'Ąei„€ NůăëňČE`zżcYĆŕMË7îžgçؠׂ !ZË/Ä´üňăTÇ$~ eHŇűDý&ň„ÇA7‚yۡťŃ€˘[ôfî…„ Ü<•đp0ĂÓC;…¬íąćő²rh€Šé†f€â[ţÜř¨>Ú¦=Ůyôđĺ/o?zĽ¶ĹS(+U<Ë/˘OÔN‰*>őaV~ŕ>RŢŕń‰MtóI*€re~7głŇ.““ÔW–q¦%6?Y ÍRÓHŃ73±x1»l_9¬Ť`" ‘>9–8wA9Ru¬®Lg! ?žä+xń¸đ|«ťss!Ö`¨É­µÉY ĆG Uµ§„ćJŞ»I]\*Öq¶Ŕ˙ë%xCŘp¦µ­ľâ’~îĘŮů±’/Z¶Ź°źQNbGą?O< 4“D×ÄëxűOI:śJĘî|rCŘG żIŤY†|1đD©ÁdVpŇ.·Uxa{FnŻőŘ? k z81ŘUď*ýë˙dĘ㏭ §˝'EůHŽ$SŻ%d ł(ŻÔężPç!Ľ,˝Žˇ†ťĹ_ŇŰWŰ?Uâ|.&¨řŢßS4Źdp´p]’z%ť)‹wĹÚ[›5궸%6™OŐŠĚ…(±T=űyn‰kÝÖëeăA2ą:ż´Ä„·Ů w[¨ýŰ2]~Y…:p3_śžîčš[4ő§ľ×_Řx´¸Ĺ“"©˝·0ˇ\—ş{O-¤Ţ‘qN_7ءÇEjŞŰËuUN[KqÓ!÷ Ó†z­a˝*Y&šy®@xµÁ6Č2A–šÚÜŚN‹đóüBé‘c®.gŐúVËKĐB8ŔáBđË 9ú»8ď /˘ü¨ppjçű=ÚáTA8FÍĂR~wňIrwfisvϲâ'ř#–ŤfgcŘĹŘNendstream endobj 525 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1969 >> stream xś}•ypçĆW–1 HŇŠZÓv—+-”$-ť´fBą}l,×ŕ[˛,˶ËŇJ»zuß’%۲…T‚ěŕ'¸śĄ!¤ĄÇĐNšcČ'g=M׆NfúGçűsçŰ÷Ůßó>Ďň°ÔŚÇă-Ű›™)’ß%Už(ůĹ‹yĄeő•"Éě“ď×±–iĺtëZz÷,…ÇKKUÖUŠŞŠŹ‰0 [R»[TÜXr˘|Ŧ-‹–‹­Ă¶bŻbůŘ6l7¶ű9¶[Ś=Ă3đhl)7KĹ&y»xŹRZřëůžÔ5©§ç¦ý,­2-1űü3(±ä›”ew0öµZM’Q^2ëC~2b‚O÷LmĘ.(®Ş&d7w‚Ę@"m®”i94Ţę08}&k·đŤ….ť<âÖi uŚ–dSgrµŚ¶„J5Č[]z›ŰjŰä-8I;· ěW‚şě.Gčf - }ŇxŮEŔŃRô]´=OnŔoë—Wĺ-|Gó‡0űLrĺÚ‚`„„g†;űżÎ?Brß°­“E/>N6$x÷ź?˝rzŚ~%Ą˘a!… LjSI 8ĄąŇ]ĐL„ěaěPÁh¤U,>SšŃđË]ą9 }vŮ(~Ă2a‹Ö¤u"yNćxÁź"ěĘż"$“Ç\§Íη@č÷AxVŔĆBL3păC«vC­f( E(÷Ë\ÚŽ]˝öůÂÝo˛»B[—glx§Ü©RH4•z˘5X=8»ýK˛kV]Íľse|¬=D†¶_cĽp:Ď8í}ţ °âléqÁáíe€ż.xk¤ç«Ž!ňÔä›çź oU$k)1©*FS„/ů†w™z˘•óŢĽ†Nçާ>ď+*“××QÜd¶ř„6Km¨¤)±ĎPĎhŚĐ(TúÁ; T+Ą)ˇ¤ÄFö3í P@“pőű9wţkńżĆ••E˙ĐcŤxGÉŽű¶˝aďŔp|ŕ[ßż„±EŃÄssěŢ{”¸ÎO’‹V?ÁGěj˝Ô(VŚľµL/ËfuFşčW[Ďoęžčý[çéŽX\ÂÇŹĆ^_SĚ®P?YN»ŰBt˙eđ4·$—F*ÓJuŤdńŠ¦CPŻ˝-ľ<Ň{˛ł‹PîÓ+-(/.&(µ4Ä޶Z‡ÁŽw5údőÇ›ň Kn~ŽćŚÇâÔ"ŠóÍN91öÔ*ÁŢ_Ż'nđŃŘtŞ ŁąM*®®«Şokîě>Ő#Â3ő·Ö˘S3: MH7—®VŰzş!_śŚß‹ßsuză^(9}č'"vąę[6чç{b€űÝúŤQ©©"k·×î¦ö7B˝BŻ†&<˙LŮŰ˙<‡–Ď)ęíźő)yN’â!’Ţâ'7pšÂŠp]•¸F,Č»bÝŃnBÄN ,^łś!gsWd>ę1Y"v}lěŕ'˝Ęr%ÍňĹ™…Š¬üÝY l…•1ĹÖpÍŃŻ®•”—öK.M˘”3(}–~JąDň«7xÓĹÉjAĘ™çWC#1s?M čdYě+ŚžÖ…k”Óc¶íÄ%´ń”˝řٴɨĄ FÉfĚt´–Ň-«@Xˇ9€2H˘Ą–yNCĎŃóśłŐµuZ0‹É ‹Á >°š¬7&Oe¸úLf®ó>HűŇ[~XBő$ÓblŔU.Úî±ÚĂ–Yµk=»+ĚE.âJá‰[TŁPŠwr S=>“×ÖIš¬Ö6đŔÇ«C‡ý˝˝^ßřĹáţQn°—vjč €{}PŃŃë8×[×w8÷ŕŃĽ<"7OŇҬű4ą*ăIvń˙“]}#Á®śů˝A:.çM~e¸×ů;ż•AyăÔU9ä AzFC«%čńśˇ˘‰îxŘGtő·˝ËĹ‚[…ŻĆńy(;ĘGÁ•şˇŁÇjjkÂ5ý]ěVćefša¸űZ'ĺđ~ňZ0Ëă;[1¶Qöµ˘w9ąžź¬®ř4nUłA­1,űďÍ”’s‘ŞÜ_›Őë¶ýzł}¶ ,Bî~ĽüiĹrÉ{˙Źüé…ď Ľj [ZG͢Ś”Đ ´äź'Đ2pâ.ĘÚŞ2dQó|öp®ńŰHmcÓúvp5»‚+ٲ+Ö\ĺńŤŰ‘Ë‘›'ô!Ŕ/%ĆÂ${pD°mĎË’\Ŕ‰Ý=ÝöĹČUňŤw.vťqóevh7Ůs9$)SK6ýZ/y×,c1XÔ~˝[fë“×2taůčjŔ5 PŞÝF›‘l§ĂLgî-vgĆٱgŮP‹FŁĄ°!¨ úý·‹@ď_?Éľěi%íÜż ?ĺ/ąDv2ůŞŰăAµ'Ó˘ o-"¦îŻI_Đm6›Ě^S»Íî3§§cŘ0źĚendstream endobj 526 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4348 >> stream xśŤWTçÚžeagl€Ś# fÖ\˝±aA4–h5X˘AEět‘¶KľôÝ}ŮĄI‘ş Kq@Š€{4nŚ17˘‘¨±Ĺ^ó-ů<ÉťEăÍý˙Üś{ćś9ggfżď{ź÷}źçy„±!,V­^,ő ˛›>eťŹo„Ä3Ěđt4`u˙ńţd*„ˇĆMŁGČ}8lö­9a$-ó”J=×řů1)(8$,|gÄŠ(Ď]Ţ>Nľ~ëü%ŇÉ®ÓífŘĎśőáě9sç}ä¶ aÂÄ­ENÄb-áL¬'\ Ä$b±ŘL,%‰éÄrbaO¬$VźC‰Ź‰á„A#†IXV„51Š°!F K$ÁÄ|A†@NLć#!Ś qS \5ŁëÂ%ÂcGă^ŤH ’Ž‘-Ôtęé Őç V 憌4äÎС‡•›N4Í6ł2k5{hľĚÜ߼ÍüŐpçáÍĂż¶°ł¸‰L3š¬&€Ó›p2­2ş€|.XŇuúú‘ąÂ@ą—BÎ$ÜNŇ_P±Ă6ŹŕŐÔK’ľ€ß—™HČŻóR·±†t“ÁrVB"52–›pärŁU$]÷ââÉóç \Ö±8ţ_™ęĺ2ť~şVPۇöö ő(€A#ĆżÂĂđđIX€‡cćĹd4 {úŃěś<|Á%Â=ÂÍ=h3x€»&äpŘA8 M°ŽW¬9ܡi…p ˘ÚŁÚÖ‚ő&:ĽC¶Z˝5Żłxu•ôYŇćú2$a=é16^ŕéĹöôC<ÎĎĹÜ4wńkżw'5V#“Ç3źÜMfǶ»|ňâbÄsFâaźĚvđö©h aă5  'éÝuťuÝ6—ÎÚc±éo‚ îÎŻz^Ý°¤Çč ýp¦^Rç±ŘwąG<‹Ś Š˙ S‘ş: UnÍE’Š‚&1šJŇ·ßú.WJ+WF%B(¬‰Ó–é ëY~;e(!ÓŞĘőď—[4A^Gv±¤ç ×hǤ{ ę·çyć9,/‚ÓTcuŰ d”m'Q±™É@Avąř)Y ą˛t$&°ňŚ¤ä ąO­Ä…M}–;ű•×DëCkÓľ‰§čKÚŚk±KFmňó^0Ű÷Ôő]¬ĽH™•T¤F‹±©Ů™™ĺĺ¬JŞ˛ňž‡”Dňđ?ľ1Ŕ“ú#!ÓˇŹ˘P ‡VEYĽ¸¦CŁt–ô/č:2gN…­'¤>;–ĂťRqh,‡ÇjkfH9W:fbAŇÜu\'Âf÷›.Ö^<ϾɾL+ăŽpč'iWß+ęű“”ÜN1B$}Ź˙7čŽäĚ­ËĎÎč8ĘŇCŃu’n{ó¶ä3Äxą¦#Ű“kż¨cíHţÜţŁů´ö 8}KnŚäBÉůr>Cú*˛I]p…­ćD~ňůŕŰa>ř©)I5yE-óż®"}ĺ˛ůl¨DÔ¨ľ-|_Fąˇf/Î!ň#ő®”ő;űťő㎌P)#`ŞÚJB6)µŃi HOŽw[M@ő…Jd[×ě‡ –#ÇĘĄ”)UYKČf(Qä'd§HswÍÂéV¶¨"˝Tőű·X źŞćě‚Bya ˛Ŕ?[eÇ«SŠ T9Ů{ž˘&«g¸9Kfxd]ęÝYů|S~oUÖĹ5fR†.ÖĆp¨äö­Eýeä}áźµ}Ô-ćd3ą6,Mq(›EŰHh‡ýľÍŰ÷o.Ů Ô\Çm+¤1ŐµeŐ…é ®™âšĆ΂z :Omź!ŢAn’"_%]ä¶Ü)Z6ďaŘąžĂ­ĺ,˝Ř;«ĆłĂFsvĎ÷büQ7CgÚ.ńwŰâŐŘu˘˝ÍÍ1$Ţě źŕĐţfQ¨Ď´¤ĺú">çôVí¬ĂŁŐŢ––ÎŞj®©­¸#“âČP…T RŘ JȤ$$=FŁČK±I éi«X-xšśĎ—c ĹĹ»+2)şŹG¶ĚŇ_C¦˛Ăé1f¬¶9bŰş­k×("_©ZĹeVĂ}ąż˙˘ujQń(ĐÖ5śýć»ńVy˛˘X>‘ÉÉq!JŠ–ó˝N¨k`żrŻÂš/®ÎPCS4ÜmÖ öőˇŤw…z{4„ÉOy˛"#MÁM]™¸¨ öĐ,4űZű±Ý甾Ťb/yš¨Đ˛¨ÚęŠŇ˝_-Ü˙1> ŘŹx<QhT=šĎľŰ@ŞA‹h8ąçí)ŞôdEZŠ‚őgI°Ľ÷îl–h˘P˝H«Íc—‡č.<đdô!^‰—á)x&öžh*žŽŃJ4Ů#7vÜ—á÷fO›ŚGýö BôÁW}7ŃŘĄx7ËWöŞDëNŞ,©DP™Xiě˙ üeI“2}´~SšXż=Ę=ÍË“Ą±¬ÁÓSa3ŐŃńcw­Ź.Rś~ )ňᢜb=Ŕ›Zňx=2E_t÷6ĆwoŞe7Ô®…Ďxô€ÔĚŔ¬Hę! *K+ö·ÉËşwáÂĺćŘć°JqÓľ¦ě2 hK@.¨•˛Śt$R1E‰%ůĺą•,^Š B”qa)‰;˝š O*k2ë‹ubúĽ¬0Ż˛¶Őć&Śß)FFŻ‡0.K7OüŔ±űŘá–ćjösŃ d łÄďÄÚZ‹vü‘Ď.ý…^Ďw§X_J‰žŠ~W¸˘{]ú_űżéőoF×GZľ­ŽiŃQ΢ń9żŃsKşĽ?äG& dśŞdÓ–úE‡ÁH鎿—pŐ*úü–†őĺ«zĎB/ő‹~ŔăYüI•č˛ę ŇAľ ŮÇl¸DÔ¤ľČÓŕ~¸MrŠ '?şD’%óÚßD‚Ęg’<;8°‘Q›ú(Ďíp Úxvxk„o’K9ËEH®d2+2z4ąmÖ"ËľO×FjŐQ]Ź#o}ř1·,éć<ć® 2÷ &¶zÄúů˛h#ISš´Š†Ôzdöőť˘yvŞDČ!]•Ľ%j9ĎíF„7¸ćnÓ¤¨3 ™n™)±bÜIFCĘž\•:'‹-(i>ţ=ťk^tÉŐv^9ýŔ)Ü3|űŽPWľO׋ůś˘-RŞŐĘ›†R]UUŚ. Ţ/ŐULk¬f]„Śőě?ď Ģ˙[eßťVťEűmäp;ř¶%ýšĎš?¸Ěx€…ËvlÚĹV‘[Ků‰î·bp†›‚˘(Łś `/ťH]˛ű\QanN/ď)ä-ÂĆx†¶ Ŕbř»u¸> ‡ňŮnN¨OäĎŞÜsăŕČ­łÚmđŁj â~3ť ˝KÓ…ä]† ťĎ@“ěOű.Mlţ§­ß4w…ęîŚSÓÇĎs­rkßĆ$6‡ébÖÍr† ÔűĎ–żD&÷ű~f—˘g ¬ŰľŐÉ›_µrÝ›±J©ł_¶_Ľt~ăVóšamś;kÉ}§ëĎ_ď`‘Ů‚Ú]RřĚzŕMw¨<§»ČN×bŔ_s™óř?9Ćę´üjĆú-Ńn¬—ŰNOXDáá?NDĆgŰÚOW˛$Nëş6ĆEµ/„=WWĘ…GÄJ“·/?îu1ĽĹŤĹÓî2sü'ŮłĽiWś‹n†.0°V‡¦ą¦«Ą¨C©ESDa`Ö*×QoUć ~%¸ńJÖëM™şđŞ  đ𠠪𺺪Ş:÷˙żgo)vQ$růë?«y÷Q§řÖĹ/:$4´4¤)[ť lnf*/‚aÁ§©)<łČ©ÔěŚě‚o®"ĘP¨ú}‘h)ŻčklË:[üaQ<#‰1ńV0u+šÚ*8Ů?Ĺ OŢČĹ뢷ňP,Ö˙$*6ČŢ`Ěż‹c_˙$Šű]:ôDo¤‚ßěÄ!ő!~Vż9[l>[Ýw†çÇ°!%Ńą1üśµ+b“sIś´9X©‹K*ekbËRKů«\Ű}’z3iâčČ_⢏O Ń8•5¨bJńpdÖšhq ZŚĚĐđ"CiŞ©Ü uZ’Ý2LŻa7aŁD,äĺwAv›śÁf7Vć•“ĄÎ˙Çę(–_ľťF蕡a둉2›ő%?§ed¤ÉAQ-~4á¶ěxáŢ"šc‹„ÄxÓ˛2rňo…čĎŮndT„đőź29—É<^&['ýbű°ż÷kiÚo‹կś?ŠzßBűj,éëú+ú­L0Š0y]öÎriČß ť­ně…ý6mpgŔrđSŹ-5Šő5$˝©A•ŰÁ>ˇ± YS‚mŢŽ¦> stream xś]‘AnĂ E÷ś‚)b“l˛hUµ˝ĆăČ‹`DśEoß™qSU]<Ä33`>Ýérľ”yŐÝ[[ň®zšËŘđľŮ­)/#ŢkĘŘRą˘:ŹÓ–ńß’ő[Ç0ý)e,DR7ĚH-MoYű(ö¬»(îX÷Qp™ő€~O ĽŤpŕMťěl‘˘`¸Řů(çXűchTGO+Ś1a` Q Y©ĐKqŕßtą°]0I"Ď«s8ó3Uť­aYĺ-$kŽx.řű\u©ÜĄ ő @ü‹endstream endobj 528 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1692 >> stream xś•Tkp×ŢEBÚŘ޵g7&Ф‰ É@ žƸlBâCŔ¸GŘjlÉH–ecËŇĘzI»’%ůAý°đP'M0ŤÓŇ@Cę%ăH;t\—iů‘şwĄ«:]ŮP2ťNg2łŹ™{î=÷űÎůľCŇ9I’9Ĺ›7«ęŞ~ÜXłGWmXţ§KÔ•Ćj•>{¦_K$ls!KYŇăąrn2ÍGĄßBëç$™­\üäĘu›J^ß­UWŞę4:­ˇZe¨RŐÖęu ę}F•HŻ3é5•UuęjuŤZ[W©W«ęÔú™ řŃÔ‹?m…4fÖ4Ú˝­¦®QŻzCSˇŞ6hj4i41oÓJrďO+ 墊ůß^^›CO‘.BO”»râé&=¤—ŇGúÉÉ‘<1_dHH‰âÄĹ_ĚyuNŁdˇÄ.ů›t»ôýąß›űˇě)™˝ťýŐś śůAbăä»_ Ü IâfâyEĐë3ѸB†çÎZµ«dççĘđ´ővótlě˝qô] ĐB–/ß‹K°Ń÷ňOµzăč­^ţgŔ1˛–}Ö¦ş…e[ˇŚĘűÝ–{]?xéSzâFďÍî±wPń9Ä\ůĽ§?čë÷Ç'߆v*o«O>o"#¸$‰‰bEČŃaf‹N•N‹×.Ą=ŘŇ Ű´Pš$‚í>?pĘěŻHĹE˝>EţqJ‚^CĹa@«5´ÚĂĐĐŔŔť-¸qc˝Đ4 Ĺ;ŞŻH„µ¸U°ľ|~ď°í„; ~8Nˇ'ĺpÎ{"-|#Š2ŽÁďaBĺpbouw÷ŚqĽŹă HE[Á˛tĹöŤ‹äđ44íә͵µĹ.Ęn÷˛l"^ćśű‹zXJárx4#{ĎŐü¶őPímef‹Ŕ’Í"ŞĚ¸=‹kÉ5ňNč1™ ÁLOŻ‘›ˇˇ·z:pŐ m8Tg9ě¬ě{oůŰvr÷PQřM X¬ł0Ćť'ËĂ•+x ŠÂ"ÉŘîg;^şĽď´gh`=č(,’,ŁAßŘXg(t9˝.8(k"÷꧑HrěěńĎS\Z6<%úŻëQ‹–®Ű­3á3Ólĺđł2ü`ů] ZH /Ě”.`R/ČÚQ.ĘDą˘˙ž{Ŕ«dř9Ľgă|Ľ=ŽçˇU ZůőšăGgzówtŘ8–OťGť9-!¸˛ÚlVKĐÝá`„öĄú±ß油 Ei ۢś‚QZA]a.ÂC»2U!Żl¦Sq™Ůô?Ű{"ŽžI?¤ŘŘWîkáî-t1¤¬+˝9•s?Ѥ¬ů?:ą;›•J˙ëÜĂŘ×ů|Ş€v{ŔLĹ/GčGţ×ĆA‡2j [ÝpXéÔÜĹ:gč€%â »„Ü•u#¨h8epé˙!”l¶”GÉŃXâv,­…j’"9ÎÄKVŕeĆzăMŻĎŘóćˇWÎć…©µÄX2†ĺ(-ą–Ĺ:+k|ŢXĂŃÚ_«ĆŶQ7‰2ăw–ćŻÚµ§˙˝rZw¤ü’îŘ©OnüÍję—‹—3©2ŁB˝aíăX\X´őË?ßżýΙşĂĚ`őpń FÔŹdÝVbzíĚظ–č“$&{ŃÖ°Ĺ⶧Çĺ§ ü#!×Őć ÚAé-ok]öbŽŐćő‚8š8W0ŕ‡¶0=ríHmšýŢ((€ź u eÉő9|Ô监錳•Ł(űˇ_Ńź}ΨŤu7‰~u.)Řů2Ăžë>.úđ'=e@-ŢĽčű†«őQźťş—ŕLĺő—.—üĽá] ľühęŻL6‰ó‰§c˛xF<“ÎlËËz$†ţO„÷VVAüB’Ż°endstream endobj 529 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3310 >> stream xś­WipSW–~˛lńǬJ¤”ó^fB‡N „†Ě¤CşC&tXŇÁ,1`Ěf¶eă]¶dÉ’-Y˛–wžVŰZ-Kň†7,ŚíŰť¤¤˛:CBҤ!=éšizŞąr_ŇĚ•ˇgjŞzŞúÇÔ«WőęéÝ{ľűťď|çH@%'Q`á›7ćVÉ6TĺřÉňç^++>x˙ŕ˝éÉďL˝•©BHMŽĄĎ‘ÎG+çˇYsľźK‰ѬÔ9 %ąĹĺ˛ÜýyUąĺ…ĺňÂ*yR“›˘¨…Y;×dŻß ¬Q©ó d;f§Jźś?—˘^˘VQ‹¨—©g¨g©,j'•Mí˘ÖRë© ÔOfE`pđ” Ł’©[‚hŇ’¤!áż&—¤Ľś‚D˝36͸L—Îdf˘YľŮý©«™ý5íM4v_8ü"ăńoÇS_őCµ ×ę×0Ç}xş!Aôčű y˝˙ÉKŰl]v—Ů[+Ëł@‹µ§”P¦ rÍl/×eppř-ĽEň<ÚÖbës´‚Ô‚Ăţg‹—ZÖňU ·U´ˇĘj|äp~Öoĺ9W=bđ¨;0ŻR++8©J ĄF§.ĐqŃ,zԒ҆ž JĄÝ]Ă"-Ň ¬KÂFąľJ-Ľ& çěqíĐamiâ{6í~R{ó_OxjąŘeňÖ•Y „ɇ<{ĐF%”ŞZˇĄ%l5XÜßĆ ŃŘaÝ mmĺűtN‹ź'đĺP™€ŻW‘~čöyđ˝V¸ęĐR|G˛ď7«9NĹIŐV5¨ ¬`67šĚu`¤WE:»lĐÉ|ĘŁç,)͉ăhˇLQĂó ö ŞFçĐŃööŔe>ÁZşpů(őř”h\p±Â©ď¦ţIĚ;mNpŃ~-čeköś\Y R|żŽ­8oAKVˇ57ľî:ó9űűOB·Á™ř˛ˇ†łŞMĚ~Ľ?ş‹ ¶ů÷÷o1_!Gě ˘M˙ŽčSżúýJĄť|~ĄÎ˘=«ń?Ęó'C$;)8˙z\peŞZ8•…śb»ět Î®7ę ÎÄäŕ»—á­@ăE˘řXüFSłŰ~©_*ćžRTf0Ę3ń:‰I&˛RÝĘą»ßÉG ®ž@ ‰ţ¸čŢŘ˝^5Rm „™¸EÔEąŰi‚âę’JtlyÇö’lúôÎúĘ +T2ŻrŻđPn« ňJdÔ=‘6Ž‹°żÄ-)ř Ѩ)ęH}‡˝ĹÍ·Çř©{—͵$­V©šSB-T$Ňj­7’G3  Š>Hëçü5® ş­ť m&pş.[„ I.źN2ó1:š‚ľ­Çm˙?űˇ§ă_ý­CĄÝÜO(úřRÖjP3 ‘Šř:ýcü’ÄŃĘóa[€÷Ač(<ďt¸H2¶Ľz×CJ^ć~:MI%Hu Í!ÄFD“Öż2RĂIë­*¨Z!R’z­ó<ÓŘŮëüW{×4öe(\­¦ ±¸$&@s…^Ľ‹–˘E©!ôń­uyy Ę"őÍ&ćX•GŐ ©\ZśY¶óPEĐk¸óá.GŔ{‚íü˙Ś#ŕę§4Z-®Í7ě­c˛pŽAFPÔIˇÜÎC#m*Ďز .FF˝ăĂw¦pK´Ňç¶ôgţĂNś®Ô Ůëź@ÂS-A ]PTé+ë‹ŮĎj˛!—ĆIßW|3cLwáńę_Ăě»9|µ͇÷żIM˘‡§Bič*JĆo˘‹ýh y¬33ĄË×”ě:OęŹř&›Ź˛(=pa°o¤Nh‡°¦@Ż*„JşşU>0x´çÝÉí[ósTuLĺč[m‰"šżĎ)úo¬lĎ­OzG€ ©Őh3 ŘBü„&Ł ¤¤&¨e Ö:ťtTÝQ$Ë/ÍŢ>)»xöčŰ!Ó™{¦ć,©­ůWĐś„!f¬ĄđŢZ1Ť˙côűŽ0®äÄż‹§9C`ű4µ;ęw—™Š§rń*Su±Üb•ęŚruĐ›ąíű~}ř¶ĄËîţ?‰=ÝB”ĺn!Äę*kŮ‹[!‹Ć˘˙¨=ßyÄŃu”)Ăs^}c-I[™Méí÷»ˇ›Ž•¶(óe‡öeM\G3äšŰGÜ'iÉc” ŃĄ ކ–Šýj0Ďi°0 5úĘő,×Kww®ˇ˝hYôCpLŰžĆ úFF.«©’“«VĺˇĘP>Đ+·®(Öˇ©Ů>;ëw»ů^ůyçç‘Ř%)+Ż­}z5Ţ‹—UżAjRë‡ć Ď·¸™Ř‰Łî qÍvu@×WÝ©"Ľ&ŠŇ†Ľ>$š@[cčźc‚w‘u^Ć›n‹›jC ŤV‹ÁČlŰúóęź9W źms xFŘwD—áCר˙ë˙Yč§Ďe˝„7ŕ…x~ϸö’t}Ä·_`εŹ€—^Ť‚â§ńx– }ÚŃÝóô©Ý›˙äíé´®ŠĹç&â§ăÝqŘ᣿«PŞ4uŚ6PÔµ™čëő§đ üžőíŢoŢ{BlÍ«ĆRc‰¬Lš++‚r“Váč‰ŘČň„ŞŠňĘöl¸iţř·‰ Ô^fzMlÖ‚ą^·}×nhú`itrbĄÚż9ëďúýh¶ŔlŃ%đ=Jm:-gÜNĄýŻŠ9„…™úZŇŹő‰zş]A¶íÝ14ÎĐ·_éXSť×1—QÔáO´i˘)›9ଠ7jIË…2©*M¤sZ} ^tď3ÎlŃ€Y*oSô¸ŽĂ?séťm` „ĄÁč‰+_ÝŐˇĎ޲ϬÉfuĺ#¨é-çťţÓ ”&˘K~=•r(¦Ť ÝrqłˇY_^b2&؉Š dč !ÝŽaĐu±xôŢžMńmŽ>>ŇHzB /¶ü’O)ÍłűpĐÂçc}‹ÁVNŠ+đ˙ga{‰ť.§-D|<±śŘˇü Ůa:bZěpý‡d»Ň¦ď Ń ŮímCŁń}’ó÷vŮ«ěFň2 M„ŤřĚř·o›7ôO{LIń®‡Ţ5†f§2Ď‹ĹRgJôđúR™…®´":ĚţQQ”v:‘$2CÔšő%™ŐĹÜw~Ű©“o´ě&BĘÁIDIbśôĺ›hŢ÷_Ž M˛ˇÜ‘ü‹@_:2FÚ§ćŚę3d•şMű,r ßÚß}i  {ϱýżzżç$|śäx†Żtěů´ą§đż(PF }ë!yl~ÜöÇŤ·[˙7´]ěęp´Ő“÷› M÷h_Ďqď8˝ŕĎŽđ?Gô}Šö˘ÁţLŔóĎÄiEXŠ—˙"át®Ć& ŰDnp:l®[ŇłëTɸů/źŠ ťöź%ţďëöhv”Éí®#huÖä'>›ßîgßGĐčŰ(éO í˝ŻŇĄł‘Ţ SUcµˇP_PYVŢ\ě(†,ŘÂér83™{,tţ)ó»NßĆf!—™^đ‚[mWŐ<‡ ˛†B:e‹•új“’8U!ŘšŁDA!hµ”ôP^šú^0µ<ţŚř,1S=!R@lß%;t0 ô´Ö žĎ{š™ˇńKĐôQĺĎĽ´íéÚ‹ ´tyTŐ x\n&ŕÎČçč= JU/ÓeŔfz]hőÄ@l ßkq5=×ᱹhq Óh®¨ ‚¸ÝdäM bIw·Qx"ţ—2)hJBwÝ<ĺ=ť_ÂIúo6őŤX×â9´bj¶„T˛ŤXK ôJÎŞ01ř…ţČŁ;CRč°w“⵹ţŢÖ-[©Î‚"Ŕ´\;fnćx"d°¨ÖZő†CšM]> stream xś]OA Ľó ~€‚Ťib¸Ř‹›¦íĂA ‡ţľ€µizMfggw–ôĂe°&br N> bm¬ °ş-HŔĚƢšbedü°Rĺ"<"ý(üóĺ§Đ;żŠČýtnK«ŢMŇ)X˝„ťuUĹ;­9«ţ¤f7Lúg2ŇšňD/H´M”%%V,« xĄ˘)ËŹ5ůNN|Är l,o•Ř9­±đýÜ;ź]8˝Íu\Ýendstream endobj 531 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 457 >> stream xścd`ab`dd÷ńőM,É®ĚMĘĎ)¶Đ JM/ÍI,IIvw˙śüÓ‹µ›‡ą›‡eÝkˇďĚ‚ů_ 0032ň É$—¤egçőeć¦ć$–”d&§–ä000°00Ř10,clgě`ěd`ÚÓaŘÎđ†Qëűľ˙ĚVi ßËw2ţ,ůŢ'ş¨´»VîĎe¶ÚŇî’’…Ý3ĺ\f›ą°{‘<ß&a'†‰ß E»çÖOlě˙­zZâ»Ęé©ý3&vĎ“śŘą$CƬďÚ˝s:ĺwKVv×ÖôŐr4˛Ďú­ó[ôiÝ”Öîv h}uMĹŚÖ©íňßU|~«x7¶×µvWH¶ö­“ű®ú®ć·k{{Ë”’ĹÝËşűvΩý®-ńťÝzieo÷änÉąÓgĎ:…QÁáű˛˝˘+óç&7fŐwČýţăÖŐŮ^ÓÝ-Y·ŞiŇÄţţiäľ{˙°ęť0aZ÷4I?”ý”ŮÉřCj'30DŤ!ľý+€đí÷Ý~°Őv—.ZÔ˝p¦ÜŹßwłC|ß8uó„źBË7-dŰɵ“[Ž‹9\ź‡sy_ď„É=ű{&ôLăáa` Âüendstream endobj 532 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 508 >> stream xśUĚOH“qÇńßoĎăăă[6vXĹóСČĘ‚ŔF4ACŠQ;”ŃźCćčĎł)łÍ6ÝžőÝ|ćeY”;ÍBë˛K -ZDŢĘ›t ¤$–á÷Y?qÍcź÷ísxQÂ[Ą´ĺä©®ŕőîŢC{ş._Uzşo®źn`Ůj5Ţ6lüŚyeă|ËśŁĽ¬Ź?Đąs!N"‘&b% u‡đ$DJT˘|aŻYčW XY®LŃŮeĽöŤ3/â1WPHGľhd8î…0Ě+ü\ÂÜöá TÜŘضŔ¬±ł˝ýl19fĎBFOR…{))˙iîy ÄĘt›·őpGŔ/łěÜŕ ¤á¶Űt ö'_ č,âÁ"}W=ÂUűńŹËP`@Z]PBĎŕˇl® ŹžÂ¤ĚÎó“}pGZ]˘a)LČćŠ0a€!ŰkT{IX_čo$L}äp‰Ĺ]SG†ućBë%<čÜW@nĹMš–ś¨'µˇŘ~Łg¤Ŕî[;€5gŚ o™ő=s|?:˘žÓô˙qŚŐőYÔ\đ%†?r>t읏x7ťP“YU’Ë~´°-Ŕ^Ű~X+ŰśVS)HŠj6q|ń3Ň’ôúGţ7 M´+†éy‚˝F aĘşŘ,YůÓA[S>“­§Ťf2zŮf#ät?ć2endstream endobj 533 0 obj << /Filter /FlateDecode /Length 4713 >> stream xśŐ\ÍŹÉußŔ·±/1|°xs3Y¶»ľ«ÖQ{á8^ěÁv$‹Q‚pgf%®8C-I­<9řoĎďŐGwUw5É‘"ŮŐUő^˝Źßű¨ůnѵlŃŃżř˙ÍýU·xyőÝóż.â7÷‹ß<żúĺźX'đSë:ÇĎżą ď°şeś/Ś2­jńüţęşůӒ۶coŢ.»¶S°Î5Ůç»ĺJŮv†5˙şÎ}˝\qŤ™jv4F´ÎÚć7ácÇxóů«lô~s8b*úÁ2«m\C9‰—sOţóů ȲśnUkŤMĎoŻµ|ţíŐJJ¶X ü®5ýzÝĽ kKËť'ÁĎn¤Í>~sż„ů™ęňśnąr‹żą~™{ZC­\€}¦ó#U«ĄíÔbĹZ-°a?tómŞ‹cčZî4(Ɇ> #9“ĹHÖ*&¨ÎĆkçxó˘‰JBdË%g.úŞFnqZÎŽ(H#mą¤ÄAĘ‚€źT×- ¨łCµŚ™´·ëćĹŇdHÁ”ę©0Űk1?«jÁË*1ŘĎ0’·ÖrËâd¬şCÓ2eH•˛Éţ±NŻ˙Hůląbçălř¨đQăc¤j$ŕbéĎO˙ÂgäжĚ›“uŮ3eM;Í—¶Ő`Ů‚ńV»ŽűľHâ«ňČ5 \ÉVuĽ]qc]Xá?˘Z&Lm~<őě¦÷ô[ňBxŠÓ8=ÚŔ‘g¬Î5lTŕ#ţ÷‚v’yĆ™÷Uâkl]IŞY¬•ŕ¦5†LT×b)Ţ[“)F“±knŔ~'8ë,,1v ŢÜ/ń¦sRćy»>nľ÷O MšDšćMnpw_g&pťŮl7ÇMar~ßż}~őÇ«ŕhÔbÂÁ§Ńű&[©íBČ4=şżj$q1N;?_É­a>×rĚĆZF€Ů>­´•“ţ3úѱ˘8âŃ꬚»E6ňşŮÇPd«š\Qďy“*ďĂ·uţ…xż$żéxóßĆĎŬëcy˙ýRýŽaw›ÝC|IŮć›ĺ0j˝ÝzNIoň6i752`/47u2JT︪çDţCçTÖk%ÁíO\´J:†Ýä@`},pÁËÝţqi ą@‘>­ű ©Z#Y2<_‡Ň››Ş5‰Z}‘#KL˘ĆĎE­1܇iŐl73B›_w˛”ČbÔm†˝67ů“ă.M€Gë|™Ű‰pŁ3ü’:ňćĎ‘7ŕüŔxT¸±$8AřĎu}µš“çř’„ř5ÎqĽ€]vdâGŚ“ÍzB¸D&íxS+i]§“\­ľ÷řzXđŻĆ2áőx÷Mřě¤ńüeůőpđZäw,h©;×8ŔMa/¶ą˛4‡8;Ô0×»ţĐ0ŐXÓüÎ 4ą4¬÷ëű•çŃŠs×jőÄÚ@vˇĄšě˝n”çŹyŕż’nühƶ-łÄÜt4»·™´“´Äyp$|„ŻKĚŘ˝Yßćv5—Ő—ôŠń:TŐnű6“üű‡8łĐ‘›q#űôş!c`° ´O‚q,‰ŹÂ9׏îÎhV)¶tDŔ‰m˙âç—€˙¦6€wŚ,Łw]ÄI¦§®Ë:ďş2¢Ľ3Q üţ†ăKi~^§“*]Á\8y“‹ł÷$ĂłvąŇ ¤ëdóü”Ű[qŘiÍÄČşćr_Hí!´ŰŢfß?‚{•zvŘĹx—±ćőCţV”™lŢ=ÄW8dđ‡w#QËé?®ŢD$!ŇÍ.rŰp<čçAę|->\ŇOů8ű 8“ľ¨ćpÜŹ ţöqŢwűŰ9ÇRs aŘŮŘRM«ŚśÇ‰čÝ>a+ĂuV%ť¶‰6äÇ5ěŻ(‡Á#”3Ě˙¦«¬ŔÜšľČGžX?·.¨-×ełë’÷şp]i/Ťí(rK{ľ$˙qŻ tyĎ—vĄ÷V­@Ü(âdźÔ¤[蛄ŐSî0Bőë}Đî“4Lv_® Ţ1§ňuŻ!‡“Đmb|[ÉUÜĂgafY0 $ĆGw.€ßV’˘CńÂNŘ3Ő‘=ă°g)T€i˝_ť:`—ćíö¸yŘÝoÖŰ6ßÂd“v1(o Ż_ż7˝ľ~¸M_`óŇĽ0šŰÝËŐvóÚĎ®´nWdÎŮ-ëłt´.LŘm\Î&Ł-:§dóöáĆ/UM»!t•ş~yőü®“î±)BW|5˝ ‰‘fnA=‘ŕ'q»N…[ź„ýŔ:¨c†VҡŻ‚w„ZVË3 Ż>¬ˇ€P€E^F‚ďrżKJVť;ÓĽ pdąńżÚ4nꉉ{š„˝.PĘů°V+{*X˛€xŕmâQá<Âá”p`>Ąkü§´'©G–>¨'q1S§´K,şü۸š¤˛wr&ŹI0”G{ôÜĄÜÇČ—’ÂäČ—t.,Ŕ…°±Ă‚BÉ˙ĺ˘W¸é‘‹âp˝@v„€Î—Ś>JKa=ĺi~8/‘i;HĄ©Ëdlaa1š×ńŃjfoĹ) łę#ĄŮ´->*ôKÍOëÉ­Ü ^Ď垎úŰÝ/WŇÂĆ˝hę‘ÂpĘľśHĐVJEążÜgnŞ^A´Âv´ńl䯪ôHÄŁ6I}É*ŞÝő.řS:urÁŞTőy,T%YÖ2>ÎĽOŰ<ěI\ě„´ÓŔXŰ Š5KaűµYˇÇ¨üÉ1±WëBśľI>lcTĐŔ6RÔ’ĂŘafÓ1ź$cá>-»¨űŮlr)+NübŘżiĆV¬Đ°úÇ}4BÂ9JŁ:|’›.x_Býp—]ßđśµT_t‰ď6ĄŹü4Î`E?ł7gýĚ6qť&‡=Rv2Şýc !*Ă©ĹÉŞäÁrq^‡"Î ‡2.zíJJDpŘIµO®}ą j_UsK‹dĎh iy×[šŰq… š[˛+&/óŤfEĐńXŰ!^Ü]°Ă®•X{Á!Ý>ßm±Z€+ë:©ţćZ¬ÉĚ|IQ0ŘuQ”q&…-l}A…Fł›10]L©>¦Ú“],Łă҆"ëKą¨Ś_śwŮŔ%ˇKŔ ç%ËŠŔ·’âXD+pŰ-FŽR-§Ň—hŢ;›Ç #C­0©Dç´’špP4čG4ŕ¨íCyŢĂ}zî÷n¨ ÷ç>'ëcŐ¨I¦B¤Tâ=x€Đod^źŠŃÉ*`Ň i¶i.—P¦ŢzúĚŤR’EĘćÝŢ0lĄŮÇqS‚Ň2ug§D"…Ř%üQŞQ‹ć]Đ,ˇJąÝĽ|ĺ(§bQZř˘Łđî0T’/šéĹr¦“Š+ŕáŢîż«k©í¨WňB-e®”ô’/EŻČaČžý|F|Q!rŤÁŘÔ©đX~!zŐ}ďEI«yôjzÎý˙CŻE„ř$ôÚG#$2 á|ăË9ů ‘ŮyäéýS)`˙đfĽŤq§ëDÎgŇKҸAŘD˛¸‡™—®SľIBިpŕ űró:TŽ1 ‘Ýě–TÂa<ĹügÝ|íěČ*ĐP§e>`óđÍÝ><0˛ą{¸ łňęµ3U•?ßĺyňź™í™dR%éŚć]<©OôÓĂJEľ5µ®†ă´~gÍý.䤬Ňó;ÚŇx_sź4Ý;Ł­¤ĺA¸ďŘń_Ŕą"[\oň‹3ăŠ%§ż¤B.,śĐcüÍ!6Ď7’µŹnÇN‹(ˇjŘq—¶ç¦-†"TŠ×‡Çű˘ iw$Gě_S˘8©Ýţ~˝őbĐ×jC_ÁĺŐÚ…¤ŞŚö}—!ůç+Č"ôŽp—‡ăććLfpć0öÉĹ ixd¦BÜČ—¸¨LE|4\4éTŚđa=´qJ§˝]÷iů$‰LÍi.c/;ˇLe;ŔqĆ$ęÎ÷…Ť|Si™/đ&q=ÓŘ (cv ăö±Y…ť“Ć…XL›Ë.ű–-«©ôˇZ™@áçË•YÝü~ćń÷ÍŠŁŇg¦"5L7Źa-6ZGÚ#U>ôÉLž`–ĎFţjFćsŕQϱ2™®ÉÔ‘}ŮM·9zMg.&·+ÝlRÍ“:^§WS”ő-ĺ˙4´śý‘ž5ňŽîŐP7ťÇ<ó…n–ľ§®ČFcb¸őIťze‰–0ä‡)íU,)3}—PĂk‚苤o"$Čhŕn&u'}[C!U°˛ň:•.µćC.pÂá)ÍűÔÜi6+r˛ś˙ŤŮ<6ů·že[Š$÷íˇç’@Ł8Ţ´fH‰ĽiĚdţŢşńˇş!Ýüpą˘řČtz¸´92mŃŠH,ău‡A˘żyťj ŃEgŁ¨ÉcC!—TŚ-jÚţÁ%lŚäţgŇp}·aü^„©a˛g{şďCř«ěé›y~»škg°&ďˇČaŤ_^łŹ•«`BAvIU«éŽe¨+űëN¸˝ÁľşZQŞcP+o¸! Býí1’őu÷^„¬ Óy^V‘éGm&úă‡$ü;±ÄŃ…µő–ľvţÍŽ<Ő‹IŃ­zŠoý…¤ľM÷Lçť[Ú…°”ťúlµ®q˛F—'Ŕ|‹ĘYR=çĄű6űŁäYúÔw&Âż8¸3@Żő˙W=ŁĎZĺ›xVŮĐ÷Řî¨ď]{׏¬[Y*ęu–M]ę—<Ď&eę`ć” =«ÎĎÔőy»kđOCEşÉuŃČpŔö×c÷Ĺ î¤í8“7ôV%30˛r!ľ–žc»>F9éípĺ;‹—‡+ŠŢ﮺Ĺď®,‹x ÷”-Ĺ3Ó˙˛˝ú·ůËŮŠgŤNé2µ­ÄAą9\Φäj˘µ |ct}±­íb_ę5%{é…o]ŹrÍ«uL‡[cÎ2—?>Ľ}ófw8Ü‘!íDĽś47»‡Ű 9«ÍĂËřŘÂů>¤×ó‘~r×±pKŇ9©ü-ÉăÝđb¶›ănź_QH#_,Mg®ő…á“'šúžś˙ëE6.gDŰßcÉGĆţaŢlÚ»vČ|Ű|@DĂÔôgEĘ]H*)Pf˛ÜE /\ľ G-tTR·öUm[Ś4€îâ=V®.,Úpź¦™çµóˇ*ű{ ďÁxwŽń™IˇjX«ţ®»ż7Sá Ł{j}ěř‡Ú’KÖbP;"rř“"_Ő‰>ť^%’ó|E…âNĆbäOćŽučf© űPźŽ)z«|’öYUH)mMÁňG`‰ŕcŽ”Ň ünÓ,UúVđI-Młňť#.'łśŚČěúÉľ­I"G`ŘÇâMI,ĄŁĄ!Ţô˙ńęmDěĚendstream endobj 534 0 obj << /Filter /FlateDecode /Length 5667 >> stream xśí\KŹ$7rÖąˇ“aßöP·Í2ÔiľÖ€µ6ü€ďj0=2¶Ô­iĺŞzj¦Şf¤ŃŻwDĚ$™ĚŞę™‘W6sîl& Ćă‹óŐŠő|Ĺđ_ü˙îńŠ­®^]qzşŠ˙Ý=®>żąú‡Ż‡'˝gžŻnž_…Wř žZm{/őęćńŞ3ë›?ĂXÎd1±ŢX/ÜÜ_Ývż}˝f=ÓŇrć»Çµ€×ťŇ]ţt»9oÖÂŔ_´čľ]_K){¦x÷Ĺđ"ö=ţAôŢ«îËÝúZ¸žqă»űlĽ‹ż8îŚë¶‡8sÝĂń»đ›7˛źŰď|}ó´!]lČčž6Ô}µ°éŢ8ćÓ¦_fóoîhÓ w°y«¦„WłůLŠ÷‚‹q¦Ý>ě/l©ŕÇf»3”‡u-ąí Ěp-uďŚ óŢ>>Ćťz ÓuÇýp·ľVÚ§abä§rŔś‚‰ű7k­€ç–;ôëk“{o»ĎËÉŞ—âÄLtwůó]NţŻ˛źĎ0Ľ ˝r®śę[\ÂŢÖ–ňRŔhŕ4“ľ± TK›ŔĂŠ 7/â´ďľé‚ź Ë cT·ű&#ň¸rŇŠĺîó‰"Aoă<śwA¬źKá.,é…ěv‡âât®:ţCܤĆŰmҲʵä;ŚByá˛×Ę‹ŐÍW7Űm‡ď×I•Ň6¬%Ůaĺ„ésá'ÜĽŹ)y·ŹŹA»Ý1>w¨ĺ>QÖ‚VŰîYwŔuĽ3^"ëŕG [ ÍWÄ삡ýC˙ ‰úżÜ\ýţ*X1˝Ú?Őz ĹzÉÔĘ2×kě¶űí]zŮm‚i˛m  P ÁĎW결dołE»ĎĐ‚ĽßV$ç˝4˛ŘĘçűÍO™qé~*¤{[pô“xÜv˙Ľ Ç/t÷f8€†âŃ€L{Gˇf䚎”ţ«Bţ†űČ2‰łďĂ1eyďy~PÝłő§ŃîjV;ŕ®+NĘŤ 2.u4±Îä/éžsĹL4čĎşćĚ0­<Úáîă8ĆU˝·Ś†ž[0Ţ׼7ě ܤ¦śĚ{î!y {BťBŢwźFK^ŃŔÁ%źhŘ7§Ö°}8żoĎl–b7żI?‰î0<€DÁ6„ł©Ă}*°@čâDď¬Ă)aĄ˙n/ďµÖĚÁůfct~—Ďj{Ĺq«ůČŹšë‡ĎÉŔň˛ç؆\Łˇ‚›•‡Ă&’%Č´u4đŐh4@käęápŞćV?€zýëx|,]Ż, ‡Ő#°XzëńÉöę‹JXqg˛1#pR‡¶F‘~ÔÜë•S6I—¸m˛TYúQéţ´Ŕ!­ĚČď Ëş·ŕúdSXü\X,ŕ˛BXţ¦IŤé•5^Ç•>kRR«9·—¬,zÎ8L×SS ź6vTĹĎšó©Ţ)Çuo¨sJÚ4&ÉQu–¦7ĆŽFě˙SKĆńXTm^.ś …TĄŚżŹM‚óä—*—¶ĹşËĽőŁ˝\ćíDÚłő×aTŤłb;ô= jÂ`ČQS¨ö9dnŰ{€©ZŘ/XH}ú@Lmt>Č€ŐůůŚÝű »âcLYú Ć‘ĚăćÇäFa…‰jîz ¸nu ÁňÍĚBĹW+™nNCD/5 ÇÇÉz»Öšč‘Áj“Ô2+Áteş'+FZmDšlł`©¤fŕ\/Śł•P̬'nŻB5·…’2™á§ÇĆ©9YKËĎfęĆÓźL]I´Ť–·X¬ŇXáDŻ¤ŤU˝bQaLxIá±R^|ά(âůýîWŮ -Ť‚ EóV(ÂăSˇ”Ą đ>ŇáŃó|čžžĎ:Zč:”!ěvCăĹë/ Éq1FK´‹ôŃe: —7Ý.'ň8<?Uٱ2Ĺ06fYdsÇe›í6’ă\)a“…ěWeCi[ÎýcťŔ›´ ŘLŰIËzËfg)G•>ˇĐJ+ąĘĆn Ńnb˛XÎKćÉËJ*YX9fgM‰xtá˘búhM¶…Äh´Ö´ţ:>|˙mńëw0#ňŃ]ü‰‡üŚ¶!öŢ’ĐB€9îpwĆŤ­´±€ÁÇ\b°^X٧ʵ†¨päa;Ü}Űôď ® Ď!ý—Jd\wNDd ZU µm#0}jHüBî ™2!măĺĹxş 5­TDśÇá€ĎŻ[„áqčyxP§€fđś‚čOŁ§źďŠvąü=ŠěłN…©®:!Ś1Ö¨FĐ:Ä …U:_-ŃOÜŃ,©Ľ€†E@8B.)äšŔ;îŔ`EŻ’rąWĚĘ ¸„r›ú:+´äé黩rp pH­,u¬ýpí5˝-®»9RĺAĆş°2ísłŕ~#ßYÇ*[Ű ¶˛L ţCÂ)Rc\aşďŰľşř%÷ uů·ÍËB4żŞćă¦x}>W~s@€a4 ѵxTůT€4W?Ů’±Đ@gJ 'đf7ě'đúĺ©T\Ž9PÚ”hĺ ăCQěźŕ}ctŻrä»ÉÁ~ĘZő üýËl` !×QÖÄ娍•Dyô>Ăět ąĹR«tuěI«Ę""¸ś¤VPŢÇĺ@#ŃW"DË„ëf±`s/Ą.ĺd!h˙ŕ üĺd_•Ŕ7ł¤ÖBr“CäΩíűŕ…Ń@W(ŕ´)í†Äř‚ó ç:ú›…RŹ"^˛Óá™ę×uU +ČDÇŃ-2 &sŔZצ7”ł:®˝ÁęščŤ·Â6Ś[.Ś˘>ŹŁ‹şuŤ¤ń‚M;˝{˝ł9ľŢđět„ą#ŢöŞŔŰÝëñÉ>!{©dĹ=ÇąIşQĄ )%w‰Á7tČ…ÁR wóÄĆ×€Jół›cÔbĹ}—ůΦ+ó> Ł3Q¸qÍ <·€Ăć!Ćä`gu¤ÄĚŻĚTébŞę<‘®;&~„DH¬żĎě"XöߊôpBŃ>´#4PUą\žŠh¬ki~ľdU']uďţZ®ş¨\UJ]YrďĂxŚ8ŔÂg‹ŕ ÔY2LG!zŃŻŻ5cÔsôĹđ{ŬFˡ$Ř9!@ďďĐ˙†ţë}+ Ľ ă ČQ˝ËńÉîń1Ę~L ˝M EÍm‡Ś3čşgÍmÓL‘ÎgŠŘ×­ŘW†TŕdTlCsTÂé%„ąXś˛y\,‘¤+lšw0ĹžU©x”Ć´"ž&Ęŕhµ Â×sšÖÎăBČ+ĐŃ©1JÚ·ś–î Ée‘ţĽ ç^E•j÷4Yq‚«B~u/@\m/­7”}ě~·¤Şä8ÎőSĄćŹmč|uĽĚr •`ĹĺX¦‘»™4˘„°n›[ŘA3Ő•6Ss‚§8nĄpôĘŻŻ¤ń2>9݉P ĹŘAez“‚ —ŇS'_†ÎZ[Yőꔊz÷ňůřy%íýÎgŔłç“F~Řó™ĺ”čÁą`jŹ[ŐU–ôqě!˝™ôĢ áë2N­š ›v\yÖýçW¨gÁÔřĚő/zţ*ľO!OUv\Ę'sÔŃŻ-žž¬â‚ó‡—F>áđj¬hµä#<;6].iBĘJýŘŠ@lĎ©hUĎŰ ‚ŽrU‚Ó2);´‘Ń!Ż“:´)€-BóŮi¨Z^¨ĎËT(3Soňd"ËĘTlŔ–N–Xn,ř –ř€Pg¤Ďýé”äx1G›UÖĚqA°……*ţ->ĚÍČ/ĄAI@^8úÇ»ÔŮĄ}¶­ _WE#§Ú¦dä2)ˇ8´y3J-%8Ë…/‡o»[@€ dÇ×mĚOőđ'tCýăôףźć°X!Ť‚ĐŰźűýĆ'ÝtŲč¦aÎ^㜶ŤÉ„Ç˙•Ő_ §IVÁ]*ď\Qż\ô”kĎěâmUmÎS°±ńxEäl¶„’ł¤ţČŔ 8f«}|Ôä_qp‰}uŠŘ—'ćţ±ĹglĚ!|¦ŕ×óµŔ—Rs.0Ś8vi¨źzě~A¬4 ©w™µhz„+Ş»î0ü\'qňĄ'¨‘Üz‚–ş/:A±t‚†BĽ*BBő 'čäă3şdc:6‹f—Y6Šşj9ϸ_’!ťĐv ŚTr™ €3L_el(Çè W†čů}Ç3öĎ•TŞf3s˛˘dt §,ĺ%§Öě5Ö¦çL§rďłÎÔQšďąTîl1—úr”#T«ęę^ŁŮ%$­^‚´`vQVĎóô×}ÖkŔ4-2ͬ@D°kTC´žJY[ă=ća•v‘Ľđ&P["3=­NČ2Îd®BstŞű÷ç“Ŕ¶ýÖIe©ŕŐä¬çSµ¸L™ć»l9i$*5¶#cw šIĽŚ ?ú 5űŕNµ" źŐN-¦ŐŠ—Á `]_nł6ů­őĐT„ËéôEí¨1ř8ĘËÔ»‹y]Ü i;ŻDž¶ŁŻ-Í´ČŽŃýíki0˙[vWo7Ë=ÁŃ«`™iŰ»±ŹÉ¨Ęű$«MýÝX_Sí$1.s/ë’»Á}Zź­?‰ťg>htÍ“|óîv=ŢćizÓ ‰Pľ(Řf,‚©tIµľŔ0Ë)#–=ł,5o䓵Gž°kŁ¸ë€—¬"„›ÍĂč {1f7ĆéH h ۬光fq#f˘_Cgb»¤Č ô’Łv^Z–'P„–ËÓÍ׏ۼϺGŽ‚p˘@ľXc>î"´7!±e !8Q;÷6łsĘs‚ÄČQÄă°Ýě©T­‚޶ŹäBlŔ6żi’UyZUťŞŠTéZ,6Lńi®´'Ş:,ßÔýôÇĐżpÔńv–ŤçŘ·\˛Ń©¸\˛Iˢ@¶4‹2zmďšę¨{Ůja›zŮĆ2ö(lŔľ(š­Văµ7"RšňÝ4˘Ľ<[ĎD+€gF×%¬¦¶Â``hiúˇoKß›b©ý}żŚüŁ%)„®Đ›ÍřÉ2N1€ ÷BŰ© ţ0dZó.~µG:'Dl”d CY~hßhĎŔWFKŁÍIKű럦mlx(íâËěXj\»źŚÁ!Ľ3„K­¦–Rľ™|şP;“T®ČżË°đĺŽ_„’ÉqŁ`· 8ÇËÖ.ŤzľXßScÖrą;Éźn9}jI/Âĺ’7Ş„Ź'JzĽNš ťłnłIŕ µpkĹ”2Cţ°”(J¸ł'T/–P­´ó%żK~uvAMbĆ^L(f5‰—F†V}Čô†a&/G\^š$Á{Ĺ.ŞO,Ąfëĺ/™T·F‡Ë“Ú規m,_ß?†řż_â~‚>ĚÄfúŔŞÂb›ý&UrŚă%™Řf“=·Ŕt4ůů/Ăv8Ž-\îöńgî҇ůŔîÎ r‚Ű4\.ůŐ·cKŢ®NŔ‹ŢT_…¬nd=AąDx» hę1Ţj†dxGßM&ă!µŻŐ÷ććIť*ÍŹwtgÎąÔiţˇE”śË_HI†”[‚pŮ0LĎš†˙7b´*A!&×ŕŘ„©bň\~F4@ } ¨9ë |—}sd„2ó-¤±ÄU†fQl…$±%0Pa›…€6$EnĘÎ8y_9ůůĺ*%ĎZ#kĚ/¤áfą9LŠvgÓÜ9Źqţ˛o/É|č΂KĚ/úK‚ ŕ0gEü…v&ĽĚo©}Ď}š’f;úoURňˇş n»Ż×%†Pmş·0» …ŃůYÉź®ţ{Íf­ÎďĐŐw 0­®Ňa¶‘ĄÜŕ§M<%…Âď•xęřÝřáŮוĺՂҶ3›‰ĎíÔ>®9†Ä*~ŮCó'E{ř ~Ôy©±ôĎ‹Zę— Ž‘ňT±]Ź ćqŕůsÜ®ÖŮ…ˇ’@řłÖňl7Ŕ(‰Ŕ…ň{ŔpŮR‡*ë8]/˘,1ĆĂi\fŔć”1Io—°čĂ-é Ś*´Ť´GLăݧ%»:Óp xe¦ŞźÍżyf°¦ĘŻ’wƦE†Ž^Ń´—"×´)?.°n(gŚK12v>\QźKËĐWľKy)d% ‡ôŐ“Ëţđ@śçWoS;L¤ÄĹ e¤°xűUÎý”«0ľţČr,V` 7Nęuh I«ĄŮ‡hĐ?L^÷GZ_'ĚĽ%ôĚ6îŇ4Ü7¤Š’3)ˇdĺďŻţ3¶endstream endobj 535 0 obj << /Filter /FlateDecode /Length 5376 >> stream xś˝\Ý“#·qW•_\›<Ř®T*UΓ q2ř.–«UäX%ąlk«Rń^¨=ÝŠy”Ięnĺż>Ý `Ŕ`†äî%ŇĂqILhôÇŻ?0^t-[třř÷~wÓ-nţ|ĂčŰEřç~·ř÷Ű›ůŁeđMë:Ç·Żoü#lßeZ'ÔâvwÓŘĺí·0–u"Üu­6¸}us×|ňòk;% ë\ł[rxÜJŐ¤ßnקÍŰ%×đ‹âÍ×Ë•˘í$k>߼I†}‡?đÖ9Ů|±_®¸m;¦]ó*Ďâ–Ym›í1PęlónsúĆ˙ĺ´hŕsý™˙ąýŚ6¤˛ iŐvšů 5śŘt«mç⦿OčŻďiÓw°~đłéNrŮĎfRJ’µśńžŇţŕ÷ç·”ńc˝]z ůa­¸ëZˇôb%TkµötÂ.ťRÍ/3>ݧ?ťŽ‘¨N‰ă46®ęÍ~·yóŻd"Eó5T0ÜjŢÜ4˛…ÝÎE¤ńwł–Óś˛%=žđNG·N÷üĘď@‚îÓPP~Śš–‡—Ëđ°ŐÍW~Ľ˛˛©ńÂ˙±N…ôri2jZ~Â(X¸ÉżŻrÜ˙q:†GXł>ôŹó&Ýöţ8e r ä©“Ć!Ó€˝\+&š‡ž­vÚ÷D+‹Ő\knđŚV HH&Z%ĎĄNZî\”:˙ÍBZĄ˛%®O)·h#BÂ2ál^Ĺ&.Ć“Šš®r%^źÖm –Ká 6ÎŤX¬¸hĄ.mk$¨öŁW=ÉM'AÄ"ץt8} ý— ĐV.@MMG#4ĐPŮŇjˇś¤‘›02'&Z8#ůłH3[ľnAümPG”+‰kµ3ÜD%!‰(ĚSN”ŮVéÁňďI śTvđ¢†\¦«ü„ëŐý$¶g éEşh•đę źť€3ÄŹÖaĐşgÂâ –[„źÂ ĐÇ·KĄ`ł›őW©_ÄŤhŢn2"ďâŁ3ĆÜ+Ł†ŁÔň:mÄ9AsvhUĐ_ 9ăe†ńĺJâÚŹ÷‰ÖÁ±ôä!úTŐlOíŔ§f.Ľó>%ľ ű âŕ÷C[doŽ§Ă&=Ďđ1§@\usÚ,ĚeŔVqü^€cgŤ×üAŃu«™–~·˙EN\˘ěF¸7%RA)óý>f;É.őŃ´COYřCńłŘÉY`o)ósú!Ń–LŃeYśwĺź9¦?í·)SŹŰy#?+ů´RĂňK]L(ÇS ŕZ~ŃśžčP~Ü܇_@ó>ůü‹đ{úôš ë8h? LUZ;ď•Ă|~sűOwä¶A!>ĺVżŘ ťbú™7Ó:’ýő*P9řĘýí&u—©\¬·ŰÇ˝…ÄĎŠ‘…,Ý1,˘dş)°r@¸q×ĹY….$Ěag{O…I2]Í…dx>×ŇD/âÚĄG´`96tř˝,S6hřđhŮÉ “éľËŕO/)ﶩeĚNá!.ČŘ % Ĺçűä”™˝Ý®éŔSg—˙ ăÖĂ×S¶wó÷ąĹČD‰óń:]ÉzWř6Ň”ŘĂw-blôA¶ůt‰ŕŐ!3ă* É\ďR«†Ľâ\’˝Ę"’Ăi0Žh€‡N;ěż÷‡#Ť†‰zÓďĄÉ?%VĆLć§đ*7!q™č˝_©žŽěÜ㉀AĘĂZ,ŔX°â5 Ź—6ąÖ›t°ŃärrÖüHrô·7¸ń‘´Z®Ť ťjr¬ĺJ`}×üž˝á*—Sn•Žč˘¸¬nrť{{˙=`°˙\ňÍm·áGŘĎmş…k×ai+şlí°Ä>Ź'śiŕ¸Îč2@° ĺ«I ۬ĘŮŚń‡  Ţ:Ĺ‘€‡ŹyH„Ź\Î “\"ôO^NĆŁĄcCŇč=î1đäÂśÁ§(ôs `Q§•ß±w_őÎç}Č·şµ%ăżČ”%„¶ŰőĂ7ąţ=ńČĄĚ©÷.ťŇaDc é´Ď‘NĹĚKĄhp…üĂźňpP'Ş2›yéX—LśŘ×"}ń°?lţ2 L^ )«A řńţ\ťŕĂą ›î{R{Ľv„ăCLÄă  »qCţÄă‚m IJź¨ř·ă1E»»>€—•ť¤Më~»Ý/cbä]5źBîě(ípůŃůᯓť.›ňç4¤(-d@ĺóCńĺ‡Ő‡ţŕ_…‚lr>‡EkŕÓ9¬A<^Ä|¤ĘRŚ;JH®¸j9dűšżŠYNžĚ‹qźcr![‚ČhŕOŞÓš–ůĚi:ôź«™Sü(ĚűXź—Ń~Sbż®1Ć€ë ˇvŕLJăÉ`V‚Őć`Ľµ5DéŻëS*mśąp«š«úVŐh«]L¨6˙Xۨ¦5ŚŐŹVŤRήey×üërĹF)ú1}žNŔ»ÖJé&dÇ–˛Ă„Čdçď.ťßUůäPc»8ćeÓU)9:>çŚŰˇÝÚîłřé9ÁĚŇę1Áz†q€±„b:ĚΫ+”­fĚN˛ž gŔFT«¸‘ÚhT3ż‰ßľÎÁÚ„\bç5ľ¨Dő5´„ ¸ÉŔ»ĚnŻ·ľ$ęk¨Ł8;DťŢ˛kyC`&űť $hW”h žęĂďĂ/¶¨ř\“ć¬óK‚ł(Jż¨éŻj%UY0=^5×ß”ł°ŃqŃř ÁýŘokDEk­čő÷šśAk‘í~«Ę8ŕ~Í­#ä˘Ý5żÂ°äBľ¬*.ł`ܤ¨Ł*Š ›Žü›iĹUüýqR`¬ĆÉ\Jm ˛ĂM΂w“™ěJý«Řň ž¤$3ďy×|Ŕ­ÍĎë‚„Ň)»‹¶Ź6¸?i`’ÝŁţÓŘş•sÖŠ‹Ô eđ‹ş­Ă4ßEKń"ť.Ą.Ś¸ ç8µ”h!ň1~áŮzvÉRz;XYň”ě¤Kţ¬~"€Źßź^ng|źUµŐÂ',seKůů°V­Í2Ĺ1Ţ{ Wó@,P+ńüň~sĆ5AđnĺŕŹ˙›ž•đ°e5#Ą[°ř<€ !ÎÓ)9LŁçž°&Xí{J6±ĺ‡Ů÷CB?ĎĄfÝFy­Gř†–uZńŽß«qÍŤâ#UÇe¤^iyBOk†FÉŠ\|VUű*Éóůę)ŰÍi“{Őč{EŃ=0}`® ŤË ¶hCΩyy¨cT°ť*<Ń·Őc†ŹÜ© ŽÄcćILş˘ßOŤÓźőB_•09’3w•ČâĆ/ó«Qf/đ«= ®łFµ źĂ:}bUäZrä3^ď‡CÎ<pV¸CĚk¸2én%çő¸kĆcPÔ7ĂęŽĐfbźČpt– t0= XnÁ|«Ž[L8»a䟪ü.qe"—&8É[4 Ű*Łw™ĺ'˘7람ފ%šV5„oÁ~P_gŮĚćŞ ,&eĘt€ÓˇqÚqNˇźv6ĄŇަzfśO)ôĽÍ(Ś6JÉjpibńpĽA“˝xwÓ-~s#U (e»áŔ‹hŐł˝ůr2Ă]DHq 6y°h,Ą¸Y[.<ŹŞő“šü ±ŘĘAű;ĺőő¦<Ă $Q€;PĽćütčÓ+  üCa5 ŹÄógÖŞ.şpžť.őž%DV¦pp2-EXlN†éÓ8-Uf›ĽÍu®@NŔë ňĺ"ČZ^U@`ÖëR”XkEĎŚ?ŐS" +Ń™M'Š©ÄQaí?vL7ÇÓzÜWň‡Wá-óLîaG5 ÝQmäLÓYŇ’’·8}Tď2ŁÔJwüÓęŽ) ąqĎ“‰ëĽeÔ}ëgăž*bŤuÖÄŽž5¬Ę$¬™ĄÜ9 KłĐ{Ĺ%Čł M*Ý{h}?n… ő¬ŽQ#đë‰Qi_CŢ^žÂ=š˘µĄo¦ńhřT_đ1NŹ…+¸Ĺ|Ö¦›źU#@ŢA\UőVąl`.ˇd u4oŮŽ·ˇž'ś×Şfź¬a$ř´´µJ„A†iŞDtŐ†áĎ©¬FC‚=ÝΆ P!Ł4™ű)kĎsöâŚÔyL3äöp9sŽÁŔ"MIMÎ-{2Ş©'ťÓˇŃ®Wp»1ţ¸ę·Ţ€Ťž•P8ŘD)˘S¶¦ÚAż’Ř‚ŹI·¤yÂqÁGŐ§N?®;Ü4ĐżCUXe/Áâ4ÇŔŽ_¦Ó%Í;ިR‰_5ż#ëžw\D]źęâ®t’_ąZ–ÎŻ”˝ĆjzŮ€©®ĺuYqp^Ç®¤âu |]\Î,˝`1Ř”/&Ô$°«;stŘĺ0Ą3Ó¦E Oęü¡ťäó˝‰I—Q6M­Ç8+ cŰčí“:_Ű/Z8.©íĎR‘Ľ¤’†>·”Ę©”ŞB©ë˙1íĄTgĚeiÇ÷ZKĄţěËj©ög_TL%v\RLŤÜxB5•+˛_0°űđ–NąłËúožP:ĺř&l´˘ĺŔ»łĄSĘc_‚`Ó‚ű¦ZeµŕéĐ+łÚ{ü§VYűN‡”>g>l:ŰĹŕ°P ÔÁ);4P—U P[ç+˛*ô±Ç‘WTd‹J+<½ŽëiÝâŔł’‡ÖůÁutzÉ#Ú—”doq#O(¬Á»ş<ZĂ';”Fçh5nBlqžĘÉDbÖ[,V JÎßK‰XáĹ‚í_Ľ‘™öŔ˘ol.řľŚŤJf¶ë—/PľŃ¤†ęęňB š c{4qch˘Î…<Ř˙{ÖvSTéŚÖuöTBÇ3ö\UNŔ!°zC ™öwŽSNY©ş|KĦ‡wÍÁżÉc·YŽióöëjĎ-a©tôf‹¬ń6 ëĹŘG‡ů=Íü“·ĺýşßҢ‹7•ěvľÜá]´â&Ýw᧞QD­˘/–+IŹąĆÓÍ)dĘ1_¸Ý?„ż uŮRŞq˙ŕGäAÇ*ü×[y•~/ÍĚ[×|^CěřM¶˘Ŕ¸®| \ńöcx™…¬ŮOLN7Z‘“i¤3y}łöŠ“·÷©ĺĚîX†BČ™~ É°őMµ´LuUHf©”5Đo2–¦o+żôI9(ÓgYyé®Rëqă ľśHç Ęń´ÉfK~ţMĄGx=Q`Űľ„Đűńĺ2°zD ë¦^¤€25Â$íŁł‘iń:O‚xú»řáŐŽ’xŻQ  ˝xŮűşSLJHBDć/#Šň,mńBŠâPßö]W9~\Z\¬ďŞk_Íąť.{¬°Ąąŕ~'ÔÎém-ńű™N+Úó˘/‘Q|Ú6üŃń& NxýW“Ż?ŠDAšü-jNÖr|ő_1h‡÷›©ň5ŹĹbW•÷µeŹrÝ«Űm°, ¸0i,’č=¤­v‰7–Ë{廉\Ş@WŐ'_?őMí3gĹ]ß˝vYŁü· |HÓŹ^8Ř íq3YŚ!÷OjŰ‘ŞĄĚqĂ™ĚI•/FµĆčÉÜ˨aŻSŞÇĄ#ňë1ąAËd"u›ůűzî¸đĆß{fjoýëf«ëŚÉ–±"i^Ľ–‘đlĆŐQŹćg…ćWŢ •šĺľ ű‡›˙ŽŇčŰendstream endobj 536 0 obj << /Filter /FlateDecode /Length 5265 >> stream xś˝\IŹ#Éu–Że  m„}¤0LÇľŚ0,Ă‹:Xš|¨ń]U]ŲŮM˛7üŰýŢ‹dDd$—’,ôˇYÉČXŢú˝%ř~Ćz>cř/ţżąał§›÷7śžÎâ÷›ŮonoţůśIxÔ{ćůěöÍMx‡Ď„4=bfµí˝ÔłŰÍÍ]÷‡ąp=ăLtć¬gZZÎ|÷6űü8_H©zfy÷źË|ĐëůB‰ën‹cdďťë~>2.ş}ÎFďVűL…wĆĹ5´WđŇ~ę›˙ąýäx~átď¬3Ý>Üt~~űăÍB)>[Hxn >˝ëamĺ„Gđđ§QÝzűYÝÇ'p¨‡l“«=îĂ{&Ľî»9ď“Vt«×Ů 4FJ!lwXmßÂTÎ÷^©.?ďrź;ŐmŠă-3ę†óqÍ † «–á€wÝßápeĽ·-jŔG8ŁMóÉáha FvűCý žÁZ&»ĺnŽg–F zĂă7ľ K±˙Ź«%űĚ!8H›7i_ŻćČ8î~ VtßÎă«ÎŻşŢ f®÷Ü{Al~‡lţ·Ű›ß#äěiŁzifź@ţăF1a{3ł’‹žąŮ8Ńs=Đći'­Ł•´:'ÎߦI‹š^8NÜáóÁX đ‰ ›dđ´™ö$kPr%<¶ÇL/0 VWhhÓŮ”űs¬ű6¬ý°ző¸›k´¤NwŹoďéł®{ÜĎ[>T«öYsđ” ’G»UîkťźĄµ-ĺ{Ĺ]š5ěČYI'joÍfoĬ¦5% sX}$MtRU´ţi ¶mű&JęŇ0-Ń[(âDĺ-r…?šÄđ`dŹ_őń¬ j`jĽÖ‚Î hŃÚďnny׉^ëÔŚ0řţ°űpř°{Déí.âMaĘäë.×í Ă˘/É•ä‰/Ď3o&Kţ/KĎA‹ŮácFŽt’T°“X ĄŠbňşL»•Np§ńEŽçC–Ĺn€Š †·ŃŔľ ÉWPJNĘJ҆dJäw•`ěÓl÷iuç[Jţ8śRąŮBÎcö —´äçą”BÔKt‡\‚sˇBťHřZđTqŇďZĄf>„1Wń뉤sÔa‘ŤloÓ^Âń ÷ú*‹Ýăd,‡ĎĄ´- m { ôŐľ‘+\qĄgc«DĎE÷]ék·yĘoŐ¨”äô`*rVa–„ŕ[:?™ˇÉ‘P^°É#nśů±Pš´Yćî'˙ˇIzF CXĚFiŔŐÄí‹ńPs‡Nő6ńŻ-¦WÖxťEHĘZÂO·c~t–€¬€Î6ć~t<ŢnYx•*ŇǧtÄžÁ˙ś«"<ÄwĆäµAŤIâ ĺnˇCâć§yT©ŐdU¤‚ěŁŕ˝ř:m®N]­ŃŢEŘF»;‘ Í·ş-Ĺőˇ„3ušQB4ć31ú?Ż^Żëj§ŞČá9f!!Ü{Ü?oóaí”$¸ŕw"7Z˘…˛WBU…‚h˝‚č–-{”ň‘$"²/ŃOcŘĽü©€3Omgâ%lŘň3Ö˘d!Bŕä± "([Đu”"éŐaąľÄň92÷9`¸g€ÚxŤ„Ţp#˙’Š[ရöq«¬ ë%“ŐqkOÇz…Ą€xŢoaK°<Ú*Óä9x2ćŹđ:•Ąđ*…ŘbĽĄe3E 5šI=¸DMťr‰¤zšŤ+q¸3_A«łą,Ć)“,‘wb\aÇçßö_6›Â¨ CűWšő_8Ţ;„*ef䇮Á—2rÁٶâ\ú*đľÂw”fNňôřţĂęHqhúCůÜËĘf•‹ËEZ‡Gk•ŘuĎVY%,ÝH¦V†˛Ş<ć`î~˝iš[¬µXȰˇńŔĂî0o-¨ĐR%A ¬Z4Ď{SÚć9µŃ, iiÚĽ…pÔç€=Z"bÎl`˙Ľ´*!ě@Ý[BżˇfůĎh–đşÄq<Ev8\eU"l`~6SBŃČŚ}'Âd H+lä˙88ÎĄ„˝˝B&ĐŢř|áyČ›ĐGIŮŚúiú8$~PIBDĚšăSyü¨âQË‹ŤSv&ŔŽ'ęţS3OŽÎ’!#˛ĂţŞYáŕ´µ•ÝńJ;VMî@UWVz¦»¤5mÓş¨ąśâ8oˇyh·8ΠĄ&:‚Łř %ěƆj» Őö‘źqNÍ8ÄÂÜăĆ#ܦŹ’‰I†V¬ľ}Ő ›ďŤa‰l?›?•2…±¦±6X€Ť‘Îň źXp°,wĂAŮń˙´*«eµć…Ő˝a@ciÓÉŔ Y3ĂVĚĐRUÜŹµOÜTo4•ňpŞoš!¬„čěYa>Ť”Ndcwš*×} °G¨ %ěCćŇ)ĄĚđłÎśf‚áÁiz1é4/Ă޸!ĐŹÎî0YpO».e Ô®K4íz°ąY÷!ułÚÇĎ űmE…üÍ° PĆřšÎ#«šTŃý]BŠ$+ÖtŚ ­ç©"@ {q*ĽŽhWbËĂ8j€ŔDa,o#őĂ>7uvăP%Éű!˝J8H­ ÎĄFUö”^…«¬»b=Ť˕04.ĺE7-ěir‚×”F0Ŕ–uč ŐÚ@śˇ%®4ôW>ÄÓŚĽ ]'AŃĺČ/TvVô– źáyMĺ – ‰çUoó ďö©ާT›xÉĂÎĂ9dóŤťTµh‰ý5ŇčőÄwÜďËZ-ľ™H6főˇ[8z©x߀”Ĺo»_ÓstU—ů_Xű,@âtş Ki Źfßťő“ĄŰj@Ş‹ścbęËÝă)źhXĎa¦‹Đ%>/D_öřŠ@ůĺŕË\Áý˙7řUa®Ť´áň-L‹C, \•Ô±UŻŢW¦µ$BÇTű PR }Ś@és'Ŕ< më¶ÎËcł*ó‰ËQźX%ŠN„&µ,űmÜ™¸™Á–-×U›shzY›óe}šiAS9ÔÔř¬%ř},uÆRŰÁ—ýq›eV 7lUŐ““yóF˝·JŇ ÝŘ„i‹|ˇ m\9Av«€EŕŻq»ÎĐg~ŤWĂ ÚĐ4Ý0=Ő`#ÂóËŞÎ&öć+Žf§Ba© ’ŠÇ”@m$ $¦ÍRľ ¤1Y9ÝĐß:ązŘęTzD€‰á©Oń®(Úmž çČ’‚†±Ps˘7Eo˛~Ď˙šKęÔs$ąTN°ˇżăÝˢ2öňnwXyßkęöÚĆ/ąęöń=€–Ë·Cëh÷v»YĄ—şÇWˇ‰ôńţp]éČ20ÔyS¦ďË[ ´2Ôĺ\€—W-AŹ=¨eM¤ň÷§vˇäß]Ö*»˛2¶Š ç‹VńŇl{0’ŘUŽ•†”ëůßfĹt!zv롱{lş/w`Á­[űG-çy˙h]Ň7´l6đ®aŠĹ”eTA ˛•ć–§•Ńaá¨ůŕĺz‡Őde­>·î¸Ąu¶Ç=’’âd˘Q3eÔR.ţTµÇ¤ŮPŃęŢžC\Ć‹líÔwŔ0|Ś2iŹ@ŞS`˘Í/^Y¶™ž˝ÓaŁMŢéČă?ůNČy™6Ć‚c*ÎÇD˙ýĹ‹ Ďi„mô yęŇ-ĂŹ§*‰\‘žşŻ 6•=zµ}ś¸‹…c ĺ ĂTĆ6HÜ&đt˘źď!n^»XŤfŁ»C_âŢüEŤ#ŕúz•ѦZB”ĆmŃ„›z˛ë3Ż®r6Ě$íßµE··îŹoŚŤŇĘzż nVx”Q¶_˝ě#~EÖ€J)eëVËXL”Âp6¬´8E¸ňŤĎeafl,h’ 4v#k!tާĘÚ¬§6üT¸řyKM÷‚EŰm¤ÇCM[®Qä±oÓűȦO¤+6ńmP’Ă6˝ŕ¦­ZÄXZL—âAť·=j•>}oŞq{!Š8çÂ1]s™ _«›·˝Fl@wś[Íoš®~ˇ¤ĹţwĘ2ËdáěK9 8Ś’yéí'†Ó-Â,"^ýŘÜ„ďFa(› ˝čBÁź•ž§!Ü Tzžőş9M]ú߶u‹ŁŤ¶—ŞÖék5°K…·eň‘?k’ ?űöţ‚dş9rŻŻEŽ‰ęk‰ŕvlQ» ©wďRś® ׆Ń÷îXµ›tŠfřľ:<ǵ®3Ńá)Çm rěNď™C…y6m$fĂomşh´Ř—đ­ ÖxvI“++Í€Ea<^eÎŐiľŞQřlOo|K§*4—§2‰@˘öm~ 6Żç>čĎ⯌s-[1í=<€C “łÁ_;íϵVf?›Sť ¬¨ÓvđL“·¶ *tµ Ř?ů“’ŠhĄ]):ŇËĘ ÇÓśş¶đĂWLńÚ_}ß-ĘÄ©ÔqĆÓŻů\ĘMŮ°7G˝ßvHÂo&P4ťąr>ą‘/ŁĚHtëÝuDĎŚy‹čC•áx…»B&ë§ů«‰ľ¬üâů€Ăő‡óúGŐšŰëěw$Ú˘đ1ámQ“ɬźµ•Řaë,v|ě°MŞôŰqmf”Möc(¸Lfĺ°B–ýö~śBâáÝ9gŻ›Ł/¤ŮÜŘňŕ#Gľo&XuÖĆiŻň…> stream xśµ\ĎŹ·rÎYČ!/Ţĺ˝ !@zMżćoŇ‚IŘ°Ťé˝ż¦…IśçÇŇťärˤIÖrĆYěi8řŐůeŇčw—ľ‡|Ż6‚ĂŠ­¸ŘŐZ­}?? # -a&ť‰«—–;Z˝äţŮô?%ŹAt Ä‹›p Źťŕ ¤xŹÓwš Ţ\ĎO§žy3ĽńÝ9Áš>ýusvßůéŕöýÇoĆŰCeaĽa¶Ä6w‡ţćjŘU×Ďn7ťN¦]~·˝żMşM‡‡öę»dš‡ŰÝÜ1ĽťĚ3t§:úf~[’i9ŰÇýíńŘßá6®`ű ¸W%ĘeçčŞ`(&L_ŤD8D,˘ňpęjôB +ŽÓŹ’ăźšĐOˇÉ@ ¦PO8ů›ÉŃ»”Ôšk(0Ă>öáR'RĆXÚ7NÁ쟢;ǡr:`|HČ—Cô’ĐYî…˛ůEČ\ĐíĺFRȨâ~Ë‘ëOjŻű,,Ł"ńÔá"Ľ{¶ÚÇ-AyÜľßxLŁ»VčŽĆ Ü"¬Ďű[]W„˙4‚OÖĽnކ_ŞsµÍń޶I“`¨?őŚ°w{ Ł¸ xÄ6Z»v—GîŹĹ{Ř·R0ąÔ§ŃDç^6?ö©®ĄÓ8Îr+Ř€#¨dĺŠ\ „Éy•ěµ}\Ôë*qĚNŃa‚îLeČĂp„á<Rź‚–8×rÄ&ą—ś˘)ÉM'??ä…SćH]¨ŽH y˙ĺ3B^Ď”1iŻš—ČÖ`03Y oÄĘĐ°ŞÁ’·VĄ örĆUŚ¦Z ]ôÝÂäÔé»–Y± Ç0Ő“›iTŤ;? űĚ®®§C2ŕQVĆM§‘h=a)~Ä>röQ­&ŇÂĽuO’Îë‚îůäűEb§({®FG SwŢĆm„±…AěE§@BAX†k–*Šyń_Ž8$óé/Ýá8 ŁšwKç\ Ź±_ť3q}˘+Ĺší}.đZŚd|¨Fł]ZR\†[ßZB:f˝îÓ<Ä.NŞÔß0©č§qőžwKĎ$šL2‰ó™<\7|•YÁtf&útG·NŕBbN âj˙ȹϹĚ/ˇ®ťŁ#QKŕDŬ˝Í­ŰÝrW4YŮŮCżŰ¤łLaÄ!đlJ«fŔ FôÖ ž5ď˙脧ćC–»đ¨€“~Ö Xb˛-€{>yźĚ´(:ĺ^M¬`G([ EÇ8ťzžÚąÁFŇS=CxˇcůÁ‰ŹĹ2ů î§3f>)ěTF9öŁ†žĽ¶Ĺž`•qŘÓ—Z+‰Ô'ľŽ™Ć´¸ąŘŻ{RîظLŁ•€3ĄdVí}fDŢĚ‹¨ĹgpŔ`Ź˘ĎL<#™ßš0şŐp´%7!Ś4?l‹Ě}ˇßa‡U @üsđO߇1C€÷}É{“Ľáŕć.Ě÷Ôµ(&!héZ Ę)C%ý­Jąw<Ü K ÎÝgkÉ{útóŔFŚ«Ěd‰+ŻJ”GfŹŞRšÁÎU‰a‚›ł{ŞéÇăâő‚˘ć­ä˘{}IvKY¶2R,ú)Šm!`Ź^ 'Ş*ĆÚ¸–qÍVĺ-—ÚĄ#EŢŞ6?Ą´—<ćía›Bv­ Ä7p´ŘáHˇ#l0ĘëćC}éMźářߧ–ř=ýť*2–ť b™g“ö=YĎ!ÓŰK¤ęߦtVL­ćÄx@AřşĎe'WHĚWąě ˘Č“¤2ĄăsUť!C{dĚSluŘ‘¬0Xŕ`ž¨‚ҵÂD¬’ňfuBŰ$Ą9âPÉ°:Šfab_(qاÔáçr D\ŕ´ˇRq`m #3SźîW©O4Ńť¬çśfÁ&±tŕŤ™Ŕ=wľ»Őî 86ôëT“Ú9őÁDSŽq0 «N’«°]Ů30ý†E?á3ő°Áh=[‚tŕô÷n›a–IŢýuZŇ5Ź^¨·>ŹŠ’Ĺz†'ˇuŻ„WSĐ˝ŕŇŞy?=ů<Ťg4 uŤŤ:ŤGJi×h–{čµŕ e€vŮ(ňu ŹŞ×lĹrřrQĽpĐfÓ Ö ěHąâpŢáŮ14t”0ŤYů‡bŔbĺ3ˉЗ˙eDfSx6(/Y˛ű>«ľ:ń„¬q‘‰CÔţŹKÖ wSýaH“MÉ3bÉ“$ď•dĂ|~+Iú`«Š e‡©ž”—ä#r;$/¬řFKŽC‚_čŚČ«Hć~–U~8ą_·TDIdŞ×ú­jÝcI«Ş2ń YˇÖř)ź!N*Ż3¶Ä{?ü’Ř ĎÝpŘf mRßĚ‘*dť%¨\25Xd÷ ¦F)8Řsb+Ţ©@‰•ű"0uÝÍEXŕÇiß;ž{ĺô´±śÎ«K‹•YčGţëą5¨AĹÁĺKĺMşüáDËąHű{…ő ZúűE=ĂBUlz öEňÎÓč}ř Î#­î)őżG@ ý.^¸ęŹÁ… ÉŇŠĂv_ĐŁtc ń8¶jR ë1 ă$§ł¤ľˇĎOÇ@ĄÂNQ̸ŠX ¦s˙Rolé©č9t–ŞÝv¬¦řj ‰ć)©Q ý†qá>hdíč58……źŕŁżŽ©ćor?×c2Ő7c§§ů»y™%MćGdŤŞŹ¸ćAd}Cţî’aÎ ’aŮčÎ/›¤€fšaŠ TLŽ‡Ě$öcŤ30č–=°Ä(ď15ˇ2‡‰”¬Ż}¬˙¶EM9„ZĹɢĘ,m–ܢđ>a5°čóD=ş ?ť“÷k¨[îÎą@DBŔ D•"bocr]Á—ËŰ‹T`%(P™Íl:®ŐĘŻĘĘ=MVČ©ĺTÄXËç)»YOĆŕÎE’ąČö´Đ"\‘Ĺ©3N˛˝.ŢĆR ‹{eľ#Áńç2űŽIŠ¸“‹ aěüV‚ö!ű©5îä|G{wńaµ"*.a)žÎRĆJŮßž2ŠÚW\BUŔE&Ç0ů.w['Iš“­€hę ¬`N«„Ś©â«#śş¸‚ęÍ˝©řˇ/o¨aK…TŐüü.Ó&JMëôF[ŘęüHwµÔ‚Ó¬PśČs9WEšeJ—Ţ@J¦ĚßCĐyFiÖ·a‘R\Ăjď§ěUçY5Ϣë4ŕËgŻr€7dJÚ€…s43{ĎĐMŁyŢĺÁ™p|v±ą$Ń^`@̨>ëÄ*ő¬BzNµŐkĹŢ6jGęíůuÓńc8ţ!ä!˛»Ńą[‚HŁVÍĚN—¨©gćÁľv”đ‚půĹŞ Q°±‚~|đ8S úňnM ש"Ş6TµĆnµ¦ÚSšS ú!'+±űBĹ uĽ$4±'Y8®ü6rn‚\(.ĂŐ){ľë o/PR†Zi»ł-žÜ¤g@ AŽ{™”ËĽ)Rrš'y†äŽüˇtQó?pKĐ`•Ę;ňrbżť…e=‡(˝X‰ĺ«XńY;üťÁ馠÷âߤş»Ĺ\Ýđ f>äÓµY\ďĘU[A˙sšľĘP,^çqUö V'ÖŻód*T|qM®˛ç}qb·üâ„ zvţ™ľPQ…=©ŐýűűKK§BeÄé/#aŤ±’h=Wë°î¶áłđ¬Č!Îß”Ô4Rëů€ć?ŞŮV1ÇäăM·1ţ+ö#/@v¦ Ĺ}°:‡IIĽ˝oü'¶±Ą-ęaĺň"můwŐaÁ[(6ô˝«Î_µŚÍY9ş“{ę+(żěHŃ-Ţň,ć˙˙¶¶č•w&_Í»•ŐŘ+ŻÓ–U_ ýŚRüëĐFÚLŠ Âw–ŹËŞë–x#]çRŚ»':[îžńc'ă-ÎĘ’ă… ř‡3ťo`6´h…íŕQÚÄ^—Žžr¦'Ĺňd©đU©pä‡Î“ źŇľxĂŻżk‚Á˘|ÇV4»*lôËęŞ)O鉔†YéV·ĆÚůł"_Ď Îę >ŔéůŁ)//7 oW@ üţT䬿*žúź/ç÷řŰ?݇O¶z*Ó?wf°—ź9ło§ŮŘ‚ö4Z–Ú–Ď8Ó6V˝U€ÝXuRW8UŻB¬ó á ěn§/Đq(ĐZLJ“Htr“U‘ SĐO8ŕěĎ4 ±ĺ3 €lÎ4 ±eÔţ\Ä®ůúXJ1Ž}ŃKĂŞ÷­Ąiy¦véőŽ"ÔŞJÜaa`,ŔY•¸vô)’ł$.řąźĽčő°»©{vžhčyň;YY:?Ľ’iÓ6FWCĎZ;ÇŻfť·řŮÜ~čűßşú˘Ę«0¶‹rÄÓ‚€ (>Y'Ď$1ˇ˛3OěóqÇ3Ťľ®:L>~ôŞTK“ox¦+Ż#-«†<ĄS°8ő ců(<šOĺ@ ěÇ9@`ÚŹűˇî7X+§/t¬ČÖ€3dg~«<•¬í¦ë{_bíÁ"ť±ôÉ"}ş=Ö—n áŹI6áĘE`‘ŕ’ ˇüł¬’ Őëvá•Žů(!ůUÜůŞ0ë„9v¦ý§~¨ł˛H¸F_M;;:¤´© Żú:·í ™îDł{HR~Ç‘ľŤ‡<’šî& Bk,™Róçí]9ńěđ}^âUá‰e°Ĺ’·Ňh_đ‰WĹ`«MÖ]řž^3ĹÇ‹˛Ď Č0ă9ýdţË(á©ĺgjË··ĹgŇ|—TŔVÖÄŕser¶cńUKJťťä¨ŁNg9ôínëó'NęćľÎ){ç‹Ö:údÜc˛,,‡‡sýŃ=ĺĐ`ţ%¦ g U˙R$‘S{źÖGbü‰Ë~„ó[ ýŞ=˘;zčň憯Ľű_v\K.¬ß[_˙>av ’ăj" y Eě0‘iTze"Ź…ߦžqwzşBk{úýi~Ţ -źfĆýäI¦˙/ě™ućůňŻćoŘxţĽJ]1ć®GÔ˙™şŤßş8ď`¬2čH]ÖĂ˝Ž#N[~ÝčU•—Acňť8‚‹yöj–wÔendstream endobj 538 0 obj << /Filter /FlateDecode /Length 6187 >> stream xśĺ]K“·‘ŢóüŤ}sÍš]Ć(Ë:XŠőJZGžLJÖp8,©{šęnrDüŰ73T(TwghoƬéBá™Ď/3ˇź¬ĺ †˙…o6lqwńó§_áź›Íâë«‹ß˝äLÂOmÇ:ľ¸zsáżá !MË…XXmŰNęĹŐćâUóňR¸–q&š÷—¬eZZÎşć>yľ˝\J©Zfyóí*môĂĺRč‰ëf‹mdŰ9×|íÍ7o“Ö»~€®đÇťqa Ý)řh?÷ćoW˙ r<]ŹpşuÖÁš®^_4J_^ým¬^pŐJe¶Y*%[Í»ĹRBcc°é«ćŹŘ±Ô’ó®iažVµ]'ŕg˙¨Mł»˝{ż^íúżßľĆuóçۇĂö~ů’ćgŚ+›Ő»·{š"‡Ĺ©f{»ęšŐún»ëo7ń'Ő<Ŕźń/ŰЇĘŐąćpűn|ńvµţ@„—ýýÝeuő¸,®K 4¬ó+»ň[­śčü‰uř§…őřŤí$lns÷>iEËL·=kŠËwě oţü2<;3¬/9ŘM|«š~ź´ĽŹ=4}~đ»Őˇ‡ď;XW͇K$˘ÎŮaÚĘ4›ěl8 5a[Ć`qŽŇćMV‡ĐsÍ»”ý·0~;ţžőM±#~FĐg«‹´j„1Â6?żĎYĄ¤â´×đÉp<˛Ůľ Ý*žĽ?ô›Uľmű@Ľcw¨ţű‹fqůl ÜVi˝w­±¦Ó ŕNí:G%Őwž´ŃŬöěútj‡}čĚąŚfé~{)áś8ň­ÍTlÓŻö ›ČmĆtó§K+»í&tŁ˛ ž±ÝgĚŕ˝39©äGd ­ăńěHZă"Ë­©đä ˘`aĐłĘČ0QUJ@®µ "Ĺ6UŠE&š~Ţ(y'ŔËů-´°sĽáŔU•ÂZ{żř í€ÄąRv€ ­˝Ŕ'mĘĄQn‘[\IŢ8PL"fnšŹu1ˇ`¦ť¶ ÝT ŻÄqiaĄZ¨Vw<]XHÍoů /Š#˛­Q`@-“1ż -»RŚjnN ; şó¦zňü鏓w9Y®…Ě&˙ou@Ź‘Ľ8Pl”pbŮŘŞµ‚ÁyńÖH°Ř¨[^Ýh DµHľ­­Ć¶‚č÷3îLE °üXż¬«&Qş›ť=¬ňů©r†&M뀽í”&a®µ›±ÝĐ‹TWúĎ’â]¦mż­łmĄ”*OúU˙ywf›đŚş'ĎXµN949©™MW2jűqH°ÂRĆQ #VŘ-›ľiµ36Z*ó¬,‘ÎţnffŚAńçń\ç3µÄ¦Ç–ŘłťÎ(âąĘ[J…]IŻhăďaNeçŽT]ňWŇ€(d­ ŽŮ˙-Ž;űDĄ4'O´sgéYR•ÎÔÉ“g:ĐŮ+ĚW.@ŘŐݢ̜zâÖ"˙ąĺ_)ÍÂޢĹČ,ŹUŁšśťŃ`<ĂD[ÝŰ(ęp*˘:•(čŇ–GLáHňź6Yť‚mą¶ů#şŮô`΂#4!qjUâkWqń¶.ö™ą˙l4âišA#?Ą™ëËQwe p­rŁű]őL«„ضN~K öľä°ď]Dáţ9bî3buÍ•řyUđÓl üŐ}˘˛§ĽŽÂ°ÖÉA*ΛŁ8~şTüth$Ŕ1´Ět‚~WÍ·ÁŽ¸÷ľGśTtšU ‚Ľ?+ŢÜíV)ÚŇ—řm™ş9„/:Ź+úNíÜDîçđ›»Ő!zňBѬ·wËu˙ąđd_­ű)HK@+>˘˘VvX’nŢ\Ž_ÎĹ2Ě4Gtኮ]<Ú.ŔŞë„+ŕď}˝”›Ç7Gk7Qh/o•2<źÔ>wÝ =zŚÉ®)Bľ©´|Qw-”CQ=É®çµY‚;Č…ërł~ÜA>b´™đ\­W»řnNŢ{±XČ{˙!ł PCOayC;%I|dCn˝R×B5‡ÝvMłÄp™{ŁĘđuç@ÇÂŕI Bě]¶’M]čď|˘ÜIŚŽ{ˇŁsëEN°.‰rŞg'x+·g8;í¬ăçBǢΉŁWF~,}c,/±ëŁ3Č'ö,ëäTĚ™4 ö…?ô@3Ţ 4QnO CĄî€wű1ŹbB30my!6#ghÔŇĚ…1!šđ UI“ÔˇókăĂÖŇnµ{ĂC7č52tdž­'9 âEpôA"óĚđ2CŢć’ÂNű™)‰™(>t …·©g´ţ^ŔŽĐŽK8yŠMÁłR›4ŘŻ;oJY §*‰ů3G"»÷ˇMewđw¦xÝ  Źt\„-"©á˝s1v ›ĽÝ÷ŃXw°ú8Ľ™ Ď~1cnÇ$Ť`˛Ľ€®‚ôÚoë˘ZZ×rÖMMaańB#w­ŃFčśÁľ‚IhF2™×#—šŰߏIéçĂ/P ×ew@{8°ŐÚ~fň,´ç_ę Ď„żŔbßWÍ€…Ó󅟎sSÝ|Žćó€É@¨ŽśŐděšą]Ź#Ť ŶťĎnŘ=ôy~fWŽxüÁ[ě˛ĚbH˙ŞCpjŇ “˙˘´3ňĄR"T7@¤ŢnŔĺkźç„Ď$”Jú<ó(ű«÷At\şťľ]ůS78Ëě,Ú^.5Řg¸{WłşAťŞŤD–ô“,'šJ=Śům óaËň3*Ő8^r|şł/w–JŔś/śˇývµŤ9]ýrČţ Ţ—pčâzť ćŢ\űĂnµűPţu‘s–*Ç»·AůQş ©k™ÄL°A—ô;ĚuáŘM´GL…8&ÄÇŚ§Ią)ířŻ®-áŮ ęëé.ó±Ęi<­ô™aÓË}ćÜL@®Śöq'´Ďeó¦×Mˇ˘ѱňţ îüöPĆÜpBS—ÚXŐ"k‘ž jŠČ¤3Q ˛ÔżRpÔËÁâ=ÉFts É‚č%uđ i ’‘a[ő•ó> ÉÎ&wŁö)QW&eő(źsâńÍRi[ŃN’“đČ&šą٤óv)‘ĚG’%Gn´MPIhéR¤®.RŇ›X8WŹLďšŰŻš´ KlůUŤ%ĄÄĚÜó$¨Ë˙Ľşř ž\Üí/Đ ^<\°Ĺ]H†iÉjˇ¬…oôbżh°üÝđËúâŻóŐůŕˇúçűd±bđLň Ó­"é&µá6GK#ź@E\— _—äpŘĚĄ‹ŕĆűű”EŔVęs\„š[„Ŕ`ÉS!kťH!śląyĘ"K§>ÇE¸ŮE¸Ž§‹řä|m04(ż4°A.ńP< J˝_{†Ç:Ž©™ĹŃŞ<­˙ …ąě¤×<ËtőĚ°ó˛*ŁN=é>‹RU°%¦wń ‡Íj=ěŻő×'Ö7Ę«NHí#%¸źe#wd°1FvŮę}!§˝ˇŞUP‚QßWT^pXo'Ú)vŕU5VrĚS1vĘMwŽ¦¶z˘©±{p•wŃP4Gé‡ĺ÷ LgłúĄß j$íhw}őÖÇ‚±–ˇîlÇ©i‹¸)ú‹«řapz&PyXA‹Ö•řf<řÂËÂsé¸WU¸aH8IŮĚŐĽŞ3±G˝ŹŰď±-\ěŐŻ§‹®Ř븪J"ó.Ľ›µăS­ďŐÁMń«›V‡9ňš3ѿ݄·ě´‡čPľňŇA ĆÝyb7Ä–^A«=˛mgIjĎŃ+ ‡Đ»X[‡ß˝¬Â ^’N^ř2>ŻoýÇ̆R,ěHÄś ™W†ĺ±ý]_‰đkCtĐď÷ďcÚŰů¬Ó>Îś›ZÁšĄřÜfĺÍycČúŁ>3IpsíďÚËĄ @řź.ťđu :BîĆçlf¨gě/«MąQă żQŹÝ$š(­$ŕ©"ë<=GYçży"CYç^ś:‡7ISżĄŔ$ÂóIwqĐĆWe ĚÔöTIÚSś#Đw¨_ŐN 3*śť+Č6żľŁiŐ´pŢkßgó«ňDqôÎUŽÚVB¦ÓäŁ]c®LÁGř«* §ő6wŠwrFA¸ oE`F‡]‘/CcyüĎ÷ńŰ®ĺ,Ĺ!ŐtŰ }WĐ6V4ů>p š@™´éWSŞÂŮH…@”Ď-đČrÂBAjÇ˝[őT˘ě=Ľi!‚ýő‡řąÍŔó"vO0˘Î ţ¶ű}źbŕë:ţP(Mze –°É¨˛¬(›#áĽ|Üü9F"« Ŕü,}®\Ä^Śl-č0/ń¤3Űű‘ö•PŽĘرržžůŚ©E/™;ijq†Ął0ţ¶–ie’šQšŞqŘ$4ó--źf®˝,óŠ7$ŕú™\ąÝݬWť¨­ X´Ľ, _/ŻÝ®©†ľ$Ż…t=KĄ©Ţo×Á^č( ëŰ1;7ZäEŐÔĄ’…HźŻôi“cúŢĆűVâE ‰Ť•ëČĂe5ŤIC†xiŃIĎĘ9…@ô,¶ú± çčs2Ű{Č–;–í=ĄŹVô=[„űü"çË÷§5SD›oÄŹU” T!ă!î…ńtí/™ÄÓ @̶=š#]"©TjÖߌqÝ "b¸€‰ŁČI{=¦|ÔJ'XsA¸źĚ,!¦&vrť989îîĐňwČńf€cĹĽź•¦]IÓT4—9OfIJÂ@f.’Y„ČÎ!łjÚ’Xk9™żĎ‚Ąw1,H>ě+ÜO¬<é]™YŹ? BfŢúÁ—Âű(Ňţ3Źsťd1’QH!^\»1“3˘QŁĚćŚLP\ălťź+ˇ)\5t2ąźEó1=öŚ)Đ]A§óŻ*Ń›%PüF×CÇ)ţ=Ö)FZťŁ˘•—[>Żbnńż›™íˇ–J0ę[ž˛üÂÝSHÇA¸3ŽI7ˇg>M‚đŰVAüäRAíĎäFFAcÄ ¸kľŢú eř•Q‚—$UY;Źp„ =â9ÇO’’¤çĽGŽBO| :~ŻŽ?•h§Ł |Ëo»źe‚Š$;a†čóe%×y_í];ä&Ţ64” ţű\‘’Ćd\߆͵ś›ßϸŚB÷ˇ`ĽščtĘ RÉXĆ 0±©Ăö¬WtştpÔ×MRt1żrÂiT—˘îÇÖ?ÔŃqřąó64ďtĎfˇŰâä; …ŮÂ{,ÂĽPWBh¸ŤÖĚ[vy˙»M”65mţŞ©Ő92žPzಀĚagŕµęL­›˝‹«‡Ĺ͆<¨žîČڅ¤Ü‚AÚJ4sĄ“…±·»mNĎwŘNe˘ůŕ ×!¬BčRĄéŐĘäıŽĺ%,m˘´żËJ ľz«°kfśm6Ůţ®?ěĎÚ¬Ćiy¨Íę9ś ŢśĆŘDËÝS♯Q.^;i'⤨ĆţÝ.ݧŽÎÇđľ,ďĄĺÖЮ܉íΰ„ő}bÓv–%éˇńCŹ4P›!KŞ^‡ćŮő~ëŹ Ł;Z ÷pfŰB–-‚˛ÜG  •őťsYäm$'¨6?÷'v 5Óâ¬ÍĂ‘ éKš†Îh’2Ťp DďI™«źŇÔjŻ§©#~Âöh®_ěüý˝Ëł ˝Ć»I3ˇKó#ŘËy1É•«˛SjÁ/ä4R•ŇHĆ“EĽ1¦U’Ą˝ňół¸0eĂ@ŘĺĘ«É-Ô\…26AS×ă·GŠVLň· sŚşŠP%+Í(ŁţŘr¬ÍŔ›'yó ,BRr/Ţu+ “–Í-÷7„´iĘdx‡Jf ”q»;ô·”T¬¨N`u˙:´˝NĘüp» Ż±xýććýnuóŃĎ/$3W<:Íř›`ş§"/Ôcí×!ŤE ‡FKťň0°f9pV,+şÉż›¨ŐíĹ;şˇ÷mDúńÔ]yŕ4AĐýă ¤űřŁŠ6ş¨’Ío†¤Śę4ĘÜćbëüvČi-¦ßąÓ7|ÄŔ_ÜŘŕ aŽIĄOFÁéS|`Ž™·úč‹@P ű××Č9–ĚíĄń:Ă#Ńy6GyČţ÷Ü’ "—éâÍř°Iš>?V?żËBŃ3VbP"xö^ýv)‚Č^Ś˛Ď†Ę«%ßűĐ0&Ý0á<ş|%?ި(ŐŽÂÄs3¨•Ň»šŽs¬¦:ÓO. ŤäľÍ(ˇĄzQMVgă{ÂÁ{ľKŘ_Ɏ‹•2Ý.ä(ÔVŁ´/síjČVĐ—"‹lL‡±JŤĆ¶0Ĺ +{EpdĐÍ ˙ EÄč-Ą*™î'öŐŶ™żŠy·µ`a=ßUÁĎČĎŮ2Ľń&=ĚŢë×`cĐ”´I§”ű,eŇJbR…"iLAy|bYďxt¦Ö‘`&°żFĐB}Z¦Ř(\(čˇĺ§ ú\zn•D$fšÇĄ˝Şíc{•»´}Ő«É z#ăźÉ:5XÜróÂ3ČŚÍv7lšx¬LŠť\g]®ű©ŠľŠÍŔ×â]MÍ°łÓňŇ€|_%,éGű1`ĆQ*‡őM§¨K}Ä­­Y%sұj•ŚŤH Ł¬ôŘX|Ĺd*ăúŔűÝú"€JřčH¤ű>^sđXµôřŧ)J)-éđż ×ŕ͇A–«‘Ě*ö9€˛ŚµÇkWaô41ŇwŠ…tĐ6őϵTȇ˘Tťô/9†ä381?–9'<ú×9y"˝+Ş(łŃ”F™Ťś¬­CĹúşZ0µ÷ő…4ůý2ţ4ň˛öźÎcµ<ß®Tď>IűÖÄĺĽq“#S¸ŃTĎô—‹˙٧dendstream endobj 539 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 190 >> stream xścd`ab`ddđń NĚ+¶Đ JM/ÍI,‰It7ţđýĎÚÍĂÜÍòţ»˛ĐIÁcü‡@€1™Á…‰‘‘Ĺçűľ˙Ś7¬/|żqý#ćľëE[ŻDf‡VúvKę‡^}zcóÓďŚçW×fď“źqŮeá ŰnÉßZ¦żysüć{ý›é»ĚĹă –l“ç+[đ#`Ö÷Čs°ťĺzÄ-ÇĹ’ĎĂy¬§·§§·'Ěŕáa`ZXGNendstream endobj 540 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2751 >> stream xś…ViTW®¶›ęRˇË2*™*'.Ǩ˘‰&:Q!jŚ‘%Ž ¸˛6 ÍÖ‚Đ(›¸Ť¸ Ę.4B#‹5 ™DŁÖ1¸´KbƸ cŚÉLĽĺ<ćś©îFŔÉ2}ęĎëzőľ{ż{ď÷=Ą@) —EŢŢşÝëî‹CĂőŃ«ă­˙ąm"ÉRů“…ŕ¤'UăóÎŻhđ%×{CNąPÖźŕŁ{3v^|B˘~upOhxÄbmä’(˙čµî“_š2ă ŠzňĄü¨1Ô»Ô8ęŻÔĘź  Ľ¨ąÔ<ę%j>µ€z›šJ-¤Ţˇ^ĄQÓ(oʇr¦†P.KąQ<5JŽŚRQQüEŃ4`ň€&ĺpĺ1ŐźUۆ9Ä9tŃôu!ăĚ8r`ń@”1č¶ăxÇÇ'N#ťś.věŹfg©Äű˘46Ia’"”Rv=gŽT~=MI%Ů2 ´0"ÖBFVv4Ô]2|=m…¨ČjŘ+ ‚.®zł"„ňű8™.wwĐCdT ?}+9¸„#®t5ŞÍ89ż…1Ňy‰»ŤŮŚ ŰE_Qsß‚~–çŘŁŇ9€X0đ+1‰~řţŃ×–§D†ňl‡)wß~6ť¦“±­§!í+űV8Ť.2É‘Č_ +Ń“fk¸z°­­(ÁŹ' Qę´yźÉşo‚mź #ońĽ¨řÔ‚ĄĄ¤Ĺh]Üâŕ>ž¸—® ¨BU×tá=wp/űzyyů^ľsűÜ™Ž g˝§đň颢ć?şę)‡Ţ)%ă\C,dl^ q9|üBN:0/żţÇŕ‹ßţ|«âf&q)ňă÷ĂN`š ˛T@A] 5Q<űH›6¦jKWÔřC†%yž, půG‡ŰßvY&ń"NńTeFw¸´ÁĽă«Ź*huJLĎ>hÜ°-沺Ë~—¬ şnmËú#Ŕ ňAjĎaS.đšră$AÍ=uŞí‹ŽSo˝ÂŰ‹Ąq™ Zci¶Ľ'Ă˙[ĘýëT—BeX$&óóČÔˇF ÉMÖů®žwɡ<Ńŕ2š=Ś™ţt2$Ú__S›ł ´|÷@Ú`ŹoŻPŰ­Źé[IÍ0ělúµ Nˇ=¤T‰áJ7}mń˘˙@ľNÍvŘ#ŞľĎż&í3űVXBŐĘ©ëäÔ‰ivÔŁó·â·†™˛÷SYľĎdoŽ/EÄDQsIÄ]˘•ĺ•¨á -ş.ˇ8xü6÷âŐŰß.„&¦şŢt÷îV­ŢČçéj¬ueGŮ*+ŞŮÖŇ&nŢýZú>¤Ču}Óࡠ8”°;KhXgÚüsjő–Ż6Ŕ2&:&b˘Opů©$>»lKˇ™Ę$ÁCm€Řú⢦ťüÇźC™\ŁU÷Zzş÷”C’48Ń–«2$ä¸qžš”•ËçëµŔxB{•€É8UÝ[s2őm­ Ď^¶áĚ|MťŰ3´7‰})ââ­ŽÓކăkĄ\®řË%şß€^Łml?3”a4Ű6}ÖFí,¨­ă±Býëů´űů¸km;ĐĘłsÖć—A‰ŰŐ~Sékíđ{˘ć¸ő2`´×ĚŐÇBŞaěHć1\}Ý÷:µ|̉©X_µ·nűqŢ´µ €ůęX¤Ź@fćáAđ"æĎîđ~°ű*´´Ë8ÚŞv0»™ŞŔlŐ#ŠDXśÄ°ć”đ°ĹÍoŤůPŰŁt1öIĂE Fw*Ą0Tpĺ†ý†4Đgňن”Őó€™6żă»uŹq辢\ČĘrŚąĆĚ­ÚšŚ˝ŔÔ”•Ő\ AÄÓ‡¸M%Î?ŚÇ!8şîaqo~rĺšűüú•ŚżÁč$Z_\ 7ŹrâDâ*°ŮdČť HmÝ×Ř(g )ň=’Wp:ÇšýWĚ3ßďËďn‹ç/źţř=űěJzQq÷4ĆźVJ[¤+v™'TźšWuksé@E8”Ňš×FĚí˙VźĐOů)»ňËg ’ÖH'Ł#RQh9TÁšăaA2V©m`g”;‡EĹ'×q×UĄŇCjÚ+© ‹ßtx¦7$u1x”.«€fdţpÄyŇXâH\ţ9‡âČŁwŞ„Ů8†#»čŇoζ|ŕđňs¬>B’ĎáŚ/|Î?‡ç4˘ĹűŚ·ĚíMi»4”«Ń×$®ÜĆëJ´…Ŕ¸{zM ŰU’ d¦fÄA¬.×ĺ張ú…``¦ţâ‹,jźţG“EĂĎĄŮ“Y°˛¶¦ÂHßťYđÁŘů°{[AŤˇ.łű–Ëß×gšRŞ…ŠÝĹyEĆíqĺYE˛š”–T d!Qpţ«V-]şŞµ˝˝µőĉÖUţü/Dâ‚ç­÷˘×áÖ¦úĂ'ňůÓôTŔk=*gk…Í•żă‰řÎŻ§«[˙¦ř-QĆ ±>š›ô˛YŠe »¤Ň.®A™2Q‘ąü¦śpC<|Ôv¶gVńĚ1•[¶2ěżNšśřtä­Y'yňÖďvŤsż®Á+tTĺÖĆ1lg…ěkF‚D–D1ěă¨ŇÚÔngjζ d:ţČ­ ńťĚĎÇúŢ!ż˝F`ůI?Í–ŁüBZ%s$«:˙ÂSY"cűÉľi'Îýi·Ů€ŔzqR9gJ¬ÔéuşĘD“©˛Ňdť’$Jű­Ç;—w~óÓ䢤^ĂI^vÖÉ´~y ëOC*„Ć…ÇicdiIM`0¦ćĺa'Ă2-ą‘ÝX}|j”ŔćÎúáŘfô%ĎŽ1J÷ß>ŻŐtµ>Jił”Î=őĘçhmfV„0[Ýë˘íčÚ­_ÚŻ¨sű|n©¤G×~Žű”=T‹ ¤d5ČďąóEÓd,ľ‹Ž¨r8ŘW(âŃÇŁ™&“Čh|hämşđx·>°o…}đWčk—ĺŚwJM¦Št˘ź |‰J—,hs,·ĘR¬U–†Ó6G˛žUKîĐc˝°čäĎ<Ţ©UŰ{ZŽě™]÷iâzŰăŃŁŰwŃ•Çűö}B/“˛™(Ą¨žLÉ°§Rű?eÔ“aýÖßő†ůôŢqâ4ŇÖç9¶Í6•ňÍ—Ç u jJF ,[Ăçä'ó—[ 2+Fněµ[’`˝[¤ýĐ 8(vuď ůNßőçŞŮ¶›‡Ź*Ű“ćÍ“ufLOŻ^|fÓl±Ć‰ĺW“<”R~Î5‡ÁFžś§ÓC!,´ v xž.l†&[BČ*0Y%~u–kŠ®‰ ‹ŤŽ «‹­oŞ©«·¶÷ş'%IŠĎĄI˛>ĂU&ŻOČLÎŘĚ“ë˙ńĘJ…\Č‘Xj(©*()ÜĆăő'^;÷‚vŚ°3ž.jNv.·[ř5)úC®¶ç¸.–'zú“c¨ş˝ż˛©ńŇyxČ ăřëÄ…gG‘3gNX—ŕúŚbží,«Ţw > stream xś’mţLMSans10-Regular‹€řÚůJ‹ ‹ ŻřÓĘÄraPVSB170–Ü÷¬˙UŞ vř[wÝÖ÷ŰřÎ2ŠTZl]ćEüVÖ÷j‹ďÓÓíŤ˙ŕŽ€Č÷$Ŕ÷/ĆÁÓ÷aŮř-÷µńBŃ/J^{p\‘Iż°˝Ľ‹şłcA`ű*‰űa‹3`¦:â™éŤ¸Ĺg÷‹x‹rixnyeŠ€‹[^˘µŃ÷6’¶Ť˙~ă v÷µĹ÷·Ăëá÷ÓÜřÚř€ö(ęűűŤýJä÷µ÷;÷őć÷:> stream xś]ÁnÂ0 †ďyŠĽA“X'!_ŕÂ4m{4µQMŁPĽ=¶ ;ěđEúb[˛˙ćp:žrZlóUçř‹Ą”ÇŠ·ů^#ÚŻ)ßÚ1ĹĺeúĆ)ÓΡü> Zn@Zý&lľwÎë—_‡â<â­„5ä+š˝s°'yüWňnťčŐÚµ PŹ¬(ÔÓ§čV'ş…uÝÂł$ú Wh «  °v˘ÖVAaÝčŢďĺ ă}»Ť÷Z1/š&"A¤Śˇ–ąČ”eĚ~uendstream endobj 543 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1938 >> stream xśuU{Tçźa3 ˇ‰¸鸫16Đč©Ĺ”äcźAE G+Ř…ey€°»sg—•÷[AŔÔG­ń$(P© ¦Ňö´ľHZµG›ÚÚ~ł|‹ô[ ¶ýoîw÷ŢßďŢ{îДԅ˘iúĹ°đđhý·2őęä´„”äź._¶Mź®‰Nuz•ŔŤč8Yâ9¸KŔ]z†sŐĎ“^ßřčű<5ź¤ <¨R~Ôęm*‚ŠĄtTĹS•Tu–ꥩ›Ôę{ĘA3´'­4¨ťeâŇ’ă5jmtŞ:YŁŢŻIŹź0RâLX1©Ń±‰jý”ó©9Ë­žéTO»´©)qé±ú¸„4­&:k&p.5:.!6ZCľŇŇ“’˘őDřŚ§Ącô3 uć CŻťIi7aM'¬I¤zňQýź¬źI qÓßz-EQóÝ.zi±Ż_drŠn×ĘŐţ«V®]CŃFÚD›ižZ -´•.Łmôaşś® +é*şš®ˇké:şžn )/çP¤Ô«Ôz=ťB׸lpA’]RéécY†¬AÖ)»)“űČĺy'łI@§<Ćéđ -ůX‚¶8†âU¦ŽŇ!#[é¸Ęä€áh iTzŚKĽNPÜH©›Ó™AŁßJěfn$GV°””żŠŘ 4o Ra/ty'1ÄŕŃ ů˘áKČó:rű ˘,V‹ĘŘŞC›kłY ¶ivÁ!_»˘po^UŚ×‡[—c.Z‰ţ/}ä¤ÍâqÇLyś®'ëi_t–“ß!íčľ.;9ű*ԵȺĄÍż+űks5ś†Vý“A¨+<®ążâ“ íéąř›¦ßZk,M`cĹ |őĹçßś«/'ĚëŮf^ČL~cż&V™ Ý±ť_Ďâ/g`Ľż3Ľ /Yú~~ éF.äü‘˘ďw÷¬†0Ö±’˝°ąwgKúQCwj͡^m°Í‚ЬšbşÚŔ1ĚÓ±( ,ć˛ĚJď—z"˙¬HRtÁg»úŇ[ G÷´Úv| 6ÓĚgć±Ň¨ú0QQM/[BčYL4m„ĽŞ”ËďířB‡™ÝŰŢÎzËT`΂RÖA4†…ý8:÷“)›iá›;ţpćäGĘÓźüZ¸Ć˘M÷ŕTß@u͉Ó×NÖžPď1šKšH˛ô¨í˘ş¸˛ ןoT:Ş8ű8Ń^„U8 !÷Úm”=öń) âŹx“_±Ő ŔÇc\Ö¦sNţ.'}ÜM“ßŰ“«ŠTyÜâEë1“d(őÓáwuü].ż)Ż°XÁć¶CUŽýöĽĹórô"ÜĎ«4÷ß;ٖs-ęt Ű&ÇϡÓ2˛r=𼩄7A&ŰÇx;ęß@ )~°š”dWäÓë1ÄÉ?%Mż5$±żBLĹn$/ˇśhşBŽńŃ$BT9ţ¦…:MŻi…üÓˇ§ńI$ú‰tćdž­plH‚ľvV SĺěÁ¸1ô™ ˙[áiüBg<ľŠIç™ĘĽG‰ó»DđjfÚyA«Ü(×ňĽN…›ťŔw(ĺ‚Đ®šD?q1Đö±ńÉ{fŐ´ľŮ»÷AÜőŚp—Cf%q„#ŕ{oE‰aäm‚ĐŞšUł»*Ä@rźŰ…öa=â-čA1€ÜXň>+YY8‡á…ť'.Ëy⪋Ú3†vt˙čĂ #ţŕĎĐÓć3¦X§*Zy!U™#lj Ć[żÂ’3Cř˛mGˇhnmŐäĹ)¬_¶‰Ş*« ?ç64Gé&}7ĹݵĄÁR.ʬĺużtw§¨ý›t>endstream endobj 544 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 338 >> stream xśG¸ţLMMathSymbols6-Regular‹‹ůŮře‹ ‹ ®÷¶âÝŮ asteriskmath¦‡,Ĺ÷¬˙Âô÷tżůŮ÷ŽĄr‹}ý}r‹qq¤‹™ů™¤‹Ą˙~â÷˛Íř©÷1‹ ~ű.Č÷)Ç›‘—’‹źˇx—~„‰Šű$1™÷%Ťś|yz{~zŤ€‹‡™ű ű$哉Ś„‹~xuv—†š…÷*Oű)O{…„‹wuž’ŤŚ“—÷$ĺ…N*z›~śťšś‹‚抅É÷:–„ś€“‹ž—ˇ•łů§˛ˇż ż  W/ «ŚŚŚŚŹ“ ü>‹žendstream endobj 545 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 583 >> stream xś-ĎMLÓ`đ·l3üÓM“ö˘1ąz0ŚĆÂü Ńá‰Á§¶±Ť}ŁŔćĆ;V¨+ŁŰ:°”dáT>Ś !3ńz# &ÜÚĺ%ÁţŻOň<ż?”Ă°S :ťÁţě–Ý`6µ^©}đ¤Ía6Ř-DÍr©tY $”yyöäć‰oÇÖŹSLϸnúĂ& )ě*¶,ÍVďWd~W˘|ZÄ6·rI:§†śŰé÷ľ&˝wśz#ÄMá|r”-09ę˝T7”aç!ŁM{FÜť«/Lú3¦9ÄQ "Ńt-Ývqm‘ç©TC±/ ó07‘šá Ü8„#{@rĂßרӿ´AĽŐ8ő}aňŹ¸F Ëç>@|3U×O…ýŞę}l‰ű'“.:wc’ćÇÔ–BÚ-)ŐY÷ÝŇaí°˝őĄE^ŕÉüžýíą‚¤WßrWqwo";1śťˇľJ—h6žĄăÚXśfá8ľÚ4Ótţ1Ň8Bt/Çņă1rzçsfâLŔŢ,żO=B5=00iíˇôŕúŶ•Ý%I“&˶} fQţů—ŘQČƲLčb˝/lć.ç‹Ď Ľ@¶  ő ‹C®\ďY(JÄĽDdµsRľÁŽŚH–É#bŐÜQ˛JŮŘIT ŃÁh,9ÎFßĐŔ_| endstream endobj 546 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4097 >> stream xśĄXyTTWšeIů4„DM%T’y/1Ń,ÝnY<1鬚¸‹". "›˛P EAíŰW µB±TA!Xʢ€ jŚ{ÇdŤ¦Łs’¶ťdNş3sn‘ËśĚ-$iŇ“Î8Ýüš€÷ÝďţÖǡ&O˘8ÎôŐkbór’sľ0wEQrvfjř‡Źĺă¤ďwŽ$F@$"'w<Î_0-š~çÓRáŻ'ßÎÍ[’˙®°°¨X”,IY-M]S’¶3f׺ôŚĚ YŮ9sŠšEĹP먧©őÔjGm¤6Q›©w¨xj 5—J –Ró¨­Ô»Ô{ÔjµZN­ VR/Q«©5ÔZ*Šs5‹ HM¦8+9 “~;é6÷ăÉq“/E¬Šń„S&O9B/§/M-›zsZ˙}9‘ŹD–E^ąż *"Şö·řý¶éIÓ?ťŃ?㻇ŢC­Q?LşüA” msF×ń=(KĐ9šŚĚŽÚTo˛ĘA VSŽoŽ^ŹÎŽË+Š×)Lj”ĐĘJ€Ćf ěaš!hlÚáźKmÖ˛…y%řŔë¬rŐ|ŠřѨ”çÁ/›e–ü5&\Ąl­hc[ˇÍŘ´˝ęXĽů8“‡bŃͨЀG+9Ôp’ş„žâ»T /7JőŚ*3á KŐŽ@ŁgżÓĎ6}Úv> ŹycͶôÄÝŚˇ/»c;AR”$ŮU¶€VW]ł9`gŞOůNµÝąĺ}±^Îľűôr0^Pî,Ż ¸ëjmĚd˛7Gý;ú!ľdÍY’ŔŞ„zč­űsÜnAĎ٨áî hŇyTyžҢţw«>x GářIü,¦>Üř ŠB3ĐShłŞ‹I…8"+.eéaĐÉ™űѤ֓lçůÁ}ť@6m‹eŁFÖ‰‚#óôě5î0´’ĚVł@@ö •†YůZÖ©-űV‚'â \„•ř 4i.š‰8×®:śě­›5_’»Ô UëM*“çâ©ŻĎzÁâóčń˝ôć×čQvđŁŻ.ühÄŻÄěŽRc‘ˇ”UMQ9ˇÂm1׌ťo ˘ůţĐ|?'´ü7¤G˝ü[Ű/Ľ·zó*ŤŽQIoČĽ§U‹ôĄ,ŽŤWgk´;A P‚Dí0V4-ĐĚîcđ.šmf;Řá˙F@)70â7Ą…‹~…w™]ís ĐtŠô¤¬UX—łΨ­pAE%Xë¬L#zČč`xÔPÂŚnć•„Ůá„š VŔH ‰íQehŐkA ˙ Ąńü`6Ű«˙ ĺFŰ\`%+ŹúS« Ć9óÜn¨84“?¸Ě‘·}gńć]ŚęTRuţ?ĚÁäµVöˇţ‚ Ř ňR˝¤„´¨F]]×\ŐApň´G„.ž˙DĚů׫hŐnč!4ź7—ÖlőäŰÓťĐG75\Ľ~ (Ęr0ézcči…CîÔÖµő§v­Â‘ł“vůD.%S+óé*÷čË!ŽÎ/|OJŹ÷(Ă8H&Ż—:ËÔiú¸µ'3>BOBÜăLşJÎľ 6&N;ÁEߎ †ÂdTčňě´çVÁ;Z«m[5{ E|Ϋu°i „ýŻ-4[Ěž0˝4ŐˇŞČL^±÷ÓÚŻó–ŕ:1”“˝loN>ńÍQôl9vøĚ=éâ†ú~R*S‘–ż"ÉČşXWď»űŕŹQ§Í ‚śęrWYžZHł÷F+Ś:8yWĆv U}­§ŰďÎłÎ@EřéžÂ®„™ř­* łŐkcśűšî|tĄGW(TÖłY/”m4zá©Â#˝íţžĆ“¶_ÔÝŕVkŰ+O‚•Ž mvŢÉş!t˙ nHşź?(®’J„’"•EG¶Č·î]°Wâ©[ä‡z>h»8Ă8ďy”TĚŐ§C=űŠ¬˝ÚŹţ»éŻ:ůÍYnČýë;ş„Z¬¨ wáQWIł4iŔL’ĚĘ|˘t<…¨ŘśV_CŢřÖËDýŔÍţlübHh})íJČĺňD`Ą ß˝˝1tÎŘ`2RÝWĺ~ľđ‡Gý%Ë·sŚťŇ$U9M¶˝ű-$N˝Ě©Ě{9ć<´Ń.[50č±PW„™÷Áč÷‰ĹP âtÎŞĐ”‘ÉŃfž5úáÄ;tµŤäŔv¶:Ťíw#¤[ ĄŔérš+Ě1ˇĂ®6»ó,j]$$“Qž®ö#Żżú4'ôz‚ďÔZÔ “¤›Âe±â<(R{~UVM9Ńi(@cěîďíëëąóĹMDCíT9Ž©LĂäo+•‹AJ‡tŹ, ÷g˝$ež„\»ŤÖmc=űÚ|AđC­Ę«í»ÉwŮĄĄJ%ž…gE/[–ř6¨i5‰Ě•¦ş±ą« ÜP YµBŻt?Đ:ŽfČ̆qÂRDűüOűŞ*öZ«X4+tŢl·Ř~•żj“žY‡Uňa0é^%ńm1_“óň/Jâű<ø$*ýHčGŻ‡Őĺҵý22W¨®µrěuwłĽv´ĐŚľ]]ëžÂělĽtÎĐ’/Ć0ČîDţřUČbDÄ^_üĆ]tO /“„[•(0ň»šs#”~•;â ĹňŃěE(3x;ŢUX†źľ‰'#% dTŠĘ™×»ůx3fńĽâ…ő7PÔ™zĺ:šÂ|ř§ë˝çţüâ ü…ŽáU˘®Ë!e˝ôqŻ“?Ś>ć†bGćw§R~#ÄgjćD¬ţ)k±§xKGąĺ1F•l­@‘\ľ-ô 4—Őu:lűŔ9&ÇEEŇÝiťE®˙ň~ć,ú$âę_ăĂ›Ľô˘ëçh'¬°Ş%™m>(h‰WYÔµ2?ŃŢFtŃ®sG’BmüĎWś{‚ÁÝżDżżŃ;’=Ű;-ĐA¸ŇćŠsWXKőäŽ@syh:ŠţMc_mäT5wË˝aÇÖ$ŰÎŕ]DÍ®.´‚ŕďF÷î°‘ŕ$Ză =ă#BD°É‰áŁIˇµĚ·¨LTbdLQÓĹî9Ű7t¸˛ó%-4FŐş\«~ţ{®~«’weć1—Ńq‹ÝükŇ•„@xÎčuC™ÉA™«ĽvŻ˝Éa!k¶k˙ŻÖ‡ŽŤĄýő 4sđ(±šatĺo-X ´˘Ľ˘±ÉŰQw„=…ąö´_'ÜÝś67~V7ÁaZšn‡i‰˘@[˘‘˛Żáu1”J°ľ[ÔúDZ§Î|˘9”Îß+®çäćĺć×—ůö›÷; ]qa3%śEÉg¸ˇRňáZj_|ÍóÁč,×6/\¦o^»ő xrv”čs#A‰ŇsĎXÍBić»eÄĄŇŽ@ˇfcv}ü6H‰ÄLĹ“ČŐG[R:ŇŘú˘:ÝGâ3Ňč^y]$Ň ^zÁK»˙ě¶4Űł3‚4NťÂh’é™Í8Íd0ŞÉŽU¤şÚĚćJ7Ówş9Ą/ë©G÷“ŘńzxB¤é=}qxB ÓHy¬dmĐŇrĎţ°¸ÚŮ ŘŔ—ŐowküžŽC=˝ýDź] ł1S§BéX* |-M’};ÖíŘ´=ŤŮ°\¬–Ş˙Z}˙<†PjŁaXË  ×9Ňt §—*ěěllj©e|mUďC…¬ç6é!MhźĐT§×€–É /5¨ĘJb2˙ź˘?>ÔŚQłQeP@©`S[F›?°×ËÔµz/„łýČ» {„ćÍČů{eź—Îh/n l…őť˙ĎĽ>©¬qřL?ZSŃ`ŻŻh¸;O ©·î‡-21ů})»×’#čÄ(śe^·Üńţ‚b‡8_ ŕ˘/Pixµ2ÇňÄ@.JaÔj%  stA±¤$[Ŕę±Ří>°“‚ĚMTP$$˘wüˇÇčůë ţůĂpőň0Z?Ś^P ç )7[§Ě‡2şĚ% Ôď©í¸„iČťó’˙&‡‘<Ő<ďŐę+ŢΆ÷OŰ›ÁAŠl“D¬+)˘1—ŘS_ZćIŔłsçľ'cŠń¤ź[Ô{©[Ë· ”éeń †"kyÍ‹bf~ůÖMuőÜ:„žFłö˛gѧHÍ[Ž˙Cą©ôÍâ˝fgĚfĐB&ü]NâÖ±żŠDąŰNČu|ĺCŹö3žVw›Łý#ô]4Ú5ˇó†×í«ۤ¨>´ÄŤ -µőĽŕ´ˇűi“ăň"§úH‘&L·őx]ćČHŠúŃČźűendstream endobj 547 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 294 >> stream xśäţLMMathSymbols9-Regular‹űŽů\ů‚‹ ‹ ®÷ŠŕŰ× lessequalj]‡/›÷¬˙}ů‚w÷ ¶÷8űkú6™‹ vu‹x{ţ6{‹xˇ ‹ ™˙`ű.¶ů\Ń‹„Ź€ü­÷—ř«÷”••‹š’‚‡‰‹…€üĚű¤{‡…‹‹“‡•†řĚűĄ„Ť‹Ž‹š’—”ű_ˇw‹|üŔ|w‹uv ‹™řŔ™ ‹ •łů§˛ˇ¶ ¶  W/ ¤ŚŤŽ–ŚŤ‘ŹŤ” Ż®v:endstream endobj 548 0 obj << /Filter /FlateDecode /Length 30533 >> stream xś´˝]Ż-9ržyţÂÜěËSj;3IIľń@#ŚŕFę ˇĄ‹v·$K>Ą¶Ú-ëĆ?~ďó2W®Vąőa ŤÚë=ůÉ$d0řÄß}źçÇ‘˙óůă—ă㯾üÝ—Sę‡˙óË?ţĂ_ţퟌs)źóçÇů…SÎŹĄöÖ?gi?üřĺëßýđ7ëŕó(oGńy^sťńĂŻľüüë˙ů÷ßźG+ý<ć׿»ÖůŁÔŻOőŰ/~ű×˙éóë_|÷})őó¨őëüëż}ö_ó®Ď9ë×˙ç×ß}ŤĎăŚůőWŹCÖąůcś#Ć×o˙=O(źÇ1ľţĂ_˙öżđkFůşţţésţü‡?Ň µ·ŠöyďóőOţďüăÚŻüßW˙Ĺ/őb5ź˙Ĺ˝â¨W˝ďŐźŞççu^çľŇŻĂŰńBoĄń‹oßĺţŕ‡/ś¬|üŐ×ç<ŻĎR>Z©íłŻKĎQ?ŰţĎoţâă?}üí—úy–ZúÇ?¬/űGë˙łęÂ~9ĎąžcťÚ®ăłž?~ąz_ĄwÝĘ·/?ű‰ŁnĄŽăłű¨zĆçlĎŁ¶ň<*ęúśńŻ†Ň¸űĄ”˛šą”ö9tĺńyúľľJĺ-®ůY;Jç ËjŢ:k~Ľű˛Hç‰Rąň˛}ĎĚR‘”ĎjgW.ăłť(•g®‡š}*ť÷Z-éÔYg>»”˘V“Ę>«Q>Kq©®Ú®ň™×}Öü,… ·óóśťÇiEM$¦^FJý…whAé,ap§¶Ę)R©»ÜW˝ ŠË=ÖS4”ÉY±Î×Ód[Aiź1Qxŕč.śU1xây°r?óHÜĽ/ĂŁłzľť”š…"Ąńž«¶†2ů }¸pĆ.Ňe(ť‘E+ĺ”á‹ŐÄ\˝GIŰ,ĄqťU­Ű:«?{^.f­—2U6©¸üň»¶TÎ]~ëŚ%¸ěTŁ[ĘŞ ‘ J‚+ézΫŁPÄ׺šg)ůnRN•M*”Öµţ ťUł©HYMu˘ÄDéËPĄ˛šµŻ<ó/)Ť+gק牬AR.•M*ÍJ••IerŻŐ¬‹Îę.žk5볣 +SĆżĂĆŕşÎO ´áë*.ť™E ĄÉʤB‹]¦WVfuąź—•)+“ '•őIj ëC \Yţ\«M׼÷ząÓJČƤeČĆôe×N+S6&ł†]OSł6HY ěBéÜ}µé˘Çiź—•.“Jç‘ëŤé« ýćíŤIĹoľz‚¦çŃg”˛Śú@>fťźÂ*c ]&&•é“Ô±,efsO%N™ľ ďÁ®Fť&8óŐ¨Ż|‰őÍźŐó/)ác†lL_ćúäľú¸Šâ]­şę¬bsq­Vť&8•Aˇ®V­Ç©ůzö}KQ"eĘƤ‚)¸VŁÎâşbС;HÁ_ŮťéişűÂ+;ť@ńI#MčfňZć»éşÓ–ôZŤş ŤúZŤúĚ“V˝óÇÓEłňlS˝ÔRN7ňkĚŞ™ô;ĺ8±0YW­,Ěę‘ BKű)kWV şUuű-«1…žĄeűKe5‹†@çPV —Y5ľV”ŠY㜣ˇ¬!‚OKčYť—2üÝĘŞ?­˘L.Ľj‚Jf5“fĄ`_VgU*ëŁĘľ,…úX.UđĄśű˛đó˛Ăä:«(+Âŕ‰W)]ů8ŐÝ™&:§şî•ő°.e˝LčśćŻPÖV]70%Gű@ZŁ¬ěâ—ŇłYK©X—Ődýt50/KńăŐy©»?)«9gA¬˙`ĘjÍç…¸§¬N{ć…Wwîs˛]żŻ]ä­c[–â"_ŤY¶eťKŮ­¶|泤iŕ*qQ2ëj‡Ź©źčKD>ćR¶‰/9¦Ő1}WŁŐ”/ěyY-ů2ü¸kÄ­‚is?ooĚGĐń—Ő’ë…ÂXެ–,òĽr§qbXâţüăĘ–$…{Ż‘j–Ě2SÁťVCVɬW+>duŁ:§ąá–yȬ,ÁbuŘ2+ůú<Ţ u=Ě6±e bT4«@0=e5fÍRü 9ŽĐYÓu¤®[& îęqaXhN5;eýr'QŹ `Ň>V”AÁôâáD]sýäŰ×՛ɪä°ˇ`TV±W+ kŰ·U¬««Xz؆ÔŐŽłXÖ—aÄY—Ń—QYC)Ćúőş0*ů­xܫʨ,arÝŐŠem÷tk)RŰčŐe1U*ă˛5¨ĺÄŞŚâž§®v,«2Š­v]íXV%'Ě\y5dŮŰeĎ/®¬1BÎ;¸ě2.*™Ąđ©ë˛2)kÇ[ŻV¬Ű čš6@çě™@]ŤXćv)Ă'MJfŐ$¦N5Űj^7Gđ“˛z N]ÍL6e)Ś–ęjC˛)Y۸ůjCů«#©Ü;ŰG>ÍŞ~ĽŔŞú*—%řógUO!\ kenSUŁcQrHéëNŚíŞ˛tăuUA•ĚR0^uŐ°,ϱ*1{]*ŤĘX}TáćY}F*—g[uŐ ÷^5!Íí8T+Ą¨n/Ązl^‡F«KŮÍšńBqiĺOgĹ® C=ďRún+Sul)c·•™ť¦×”XĘIÖśjäI«tsÉ)B §ëgËůt>Íyą~¶śOWŚg;*…łZőłĺłë:Őőłĺ„Zg5WŃv¨gÂȨť*ÜĄlkÔrBťBߏ“§KŮƨ­U8Ké>)Íń¶-’K$Oş¶-j9ť.(”qËét~‡kŰŁ–Óé|škŰŁ¶ĆHůRŮĄű$ Ą0Qi9›ÖIŐźĽĺl:…ćިĺdZJ¸7jEßUŠK4'ÓzšľK4'Óz‡±ß!Ç…îłUŤŠ–˛Çe Ź[kô@µM×QÎęF9ÝČŰjŇ9ěJ…™TËŮtľÄb¸s˛3ňM8ĄiD!ĹBhÚ2Ö»…Ďé\ʶP-46\ Ź–ó誟űasťŹ_ú~ŘśGëA†{϶Úsť(”]ÎŁőôs—ďjÎ9âuŹĺ×@U“–T\E˛ĂČłŞŤVëŞrK¸lZ×BJp«śFç ¬bfúÖr=QčZí|íe\:24±\Jól­ŤŽuYĘäs&­Ç [Τő{ęßr&ÝP\IfĹĽÔáiLË©´ÎÚ¶­ĄÝk(ĽEäT:ź§íˇz,›¦âi{´GˇxVEŔÇŃ0/mŹÖc5čk˘ř2ó˛ě?Ť5Nś°©Đ}ÄyQNl«9—ÎÇY#8żDÎĄ'Jł200qÝÇL L\űE«fçK)ţ~QeRĄ4+M^µŐ†4˛Ž4  łŞeäTZ'µýAs*ÝP0]‘ăe˝DěWo3IˇG‹6(ž{t9—î(t‘Ż¬ł†«nä\úDaĐ9—ÖóLŰŔîâŮsňČątGá2ýŔČäŇĘ…‘é‡;ĆôËȤŕWËΙ]*<_NĄOô5†Séôk7‰qbfúeă9—>Q\ FĂÎôí“’·ˇXNŻ¶_é Uá,·_ş,KCqNÜÓcŤ9đ­¦Qv&‡µĽUΧOćĘ鸣tÂő+}n”N¸ĽŇY&;ÓĂ"Ý^‡Ďň!™éÝă‘tNEGa0śn&JgÓe$3Ăü:=?˛1ˆ2ZN?ŹlL·W!621Kč>dʧ6°néTˇ\¦4é‘éÓrúG&§ř3ÉŐáł÷ĘŹ‘Ď2ö ,˝˛żcűĎŇă r‡«ľ >«ń<żt*Ýgá—Neú¬‰»sÍ)˝ fěUÎ×U6YĹxŠc:•Ću*žéTEäÄşú,Š¸qşÉ)±ŠgŤ1ĺ”XĹ34R‚cZ ŘđL§â“&öe\îPs^*ű’׎rątö!gťÝ¦Ó”Ňgą®Ži)ÜĽă~*f)tŐ9Űĺ]išäĄÂ­:®é‡€gú% ÓḼ®:ę]4[‰ĎööpżôC™řĄ/9ńK? "ç8ĺ­°rFý^ 9Ł+Tö‰_úţ.9™>‰š”ŤŢźź7§m>«@N(š]M4A(Źš”Ó隤‡ÉÁ˙đ9ÔýŘGyÖŮ´W×P:ŤŃ]Cý4çtá6™9Ü–qY CÍ\‡ŰăĄ9WźU}Vh"s7×ńžV|•iĂ;mŇs0Űm+`ćXŐćĹ]`Mo Ă›ç´:Pč[®=ĚÇäĚÚ†ŚC*NéTćŕŻŘŘŃŤçŔĂŰí‚ĚA›&2}Źđs¦‰ĚRáçđKłĽŰS‘#©jsŤű=GI—Ť<ĄžSëî~€'ftŁľ‚srjíŢ„#âb’×ŰţvK:{%ź6ľu–śZ”}Ň´ńÝk2ętĂŞŢr ř†uY-ß_Š×•‚MĄď>śŤę‹;qfčj: }ÎČ©uőč€Gué{ k°z*ĺđuđKçË0*9µşÄ±š´fy±çś#çÖĽć ^öşÄ¸ĄSˇ ÍCné,YšÇ<.ćx·7n•9^ěuĂ™3k=LĂŤ3Ź~íNĽŇů éç‰W:<2“ +ĂJă'o8Ď \bŻÍ5gX·}’ó’K:‡¸XĂyá’N…ŐµyU&yq¸#›9«”Ăgu fu<ÍĘĸ,ĹoťÓjŤ÷‡ď,xĄłşO“k÷ŠŃä@“„áCEÓöhV9Ął1’™9«¶âw¨8ĄsÎB…9«Îwh$HŃz¬ÜśUhvDS ·t*±‰[ł,lßlrK§pX¦x«·gČ3ł4QťžŐĚ]”rYÁ/ť6ĆO8¦sň%™c:V‚fVĚĽ{>(śś[#řSĺ¨Znű5;~éqŻ1Lůb%° 1;Žé±*fJϵý iČ=×ö+dĄëî%‘‰;T“xfŕ—Ná˘l~éôĐÓÎśXČ[@+śó¤h–Âó˘d–éw››rL§_ÂoÄ˝żŇÄ1ť=†ÄבłjťU™ť/ĺ¤dJĹ/Ą¨dJˇŹ_ľé±Ľ–‚o:»Żé“ä›NAµć:rR­§9xŕ+Ă«T2—{żĄTŠ&—ě|VÜî#?ń9ě>ň ~)Ó-ĽŽśTË›ź’sę9łTŔKhv­UęůRpM§rđRęH®Âśű: ®iuý÷:YXYJµ_íÄ`-%ěW;>yi\Bňň…Ż‹k:“ W\Ó©ś\XuPţÄĘIµQ.ąĆŚĐ)–ÓóâĄČ3ťÂĹ6<ÓéÜtY6\Ó9NrY˛ř$'©&'Óĺä޲çÉ|wýÄ1=Ľ_Z4J;'Ň'7Ž†Ĺ]şĘŤs­c:Ö)rÉ™ĄĐ·_Úţ”ĄlżtĂ,ĄbUÇH-%°¸‡˝9KéLę–âOÍpK>đ•ÇöKź»şűĄFTKhXš¬źa—˝íŮR†]ö±Ňuä4şăčď\uâ•ÎĹ·ś‰W:……- ¸°r͢CđÖ9‰ľX— )ť9‰.(r(,E>éÎ %ŕ“ΡżlŐ•á¦ZśďJ¬îx©ë<HǤmť9‡ž,ČPRgNŁ%M9Ż 'Ó2`–ŃD‘O:Ťz–0YÜqj»IŃŚęÚyâÁÖµ3ŁÉ¦—ˇh*'AZŞÂ\ťNéî‰ÂuâUÖŠmĺ̉4v'#ÇŽ“e2š˙É*ĽÖÖ—é¬z]u x¤S9ąnNŁ kv~śF7Vú‚ŇĘ.h°Hý<ł'«(´—W©–ý89Ź¬:Ň^N\śZ™ôód?˘`ŽNĆ ZÝäć9Ťfý3|]â»rŇë"ŽÓk¤t=WF’) ¶5:sÝYŽőϡŕdÉÖ<đK§rń09‹¬ü6^S gôůúYÂĘá·ÎR+,'źŇ‰ÂĘŃeŽăE ŐźŚÓr`Ž8.VÓ[Ęä,şł$Në^ł‚°–âÄŠŁŇ ď4ńIçę»ëÄÄ'ť K…R.^+§Ń……ţĆÝg'k;ś—2 ÂZŠ&)W†’)Ψ9Ül)8Ą3ę€gľśŇ©đĚËŠ…Ő&gÔzžęŹś!es˘P1˔Ϲ-s9‡Ë>ćÂ9Ý÷ęúR.‡{â Ľ2€ŚhOńM§rů¬ů铨$-g×zść®¶]Ĺ%Ăîź+cËdYzs˝i®éT¨7íÂ5{ fŤPMô´íŤ[Ů*)Ô¤¦†Đ÷°­½Ra–űöšOą|ŠÓ)ŕłiU &KqŰ•qdGEˇkkµşd FŁUľb/ě,Çt*ďÖpL‡—z–pÉ”aXó–3kębˉő…B§ĐnéTřM^éüM/ŰŻt*t[6+ĘÁIˇ"[ĘžÔ·—ĚšjcEˇ´Ž_:;relŮôIŚ×Zέ0a-§ÖŠktď..Enéăe Ůaŵ|ŕ—N…oę'Ą¸vćÔz ¸9ĺÔN­MüŇ©¸!LüŇÓ3ë6ĺ—NÁ-cĘ˝+ĹO“„Šâ§™“˘Ůń:W–MźU¬ŕN…ÖŽéT0Őqh”-…q|äÄ:o׹2Śě°2pK§Ŕ@&NůĄ%TüŇ©Đäâ”qÂĐ?ČźE#ŚëpŮŘE®éh•qᚎ ż\ÓÁ4}ÖHź} Ăם.šíČ‹śWW?q‘k:…f×tÜîˇ(ř¦Sa źAe2ą±ű˦űrVÍo|`QqMžb)¸¦cŻD.Ĺ?‡NLnxMäŠvş`‚UŰĄLŘI ç´|Ó)Tľ[Ă7;ćlÍŚ,něŮWä„»Q]0áQNţuř$üŽúř=±+·MmşZˇr6(~ďŢ\0Íö)íţôYFőv> ‹ĄţŘgaGr0ŕ“łćPE…SAMó´Jűzč‚s$~ źĆĄ>ÉE“c`? ¦PăíŽâ˘™Á¨ko ąrŠ> s™łŞ€^2+±Ge9Á’ÉŤjsÚ÷ę¨î¶űŢBť¦w LŰo Ľ4c­(Ěu´Ő0¬ś(l™*ńiA1‘Wß;¨yĄç řjĺúô­)Ną6¶Â_ “űPş ĆaěWßű§Ă»Żôü\>‹‘Qú”ŽxWŞíJőô6=Zľ ťD:ĆvŮXŮۧŁz9N»ÁR(ű3Ôb»ňRpLKAčĚčnopş')›[Ů»§—B¤íUa…×lŐvĺĄŕšN…^"]ĽŐČĽľďíÓĹۧ3 •ÂÉç¸Ţ•făâý—\äí]™ĚZb;đúŢ?ýPĽZËfŞŤË-ħ/‹6W%Ęő¦ŚiKw˛}ož~(Ţ<e׊śäÔwĄŰş8ĆâĘ•źsĽ)I­đ+Đ=vďź~*ěźN…=¸Ę|W†ÍËVrµíđóĐÍć‚Ühď ¨Óŕ22Ţ@ýTpN?•isążÎĚ1ß•‹iÝCau* :†7P?üÓ©P-s±w–7ĺ:md^Ja^Žă»†wP?•îňy)ř§JÁ?;ćŇ2ýů®T¦v%îňaR1Ľ‡ú©LŰ™[©ř§źJ±ťqlřĄýó]éwůleÜĺĂú|Žôw÷ôS©¶3/%pĹĺ–4Ľ‡ú©Ě»x¬ÄiKóRpO?•fKł3ę8ßöP?”~ÜĹł•Ë–ćĄT[‡­^ €kďJÇwôPŘDýPrN~ľ+Ĺ–Ćţ×1š Í-„íĚ- [á-xőC¸î˘±Pmf.Ďa3¤l¶wĄŰĚĽ”iĽ•éMÔOĄÜ%ł•j3ă(ॄÍĚK63V~vłU"w®šňb«lĺŰÍVAć@çüTŔ›H1ĽÉ›˘Ąš7E!äoŠđ&oŠşç§ŢäMŃJ>Š' #SFţ¦(öŕ©Đ?ż)Ú ř¦(BLĘF (ŚüMéwůlEx“§Bý¦o"ĹŔ-<<…¸KÇ‚|ĂŢů)¨sF0íDl“7E!äoJż‹f+Zü~*tÎRćnň¦h˝îMQ ů›2î˘1î¸É›˘ţůMQ˙ü¦nruRq᛼)ÓĹs+đMŢőĎ( ^čźßNŢ’?N¤l0Ééňy)ęźßőĎ(PśĽ)šj?'Rś3ŕäM©nę/%ÜÔ÷NZNŢí‘z*śH0oŔÉ›˘îY w˘w~ ›<đ&(ŕ›Ľ) T–b€}ó›2ld^Ę´‘١“曼)Z—&žhíůMé62ăć¤ ™[o"…ŕSóMŢ­€ŁP˘â›Ľ Ý6fłĚ7y*đM¤px“§ U5ľ t“7eŘÄĚMĆnň¦\62{g—é&RNóNrVţ&Ču‚bĘ´•ąŃM$3ÝĹčůNß…’K)& o‚Â1ôÍoŠú~)Ő ńM¤¸˘ěË#G1eŢEcB]3ŠQ%ĹćĄhyLJ7ňD XN¤¶!ŔÉ›pŮŔĚÍŞp"e>'QëÁ/ŃMň§÷,n"Ĺřč&(攌ËC©—zc> › ‰"ş‰vL@7Aŕqˇ›H1ˇĽ‰óNÚçţmAt)ě 0ÝĹ0-°H醙hą…Wo"…řdăMP <X—úb—d$ů¸3l“üą ¶ Ęn"áň!ĂROoH1ÜDŠ"ĐMPxč&RŞa&őÓ‚Kş‰QfăömĂML;QąĂB › pkč&R¦‘( ¬¤MlŢÉÄ°ÔÍI0ÝDŠ_ş (Ľ‰„b$J¸l.ď$1ŢDĘf—˛+Ő«öo"…«@7AŕFĐM¤ Ó]67bşIÔęM7‘rZą°+µW!ľ‰~ŻßDJő!ĂESĽń/ů&ü4ŞäÄŞÔňĆ7‘`JĂÜÖâ’ń&(>iR,ŐŰIŤ7‘b& x)& TY”zs* ›H1Zş‰Ł@ ›HŮä’ÓVĄz hş‰ÓW ›D.Ócn"ĺĽé&úYžt)Ő\’Ë&eoo"îÖx)ý‰7‘2źx“Čcý,ŕM¤řYŕ›H)&ž4•Ř¸ř&Rčŕ›H0Âľ‰SGś,…;‹n•‘Ä·›n"ĹĐč&R|cč&Rš©$§K¦oĐt)t¦›,ĺ‰6Éź6U M$`†Ś6‘b^ h)ŘZŁM¤tQÂ6ĹáDmYđćˇL›”iS`˛‰Z>d n'M¤ ĂOÂeŢô“!‹Ň„±É&RŠ©%Ö¶í­‡&›HŘD;J 6‰¬(&’6‘˛©%'&ĄmĘ%` ´M¤pk¸&‘ĆXk"šh®‰_®‰šą&RŚŤ€k•ä·Í5‘°ń(«’Uť7€k"Ĺ€qM$ N*–V7|®‰3@ŕšHáş`M$»ÖDĘÖ$ÔĚ CiĚWZŰh°&R6úd2Új^ÍŮX“¨¸·ľ5ŃOăFŔšHiO®‰zsMB-ścŕšH)f’\Ř•Ö÷u@›HqµmiÎ'ÚDŠż&l)®%°M¤`îÍ6‰ pq­€m"ĹXŕ&R6˙d`sco{4ÜDĘe”‰:u)Íŕ’„%ŽýÍ›DÓśľNǸĹ«p)ţÄŔM–âźňřćĎÍUl"ĺ 6‘`Đ`“Ȩ*…Á&Rl"…!ŚÁ&‘¶•*`°‰”jřIgľŢŇ´É&‘ń@|+“M¤lŽÉĺ˛iăŮ$Ňl›qŮDŠM¤Đ:M6‰4íLňM6‘B‰šl"ĹgA6‰ŚGbŮD‚Ď™ř‹bŘčlŮe\’\xŚÂ@l"Ĺ”Ŕ&‘qNĺ 6‘Ň}ÖÄÂôsc/›H1ö°‰—2`“Čx)Ň)śľ·Ňl"…Ű`“PźĆ‹6‘Be7Ř$2ěĘE ŘDJ{‚M¤L_gbcşăĘ7ŘD 31M";ĚÓĐ’†î›îl°Id@—y-€M¤´ŮDŠA+M";^V ›HqlUŃ$ßn˛‰„ö$›Dv׆Î@6‘b0 d).TČ&ˇ3„`R7ąÉ&‘˝ľq;M¤¸t¦ťĂŁě 6íűf˛IäXÁ%ŮDJ‡2)ťŃÜhM6‘Ňžd“ĐĂJĂČŚÍT2Ú$rĚq<Ń&R¨F›DĆÄVěšă>Ć®é±)K¦›HiV:†fţęĆ›H óLNĘ'I왞ž¦™o}ç7żěž×&Ŕ7‰A—o"ŠbĽIdČž!$Ĺ~ééíý¦›DŽ¤Š±[:żÂÄĆĚ=Ę5Üd)” d“ü鱧É&‘c/ş“M¤ŘŮ$24ĐśĐ&R†…GŮĚ$m"eúüŇQhĚh“Čaťż%l)aJ‰BČ#ŁÍČm"…şn¶Iä`ĐÜŘ&‘ŁA]Ř&Rü^°M"Ăý^°M¤ř˝`›DŽ!Í‚a;[dHŁ!.ŔM¤lF ~égú™Á›H± Ůld$*ăM"‡˘ôŕM$t xĄ3T˛]‚W:G«fç€7‘Bë4Ţ$2ś˛]Ň(ť ÜxâM"ąŠ‚W:Gą—Ů%xĄSÍŢ$2“FeĽI´s÷rĆ›Hž çĽ1đM"GË4"N¤ ăLđJg0'3qNB#j„Né\×&:Ŕ7‰Ś÷¤Ć™o9č6Âľ‰ş]óM"‡áhŻNdL¨1$đM¤L_fR8¬x}»'‘qŁĺ 8‰†·üŰ 8‘Ň}–'‘±ĄŐg p9Ŕ?M/Ér ÔN"ĂOý!śDÎĚÚp"ĹŹ ŕ$rZŕGpĄZL&ŕ$r˘€Ő6ŕDĘ“oí^a4ŕ$r.±9)śHˇó†pëĘÓ„“h·?Ń„“h·?Î)Ă\”Ž•©ŰÚq9'ÁqívŻq"§‡'Ńnď„'‘q´—ĎX™şÇ fśH1{ĆId¬-C\3N˘ÝÓe3N"Ło] `śH1×tN\¦ěpŚĐŤqíž%‚8‘`š Ś“Či“k2Ś“Č(Ţň`śDÎŁ6żDäR Ć€qčŰĚAiNŰ wCN"c1妜H1ÜÝO‘ó1&¦śD ˘ŻÎnʉ”ń¤śDNŘĚäq 2€ŘČ ('ŃeřvSN¤®ĺd)ŰÝcĘI´ŘĽSN"ĂŽ©¦śDÎűĚ˙€r"…*ĺ$22ٸ ('‘SC )'‘SCj$” THSN"Ł—ăI9‰ś=r] '‘ńĚçr"ĹČAN"ç—ý 9‰vm 9‰śqR|bśč·Ů)0N"˘ű“qíŁšq9'5¸ĆÉR|ľévŹ> 8‰ś´¶'ŕ$2ÚµS€“ht|»'R\;śD»‡‘NB]óLpM·{Ěh‰WNvÄGN†ý™pˇ]Ě<Á9ÝöxĐ„ Ă|Ó9e6+G„“Čîň$śDΡýőŮ%Ĺź_“Pś7×q9Ďv]qů}<'R nq9Żć—•Íś›VâD ˇĹFśDN×7ôDţé8ÎÍEq?~M˘°,)ĂĐFÎčŰqcN4¬'Rú5â$rÖßź“Č8ôú`śDşů6ăDŠÁ0N"CŐ7ećĎ›XăD ™†śDzb5ä$2š˝ř¬ hÎs?/”“óÚĎ ĺ$2â˝X‚‡:ý ‡‰%J.Á% ĺ$ĎeŔśDş$L§ćDÂFŕ ÎŔyBfŤ9‰ôZ¸N€9‘OĚI¤Ăćźţţ`N"cí Ý€sé踬d|¦ÂÍ9‰ŚÇw˝é 1NΉ”ţäśDĆěű ŕś,ĺ 9ÉźűŁ°Ż'ÔoE^r)Ă°AN"],®2@N"˙ŹäDBXä$Ňc ś)Ľ“HÇŚ!,`N¤¸A‰Ü?°Q(¸¨ÓyCŕ°9'RüVâśDn10Ή”nމ8'‘š.ś Çŕ˘ÖĆ+ř¨S1oÎI¤›¨YrP6eďQ7č$r;a€N¤j‚Ź:ńả~›Éć$bŻÚỏć$rO„i`N¤đ1Ť9‰Ř+¬s"Ĺ8'‘[)8Dý6ÁD!Ú{9pSN¤M!ĘIäî‹ĂÁA{ŤmSN¤ĺ$‚ŕĎo7ĺDŠQPN"wqćžč• —r"a#M9‰ô±™"äDʡ(–\ŠŮ#˘śDşá6=…@ŻT6°äÄ°T'Ř)ŐŕaN¤¸j9‰Ř«3s"Ą>1'RúŤ9‰Ü‰rřaN¤¸@ÁśH1–ĚI¤—đđ1¸§c}7ćD ]‹9'RŚTsąëĹH8'R\!áśHˇšs"ĹßÎI¤ŹŇt8'R\ČpN¤ěëhě!ĹŐÎIäž›ăÉ9‘r™j‚‹:#ŕśH1XΉ®lΉŁFŕśD4•Ŕśčw1÷u*ÍPÔ©śćD •Ŕ)Ó“ĂĄăĹ–Ť9‘ň¤śH0Őu ć“Ŕ9‘Ň|ŇtŮěÝWćś p'8'Rxm0'ŕ7ŔśH1~Ě Ç€9 9ą9OňJĹĽ 0'o j)< “§ćäM).ť—‚ú©ŕ ~*8¨ “çó€9ySŞËç~/0'Ďwsň,0'Ď2sň,g0'R6äą|îĎç„ŹĚÝáśP¨–pN¨+\Î Ő‰+Ă9‘˛é(áňą =pN¨şľÎ´ˇ‰ý„pNhŤ8‘Ňž)†€8Q·B4âDJz2\0‡9@NÔA›3ĺDŠ‘!PN¤\ćž4ŚL˝i*PN¤¸ř śH1hʉşáa„ .ęTĚ`s"…‘ą1'ęňM×s"…ÍlĆśh,1ž).f0'RŽ'ćDŁ”xbN¤\Ỏ†?Ü Ě‰“YŔśheÔ)&ł€9ŃPĚ8'R\`pN¤P^`N4Ć3 Ąxs#VŔśh¨čÂs"ĺ4-ebbĘ&2s"ĺ4ÔäbšW6śŔ)EcN4ţuq9‘b´ŤŁ©<ĆśH9¬¦yĄnÚ ⧏ÁGťJő1ř¨s.0ž)Ĺ“‹ň){'Ľ1'R®'ćD3‘°‚“:•ăÉ9Ń„†~ÖśMh[ťH10ЉfSĆc:‘–eN43ôE MÜĚ…t"Ą ×tŰń÷›r"…Ďmʉ–jMKćDë»ćr€9‘r|‚kşíÍ@ÂśhŐ8ŚJ™XŰí†4ĺDÂiĄP0™9ű@9ŃŞ¶_̉VŔśh-Ü0'Z/7#D-˛ÓvŚ9‘r|‚s:—ć1ť`N´śß}ŇĬ”Í™6çDAĆňŔ9Qč€&Ť‚ą6'Ó)~`0'ŠIxRNÇŕ:,ʉ”)' ~h>)(škŮŔśH8źĹY4#LNĚJî%4¤`qŻóóI9QD‡ë”ĹYCČ‘ę´)'ŠiЉBN6Ö¤brĎľ9€N§b\ E·Đ :‘ÂIpNC›3çD4”ą9'RŠ•PŮÜ‹?ćśHa|eЉ˘xž EţîčDŠ_Љ…ü €NdD‡kЉ”bBɉm9¶Ć )Ld :QSłźŽ‹šćĄ ĘćŘ® N_e,Ś@' Pt˘ ,#_ť(”kŁOş˛®Ď'čDać“śÉÚ Mćś(ŚĚßΉ”Ă,|Ó9žó;ˇ­ 6żÔŢI=·gĽď­ÔÓŮ7çDŠa2pNQg¦ 1ľRŚs˘0<&^}oĄž{FŢ÷Vęé˝9t"ĺ°˘hŻ ¬>iy?÷üۤ)ŐĚ爛ŢńµI'Rü˘N×8ž¤)ĹĘ$ň~Ě])!ťH1kgď¤cChöNę±i&ť(^ÓŔ”á°O{Í9QÔ'@0'pŽ˝Ť:×ř Gń6ęáŔ¤Ť9Qęđu¦>7ZĎłbŤ9‘b‚‰wQźá-Ôc/,q"ĺ°‚k:g<ôJFśHˇNq˘Ý7ĉnµ÷PwgnŢ„) L8QDń|N¤4SP*AźÉg„Ż˛wQw‡˘m‰\V&ś( ăk‰ęŤ '©đł9®Ľí˛Ů[¨wĘĆ›(H›öŢDµČxE›OŢDŠ))ě˙Bź3öęnŇçŘ;¨űMn"/°é&Š`Çvn"ĺňYÝaĺÇ®k{u÷ŁM7‘ršJ‚Wşî¨źM7‘âân"…áŤé&ŠđźĺMÔŚ÷żÝt“Tř‰K:§ú®l„ÂHˇÍn˘- .Qč&Râ‰7‘ňÄ›h7„O‚o"%ž|)>©c[ÂqŁo"%žx)4çą÷PÇîHŤ7‘Ň} >i9=|ĚŔ¶„ť?űrצ&eńă:h&°ĐĽŽIbµ‚×A[ÉŁŽŹżúňwëŘŹüź˙óË?ţĂ_ţíź”¬FÖ>~řË/'G|äRĹ!l{˘óㇿ|ý寿ýę»ţćË÷ŮŹ«q÷ô·ŐŹ~őĺç_˙á;ĹÖĆüú‹ß|÷}NągżľţřÝź˙đG_ţŕ‡/Ľţ—pĘĹ× ŰĄÎ™ůă÷~ó˙éăo˙‰gm˙řYO%€[Wm°çŁţ"źów^-{î˛*ć‘üőßäŹsIçüj53‰­kiŹĂę‹ühYaV©~üĂş÷­˙˙ÍzŘ?Ěđgé9ś_UŕLJŇ’őł/?_7–«ż}üůúóW_Ö ×PłĺĹöá$|ťYŤĺKúY®ŮÇÎŘŹ/ĺqÔĎ}ńÇ“ţε~úĽ+ŃYý˛íŻű©ŁîcćéÍë˙TĹú‰Źu)“úĚ‹¬±ŰĐ×úĎ?ńµrSß»ýŁŻµżTOBHĚG}ßJ>Ö˙Ź•-·…&',ş+ ăď^ĎŻŔ =~­kRôń}î¤_VCoqţÄ{ćâQYfčyÜżŮÇ=îźŔm>ĺńÓw\ŁŢń~Çë§ď¸z¸ř'ďž˙sus9mËDű=wţÇďZţ7Ţ5ÓŰŻ÷Ç÷˙ş[×É­˙÷M5ăOţ ¨«ż«`¤6´•„<€ýüYFüť9Ěxµ•·Ł* ÍGYy;*§ukô8ĘĘó¨vcŕM~ó/ě*’¦UWźťs¸#‹öÇŐüéwÚÇy~ýw«3Čąđ(«ú)Čv¬zů}Dx®Šň=ąĆúpß—śÁťőkűÝŽăźőqţµ/°Ća9DOß÷[e“ţ˙ěëź~üűŹëf§÷gßÝ5ĺ÷}ţÄŠäĽ#<‘ĺËsÍŰ&~–{Çś|÷TŕOujrŢI 8ŰýËQH’ůű>âO÷Q%×u9¨ÚŮ TĄ›č·’7ůÇGÝŠFö>*ŻIt{µ•çQąˇ&ÇŻŁ¶ň8Şě}<×VžGeIre_GmĺyT…żţ8j+ĎŁ~ç˝%ń8ę_<`J^ĚLp_ňĐÖ×W+ř~ŐsĹD|ý^Ő_›˛ľëO% 5 ˙y˝ţ,Ż?ë{K(GŐđú_5R)ŠH7ź÷ÇTĘçá[jwX‘[µ( Ń'5„ńąů§„rmí˘xÄ'•¸("ńÉ2.‘8|]­6E$ÇěËĚᬙHQD˘ÁĘÎG„Âuk5ÖPç’‰Ý×őUĆ&8űyŰqś5?,ŹxúśIÉ´rŁ­J¦µ7´uÉpÄ'üş(ŃJĺ*qš±j¬öR ?yť¨†ĎšŐ]21 ŮžĽaŚň›7ě‡ÉÖ1IšÝaPxáĄ{1ÚÚň˘hÄ'¶Ľd4bC>iş`Ľ;˘(Ń|ô“ˬaëDđďj´µ—-J†"6s×ĂÇ  ±Ć%#OŁăĘ.wö8úbfľă‘‹"}Văńraˇs§9ťM€ő˛’»ĂT}­•ŚC|2ôK†!nd~C󝇬( Ń$ţÉ1çq' ˛* ŃŮ ÷>‹‘ůŽ„.ŠCôY+gxű‡’ľđt:'2(†8ťÚ€*žaÂÎî %ăŰ΢0Pâs§g¸xŔk8ť€YEĎŚ%%4Ü ĺb…ŕ•*˘(ŃÇ4.“sĎŹW Š’;ň 8Ĥd"ůśA±(ŃŮ.¨Ž‡X=Ź˘Rdâµ3křá„ćiĹ!ÉűJ X ôY%äY†ĹťŢŔ_2üP‰âÎÝËgřˇŠfç®.ř¬2ұf”'±rsŕłĘ®Hż¤đĂNNFW‚I¦¸;ocÉđĂćLŽôKř¬ň?ň<•µ.%ŤÔŇK©Ŕg•j’'ĚđĂťŽ’ᇤŁÜ:ĂU<;5y©Ŕg•“ŻźURMŞW>K*N®|’+.WąĚIŞ8ĺřäĎálťq+“t‹eŹý2úPé˸•B:Ę2÷Í/RĹ外ÎJFŞxvćů’X;OvS.îÔŞEá‡:«şő)üPgy+iÉđCĄŁ¬Ţ ULňU‚ŘĂW&W\®]2Z2˘Q™g/+Ĺyo˝WLĆ{ĺ´-Š?tŢ[š„kr1US„0sBÝÉK@ SbŢ“lŐio‡',~(3łSţ–dQ)eŔH+~8śJŘ,Č×w>‚RáĎ*gńĹe˘aev’”˘Äg6äbx‘2&3<6tH‰—/Ţł“0.ůX˘ €Vé›iŮâő(ˇł˝˙%§®˛2Ýë E1N0Í(+ŕT<BEÉu>•N7Ź˘QŁt׼ĂŚĚÎÚVĽľ©ĽÚXa”{›A€W`ÉŘÍ­@·(Ď·?Í ÍÝ{{©Y Ä]ă21Ďš+]E1Jśľk·É'ĘgNš+ó*ťéh•˘0DťĺŢĐ0ĺ_WI1iD9Úy‰fXż{±Ś~8+ąŕ±` ™ňĹ[čřk€H‘yQjzľ§Â;éëýÄDŹ´„Đ"ÚĄSĽż¬46o¶$Ećµqz‡A1Cž">fŢ\ň5† ľ“8Q tźŤŤŹmśŢ\ˇŕ-Q ÷†"Ür—§ďÚ’ Â(Ků4—!%¤ŇçÂ.¶˘AŽlą˛KÁ°g ĺ®Ë’aĺŘĹĐ´ş%-„¦¨@Ä|šb`VQ$b>NŮ#η®ĺR/­^!q)8|±(Q'yŞHÄ<§:©ľ×ĆÎ.]ë…-W~÷UES÷Ü&ă sž—<Ţ€őÖ–kżľLWěÜuLáÚ–8WŘNҸ\v čĘ7šĂťKF"ć@,#~íˇĐ«–«Á~m˘I›#\ mKw‘źx5. e,bNó´@Ě•'iă’9âGÎÔ’9âGf3~Ë%cŢm±Ç…ÚVż„~ŘŽ)ŘXĘx|K‰mlŁ›VQĽÓ˝ĺ rř2rc´D`\ŽŻ+ČdŤ;e!N\‹hÔüEŰrQyú$Í[.*ÓIg4bš–\Tf §ů|…á %ŁÓ}$J g?Ö’RB§Đh[®3ÓY4Ú–Ü’éł&¶e:ŞŁxC¸Aiă[rZ mśžą.,Ú6Ź=Ś4ůó¸ö㲕¸ĺ:4=m@‹i“ýŇRH—ëĐĹÇ4n˛ KŠöŽ·›¸„Ѷ\¤ÎzkKÔ‰?ťöT-aoďřZJÝU‚ťlKńî°bѶy:tľ,Ú–ôĚyG»”i3ˇpÄ|šË8Č"7a>MŽł(=ܵ;Ő ~ˇ%…9SŁmÉGˇ—O%§‚.éÄHRSh—rGč±?m'mÜ,{N ů~IĺÜ·‚G»”=P8˘Îr©˘pÄ|śR÷݇ňĆÍŇE+9…UŃ䜌ň$ú})†ő•Ź¶%w[­y¤Nš·B޸$±¸qLňĆÍş=ZšÜĺ…«Óc–¶Íę öŇŇ.ĄúćŠGÔYŤJťÓ+ý‚JÎĄŇ˝–üjMN”T6u;dşx´M@í˛Jâ* mKĆ Î–őˇĄSś/žó•M3$«(| ŢfP45ŃIŰĺŃŇ.ĹŁĄ H»˙;iăĂGÉé„ĘĄ9™…¬Ż\rî0/”á“pKĎ{äŞPÄ|”đ®óŇ!Hámů_ż˝ĄĽt`´m†7E"?p•_:™4Ś$:[ߥ ű—R=ŞĎ‘şĘ%Ľˇtvw·$ٸŔŮ=-eoz†™¶EˇĄQ⡴q)0hÎa¸Ę&Ľ¶th´Rş/#×ô oď-ťś.RüÝú‰a‰±k\Ζ\Ćůť­ RŠŹÁ9ť m®Ł•B‹W$bžŐťŚ`)?]A9ăRq}䌛Ý|•˘1‚kÍŔ5ť ö*GÁ‡Źqś–Ąźv) q Đ9fbłŔĂMśÓ/Eaă]9eXBÁ°Ü×Ő·>ďťa… óĎ´^@ź6cç~ÉraVîrP˘ “«žä‹Sqú$Ö{SˇđZř&ÜJ™\řlśtĚJ®; 4¬Ę˝Tˇ(Ä †06J]ÎéRaŘ0ČĺBMăNärQeÄ rąHaŢ®ˇ)Âá“e““ErĹĄ€ű=c;Ť‹0Hä"ĄXÁ/=ŁŢÇt .»ŰĄ Mq5RâDq‚ŽMč>¦Ú˛Ţ]†đ 2-ĚÄŰäe|č#p3)\%H—6ŚÁF2«íţťA&)~+´2—\7†-něŻŰ[\›¬R¶ŁĚŤzĹ®4oű-Ci\dÚý™ŕĎJa1ŕĎŞ?đGd‰Ë^§LŽU2͉<Ę Ź‹zŁđYa©c×sň¸¨Să ŕĎJ`Ô•ĂśŃeOčÇ™$‰Ëľ?¦;SŚç Ť‹:\Lî Ť‹:e ő>«Ž›/©ÄNçľRÄĺ€MҸh@Ťť¤qŃ8‚Ţs*Ť‹ŚsrX—şYLŹ,9¬; cn…4q9Î +8¦s,ÄĘă$•‹ĆKú$•KKĂĶť¬íIŔĽH—c3¬cţ•.Łľań'ôY ń|/đłRý&řŮ–ŕ<.\´˝_CIżV‘#YĂM¬K–JşŚrHZ}Žé|=—)üYŤl™ML´ýbý4PŇ`w·M ŚňqNő‹†Aşň±‹­ăĚ&Ú–_ ă{/cŐó<íł?LÔŚtÔÚ`źű^9©>Y0đ!Ëľ{‘´*[Ş—¨)Ę–,Mx]^Đđv†z’ĺĄ 1ΕŻ†Ëľű‘ŻŽĎ>ĽëŻf¶Tůě3hIB‘Uë+')@”Użi^´r< i^´şĂó‘ĺĄőŰŢ)WjgŤhrďŞÓ:’w–RYhň/ĽŇąUy#RĽ´~Űż“/ZÁ˘5džT- ¶ÂÚpUžÔĘŇ X‰Rĺ3jíI–-±ŃÎN˛Ľh®PdyŃRÝeĺň˛ŕ6’™,uzĎĹň#iđ lČň˘ĄĂiezYĐťr=Éň˘%HÚŚ’Ąz™’íŐ‹¦F{WĺJ¬vR}°(Xú~OrĽhŃt+8¦sa›ť©RKŻô™)•5Ór+ňşh #~’âEËĽ\… /Z îVpL§3#©D©ÁŠ˛ß{jźżVť'/•ű)4|ŞI^´T­1}˝Hň˘ĺl"Çtú™4娙%5§yąL^|Žvúk)˝!hO°VŰ©Ô^´"OűąČđ˘U{ ¸ĄSđł Ąţ‹ ç_ ¨<ÝĄ€;…đt¤wQ”Eu‘Ţ%~ˇŰ÷ÂTU‚Ô|üÓ N Rő$Î^•!UOâ…źz •BĺĽĐ*˘đŇ$wQô…OĘ=ţŠĎĽaŃ)Śš”U‘ĆÄVĺGýP(ć?+ĺđIř¤ÓyÉóVm&>-śľ NiE#ň–,çJ©ś¤Q®—U©Ä{Ž]­•µ˘0L-ô źd|©ô¨±¤Ţ(=ju&ĺW‹ă=Ç.´R‚+çŚÚź\¸Ž;ŕ“ŞU Đ6Ę…ŰEŔ'ËٵĐe|ÚQqäťĺşŞü¨ŽXeLŞü¨Ăq®Üţ¬ba]ćS:şwžÖĚŹÚ@[¸ŽBŐ‰şőe†‹fŹű• ŐἛŇ}€Ë·ă“NĹ_…;*&xřvH¤ÂŤ)h ľLŽ¸/łe"–)†GZQÍ\E©\$0„Íܨ2,Ý^«ŞÜ¨z˙<](Ž‰©JŤş°ąęÄ}j×BbąůFsŢqäTŹzśüÄRf^ÔáxpFť™u‘W„Ř1ä—…qÇÓígÔŘáöÁmčŘq(ĹáőĆĎU%GőY|g%GőYÔ—Jç-Ĺ÷Ę9ôÇ+(żfrTz†3oUeGu´?Ć^éQŞŻ‚?úŢ"P•Ő'ŃÔ•ŐŰ&—)…ť¬áµĹZ y»w,ÔJ v4đ ¤pa×—Ń0ńµ1˘VB×î­UŮQ˝ËŻô¨ŢĄá‡!*Ť]VđGÇŽČŞ•A4{=xÍV0¸aHÍ ŚóU‰/c ŹCö™¨Ú+=ęÇ˝7ĄV¸Ľ¶ŻTm÷¦?űVP¸bŻ­2U{ę}6ŻRáŮpĂ+0ŻzmĘ©É Řűv¸9!ň{kŹměGáĄ.ˇR%|\ ł´ m¶ĺâş›´Y)ŚŠ»Vx"#¤Đś+ů[¤0ŽŻĚ“Q¸;´Y)4đ mV s,%Iőóđ˘Ę’ęçÁ42¸HˇŹhkˇ”ćÍ;{Ě*jL·rˇhsżĆ(‚Řřyč6Ńş-w/R>ílţÉŻđö'몍]ÓR°@Úyć“:OG­lG#^…§#:V v« ű¦LâČĂąëUsą‡ňUĄIőóđ€řň%^ O×›2l_ś•¬*OŞ_ÂE\……zS 1öáçÚ΢řnóR¦ Ěv)5řßą|P(ž&D}‹p&ĆÚÎľ)8¤ĄP<gß”‹8ű0nł*Uę|WšËçÚź”uŔ7Ź´Ężî›rh×ţě9‹nďJ¸|^Ę°™Ůs«qöM9mf®]5đ˝)í.ź­ô»|č°DI|@Îľ)—Í̵k>˛7%îâŮʸ‹ź[€ś}SđI?•b;c J ‚0ßąß”yŹJ' Î>…ËV檍Ě-%/12ĄÎ7…Ë7ĺ´Ťy)Ĺ6ćĄ4ŰË#eJ-ďĘĽËĆJ9î˛ŮĘe;óRŞíŚłÖÔ€7ű¦ Űŕ—2ď±RĎ»t¶Rlg^JłťqŠ§gß”azÉ­´ă.ź­\wůlĄÚĐĽ”°ˇy)݆Ć+h5“ĄŽóM‰ó.ź­”»|¶Ňlh^J·ˇy)ă64Vr^Ýß•ë.ź­T—ĎéI©’ĄöwĄŰĐĽ”iCs+ădGĎC).ź—Ň\>/%lh^Ę°ˇąR»Ľ)— ńK©7f+áň1ń±ÜŮ7eÚĐlĄ“ŰĺM)6Ä/Ą˝ĘÇJĽĘÇĘ°Ąą•ó°Ąy)—-ÍK©6Ä/Ą˝ĘÇJ•Ź•iKs+×iKóRŠ-ÍK©wĽ”řťňń–§R[›í,K×ć9ß•jkóRš-ńKŮŞ_ĘŢQ}+äxySŠ­ÍK©¶6/%l‰_Š÷Tß½§úĄ\66/ĄŘŘĽ”fcóRşmńKŮ»ŞoĺŢUýR®*ÉJµ±y)acóR†Ťń­Ü;«_ĘŢYýRŠŤÍKi66/ĄŰŘĽ”ic|+÷Öę—â­Ő/ˇÚÖĽ”đô楌Ď÷{ĎæřĄśż[:{oőCi·©ŮJżMÍV¦'8[QÖÔń®°»ú!xwőC‰ŰŇlĺľBHű¦śžü˝oŻ~(íwJgćĺM™·Ą±‘öMą>çoŻ~(Ţ^ýPĆmh¶2oCc"mŰHŻŞ¬©ń&xwőK`sőë÷¸m [žÂőů~@őĽďĽ­ú%xWőKžŘlíS(/Ó‚Đ<㻶Tż~{Gő-„=Ô/ẍ żë˦ „gz·Đ§0öfę[čvNż„ň2'íeMúŰŻń;E±·Qż|ŇŻßőeDâeCşgw·0§(ĽúőŰŢč—Đ^Ö!>ßjAÎĄźO1÷Îé—p˝—Ä<ě‰~ vDż„ţ˛oÚ-ä$úíwy/ŚyÖ—É@Ď÷ßăe0$\‡ťE·p˝†2 ľ]ăj/cĐ_¶aľLŇ6楼ŕzßń‚ë ߡźlO‡ĚđČq%!Pd9ŢYŽ7EaăoŠâ_źŠŔ oI®žJ»ź+i;Ţąź `†7…WO…$WOEäM‘ ySÄIx*"3H02Ă›ŇîÂŮJš‘7Avä©@fxS.ĄŢ…ł•řüťËČĽ)˛&OElŢ 6Ă›BŠ«§BŠ«§2€ńľ¬Ę›˘éó›Ráe>R\ŐťžzĂŢ” Ś÷ĄČ¸Ľ ďCiđ2Jܠɭ᪯9n8Ă›ră}(őnS[i3 ®R1Ą8ĂSÎ𦔎ą•Ž÷ˇ(ĹL2\=ř oĘtöˇT łĹI#6ˇáM!ĂŐS!ĂŐCĐ …WĐđ*ÔŮ—·Ť±óQÂĎđ¦\wŮlĄÜ&†MBĆ3Ľ)ý¶1[!É•UAăŢ”r—ÍVŞŤĚŢhn<Ă›2ldnVx†7…,WOĄ¸töFđ oB:»ó&m<ĂSĎ ĺ2Ź ćS©.ž±AŢ”x¶ŚÍĐđ¦äŞ:ąč&4<…víÜ€)ć[hx*Pž€†7…W©¸Ah@ˇ,4<¤°ťŔ€#Šm°í6 áMéwéř¤i+ăŐÝÍg¦1\¶2/…$WRĚpĎŤ-Đ€ÂKhr= (<€) Đ€âcş‹gďU3 AŠ·üh@ ”ËVfއj+3˝)Ë€).f*1 o AŠ @Cř_ľÝ€†¨őŕgĂÄÔ˝›Ét)ŢÍťAŠ)ŕP¸5x)ĆP13őđ>8ă¤đ,Đ$Űž…Ç 2\ĄB$»ń RŘăb<6'Ď°. ›!îw‚Í ĺ˛rą`v¨»Ů R̲€Í Ĺ\Ř Rx^Đ ( ¤ż›A {Ěf2ÍoLLőĆł$ř‰a3H!†Ţl)`ŔfŇLb,Śo4„74öí͵n8ŹŃ RĚah.›˛w±Cf§$űvŁ¤„ ĆÉř6™A‚á"—…7Ď W©0ň6šAŠošAŠé ¤ĐOÍ ĹŰă)«˝7Úh) ł¤đ $´'šAĘĆ7á*•'š!r]ű|˘¤xC=&DŠŮÔL)ł¤ł›!jÝł¤śAŠ) ¶e ´1ł¤Ls ¶egÝŮl)őÉf>F‰®”_Žň‹ÓÖeR­Íf`.„Ř ša ¤ąŇ ?ď ›!ęNÉĽŮ RŘc8”x¤LŁł’o|»á RŞŻŁLW)tŁČt•&ŹĆp)ćVgB7i8Ć=†3D%l†©®Rˇg0śAŠ?0p†Hóz=á Rš!ťéL«÷YĘu•ŃŘÓ¤©®ęÎĺşé !łm^C`^š*6ť!jë7zdW©TłN¦z;C®ń ‘ć˙ôIŤŮLsĚĘĆ3HŮŔ†‰}i÷®đ Rř4Ć3DhšžAJ<ń K1Ńa`]bł¬ĚfBé™ÍçQĚYPş«ŘŠi8ý.,ŕ ţyâtć.Ř–ôE#éŠ\‡ßn2i xČ Ęe``dňđĆ”%Áe™A  2r/\š eďa4™¬>&fŚÇ€Ě@ş3.,Kw®ÉMfPÚ ZłÉ JVáŻţéÚ™A)0Ę“ĚđJśa2rk`tMfx%äŘd)~%Č ĘóÁ2™AŮAŽ'™AJ’”eĨČ ĘVF 2(Č ĘybŔdeJ9d Ś’Mf  ™®”O’*á•×e”ű%Śj¸°+;cĚ3(ĎŚY€¤ĐËBfP˛s 3(ĂŤ÷ÔCfP^ou™!“éđ«aS潇,2ňřäąşÓřl*’˙Đ—Ce =O•A źßTĄę&7t™”ťyr”ŃËÂexĄA2—Aą“Ř˙k.ň+=± JĘägË ĹĎRťĺ*“=!äę(›–Rf.4'rşY Â2(7Ő“Ę ôUô^¦2(éł3S”*k+•$qç¶v¦2(W<© ĘÓĹ ePn/×  ĹŐN¶ˇ ĘfRPeëf0tĺ;űţ$@”ÁĚŐ(˛śŇťăj'§ÝPĄXs‘exĄaŰPĺnŁç4”AůÝŠ•‹„pÍ\)Pę eP¦ąń€2(ť?-Pĺ´;źPĺ˝câc(’ĺ÷”A ő|+A”sĎwĘ Ü}Ţ”A ˙h[@˘Ý3IC”4Đ;Ď2(Ó #C”±Đ›Čá2(«!#cs”ř0 T¸Čźw#ÍexĺXÜ`efôŢxŔ ĘŢ> Ç´RŚre”'ň2©ˇAŻíMĐ&3(ĺ|’ČZů$3(ץy”ó fPJÍËđ†ęĚś®čp”súAŮ8ËĎć2(¨Aâ2(Ź(Ócs^ąF7—AéHůĽć2(«©±p”ůtHp•a^ĚĚÍe É*7‡ËđĘĚj.˛ąúÂp”ńŐä¸ JëGň[eÜłV”‘ÖeAil]M3ůÖg 荹Q"3Ľ2ěn2ŇňšZš\ľ†5„¬ËN·Ń JĚ°×h%6m4ů‰ą hĺ0c4R!ÓcÍđJ ĽŃ J»ěĎ›A©™ç“Í ĎŐ R\eřAbéâźť\ë§ăŕ7š!2z¬>Ń ;ăF3DŽu‹± d¸Ę€2C@3«›˝ë ”ŕŰך<áüľČ‡~ý™A9Ę©Z&3(Ź9om22¤j™AYÔą `Ňł[)¤C/e0Cx@üí3(ĄĽ0’ŐóÄp”á~CpIÇí{1!rěú€BŮTŮ~!2mřʸ¤ăžýĚ9rF,ŕ’Î4RI‡~ĎůĚe8_>f˝9[÷ć2D´Ť;2—!r,í˝˙p"cŇ 0€Ë9öIťÂ‰s)XĄIq“<ëÎBĽ© ˇupHgÔZř¤ úÎʶ© ;ßŰĆ2DŽ¸]Č`BÄů'–!2ŽÍWËAŢ·o7–!´†çËĘŐĘ1`"v˛ęŤem&ň1¸¤…2÷1¸¤µŮÉÇËëĆ”ÝX†'ZÜX†Đ.‚GZ\pCđHgđ›?(X†ᛚ—!rčľ™ ‚Ť÷Vt¸ !:7Ćá2„‡óßn0Ch‹[Č3DČŞj0Cx€˙í3D߉Ý7™!úN4şŃ ˇ!˙Í9äż|e\ŇDWMYPlä$Ŕ÷‚Íýxqä^śřî°˘źFĄl6CäL-Žf3DÎŘxd8Cdč!›†3DÎ!5ś!rţ°ĽŇŚwŕ€W:§ě¸3ť!2<ď gśc°‘Äp†Čx=ďćÎ eú2xĄsâ“pJgHßF1ŕ”Ι‰qŔ"g&Ć!@g ň«ć5tJ‡ńÍ·›Îöç„Î eĂđKç„Ć_`)ޤ™A˝‹7ÚCfPdžpőRŐ¸ÁÔ“5ăDgPg÷FgP‡čÇΠn”nŔtő´l6ťA˝ńVĎ {ř2Â3„ť‚ßn<:~¶SgĐŘ€…Πáo ť!úN<żń t›žA,xŤ]\ŕ4ľ)VđK÷Łďj˘Ćql^Šń ZM“N ć0mqă4 ŁA›Ď A›ż7| ě|#¶ójđçĎ ź!bn|Ť!ŤQ`s·Ć™Ĺ'á—Žąűř óÚ >†´®ůđ4쥅›ĎCc~jí3ŇÇM+4śAĂëú„3hîÂÎ1Ę&‡Îv°»á íź&:(6´×ĹÇČ+Ý™Ë6ś!ěÝ˙vĂ"XËűvĂ4Ańžč ˇ}ę€DgĐ<T„é š y›=t†PJ4.,:¦T—9 Š‰ mę}Ň43ŁlLgí+(¸¦s†Gő4ťA“@ŠÂxĄř ëɤ •MŰۇMgĐ””}ż¦3DnĄęĆ*Č9ť3[Ş˝é áeŁo7ťAd şé Ű?¸é šhW“pOGőͦ3hÂÎPËt†ČĄ/SDgĐĽßWÍŽŰpyüĄgÜŇćň„Î 'Dĺ˛ĐŇQÁĎNÁÜfł".ç˛Űl9Dü´lŤÜ•ç§…Í ÇŠßZl†ČuG?.›ěĺťńă‚Ŕ9ú 6\<ć!@`ÜWhŠl†đ˛č·›Íąrş/2)—óÚ/-8CzĄř…_:]VÍ ~éÜéwšAž/ż2h†ŰÄÍ Ú&/śö©]›…ťAž8F¦3Č[çĆ4íž}ă< 3Čëwľ 'ŕůšÎ Ď!É;Ąçž@g˙‘.Ďt†ČµuďG‡Î 7& Ňt†ČMŻ”é r‡ pÚ)˝Ě—÷ÇźvJŹsďb‡Î ׫٢3DîĘ…Ëa:¸4%ÓŇÉËO\ŇýŢö~Ů%Ý÷>iŁ"÷ #@fżŮĚČ é“ćgĂUż]?›Ë żöőä2D[0L‚Ë ď¸Ë.üçćfÜ*íŇĚ 7|ó1vH·ŤĄ4!r¶ą€äň߆‚Ż~G5Ě ĄĂ3DîŁěŹnÇFhţčş«ťÉ ‘[Ëé†LfĐZ‡‹2ÖC\8´fbîd†ČŤíĆl@fĐÚ‹ß2Ög\EfĐVÝd­űŐ µ±Čmöţx3h­ČĽ Ŕ ZN20–ś6Ľ!đŐ—óF5tʦܰŔ ZŢ5c0VŔ|/Ŕ Z%ó˝3h%Í0–Ú|wŔ ZŽ30ńčT fFXĺ·Ě Ą?SęĘŐAźŁŹ¦DúIc´Čh¨X­Cz;9X­UVŁuÉŠóts´ŢÉKšË %Q+p´lZž\-­š5—AËŻF#ŔeĐ-Ň\-ănE\­ôŇzÍeĐbđV@Đ‚±™ 8¤Űm…ÍeĐŞł÷ůĂeĐĘ´™p´ś=.‚Żć4¶ĚX)‡OÂť•‰…± ZI7S,VŰMâË ůöÄ2hŃ>|L%üj–])Ŕ2HÁg,â®'–A!PcÂáŹßn,şŹiÄ_Ťą«$X…3`­ŤePČ«XEEř™Á2(–Â%–AŠ… x2M&/ŃŘ•c_n•!~âŽÎ¦íÉŽýv#AbH)XV ;Ře$bU\Ä ¤ŃP‰íěN:Ľ‰ ‹aşn"˝‰ ¦‰'‘AĘń$2((ś@…ít+ťŕÎľýç2(ü‡±‰ ŠňĆr Rp:šÉ 8Ła%îě‡Çľ†2(^‰Ż`(޶ˇ {ňke‚Í6”AŃS|CÂAĆßn(˘°đBĘ ĹŰţ2(šk3:•ă ePLX{B¤F9LĘ'Š§p†2Hń{eP|ZXÁťŠ?)P…ąŃh e‚‰3”AŃs ü e‚6”AŠK(âň°M†2H1ę(âű¨©9Rů°ŐăŰ e‡‰»ˇ %¤3”A ľZC¤/ÇP)TyCÂéßn(Â]Ł€2Ha€m(—3PZş 2HaŠ`(úKCęäy€2řéc†Ă<÷8ĐP2×4”!{˙í†2Ha(c(ÂW™ˇĘ %|Ět §Él(q±Ą8ĐóŘű˝2HˇĘ@ îĘ …îĹPbyźPâ}}Lu$ůtwl(”}ťî0űío2”ŕc 0$ř20a~2çL7“AJř:Ăaö›ök&“™ RŕE™É@h6Ź “đmźŐ‰řLŹµŻ< ů¬›#l&š—™ Š&÷•a2Haîd&QéÜKL†đ~Źo7“áŰľ™ ‡§®É@€f:Ö~Ł™MdM"[+¸ D¶_đV^[4LdxíâŘD†{ŁÇ2Ľö‚l ĂkżČ2Ľö”l ĂkßÉ2Hařl ŰW ĘőiÇ3áµ fŘ;§ VŢ dđv›Mc`‡ű͡1ĽöělĂk_Ϧ1Ľöţl†¸4†{ ‘a l;šŢR}ĎÂĆŢR˝7+m\†1Ä˝éiĂâ޵i Ż˝TÇŔ~+îľ÷T{Ö2Ľ6im"Ăk#—‘ Ż˝^›ÉđÚ¶ˇ Ż=c›ĘđÚW¶± Ż˝g›ËđÚź¶Á Ż=l›ĚđÚçf4Ăk+Üf3Ľ¶Ëm8ĂkKťé Ż]wĎđÚ™·ů Żý|Đđ¦ě=ŐlÜ„†×>ÁŤhxí.ÜŚ†7Ĺ ]Ŕ÷†ęĚ0î Ő/Eîé{ďă5ĽöGnRÛҽaxěŹpď§vÔ´a oî齣sÓž‚śÓ÷®ĐŤkx(óŢL˝WËć˝™úĄTďŢS#ŢĽÓ÷n× mx*˘6Ľ6ÍnlĂ›R˝_Ř67Ľ ˲7őntĂ›rÝEł•ę˛ŮaÓŢ”~3 ¶21.{kňĎľ”Śâ¸QF?~işóÎxđ!q3|Ěň ă㯾üÝ—óřČ˙ů?żüńă?üđĺßţII3łĆ íㇿürrć¦kPţ×8ňüřáÇ/_ůëożúůň}fD8V…Ďä¦ëä~őĺç_˙á»,Ěóë/~óÝ÷WűúăwţĂ}ůľüqF‹\{óăCéťşńł/?_7.ÓÖ>ţ|ýů«/mĽZÉÇ?Ľw˛·×BZEĐzüőZ}˙ńĄ<ŽúąŻž«M«„WßGýôyő<‚s`ŰOő:f`˙łßSěí'Š=»­Ő’…N_ő%‹ý?g™SŽţÔ=hcľ>őň~ĽîX28)0…č‚3#ŇÚţĎoţâă?}üí?Q'~âáŠÜĄëŞÚúNťř»|8ę–ŽÖáQŢÖWţ>ť+×ęaVýřzîă×-ŮcĆÇó°î実¸\®)_«đ×qsşÉĺĘO\Nţ¶U+2FáXßň_r˝z2ľ†q.,,Sf„ĺŞ×gNßVĺďńŞçÇ­˙˙Ť ţOţ a«—­ç©°áoĺÔFq %±śĎŁ¬<ŹŇúď…˝ŽÚĘŰQňěă(+ĎŁţŮuŤ7ůÍżĐ%µ˘­MY´?.Có§ßĺ”ý<żţ»ef„ůź«v}Ż˝lŃVÍř^~źčë«~ŻáőgM“”nśöµ˝ěŇżŕăü+_ çäňH×h¨ĹüżöőO?ţýÇő?ÓśţŮwwMů}ź?ˇ9š=HŠţ#{f”č´żŕgąM xnúÇG•śň%»(‡]łÝń§ßiM!ňëó|ľT‚â2ăĹšNčü_ýW˙]:ÚÖóëoţb}ô}Äőő\ß(ŁNçŻ˙÷·oĎĂţűoó‹ßţőŻ˙6ÎÜ$_ý—ţł~ýíůîűÜ$ąŚ˙ůu_®Öü3/0Îăë˙ńöë—ßĺö\DţúŰl-8W°Üý ʬ©!°Ľ›Ęďo,y+eU“ ´Yă‡=o¶–KĘH*©Oh ¤ĹŠń]˘†ÖÁć•MÝă#)&VšŘß]ËşB…g ˙Ög,®lŁ 8°€´­CĽĎÇWŻ ¤ĎĆšŁ®¸×3ÄLŘËx§!Í^ëq»Zß<Ć_^*[Ć›ŹSŁšś“’ĹođP$śHň–Ük$ćSś"_‹ţÚ5”„4äQVĄţôµü¦ ŰsŔŐL%±ĄŰ| ¶%ŽćwÄ®“ĐN=ÓŔAôÝyăęk•ź÷róF Ń~ĽY»Ěz±÷M&ău¤“żŠÚ§ę™ĹRWÄPĎë“ág0Őš6@°TĐŘâťPîýťd=i^¦Łă)…LŻąLB_ĽşTýpq™¨9°sŕˇ;ń÷=/·)Č_ÍF?×]\«iĺc?q3ĄÍĽ­zMčľĎŞř1–˙áő źČ˘înݤa3†É/€¬Pj%ÝÂŞ}‹ô]Ä‘˝Ó.Ę4Ôëyö#´ŤăFÎ…p;ź&ĚęńeŽËřĽJăĺ n, -áÄŢϾ뤞.Xź< !'"Ž¶ “řÎKD[Çmëk …âr«Žyˇř—o(Ĺ뀔–Qä{˘¶ż ťšHĚPżŤ©ˇ˘Ťä–߇–rŠGÝBÔâ–§Ün!Ô;ŕwkĚ,CË10ôâWž€AčÓ"´ó?B8"˘‹“+čUKĆOęę UsdSă»®÷'!Róśr˝{ż%(OĐ‘\—b? ««Î“|~Kh3C ”ß•Ů1ˇĐvȲÎ[)Ő|·ü«÷EĺČq‘ű‘CÄ&%c…Sť dÜCŞŮµń˝vá~î_Ďąĺ!Ý)É~Ź//nyÍňî/Y‰V‘ú–™/ŘäŻ3ŚĺY4âx3ŕD|Üź}3ň-RűÁěa[ č/w±m8K$‡ ô”ńA&˝Ńž­Ń±¶Áiuź)ôÖz yĆN; Ž3dÄÚđ—čFŠÉ0­Čfq(Čň=âPřödSt‹ &]‘bÂłÚK¨":q…O[I:A1ŕ{z6çrUSü((†°ľ¬ZćÂđF=©–;r—?şZ†ŘTµ\°b?çE§TÍ•b[V×Č- éUS]#·řş­üčo§¬VBAd»)H{Îô{ľ~Ę1ő,(Š¬Žóžg™ŞxĺXşVEŞb u=[+ÍĐ \a®ŢřWČŮëĂĽęÜÂËrpĚ€Z±WÄł#Ǧż»¸HcŠ¸M`mA—Âwĺë†h›†l‡`SĽNĘRSP|–Ą3ęÜJú—kcuVë˘BŘę8éôQ ”ÓżĽÚw §|ş­ëŤ6;pŔĂ'áŔF¤T…“Q×1XÉ«Ĺ>4ţźÁ1 O?!řP·şú‚ŹÍ•‚_?nŻ-űˤŢ{U| fdn˝•¬Č´ š´TíÖ´ŕÂű¤·^ń9k¶Źü“„uăŞUŽ]3q8^MĹŤáĘF®ešÇ!uÄŢF4<™[ˇŃ&?¦2B}-~ěFyoťU^~°=×&«ep“xMbâhűçĽzÁÉŹ5Śńz)ŰD˝¤ńĎŹVhl6Ű°B.ÖÁÔjA{Á…ÂÜŚ¨ĐuśČîW_‘Ć])•RWHŕO…Ôµ€ŽŹŕVµ®ÄłëƉ'ű¬w›>ßćČ™mśÖ­’úC?˘?ř.,ÚŻ?”®…lKz@µ; :§>üËŞaµ‚ŇřN«â•ŕŻ$x”Ä ×'ÓŇąÚĂ2'6ZEšážÁD]é ~­›…ŤŇOĘ´ËćÓ¶‘ :yĺtňaAw3ŔĎďw"1™ĐŔ|Ę»©qÔKŇ-6š}Ź¦“@Ž[6q8Urß_ÚTˇó/_ހĄĆĚn$—m,,ôϬˇ†d-Ęí÷y˝…´V®;ťŰQ©z±â.%¸ †V8VćµĂK.křfy{Đ‘‘–ˇ!Ó?˝‹ÔoD…{¨Ň\P˘gËV˘źßú¶¦ĘY5Ż§ĘnGűĆ-ij9)»˛ę´”Jl§‚ ˙*Ż/bóôE21ˇ0@VţŤ鿆źUaöDŕhÚE^´kµ''e˘¶ř äJzÔ_\ śü9ŤZI¸‚p$>ŠcVćĂëV9/Ż”µŚ\ň‹U|OXČ»§µ„!öŰéS?ş!ŰëĽ]Â-ÍäçCJN¨wÎ;RD‡5©Ö/iŇÔUzÁçM Ł (¦l·!J.¦«>Č'q (ˇ-Ş Č¬śÔE«!%Ť¦yE[±Łď_ÇŽhźF°[…YA4‰˙čĎç߬“ĐŐG‚ČyMĚ‘ĎqđuČ:Q@qěé23Ś(îú8ţĄj,dHV­B+zA8‘rłoUnńzp/oy`ÝďIlkh^·»¦ÖĹÂ\FI4ë—Ńô†qÖ÷Łˇř˙żĺ–‡1tńónDbĽ8·ŐU˝äíżNܨÖhę(n°­3PäřlÉ«ßCYąz Ü&H˙ţB4úqţŘáeďdŇŕ˛đ[&®ů@'uEü'”¦i'?6ˇë!ü&ZžÍÄhřsÚ‰…§¦ŚL^NűŃë®nUÖŕý=MqĚ©/>Ćş" Î ¸ÁMł- áóÜŤŹňę.GzĽ#ĘŁď P ÂD4Š#ľź Qí÷$±üY7OaÎďe¬yňaěÎU¸TŽH2˝™I<˛FÚ5#$0ÇěFăădíbÉîúźŽ§±Ďć+pX‡,kŘkf†ßě´ć‘ŃÝpw _ävűE2°ŚS(͡3ňÜO®*Hרhx•p ŮOćš ÎfŞé0đ<ł®Éz]N‡óđĂRú#9w¸Ýę^ a÷“6HĄNű7*qub¬ăâ_ËS5Ą 6!N'ř’ľľŰs:îe@G†÷:Ô¤JDUf˙zçT7ŠcÔ6Č˙'×j'»î¬í6»~Ŕe đgRW ź BهDÜšu÷áşs‘\^m.çVřćÚüJ d}žřtCf@~×â¦H!BML[Gé¸7ÇĎłę Çš´p ÜĚŞŕ@đa J§9&źw.˙Ęçs0vfĎpś˝Żfě˘iSχńnŚ¸*ŻÔsđp7Žë<śÔśš–qť>ćé7Ţô‚QY[|Ł¸ř·& nT•č3Yö0fŘ妭×Ěćť|ë>Ś.ëHĆKZý´ľ^ŃAąň%ĂXŚqš5egëGRv>† ŤQ"wTaý>¦ba„¬Ő±ĂŐß_Ţ÷;4ö§dIËśę:ö­,gZqĬę’íňxÚHß –VA‰ŮŃifqť»ß1{`Řç·yUnŘ/ŮßĎ÷ďĂŐ­ĽŽ|˲ˇú¶xţĹ—ső•î!d“O©q™’¨|ëźÔ–ć4]|/„bfé§4 ĺŐ ˝řsSĹ?npĽvęhéMü|Ë…m$Š?ĺ˝ü¶B1M,¬Őőµ]‡Y {9ť“ĚTů˙ 8!&`6±Řü ]ůĹÇ!Ăî®˝J![‰µ27"ę‹«Ö9 ‹ÎăţČ´Ľx’vMńÂó,‡ţĺn[ł–ń›pŁw^Ľ] P4ôSnŠ[g˝ńŠ¦µ_áőm ˝üd†qĚ•+şÂ—‘ńbÝ=˙*ĺ´$üŚëš%´+Zźěäói!Ü…¸¶´lĎIAâşŇĽłs'čWŘ]ë˝DĚm>hË3Ë4Ž·žÁŞ*.bŘÄą=ë`yCt4_§†k˛žÚ—8Ś!\~ÍąµncĽD•V‹~{n©®´%“ď—ŕEL¬ybćY‘‰ĘUU%îßôâgç»'cúßr p/Ëö„ł-L/K®‘zs^x—döY†ÜÎŮäŃx7ůeu˛śxĽÜů,eÇgw$(˙$b—‘ÖĄ•#ăă_ÔÝąźf, ˇ2•¨˘Ŕ±ç›W5B${á;CÍÝV„ľűysD""\čBEói“"Ş)ŞčĎEXŢŮϱܺÉ&Ż˛Ůp‡k×<ÁCWą©V`­‹«yAKém…ŮkîŃ7Ľb-ýYÎVemą‘ęGŽťÄŔÇV– ŠÇ" č†3T{ ÄójwŤStRůżež:endstream endobj 549 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 412 >> stream xścd`ab`ddôńőÍĎË74Ň JM/ÍI, Jtµţč˙ńťµ›‡ą›‡eýWˇ ‚'ůŹ0€srN. /Ř †<†­Ś ß×đýgbšĘĐzôű˝ŁBWĎ|79Ów3ôŚ¸đ—1ßE—u7—´7׶ɕ†Dµws9_z±oĹwöďâËtvM‘źÔŮÓŐÝÖ—´Şkb7‡đ‹…óf-» Ö˙Ű>ä·‚ůoľęßyä…YľK­{7[bS÷ŃÍGż—žaţ±BtEaw­ÜoľSŘVµNÍ”ű­ÎV[Řť—·´{¦üwľ?Íżůř'Ůf.í^7ćűůŁáG…ţÎBâÂ{~ôÍ+éΑűŢÉľ°ű;‹qFfuZ\ë¬ŇŤŃÝqÝ9yÍMÂwVw•uWJçBĚ]Ô˝Jţ÷yöěR¨÷ÁV€ ‘˙îĂ.ĽçţúŰ—OΑűÝĚ^UT´ ¨č Š"> stream xś}T{PTeżËÂÝ«’ÄŢV0›ď–i5’hŘ”V:ř-ĹÔp ]Đda—Ý%yÉăl,Ú,+°Č",„á3“ ťz1g\ MZ9bĺ«wsnóőGw#˙¨oî?ßťóťßůýÎ9?Ä(ŠđĄ 9Ů9ĎĚśľbv«.Uřůp5J. C T ˇÁď?˘«ţ-üB؉™ŔźťłEoČ+H5­Oß ËbĺĚ«ĚkĚJ&‘YŬa0o0‹8&žI`–1a2 Ě1ÇóÝA/5(c”}ÁiÁ„Ě q„\b·á{ăĄVq@LŐ·ýčŹŕŹHŻ¦Kf’‚öç5‡_z99Óh$Ľżד¬Yş¬vp Gč@Ęč g±Îvđ^ )Çňť?ťß×Ü™łśĐ‚tŐpÜž@Üôá8AF.ń’¨řÔŹżRҢNáŃ?Ň`ý §üͧ1nŢB5‰ß©‰Nť??áÂßť>}î‹Ď—Ě$rŞq†gî–˙• DJ–@Ş°;Ź%%›t™„˙±łĘąáľĘ˙ęřĎĘÓŘ©‡KşCĹí›Č ń˘â–ÄÍ͸ÖGUĽúÄgÇOť˙lÁłä_Ęát?*ýđm?S2Kă4-oš˝ćÓŇDŇŁâ/u•ż›IhkŃC–® \Âe:đÂč ťlc=,Ub8ËOąqâ>@l†]ŕZ[\{FĹúBÄ&Q)Ą`¸~Ł÷ćÚĹő‘ŮöĹő°źkďîşůµ3+·†Ř ß.ěn/¸[żĘž,C…µ¬Š¤¸SŔ}1oŽvĆď…ß[_éWEđ:·q㦙ëVÖ}©'Ű›*ęrË€üašĘ zŻĂeë­'>íńŞY”îŻűFĘ9#*Ěcäć­Bµ¦ Ü›Şó IuŠâ<ŕćÁ1Ź€%8[Őč‘ůduéě+l3´f˛“9ĎŢ 4 ×h%uF;xţňᡀ˛±_T¸0é&)ĄZiŞĆkˇ*ÖduŰ Í‚Ź]KűCŞŮŠö˘ß:h:UY—Ĺ2»m[+ËÖSRQŔUł«±?ÄÇ6µÉđy`î=wËăw’Ůój,`â¨q4‰žk6gM+gckW÷Ň1öŇúÂ&¨‡^¨qŮ[OâP¤× ]wy'ŠxNTäGłÉ4v9}d ˝1Ő(ôÜŮőOÎ"ď^;FÇűă1:‚/’r/rÁJ’ĄěđÚÝçV1ě¦Î4×›ňü+˘ž¦ĽŔ×ĐŻOűă“C{:;żL ÖduyęGăó~ďĘäŮó-?7tëěéłźűV&’al8yń$>$Şů-Rú!SiĄ±Śl]łŞ$b!ö#óUűYw3ô"űĘ:Ž‹z’† |/˙ó¨ÁČŁ×=dNÖĐfÖ9xâăłp ôŽ)Ü°«HVyłŚOôŽ4rÂ=B2‰Qßšđ—•jţużňŹę÷śéř'8.đEđ>©AN–Z‚ŰU-€lLVZQz±ôä4m‚Íe5lĺřËŢŞ0MÚĚZr‡÷ä}¨´ů#Ö}í®SÉI\¬â}CŹÜí,\B¨UeĽçďî úźaü¶:iaέł×±âX˙82681'tĚ>×[ŕÔ¶Řw„†2Ěßw'rKendstream endobj 551 0 obj << /Filter /FlateDecode /Length 3114 >> stream xś­ZKŹÇö™Č)@|J B7ełÓ%vŕ ±LŔoŚ–\j,>l’’,CČoOU?fş‡Ă•V1ö°ĂžžzWőW5óó”Q>eř—ţ_o'lşžü<áaušţ]o§“??áLÂőĚóéâfźáS! ĺBL­¶ÔK=]l'?'3á(ăL3F™––3OvĹőj6—RQf9ůŞ)7=ťÍ…J\“=î‘Ô;GĆKĆyô¬Ř}hŹ' … Ž;ăíËk»•»ËËť˘Bń©ežjo˘Ľ‹™'1eHĹK‡lŠNUL“ZĆćTúţ7áżňhż AdŚ §ćş| Ŕ­‘„‡˙h "Ň%DśěWUżŞ{kt޶TŠŇ{iĺý­aĽ¦FąhŤëŇűÍr6WbŢË* ĘD˝ďäŃ})z·ĘúUżjčéâ›Éâţm_cBÔ8B,9o:SaŰłsýŞ(…@ÎČîU$ în[ŕ%|Řp®ťGíبJnÔsâm<@(ď,č6iŁKf°•Źň-Ô‰ ŁYČŹ>6ňĘÝcV ä+3j$MĚ_%,Sd%QĂoKÔPÔz˛x6¨š ´‰â¦*ŻŰXtM¬ˇPŤ ŻÓđ€uö7p©Ŕ+Jc¶ĄÇÖÇĽM‘›29÷Ű$dgů@;¬ëQ‰‹ŐEU^–Ľ˘|†•c0"cp*ĐŚJ,r°Ç!igČŢĂŐ°Ř d("ĽŁ*IUEššÂzh“4jŽí¤ń#(ů0Ů€M1» V®ß_°Á˛˝95]ĆęśŻŃľĘ íŰĹa<—őôpů<ľPˇÖ©©áŽjž"îIł+•h6›’éťąAnŐ’ą"ÝŃůţZ€‰­ŻČrď|Ařέ¤†ůÚ.Wł +Hł^ęxÄÇ2ťş q Ö§y9^U™¬*Rq:mÎjoÂ4M>Ë{ŕ™÷Č!ü9‡*i3S °‚sD5?żH¨“=iĺ99=+b$Ă38|·űxx;^‡NĄË&É ÉňŞ=e+B-Ď*źpPË'¨u˝Ů˘_Ďđ\’ŕXw H%“XýČ>V y â7-^đˮϻł(‚|ťs bĽťÎ…¦Vů<ůb6×B…j±iźšĂë+roX¶»fsâĺ,…Ë'n¶<˙pä/óţčx í:-zMţ‹—šbôśV‘ňŤOú×ű€źÓ§™”"K,$ÝÖĎű­ŻÚÝŞ°@ĄÇŰmP dM»‡îK[aDWŁö‡í‹Mó §Ń+ś™éoU¤Ďw P# .÷xŁa›F1Ľžb1Źę ‡6íî9˘DÍ b«ăłs˘hĐběź{ţ›ýú›öy/č—_?>ś1Ěř]{Zň=óćş>4ËŢŇ ň’~Ő ÖžÂ~rłYýŇ>Ý´Îbi‹lÉÜŞ|ϱˇwýosEVž ä_ÍąčŮ jWź0Óx`0Źö«››öş]íNÇ:€Wć)&ŃBŹŹ§vŞWvŘw§%í­ňřpŘŠ˙Ú;éeły±ęďüëpEľxóë›'óĚ'ř9ˇ·_Xń‚$@xÍ$ż- ú głm‘S+uĎAPîWsfzíďßżßY<ĹĚëŐ1 8´®d ¬1=čsŽ¶Ĺí,TgÝ«Č“ů|>ű8pů®]ďÚZ†ęr†íitDWUŚAň“şy8–jlNI^&I{LG©ˇ\;H˝3n4v‘őT'©âëŢţŁjS[ÝKă&gHáé)łMÇÍDżpnTëÜšM±Ná)CχLą ŁY@´Ň= Zź’Ů2I«T9äÁňsLśŘHëäVäű™ĂᎅF“—ˇ?*'¦Í±jř—Ă®…ë*ĄÓ8Šů÷ÓXćy#:çÝË™ŕĹĄ ‹Š¤‰Kű8¸ťKŻ)”Ă3ČU” 0`"Ř< uć°;Ź$vŔŃ™ Ľ0:´ •+Ź‰ÖĹaŇYv+<z25Í=fv•đÄ×AX Î~Wôq«HŠ](äĎ *ţüÓ%Ë@/s°łĹ˘¸ó<ɦ](†Ö†™‹ď-ęA4Ö±ţ^´@Ćę·”¶<ęcUŮ÷qśÜFcľn Ľß=Cć™PŹů1fĆÄ(ǢsäŢ—‡f·lć˙<,›_Ç™rhÇ…•™Tś8<:°˘…K,›ĄŃŽgĹŘ…OštétmĚTŘ<ăµ#?ŞvµŐ˝ş˛E°°ˇ•ŕßM Wa8 »Őŕ<ĘňŘó CŠŁ„ŕTĽPStÔŃ˙él´Ş„o.Cş?Ś•¸4ŮňŮÜŚc]9î“,wžK˘BčÁ)s]VTšĘÉ` G’űzÚÝ1éFŽI…{év; ÇTâzFťLF} W˛,ď›v ˇL(.óŃ.ůŰš$„y('á±ËxâÝB?ěşî/ä{źř=f˘ "©:—ň ž¨ű „®ś Çgá| ˙‰ń31ŔÚz#Ř‹7ÇăŢߥ˝ĘMAcËÂVŔ%›xÄ@}Łq&öň_ ;ăđşćę­B oS‡‘A˘Xmz¶Ě÷QRń2ϱÁ“­n«°\ ŞĂçůJ¤wL# ÂćcţÁ(u83˛ś€őÇŚ^ úŮ(HKcˇ(˝r‹ˇńy7bČÖż­q$3ć@EĂşž÷6făíöă–)»ůKäż•ĺčj·8ś' ±…Şt7Ł< ô»đ\p ç·9›QçĄŐÉŮiďď3UU8 ˘`6ú ^Řř㨨 N)¦ĺĆő¨ś “ť>÷3„#OgąůŕRp{ŮÍÇř¨¦G$ť.úJx“ý Őű&ęŐ }Yž^ć˱sÚ#ô˙#Ź˛9ŁĆCđ]ĺécYŮ‹ňŕń6zÇŹëuw‡1>AáRĄMë‹ĚTGčÁ(4eS(;ÚĄńřářfGcˇĹ—`\Ş<«QŽ m<ď˛ńť—QďŐf‘,ˇ|Ĺ›Z»!N÷†ęn°Ţ Ś˝łT8ß˝»Ô6ŹNŽ@ť-ż)č_yWt ‰Öá$}ÁŁť"űc{j_FěfL4!€l«k Z§vđć}Řá‚ďZZŁá–ÍţŮ'&‰v4@4†öwprĐúŻwű Łźµ„ç@»¶Óš•}mę°nměOĆýću-yTŚ<¬‚­j¤'ŽűşĎ.ľťüjÜóendstream endobj 552 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6837 >> stream xśŤXxTŐ¶>!ĚńHÉqȉAQ" "H/†HK¤ZHHďmf2“i™ÉJ¦$“Ţ{ˇŇK(PŞ˘p˝Bîő ęU÷ńnüŢŰgBź÷™Ě@ľ}öŮ{íýk­mŞ?ĘÁÁařň+ÂĂÂ׆l‹ywĘŰkübC¶G OFDáÄßúýć)‚AŽ0¨˙Ţc&:ˇĆačµ!ź Ą„ź% ĂÂ7~±(rqÔ’čXŹ8Ďří ;–'îܵŇŐnŻ€Ŕ5{ÖzŻ ť8iËŰ“ý¦HŢť*›–üŢô3gŤš=çÍ1óć/˙Ö_ŠE­˘Ľ¨9Ô›Ôjj µ†K­ĄĆQŢÔ:j=5ňˇ&R(wj#őő6µ‰ZD-¦Ţˇ–PS¨ĄÔ»Ô2ĘšFyRďQÓ©ĺÔ jµ’D˝D- SC(7jµ™r˘Xj+ő2ĺG‰©á”3ĹQ.”#ő ĺJ‰(šz•zŤI˝H  R󨥪?ĄsëÝŹî§rśćXŐN˙{˘]´.{á­1“Á<}±jŔ¬? řÍ  /MxéÄŕ5O =ääĐĂĽ†}ďtŽ}źýńĺńJ±mřŘá?;8W;?áFpn\(wÖe­Ë±Wćżň™k´ëŐ;F|˙jÜ«×_ |íŕČ÷Gj^_ôĆĐ76żŃúĆďŁYz„¤ţŘ˙i'ĐčĺUŠ>YZ EŔüHC%ęM ń˙͡´itÄ6ÄEZ ĹÂś"¨&s<mcŽFĐe‘ÝÔnő¶:ýjCŢ6g¶ŽĎŻ›˘Č†Ś˝I‹~đ;4\–Á†=± kk4 vşşÓ"Ë äó íŰE~˝Ń4:ßľg÷rőh±­{Rxgß ×S` OYĺŹăą]ÝŻŐŘ_{»ë5†X§±˘/¬< q¶ŕ1îÂÇa|‡Ů/'ˇ~ |ż+CNĚŇL±t˛›ŰBX›n<*řöóOŻÁu8ĺ)ťÂŘŹĘˬNHió'őâó_“F ¦Ť¦Ą‚ ˇÚr‚$śöÄ:4KSV ĺ`j0ŐGôV …Ŕ”Ń˙ÂçElYţPŐűH@•ýěö ˘hÖ«}6ˇó˘˛®G‚I +źeuřÖ†~¶9ň4OlnŠ(‰“ŐaŃoÍŢS`é/UhBzëç_:€ąpdËś‘éIi’zhC™±´Ťä …ĆŞPHuŠF­K}RTXíöŇ €Ĺ€]ń+ˇŘ3Ř_AĂ1đCGÁaseEďXŃÁýWmQ¶˝6µígÍPŠ/ł>Äýű7Ŕ|w…0ě›Tť ňý˙čz6Ťšú´öO˝Ď°jŞÁDŕʶ+üč´ŁyűAe#¸ @˘–!–Y2śu§&Jćx.vťń÷łŽćŢŕŘaŠóŮ—O]t˝ ‡ÝĄďuűĎáˇ-φ˘ \Ťč´¸˝·MŔ.Ŕŕ=ö/¦śžýT&Ší=vĐČ™°˝^¦“mđ‹óđěĚDú./}G#4c—xĚôč¦ŐésŮŞl:‚ŽšĎŔŢĎł‰~Äź±I%ců×@Đ%iücëvWŻ±ÓtŔ$ÂŃ8<ôöÂŃ+p˛µŞ‚aźŕ`Ѧ>t™űŚoóĂĹĘ5ËgĎ&^µŕAÁĂ»¶Ż€aűÝ‚Ć ŹNP¬ů !KŘh %F=ĺÍņb¸Bjś.^ľ„ĂĄô>+Bδz‡NŇÍ`,7”>â %21ôő;ÓÍČO„ô4{Dą^—Ű .-`,3”GRł÷ÉŤÄäH»Év(ëíř†öĆ—I7Ĺbjdzd4Ó†dwfÇóGřbC©öŁY°–%z,77s¬­ÁDÖwĹýz#rÇžQćô)źŔÔ™Q"…xÄŽ4É "vü? o}‡^rŐEçĹW‘€­(4ŐtY$|śPŰZŘůÇ™}Ä_ĺ5âÜť'sy:¬÷!šhöWálA}¸3ąwHűĐ{QŤř#´F;´:;´#:gčn`Ůo:ˇ}žŢ“I­Ž| &.ú7VbňČĺÂŚą™űŤŐ­ ˙„ż%4-Rź”–Ô]Ž±qö ŹŤL§ŢQć €çBŔlM€äťź’:dGU·“•ë5»·MÍ°.G~›Ńës"ˇ“’ śN’U(L/n=pJ_ h*ţ[ÖŃ.Ó®ŕ‚m^6oŰ#‚Z:„śÄ†bcY 6N—¤Xá• ŔrŇXĹ°Ű ĄÍę ë…gŃ,“·“p„™:˛7–ͽ׍o•€/ŰqźŢu’‰í7Ŕĺ&Ü?TĐŃi·@$'´M®@“ťŮ>żAlŞŹ0[é3čn—˙đűÉ»ŇYň`×y`n25~‚*žńůł·a‹dâ§Ńdďp(ű`-Ă. N-b×tˇp¤†ç)”<’€|„JŮIDĘž>Ő‡źűzÇ y.‹Ěî=ĽŻë5a‡˘8~©hă]´Ń‘żÄżů,Őŕ{C-Ťgâ[Ţč–¨¶7ćd˘„ТŘzú~dŢS eŕRPÔ„ÜĐ?¸úŢeHguşß–Űäţ:۱pŹŢÖŢĄ—<ť,›1K›.*R˘«M&Ł‰T JIi©[ŃRm°bůąÍO ś.ř–ŕx•OTßĹÔĎŃ «Ăßď?Ż#Ůk Ů+š”/ż@' ¦“˝* cô8|B”FCµö°ö ębZN ¤˘Ëbµęĺř5u<“FëŃ Ń±nCžö\¦ ęÁ;¸8`˛Xk_;pßźYΤө>ĹřĹ •%©rˇĚ…YĺA\=ŞÓN;ő®YťŘm|™@9AlĄImŘ‹B¸śk;żĆoÂ6rwmh‰¤’ŔSgÉlÍČJO/ÍČOĎ#±ő9 ‘/‹uŰ(™Č°Š%Š“ž?ş¶ÂĹĚ“ ëRt4mźk­]e0xŇOb]LjÜöD21i×VPą®€Ŕfó~˱‡­hŚ±;«:5˘Mx8Úd"˙M@›śŮĽľ›Ś;é±h:‰Ć‹\ÓŽ/ö950e,çőCµ}g—.»’ü3-v€~„Çă‰xşh'ÍÖőz„^ěf]„ŔŻhw ‡ŘNŃig™Ói@WBąiE"=Í6AíüAbÔ#Ď? ÎOÍşřÔ¸piC©©ŞSBôT’‰D>@·|Č>O´ôŃNh Üí˙™WŮ+f©±¬łbĆëâ„Š©±GrÍň˝±›Ń;¨Zí‘Ľ»÷ ?¨GůĂ Ö•ČÉĎĘű’ČB±7ůÎ ßUwWŢ͸ äŻIh#[^˙OSBc¨„ÝĘDyŔ÷mYj ĂŁÖ#µ¨Šf_¦z§ÜaY…íOušĆ°NT¨–çĘšN5Đwńo†”4€ Ŕ®™IQţŢ»őŇ4€LKFˇ#Ue”Gą˛źĽń‰©‘ęí5;ŹÁ¸Ś8s’đľ$m°ÔĐ癣«‚9‡& ±©6 4ÄŠ˝"^•±y!Ě€UW ľÍ:z˝€\Idí‡4Ą6°HVI¶˘ČTÇäŢ [»Ál\”N˙đT—XV .őg0ď#ÇćŞčž®€ ź_@/“|ÁÇu;#”ş”„Đ k•áŕÇőß0č]FŇ«ąµŃľßăá€pĆĹá! ŰŠÇ=‰]íHaߌF‰q ]}ăĘ™«pÎE©Ţ|Ţąđ…čśř(úHR‹WůDFřâCľřŁÂ´Đr¨©!™ĄqĘ ů˘řuńkCă¦Â4+K=®;‘Ďr&§=çJÉáŠóMąwá4)ÍŢĆÍr7ĹĘîT‡†‘°]oK˛-ą·Ŕ†Üsfwđ5üiqö…ąśą0c‹ě=ĺzn\1±ěš5 rlźZ[Ů»DŹĄŮe'Q» î#\Üń`š“u$ďöeRB\ŇR »Z Ş Mµ]¶-·"ťŐÁ.ÂcýŹňnâÂG^đ $Ścţ‚XFâަ„Ň hą ŁI‹v˙AÁ#’ÔTë˝—LXuéDżĐßAĂĺz{rIĽ€ž=s˝!ô‚SÁą6‰m=‘jŰŕÜj[Ü9{wŤçÄĆ YĂ:ŇQnJóŮĂ°—wĺČ‚K¶¸ľ 3Ýd3ÔŰrr’%ɱÚPM`vT¦|öVĹR˝B6ýź+ŃË |^hĎ˙»ąUy|s ŁČÜUţ.0‹i$:CJ¨•’ŻĚ7”AËJ7óÍŮ űşNźŃsĚő!üý:pěT/S}jťĽ¶"·ŇźžQ®Î†"¨Ę%‘Ź}±#iv|ü|`ě9b9Ĺ°ź =›}âă“®§ˇy39éQŚĹjżŮŰĆÁ8Xz(ócCqAcKimˇnM©ţ$˙tz—Cě9ÂÁ~‘ář_Ż1ĐĘ?­4‚ŁţĘEFá“;űN€Ë_»ĆčnDţ%°…¶-ł™ě— ľĺ‘ŘÔ(ôü)ÂĹNhšJą; Â!ë°¦˛/fdi+Tu eňśë­uÖĚů߬¸‹Ž-î›k:SIŻÁ?ŢCíČmş„pş&Ľ$.5V˝ť(oJá© ÍfŘ*Bs«$Í®ˇĺłĚ}Ě8ô“XµÉ{ő`>°żyťfżˇBł—Ę·;Bo>qB[ňgÖĆoëV!Łz(s<ŞOŠěÝ~©O@}¦Ůńëřr±±6±<ś`›® /Ž­…Z¨.ďŚ?{úqúĘm¶Őˇ9âěKa)óDfşĎ/ćvć·d±ś8{ô övzHZl¶¦´«*G\×­I4¨’’C[|rIr„ió¤3ËZ<ľŚFŽ\ŤćËx’_|Ö{Í#†řk¶ĚżĆđQFqFQFqpW3‹ą®nŠaMĺ`ÉĎol ='ą$ܻܶßŮÇt)›’č‚!öK¨Ű˝:QW:”*MĂ>–»÷jÄ-§8äb÷°Oźžxa߶ÔމptźNţyBhuŞFľxůľŢČw%ůÇ|Ů6gö”źÝíÂ3h=…^µt{ĆMŃ`"O]ńäŢLc;ÜZiě…'ťG?wÇł·ĄÇěćo˘IjęgX˘%Ď\»{kŐ`Š.‹ÔÔ&:˙ÎĂ›"VI=ÂďŘŞóJóµôčšě ŚškC űż÷č^Ä}3ńüŹÄ×Ý||Ŕe=¬=YüëŮ®^¨Ú~Ď÷'/­ĆŹăńkď<—'đÓĂR4äzĚŐ˙_ťˇ#Rß-ç†÷'xjź´2Ľł÷ľŰŁ¦?»CąŘ† gö_,,'Üô"-g(%5|*„¶äŔ]Ęć¨â †`Yx,ĂŢ©7ÄC˘kp÷YĘ`/¸ă îyžşß]„„%ëŃRŽ=ÖQpěČA× ČIRxîÂ2.ˇgb»ő‡ :Čtř¦ §A•WťPúŐ-WW“Ż3kâ›Ńy±ą%äŞQ4ËT˘ŃąÂäš@˝śĐ!Ź‘grF4-¤W#!Čl7ňH/×’!BqSKF.' Čł\ĺć;€hú©Jśm Ţď;!3Ö)âő k“¤Ĺéµá©QEÚ"Š?2źŘ·čénJźBjě•B¶áĂH¬G«»Ż] ŤÂ¬¤Żś@Ô­ă®·ť˝”÷U)4í ¤hOž-›ˇŮ]­("ŤPu‘±6#Wź§Ę,?|Şá 0wÁ¶E:M±Řkµ›76á•śBĄŃędÚ*;›ö`S7đhí,±˘€8ÖTťžŃéŘ!#ł­Í匵Yźl®ó«^a „¤ÎŚ,IÍôŞ^  ŠŔÓ9őÎěŕý1+S6§Ą†á%ś6L€Çę»P'Á=řľ´îN†9븩¶ŕgŢk(ŘW¸żŕhze—;ů…2.ˇMV§ËéD­o&čńfä.ν¶űüĘúö˝­g-§ón®¸LÔ1ó}ĺK´Aĺ˛R;¦ÚŚüÔlťˇµáX€ą¨¶jCăCcwGFéô«SĄ  ë «Ă4ky –Ą¬NYąlůÓn9‰G̦,3éĺ+Ąö;¨(©6X:őŢj43üđib%ŻD÷Ä…ňB ‘[j­Jł'W‡ĺ‚Qjýp §KLŤi$áe2Y˛›?.>wˇÉ]á)›;gŐL˘†Vd%ś1›,™†RS]|a0RVjvÉf]_,$’a€č%ȱ‹ýÚQ˙v4›Xł„Xhť.÷’|Ŕ;ÉgÇ>ô˘îއfČWµ­FCöŹ.Ż&öU™ęłŽEśž@,|đdüŇĽu'NyâţŘ~Ô˙kc¤]’MÍŕ ˇÇR¬šJseF~v»ířçp>Z–ĽP0$;Ž?GL¸ůĽcÇŁu…‰ ‚=«KPoç:eS JÔDE4ކ—/‰¸ź^¦ j!1Q’cŞ;‰Z‘'rżvľ˘8#Ă˙, ¬h‹Őé†M-‘@ěQwkíůĹe_ל>f9›÷ŰBż=&Ě“ÍQ®iÝx+’aoĚ‹s÷Jv“L¸=M@Î ~˝_ř/&§¬YâçNxŃŕë>±´YN^:ú%܆cľJfŢ/V,yí,ňÜ{¬m˱e[mż…‡pxyŠ˝‰FwĐ>™ż$Î>ś• ˘Hő‹Ă~ś^ qµݬbcQ*hŰźŃyŔŮí¨•¤ť!¶ĆŰ—‰KѧâH3Ţ6IĐÎř…YńřĄLßJŞÉI8Stň`:iüDPB`zBˇÉd6Š„(Ť$˝Ä$‘bl^$tš 7Ń°&´‰ńüB¬ôţpÍ,Ű/çÝĚżw§í:‚ĘÜřę]ćů˘®‰9•|úMîUű!/±wöć˝Y'˛Žž9p1›ůĺ©łXąÁgł‡b/ ă.%·lUm°—v4ŞéÚŃčv'$nŰ-(Äv’v>AgřłâĽŰamľ° |WËÝ’ç×­= ÇŕčąÜ[ Ň?ŠĺĢhHIPËźrż/ć4):mšZ—')!dzX ŮĹćŢĺ·Ąś9Ű`JĎd6>ýEśw3âüFŘ›˝’ĘÖx‡ăpä|îMř,±Ę/&ś(ö+9Hkł>6¬¨ĎňŞŮAú§Y¤•ŹŽ±"«Éü8ë㊚\"T "T~öä˙­ŘP˘ČJÉÄŮČCW‘GnfA–ˇÄĹX‘”+!ŕéŇ$Jü?x'—˘‘Şt údłÂ˘F'°?—§ĚHłÚP–k¬°»Őçę]˘ŽŽđNDí. ńcZ»íę¨É®ŽţCÔQ“ Ž"ń$2)Č.ˇţC$T™¤ lµ+ńǤ…o%ŇŇnź Ţ2ň49ĘL|ůsr‹ŽČ ÄÉSct 9Şl5ĘĆľŠ=äjÁ>—Ô"y!)hĆô Oˇť\¶9źśÇn paä¶NśQ 1JrqżŻŁ‘K ę_ôÄŠF˘·ľ-ÎÉ2f¤gĄ‘0 ‡ąmŘŹ6Ľ[łń ű§k+©Kiz–}­{d­qĸR40äAÄń7<ۢIąO‰OS饵I‡Ćb9ž®đL· ŹÄ¦$Ą(µziš*#ľ :@q;„,öĹŚź©>sfÝx Š}zlŃŠ¦č|4ŕ<——™źi(I7šęvńg®ÎýĚT—n17 °Ą)µa)úČ·.tô &Ýš$Q'Ő%dkrŐŹ˝8<Ŕ+Y-Óčâ]ŇRµaŤ¸Î± M¤ÜC–¦Ô5 iJ·ę˛?˨nŰł§ôâöJIdA) ž+r>l}wţžDŁ~żŐ?©O)óč*eůýCNbLi¶Kňg*N‘ĂćçshëŰŔ×ô÷ôâľBsşđc*5š ˘¨˙HÖŤŔendstream endobj 553 0 obj << /Filter /FlateDecode /Length 163 >> stream xś]O10 Üó ˙ ©Ş*!ş0´ŞÚ~ 8Ę€…0ô÷%:t¸“컓ϲëŻ=»ň=ľ(ul"Í~‰H0ĐčXT5‡iź ă¤ÝM‡÷'¬˛Ű|×Éçér*«j ˇ74Ť5Ź$ĄÚĆÚV›?i vwÖç¶@©•ł˙Pr4—8n.1§Ň´4ÉÓď™ŕCNÁ ń5> stream xścd`ab`ddôńőÍĎË74Đ JM/ÍI, Jtw?ţ“‰µ›‡ą›‡eýw+ˇ;‚7ůŻ €ä KóKR‹3óŇsRőJŠ ŐŰYľŻáű±đűDzď»Ę…ľç>¶?+.śđýřŹ›˘ť +ç•ts´±•tUUu–pOčö™âŐçÝSÜž¶©›cyďşňSŮ…zôšp grĎÔîÉ| Ó~8Oűn;­Ű ® Ür\,!ů<śgOě óű'ňđ00ţéM~endstream endobj 555 0 obj << /Filter /FlateDecode /Length 5404 >> stream xśÍ\[Ź$·uVňdLňâűdčřE5Év…÷KH‚H°ˇ\ě ŕ+?ÔÎjÇmuOKÝ-Ď®ňŰsÎ!YE˛X=WmO5É"Ďő;öw+ÖóĂ˙âż×» ¶şąřî‚ÓÓUüçz·úç«‹ż˙Ťăđ¤÷ĚóŐŐű‹0…Żŕ©Ő¶÷RŻ®vg—W€ÁśÉb43=f\˝»xÓýË÷—¬gZZÎ|·»0ßIŐĺO·ĂióÇđŤőÝ×—k)UĎ”ęľÜÜfĂľÁ/Dď˝ęţmą®gÜřî]6ćâŽ;ăşí'Čž1×ÝmNży#;řÜžó»«_Ńtq Ł{fÂyşß,śą7N¤#›­>\ÓÁî¸ ď2L 5ľËć )Ţ .xZi§ *¨1l/Ă %ŻÖRŔ‰ť\­Ąîť1a‰äR@şS:ŻU@‰ĂuřËKx’HţČOqz ÄSŔfşM_ ëé+‰ĽHtUNřŔG%ॶ|~(¦óŻöŰw8‰˝Tw·Ä¤îÁ‘Ąźq2ĽQu×ůř=ž ÝýńRën8l†Ó×áEŔ‰nsŚóęţ”Ď+^zŘ÷—keČźčľDůł(Š¦ŰSđĺ&nÎąn8EÁ9Ź¤Đ˝n%zg>ąúź(WšÜd˝óŇęŐ:űWq¬S+Ře4TŇ,­yo¤öŠnţFď·˝0Z€gCżęâP_l@őB oŁđߥ1"{±ďĄV®@µ´óŽţ˘µC8ŚdŘ°ZM)ÂŘÍÂ%hä™’AŠżşŞ{`—Ýg‰´%Á¸ď™gQ— Ś*)5Ęĺ«á6Ť+čôI“LřŃx~/™@/_–LľWp\ąŇ˝uR’Tî㪥$ýek¶çŢ!Z*ŤŤ5ń,ůŔá#×JrXDöZy88Dît·ŤZ3‹IŐ†C4Ő^v;Ô43ř9KźĆ‹î}nNéuvnšĐ1hß6MaŐcn[Đ4MÓ U|áhěłů›íć4$s ä‹pL.LĚ-mČ’©¶`—ŕă©4@Á ‡…ĘťÂk6űÜő¤ÜôVpŕÔ—Wű¦űeN°ÚĘęf­•új5#>gĆvű–» Öűg;Ńĺc†śµ9Ý^'­­Ô„Dy“ĽŢoĂ+hJËÇq×k°i8ÚoÚ…ç3ކ3čeŃ9nnFčn7ś›Ór9s÷tX Ď5Ęq˘KO3”,»Ů6ĺ÷۸%°`Ł/z›Cˇ´g+Á$‘\%µ8bé#ŔęŢ×'ŘZC;Ą/ŁG –{©HŐÂŘqÄ\B”8§\ĺu9 s4ÄLŰ é:Ľ«Ą p ďv MĽ‚/Ľpţ@ p€łěUśl+@ T‰"˘Đö™¨7]0ÔŤ C/ďł›ÜG‡>Űl1@/ło–%ôŰ5”w5 š&Ô¶ )ěT7‘dnnŘĘW@)ŘÍ€9‡KŽV‹Ž|·ĺŔ^®+h¬łĹfșēLţj+ŕJ)÷`+ {Ţ9tf' †.@JđĹ(LÜÂ6@ÂđDÇď3\˝Kô0¶¤¸@? }ĂaŚ°¸·5BşŔ|twÎ…=]ç’?”Č;ł A†É6 1áe``§LÚĚ@e"AL2ĄÉ=ĆçđYĆŹ\Ńđé dą:FBG 9!űĹ°(Ęąž¶:9ßkë›öś>˝ЧX hŁ[ 2p˛×ôQwbBM„îĹ ą“ e«ŚŰî—·a>š–™‡–š€řŁ’!<ĹŕD aÁŕS­ w(bŢSä68óÓ!Ě`ޡĚíréę"€ů”8lćZëPk5¬4OkňkÁdoąŞX!’1Šq>9Č c3íµŠ‚#ZţüŚýL÷łëýíéĐĂ™đ$·§ź5đޤAt$3,ďz)&‡ôh,_Ű\eÄ3ˇĂń3Âߌ3$üÉTµ_[ă“uú”ŇÓô;”±Ćśa …ŠĐsgç†Ýj¶?Íßq<ŃAo3»7 ŔđŠVŘ=ł¨1uHĽMÔăhÜĂ\©;‚1&©řęë\ĆAŰ^·Cĺ5÷Z@t7€zÎËđ‡f®mZ€[“ÜžĂZ"Č şbÉ[¦CqsŽÓ¶¬Ł ¸V-áóŘCďĺĄÇüI ¬]ýrÂf|Ł.“b^Ž8…$¸ąčkX§YyQó(‰-.€ů·Zz‰ —Că­K/}¦x(aOŘ!Đň¸lË÷ł)@$Őqô˝Fĺć{_XtXŔ[í yL?$Ăó(ˇµŁ±KB+–„%ňˇUÖ. m‹3š2k-ˇŤj|źĐĆaµq]Kc)c\‚§$ĂL•Db+çBÜPŠŰ©ëFvň\ `!;9ý5†ňĽ‘s@.FřsË,gâSŐU@»9Ľ‹oťĽÚeIŔF) €ŠüĐME©YČm"S¸ â‚;‚#LĐđh1tÉOz;DËýÉ(đşëŃżţyK€AV`ú)Gü+#\Ă,“ üL=Ş3Čz‡==oOő€Z‡+ř!`:ÁŹ_5„ľ—J§ěč'Í |´Ŕ˛8†/ŔW‚Ĭ„hÁxmżĎŇ>»ŰŇĽ'ťKŹ  /V=p‚Wăăî°Î\ ţ„Nľ™DŘ­«Ľ\¨e`07.[cŃÝo˝ťqY¸(sU« ŕ&xŮҨŔŚ‹l• É޶ŐTl%ÁT ˘Ô ĎŐ…â…cDr /A[¸ˇXŘĂIf9”:†Ľw/Ăf!,ě… ĂUˇöăöǢ™Íqú<Ś%´ZÚ ŕ{ÇŃŹ É«Ąă$BZŤ< ç­ŤÎ WG†PŐé(˝°ńŻOC3ę”U¶*©‰Imté®ëPCÖÓ©3v6r$#>äcÝńL9ňŞwÂVQÓO3A9ev•ŮdW˙}Źá˝âľŇŠYř‚¸‚šÎ1¨'€ďgśĄyü| Ë!Ćź§îf TŢ+/#ţ»i/uoĽk’ż°ůç}Üů°=îăáŔŕ2śX–5ĎÍ ůűÓ>DŢúG$줤ćűř¦yŘA;Órâ>@€sZLŰ&s´§ýôĽD7»†ľS <‹ ÇŘ÷·ÉÝá,ë;Méc(4)'b]Çó©B¬„Ö5•… ±´˝P|”„Ĺťź ZZDZ˛^f2GXĽͬŠ·`ž+wh§=X´:Gľý0QEń}€ÖŘÁwČ*—¦-á®ýO*Î4ńü<űçá)%'L3g_o‚ň:ąS=€glŠ?"3VXŰŞËAäYĘ–ôaŐ+xî5 *ű[Ě…¬Ö’őbÄó˘·ŕS4c„Ř>ß~ý!ěÍŰmĘŕ)6·ßÄżTÚz÷ýí5şě#=âpjŃ+ńąťěáŐR %Űŕ45“Ł H2ÝŕÇ’L›^ ů ţ ˇ<:ł„¸čîŽń n硪r”L?ŤbŚ;@ě§i© Čuă Fu‰°x˘ż^RĽ›ZşŇž·u?LX·¬SĺęŐHDĺ.ë…ŮńßÍ–šB@Ú†B«Lř׫‹__„¦"˝:<¶™H ĆfĄ<, ¸ŕjśű§ĂRÝ ë˙(ÄbřS•ŹŰyô><„Ŕ€Ř˛}ÄfgžĎ#(±Ĺş H¶ňc—ÔÜöV±ŐĽ§ërűmć˛ŕőůÜăLô~”Ó˝˛"pď‹Úóaâ:ó$ŃF‹Ěݢ‹řü’`0"‰bę]@¸JWđ~{ů p,>gGy XF-_@?CŘ­mąŐKrk®,}·«ţ(µľ°aI‚×öEH”«Ω „Â+q®°Ľ‡}Ş\‚ÉŘ ŽeiŚ·$&Ňw_Ŕ¨áÁýÉöiY] ‘HF%ŘÇŁ2;Od”dಕË÷ń"2Äë%<Ę×}¦Q‘@~ࢠ•÷ … ĄgkfNÖţĐ´—¬Ź)Í7 Ô¸Ś2Ţ& ”÷GaO6=©^Cř㊌J•ŐN§»ť´_ccÇ Ř¬ŰęU;?#z‡ůŮK‚/y/\y¬˛î«C» e”cúÁmx f%)ęqłŘ®Ř}–>şîo"©7+ŹiC¸GőĆÇ€b_lľnˇR†}xŠ0–7ÓZ@Őŕü¤IŤđń‡$ĆT,…Ř›Ëé>i˝ŢÄ6 Vrß•Żu†[ÄÍ­ŐęDŢt`>jč•\Ý/ňŻî@ż¸ňB¨VHş:»Ú>ĹÎ>>Ů^üעšÖtőŘN_NIkIőă™*™[íVB>y®ÂŠmW¶µÎäçç­ü˝MÍ"ľ¸+bż€´…U”ÄT’÷¶µčşĄl©ulLÇÉĐÖ‚źŐĽiM‚śjíáń‡Ív3>ĆIĺËdĹ°+ Z5Ziš8|tţ¬ly>ö˘Š%±§ćŮ0ćw¬É&k5,gPő2Ő;ҵĘ*.Kđ›f’®gn¬vĆ„¤¦DúoŃR™MHýL Í"ĄŢá‹Ť0ĽfĹuě@׌ŕK‡±šÄ čćH‰†đÄ4~Áʨ}Ž€ő¬F>[’Bů˘'n8lJôzşĎ0¡ús®ľÎŞ•TÇ!,żO@ĄWF®&ďÄĐ›&áJ|ÖŢG“3ZĄeéQ“b#ŚA•€ŘOgSńĽ”Ó‹˙Ç|Ąjqb†QŤ­Š~óö&ă±?+_mÉű:ěXÚŁăuĚɇ,,oÔ¶U˛{k˘:&FA_ČáÎLSłÄ±Kfë11+TUA>¦áMĂw±zbDÍ⽬Ź’ťO±F4¦6§,!»F*ÎxVşń2Zě¤í)rDW-»›ÍBOTŠ…•¬#ŰúŇ=ćó ¦ÎŁ¤RX1Lb™u|@¤ňă3ëŘte­ ;B~F,*h@‹÷T˝3]ŢeŞC,¬ő6&vË4iŽâĆÖÄNËöq†SeŚ(!đ6íţ.~ä‡Ç­¨5’U8ÜRz„ťpx9kM †§VG9šűl-aň}Îśµ-`d±—»lMhÎ\ö·0€«TQűˇ$ S–Ţń'pP‰p±íľ7{9*ĹĺÂ!J˝,qĚ™çIÜ„úL©ÇIśx ¶…ż3™“ž™‡ÉśMz8Ę\ĺ6ô±Ő‹5śŁ¬›y<ľÇQĽąśÍTxÝĎđe»^Ô86±sL°Č0×Q‰włű6[t»©ó”8o«Ľ›>ĆóVÍĆŮp‰u­’\" ·ŤllX_=±®Ómp~Ǹ˙şH™Ż{Zż/Č6ŇíŘ)T<‰"°ü^‡!őUW†]üeř0‡sLŽý §Gwý*}”𴽼Ĺćs’TŔ] •ôÔtü¸+;íOt!x‚%ý,lg9ĄÓŧش´ŕf‘Ö›)ł'\¤ZVŁŻĂCáu467żbÉTä#µó—čë..YŐIť°»MZl,ĎęŃŚD|·+ţ˘Í—Âí>/‡:+ÂZáyk§ $>׺QĄ ň© :ëŠ 9/Z^č]VőXk­}kűřŮiĽvT¶ ăwŤë ř›Ę&ĎFźÉصpŔ‘jÔs˛N |ű|÷ážúĚ4„tU ńŰ© w >q&őo{€ŁNÜ-çÖÁË#CAbĄ^JFqŇ‚çRGc%ę»2 3.~ľ°Ž»›^öŞ•0 f čŐ*ćźé!i—fÁ~IĚ=­K…tÝs=&t˛řh!n-â#ŠŠ×#"ď¨KÄ„ÝŹHĘsĺOuĚë< Ąb^$|Pč*`ßí¸śĄňůI$I&]zPÂxY¦˛ŕAKĺ˙G‚äřIćĺÖGGÚÍňlb±-T¸U7ďÝ(üOq˛}űť÷*µ[/0ÂaŃL~ÖcN©çcÄ”íl3Â`->ç›Ňe~Č3Ş(ĽjëęçT|O¬®/ŕZ˛ÚíĎůtŚ€xŢM?€ô4+]÷ŹäVúĎšÇČ ÇÜř”ë/ ®Śű±ď`™> stream xś­\K“7r–Żs˛>íZŃLJş\x áĐÁ’^9$Ĺ®bn¤%r8,±›Mu5_ţőÎLUH5$‡ŚŤ őtW‰|~ů˙Üu­Řuřżđß'Ç«nwwőç• owá?OŽ»ďo®ţý7Ń)řŞuť»›gWţ±“Şo…”;klë”ŮÝŻ5ż]ˡíD'›××]ŰeEçš—ÉçŰë˝Rşí¬hţ6¦ý~˝—=¬$LsÂgT놡ůŢě„l~xž<}žć ,…_ b臰‡q^š·~ůß›˙ "=ŹL;ŘÎtóôŞâú揫˝Öb·WđCßă׏šżą¤ g˘Ślžřťś‚ÝšÓů|›ţ=ż‚3!wTsz™Ľ˙49Č”2ç–­sž…\/•„íŕ“’˘Ăł,ßÎÓĺ\ó>ĐůG•JŚę€¨Žš-Ö·ŞW2jáǬó˘Ććhݡ47đ3¶Ů)ÔňäŃŻ6ř,DŰőťËwîů : Zž>ű‡śLČCy‰Q÷UxNěf°BD›ÜŘĎFýŁ†™ý»W«ĘÝĺ,=H®Ź,V=8č˘Ńęç–}”Ę=ŠŞÔ˘_Wu@čÖ8µů«ęnţcÔćÍ#U•Éű |Ů +Ő"ÉE–ąţëAŰHî]]qPŻµ¸Wő]«ŔučđL_%©‹'ţ.šŻlşú ÷bPŔí\MßJăhŐo¶TčĂbű˙˛Ş}Ć‘Ş+ŘĐo˛ˇzP·ö ÂĺĐK• /ÎGÍŰ,N‘zXÝ«†…¦*ç”hŤÖ÷[ąC ń¸ßmy #rwÇüj…˙‰Ž@úG8tkx2îČľÝwbđ_m¸uďëâ ˙©ş÷ÄQčś. ¨Â©(ÎiŽ@Bn%ő˛ąŹÇ1 €Á><”Ăë€LĆôą§…/ĚD˛[ţ¦vř(ToËŮx đŚkćËÍx~H•žÎÇń°â™uxj0ČVpçËő̸ßKë™·ţÖ’ÍíĄîZ­-ůŁA+čěßĂFZXL3^.#Ăp9 ×"YHťľď]ó߯“ź ÉzŃ04yxÜÇw`ü’Žś/çé÷BeügŻD˛±@ňFl@q,ĽîĄŔ:´qCf˙™)°ZˇîŤc<Ô˛Ž¨)Ć^Ó Qáľ…XC1×7ĎJűA}#([Ó7ZB źČRfT 40˘@ 2,•ŽĚ®úHÝ „™÷ňşkA“€ ;P §7„Ř}Aş#Ď8öDç´+őž¶…«śícZfÍŃj#SuRLÜc0ź¬řš6S@ŠÖiýfIĐ­Mf-Á¶P(€@ť†CžîöÁ+k|ĽňúE ޡզŮiĘ»ŰÔŃĚ+›ĘmQŽ¶ ţ§‡Ą¬W)㉅_Á „m›óťOż'"ż¸W‘ďÉuAA–"Ͳ×ă«ä©ó=Grľ ÓŔĐ—čo;ÂĎďâ'˘á˙´xÎĄ9l üăÓRBŠćMŕqERŚ/»řz  |ýÝsz·ŞąěçK `Jú–˛¦™ßŹL –OůVçᾇŤYřŕLĂĘe˝Gj„é›H€Ę¬ä-}í¤â_gáü¤›źŻnţ <ćĄ ,ŞNb+řŔ ó«:*˙S‚C¦ ŇŚ±ä :Ąµ”»C¬vpD2§ĂűVTszТ4”ÍÍúŰěŁ2ĆbŚ]żž.D"BÓž»·ńâ@c{B˘ŘÖ¤Vwš , UlF ä¤^­Řc<ŁU8H‚€G&3.ÁóôéźcDj@™ŽĽ¨SB)TOÉͦ˘KÁn8÷Nço7"}ďÖ y^Ă 6ZV ď,NNÔ®ě ¤‹É“­•FŹŮsÍoďÚř“+`ÚOkŽíŢ°€Á~JŐ°ĐUŕc4Ȩ,đ(Ťă‹ţ«’×Dčôű1V,µXÖ†ßQfĆUÖ?aß ŻŇĽ¬ Ľ8ľ× ŃkÝf1NQ.C&xJu*·C˙ş‘X^řçđ¸î”Ć•Ű°5hÂď¤,0ýö´‘Y>Ĺdć3rÄ·Q#hyÇů.5Óe#p }ÄH ĺM|ĐÜŔ˝Jđ–Ď#G€†…ź9qórDvč)đSŘ´ňÂśÄy;D_BŔ§54řŤ IţWľĘâ0LtѤ-˛&älYŘ@xŚŇťcSIň`á±cE_Š-8Ç­¶ xš(żŇ˝$8ˇ_KąŰ+ŠAÂÇGNŰt¶Z~:ľ:Üo_^+J˘ěÂ…=¸> 0VÓŢżx~ôŞ^ýź‘ÍŹ3Q"€đ7Óńž%~ř9,ArŘ9ü˘¨:NŕŇ(ŁZŮő1<ť˝ćkmúĄ˘ă˙ź_ŻĆÂ@Ş˝D7â~B5ę]9¬ô$FŮZddFOĄÂ´AHb)ŻjlâJ/Iů5IöĎ“ôc<Ľ)2w°ĚÇ™J܆ÍŔłrx1žëqŰŻ‰ß Ë•»á ‡ăáýeĘ’…xÜ,/·íĂç9a1¨§ˇ÷t^ë÷›eţóř4­Óän•|đ¨™őJ&ŞČ˙˙Ť#yZ‚!U’”˛nŐç_nYáÝbۡtA”`jŹEžéĹâ¸íN5°` hˇđs«k1€ ó>X˛9Ť)ÖťśXKU̢Ź żęhT"s›Ş´€őĹM§vfQ4žłÄA´Fš=ťyĚ=“đőéś)jLáňÔ›\cŤŃ“¤Űuä6ý~!‚†UßnfYą2ĄŘeˇĽĐ8üTö´ eŰ1 V ]š”ź^&ă(ű5Ż–BĐŇY+]ÚPr™ćëR«ú}]±y˙ůMe@¦,Ů”OúÓéÖc|}Á’ăbM‡cĂ=©"Ó‰żddµ |Ç;tň:áý9SĎŰđ“ý„•˙Ţ1]5ŻŁµÉ3K¤Ě9ĐÂý)[)KęiCVkSf)ţíÂ×ăăÎ}¤J­î:7]×üëÖďXAő°řË›}%ŻO{Ž• N™×űŘa€ń1ĹçÇŐ|ĚóŐ­.•Ü!6Ř\Í=Ť‡}*f1yë! š×Rđź¬v2OűTĽâRYcö1Ŕ˘  ś–Xá6Ť/¨Pu=&#ee0TˇĘX ˙•bZ<ÉĐQă‹r;2ÝÓaŐ©1]¨áŠÝ°QjćPçnę¨#W´ě…o)M™d)Wľî«Ův>ţ8̧i¬]r(¬©Đ@ź+őBë(Mřl…K¸ţSb­KBŢÓ‰´{ľR¬¶9ü>TăÂşU]e·Ř)xëQŚ^ÂdČŠűßó‚…˙…ĺáب÷uÁNfĹ\ˇh3/éţax ]±VžAR$N„χçuľšŁŽš;,Š÷šÇ#,řî#Ä/ 1Mo€Ăié±˝ĄŚ·¨Ž¶„_…Ę Ü1ç.M«l­ü ň͢(Ă*y§PRnK%ÎŰ®¸¨éľ?°ÚbĄ‡@ÚŻ—ôĐżĽ•ú?ËôpčČĐÁb—Šx™’ JĘÇKDE%Ť^˝ $<©Wůáç_ć°5„9»ÁYĽ™Î—JAžĽ™ĺŃźć<(O˛@U­Äöî5|L ÂmĚWźă{*íŢŽyńT)CĺŢŕń(x ™Ă‚KpsnÇqﶲ¤RĂóôtąéjĺ•.¨2„żôyőťg"—{3Ú÷çYoĆOä|ZwI;č#‹ÓaşŚˇĚĚśŁ8çéčmߢµvRá ¦A¬fĆ!;ő“|˝˙—SÚ*šŽŻďs:G=3˛ÖŇ ˇý,ě~Ŕł¤"‚…TXäy÷ŞîőÎY{.‹•Ţ^ÚôŢj°n”€č|:ĺ;aáF€ŃÓöë‘o}ď´!Ĺ`ć0Ů),;gíŽjĂ˙ćzP<ś†E=Pež.ĹŢĽŐŹ@EJźfŽQrĆdŽ›ăuěHGµCę ŕç<9Ľőßc¤áyâ×ÜjqpUZ¬ëD¦ë7¤)ň„ţ‚č—]ŹIgŁfć=âvŐşťTdŻôŽu;ź‰¬/Đe ĺ11s‰1|ţĺŁĐ‚Ě‹µ•š%4/c-f1/™˘U6Ř™ËxGĘ÷ăÍŐ?®üu)ł;o_“ʦeĂ-)Aíał“Úö€·¤š˙Ä)Š°ě'Ż ÂWş^9ę»8ěűŤÚ%[v-Jrw™ćXyO›Iľ<ŻŠíáŤ6–´ąîeś‘Ţů|™ÁA[pśÇsű¬––Ö)űT’4Š}`ZäÇ×?ď¤ÚXşĂ—®+;!?CA5&ŻZpRŻ[?8$a/ś}4Fú¦™łô0ęÝů˘¦ÇßĎצâA×! >_¦Űl /ńă(6^žß†[AŠ@_wŞˇĽëR¬đ8ö-(Ä’Uˇâ?{ýňI¬?aĚÔÍ3*¸ĐVŕuŢ]n_>˝Ą5+Ó7±ÉH~SŕŘÍüś|‹ç2¨Üßy`Ľ\†úµC˛úQZĄË ןăŢčÎ%gE‘Y·g&ľ€Łî±ŔdŘÎß3h‡zýź,ˇű ÁČnhkľ´h$„DĐô/(IiE_ŠĆu4Ü9óbF¬č„*K^ÎzęeŠ­†ÇYoýÁ ĺwĘÁ¶irćĺ‹Ą~ąé±+/§ó%=&­%äG´ëôN öŐqĽĂŃôŮ7§{&=Vć %€§÷]ŮHˇŚMFÄ…Q$—ý’Óx(:‰>»‹Nˇ]jçn©9©Ţ·=:J+iűוIć+·žÂdšQŚ3Ťdă/˝äI0úŘżNe ˇkÓÎą§~GüDĽRů™ŘB÷­´z'AW¬Ţ0?Ă*±ffĄK×óf'.)—[F\ÓŞÂfÝp\ĆC5+o“SöL¨düÄ,Óđqč1/Ňl°®$®ôĂ˝]ĆÜń‚ ;âť ń8ç‰ád=U–ţůš*BÚŐ/–f5řśSŃCXŔÁ)Í..SPË\Wi%ç‡héŁÚ2kůEúë~Ź‡–‹ÉłÁByS‚V5%ĺ ¸gĄŰS……ÉňËě Ż9¤~–°JJ§ď6tó|·ż›Ífd9rwŠ­8›ŢŚ8xžw8r]Ô|‡J|śRTT?ˇßm\_4“Ôă”ŮhAł;ĚĹŐz}(Ż|Ń&iUHh5ôqĽś!öw2hüľś÷‹«O.Á±ČËKVţp‰čéJý4Ż”Ďţ¦ĎŞ‚ô«Męn§yZ"żČCĎô÷¤·-ĽIđ„—š~Ą=© Cü~ęË$N—•ţU<ĽÄ‡Ž¨2ăÇůâH%ŹN ’1#ĽJP9¦/UBůh\kămtť·@VDőŕą­|ů0Ä[ąËŹţĘ‘‰‡Ü‰;Źš_""’˛ŻóMwŰ~)Ľě슊´ýíBâëóÜ;G÷ţňűtT«šÜ‘ß2Ě \RwHtµ‰A·ĐT·=•If^)Ą~˛ń…˙Ń_«ÝŢűç±{ĂşjĘZşix‰ÖŻťÂÚÇĽňa kýÍŰĺ!€w™Q¸ĽNő,i(ůŽ%ťă Ł¸ăOy¨ŕ·€pH#ž)ąSág‚hΓk͸,ŁĂĺ6\FÉ*ţ°ŘW§â×q¬wq>ăÉD1Oß[›Ś0dłâcy}x‰;(ĹÚ˝!śsémúŐw— ě§e/0Ł9iµ|Ć‘1~בţ9Ü‘vQüC>·1—ś«Q}Ťĺź˝±"F’$xhŃÔĂXéĘ25H Ľi˛·ÓâX¶H!‘˝ÁžÖń60ĄďůMoĘÁ°ÚU1^Ôś§p%(âó„j,=_U6µ,·ď©óŞúÁŰ–NçEKȵăŔĽA î–‘&é’«•T¬ÖşZßx­ř\LeČ™cĽĽÖaűĐ S §MčUłÚ@XZű%« Z”Ěv—6üs}Ę4ţ;4)ŢI¬Ńó¦~“—{˙˝‰ĐL8ýŽő·>> stream xśÍ\IŻ$Çqě۶ŻŚľąZP—*×Ę$ˇMČR†Čgř04ŕšy3ÍâtO»z†üŰ™Yť‘•ő.†0‡é®ÎĘ5–/ľ|ßmşVl:ü˙qĽé6ű›ďn=ÝÄ˙^7˙v{óŰ/ť€'­ďĽŘÜľş Ż <íMßze6·Ç›FČíí·ĐXtŠµîl+¤‡7nďnž5źľŰvmgT/:ß·ŢwJ7ůÓĂp߇_z߼Üî”Ňm§uóůř&kö­÷şůâ´ÝI×vÂúć.kďâ'śuÍaÂTŰu®ů~Ľ|ľy«ř\çżo˙H 2lAÖ´ť ëiľ\YskťLK~›ő>Ľ …iś˙°cŮNK=ŹŐçiŃJ!Eęét« b»1¶ˇ~V;%aĹNmvĘ´ÎÚĐĎt9‡ ײďtó",Ů+čąąäGq~™˙t[ć¸N[¦ťôe«)˙ét¸Ëľá x ' š!}˛ů~‹‡×)SŘ!5±YsŃäË>Ë]Sô‚÷őKöíĽâµµ2ĎI2Ń9ĄÇžŹwąÎc(;Íľ\â<ś^H˝nűćŔfEAZ+űf8Ź—Y>¤]sz»Ő¶Ţm/™´ťŮóĺŤ|¶§óo˘řÓ1IV­Ń^nn?żiţqű/ŘŔé ̬ďčwÓjŃ żŮ‰Ö*ă5)ĹřmĐŠÂlŕÇÎm˛–ĎšáM&wQŁQpz``‚třör8żŚJlଧSŇhŰěße gčöŻł 6ŠmB±#q@h5ŹŇ7ůÎÔO×Űć}Rˇš4-řˇźňeż ô®^,'Ś’őr8íw‡ńuŔ“<ŚßpąDÁđťA.¶ËJ%›©Ą“Ü Ű*á6řżłZ„íľÍuF‘,k/J ľśGnFX5öF’J­Â¶Ő:Ôňö!.ěCčXsŃ…#<Ć×@Xś+ŽńĽ¨0) ®są´ÉN·Śi0ÓŻ˘™ć Âk@ťb›Šm ů†íí ůţ6µd#ęV9%sńnö5=p­ŢĎŢáy8P[,föqĂťĺĆ(˙˛ ę6kÝ0q“0LËq4·qÂĎfaůë‡ËufÁ§Ň7éç¤7ŠĚ=ób˝ź_e?äó)&WµP; gŕĐVÁ™ŕÎ˙O:"ËŹČhť¶ľůş‰Ť|ÇI-}_HÔ¶ş·ŢÄ6ź¬ôă`¬4ŘGŐ ÁĚm?ŹőIu,ěÇui¬Ő~LŰ+°ŹI¦ľŢ‚msů»Ý-`š$÷˘j¬M+ˇÇÔá÷k)?®úXľ˝W꡶ţ'ÔC‰xě!Eômď°A\cđ-¤¶WźVŰ‘Z†ĎŤzh^B„źA+iaš‰µűîÝňTÂH«Ž˝ßnw°EäX?{×%]YŔŕÁŐţtŮŻGúµ.Ü:sK~™˘Cďf”‹zŠw=˝×kâď·Ć ĄŔ±ňµ Á^W8ÜŐWOąßŕZŐ$tPu<˙ŮHDĎ  #Z´qv±rT1p@#7ń…ćëÜ}“˝?ŢÇ3 ß÷iH}?.ÍAŮG‰>ÄóóěŤ[ÄĆ3؇i/Ź“ŕSżvśÔła=Ç EÁú__c¨p"p Ú4—3¶Aµ€hěu@ 3đřüćö×Ďš˙(ˇBîĚwŞC¸?ŠNhuŕRő’`»ÄŮĽIîĺdă:Ů)t†»Cp;çúéç_Ä_Đq}Ű˝ÍOî <â9𹎥Y8çe-V,¬증-Űß”ősŕ22 ?˝c&ÎŰjŇ#Ü3S¤‚q3†Űpî!ŁX |jF1ĹDÉ(†Qˇ:AQ á+ÍĆz†űĎj'Ťk•H¬ź™éÜ˙żÇRNŘŮc!FS¶Ł™™¸<¨z•źÂ™ÁúEpo<_ĎÉîhčőC­R}éąqOí ;ą›+4÷7ŘiOč“O:ÎĚYn6ţ20?ĂŤEŠg9&“şCtĎí‹ýę«Ź?~{:śk›m%Ëź1UŤÇQ€tŹCŰbƢÄléSđ`¸°F}«Zí¦‘gTđ›ă‚÷¬9˝Í(šËxL›7źâľr2h­lRD‰¬;ęQFŠ:‚ĐöDŁAÔ|wu ąF•Č$iCŁNm1rł é:­hł˙·ŞH0+ḉťl]ďĽ`Ą]©QÎqŤ+¸ş·R¦Qż«N@Öŕ0ÝýăBQ·Äę˝*5ů“ę A•iµůŞ˘-*ŤŽ|ě==‚`Ô‘ó䪖Ë>ÄMŐH °€–桝\źžăÓŕL]Ţňő¤ŹO¶.8µ5­źu'>cŢt5ťm>Ţî„%–'|DLËž~R×Ü@ć#EBő¦. 7ÔŮĹ–ÔđŹ)^•¬ˇęő®ţ˘¶Źâě^qcE¬DO4Hďç«UWűđ"ÍCKścÂ{Dł22ŹöŃüSWNýŘóÉ|/ x™:0`˙…!Ó”ÎX2@„§ }–ąéőĚř%X*ôÓJ‚EőíśžYˇň8\NšÓWŇ’6ăĘ #Ó  :`,âť| >C?c,X ŚN>]÷ó®@P¬wô"„r˛_'.#1®¶ť€ ž´Î$Ŕ©fĎđú2ą‘ Đp‡ŰQ8ĚF9ś&ÖÉ9RÎh|dÂ^_ŹA żcÔ~€ THd+O47řÎ5çwMÎh‚x_I)u$? ëBtN;çdłąśXĚBĂ-ěd©5i”52nAűĐ´ĺTŢ`,¸1Šôp>ř˛H nvăaĽ |ˇS:‡žżĎE`V.·KkźÓfşZęD{©Lł ôAÂÂ>¸ZjÎť÷•Ŕ‡m@%ÔiŁ&ŞŰţť‘€ď2N¦żş çËřMí‰${?Ţ˝śŞfŐAş™ěř÷­ĂĚt^´pÄm\‚†Jײô¦3‚S- ¬&Ýב´ oÂ$ůűŰ›?ß„ä˝Ůśźš´błŃBXmCâ­ěőÉÝy@ ë/ĐĎZ„­4k´[Śg¦HËu¦ž¦S|ÍËŔě†Ý.Śúx‡×ÔŇŹP'đe1Ě6.¦MTZ‚ľ§L`ş`©B¤Ű.-,Ą TÚ|)Ö–eĎżNf '§Öěe•×žóč~µä#*ᎀe0ź‡đrbĆa8ĚE\«sŠ…âď{Äk3ü$űýCť&u ęśŘ› ż¨Ô¨_…Ї8KŔ¸ńťkŤ(-Tp}ż¤EŢi]Ő·|)ćü¨üĄ]&S­3ý÷uV_Y}í˛–ĎXŮĚSý_Hńô±@]BÓĹ©%„Â2ÖČěFv™˛Pß!¨’ďËXś6÷‹±˝h¦·ˇą–Üb0)µě(–Ô‘ ŽBˇ˝–ĺ 8ß«ô®(j·^ÇG¸۬–Ű\]ţ{E‹ĂçzH;iźŚâÜ ł7‡äű:Š&Äľs{ń@ř\©– gáRňT^MŐóđ!‘$´VřśŰâ4crŹ^Qt¨"XÍcbłU^E ÜCč~^;v¸ô(ôÜđ*»ÓóRL0Ş€–b"BX0ĽY‘€ßžćť5™ůah€fR™ť$l611.Řqˇą\·~ŢSé>ć,8›ŐŮ$8WÉňvý>Ge:J˝=oń“§ç‡—Ç{b°ľOýŐ#iŠ›esŚnÖ€d €,ŠŠm×2ä˘đEŰn{iŠ˛Ů)ŽVD ~>sćCěł“\bÓ.Ű$°D¶t8ďfŞĎő<ŠŠÁ ±ŐbŞ»ŘÄcH­ W{ 1µ!:-öbęLôžvÝ.SĂ4Ş1OB­đ’ˇ"&¶IŕgŮyŔĆOd|ô¶­×;† ÍUR×5VŞv°á–ŮLę+X©‘* âqćűmá©îeáőeBáR«Ć6Ö<Ís .5’r˙™|±Š|ŽcĘůGeëĚjBtť-\0W8ă^/2řxâ ŻG¨š?}?cťv^č’BTřUŃŻk=<˘ŔSŇ ö<2颬hve1’Ż{µ ‡ŘJÁfZËM˝˙nĄşŤ˛ďŔ¦žÇżÄőˇK/lM„ÂzÔ]éUł'Ĺ; Ż§´Í}Ą>„–VŔíX'¤,ŽŘĚÄ9ƆRa$™Ţ#)ĆĎóî¨y´spçFÇ:q͡ ĘT3-ŚBfDbh„š­d-4 Ć=ö`KEL˘/[˛ dŰ»"ä}VĄÔ쮾ɢď’D Ň⦑}»‹É8Ł€s•G˛8pLEf#ĹÎěÍé8çhLsŞÝź‰Út$Ă‹‡B•C ˛ŽD„ĚálV¦¬hŮ „ěócťPü«N(7Ź! ?=˝y˙ňĽ 5­˝|ó‚ľxMqxm˘$ć$‰¦”`~ď­ńi„ĎÎóń„Řóí#0Öś˙ ę)Ťźw/.,Rř© 4ĎÁËeqăßFJ¬r(UŃ5s”Ďu†?¨hζZu~ e…lŻ@Ť@Jt•ä.-Ź×˛ť1Ďě„˝],Őc8_E=ŇýT p­Ť#Ä+ŰňŠ5-Ó;%’ŤĄIËP Č „.Ňîc$,¨Y¤t´ ×â$•L¬š±ý\¨3NŠŞe µşŔ¨U\wFšČÄ_­˙ń˝Ń@ŤÁGóú7Áň«%ĂČÂĺđă$şš©2™jĄÉ”Ü&őµ}#T2Şś!,Ž%ŹrÉŽ†Żű$öž[Ű”3Ź¤щt‹<›SL©Ć\IÚŞřá&cő€¶×ˇ`'WnpgrXV“«‡őľÂi Ś'¦şQtĺPú†ß­eĘéMeLý$ËCÜo4–*Od§éw•—ŘKö´Â~éáe2L–¦8§ÎTčî.ŘiĆUgN¦!ńü‘ňL[éL¶­ÔďfŇrś˙ŘE´ä˝3ë„ÔşXϡÂJJ$ŢP.8»#“ô‚$O÷ĨĽ> stream xśµ[K“ܶľď_HS{1'Ąˇ‰7—vĘ.'ĺRĘňćäÍÚŮ#ÎrER–ĺ_źnzľŢăeĄHńCz˝?P ”(:ĂJŁuń­{¬-ţqŤî›aRřB-µ_C“†­/˙˝řlH“x?T‹R+ {ş8ž„í/ţ‡cx<ćŔ9Ů ”Ň;?,!E>:Jż߼ŽřşÖm–kjLĽS űâ´¸rĚ Ýýž*řEXń«•eEyqŹčoWvçI(…ä´‚›Đ7©ŕúÖ„ˇ´4\—Ĺ©ţ­995J“¨ńä‡ZÔ«{s?ÝŢPŬ¸íëcô©ÉXÇUaĹxą÷Ü‚žß»}3QÔ§TńdźÝčGW¬ę±ţşź©ş%$•’Ş"^ĽÜxĄ,ű±)5CŘ/N uĽč°Gë!¤dŤ°RpCťŞÇ»H·ő6 VatúáÚ˝ĺu{Ű"âŻ'üJ`O&ŐW˶=n¸Ő~ŃŠč"5‰–Ňm»!0$U±iSÉň·wžĹŘ…AQžw"‹a…t1…ş˙0łđŕĽ\h^tŤłuZ ܢ»?š‘ ľ9ěOŕýöĐ6oěôŠŃ”űvoeO@ýÍ~0‚1$,­ĐÂ}D牅Xý˘ZµŢ]üxvń·_Š›HAKDsďŻËö^î=ä¤p|PĹv`v%QÜQQ­" )UQ~^płÂAóŹa¸‰X‹ ´e˙D0šlĹďŐ …iÇO ĺ"łŞ ŔŞ(~ČöŢÔsZŁń9źÇüMD3ŘBŃě­‚EÝŰ·’Âăm"©ş÷TŔ/‹¦Lö_ľ€ŹŤRZŔ%€tѦ°2¸OEwżÂş$©97ąQ\ŁJ„D•ŔR]ô „wŰ4•…Őßc*ič.÷ŽT[ĚZ‚#nW‹ÇÁŃí 4ńY'¤ ČĐťkŠÄQź^¸źĚá5Ńäŕ0™nÝ_űg«ŻłŘđ®Ő¦ 7oߥ8=/Đ~đD+ťD“cý/§€ţÔܧúGŕ0‡ôB»żělŐ7ł.T3‹µď1‚Ŕ/`É—®«q%®‹řŽJIőźťlÄ.$łŔŃ9×Jl dÍż ä‰B°g­9¶)™@QTITŤÜÚXŐŶ3b˛‚ćž'+8RQŚ(VHܬЄŞ9  ȉLgmOraÄŠÄĺč–3<7Q2˛•_ĹIĘč20äP‰÷ ž*¸Ők·¬ETee´ÉŁ¶ ěÇ,t[Cu™Ś‘O@=Rôľ] ŐÉKR ąm íŕ˘*‘Ą­†<ţźÖĄ9Pé#~ŽQ0g‘-`ŇąçŠEAeÁŮ8{,§Y´G€çGdˇXdoa›r,`8çĚíŮq­‹—Ż<ýJ¤ęQÝW‹‰ő|ůJ™8ł rxâx×'=€¤6l÷k=¦KŠi 'Đ'[ń0ĘŔ:ş~Ľb!»[ÝT‹I4lŰno­2¦÷iäqéăUÉ´ĚRĐ <­ C}›*˙ď«5MHé~Äňî‹' ™§úEÁ!ëűÔ~­ APIť±…2üW»SD„Ą?§¶I~l Ńę“mÓ® ÉSí¦zÎÇçVO:fbWgEÇřśŇńą•ăsţçŐÄNbŮ ë :+2®˛îĂF–KéE±x,C 8śş—7iÓ´I Ojőią‚_ţ4ěšôi7Y ăzS>La?5ž¬|{x$v§ę++ATq·ŞÇcÚ·yŘÓLgťíĎŻdI;ŞNűN]”Ŕp–çIď1Ć•@Î’˛#F—D&EqJđ 3¬Í łg+?-+ß­öĽd Ó+=¨Ó!{ŰŘdZ ·]Ô ń®żîşö8/I7pÓ^˙ÖĽnŻý޸áóáĂét=öÍŐyd&ó[z­p~ýö]sůŐ÷cX۲T–ĺĺ~µr¶ÄMjť?o¸ľO˘`©ä­íMS-]_§OŽ3Ó~Ż/mÁ—?hŮ&źýˇšoÜqŤń˝îŹn– y/Ůtăő‚żmo’ňĐůű{?Y,ŇťU¤ĽÄ¶źCşu üJOÍĄŚŐ¬˘ËČWĄËđäo7¤ąEEÓZ˝¨őë-8 $ś”&V ’?ŇĺËŠt?›•'ôn)­<”UI¦.áč¸es5}µŞ €t©Ău¨€¦kă@Í„ řÂŤHIˇQI*üŮUÁÓůúŐ6âz@çOgIhé‡8_Ł„­LF?ÉŘHÉńŢ™[aBůµE„(9ˇÓÍ3wB/ń ˝F3cÂ]§KOÝŃÍ™ŕ¶÷a+\%– bK jÉűü;ď·´¸/W˝ç­čಠGß´ÄŁďąCťŔ OM-1îµŇסXŇăQ+˝j°éHvĘ6ŹŮĽZŻÂ#!4Q®™ĂĎšaIŘK8y@łŔ„aŐ*°¬0:3‹ĐŇ}Ę,´®&łp)ČŞ Cžixf†ŰÓ@őŠcŮ“ Ľ§%ńC3h.›|k‚ŐtKŘS‚E˝{7Ńâ€űĐóH®ŔŐvh‘Ü߀°ŚdęÇ•]ľ‰ŁČčU,=vĎŹĎě>i14ŰŔ(é•Ů®ÔüŐ7^‰µŽ‚/֚ͫŚa H§VĘ\7Čug |çwhŇĐ€fy`••˙ň@ˇ’豩ťŘ9©f'mÉýĂv:ÎÇżÎéW®¬l˘ŃóYzҡďç>ü“¨îOŇ—¨ÎÜźŠ=Šęöfd+,şăÁŠQtgt©+,Ů-şóĎwІ¤ˉŢOg˙üSŮ6endstream endobj 559 0 obj << /Filter /FlateDecode /Length 3573 >> stream xśÍZKoÇö™đ)ČÍ> ÷ĘŢIżňH°!#¶B ÄĆä’^yw‡šY‰ÖEż=Uýéží%E;8;Ó]]]ĎŻŞűŐ)mŘ)Ĺżř˙b{BOŻO^ť0˙ö4ţ»ŘžţĺěäOĎ-7ŤŁŽťž]ť„)ěŢe'ÔéŮö„0»8{ ĹhŞĆĚ8»űÎoHŇŞˇ:ě‡VHw‡Á‚siű1Š•Ęúő¦0°S& ‡ťî»ţ-NłäÍBiĐ'פí×íOů”’—ĉ"·ůęë͡¶­ÎĺǵmŚHÚ^_ďş~˝»J/%-EĂ…íüŘ.ű‚±m[(±řqť$«ďߧćZsö‰z˛00˙‚[O¬qFž.™h”t<·Î đľ[x5KCެ+Žä0î-=vó“/AĂo“sé´ő@2źěh.6cE”o{yÉj˛ĺÖŁl v I'C媏Łs€7Ţ®Ý "/±LÚ@˙ů7‹Ąâ#ąÚŇôĂ’Ż–Ó‡‹ÍöÜ{Cxéy‡Ź …°/ŇXF.Ű}; úzt»Ţ­Îž9T Ňg'gŹJP(çČÇHБᢻYy25žŻľ_mo¦?ź>\t»}{±iˇŰű*sź<ůyýIän®6Đ”,±űÂfg˘¬úíD6°†@±<%(ÔYś aűrµyĽřěd4Č@n’j ÷nÚ"ó4¤ňF ŮF­ýb g”’?űž´źAž=?[€šĄVČý9ův7µĚé¨@ĺ«]·[}ăç#÷„3;őĂ‘µ ×đŃ7cr”x’Ś‰ĚAíjIődNŹ= G˝$^ ڜ†źĹ=™Fq ¤™2ž Š+R;­é’ĺr Ň şŢ­ŻšÜ.WĂă‰&=¤Lv|ÚEĎ#źç,MA5†k§âÜ“4'd–RbťD'©D  ~O¬J Ŕ¸ěXŞsT¬wś%Ĺ&–ęAÄŃBÝIiĆQ• Ž±L “Ö›^‹ş|ß— ŁđöM®‚á‹h8 ,/ß°hŤ1š_Ĺ懚! @4ŤůCcĺ)¨ÚĐ8„RGßđŔIú‘/ÓČbE{–cw%Y­żˇN·źR )°4ĺ\âł»C#‡vzxŞ0nĂ‘ycę jĽĂĆĂ”‡U­Ę'ÜJŐ*gĆÜ}ž´É|Ç ő24ďŐ‡F r8=ôs#SY ĺ„$UŁ#*Ě1ŐfşÄS\J™·Âđtĺ˛ÇUn\}µĺëoPńžňO‡€Ga$i«agPžjĽ¬€ź6Ýőzź‚´žu(E§µÎI5/¶–ăĺŞtlŁĘűéđ±ÝňŻZ~Ń €ËĘü˛®ćíO¶ËüňÇęşX^3]‚…˙מÎ}Îç TżżĂAľ^TA^išş;ż!]ęr;–šYşüGBÔ°p»±Ćş ĐwŐ}.—KŤ§ŮŘërfÜí}óy /™,¨=P0«ö»Ęĺcä¨kąX]Ŕę_ĺ«/Ž„Öf\ýş)ĐěL÷Ă#Š€40Žąk§•ÎaąÍx‚ ępś…(sĎ6ó‘ă6çZ¶ÜJs„,ěĹ::ö.żžlšŐmÚ_©săů—‹%Óđ 2 ^ŇĐĘ'˘Çł·áńËiŔźĂ{0Ş„GK‡“Ťv’ýŻ9ű®ŽŽ!8›éxřŞ, Ó©^`HĆŞSpekµ‰öĂxPäRbHFô é‚KéÂFţž_đ§óŇW‹·ţČ›ňÔ‹gß2dH‰U @Çu:năÁřô‹Ă]ÄwAŕ]Ty5ÎĹcčiŮYŐsp®†GčÖÄ+2\¶Ěú€v<)ĺ!äP¬˝O -ć˙¶ăŁÄŚň­,ăŃc±ŢÁÁ… P«˝ÁQN8<)úqëĐF¤¨ËČ €F_úEĆŹó·fËB2ŚW°âĄ`+ýŐĆvVlďüvV$“.ďřěăt7»LŇ…"VaK®-[i†đ˝űôĽŢçGĂľo{yČRˇIâ™äoëë×…Ťç0żŻ˙„w‰…L)]c¸o?ńßŃ}ĽŃXi2rË: G%”E÷ÄcS™ą’¸Ű“p8łÁ“đĹXt¶FkzĎľÖełĘTĄĘŁÂ±Ř׹M+3Qí¬”ŘsÉĄńŇČ›> stream xśµYKŹÇö™Č!ró…Çf,Núý-¶ň° %°^mpIîîČ|Čä¬Wýö|ýš™ž®$ŘÁv¦Y]ŐőúŞŞçç)­Ř”úżôµ›Đéőäç «Óôoµ›~łüůŁK•ŁŽMW“¸‡MąĐă|j”©śPÓĹnň’Ľq[QF9ąťŃŠ*audß{ŢĚćBČŠFľ]ö‰.gs®Á‰)rđ4˘rÖ’oâ#eś<»éQëSV~Á2«m’ˇśÄ¦Óą_ţłř YÖׇ[UYcˇÓb=!śÍŻ@#xˇô\J6ť Pjíé éÓŮ\q‰C rµ«ö‡źEöŽěM%ĹăóÉâO/ÉŐḻÝ.w›ŹË¦Ţ_űwUQŞÉűôŤ›Íîu"tŠ|‘duŘ7ËU2Q)éx€Ôűĺ¶'ŕ}źÚ“¬—Ť?§Î€ÜŐűMřMU†k§¦sś™:őÜÖűźfsF%ÍÍqsş9l×™7<{¸e¬5dy:ő±y×—„D€Vś\ő~ÁQ’†ŕ°ÝvJý2SŠ °——=ęmiGYş$wˇŠPˇ˘°(Yő©—í \Qiňk®57Ń9$G(kx6{§ă :˙ŰlNÍ@ťĄü¤/@~ŠřÔesË­KuäÎfŐÄų̈ň˙* •ŠŮR*&Ô_®:ÔĚ@K€+úů‹E‡`?/ČÓg7u2żϸÍŐŻö‡ý橯߼b$[w4f=·±DŚÚÄŤ–NÍąßBeź‡čÎ$˘b&äz@Kh%´’m‘ËÖH:xŁPP×ă=¨´RZ›>o…žÍö~0ôÓ·FXpaa›ň$®—˝ÖgŻAô™,ŕ;Čä$X÷kU)«xę[v‡_€eˇu)χt¤0]${Ó’ ‡E6@ˇăÎWŇ‚uŻgËĄ*ć4KŇSŹÉ—Ľ2°y"l‘¦dĆx%hŰ‚ĺÄ9ÇŚ·şěÇlĚZÍ®EŤK[W3§ÎĂë:ŐĚ{–CéŐÔ}šĺř'Zî´ZÇüć+›żŤÝć’†—AŢćă†ĘjˇĎĺĚă“päm†pMŠÂŇҺ세ľN¨¬Ů ^ĹŢŢĆ×!Ţ5ĺP űĆçäĚ´5É9V¸{Ě°L@@¶Řr˝fc¦ŕ<"9uľ úJjMWmĄ$Í˝JőEmŞQˇc•–a»/«:lďTŘÖýiĺ˵ÖáČG°€÷yęqăPßtť‚Á,č›SÚŕBˇ‰{u)wą ę«ÉMâ'd×X®U xŁ¦h0ťŚř(ašVÜp :řoaĘ`#Y‰ Đč‹°DNF8*BGă›ĆzłÝ†’%b3~ ęŁsNBŚ§PÓ?ŹFß… %±}EXę“ţL?Ą=Oí“ó0 !Ĺďüşv}ż›ŇŁ§@ÚĹ3ŔĆ F Çó[ĐĐÓâŮ)vvűv9>˝O•çŇf”N4=Ú›LŹv>‘•.0Ě´ÇşOx{żíňĚxMP^Ű‹#ĺŃY22 gĚŚüĐhµĽ•‹é‡čB¨ĽyÝĄëvĆ<ö)ş/O‚®iŮŽo“ů€µz)ţNŮo&wzŞ<äXĂž~6R#ěn{nńŠ0ţć@E64Ł~!×ÇdtŰéüÜ÷©˝šbÔ† (ÂŁ€ľS}ÖäA ‰MÚMIÖE·bÖc Ę]qÄëî軄VéóÎŢfzXôćěń˛~ŔŞsç;•]ö6˙„lóÍLbmJ·›ă> Á…­—¬é|EĽ^âR¦âá2Č„@/x6ZđÔ‹űaäCGR ´÷ęXXW­ éłx—–CŘś BÁ¶ŤKˇ Ő*vX‹ $ĺţ˝y¬ČŇÂâ˝A|ĽďĚČÉ<ŚR}*üdků`¦` qk †đě>^Hć°+»č0âč@hlmÁ†K‹ězsô¦ďQÔăľňÇÜ I?×đ #"Řę. /6ńŢ„áčZř+[ ŁB?–.şBĎÂÝ+šAĆsĎxA‘*ú‰†‘ĺfđ‡Q>Ö_1ůa>ţţ"ý;3’SĘĐ8{T°§ő·RáćHĘ:SÚbL©$NŽ‚ŢŁüă¨\ćŻ\Úćը蝙¶ą{»ů«!î1 ű$55¶,9ćKś^X$U`ţ‡1ĄŔ›SSęôęŚN–+ŢŁül\'Úu›äw‰DÚ” ¬¦dŁĘËĘ>›}(¨=ďĂ0dŹhśzá9ţqî;¬ľ ŃÂK}JŘ~Ü8ťYÖůWEŁ”fáçÍbŮG›Ą=[ľ"±ŚźĺÜąřµL!=X毋ɏľ™ÓëÓÄÍŢMčôďn¤Äč>ĹŤLzđ™2Ł*?~Ť)°îM"}Ć“Ź,OŘä÷grP5NŰn~dfĘţcá5g“±Rđ űc]Ě íýČ“Oظ‰ŔŇiÇň†/g˘ĂĎc˙¨Â<ňx°żěöţ9®d’ ťeĄŃżęÉÜŻ<Ů÷íi ‡˘ĘݢógŁ¶,ŇztúfžŤĹÔ)}ĺNÄdôăąYiŞ1š ^vůCÄŕJ-ÎŔĽkŤĺsжť™Ó -điŽ~ˇÂř[vÂéßżĹen ĆŔ~ůŻŰ[rtAŰmqůÜWžđąó#Hjů[}=ě.ŠŮ' GüB«¦Çó_f¶ÍfťŞ¤B™€)  €úŇ;ÎOPŔ•ěł»wő6l‚ú—ôPŁKŃĐç+ýÁGzך/~ÇÍŚ±?\»t"ĎF/÷çśű±€âoůůč—ÚÓjŮ]ô~5ď}BŰî.zďń˛â}wIüˇ‹÷GݧÄx«×~´zŇŃř=ęüWŮĚ^t[Âh¸É_ˡ¸ŻŮév·[ß^$Ó†ŕň'˙>q)endstream endobj 561 0 obj << /Filter /FlateDecode /Length 15766 >> stream xś­}]Ż]ąqĺ<ëq^g.ň2Wëdo~Ó3 0 ś#[@0hçáş[Ý–s%Ů’ÚN‚ ż}j}pź}n߶ťÉŔ0Zg‰ä&‹d±ŞX\úőÝvŮď6üĎ˙ýňÝ‹í~±˝óľ|w÷çŻ_üÉOö-t™ŰÜď^ýBuö»”ŰeOé®×~™ąŢ˝~÷â‹űźĽLă˛í[ş˙öĺvŮjîű6ďßźţüćĺ«śËeëűý_?ś ýüĺ«Ô˘Ą˝Ţ@™|™cÜ˙ąţ¸íéţ/~q*ýńí§ĎŃ€±Ź6üŤ:KTúô}óŻűyáZMHÝ.ݵ†:sX]kŞťZ.¨4c˝H~µI6¸ÄhČęMŤöIŻí—ć:ţtËw"^« ©ľ´.ŃĚ˙%2(š’ZéŃ^RT©'Ě‘Şo÷rÉş+aŹ Ńz—`fŠĹ*dJ0$•Ń^R4Č‘/ٵš›fw­ˇOŤŘĽě v«q1ô)$ )šÝ¨ž]Ćë~–‹‹ Wj—ŤHYkxv|“Wěś– aiŰ-šâĺ[‚$2‹zŮX©z+¤­a+ŃÂO[,gM Ç^–l 4„$˦yÉĆę ĹJ »HĹ #˘%RÇ ŃÚ‹1\*6P nW™ŘÎ’M÷:O±ť“€6i–@¦>*”šeŻ›”5KZ$)S‡ęplćÄu3˝(R¦°‰h ¤\Ą\é.Ó©\Ú¶AŽDXšHVc?§!¤k ±źcs˛{:S)ŘDV­FĺÄłűąH«Rlgh E݉íĽ!]Ý©q„°V^3S+T'鱇W-B<ź±ˇ3«KµbGďC§Żeü¬XüY Shk¦#p}'¶3?ÓÖ´ÄvN»m©Űyc™ľäŮ3Ő.ő¤Ç:즞 Ś%ĽNEID;(Ĺ~ŢXkzż¤»v ±€7Jm;»E¤I2űŇc çäąďk‰Ć††zâ2P4řľôKŠťÜ«f¤b)’Ź2˝'˛ĘL‰{‰̱„ _€´.$]T(i<Ť‰tiXđ0"20­Dtlć Ĺ{RK)Çp‡ÚŢH¦‚R§ …Hě# ”ŽżBw`4?P8±łĄ"sJĐ/´rěhč—áAĹŽÎY;;zÇBÔ*db˙RĽŇsŽ­3…č¸UY«zíçL5H[C-˝O!ĂíLt5nő‘ˆuČ°ZĎ%A;Ѫ̱Ą kQ/iT1-”ŹTk.´IŮWźËÄ$˘˝ëMHňúʱ§+ZŽŃčα§kŻ¦{š*& +Nmj°tWnţHÓÎĘ-I:!ě"ę;¶€†.ŇĄ`BHÝÍL)RŐ0űŽČnMšcWS8e¸9¶5…şq×ŔăÜž¬µ˝Ü‡t ´Ąľ>6éRm`ĺŘÖý a«™Q$›Ň—übWS6P¨®Ô1×LĘFjŐĄĆ3lÔŠů°tbWgt'´®7ŽQt'fH†ZĆᆖëҤyiĚűSbWWÖj^M%v5µLĚâB ÄČđž(ˇV)žş4Z ŤHńÄÄęë%tµLho5łďR21ŐZ:%v5• 4>€bY”˝I:a˛U#CŇŠ'€íÍJ]R/Ř»¬3¤J*Ň0±:dď•Ř„TŔ}i‚’şD§Ŕîv§DëĹŚŤA fž4U‰m@+Hë­ä"+H6`‰5N ÓOŔd:ő˛I4±¤ü©XśÔ1c·¶(±8©cFň0cÝQĹ„qčQ•.ý ăP…E…ŢŚć…Sb Q8±ě,ĐšĄbĆ°Ş*±`¨b`ëă±<¨bb!f×Ňż‡IZ0őčLG 4fšŇÁŇT­–ĄbbizX1±T1ł/yĹ/!qŘbý8KHZ¦Ç![]¦SËô=[)xPčO,rĎŤ H[Ł€9ŹţŔ×TËa/Ăë°OŐ2d‡Z8ÍÔň¤ëH˛rŻ]¨@˛ű\CRĐÁ=Vľ”A IQ>‰Ö‘J“Łă€s­N5ÓÓôj©mÔÚc/HÎug?IvÁ*Ükô1„&¤H>qhc×3ĺ“—P1fÖ¶ŰkŚy˛Ö„.6j•µk˘ÉČr„jŞ’Ohj©Ć -—ĺ4T¸Ř¬Ő˝6*\lÖ«z¨u¨á{^MŹ=ä>ĂÉí"TśVDŠ7eEç1ÚÖĐ meŕFź‚“ÍZÓۢÂÉĆT„ö” Tádcă¤Ô ŕdŁ;ˇ-µx+śl ›J °ĽšŞéˇĺÄT¨ţ`ëKp˛‰ěđeLd=TˇE /cčËľ©PâCl2OMăR ¤[!ÔĆmČôćŞĐŃĂ u $úÇ®«ęN§H±>I˘¦é±ëäµVřŮčNě:ťj¸Źá“·ÂĎĆćfk«ÂĎFĂp×ő)ř٨—Yă„*e­b“¶ÂĎf­†­AdPwřĹŕgă÷ÄHXul›}¸ÁP3§­ÚEŁcËkĄŁ1V©Kś“±”@šW(üłÂZĂÓ7 ţŢŘV”…^RLÂŘ} ĂáS3°I§A3b“&>ë,;ÎÜ˝[@ˇ\Ćľ–Ś~(‘6+ô&ŤŘ´R0͡`F(*EČ`yĂŰqDkÁކ·7pD7!čKę¶Ö`C» 8Ö.0IyÓěĂĘĹgň:m`’ě¤%h‘°;Í UKčeą=1N ŔýKŠSŹCSÓü`o¦T¬jÇ1mOŔú lb~,ż¬8ő@ŔVµ˛âÔ@´;zVśz ęidę§Îáß}A€TJ’d™F¤łx©ő˘ 5©(J=b!H©ő2Ą[ćRj°!(#2Ą>TĄ±xtîÁ` fADŇ­0J ŔCl›4ËöĆi/!^X­X0Ăç^o S™.Ł8ős‰ł)N ÄíŔµB´]`¸’ŽąĎ:ÖČÜ6ýTŚ:~ÚÉęť1j^ŇC1j ÚÜ° W€Čh€%ÉŃ°áVw!^yCAj Ňć}(H}B¦˘Ô§Zp«oşRçOÁ«.7ś R_Ç€cľ¦ó0yĚ»’ôň€SmqĘ8ÂI?-N隧Z€ëL)L ?ÍSÝE´)ÇÎ5çVÍîUŠč]H“ŇťĂ*–§¸—š*Á§NtÖŕȦb™ÝćŽl*–ZÁ‰í%­0,í®UŻđřHS:*’+g4ŐJ şô𩵝Ş"µ›I@Łç‚M©AĂŁ®,޲Y0ɲ+ OCL#YZ>mR­ŇŤtú-@´ť<ę]şHŢNVřuăđźGőO™Üît’ÎSŘǨôírüphJßj@Ťk‰şU†(OČ)…¬í‡’:%”¶ü7ÍŠ}µÓĄm“˝vҶ» 9śl{Ö!C'ü93Zň8ȨTbłjçđÜ*:­šk )Ä=T ‡’=3ńQřshOç?úg§îa0b*ôB] NŁ§RÓ}ÚuN{.ç.Ť‹Ź€DwÇ˝?>·¦E ia™ ˛O°!hk¶jłŚűµËöBqNĂťô‹‘Lw3”Ťpu˛{ŻLřŃ2|4sSló.Wrî NĂ Ňš;/ąit©]xŃ]f™剸:zKls3ö\˛Ż;w§±Nu‰6“‚Óăđlgâý_Ĺę–ń>áEÓţěŕ„ŽîÄy§XׄM‹´útźđ˘i‘®ărf§±˙´R&Ľhô§¬}7c?'Č›­Ŕ 7ýÉË(pŁiăw۱nôÍu-‹Y›†ľh.ÂPK…JI.Ó8‚ÚŃfťđ˘ŮÎćÝ9«‚ÓPVŇ&H7¨vBÜrUtz v/aÔ&ŹîřOřŃô˛OŠYy0Ň#rź›ÂÓT¸úVSxzěs Ł)< çKqÂŹ¦Ö¤'–9şËÍlX4Ľ/;zvE§qfČÂ]áé±űz}vE§áPz ÂŹFo¶nE4ű”t¶Ěźc—tŽ»9ťĆ±§9 NŹŘ=şŢšCÁé~ÜgN¸ŃđüŹciÂş›rµÝc8ŇđóŹâś N÷ă{N§űLk-O§űa-Î95S2ođĄ«"ÔzdEŤ¨Jă§bÓ0>ŠŦa Pť˘Řt‰P™ćm§ÝŔq$…ÔBaň¤(f´BĆ(µ+:ÝWĽ:o‰11ršjĄ,Ů4GR)’Ír‹iGČhjÜi8fä“&oysĚ(Éţ$Q#Ý—FË[Q|şŰ S÷ŘI \µMŽG Mâ)¶VQx>Ë´*<Ý—CÂÓ°č-T8Ô :ţH•xŠcDt‰'”ŐjÇáéPV]=lOç.“0D-§¤k\!^FŤBpYíŔĄŢHőšKí`kŃ×»ĂÓp‰4®îđ4¦MS7čR 0}‚±ßŞŹ÷®Úş° dJ<)-a G§ÓľęXŃiť˛*„«‹Ć ׏aď.s.!éě>Tóc 1µo ÄÁéŘŞ4›ŢwŮźTĹî÷mőNuW¤ŢË`NÇî“Č»÷ÍËßŢŠJ LÇfĎ.ăŔô–ŕd(pż’(22Ęxw _HŔ®LĐ]ţ”®ŇyÓÁ»É@—Fx€žc ŠK7$ŇěB¦®g’W÷´éî4DÄĐA ‰ÖbÚ{;‚gĽ š29iş\Éi(0Ť¨‡¦ifĽ ÝliÁ«ć“/ýÉş=I| U×±:´ŘwxŐ]—W—fF ĂŻŕ+ë’¤Ó×ÝK‘tş=ä@šna} şěŮ‚W]ugW4nŘ8M÷zŮSM*‚QSlé¬ËŔÍ@÷ő cifĽlm‰~ő®{ȡ!´¤LVÖŞ€_]tťŮ\«ŃC<͓חFČ­şĚÔő`|ˇŞË}×ý`µHV¦@őßy0đŽ¶  yŹ«ÓiďŠJ#$hdlş¬Ĺ»uI×5Żoõ.şW^HŁ›‡»ç¦ĺ¦EĹűéćvšĆ¶´ä>šn+4HÖő Jő‡ř®ëň) *‹÷üآKvsicl1U©Ö´)6Ť¸«–[ÚśĆ ?]ŢŚ\łŮ” ©Iˇ#ŕ뵢¤Ŕ&‚kđjĄ§}wÂÚUI¶3hâśÍS‚gť”ÖĐ]@‰« .« ,˝&dW™”ś›±Nä•1 ŰO˝S4ś™şr´ňRS ľőł7Ü9ý‰9]vîWr|&'¦hŘ%(őśą$j®5şW^uʦ­ă|Iđ­ťČ’őĄâÔŻčvS;E‘i$Äh“Ą˘Č4wľőój¤˘\ë$d“dj–dRZ“]™ĆE‚ÖT™˛Qd‰@:M’Ň+$Ó-ÁżB<†ŘĆL'VŕIn!/¦Đt[–y Mđ¬ŔżfŠVóŽ<łÉě¦j咠ᚪ+6Ťk–áv›"K) Ŧ‘´ŐŤěNѲ»HVŠV˛„dk gO¶^ŇPl9dç`l€‹LŦq-$ťź”vJÄs7‹„łnÉiN YăTR$SădĽdĺ.©›°É§ÜIýdx×Iłué’ÍÖĽFóĆĐ4í($™QłlŐž%"Zîu˛«¸×Î<ěng8ËŃIYfT-[öÂÎZŠD´*2V´})10Ě\Éá:ݢIÖ%™Ęr[Ö}Î MăÎO{7+)‹N?äő+˙s÷vÎđ¬Wţ§>Ät*:9˛.׉XśR’L5ŐâË…±iҧŽµłQu˘çÂffµZŔp¬ťůŞĂ/W§xZtĚŃaś«‚Ó¸˙´ČkSv9˘Ţę`őĎäÓ©±mÍ€NW"ŞÁ #ţÖ&Ě­:łĽyJZwfyUÜ)ˇ¤ű@dgxVÎOv3˛<$—)Î-/ö§K¶­\hő†™@Ę–Öú´`Š]Ą źÚéҞʑ•[î욪sËłŹa$—)ą<{7ŤáÜňlK;ĎÍ’É BMŞLr5<Ë‘[Ţ\«:·|¨™wÝdgexÔé”Řž‹ÖĄrß›Lß®®™\”ĂK¤ąVsrąóőG⽊Ŕ§vŢ˝?źÚůüŞłSlGĘ.R¶z Oď]©ĺ›=ᢠ›ëŰ‚\ŇîÔňĺęxÔíôD!ťgzĹĐ…4ĺ–Ż— * *˘,Ěë‰@Ň%ťŢTdä‘mF˛Z ±^bč·ęľdÖľ>đČĄěĘş_Ź@2ŇȶóC‘@ŠDă§$4Jf=6 `ŹV¤É śéqz´HbŇ=5[™–¦—.0ş>Ź ¤+çţđRJť~´ŇWŰ.˝˛Ţáä˘(Äő­N ÜYD´ˇJŢuŢ­'?D†˛îuÜ‘G@Äcčţ´|˙ŇóńžG{°čţ–N§˘ëZ úÉ«ŮŠ$m¦2v?ćiÖŰEŃy"ŇÉe?ćiŢÉn´}y0á€HŐ,éJB€]Źyśg€Ó@´Iˬ~ĚÓ¬Ęě~Ěă‹ý@&Ý9 :L6ݲ,ÖŞ"Ň"uShş˙T\é3ŚĐÂ…AD’AŢŘ–Ť!;ýą3’ĄUFµĆ¨»âŇD˛ĹĄH]!olëFÔá°ü†űS5(Ĺ9newŮ…(. D"­Iqi"&ýą+iFČF˛Ełb\5+ąëŚ(,MDŁĘ K3IŁ »»Ď[$ѡ«c,µ”C: i P dŤm Ń0‹˘Ň'DW+Ô 7şß"ŐÂQ–wÝšĺ†KŃBśä Jźž(D<ÁŤgŕ Ň,ś+Ň­[ŠíÚÚ¦•ËôÝĘĄ¬eŃăąA*Fg¤3šFDěĂĘĺ@ĆfĺRÖŇÉĘĺŠ=é9!íŹěM*ą~‹Lë—™»őËÉV1+]uuz´C> ‡|4jşŃľA’uĚ)Ö1W„šL8áK> ™‡|Śě Mź‘l-St¨ĂŻ™óh Úź€qG€îLÎ@˛Ž)öŕ[nů©Ö1W„w7Č É‡|R5ł~¨™…ĚCÍé»uđI‡|Rů,¤Šf!ăP4Šc4ĄQÝ »µđɇ|Rů,¤Šf!óP4Fć~(š…$«á+Rü|řŠ4[bWdŠFHWŽÉ ˛Šf!ůPÄ ©Wůé¶ĹśĹť‘/Es űfEsE’Í)VÄW¤Y>Wd˝­ľ"ÓŠć@ŇnEsE˛Í©VÄW¤[>Wd=Ż>řÖ·µr˛®ą"ĹĘćŠ4+â+2žĘg=°>řÖ·•J¶˛ą" Pźn5|EĆSéď«ŻH˛®ą"ĹşćŠ(@}Fşý™+˘ÖW íO…Ó˛UÍ©V5W¤[ŐřąJF ú(7Čzc}BüĆú„«š+Ҭj®H·Şą"ór[d=˛>!~d}BŞ5ÍiÖ4WdXÓ<ĘŰA¬WÖ'DŻ¬O@µSsEşÍ™V4 ÁuzI·źYź?ł>!Í~Í1˝ÂŮ7+š+’ěň]˝ł>~g}Bş=›+2/7âB.Dľ­'ű¶7ëťő ń;ë2ěŰHŢěŰ\‘tU3FžT©OEăWÖgd^uŚ˛›ÂáŠä«Ž1Rěő]‘öT6ze}ęvU1F’9®HľĚ[ šĂáŠô§˘ń#ëŇö«Ž1’ĚápEĘUÇićp¸"|h}~Űťľ_UŚ‘|yTű}W¤+štBôĐú„Śý©pFz˘b?מÔjOT R÷nEáwÖgd*ś™o5 sźTęO4 ň6÷›ŢL?ł>#éň(OĚÜÚ3ánßűf·ďŠěOd3ýĘúŚÔ' fîý‰‚A~ŮŤ‚ůéAąŇŘ<1®x\„+ú-V ®‡l‚6˙2q éVn¦±1Ż‡čV„\…áť„ö@Ă{ŢÍ´(¤[r¦[ąAÇN@Yžć["ń­Ü 0$ł«đ]}Zt+Ît+7H—`ƶHD·"D’9@¤š:…t+B4Ň­ÜM˛ŃËćÇoE)Y0Lq"ľ"fN!ÝŠŤR|+DnřVn±DŁó­4D•gľ!'ľ‹L…!*!ęŤW,"—iŃě·„+D”ÁiÂ"fWáýłs˛đ¶%Lľ¦EŮ,š}ÉS–€őŹ–~ć[!bfń­QE·"ŔĚ)»E“üžŮ|+BD:!C€ňâĚ·BDIţâ[ 6 ń­ɦNIÍzD!ľ•ć×ďŹß ‘Şţ‰o…H;ó­1uĘnŮ$?;ß a.•"µ2|W±řVQ˙I¶‚_% ÷‘Ýô+,e4šlE>,3€Ç(3€)˛"ŐD*L”"˘TD“­Yô+L}&â.Ë bú•!Ő˘1‹i?ŮĎL+Í|ŹÓ ĄËši…HqËÓše%7›i…nYżĚR"˘"ĂÔ+$Z!˘tm1­4ÜNmg¦"¦Ó “ťi…»+Ş"&Ő ‘ę–§őĘA$Ő@Ä$4Z*DL0ŁáŃ{S­4“3<T+DÔYôđĎL+DL$¦"ĘÓ5Ó }[D+ôiń¬&H٬Wú"?ˇ@Ŕ4!âY!âĽ×$ Á4+Dę™f…H3aĘn˝ŇaJ¶^éÖ+fYi¸H”1Ë éSÓ¬ɦCŮ,šä‚<+¤ÍłBDĎĚłBÄĎJ†?.ž"ć>Ď őF4+ôÜĹ4+Í´ŹÍ ‘áZ¤Yia7ń§8Vđs‚c…ô 9V·C+D´˙ͱB¤›u…é±D¦UŽÝŔń!6s¬Ića!ÇJ3ČăÁ±BÄ /"Y!b:‘¬Q2ľYVî|Íů"–"ć…Í m3Ó¬QwIJBŔD1bYi %ŮĚ©’-žŽD,+DL€#–"¦GË Ůt¶E.Ą˝tÎ1­‰Ô‘bâ•fń”µŕDłBdµ<Ąaf]ËKâ%âµ-š"fŹÍ ťŕ¦Y!b¶–!3ۢáË ‘lŢ•$3}ź·XVhGe%3Ĺ ~Ä,Sęeö.e—~™ë]Ž9VĚ3ÉJC7Ít"’"Z&Y!ŇÎ,+D†YU’T |EfÎŐŚhVH#šf…Č0[ Ů[ŮëźiVdŻf…H3© Ď"šNÓ¬4¤:C<+D¤ÍłBD:Đ<+D¤uĚłŇ0C»Ëđň‘Hq^=1‘VRL(#˘"˛ĄL´BÄ”)"Z!bĘ­4Ż†Çh…'YD+Dş©W’ĺSm#h…ÉFD´BÄS*˘"ÓeÉŢ„a­©¦Láő;Ď V¨i^D´BÄ4/"Zi^ÄŹŃJCzÇ"QI–ĎXó5xO¤›D…D+ KßÔ4:ó¬Z<xvD´ŇŠÎŔÇh…Č™g…@7; /Ňö”·±xVĘC‹–©2ijҒ"unž"®D†Ŕ"g!ÍJóf}Í ‘nRľŽjP r¬LłB¤šTĄZ¬1­ V #h&XiČ4 †V ŁlN[ďĺM°ŇahŞE¦t#ŠLĂŔ2GV ,Ő"X!`J¬4d&šEqióÄŻŇ`“yâWiČ]Lf\R+˝®!`ĄŮn{<Vňe‘`…Č0ĺŠ"Ó°ídŁ`Ą! r72őÓÄ(›î؉řUZ9B¸âW!`Jń«´rÄÍŻŇ`ĘĆ2ż sŃ_Ą!·˛śV,ČíL°BD[Á+ é—ĹÍ0, #sŃ©lŇ,+hb~•† MŹIü* v¨ö»ůUhs_Ą!‹Ó„+ŠJĂT]Ô(»TËáĐ‹^Ą•Ă37˝JC¦§K((]˙Y+ ć­ě6¬´r8ą&X!b6•"ÁΩůUŇE˝ÄŻBÄä9âWi°’UIô* Ą˛3DŻBŔL9˘Wi°Ł%o±«4ŃŮ­0$Ť”Óͬ( I3 U bWi°´łąTmHKŐ 1» ‘n–Ě`5nVŃ«4$ŻęŚ0˝ S{^ĄÁ`7‰čUň[Í‹"z"¦ž˝J«ň×~•Ł^zĹü*DĆ™_Ą!+Ö¬"Xi0üÍ4C‚Ó•¦„…ŁŹ‹`ĄÁ7PäR+­. V4S®đ%MűÝ )V˛mĺB™b…çA+ .†çA+Ťąf]áh"žq¬´š9VÜsÂc…Ô98V’x #Ň ~Ę~ćX!bBq¬4&úšB…÷ë ľŚ—‰hVt“Ş(4]Ú4+ ţŽ+e…żM$"–•†tár¦YiôLŞB;•‡$š•Vóş×3ÍJCRńv¦Y!bˇ‹fĄÁŹ˛ĐEłŇxlˇҬŃ1kš•_+›xEˇi Úś¦YiHW6ŹhVü±dVň¬1Ą‹xVRšM$˘•F§ÍÔ+ŠNé&HQtş–­‰VŇž·3Ń łShĄÁŐ3)‰VĚ3ŃJC®´”¦‰VĽAŐĎ s¨0i·Őâ´×ĹłŇŕ/š”C<+DL "ž•VËâČ3Ď ©}ó¬4x™ĹŐO«‡íjž"˘ňÍJCž¶ŮQ6i˛XͲŇŕšf3±0Jdšw…Ůě ÉÝfÁËJűŞMc–"rAŲŇ˙mʱ¬ń Ä˛Ňěó>,+DL#–•†¬qOXVübíł¬1QŤXVZ]Ö«IVt!ÉJ;mň‘¬ŃıŇŕ_ç3ÇJłÇýxp¬4d¨ç3Ç ‘a„$+ ^ą'O$+DĚç"’•†ĽvłÉd…Č4‹‚ÓôĺŤĐ$˛ĘLI§­¶YVxB‡‚ÓČň0Í íFÓ¬4äĐ«bY!`J•MŇi}Ńńd…Ą#’•†PB25‹bÓ@ú™dĄ!ß/"Y!b摬4 vYÂéëń»iVč1źiVZ]–ň˘Y!b†xâćäË ˝÷2ËJĂ+“ˇe…H=Ó¬q%§y]ű’"7$+´¨M#’"¦—É ü4Ă ő3Ă 3@a…ćľt¬VěFşäŇÚ˘„ Ă ­33¬Đ÷đ§Ĺ°Bd7RakW>•&ą´˛Ř<Ä°B_¨źVdC +ô©LÍA†«HU„­™ą}Q¬1Ń Ue[,V¦X!âa‹b…~˘)LD±Bds­¦řZ‹G†+ÍĽŹĹ ˝Ör¦Xˇ«+ĺ)ŠŮEŞÔJő?/µ(V$—’L]d¦X!bŢQ¬Đ_×iŠ"›Ë4i–ę R¬0R0Î+DLŽ˘ŕ4 žmR¬Ř Ti•˛H.̱ÂČĆ Ç -qs¬0B˛ŘRžöÍüăÁ±Â¸Š‡$ŽFc¦)UúĹ›|ćXaPGÇ°9Vďgä‹#Cž§ářtq¦ŰâX!":J“¬0ć$Ě$+ T™F$+D˛)UˇĆż]v&Y!âĺ7ˇÎă`]™Ň+y&Y!˘‡É&YaDNÜa&Yaoq:ŻcŘ$+ŚţifY!b® ˛¬0h ±¬0ô¨ĺgš"›™XˇÎ>Ö̲ §¦Á,+DLç"–†F‹9UŠd“ĆÁ©Ň¤\”$úx°¬0 kŢ’ěuj‹M„4+´”LłŇśÍňxЬ0Jl’ň¬ŘÝĘ”nIyqÔg…iS¦dą/+kdѬ0„˝hUE“–Â7Ď  R4+ –›Ć„4+Ś°›;D4+D,qń¬0.ď:ݡűEŹeš"Ű™f…W&żÍ ď 4bYáŐ‚—‘XVd73äŘíľĎ],+ĽĹçWá.Ü©¨YVxńŃĚ»Rĺąl¦5É /rń¬đŽEJ×<+Ľ™‘Ĺbž".˘/ÜćxČťÂ+ ŻѬ1ĺ‹hVxoä) Ď /›<ÓqémE–ĚłÂ+*×éRą+ńpѬ‘‰`šŢ…eł¨$ß NoJÓ¬đŽMs`¦"Ůä,Ă—‚‹ÇL+ĽĎ3‹VDL+Ľ4a…Vxu8ÝŽ"ÓeeŢ.¦Ţ7Ę,4ÓJ++7x1­ŃŮl¦ŢlŠěĚL+ĽnG±é2}‡ľ¨Vx‰ŞŹ‹j…7ŻăLµBÄô'Ů ^‡ceŞŢńJ‚bZ! ­j¦^ —3Ó o“µRĚ´BÄý+Jđ&ß2Ń ď­Ý=­1µŽVxŰmέđŠÜ)"Zie=#[L+ĽW·Ô«sĽ{ÝT+DÔa1­đţľš3Ą(«/–S3­‘…a¦ć x1‰i…^LbZ!âĹ$¦¦%Ü0­‘Ć1Ó łĽÜŴ”Y‡fZ!"ŁÂL+L¤đÔi…éž1­Ig¦&mČ`0Ó S=< 1­ń(Ä´ÂüŹBL+D̦#¦ć™(pe¦&§č¨2Ó q6h…-Ššh…y0ÓHUşgsbţ"Za>M72%žĂ˘5Ń łp4P­0ugQtş¬ëEµÂ  ndHĚXS­0GÍŐ ‘ä2 OĂh.Łđ4ÝežF†\5!Ę&%Ľ®"Ő 3íĘ™j…ůyRݦZ!R\«KѦ­©Vx˘Za®ŕ0’,żMYT+Ě7ě.Łř4ŹTT+ĚR”bŞ"ňMµÂdÇf$;éseŞä“WŕĚT+D<§˘ZaęĄó¬0÷۲Ď ËĆ«ËĘMY<+Ě*×b2Ď mó¬0_}¸ť®L­Ă´Ď ů[ćYi~Śóxđ¬‘őlžfŘ«7˘Y! ‹Â4+Dd™f…©űňÁLłBDg‚iVř(@Ľ–¦Y!"ÇŇ4+D$.ľîçó}fY!bůůe5ËO,+|Ř ?Č,+D˛k )™}…aͲÂG^n~[M7UăÔŰj<ή¤uY)U‹e…%*–>Q-ł¬‘6Ë í`ł¬đÍÉĐüte•¤.‡c’>oą!Y!"‹d…€>ä·ŐxHŁy1Ç ‘ćv˘.zUňxp¬ц6Ç _ńt—)Ç» Ý+D\D1jt¨™b…,yS¬Ѧśîm…aM±BDs`Š"ҦXÂźâWá3)©Gó«‘I`~":,ĚŻÂGZú˛ŢUă·”„éUšă=ô*Ddŕ‰^…ďĂÔŞŘUČó4» 7;-”ĺÚ™\…ŻŐ¤{L®BDĂä*DX2ą ßĘM—ŃŰęéQs‘«q3"W!"Ý#r>Ü“iir"žF‘«ń4®§ŐsĽš\…¶ ÉUř´PN›ÉUT—Q|:Ďľć–ä*ö3ą >z‰\…źČUxşE®BÄ;P_ ˛ťÉUř0S‘śąŢVNîôŰęąÂ„&W!˘udrľ•-ršM“«Ѣëmő\<ás=®žĹVÉUřŘU[Ůä*DVËS¤ Ó®ÂO_¤-ß°5˝‹Rsżĺą–j„ös©… Ôv÷Í‹_żŘ·;üĎ˙ůňÝÝźż~ń'?ÉflŃz÷úë»JÜ!Šş‘@ę'Ý˝~÷âţËŹ_˝|ýËŻŐżĹůDj•ŘŻżzńĹýo_ÂßčmŢ?||ůŠ™1=Ýż{ůŻüâGŻ_ü‡ŁëŤ¶Ć»őK\ăý">L ŢýCüń«x‘křî·.ëĐŃUÔ·ËOqyÝŹŰőÖäTę · ,ěČŐî*ň|%&`®F{űąR×2ĹČźţi×g¤Ť—8…qQ †´QKpžâÎËěó/ü»řdÚ’{q©[~źČ@Y˙ůřćîďďŢ˙žµđLďpá—A]‡ż#z÷kôNk‡ą“QŹŻjśCŻŕĄl,‹ű}•;µ‹$×-6óąÜÚ^z¦=F†ŐŢD…?¨˝Ębů™ćđ#….„*ßBţ{şWŽIÓt¬śé»#ó1ô>V˛'äş÷»Ç˙iÉ˙äŻôV,ÖXL8łPŢČž`¶¦•QŻS)#çRäˇýŻĄrSŠËt.eä\ę^lÉǧöiLř¬đOvęž/î˙ĎKü›Šű~˙ĂP.x4r,®WŚiÔ=ÖĹ«_<ţăŹH h=¦ăóĂK»ŻWEôwßŰ™0fa ns?÷”‘;FUuĺ/ß~óíK8„đŐćýÇ7ńAŘĄßçč˙ Ą™ď˙ćńń\ěÓ珟ß~xŻÂ3÷ű_ăĎxOv˙éË—ŻPtěqôß?<®&[şsţ›˙róë¦ŇçO¨›ľv˙xSěá«S7ŢľçŹ:Ë÷ßř3!ÖĎVő|Sţö“o~˝ ϱ¦řş‡2űscąţüäáŹy~ş˙ü‹Ó'߸'1—ŹźU˝á-]_śUL÷żyYk8o~~jŕń¦Î˘$ŻňźěëSŤË¸<ř;¬î×űâő˙âţG,QFšóţ×ßž~h"ŹßÇĘâjÂâ˙ţőţücNYŘ0ĺ×ř/Tě~U&żKeO : %wnđ"%6·s…WĽ˝Ž3çłYvćźßĽűöŻă°Ďpo¶íéţěĽ<{áőáß[»o ľ|µ#Ű"d…뿶]Ĺn±Ĺűĺ‡÷źľŚ‰DŤgľ“k˝ýNßĎßÁKµíüťëßAČcpńŤŻßľ˙üňż}GRx0æŢ4â‡Ó|ž7Ú{*3xY=,vVŤš~ó ŃŢ~O–ĂŽZ_xçŤ0s¬ŔŰ˙z ă®7{/6 ™eb¸ż:áç??ţ3 ĹdÇźű6Z}…ôŮĘýűۨP‰=5·ĎűsÎĄżyăcg~ĐźˇŃޡźgÔvÓĎ›ţ¸zJĺ¶CV Ţ–T ěTyňůŻV•t;†woĎ?ݱŃoňđńó'íćWđůCŢqD3ń‹łđóÓ4ź·ôç—ĎÎôćIţęă‡_íĎM2Črő$‡®yf‹!NÖ÷Uäá«ŻžoO€Ęü\Ź`Iô>}~ó«ďý@xCO–ŁOŹ?p9BIl9&öâÇü8‡?Ľş 3˛ńŇMí kÔr˙áŁŰÚ;Ž§Wx©3gŮ9÷(“ăDş=xŢźŻZ”üĆę¸ ˝q‘¶ß˙ěţq cK·Š˙Ş˝Őłź˝|~î­ őëß}űřě6Ç»Ąą„o #Á¨pˇcËÝ{čXüÓöÍJ6,ÉK(4Ä–Ł‹?ýüńŰ/?űń D€'{Śóß|bO÷člş˙Ex`§ßęő“YFvV8ÜÖ±öFbňQś˝7 čÖxř˙~žá˘¤Ţ!áh†mă§\Ňä@ĂUI¸<§żř}ęźăţfÜĎ™Pm+©Č„}޶őpg±v¶\ďżc˙°H«ßŻo- Źo.µ ťűć%–:ŇM±ÔŮÁřđoÁ-ĐÂÝHç"Ç×bË<5‘÷r˙đéÓŮĚÄąŤ€f%ęĽ} _«o{Tź“µ…2)śë=v˙â‰e÷ÍíĎOźŢ D»·úöá‰*ąŘ'ébä‚ĽńŐa` üâlT˝\»ő7’}*÷ë *uŤ_eOÔ'~~•ú˝S˝Ž_ť185nţâă‡Oçc÷ńqý·3°ä#CúÓŤú|üÎ!Ž ©žÖÔĂńŤňDđŹ˙tóűÜÔ–,dÄm :,ž›n˝=NÇ~ÎYŕt˛_ĺ‰pcü?Ń”:s;Íü' äóÇ·Ďk”%…gěkö!éDřÎôâź‚lóv­~<–óÍ<R™8>Ăř®ô“ÎźYIŢ™÷dśëcáMĽĄŐ+řç'ó ŞáJŢč™O·Ëýáé|!50zőúÉîŐđŇŤňá1Ž,üc›{Á {c‘­Ž÷?ĐăžĚŃŻĎzâíÇ'é“?0žřbĐ`ţŽ"Ţ÷g÷Ĺjöwě‹řÔÝCś~Ćú^ocdíŐm™Ü˙Y§ě>Ę“›‹„ ´ÁÚ ‹¬ďŠýr•ĽůjĄ ŁkÉož;Ű祍<Ça”atäČ|˘inĽĂ·_ť|úü`Żµ'Şí`Z@xĎ‚}®©µáhNń_R úFďŢl·ßĄ3řolî·Kz‚Í&|„ënÎ(őŰőŁŢűd#Ĺ:¦ĺĹżî8yž§6ßűĎĄ^O({w…KÎg–Ţ ÂŚiĽÖ˙ö{”Ő7O4ŹPl•đň^Şç:Ź1´v;Ę·głűÚňwŐSe¤úŘaVDVÔCç–>ťľ÷é漑ÄpG…fáźqĆŢśęvÚ‰‚?… ÔöęŢ~>Y^2*Ęěź]rŚgäĘżř®Qqkč°u(ĽO®ęç;J€‚Čëć@úí!ÂpËišŽ:ű­F>$účĉťźÄÄžÔÓ\nUńy=<íÁőŻ´SËŢěÚqÔqőäÄű]s ß!lĘ[›cŲüó›ßŢ®ž ĹFŁŕíĺćŻ.ü«úÝ9{X~ë}ɇĺ÷©Ë­K[†ó;´%řcÂ,»;—üO.yűU0bĄŮßg]ö»±?Ż%ńâöĐ˝ÇË8Á˝i=†ąŻďµsźŔŐđüů{úś®ß=®G@čF˝ŢÚ2KŁkťĽâc§ł›łüăóóRA÷¸7÷ř—Ďö©x=ŽúźbęéŽß§ď™lőóüŹ—ŻđVžĎřC˙‚űăçO\fŘ—ý‰ oű„™ ŻôVŇ·ň»9˘ż ńŽĆčöë_ś|’µ;úţlhŰ»ňÖ–dŚQućűßa×|Wőđđ­ŢŃŻđĘ(sáź‘ý~lô^Z^6ŚţjŮ0ŢęŽVĚ]:!‰Řˇoź‰üÇd”CŐâCyőÖľůöůŽŐËFţăN:^†mpG öˇ;Ţ˙HĚ|ő-śţS{_|7˛ÇÁî1Á‡—ű°dPúł±śŔ= ĎK˛eŻčĹžq3xŠwăĘ˝ g6–än‹ŕ'†Đra8ëëw—7żţöí5öü?_]˙ňËÇw?»ÇMÎűo †c÷oײŠśŻżřăë_8ÚýŐTą˙ęáóõčź^‹†í˙ćĎEĚŁą1“ăB­ĆĆąúˇ÷_qíţ#·Pű<ĆOßľ{÷đńź¶ű}10ÄWóá°9 öĂk;WI(,˙o×ţď“Äs„HpÁ·1†‚`1äâhŇ@‡î=űřöý?âň ngě5̲÷~ţéúíÇßüíŰĽvňýÍ_Ä7vŢöű÷o?żů¸ţ.Ýż{ř§Ë7ľşNSt÷«Ë_RŚĆŢ~fůű“śŻ ôÓÝÇ+䣷ë‡ńĎŤô|ý]vż…ä5†rŰ›W[ż~9_Ň›?Ţt§ńę‰t/ýŢ|ýőŰ/ßľy˙ůÓ±u[~bęţčÓç·ď¨~Ö”ýôóW—«l~ôńă‡Óđ˙ĺ:MżyxüöÍőoţ÷ÇźÝ˙ŮżţËżzĄř&ő˙u·7Ŕendstream endobj 562 0 obj << /Filter /FlateDecode /Length 28995 >> stream xśśťmŻ'ÇqÝß߯`¸/ďŮż§źŞ» äŤlj‘¸€aHzA“Mĺ.-é(ňáÓuΩž™ĺR&AŕýźťÇžžšîęŞ_ýńůx¤çĂ˙§˙~ńţéxţęéŹO ęłţóĹűçż}÷ô׿JGYŇc3=żűý÷IĎąŘ#ĺüÜ[ĚŇžß˝úőËŻŢäń8Ň‘_ţĺÍń8Zéé/ß\ţţÝ›·ĄÔÇŃÓËýüşŃ?˝y›m)µ—o}›ňcĽü-˙˝äöćÝžţîÝÓ/}ĂňüŐwh—uW9=·–ŹG]{Ď–˝=§ŢęŁ<řÝó?<óT©ÔŇź˙´ščë˙X­ú÷O)ÇŁ•µď뎞߻’«Á–2Ç|~ueíÜ©¤FĄ­¶ ’ŤJ÷sBYg2M{Ő %ĄG™TZĄRxĺK1)íqčČťçJöčÚkđ\iKIŻÚŮ>K™ĽžŠ§˛”goë:&•,Ĺ;2^Îę>ŁPh|¤ÍÔ<«i§ń¨Feđävř—˛Ç“[^=śŠNeeuj*E{µ‡M*M{u5Oytި­›ČT&ľ'ď˘ţöř€’3Q)ĽMÓˇźmŔθ2xÉĆv))Úk˝×Ő¨đ×kíVŘR–5Ďë˝N:ź^ďŢţK)2°ąOXWhżňzŻ˝µVßTż]ŻuÉTÔëµN¸u+RĚű=”Î ^_Ďî-ę=šÍĺ_FepŻő^ěŐăĆÝl *SŰ`ˇŹOö3őšç9Ő2Sý¦řX4[źŔ,vʨTVźň˝Ö«S’Ąd˝zĺŔë ĄăĘz~ąčžŠ·u§Â‡YV+ąŤ±őmeç_¤„¦ÇRÖÍőLe&*řü/euQÜvY×…¦ń·”WĽN‘ š˛N1q9ë:y9k˙Ž˝¦l}Y˙ÖüʡYÖ_•źTYŻtöËY_ńĘ“c,çJ¦I.Ą=ô{Jč~ĘĄ”hôőBW·z·te˝ĐŮ/fíĚž´F[ŹÇŃ•ÖĹ,đ«±=ÄżĚ~ŕe$őć¤eY Ë;ŻţQĂ^MF¶®O,ËjkŽVŞ2\č>L€`lśŐřSĘ`ă¬Öç·¤®YÓú™Ľ÷ŕg˘aéYć˝.“òžﲮ7&wYZ~ëz•Ń4Ý{„‰–Y–w }k>hVşĎł¨dš•őĽwr[±„5Ä҉˛Ńäş-ć‰Ö{Ś†YCěşŢq4Ě2Ď´u˝Ŕ°+nžyśőz®¬gZyśő2®¬qšs˝k0ącČ„U &Ć{ţÓß#?¬ŹÁą‹ż6ľËôÖő’řy8¨«÷â¬'žµÇ ą]Ł´¦ŁN¶ËęzD-±]ö©zO^{ő_(8âR’ľ!uuS·)ÝM<…á涯>ÁůA]}Ň›Ąű ŤF3Kčú|UóiáÍN5QéÇÔg¨®ľĺFĄ§¤W©®±·ŰÚî_Wwu&o–žj<Řk˛”¦QWí°K±8rÇ_K‰áe]]ÂŚ>´:†[Űľ> şŕŐ Đ2ţiâNë=öAW_})i/]éë3Ó´W‡]éërđ}–é—ăź %¬;ç]ůŚd űëP}\Éńä&ľčK©ś'Ő5 îţ»i Ôü úµ”®.Ţ|Níײ,;-eó9µ_K=ÔÍźgn¦Ă¨ôZÔź›O©±SUďmţ„übV'¬ťŠwŤ% ˝ú-5¶Lť˛2ÍÇ$~ŕ–ô™l>Łv!«Ă•ŕ;-cĘ‘GË(.Ąé»Ň|BíauJ‘ćjżšŐ+‡”Ž¶Ů–˛ů|ÚOeIíŮ žóRŠ'ÍçÓ.´¸<źNC‰ŞůWÔŻĆF\źO§ýjĽ§Rńé´ßCŹŽÔ|:í7Ţł^¨VaO–Re¸[Ĺ n) ¸>f>Żëë#Ä!u[Méc®îFŤMęÓiż‰ŐyŮE›Ďuúęą|N>—ökYö‹ÝĽů\›´¸mźKűřđ’wésiż–e­tß>—ö;pĹ#ű\ÚďŔ§˙Rđ„–Râľ×űě“şľśşoźKűL‹űîpL,ewśŽ9ýRvÇé2·± oŇçŇŐ…Ě/Bó©´ąP5ţk>•î®4YŽćsééJ׶ů\şą2âú|.í{Ą#®o`˛˛”pjŔůäW“â wKq…§ö™´6™>,>ĂwŰ2VçřIóîĄĚx¸>“ö˝rŇĐóSż˙–QHh™‘«\d>×CËlóYŰp%ĚŹĎ®2ö2đ>+JŘ+ěŹĎ|B7¶Â|Ć/g źš mÂaÖáOÁ-Pˇ2ŕ7Ëq8熉ťź”Ď|>7|(É3ů<ÚŻf ¶§ŹŮŃ85Ľ;ˇ»P5'đÁ÷ť4&đˇöŔ>=Žëłhż:ôIĹ°Ů/f˝G]Űۦ%˝Q>vë2öĎGÁn]ĆúPRđ!.vjz|@ëNŁá<^°O˘ýr–‘â‹écS´Mú(ůčÔÍË°đ úXÔÍË°đ»ůČÓÍË°`śé7A犏)Ýe4|Ć˵Á¦±píř˛c—®÷ŮŚ { Ý“[Aě45[÷± Ţá/(ěShż–žăéúî~`˙Sń)4öŞŃ|>…Ć^»‹v ö—b2é>’óůÜX¦NwŮ;Űf˝Ř]Gžl›ő_y¸ąy#&đ>Lsó2ÖżpV‚ašďĺcr)đG,%L˘ĘĐ<#ćŢ>.Có¬˝9)őQXÁ^¦!ťMz§ÇŘŤęî6ě5âŢ'ËK™Đř¸ íă†Űř( íăF¤SˇwÚvUÁŔ̬ł÷Ăhc–±­ÚfŔ§6fLĄş1żžŮ4sęôZ@áׇQ°13>ä>Ś‚‘qŹś:ŤŚßŤöšđ©Ť9ôĘú¨ í3cĽÝ3˝Ó®°U}ÔäFf1ď™ŢiWh0Fę®Ä ĽŻŰ đ\¶žFĎÇDŢ>®¶ˇwz®–KRčťv%¶ˇwzú¨P™03®Đű(ăzÂć ŁSáa*˝ÓsW| dŘÉâÖÝât*ü‚ő/ =RźRărş,OoEÍÓ9LÄgR  ń!OÓNjŻ'ÄR†^á¤F…Ż÷)u§Â3­‘8gČcŚŽvšÚ‰Îéé^6Ţy§sÚ~č|»ĎŞ%đ7ťÓ¸6פs÷É.8éśv…fĹÇ/]MjĽOźTG“ę8pwłŮy}“ÎiW8zôăańČ®t=amgř¬:±§p˘çŁ¶Ži~3|·ˇp¤ĺŁ“‘Ř+Ůż|tbę§|EG _€‘şÚ§Ęűp„íSĺ>µn|‘h20ŃËĆì÷şę ŤMěQ(đÉřŘ­“Ô•1öhTŘ˙}ěŃŤZÇgÖ…&DmQÚ63E Ţ"ÝCÁł…Bg€Ź5íý1>°h˛z´YČVr¦4|~ť¨HŔ–/–Ź#|BăFfŮÇf4ÔzŤľiWmÓd„“<§>H ŽI™0ćđ%KŢ•O°ůma?ńůućçG˝ËčšöOÔĐ>FĚ/źţ1ČŁ÷O=FxŁęĂăźzźçů§1¸eđů¤aőĎ8†1#éťňĎř4~†yńţÍžüRëUđą5żćü™1ËÓžPĐß0HĐŐůÄ:q ˇNĹ;Ĺ`äĐ+íőşO0há@lp6˛”CŹĹ5Śtt“>łÖđC]u& ˇ° ú$Y4޵}’‡FT0e]J,@ú‹††1-Ŕřšú¤G›ŘNú>0p¤‰źëMNË®mGźÖNźWűµ´ř˛Í48~iYÎş™á۵93Ňc}™’6©ăy?ďÚ¦aŽçcęŞm:Ćť±<•O¬‡ć|*ł$ďÖ§“6mş¤}„Ď•é3kNt7·ć 3ěëĘą7©pJŹ°9¶+UŁĆYé•vĂ!k˘×¨!|Ví×Rb2}VýŚé_ŮÉɦPĽÚFź´Ď˛Ř_gO–Źńiµ_Ž%»éÓj7?¦Źóý¸iĆaŚ^é±ÝRÓč•öąŁŽCź¬O.ă‚}Zíg_CWěÓj˛ ܤËóXîC×Cűc9;|Ň>VŻęôIŹ˝¨7}VŤi6‚]ńwó좷ú¬Ţ=kĐ)í_DN%ć SÚçřlĐAź´»x&źSűďđeNF0Ŕ™ŔĆt“ŠĂfy“ç„GÚżéľMzŕ·ŕ×}Nz¤űĐâW>¸č ˙Ç’č=•öx)ŢŁe¦L}Ň=ŚŢRč“öˇ LĎRŕ”öŃͤŕsęLŹîR2[f5ýRŮ2]ďĘRl{ŹLĘ÷čŕŤ/…^iŁ5*>«ôTáΗRĐ8n±*…ĆĆaB§´ŹŮţůpźYç ú¤}Ś™yą#n¸ŢLJeˬţđr‹±eZŤ‹+ôKwľFPč—vO ®ŽËFđ¶°Ď©éPÔŤ SŤ°”Ά© ŽX ÝҵijmrK/SˇgŰä—®|3–€u›ćłÂ{jĆvY–§óžŕq.m­źňJ—JK™“WZ†g ĺQéĐŐ“öé4śł˛;Kél–0“\ki}"Ť˝Â†%zű°rXNěyXď<;–ž±$fĽbŹAL\5ăŐř4zpaMÇĹ縹†O<:Ą}uŽ}4ů,şpŹťßŁÇ|:g1t[JeŰÄĐm)¦•@ Ý–2´xÄÉ}ŤUÉIßÄR2#Ö«sH)ĐŮ6…ÉW¦ W7‡”Žµ@«2…‰ă/,’ňŤN>Ť®\HíÜƧэ‹­¦m*ćsľ kÚ+X´e‹Óî”cĎNýŕRඡ ë‰@ŕgÁ\ΗŹŤMÜ#Ť–©Ňy|ݸ  ˝Ňî0ě<¬¬*—łiĆť`Xň¦}L>‡î\× â«“Kç“·°^iwŞY,íä4鶪0°śčŞÂ’|ć^üpcźö.ůËS¸Ö_y.NČ ¦ ű1|e<ś ˇFZžZÓ.đ‹“éżA,B¦`ŚĂ* ] CUÝ»ËŘCLJµŤ|N đ*úEŻ´{“zĄ=Ô˘Rč Á*eŹCĂ”"#•óÁ†)ňL-EÁ]ëĺÓ©2ÝŇ·#gşĄÝ©MÓ›}ť¨Đ´y &ë]Í%±aň Ăm)ŠíňťŮ…ni÷§sL’ ÝŇF e0+›,G^ Ű]Łö\Ď­ł.˝óF«‚»|i”ÓîŢçăö¨1X—Őě~Ů»]ˇ’yŕ†6@ČI)l_á‘[ŰFĽâFÇ´ĹbîRčv…v5ű;Š,N —€°z2VŮ8ëą6)ôK[,$çĚ9"Ý•Ń/íQY“{ů4şQˇ%ËôŹ#şkHilťT÷6ôK{ŘĐqč—vĄđ&ýŇľ8Łő©´ÂĎô@Geë$­tfŹcó¤x|~i,űđľýŇ®čŢ'ýŇ®R ă°·ěŽĺI!I16Ź{yŞI·´+XuËĺ [ÚץŘĹ'Ó‰JŁP†ut}K=”l*ľnžĄt…2šľĺ WÚ—Ŕxç%%Ez6ŤE‹ŹT:~ż<–l*H’#–âóiIVí5ËX9;Í% ő,ěN%gEz*l-{äXDz˛‘K†w _ôâóéN%öšŠeLúţ—’é™ô™F짢6-U‘žZZ_Š©y=‰R†šçŕ„4—JŻ´+´Ąf…”OuB'› źmĽÓÚR>ŁákgČýRg2ä~*kž¤r­Će*›Ěă´Şň®ˇDi¦ň®oniC!÷=—Ď HČŠ(Ź·¶XQHąéiů¤:ÂźµIWŔ}|ÁŠMÜ+đl™Ę¤Öiôąe+ŠĆćN˝* <>{ŧŐÚ)i›ˇx{Ĺ}/‹{¨qŞ>FU6Máă|XŁě€ry´Q®#Źĺü9N®Xöě!d‡˘ŰůĹ->­Vt»zŬŠ'×:ţRLńä%úÉŠ'ĎšízŮ1ú“JRŰd™ňę‹1CˇţFĄ) <ćg•žđ3e`)SĺY˝«şŮR˘Í`MYŤŁčĂĄ`‚ĆNĹP®4‡Ą ”'ÎÚ<°l^ł%Öw.)ž<ĹÉsQó˛2575Ź¦”Ő'Ö×äŤě‘es^Á¦ŔĆiT •B 3´~µ”¦ź™?é›v…mŐ|v]oJ:vŰŔ˝”Śyž+üśµÄ ŻĆ™«— ě˘U˛ĄĐ3}U|` ĂŚćSë,…—ź‹ÚĺTňĺ MfËôL·=ýn™žé‹RÉ…N»¶Ţć¤Ëá3hĄŢ2ŢË:"ZˇgúŞŔ3 ż}b­K©R ćxWĄî–áŔ˛UF|]ş¦ˇ°­]ÓW%Ă‰ä żÍ'Öwˇí– ĄË˛„צµů(7Áč™v…ó*Ź-›ő®`VqSl· ż@ÍĆ#ZTJ?dZLFŹ-›ă®”ÇGB© ýěŃ2ü9—IĄéŁ×F–E9•ŠŮÝU1µÉ© ¶I‹Ž9”SI2(§RhQšfHËwĄ«INeŞIBAúRľ+YE ŮGąÍîŠarwUĆ#ß„těĆáĚݧ}Ü•ň°»ĐdPN©7eîĆ‘âsj{ź?Z˝+U6ĺTL6ĺTÜZß„ąGŠĎ©ăŔ™JˇU9…&«r*]VĺT†¬íV|J=îJ~|´I•QiÁ¸w%Ť»ňŃĎ)k»źO×»RvË„ŇdVNĄË¬śĘYŮŠO¨ďg÷µ„Dˇî¦ ĹdUNĄÓŞśÂ”UŮJO˛·§RΦ‘ŇΦ‘b2+§2dV¶2™•SÉŹűN>ťNwĹÎĆ‘Ň: Ť°»s-ß”™dXNĄČäžJc¦đE1 şNelűBĹ}ŰuÜ•ö%„*›{*‘H}*‘H}*s))mJŮ&”*›{*öřH<ę­äcŰ—Pňă~nźM¤´m|Cé7N¤QźJIŰŔT eŰ u› ¦WżÇŮ0"úrXý.Ű°H Kú"tÎĺNažM!2§O!oŁ"ˇn›"Ţč‹08SŮBdMź‚’¦Oˇl“"ˇm‹"ľč‹09OŮBäKź‚ŇĄOˇnc"Á·cúśůvăĐ e J•>eJźBŰvDBßfDÂÜV„Â<8o;eIź‚’¤OÁ43ŮÂŘ‚†ő&$MÚ¶ üčSPzô)tÍJ¶0Oă!§í 5_Ű‚2ŁOÁ„`ŘÂĐŚd ó´r:Í…˘©ÚÚ˝=†r˘/ΧPME¶O‹Aˇjš¶ű¨=” }ći. Tşš/B9Ť…¦)ÚúGíˇDčShÇÍVxN»íŃęÝVxXOş]†r /Âü¨9,ÝŤ…Ç•Ű.ÖîĆÂc›ŽŰu(űů|.|;hĎwcáˇXůľ‹ÝŤ…ÇoŹŰu(óůFú¨=Fą Źą>î»ŘÝX îvJzľůŁöőn-çwߥ߭…‡ŢŚçTĆóE(÷öđ°yßĹîÖ1Ą—]>Ű$ó<Íuď7ˇ#”×Mč€ÂP‘n <TNĂMÁšŔMĄą)057$†›‚`׫BĂMA°ëM©űNCÁą) 1ܤ^nb]o ŚÎMŐÂx'‘® I 7‹u7!_7¦ç¦ŔöܬŻ^’n Vën H 7ĘĹpUb¸)w˝)p"ßG1ܡ›;tUb€2U@¸ëMŠá¦`Uç¦Ŕ]˘n śĆ7ÁT}‹á&€ĹpS`‘® X 7K87,(ÂxĹpS°ězUh–n X Kv †óçőźŕ<N53ÁiŠügh‹n ˛>n "§n â\ˇ$A6Ć)d™•S©2+#2ô_¸ č°7®e(Y…m±•"«r*UV%Âě_¸)€/\Ŕ (“žđ…›RdTNĄ=Bźô…›ú&ĆŠľpSnC… nŠÉ¨DBž W˘+ ęń* Ô•ÂŔpş ĘP Ą W…*WĂM©Ń4C¸x(©°i`¸* 0@ł*˘+”Ý2ˇ4µL$ťŔ…LĂE •ż%k›Ę¦™ŃEČ_¸)ŕ/@vü Wţ”*DB]©h›¦¦ Öř Tx—ä/@aČ´ř P‚¶eM¦RtČ_€Ŕ§ ţ&š“żE”tč§Ř ŕ/X=´¦ü*LE'ŠrÜÉ_€"h·=~ŃŔ_ "Úř PHKţ…+Špä/@aZ†ř PDd Š8ä/Pmü(“—Cţ‚ůšä±ů řÉ´ń 0Sü(ü~ !@ž†(˘Ŕ…  ®€<{i@4Ţ ćÝBP A^/ tÁ 0@jśçPL;á[EŔ" \ ć«ą‚mŔ… "0@ÉÚ ‹ńPŘâ0ŕw\Á®¦Uâ× `€˘‹!€ĘĽ¬ŇÇőş P„¸ €JoÁ®P„@‡Z"0@Ú ‰5ć‹Ö‡@LA$" Ü PhÚ…`€ŇŻ(ĘC'Áü×&W…\‚J”Á]!đ MmcÁE ‚Á|•ť€ŚĽ‚ŠRŕ‰`€Â×R(C{5µŤâ0…`€Ŕ«#1S"0@á]Ŕ`Xđç™ `€Ât4 4mo&”€Áj:6J!Ó°¤H€Š’ř `€"` ćV“=0@aú™ PlđSPĚ#‚Ů€ő8(W~q`0·ÎBQŔE‹(ęF0‡>čáŔĄhDąCŃł$€ ż0 ĘŔ…VLó ŠŔ6 ÝdA!‚Šž  ć_”tE0@ŃsXO€"nC§uI#¸$0@1Á`×ÍżLÇÂEB č-#„Áüó•Ż(JŰ'„Á<$‰žŘ<9Eâ7) ć=~]Da€RŻ(â)Â`PREX@¸'Ą¦“Â`ţń,R*›'+÷ 0 ća(Y 0 P”ĐN ŐŁâ0@Ľóč•€,4µŹBÄa0˙P+ßź(Ě›Á*]ďŻÄ`ňrhDĽBiÚĆŘ<%8Ą1@€ óHľ}"1@(‚$Ă €"^ÍŁiŇÄ%Đ fĆÇ Ľ‚ Ö@yNb0[ľ!ŻPć•Ĺ`¨Ł%‹ÁŁ}Á| —…T(´3öS «łĚ˘B´3=X1‡H‰źŮ<˝ÄÉÉa0Ź™Ş­L×ú[`¬vĺ€ó*Ha0!ŠÝ@ !¬Š{Ă`>hĽaĚ#­$ ™QQĚG‘Á\Čl›‰‡˘0Ź+ŐęÄ0Ź+…‰ †Á*ŃŻĂ`>Ňß󑦸 ™m3#)^óˇ§ŘÄ0Xť‘p) ůh”©łÂ0Çk%!2ŤĚ2Â0XÝłPąě¤0XŰ3 QĚcşh^Ea0±Şß’Â`mŹTEa0± ˝p%ó8/ÝcéĚÇ°j.F0ZŰ#+aĚ#żÄ!†Á|T+ÂFІQ­6Áúťµ=ä…Á<Ś§…Á<,‰ž@Ç4şĚG'…Á<@L©ň¤0‰@ ůĐ×Ds…a)Ü…óqŻđD0Ç‹Ť+‚Á<^L‡%‚Á|,|C0X#Ýűu#ĚGĂ|šB0XŰź'1ĚČ„Á|x, Ö¸đş ćqebÁ`><ć&D0‡•q 'yX™ę‰`0/ î@ůxYěďvÖZLăE`03SKŔ`f¦GGyś™ŕLA2Bó'ůš;‘Ŕ`xĆFóČ3Ý7 ćj‘H`°¶m­ ćj1 @`°f1R‚Á|L-Î ćˇh Á`>¦@óP4Ý'A ć±hÂyÄ`>ĘÖ!Á|”­ $ÁĆ`>00ł8 ÁĚćĘĎ÷‡ŕŁr;ÁĚöÄH0óĐ6»Ŕ xe^-óźĚ#Űx˛Ěr`¦Ĺb0Ąťˇł]rt±ĚCÝŘvb1‡şč öűŻÁY ćˇnşG˛ĚÇí|=Äb0+>!ŚÁ<řŤĂ~Á̶ŚÁl[ ŃĚß‚˝€WłmHc0 $y4ś L#7Ű4ó˝ Ď€dJóx8a Hc0Đ~y"ŇĚ#än4ó9~Ec0ęs+Wí_7ŤÁŚŢö× 1ÁC÷şa ćsůJc0¤’^h f–\@!†Ž^Í,ŢÁ ™®-$6ŤĹZ` ćQu<Ń ÚçC›ĐAísáCżoeÇf`ňů\Á®0ó°;uŖ́ jqÂĚŁîŠv˘{ŮĹĚ×'ŚÁĚĽt IĘ•JAË,35Ż0óČĽ$ôÔ>ĹP ?` $Ż@ {5ŐkWůśĂ„U¨lş _7ŚÁ|ҵ]ÔČéÖ6tQűĽDäÄ˝šř]P ćÓŃGi>MéÚ„ţiřë":ř;9#Ę_,Cüźč y5d˛3Cž,ëa(Ĺ`>µţ€,óÁte1OvqčˇvĺĘb0Ź#TĂą`ť~Ž× c0$ěóc0,<®0S¨áë†1O™$y𡮏4(ş·>§x4óčD&ĆeHń®l>í„8óF&w ÇĄ]q Ô0·!ŹŠČ ä1OÖ’đ ¨O“Ç`ô¬,CQß#ŹÁ|Š§§@Áŕˇößj‡y<Ąŕ!L~0EXľn”`-Ŕçb>uĚW‘čˇY›` i¨) p ‚ę0Ů6ů¸ă đyÇA`âĚg­Jß'ŽŠ6Áz&A6LŽ<.Á¨«] a TŹĂM€]ş*„1\CĂőT„1\/‡©Ô—+&‹árOD1đ¶EQČŃ2ăŠb`ăQ€±€PtpĺÜĹŔ§„+ž$Í•P Pt˘Ř!„k€Ź ťFŔ˘ ×@¦ńĹ€Ú…YŠŠD1 ăO§Ă´$ ”Q Pß/ި&i‡Pb|ˇńfňŰ"µ1Y xĂ«P mKĘÄ€Jś‹–D ˛\áOżÂ1qF Ř+v!ÉćNe° Ä»wĺ0Ŕ4ęňÉa€=D(zşä0Ŕ uľi·ÔUŰĐ7íĆ< ŕ0ŕ çD>b>Ă% ôMűÇ%]A řń«+>RBÄ€ŻG$|éÁN>†ě1ŕ{ɶ‹_ÔPč™öŹnť^X|ŮŻcŔÇ» ˘€X|ŕ•tOY ]Ó>P ±Ś ńcŔDéó„1»=‡H ‰­3„l †66Đ5Ť’RčšFŐ^a WÍ+ŚÁÜM+pa Śń0d1`Ľ¦»"ŚCşCz¦=ą˘k/Ŕ02T Ć€ÁŁ „1Ş@đČ„1`Ŕz¦} Ęf'ŚÁÜ­Ŕ0ÜeŰĆ€qžˇ˛qZ|öcŔ¸Z˝€0 ˝á@ż´§´KA†đĚbŚÁÜŁO$¦40‚1`ş #Ć`()"¬]Ó>íĐ5Ć`V#+J0Ě^á`lťšBć@꧄1/x)AćRĚcŚÁ|ád^i “éů‘Ć`žłÄŹżh Ú‰´@×4H#RcŔQ‰ú¤1Šâ0ý›4L4Ë•Ć`žwPş¦QÇG\ş¦-3ň!` ö*çž0ĄCčc뤮\@ÁĚ“Çě cŔ,<đ tM‹ÁË!ŤÁ,í%ŤÓýrĄ1Čč›cBčú¦m…c€ďAÉń„1Ŕ?!ęa Ö"'` ps¨ c0T[ăMĆoI–Bç4Ň÷+•FßŃ9` đĚčÖ c0dXóF c€‡G·Nůę+?7‚1ŔS”Ą|GaŇc€ÇéXá kmĎńDc°¶-h đnéމc0_gv‚8xÉ™ ŽÁ|˝š§"ŤÎ6ÎEc0Ď Ý Ë;m=.8řőtÄ1XŰćI8řůF Ç`ľ0?Ż8řyĹCî馠1Ŕ[YDu€]·Ć‡ŻČŻ'Ç2Gľ ďtS¸UđĚóxÇ•Çl5á ďľF˘§x pĺŃicÁáŹx đ+!ţőܤ‡pPǤM<8źĐŮ:%€iâ1Ŕ‰­¤yňĚSĄ»ö’‡şÄtU@óŕá d€S˝^ pĽs\$ yPŠŕId€÷> ě0ä˝;L"Ä ‘ B4T¶Î¶NB2`˝§&‘Kj Ě3ŘŮĆ2`aCmĚőY_üŕĎĎ}:”đ*P‹ Ť‹,‡0 MĚ/ŠĆ€µĄřÇ€őś,@ŃulŽq Ö"`-p X:âXK8,/ ‰`Š›xyĚ”n‚<¬d5í4Ś4ëăŠcŔ‚żşÂ1`MŘ„®°\á°öÖ®8¬Ďé0±HC+őcŔ*źŔÄ1`mp^q X?B6ÖwŹ%Ž‹ŽbśÇ€…É&…ÎiżőXâ°ŔYh wÚŻ\Ř â°NŞg–R•đNV[Á ×{@˙bşâRÇ€U]ľ+Â1`-ON8Wř33J‹Î °ľ|Ö@Ď´ŻAë2ČbŔ:µ.,,eÓT‹Ĺ€ĺnv!±°$.”DVô—Ą€Ĺ€Ąu tL{mWVč9:Š«řé6„Ë4“ŃŠÁj˘ H „: ‹AĽ˘—ŔA¤P fčÚFˇ_M©b€Â./â$„Š±ś|Ĺ€č N„bp…?é“®őÎa@Lm¶8 űĐĹ‘Ă€h‘yĺ0@á{#bLšö˘[ş†?8 PŇ•Ă€xÎÉa@Č ­8 PÔ‰b@čŚöWÚktÁä1@Q7#ŹA:|ŐÄc@ ͢x PŇ…Ç€x Ýy "K„<("ź€Ç€Č#Ýy P8qŹLęŚQ‡ÂŻx „˘iŹńSü0‰ÇĄhcěgy ř:‰Ç€Ř­.…~i| ąx 3 tL»›€Ç€P2z3Äc€Âąx I»ń ¤+Źˇm|zâ1@ÉRĆCQtWX„c@čÝĽŕ Tč™v…N8Äôé(Ć6q—¤1 4°‹¤Ń4I5>Ć€C~)Ec€ŇtýLW"É Ť ŻŤ0ę„1 hRŤI^ ŹŤ9Ż,(ô\’Ĺo®X óä™Čb€Â1Y 8Ű‹1¦üüŠĹ…›Ĺf[(„łŇś ĹEŤ(( ĹŔ8Ů Šˇ´]›T…}Ę"š9’Ă;Ż$(jN’ ÜH PÔ[Ib@L1ď€ qˇň“ ą΂ßĚ)ş@ PL›4)"Z&@ PňÄŔŘjܦ@ ŚżćÉ b€Â‡)Î>b`¨7·Žŕä‰Ă…v…Ć”ówÝ!ĺEű4…”+.0 PŽ+†î<71 PŘ%Äa€ÂáŞ@ ¦ç}Ä!i§ńöř©˙đć­OľgĎ/ďßüöÝ/žţîÝÓ/=DdŹxL~;[ś8áJ˝Nźx{ţíúó˧uwk\Öž˙tn®şnçlšśÜźqeľž ńďOĺ˛ŐŻutďkx9zlőéýGáă^ŹF[Mđ©­Îm†<źý™Ćoźh|˙ ¬}ý´¬ľîŤ˙OŢňlG=ńîŤő®ťO<?á/qJ —çVť–ćđa‹ţóáwĎ˙đüÍżŃ5>quľć^ý¨kłş:®îŹ~uěJŐ߆µą§Ą¶5á|»ľši˝7ŢK^Rlw9nńúö|Ýě§.âp>ůĚËÜąŘwřIÇkج|âpČ\Ź×‹ŽőL~ÎĺŐýĚř4âmέ#quěä#˝ŹăŇ!ź±ţ˙µűŻţž™bË$Ż÷ĂŚ÷[ń|ůţŕO“u¶/[Iąn……ŕ50;· 嶕űnĘm+)×­~rWăť|ř™¦(yy«e}ŞpxËľ_Öć߬î‘ŇËß,[ă®QVçz»Lž§ź­Žń¶şsÄl=ÔĄúb__ĎămöLŇ^Úi—~úłůKŻ ‘śŘĺťLSú?óňŹĎ˙ń9˙?·©żyłűÉź{úŻpŮd ŕ÷LAńˇĘÇĎ<1‰śoĎg9ę§6J>ýCqś‘8ňóĎĂŮ»ÖbčTTfé+¸xT\ŐT%kqŮ“—‚¨8Sőy˛PYÔ”+§’-zśMe–ĺŠC·ŁČÔyPśŞĂ4ŢT¬áv$ŠC!ˇC°†’™ Ÿ—©ĘR(/—)č1¸ߨđ)Řd ·¨ëY<&Î(đUő¸ŞZ:j¬®K‡Bw‹ŁÔPEčPxońćČ,í“y1ă` ·Cţ‚8c‰ GuWŞ<ň°]FHí7˘ĘŇ}}ŔńeđšÝʱ¨‘ZkÖpKI7>«%%QÄ5*ťĎnž5–hT="ÎÍ‹+´[3ÖjĘR*k¸ĄŞ¶@DÜdͧ,%j,5zXŠGıƒÉ4ć•AÜ+–JĘ"-WC·¤ř©‚8c媦mTd)iT<$E–ŇT×)L%CŐ¬,Ą˛ŚP>"T7Yk k#ĄdUYĘ*_]<&®©fWç]UYĘ%î«  ź¨ÇıZ™› bâ‹Šńé”"_BVý¦â1qhźlô˙Ź‰CűäĎ«"l ŤLař%ĘžŻ§v•+Ór^ń8s;Ô/=&ŽŐÜŽx^Me–Š‹ÇÄÁĚ Z‚±\٦”ˇbn%ŢTe‰é9P˛ŠąµčPĆ*KV´A‰)Ý‹I§¨V§-&k•y± Âáp)S×ÖY_É79Ŕńh84LŤa˘áTLĎtÁRe5Ë #{ĹŘk(äV«,iaŚ Şý%y°Â’UE«‡‘©m5&ŤŚ&6ŃpŘIeŁ ˘áT PĎr˛Â2ůxŞÉ KĹ­‹˘$źŤČ>(É‘®]QLR×Ă$vśd7đu+µZT‡˝„­*ľĚ +cZG+•0TÔżä áp(\©ŐÂâ!hzÓ<¶íÓĹh)‡CÍÎÄxŁ‚x8ß««Z_A@ö*q§…E–<ôś_GŹß@űôöŕ­3’°ůŞđ`3“…Š*Ł/§™>ą^‡z¦GśŞ˛ĘâéyŞĘ*Kľr̶‡Ő yF‘qPxj§ňk¨8ěet1APUŤÚXhɢHQń#4ĎT>DÝŐ]S<@ÂP›í!0˘â°OÄ°TÔ•ÍÚ…e–ÁĂv–Yň =«Î2K¶GQ•ţ¨sŰxăyç­3ź ňÎQ.—Ź0 TÔĺtÁŁŘPŞ×?fXe©3Á ˘fP»—ěÎ|ěŁĹ˘‚¸ÉŔz±&Ë,y^ ‡t‡J˝©Ćóť,ł„´9ŢćDŇyëQ|±T˘_Q´¸j,$µ•Kă Šó’tÍ—˛ůBxD$'+­ .®łĐrÓ^X˘G-f,j–FTę5s'9Ě|u+8Ą1Seźiw<8Ąş‹°OEh Ź®PBĽ9+…Ó"Çu f_Gpś_Mfi)ŤE¬ŮŤ)ß­«LjAdśjałW7†µNGLçŕjŞĽÇÂ2K=j˝ŽCMęŞčĘâÁq(ŐÝTk° 8®±Ŕ7;-˘ă:‹€s@‚đ8żž¦´Čâáqn€ť¦Bsâţh4MÓÂUńđ8TëކSQĐÍů*jІi* ›sĐ‚đ¸ĆâçşÂĆjKÝâµň9´ŹŤ¸BDr7_%ç·!rťĄŘŐ• !-­weĆ—6**şÓŚ{„ś›__%W Ú`ëtńcŠGȡdw× biŚĐlľp®>ÚÁCz>,˛Q›Ż›««wV[ęQܢxŽbŃ!«-9‚E÷=2KĎC39‘C)đ(S]騭GŔ‚9ośYăĆ'«-őiqçS^ÉąűÎ,´0s÷ť‰ľćKéĽMŇQ ,PrÉ‘,˘¤%%Őźgů(Ě—ÖůĹ5jšCZxyF*bóĄu^ž1ž¦9§…ź„Č™+ń}ĹÔÁŻ†VS˙eúŔ٨ÍÚ9¤B|ÜtEĺ1‹4Ó|Ąť#fcşkµ…K.9´…Ţ2 ‹ýŔŰţé¨mlűc¤Ł¶‘µlZŚtÔ6¶B€śßŔ6@‡şöéA~ŕ°?F6js°ËŕMąÍwŞ wF6jó•y ,·äT—g©,·ä ójĘĘrKzˇU3ÂQ@/|$„Ł6_ŞçÉFmľRŻ7”[Uą3ż:56VöWMń¦…ä…6öčĎČFmŽ‚‘€É{s ßÄÇůµ4UI+>€B»4EP.?ĺY.Žóţaá4˘QÖöy‹`(4GĹđÝňa{]-ŕ%`&÷‚‚Đ(~ĐĽ/›b»ŠŚÚ°öO!{ÍQ2śŔ+[± fÉ@AĄ%ŹĐs¬´4ç “'›G¨ĺ€Em›Qżś?o.`RXhÉĂtŹ“…–FWpAÁŔV¸Héä˘6Ň mĚć!śť`â{ŤĽTZŰ"ËÖ/gÄL܇h›Ń4?íŕ˘6;ŕh®“‹ÚbĂí䢶Ĺ" ‚ăp5SŁ%^·1&X|DáŤ3•ýTgTŘé;ą¨ÍŁtrpQ›ŁpŞ6ať%gŕńáÚf6Íť:Ȩ8°őŃlĘŚO7bă°S×€ÁqFE­EđJs¤_SŹŹĂabśÝ F…˘­tM;u§HkÚš¸MńH ZJ¸kÍÉ<4qV;ŚŠiz§=Ú"Iˇwڕ؆ŢéÉDWHQB‹ëńqÉ…đ‰ůH`f*< ™)ř ńč¸ć‚Ĺ}ťÓ®đ[ĺźýT©čavV\rtPŇ6UmCHCé]K|GŤN.*µÖ sz Ö^JćOľđťYÄPxšŃÔ.Š÷.'ajz¦=˛B}fŇ3í żgŚ3*śn 2n(—‚ĽěĐ€@×ô© 2nÜuŢ„Ór×?ß­^ĎŤĎw\ ş¦ç‹Hţőžq› ŕ–PhH§ÖDLYA`ÜTę8\F‹óYU ‡Y©xL:pFŘ&ź­6i0-óO#ăŚ}„S:˙ť ç1UE p45XUÝ‘=k°Ş”¦˝<Úű˝}Ů:Š˛/7 úÂüóŰůúĐL ÖÂŁ°¤ŢÂŘťŠLj›¤>Ś¨¸I…aq˛j&XĂp¨)PRB‘0hw÷ Á Ą gţţéôÝJM-WeęhKŠŔr64HC…"aČîŠXU<*Nv—†Ř?„-Ń4ë)ôĘ1Ë gç@AŘó¬Mč™Q·ą ˘Pńˇŕ'1qŤö’QŘ4c÷-Á7ih'ŁÝĺ‡n°šĹđ“T|ćř©ńkôŮś;–gňŻ%ÍéúśęmbM|ryé¬*‚Ż2_‚IŞąů“Ĺ™D–ÂęL> Ú…ŢhoĽ.ep·Ć|#OŔˇG“€$sŚN8Úš‰šü1Ń©á!>‹ó1 ďp’Šł“eE0Xâ&¬*‚ńßý™‘dŢŔćă]e–iňŽĹÇ<3ë4yçÓ&tEűĐŽu’~ÚFSđčRčŠF°'OUcŽ1d×6h&Ś39~ť9ćÍ_ľŘ“T Wéž› bD«› µů‹´ ’Ě12îÚĆŘ:U¶Ą` 9H‘Ó•I*Ćŕz4$ 6·´i“TŚĺą,0†ďë.Zgű”ąŹ<1mŕ&¬,ŇÜ%)tH»±ă@q’€Úś2)Á8‘+)ÚÂ[§Äčcö­“Ĺ•+“ĄE0Wâ“Šé”úm§;śLć•ń:űdăěŐ穡qŇŚă°¶f€jdP1KÔqýŃNűÔ%ř†1ÓÔ%ODd7˙žŃĚ9d ­“őAŤýĹś$ bâ«ţ5éŽ{moNdź`Ť ˙ęHµ“ăBC°”Ěć9Ôż–Bw´ĎÔ1X ÝŃţůŻčŤö€úŠÂyą”D/Ú’~)…^´™éD^ ťŃ} ý˝:Ł{„ěÔÔ†Aď!ô ÍQ—’é+bś,ĄŇŹćx)tF÷0ő ž—Ćű$ŢÝyIôuÁă–RŘ:Ž'ŇŘ:]oÍRúv™”!gŃ÷^éŤvźS“’é-2‹{Ż•ícŤ~»Ąۇ0B(ôFűŔ—ŤQéŚö±qçM4:ŁLśyÉ ¸ŰLJcó4%î.ĄłyZŤ lôG÷–ăŤţháëŤţhź 6łw7˘61¶NU`BuÜZ§*Nb)ňG×ϸË]s<ă.‡t=Ô ;ćÍÍ)Ň…wŐ;§(9v)­S4«ÇCşÉ·9¤e‰– tX˘ępµ^YY˘Ąt6NX˘ĄL6Ž,Q=f¸Ł•«·”pGk…¤3ÜŃU/Ĺč«Ď)ž•O©ýr˛&źu;ťá|ćé?:)ăk)•ŢúÔh›jb©8޵S—·^ÉEK™ňÖ§8pJňÖqŕ$ôˇä…ę|5xëŹč^)˝ő‡’«ÇšVŘ RĆ‹ŤŰ䬥 Ĺ[Ô”ĺ“>µ˛Ç–aQ0üŠKé\ś‚ą.erQpjµ±¦’0ŤX &žľŁ>Xp¤Y$-…>i ďhM,8‚•źĘÖ¨}Ć«™ŁGűřÄÁť2ť'b-–ˇo“ŐFšm–Xm‹WźyK\‰N“ę‘dđÍ n•Ńnâ(Đ#íŽ%Gš;źôĚYp‹t즎Xă‚`ŘĽd…mĂşĄŔĹ‚Á&ĄkAPăşšXp ‹:; Ž4wź%)™+‚¦â1K©Z0 »:B°Đ9¤ ®š 15±ŕLůZ'Q±¨ÚµŤ»±îjÚ¤i˝TńzKAć9Öo٤¬7‚%^őmÖÁ2p(tJ[k)•HMś˘Š˘ťKÎ:•§“pUšBfą¬\óšYn«Ű´gDT,€ÓNz¶¶FÉÎĘ…t \*JvxIjfµ¬ľ'žśŐF°BĎ/z&ëú´y(Ů9¸öϱ—ěĚ `Sx@ÂłŞśž5łŘ ¸kŤ@ŕ§'łÖbxyŚđ@IÔěÄq´¸Y˝fç¤Ŕ'WZ‡@8ŢT! oÜkv ‡„Ęx¬C­đv!$)ťMsmT q¨P°ĚV q¨dK d§Qá=ĺJ{c[=éAчĆëÍtKŞĆŁpD…EÝ6¬ pęńc‡~˛P°#żCEĹNŁ˘Ć˘í€rpŻšňÉŞ;ŤÇ……ź…ˇäřÉ—őŚaŻ¨!§¨v~XÝPT;űŠujŻ¬˝ş"É…#¬¨‰¦Č|Îp|2™?)`´…f»rvÂř~^/ę‰0@; E’+M ˘Z§vb—Bń.%Đčˇ0Wż¤$TTÝšJ[`{˛ Č™×P+ Š@á©0<ł#މ,_(*ęu*í‚V8$%kđÔ ťąµ˛žČ™ĎQ+ Š@ŃĹ´˘(űCăiĄ‰đ7Í™Z¶b5¦źđQMäĚP©•ŐDÎ,–Šrťő’éRQŻÓ.Ů0ő:uľ•ń+gVM­¬&r&ŢÔĘx=*Ú-}§z´ÓwÂ)zťE oŰçřvU–ÂQE%˙ Mg%˙” …®¦q1ËTx&†ÔAŃëÄ…Jü)>'âOˇčť›Č3§âBăňEk{žÖhŇ©* ęjCUđjc-*™  PhP°sJáąz3~‹‰PŃ6şš‘Ćb"P8^AąÎ"=ů[Ú‹mzťş~hˉ@ak5–ˇÂ[`9(l-Těś7Ą Řž /¸Ŕm…ź°Fú©+üIŻtZ!«ŤĹD®J Ç(ŘŮĄđ*¶7…^iWh1ѧTxSDź^źBëzč§óh±ŁHáMůşÝúĄŦ úôŞ0 „ đP T)Ems*m7‡’ŤäÓ›Bż46:n ĽŘPř!h\Źą)¶›'”! .šFôéMI˛01…BÍÎyWÚnžPún~†hk®ѧP8TDbXą+X§¸)ÍĂź#ÚĆ©§çO:¤ýúřéóamË©ŔsSđŢÜ”©VŃ‚m5"OoJ–m9•*ă"kEćGż+J]ź=§»’d\NĄČ¸(žˇ‘§7ĄËôžŠ2>OĄ»}8S72OoJ•}9“}9•!Ű{*s·Ź”švűđĂď:ďJ“}9•.űr*c4¤´c·O(y·Ç3ňowĹdbNĄËĜʄĂţ˘řTşÜ•˛Ű'”¶™Đ Xgą+C&f+©k7%ďö Ąîö ĹdcNĄËƜʔŤŮĘ@=‹›RvűЉů~WL6ćT†lĚV¸¬sS˛Lđ©Ôł}¤ŘŮ>RşlĚ©LŮP:ë‹Ü”"|*íl)v¶Ź”!#Ł8ÚŠ‚ťý®dŮ™S©˛Á§Ňvű„Ňwű„2·µ‘’Ó¶6ˇ”mmB©pśŠíö eěö‘RŽmmBÉŰÚ„R·µ ĄÉźJdSźJdSo……FnJŮÖ&”ş­M(¶­q(L§>…H§ľ(y›Jˇl[#ˇmS#ˇoK,AąÔ[TęSČ7NOí¬0rl cŰ` ‘H} ĘŁ>…˛ Ś„¶í‹„ľÍ‹„ą­/…H˘>ćPźżë¶,臾pCźż~ŇG­ÉӧжI‘Đ·E‘05y‘€Ňśă&0uúü­ĚéS°mK$\ńJ.{z't§ ¬éSh÷Ö,%rć6"H<˝ ůqß@ůҧ téS§ů 0Oë°Ó«P4ŹŰ‚RĄOˇ?ng%éô"°xČUČŹűUS¸- [â/laj’)§Wˇść‚BÓěm HŹľüfvô)pzňăöŚČ7˝ ¦iŰúGŤˇÄčS Üô*”»™d›^…ŰcWFô)(!ú"Ŕ»|ů]ď&bizşfj[53ˇ/żéWľín!<”îÖ ć [,„©$č‹ď-1‰2˝ t)_„~7¨Ży˝ /ŻyŰõoÇ$Ăô*Řăţ{Ü-JkŢŽ™ó˝1PZóv LŻBż[ÔŐĽěňŮ& śĚ¶ xśĚ6< .@KsSĎ@YíÄ3\ân /]››{sSŕą)˝*Ŕ3Ü„"„ă©´}㡸ѹ đ(_ân /]•*‚ă©Ŕô@a¸“đ 7x†«<ĂM(»qBi»qBqűs`€® ń 7%‹Qx*u7N(Ť#h­ĐM™»ăX!=î›ĎpSš…§ŇĹoüĎpUhŽ  qŕß˝)UÇS1OĄ‹ŕx*0JWVé&`…… Á4ÜŰŕĂP†ŽˇĐpS`ś 0ôX€†›Ňp<•.€ă©L·B@#ůłÔ¨źČĎ8"¸éüÉZKžŚ.ġ 7% z*UřÓSC c?e¸),¶tQe¸)E¦eDŽ>ˇ 7ĹdZN…LE¤Ô ¦pD›l%GłlĄČ´DŔ˝  7ĄË¶śĘ6Rée¸)e·OąBnŠmj(CĆE`Đ 2Ü”,hŻ©*ŠŠ 4†dbKT^:6d(|‡Df€Â÷Cd(Lb™ÁP1Ž·E26NSíĄ#ňçf€Ň…j`íĄt‰`(Ě,Š0u5SíĄ< 0 I`(&TC¦II‰Ő3 PIÖ6Ťő.R¤7‰ĚE ‹ÎúK,ÓńşÉ Pę•ĚĄk›Jű’‚ 2”*Vę/ĄHż™µ_´×Tý%–÷yÝd(Â94ÚŻQΓ̥i'`JÁíšŐk˛@ *ŔäŔ„]¨´/)2ü„f€˘L{˘ (§?©SŠQĐ PÚ…Î`úôľn:ęúÔ+ť źč (”Żt(â,D¦ČŁťʍ΀âE4ë˘3@Qę?é Pś(Q)H`¤3@PÚ>é ¦ˇÁëĆ3@‰mpKA+žĘ”ĺ—6|(‚Ô(ż4nA>iÄńşů P„+  ĺŞdN@„®MT€)Š8 Š„:C*BxT×:¤dZ—Ůšâ3 J—đ¦úK%$fŞëĄ"źŐŔô Ég€Â=€g@1=®ňK%@—"4@¤«ţmëë&4 ŔYŔ2« Ő# D4 ,Z»"PL-_ h‰…h@¶+ˇeŰ8t!ˇ•ÝtÁ$4@áőN•_Ş y@ ČUqT~©îśtL·× h@eş~4 zť@  0µY Đ€˛xÜĐ€ĘyÂ&ĐA‰ö4 Ü^0Ś†Ą5ĄÄ'Ő_jńÉźuţ”şžY©©’RđP.P4ňPQć‰|S;©ü’'‡r§˘ňK–o>Ş*ëź|T<ĽâPQhâP7ŃxÜŞňK¤ âĽöb@ g@ąĆ&¦ýŽ>{xÔxlW<ę@Ň~ Ď€B‘:wSůĄéĺÂ3 ŕ¤ń ¨I©ű&žu+Eń žµ-§h ,Á4Ž;žE3éĐhVFđ…Ég@íÍ"aҬŚÜ ň̇˝íĘg@UOa2şJ0ŤČ ŐB1-Ë<4ě UGEĽ@CĚŔ[ Đ€BĄúw•_š›A@ęźć+ %Ri¸h°şgý4 °ŞŹ€”c#€TlŐođ¬±Ńëć3 Ě«2ńÁg@mŘ,â`ÍăÖ8Ťźe™N<ĘЦ+źÁČ&Ň}Ó-Ĺ‹ >ŞÝá°ćămeĚ“Ď€ąýĘg@aݤmč›ö¸ŕ3 ď{|TđÍW>µ˝Z|ŻĚź,˝Ô˘nyŔPą”|kŰ8 Ń€:çâhŃ`e7\`Ő%Ź˛Ó»€ĂŽ\Ń`b'¬ (ĚÎJŚCt˘Ö\Bč+SЉi0„Kˇsşm›&LJÇOń–@HaP“>IaÍ%źt!Xs ł¦©Ó`uŇÓ`FK†%č' fGŚÝÄh0Űs[1ĚŽ€‡Ň`>YĐmŇ`,Hˇky8ĽIBĚŁó‘ ¤Át…4,EěúĄ-…OP„CVÓ•Đ`(}ĘS“Đ`EPĐ`¬§ü}Ěrt )`WB!mŚç"ˇÁ4źxÝ„óů„č$4‡ď‰¤@BY±€-€Đ`ČžăIh0ŰöG„łm„h0źdĐ> Ń`¶  fŰ Ń`>í ßDŚÓ´ău3̧7Fy„źž ć~śú‹Ń`>QcŃ`>y‚Śóżve4bţÄqŔyĚ_ľ2 ™ˇĽw2ĚX‘ńuCĚl÷/BĚ',j B W…m@ę«y\ ăwi0Ź dp¸ ćł)]Ó>‹aĆ< †@AíDĎ´Ďkv)JĂRYNDyÜ`ľ"Ěç9‚-Ń`>ĎaŢ ć‘„Cǡ[Ú# ™Ö'Dů̇1ŔB4b yÁD4Ď…ë/D!Z ýŇć- ćł#eëŃ`¨Ä{"Ě'L *˘Á<"Qä"Ě#mCÇ4Ň˝…_ cÚcĹD ˘ÁTöu# Q‹lv"–˘ 蕲÷ h0źx ˇč•ö°Fž™|ó™î›|ó8Çvĺ3X— iÎ_7ž‚ú:ń ć‘šb:L¶M ţ€đ ćÎ"ô=Ň®¨«Ď`>…‚x(ęÄ3|&ˇ6NÚâÄ3,Eü°ü§n[l(]» Ç›GŤ˛Ç ÎE{ÎEiů„3@őpó)2sÓÉf€PĄ Ščd3@€l(˘Í€J}LĂ›ŠXd3@)˘5  SŞÄf Â#3ך5Ĺ] WZU_7›á¦`öşŮ 7l†ëąj˝]Ů ×[ ›áz›d3\›‚l†ks‘ÍEéţd3\›ťp†Ë“!›Ź÷D6u ˛ Tń Ű&qˇ5Đ ěK:tÚ—¤ď@3@aîŽĐ ě´Ü‹h(YŘ…ĘÖˇGćuŁ H´/‰¨3@Đ'Żâ”âsi±IcÓ¤ČĂďü•Ě»ĐŻd(W0Ś s¨f€ W0˝ľ3Ŕ5aš—CnŔ3@9.`XČ"čň—aWŰĚÓËÔ1 đ[ś‚`ć•pN0ľM¨Ěińµ0ˇĚ€Š83ŕ›3…THŢĹ’}đĄ͡qt7# Ld|˙ň•Ě€odDáŕlŠMd|k•ÔO8ľÇ< Ů ćNNÝ8ŕ ř†' ¸t|çŹ+ścgŔbJ KÚl˛0 Z"e1V€lŚgÔć€3`Č“®płpmśC'm28´Ţl żřćŠÍŕăłh^˛0†cú‘Ř çéŃ΀ˇ`č”ö4’$ŠBf1¤8Fťę3„3`dŞçF8FŻj<Đ0ŔU&ťŕ,Câô΂Đ#<ÓzFcË49ÖĎ€Ayĺni,!đ>‰gX ›l ţud3…‹"Ř Dč¨`3`žÁQ¨Ř ‹đý›ó•JSv„fŔ´Gč@3`f¤Ś˘0{bţ¦Đ f%LŃ 5Ń°ÔmľđĂÔ[±0—‹Ăt¶Kř›‚Í€9ˇ d3’ĽDk(śŢĺWL8ćźşdŔ0E\€pLcĹ@§´íď#á Ź+śÁ§ËúH΀)u®ˇłqR vá šłg Î`žJ'é âK¨´+Ç뜎]á p&Ś+śÁ˝ 2X„3Ŕ!(á fZpř5„Ő śľŹ)€Ă¤ďhF®¦ŕ đˇt)tJ·m÷g€+F< Ŕ ůâÝjC ć€3Ŕ룇w˝VEŕ…˛]G]J“ë(č,‚3Ŕ˙DŘŤŕ ćëÓşoŔŕĆŇm“ÎW×”"§tŻz]}Ň}ŁMHg€SŤX6ŃŕxëRĆ+0đ‚§ĽŇ±"xó4ŮăŠg€P×G<µ”Ď_˘~e6L ’č pHŇz’ÎźĄrŰIg€_“OV€ř>%$¶KŰ”ňŕBĺ,O|¸YË•ĎOěĐq&Ýőa|g€?WÜâŕňUŠ<ń p OŃä’IHtkŰôδp¤3’¤+ť~ě.ňBŁłŢ_zńä’v°y¤=Lž§ťÁ<Đ…Ł Ńŕx§{Ct÷ĚëÓ#:Ľ÷bETą¤×ýÇĺ’ż[ŕ°PĐŻx,&ĐąB>y|ϡMżŽ5 ÂA.é¤â{4`iC-L@–?t4`‰Dg" Á<ű_ °ŇX‡IĂrÄ@€CřÓĐ€Eő°ěŁ+&ˇ+CE;Đ`íŘŘ °Ŕ4„VČ\ Ś „ 4`ˇJť„¬e%íŐąHęŐ4ůhŔ’Řl!q%ĐŤ…Â…Ŕyhľ!B–ŢôČIh0ŹJS'%ˇKxóŠhŔ2ß’÷R í§ X.9áPt×˝ Ń€UÇ,e2Ňh(! ćńw‡”ÂĄŔ]ą!Ä®ovA˛˝J:®¬¤r‚$DV[ůQ˘+˛ěB4`Ő6…wő#Yá]ۆ Ń€bń hŔ2żĽB4`ť™X!°M! X­V…w9±€ý„4`Ń[` B\áĎÂ,K‘«OBÖŇÓ•Đ€xN DhŔ"}Y!1ʳŸE„¬ős¤ BÂú•Đ€=\ÁOâe ‹!źˇ ĺĘg@ř‡Uâ3 ÂÍ@<‚ Ô Ä3@áĄÎ€Č Ž8Eg@Ľ…ú'é ÉčW:”CÇQh×jFőXŇýˇë#ť"< á Ô…GcËÔ€Ő Î€P‘HC»ęÝšp(â΀¨—v…3 2†g"›‚ž.ń °áxW„„ŕđ¤JľBĘcWHb}¦ŽÓâY‚°$Hb†8¤J’B—4BŹ ¤ ›]„+U ž Ľ~ÝŚ(şd2*Ĺ3Ń.#!qeR:moîĄ Ób·˘ G7B4 ŢKýŃ•>á0¦´»ąĹ-’΀¸3ĺ˙“ÎĺB4Ú¤ĐíJÓţh Đg-:!5LŘ5Á ”+śaz8Đ!]™1óşá PÔ„3 ˝Xp(ů g@dˇĐ„3@á”GpF(ę8C!ž=€„30Ň‘×C8˘!ŐŹ g`ŔäÎŔ JíŐăŮä“ś±™W8őÂă9®pĆň g€Â±śŕ 'ĺ €Î(÷3ś‘đf8ŁĺĚŔzíŐvŚ}Ň^]1öAלáŚŢ:Ăáx†3 ř PÔ3h`6ĎNBŇ ‚ĎŔ|Ţ% gÎB ¨ Ńpć>ŁŠNMHĂ™C”†3ĎBfb°ŃÉi€˘~KPĂ™Ń!RĂ™ô¨†31$X gňHŔΓ 5śI(k8U‚×p&ł°ů.F%?$°# Ůp¦ÍłáL­ hÓop˘6ś):m8Óx‚Ű@…BSă„ËFŕ*…ĘTŹ˛ŠÝŔĚ#ž ě†39)ŕ ;)ŕ gŠSĐl§AľÁvŞTđl§SŔÁvĘUl§e á`‘¸|ëĹp°ť˙%Ă™"‡3Ť,0gŞYpÎt´9ś)kAr8ÓÚĺp¦ľËáLŹĚáĚ  šĂ™e8‡3O<‡›P•.+ť":śIt8ép&ÔáL0 ŞĂMiJÖ~DR xgRoegRźd‡3e2Đ7Ĺ"_XßVÁÎôĚ ;\•H¤Ž•<ńÎLĐ<Ü8§wBi .ĘÜyÔ"1ÎťF˝…ş3†9mäá¦Đ7˝sdópUŔy8SmôpSęNćÓ&ęá&€őpU{8łöpSęnvńnJŚŕT¦H Ęhţě©x Ç=żjŇţ®Tmb› ˇmBđŤŽçŻžţř”Žg˙źţóĹűçż}÷ô׿*neÖ®=żűýSâĎpOńż ©=ż{˙ôňĹ·Ż_ľy÷‡§·îňýúĺOoĽ5»Í—Ď?Ľy›ŰËű7ż}÷‹§ż{÷ôKŹ&٧­Éďc+@'\äŻ×™=cÄß®?ż|ňăő–<˙éÜ\ŐŢά˘|yźůJ<0Z›*—­~­Ł{Láš"^Ž[}zż5ÖĂĄ®Á*Ľ“źÚęÜfČwüŮźi÷ö‰v÷Đ—Őá|0[ÖĐŰýźĽŃŮŽzÖÝ×o×;·źu~ľ_®3MrfLaXAň`´˙ůđ»çxţćß蟸8OMďŽWZv}®oť_Üýâ؉°†ľ6÷ÚĎm}jŢşK%Ż1Îę/)¶»7űŔj˝1×í~ęńňź?Ţô~üxčľ<^ĂfĺGçŰů*ß±ćO:ś.ŻîgĆÇŻqF nňđĘŐ±“§;”xg‡LĎżX˙˙ţWĎĽŁe?>yx %!ű…OľĚ Ëe+)×­ŞCYÖŔçÜ*”ŰVHy˝nDáşÍOîiĽŹ?Ó9ą˘­Ź§ËޮůÇ7HšI/łŚŚ/ýŹąúÖŰęK|f«[Ľ->O]–óĎzţŮN«ôÓźĚ_xýÉĂ ˝‚áĺfÚĐ˙ů›—|ţŹĎů˙ą1ýÍ›ÝKţÜłwfJK˛đ{fÉ Qí™ŇU‘Ň'QGýÔFĹç{¨Ť3”†čß…łoő´ŤłzM(ě[ ľ˝îAHĺ“ť›żůłluv¶ëÁkšČ#Ů˙áFç&çÁ?ŢjwŇ۱‘ o—cĽÍąĹyčźo˝ĐMökqwGcgýĎŢď<ŹŃîŢşŕ§O˛¦îHÖ#Ľ6ÚëzĽ˙ç ˛n;"b%j[—p˝č˙ĺ˙°ŢŘĂ^ŢË›kŁ/¬Ľúöľ0É ö?WŁ|ÎŁĚ՞뼷ľÁŐµžń¬üTéĺ˙ĽimŤżţüťÉ˙}ďkîµć /÷Ł}`cňŃ}¸ýÓ÷ěĎçhEOý5ŘŠ˙ă[?`V§Uż`;~ľ.0ăyĎű?üŽş·đę-o}ĄÂéPţ”ßzęs©Ü­x‘pśR~xZ´?ßJŘč¸?„Őí?ÜŢ˝ëłć‹ŚsÖ˛^„}z5ćű[W¸ýŰ—~<÷¨§Ő÷ým+óĺ_ăŇĘý…Úíłú¨·GžĺĺöV}ýĹőбůúólŞôĂ~ç˘%áľ×»ľnţĹő­ú¨¸!c}ţúÝ·űĺjŃ)>˙«ß]_®ŰŐ~ż¬ŔúîüŕI"x ő±múřŞÚ,ë`÷ćýN8ňM 7˙žď®ő5©Âű]Úýőź·ľŠŕvôăGĂ µźe˝ŹŻoLyůîńć­OCܨý·ßë$uţĺŐ›ňóqYmţf?WIp%ŁýhŹřŃwŕöťŐÍVüyÝőŰď?=MđŃOľĽtË Iá/¤{ćňę€/_?n—đřë}wć—?}˝Ú’›®ďěEqW[~yýö«Żż×ĎŐŤ?zWĐĂýóO˙<éżj÷´zÔׯŻq0[ťżĽ|őQŻú±6Tű`ü‚1‹Źó|´”ęšž>ćęI·áRőŔčňěëĂk΋±qŰŁá?7úúôŔČăďúšúů*p]gÄččö`ż×ť®ďĘíµCSüěÎ8`Ęăó/ë‹ńH??˙ĽťęŻn†źúj,ĂűýëżâĽÍľ(k"]×ý2ßÝľs˙›·^ĘÝâ¸É÷ŚĚ5¬:?Oü'ťČ?ÇÜhuZ Ë%ż|ýĆ-Ä\}q8dće˝®§ÔĚ[;6ţÄ{‚uelţĺf;ńi-ăĺźµĹÚ÷óďüo®ŕĺĹĺşÉů_4–ëD·öůSlRyGą·—oâ“v˝ťëóĹĺÎTÓ˛5pwu䣰oă Ĺ~˝ŹęCáűŰţ•żďeťCďş_’ĺ~CQüďúŰő˙¸S[ö輏۷)¶üÄh1,ů˛ ýőŻ|^ëÍÝ2üîýĎ3öZÓÇeđƵľLź}ń9e˝ˇÁ÷W8wťë‘®·ć‹őe<ţ‡Ř®Ľ|óíWü˙Ö®¦7nţ¤@KeŔk%J-ĐCťK-ŚÜę‹b+±mÖX­űßwŢ )‘”ví4˝iWü߼™!wŰżđ•JEŐRilJx·®[˙/î±bň]Ë_o ŢQ„•7Ą‘‰Ä€›.Ąőóřp!5®yJc¤Ö±ˇo˙ŤYG¤=ŢtăĘΨ JA7íÔöؤ&Źíö^ř#Nc—öۦsUËÄU%ĺ*a%Á9 Ó "#㣽3: (Mńlü5Z%î!¦dHQ)§$ŕëI˙ŻN5 Ťa_»1:&Ą˘GěÁ¦MŁĹŃi’ČÚ# üü~Á~Ĺ™MG>—>,ŃĽ„|‚@á4QÓT^+§…â.fĚ’ú¬#s1–m^1 `EFĆ˝†CČČ«¤°[WŠZfŤĆsJŮBYĘvjňh;!ŔĐÔdVČw÷óL6ÎMY)ôO„ íˇő"„;ëÝPqüúaéřńż6%ń#'ÚëFŇ^1‡Ńš Ľ*?¦Ýţ6¨›jÖŕtXY4ľp-ÚžHA»áKű9˛ËĽĘ8>—¬2-›e@^Q5b–ËP^Ţ÷lc\ĂĹ95Ű|yqԊ߬{”#·Ĺl7ÇIÉEÉąĹq·ň=§61Úfű>٧źÜAĺi!ůáa±EKąC‹mZä†]“·aw} • ŐÁU$O:ĘU•±1—©ĹŢ‹|ĚoŃÚ8oUW RÄfŞ.]]Úe ň;Đ4¶Šř(żs‹@Ôđ ŠŔŢć8ĆÍĆËq+řŐIiÝ#I4^ꕢűŁ+›ú˘¸‘ŰXŕ{Şl4§—Ĺň—ŞeXŹçPĆ‚ňýăě‰DJ‚<†F&ľnB rĺh×-ĆĘX¨_8VçŮ4‚‹Üąu¶Zž=\8Y˘šIŘĆ[g řzŞh•7«fłá‘0C/łjŇ•)¦Ę ‰ç5vÖ2ţz}PÁöÝń·™WK®űnëtTâí˙®Jó‡s?ĺe•Ěü-&;ěü ˛·né­%ţ,ýąŹN«2÷í ·ĹŤ/U¬s@¦×¸1ΕÚÇTČŐŮ Ďn&ŚŃ&žÓ“+P's} ‘xhCµ†Qáďĺńpg€ł3Ăîx#xuHl‰L"71ʬPîšvYIjŐŇ—ĽťĄ˙űęŻwĽ[łő8GŤź9tvńµZt¸äçĎ]¬’ ŤGWčBJÄíŕŞh1‘’µ <÷ŻŹňRźgÎküWůfâč¦rşOf#˛ŃSmł‚SkrôۢNěŐđÜZâľśŞź“3ŽcšfŤµőă!ÎhDńhhitŮU&ćŃÇüA?Ra•i˙S@âPÉŃČT\–$‚Y·l««°j-~qô°ĐE(ľ ~Ł¨Š7Ťó˙e#bĽúŤüfľĺZ0_3i>w_BĂÚŹCwÍ«Âß–ě(Š_ź]źť­-(®T†4MăÚ©ĹßLď#Mä•'ăČĂAb\áŇ陞‹ůŃĚŹĺü(6M—* ']udfTÎĚĚ ×*ł|®ý‚Ç'ěC…A[p˝r'&Ą3˘Î^Ľ4ˇÚ„ĘÖţfš µ’)ĄÖ‚/ąU Ä›hw¤l °ČâF.YżY”7|w«¶s˘Ť<´S‰6”ŘGŕŢ2f)ÚÓč†)Á0yÔ3K-T{´»ź†Ó±:×Í‚é2_2[F¨¸ b+G±rđ⨄ŕqCÔčŘNą”ô^śĚUađ "j+®?;‡aŽqÁC˛ëěě燪ŹäÜńÓ‚şzŁ Îá[—ŮŹXŘe»vH(H´L~‡1ňďíQᏠ*öýÇ˙ăDřW^ Oä}éř¶Ŕg6¸ŃXXŠÜ†Ŕ>»Ś!9V„íÜ€Í4á˙ŹČ‚yIÜoŁşˇtĚĘĚŁťCK2ćíă„ĺčWµ‚*}OŢc}:H}Ů&YË(ŁF–řřpWysîcMuv9DĄÂĚŞ'˝?w̆l:µ(žÝjKšŤLĹČŽ=’OîÜׄ„-ŃśM˝üóý8÷áüz~g˛źşÇţ#»ýî‹ĂÝľďvĂíTE»¬ Ý˝›{ąßw·ý ą–®7čË·»n?Í2Űb}lĄ â›ě×b·gát#q‚Jâw„ĐůÂş¨‚eŢĂ€k„„%8‚{`içÜ·Ň•Ve)Ů ŁřĹĐ‹­h"ÝĐß9xČipn@JI ńě=Íţ^ľa'±÷ O´+2|\CEFłáňDFr€ź\rč"> stream xśíKoÜĆůľ÷Ü‚`‘Kf]/ĂysŚĆ@â §Mdĺdµ/±ćŠ6IYv ô·÷űćAÎp)'BĐK†ąä÷~Ď7~·Ě3şĚńŹ˙ws\äËĂâÝ‚Ú·K˙Ďć¸üî|ńőYAáMfrC—çű…CˇKx«ĄÎ —Ëóă‚°buţo¦9O s•Qfă|»xMžÝ¬ň,—\ÓÜăŠ~Á‰ßÖe_˝w_´!»Őšs‘ĺB—Őuö?°ĚA~lVkVd9U†l#ŔĹ-TAęx–çą­ú+÷Ë(Nŕyçźçł ÉD!%ł\9}ČŮ=:gŞ`Aĺ·őrc(ypĽT.xé ŁŚJMë´s %Ö(ë•ŁújÍh\đĺšË¬PĘŃůĄó¸˘`ĆXO°¤ ¦pďwhUPş9¬ĺńXúW9ĽšzĂ~ ŚÜ®Đ9—ˇČ&vEyí9* ‚wMŔĺ)X3řŮ€Ţ|óĺPvż„ÄDńăťJŰÝ\űń"Űc}}fŇXĢ!i ˛oÚăM]>iĹ:ą7NĚë4'*TXn ŚV% &3Í”ßc…4ˇ„ ŠŕS*l‘îŻÚ]wŐÔŰŔÓëć˛m:˝¬JŤźÉ·/ž+e…"×Użkí7űóX~Čm9Đ‚ j®·ŮV”4ęgŰľŢ}¨.1ŞiîD˘…Đ#ŕĄ@Ž4!â$”ŔчZ_Ŕ_ŽE4Ľ˘™Ěw뜏X4㻿Ŕ ›©elRgÍnżŻ6Őîşďž`ťĐşi1)Ŕχ48­ßfŁ¸Ď۶iÇxúué}YßěĆ/?µäéÝŻw>VÖ17éx9Źł`™‚Ŕ|I#Áţ4ĎáW^T×fRbä…l@ŮhGŹ ®pÄůHś‚”ĐXâŔ‰™‘¸†fÄGâ4SóO±äRÉF┡sq(1qf%Ďő§Ë¸ˇJDÄ9“&1 Ą#q‘żi›&A^ŚÄ§26 ĚŃ1q-€¸<%îýúrAÖëőę«ĹU.‡_U‡ëjźŤá˛i¶;CCâ\cD¨ŁéXśCm6~T%_ąţ––ťěĺ±@SB:Łˇ ÎÓˇ†>Ś5Řăf)AçŕJ )<Î6˛śXŠkŮÂŹ+ęk<9ľKă&)°HWä6vÓŮäWa#nľÂÖĺńr[ŽÍ-Ď´6Ćö7›ÝyĆ‘ăw(©Ř‰†ś>ą*F B˛ű˙3±˙Lě˙ËÄ>?ťOłŰ‹óíŹć¶;ŇDt‡ŞA^5 {šŇqPbŕ^3öôµÂłÍĐóŮŹpaČ‚ś–Ń4!¤ŽpE&i>ŕň;‘ŕr%%ŹĆ^DSĐšg F‘€+îd‚ iJŁ)NĄŃx:ąJG $"ďÔ8:¦Z*3ş`ŃxLĚ.¬&G“óÉqź3ű3śęÝű˛ţŘŮă!uK,8‹[@#ćΓ̭‡öxŢÄgI»ˇáżB“.><7+†§ŁÉíµá”Ü·a$mPJńÓ™ĹÖaŮBÉÖ˛‰U8\Ůă·Ô WQśá@-śU XŻ vŕÉ^¦mÜ2LhňľJVW±ćOËŃűh3Ů–Çé2ÍşNîmp-ŇŐLY7ëą3ĺÁ«&Î…µş]ú2»ř°ܤ[!\}¸uwJ# ß5n§,ů°~†š’P‘ľM¤éâ-!ŹËď[Ţś¤^>0H=·–đľ `†ç[ë«ëĚ'‹†˘J!&$ł}Ň J0•Č–0»$Ä©ŁůOłpHYެ8&”¶]]]ˇé0*Ŕř_ DČv>#a) µy&/0.d±KÇű•-Jl$縚Ť:Cq‹ Ҳő"›4Ë$ÓŞşęÁŕ“µĄaN÷sÜîă rl îK¸˛®?)Č»8oŞŢ’SvˇW&ŮüqÚ˛2@µI“)^Y×”˛ŢŔ&'¸‰źW艂2MŞ+gN =€¸wQn:î–ťMěv`yŽ©€ćĆĆš,ÍŘTNOĹ”"‘+·Ń“ą$~_ëaÚ÷+‰–ÄEţ(}wÚnă KH-H¸‡á"” `—,ńl‰Ä4€X×±ő»ľťlá·>ł8Š<Üđt»{ť™&6Šýü|ńóÂÝŽÉeűĐ[1Ć‹LK˝¤‚e ÷ŠÇ$¦a<áS”@É$_“ÇVąÓdŔm©4żhMíâĐ_›ĄqXĄÍV(“źDź54M* óŽ4PÁg+¶ąC—l¦íˇ× ş«ˇpg—6A> stream xśµ}]Ź%ÉqÝűŔ~· ô‹nsU™ůeŘlA˛,P€%-ěŃÍÝár¤™ťUĎýëçśČşU·»—KR!lߪüŠĚřĘS˙t·]Ň݆˙Ĺżţřf»űöÍ?˝I¤ŢĹľţx÷ßżz󧛶â¤ËÜfşűęoôNşËĄ]RÎw˝öË,őî«Źoţţţoň¸liË÷żzŘ.[-=móţ»ĂßďŢ–b—­§űż|<>ôó‡·ąyK©ŢÂ3ĺ2Ǹ˙ďúsKůţĎ~yxúéýç/Ţ#Ť6˘Ź:Í_úüÚżü߯ţĘ'4Ňq>yÔËčĂçôŐ7oîó|řęŢüůWoţ–»o?c]Jé—>ďjŻŰĄůŰ6óĄŘ]ĘŐ.ůîéÝÝ˙ąűîŤ]R±Ňď~ăKôWţ˙˙ŕ«ú?üÝéĂţîě—\ď>ľI¶Ą‹/آ|%_zĄ0/­ )ů$‚ĐDÉ+gJąŚ3ˇ^Ň Ą]j;Sś}&Š%QćĄä%o—^Ď”ěł=SĘĄ¦ ¨ĺl—1Ď”vÉýLé—˝×,ĘĽlůD)ŰĺüHI—>ΔrI1­ÚE±K-gJ˝Ě›g:¸HJÓ*—qéůD1ś†ébăLÉ—ŃÎßŃy7Q*6Ήâ›=V'^—ŇO„ąŻúĐ6©içç˘äťźS|¨eçç˘ÔťźS«^ŰĄ±ďµ&Ĺ˙ęgĘĽX Š–«m—QΔ|ÉI”¤ĺjľ FP4‹f±ěă’5óÖ.ež)ľ*Ń{ž˘ĚKŠŢ‹fÚ·`č¸čĄž0A4­^đú‰b—ťW-Fo—Í‚˘ItߌY”¦©÷q‰9?Çë>pLIIÁĎÁ@J~úËŕ°`č¸Ä#Ěw‚oqŤft—ˇAчŹK„¤ÁŚy#(ÍL—ÜD‰ŐrqÔŠ(E}OC˘Ä35V}^´ ł]Fô]Ő7–_„¦ĄÁ?EßšwݶŕćŚYÖ-Ç!š—YE)—î}ŹmÓĎzŮ&^RĄ]¬‹’ł(ÜФ”čhňbę(Qö’RŐ‘K@đ”ÖD)ä%(˝‹b”Ü Ś!Šë­č}NQ:ZtJ‚!ĹYVDÉjÇE`I˘µ“¶)U#tč\$%Ćă"ĐL”ˇ™ćĘUeF;ÔNÉX'RŮ JV;.·$Ši}\–)JŐ[%óŇă-WI&Jôĺ2°˛÷‚!ĹĹEĚq‡(5şšĐˇşůłáĂ@ÄÜIé85¤Ôxfęô¸9$ĺÖ y˛(=(Iśté ui8HY”—@ ¤[ ۝Æj˘Đ"Eb˘mCÇÇEŠ†ÜśĐµ#Ż#Öś=uŠ2’(~ĐŮW èůJ°Ĺj©jŃ]ělńV+ťÓÂ"°÷!Ć4ź19éĆ™öpóé •󿳎Ź´ä͇‹uŔZS+>,ăK9Ö¸ů°&ĺö›ö^ó.&ĺ˛KެyźRšÝ–ĄŮü/˛Ó–IŃü/˛łR‘6}äĄ[YłôżČËşÔBsч)ůšÚpÉsuT 㯹9su@Ć3›Ă)–ÚBNY©ą0„y3Ú-ÍEĚ›á˙•IŰÜDW.e©4}‰[ »č˝:Ü .ř_dfë!ךË>ˇ¶<˙ =ą”aŇ:䔼–Ü˙‚ą:ÜA)4WGß˙Ĺ#ä/čÖ ×_P†é&_ ÇeĆçâMŠ¬ů?‘™nßĹžđµ:\ĽInµAíé”ʸůÓ0W‡K´`ř \ÄĄŹÍź†×7&)SŞÖ­7S_.˙hâě>Tó÷1śIť„BŰiî–I›d€S 6/)•üś»Ölp ;(}­Ś[źÖL[0«Ă†CË»čč éÖÝŘ€˝:S ©Ô]Â^ť» íŢ)ÎĐ„LˇsŐg^Üë.ÁĎ™ŰŢÓ$?§KŮvÝ ^r#7ş' §”8BÝUěŐég˝dQ*íŐYx¸Hitú¦->ôD©á íŰ}ě0p&Ľ6Q ŕ1@xij9sQ\ŐäŮݧËiú‘‹I¸?§¬í4ňs¶%sz†čÓ/Úýţł­ńŔNYw÷€ą:ű2ôzˇ=甶Zu źoúv–ôč…˙Vçľł»Ë?4ěŰ8Y†9†L´îŇşvÎĆ|÷U®ťűíVh¬NlźxË`/ąţ̡»ş‹Fg˘SęZsţoNáŽ'eŕຎÍű3>cÚj˘p€˛4r÷ĹwĂ©mľô’˝Ý%߆·rü¬ŕ¤ëé°şËAg¤ éÎ?>Nk_ąđkhÔöY»śčŘç\i\E§Ě8>Ýĺ`ÇŚ\ËŚę.ýfä‚Vzľ7źn¤p§zC4 ” ŤKŠŰŔNčT2»a—´Ąśé:vÉ%Ϥ»ä3t ‹Ló§:v‘çË7.;RqJ »ż{›űŚÝ37Elíg7±ÜÉŹ«ä\t-Ü8)ˇ®»K>đ1ĄltI˙íç%XärlLÁ"ßm~lZ*)Dewˇ·ˇŃë1ö:†ŞVÇľ%;šu–¨z>77x6Ľ¤pc;Ą†¨ě“bKm‹8#čÜg_ŢŻ›I[śY:ŠčĽ×P$tĚĐąŻP’Ě 5Ž}tîs‘eWŁˇaťxĆW!oKőŔ˛/¤Ô8I´ă}t9m!‡`€c˝sj±[in{×9/ńO{ş‚Ň BIiädvĂ)fŕÜ'3d@uĘľÚ•N…›©ëüÁňËčxl‹ű0ý0Ł±ďßí¦4óÚŠŢ+şBĽG«éÉ7۶űRUމfp;DiÜ– !ä $Čľ†X°LBX~`Łĺ'–αo5žV5ĽFŻ¬! *1?|Ânˇ67ĺ[Âňs µ!L)_b¸čjCxqč-—z`%…±];;mđmńV%/měś-YŤąćébŻ˘÷ą”öp•éfťŰßiťSß.‡âV±K\ÖúZ gץNsM3"°]ę4„€â4žÇ†`NśžÁ Szl$‹čŰ•Ş ĚĹ }űfď:ś±x¤¶Đś°ÁÎÚ–ľ‚ýó¸Â˘pç5DdĹEŚÝößÂNŠ068ęňćFĽÁçV_a+Ěj®€ŚL0®°ě“ą‘INYQĂąŃmôFBçŁÁ±¬Ń×@‹NY‹ CÔ÷Uw§Ł8ťË?Móš?řšÂĺŇp]hđž¤L¦÷90>_Ż­tČúFeşŽćâL}(Đ­"$rîÁŹdr–ľöŔtɇC›]šcÂ3Çśśre`ŕş,j0¤µę0p]A8ĄííĐĆl0xcŤ}Ç$V jť Fh,hatÎ)+Ć1 wtë×ĺs} vÂÎÓĽá/Ło[äô•5ôíňIöüô“‹žtŃ@•Há$±:ŤźH»¦4moËŁ„)]0ľľTÇ„/Śńů ŚÎŤ.CQ[ Bl49‰Ü„úŹ®|`ŕ&ďc4+7qPUç8+”v‰f¸’ 1/Y0Ńa˘Ž´<¤éĐÝĽ5(űF»+˧ž|aŃ©Áâ2Ő“&ĺ–¸É`…şňmM Ĺ"›cú2ÁJ…ćyş3ZAr}ş„ť ‰»ËMAś!óŘ“˝PŐÝÝRiߌ¶Â°đ`§BěJ?LgěTYuäg¬Î ”môśE h„ŃĘŕj{5^ޱA@Äňńę¦M]|xă¦ŮFK•â Â`Ăé7 Ź?ýT§mUő!JĄ3s\ę8ĄÓXĄ3Ú1 çkž7zϱ†ÝŠÎ×VĘp–ŔĚY"˘á ř†cKq┊3„c»šˇ[Đpl{ÝĄ·1#™€Xź,Nş%m°Luô’+Z0tČ“'ĹČĐ]8ĄÂjĄľč"đć­ŤeQeD`µBí¬f&­V~Ő9<á,í5ô–‚“N©ňé3b0sŞV;‰ÚĄ!Ŕ-¦'ܡ÷žJfĽ˝×µÉY†Â{›zĆőÜÜlšE¦jźRÉţłđŤ]f'č¬ $˝śąóĽŕ tz~đĄW«C‹žĆęŮ7¸ ßž–FF¸„öŠ+˙ÍÄ#Ú8jNzĆ­•<]´”,(ťkWŇ)+2I”IżqmPah±ö)›Â)Ykě3š«}“ŞÍŇ€ŹĹÚZ“ąťŘ­Z×fM6e«Ö¸§Ě©2'ĘMÓ¶¶‡.B‚’Cí 0w GÄ~h¬–°őťŇd¬ć®0·SEc:v˘]·-"F`#bÎę©eŮŞ[Ó !F–˝š…Ż ÇcFĆ)MŽ‡źś¦Á4&D5\Ä9i<NIkËcáD¸äR×n§u:'›B,N)4Uyß“çŃ"ü”˝‚Ő„+˘ 3!Ę}§y‰—Eg*ŽśCú[ú•äę•Ą$ŇČrőňX|Ś)4ÜŽ Tąz¸Ź J“«·§ ąz[Hś2/ô*ÓÚ™“öź{žU‰;NÉÔ±uů[N)Ô±‚W]!^.DşşšĚ†rJY{QNň–µş\ˇG­‰"J7č†w9NÉ"jé&C5ä9lńR•ďn‘Ăâ&C5dflŃ “ˇZÍ3´·‹\2ů%ÚÄ˙Áď@žŠ8‘S’óž"ć”"çÉ IfC1ŽŹP15¤ÉɉÉPNŮäř:~Cî’~g„šůú5uť™ Ől%{Č˙ŹJÖ|ý¤°rfHC~8“3=˙fµ+&ćž-†}tę2ďźZÍ0Ý„—5']ţ4d÷I´#¤ŮrÚdŇĺÂ\¨Ć|DőT‰a¦ŁćP ŐB)=#úŹXä8ÉPN)kšĆ ¬ź…ÚˇŇb µI‰dc2T+ŁÇ¶ÍĆ|(§¤°é˛n…[ńó,7󡜒tÂł1<ŐJ«ÁşĘś''lqŔseH¦•ZCˇ"( CaÇŘ[•:[‘I­Ve6”ŕ‡(W:; Yş1Ý·3\ĂaçxKŠ¬¦ą¶zc2”SJh,€ÝĆęłAçŰň;rc2¸˛1sc2”SJźyŚőVg2”SJÖÜłâäpOŐN7ĹÉű~t1ÜrŰÇÜ‘ ĹHuě®Î0Ă5í”IË+YEq>*L>×]*Ln Id ťŰ¶Ú¨ “—ň-ŹĆ0ąoŰXťŃ&Ď-¤PĆ5˛ďçéPŚţO Y7sNÉ!çłn“‹,¤<ŠoP ňap±ŻşrYťb‹ĺJQlĂ\ô˘Ě<ŢpXP¨u´‚ö: ;5őHŞĘEŮ_NY'¤l̆j©-S¬l]×Lpâ-†ă …%+JÚtË´nrś’tËT#†âfCµdKg—Ä §”8űť°rfĽEőÝ`,ÉA(ičŞiç v9Żšpź˘g2Óˇx§%«d¦C5ŘŚrćJf:TíąĹ[´Pť’”ťă”¦»&,¦ž‡îš¶Çü¤!®ľ42§´µđpTp8ój*šW€\s .÷’ŃćD5ř1ň,™őŽgÜ,б‚”HE·ŹŇîĹ6]öȸtJҵaëű3Ś`4¸‚ëäD9a‹cUŚ#o[m *:…ů Ľ=Ťys˘\` 8¶Ě{ŮeÝ•Ęś¨˙[úľTĆ˝vhË4xúZ˝Ęx$ň‚tžYÂÔˇÚö2˘ć.ýLÉ>AÚEîĘ ŮúZŚ¬Ś¨)µJQF˘żŃîÓřVŽť‚ĄDExĆŤ$ÓÉg\üeLeV鸲@¤+űjE)Q~H®˛@„ůX9TŚÓŞ´®hؔŻ<-Ş‹*ŻűDPFncžľŻâ6V"LqËZB…łŹWOF…HdŻÉŚeú†Ý"‚2˘¸Wřő!čŰŹ§ěcÔ‡0űxĄÎeÖ‡0Qn ~Ö‡D žě;Ô‡0Ă­Gú{f}ČPâžělŘ˙Ě%o+đmMQ¸Ž5nĘÂMqŹvş —ÔdyHWba4Ü•…+čXő®¤¨Ń–;úćđc ęŞ+) ·Ý#(Mě¬+ś„ŰăŞäČŕŚ’™@)·Ätű^qÓt(+ ѤCYQĽź×$†)…×ÜA©JáŻ+Ŕ¦fnkMÇPňĘ;ËF‹ěš7šQ Âtr‹ Ś2ÔÚšů41Ô"3ăľ› µđôX R•×{] Ě}ŐđP*˘ěX­ëC†2hµ—XŇ9µ™ő!¦ĽŰĎTĺ}—ĺň˘D¤Fţnş¸Yzl7TA•"CiÁ’x,iJÖZ±@„©ĂU?MhegT‡d%$‹o,éJZ–ŤÁâ*ŠÉ›ÖůJj%'e“—uồ‘%r^2jCjäTkc!1`Š‚Đ•}yŘ™•!U©ÚRC¬ ‰tîAIĘއ)ĎdeďĂ‘Pߨ aĘw]Ó”BĘĎ4±2ÇuvFiY‰ĚîčkF2y‰“‰Ú˛2/›µ!ě=G̵!]”-(Uh%ÉgÖ†Q¤.*ÓoĺĎ©”ＭIŐ-Rřgč%–†LQb§ÉšdšPĂLciHT7ÄKUßiůđ( ±(‰âbiČ%ÖJ‰i¤ČQdiHÔbÄ1ěůZ‹ˇyvS-Ć g°4„łĘűK])üiŮ, )˘ÄŠö©~ @)V}Ů`( a:9®+E0ýÚâgŤrŚ-ě–†TQB"Śˇüý¤ »ŚŇ%2rąX%2ź, é˘f‘˘ÝÖí ‡ĚřŢÖŤ)ŞCLÉ\䶌 ÄáťS©ä[äń榬=ţ(IĚÜ–ĎŔâ*JÁ˘š©‡’GĽSŐLQt”›rŚX4˘áˇ ţmŮÓ,1Qd•#’ÚŽON)bć)ÁĹ!µTŃ2RcDĐ bmHPd3˛6d•dMQ¦2ř·Š–Ĺ!Qę%™‰ŕoÔ‡©] ´x§ĘşÁeyĽÓ‚ťv‰GFp3J`2jCÚŞDÓśJ n–°§QŹÄEéű«Ŕ-ł4$ Üd¸ł4¤"sĄ!4nVĺ\fiH”Îił4$*đdM 4$Ęö$X2DŃm Ĺ©´Okc-J#1!Ł4¤E;9Ú˛U·ŰŐ!Ńą/«C˘¬Q*“Ő!QÖ(ă±˙xD:Ő!QŐ¨žp3‹ňX2˘vŰ܌䙌⋆ĄťY}ÁâĄĐĽ¬`ßŰ:B­ÉXÝÍv‡Dͧb ,Y5źęśQS•…Ş+~5ŠI%2‘Ć5ăŮ ,‰BQ™”¸^iŃyÎ>ö‚Ó]Í˝ŕT˘Ő!1‡ŐČq„6ý,´lözŮĚʨޕRÇĺOI‡*ŰŚĘ^•¸•!«tX¶˛Ěâ‘öL{é°\7V†´kpfaHTď†ŕí\9śY2ŐĹą)Nx­@Î, ‰Î%nXRuË•!«vXń8T†¬ÚáE©4T÷‚čĚë´y(šÎ, YuŐU,öJëĚĘr(Ćθ¦[Ű‹ÂP˙µ„;ł4¤ĘĽ3KCěP žQ’ú™2ˇQ?žQ2ˡĆfiH;TŻg–†Ř™ŇŁf[EđŐ!§ßeŰëďeâ˛6¤jë3kCć™b×úűh‡ÉQ' “Ł®•ýą3ŮůH0”+@fqH;SĘ^/-„âKgJÚĆŇ÷UW0éíLÁΕ§‹âŇΔě\ŽŠCR:SÎ>QuE]Ȭ©gĘŚ üť˛ŕ´4Ęę>Jpr'ÔK>Dd–†ô3Ą+Ż&F]ˇ'2®Ř{:Sr +…‰Q' ŻĆ®¸÷ćoKoż¨\'!ęW×~ö„w§čD)ĺZQ"ÔË÷ÂSWŠň:řr©aŢ\źÚ)קx# +ňÚăN9´§‡psçĘáúPN٤5u}(§‡ ®Ňáý>=Są>sŰŹZo¬ő[,:˛h˛řč8iÁ]ĺ>ĽeNÎ0˙‘Ź?Ś?`űŹ˙҇˙×ÇÜy‰%Ż ţüŘAď›)Y0ů\"qĚ_Ţ}üţ7“Žq˙řäcA6FĎ÷9’ë„á{°dą6 né݇Ç/ďýŐ±Ťr˙îîű§Ożx˙áÝ݇÷˙ř»|Śy˙îĂű_~úôÍufóGcĹ»H\ĆˬĎ)‹pÚŞĚ…˛ăCAYR¦ŕrĄŮ4’bş^®hô”ş62$ ÂÓKÖ.J^–Šµ0:ÝĎŰ…í˘´]ŘŇ.N÷~¦ĚĐ›;Ąlˇ7Ż”t‰#L[ 08=Δ…[sĄ,ÜšĐXŚĐ›WĘŘ…CPl ˝’ľ 8Ý΄ĽëM*•‚ŕôŇ›‹RwxŞEé»ŢŚfĆ®60ĎZł06]Ď”ĽkÍ)ĆT;˙T``WáˇéĹËEËÚ´ľu/w ľG,Ł‚Čt)ä 2ÝÓ™RCq†S™>bF¦íL™ŚňěÖUAhşL2'0Ů}·Ú ÓË ‚íPlľŢá*ěŸôɨ 0=ŹHFér0V ăŇG$ŁÂ¸t=Áqi;Ďqé‘®öuAX:/[sc‡ Ú4ľąěř ôÂ1Ňŕ&˝â«‡P”Nvđ+ ‚Ň5Ľś˘±Ě¨báźFĄĂ1 f2tu| Rž¶mŹ‚¸´EďZ ÄĄGôΛś‚¸t^~ŘE€»÷V00]>aAdş—ßX™NáőžVd <ŇÂŕt;x­…Áé#ŕQAtşŤ;\Po¶ŐË\ž¶č}j9)fľxatzÜőÂčôŃĄ/ŚNŰ!Pž^ˇŤU/‡hBat:˘ 1’(]aŠ‚čô8†2 ˘Ó9BŃw‰ë±$)(Sś')Ńi;ÄZ Ók™zÉŇčIęÜ´fáÚE Ç´˘V÷@O‹·Zz rĘPČÁBä <-vĆ…YAxz´C€« <ťí+O·śŤxË"ĐSCtU•­]p…ńé*JŤgfzjj¦Š–&Ra€:âŠŃN ěšŔD*OG 1Dkč‰čda|:Bš±‘Ű@O_G­tÍB–(ŚOO…Ocżő‘ž±vW·ôÄM\­×đ(^ę—›úFíf%6Aźbç°(Uy´×Đrax:@’4ĽaŠó¤¤Ń‚µE[Zęqw {¨#|ë9¦BĄ)/3Ř1’ "ÔäćÂH*utM*KÄĚ€®IqŰYˇ®"Śh¸‹™©®#3§®S É€u‹ FťČ5s Đ.6˛Š °:ĽŠŇ„u’"Á· @]Li D \»Hă!>]KiŠ < V”Ç#E’ÚŚMlR JŐudŽł‚ŕ4Ą 6© 8ÝâöIr‚Áé¸Ĺ˙śŽ[¬RnMŽ2üŇrŕÖä( )N×ŔQęŃL+•«OĘĐőrŽzžÂđ´nôřłjMž‹%%Pk`$š(%n$Ł„Ą :MB–Wś˘Ěxdčną”°Ďś.Ł$SÁé0Jšµĺ¸‘lşÔ(NóF˛DĄ{Q-oaŁ‘¦ ýeÁ†¦y˝»­áY@Ö¬ ßŇTüĹkbI †¦yű\Bi"4M^šJř "ÓdĄKߏԸ[n1šÚăjYĹ[‘iÝ,‡…ŔtŠËrµŃ”›±®Ó ĂŇĽĚOk5‹ËüëÄĄ×e~Žv{\ćǵHA\šË5’´ âŇädŤÂ肸4 á…ĆĄ™Ć¸…qi¦1¤0o—ćud+a!.ÍË|Hçh'˛3Z[kŐ§ÔěBU*ŚK3Ďb.¶Ś¬űČ™=±i2łçĹ–Ů˝ěí41ŽwPÂŃë-ÄcÓĚ ‰ôôÂŘ4sW"ą 8Íó4h ď#GY§pšl›• …±i¦Í´P$MsŮÇX+8‡.—ç¬Alš ťYqü‚Ř4:Ł‚Ĺ)üŮ‚ă LSiy LŁë9u7QN&”Ąo)5c.\ÄÂŔô<$+F¦‰˛4b‰™”%ť©ž”›A”%µś¸ĎNeń o™rŐ‚˘ä ¤eŤh™Ů(-Óú10=łÄ›ĄÂŔ4łÄ˘ż 0Ýf)•ť±ç–¦§ňĎb˘L3˙¬†€Č4šAťť)JĎ@Ş´B”ŕÔiQłPšŢSč‚Bp; 7‡Ćdhš0KËäehť×e˛14]•ă+h›rčË®–Q´©LAIt„¦SdJĺ 4Í„H9jőDQŠ[˘‚Đ4Ú—ÉĐtUşŁT3"uňYÄt€^* Ma/‡«r4€˝T5⪠”;ë !4 ŹŐÍ3bčî´"4Ť”âm]וŢ_łéö™ˇ ćXshEĹ ˛0>Ť Ř•P fFqZŽm'2Q^’”ŃiR–betůŻy¬3ÓU5…ň]Ů®N3ąµ´ĐóNŁ Ą¸±ÝzSF1Ň|EčL(FŇ°~ĎČ'^ °‹PóÂ×-(‰Őo¨tęzĺ·Čĺ+]X Ş2^´ž5͡Ş)$EÇCĹ}™®]I„d 2`rO&D0HÂdŠM;MĹJÍ"Ą*ĄxFŇPaŕ· “i‹ľa“”6J K§PÉ«Â2T:OH&imâČ2=J ďÔ#É] o5Yiô >Yä… LźŹrßBŔRäÜGívˇ™ŤÎm„WM“ťŻ\ďă·1żÄ©*ĘgQ@t•T:…’ą•Nˇ¸@B‘™?DjRĆEÁY Ô¤rýs˛®!Ń ŚGđáZ­MEôŤ´`Ť±í†’/MR%¬±1+p4ŐaČÂ…‘—Y«±‚zLC3ČŽgŃP %5 ÎX(˛\XpčJŮX$0IŁĺ•ô^`°ˇ†@M«™ÉĆT5dIł¶%8…4ľ¨‘Ś„5†B¸©©Ŕ3"5EÎH9†Ň)ÔÁD3¬śB=‹$?¬ŻXM± U6Y‰5¤:#A`±«…¦V«Ňl¨â-c«˛i‹SNc‹`Muí­* ›RŇZőĄS%  RDY:e+Rk «Žšť3X[,ÉŞ¶řŮZÔdEZµŐ’Ş´b̍ꆅ\±ť5 ©őâ^'~fc’ĽîdµSV i·č{ÖŐS†Ťm‘CUdÄB¸-j“ ¬/ÂĄĺŃúbS!»`}±.[D‘KĚJ¸˛­őÂ]Mů2…5ܬÂ[Ńd8DŚ‹}C 6V—ĎŠěgT)Ř*@-D2ÂíRk±s&a¤¤A((ČB`3dÇd6tCŚR. Ś¶ÖT±¨Ř€BNUŤ…Đ(ŽÜí¬ Ľł82Šő rĹś"ą¨ŔŚc5iĆmA‚9‹Is ĄôÄoZŽ QŚPňYVěąě)śĘdvC„H: đ(ÇŞµŁ$źYnšÂĆĺf"ŢŇ‚Bą¬˛Ő"Š0ló°x†°|Ť v˘»¦ŐČć%ŕłB*ms­¨@A{i8Ú‹,áµ0N¦Ş§ÝźÚâłň€ĄŔűrećł´¶đ®ĘT|keÉDŘ”xÉ"óŞÇ…ż¶l™Q¸,CŤµEĹÍ9žQŮ|·íĂ^i€&č8TŃ2ę7Qj-(’‚Ę °.N,…1KŁÁ[‘M@ÔÁŃń mŢFŕÓ °Ř¸Á«E#”[Ř4Ń@ÝŚt Ď% Vö· TŔÎ0ĄIM/5"‘©ÄkŠÔă“up(“—ćQŽRzĹ7X/SUn»żŃýma,’"Ř}[Pcł.¶rSĺTď+ę$#VúŹĺe·”řU§5?… N3Ŕ`i€ B\”ŕ#ŚáQ„# ÓgĄŠźČĺL˘ÄffůBśě\¸=#˛3EŞľˇú›c),DŁnY`N‰źö"S B yX÷—šĆ¶˛f•„% cW}§)ŚľŮW»H‚29™YĐ3î FĺK#AH(§Míf‚ô4Ćr㦠P˘"e&PçlšwŚ ëŐNŽÍhcMˇMzG+4Ôĺ×,DCIĤ{QKF3 Č°ÔNs(t㞨yŰ‹ęőęŇ×ÁmŠI§« }Ô‹z_ű Fč·lŠ¨1ŚÂz±™Đ¤‰“¬YŁnĎd‚Äŕ*1¸bm€1"ÜâنČ᲋·`=5&Ä#Ť¶*BDCťCň3"Ł1Ö.z¤ ŦŹš0FnęÍ© Ma9‰1ŔŃPE*~ĽŁH ˘†5Úí˛Tkä`Śh©Ö˛Ö¦oa©Îµ (Ů!îY 0F™`MsuŐM†j±PŁŔ– ˇšgČP{h¨ć%[c„–S`Ť@ÝYöw`QŃBfŘô-pN HFô;f€ť°/čw̢kaC‰~ÇXÚHF0TŰ(kă¦FąßŃW;S(6m·Đ’>éEÚ¤–ˇ[ŰOجr;Š­ÇF®Űf4BďÖ]§@Ů7ŕ›¸ Ô CŽě$‚®‰áŚiŻ)’,łtĆ %taŚŕĄ¨!6ŔŃ×K9ö'ŃF0ľmI€1˘Ż·­óŁFĽ¦H2DËŔL\”›:O±ÁťüĐőI/şąŃL¸ńp2†Řěwl€1‚© §h8æֶÚŐ˝ŕĎ‚”FHŤg)ŤÜ:„#hZ$­hk!vŻĹššyfBś¤”rŮjšMŠQ!XtR`Ć€b5‹„Ł-ž1šŞ(±µx¦ŇVEÚTŹgE4ëĎPi^oQ0écCŹáZu ‚đkL褿&éH©ÂŻË¤ŠńÁ-r/ (F·%1‘C€đ2VË2,ś’WËúžWCrĄ”qŚ0ŔA4C“áEnYł!\yěŃĘ@IŔBěŃ:…őľbç#‚˝O[GR "oc5ŁŹŮ0:Í4"˙0€§Ł#N˘nh捙Q X3ş"‚Mi)ŘĐŠ|Äž÷^ŁҲ>çŐ}/É–ő9ŻÔ•80ť™QDkŠŃtfF­I¦PŚě€Öd1ęDkkŃő9/˘5ĹÚčs^ŚżĘěc«[ ŃFŁ)´¦8f×ß őNő5”U>zé1b¨|d]Ľ@Ś*ď}u>łBĺ+o1b¨Ľő%<¦)TŢżÄb„hu ŕgC|ą­)Ż2…`˝)8Főđ•ŚŘ™W ĎŠ>ęĹ|Žg`]˘•¦HyŽ$1Š#ĺi©@_ńŔ‚çEőjŤâpŃG˝śčš#7ÔńĹýD 3ż^ői ń(Fp>¬'í^ĂX…žńŚlú§®˛lR#Š?ĹŃ–WTüÝ`h8™©QgŠf`C %B°!`Ł–"+‹)¦Y6]7Y”‰0ŚtÝVôU/b3É-E_Tu©ý#<ÂZzţîşmZ×’#Ţ6ĄČf¶˘ozń›%ż¸ Řş4ă0Äă[ßâ0‚a|[ R,>Ş˛<>€Á÷ŘV˘áBaŞ)pc çť×‡ŁĹyń|ĆÚµĄ}æϵ€Őô› §#~ÇfÁo`Śř!›¶oä:ô!› §FŁ!(&I*(‹ŹÔHˇ~×ëúŚ,V¸ň±ý›ľ¬˛#1E_Ń­|5~Ç" ‰)Ĺ[Ü2ĽęŤěIł)qhŞü nĎÔr¦4°¶ Sš‘š čË*[Ž/†9…J´r* HFŞ°HkMGŽŹŤŐů(ú(ŃĘľ4`Ĺ·Ťä0ĘŕKËh–Qlf[Ç<ľë…_¬ÎT’‚2b€eÄ/LŤľVg A`.Đ.ćj‘G ßĘ‘"`{´«$©ąĐ] XFݾĕ0}™UŘKU”¤Ź¦„o3•4{Ił4%¶Vĉu iů%¨x>N!‡t!“PFf‘o)M q 1Ďâł^uy-¸Ŕb~‡-wČ”ÉĎqIć°ęŁč“]Ú’° zRv‰”“­Ďz•đdÄ´šYRĆR‹<– Bq;íZÔŠ0żŁÄÝ›SŞň;r„\ µ"äćĘ4ÖŠLa-u¦ň;rd0›) PKÚµ,‰śi=ÔŠ”@ZŇo%Iá~Hş“•"UŮCŃuéâfZgöŮą>¶e¶>ě…®vĹú°qšI(ĘmŞš˘VšůO#ŢPŽÔ\©đfđ5sĹÉĚľfFŢ’™ µŚ%ÎB‘ř ž EHHkaŞ)±|.ßŰ”ŠÇL0‹f”"ĹËÉh&đkĆÎÝ:•<–l3]1•Śµ"‘»¦sČZ~Zp†č@­óůă(´¦ěďľ,hŠcĄÍ™5á×@š‰)=đk4˘™ňđ¨[¸+A Y|ÁÜ®)ÄL$ŘX*2•ű§¸™őŔ°iu-q ›¶ĚF–ŠdĺęĄđš>)ĐâÚČp ˬňşÔ/KEj4Ö®bł”Ě”¬'%QŔƬ|Ę&HŤ[\ľÓ2/3@lę’Ľ¬1%sJuá8>ˇą¶’Ęp[rŤ­MZ·±±SŻ*<Đ<“(Eéü+UÍŞ>RĚÖ&BS6ż­kĺžµČ.˛*X¦ĘĘn«B@ą&Ď+EĆÝ-ÉŞRĹ…–¤±eŤyş’c¨)‘Ę+É gł+ŰwĆ#SŮČ%n¤¬*›) M˛P¤(ŤXţPe=«RŤĄčk›RÖsUţ÷‚§3TŠ’šGĽ4ÄÍ’Â5¬%@lVr‘ˇT„Éü9p.­*ßPIj§’ůs|ôËX*Ňď®IVK ŘäČŢ1–Šdes·čk^"á;–ÝR¤€/#Ą"->Ŕ;RT›‘W,Şę‹ŻĚ?Ź![ŮäKE"k]çˇ2;ůšŘn,açË”c©HE–o­dł+ ¤l‘S/MĹR‘Ŕ? öŐ.†.D$«5l"{ßX)éü:hUÉČ,ö)ůúEe«JF&Eµ"l·­=©,JŐhžm(ĄŐ(KEŠ(Ră(á˛Ë~FŚGĄq÷o¨Qi†­}Ü…b“ĘÚ=Plř‘±P$Š,b­úŚŇŚ@?2Š0ź?­  Eâ3Ř€¬áśR¬Ţ›U(b,‰ŇI~TŠ¨4c[ë9Ç&mk±fR†ůú”·±R$ĐŤ$kY)čFZ˝YU›± bŚ…"Q ”ć»+Ú‘±PdÜ]Ꭼ©Ľě wdMŐZ‚;J˘”řâ{ÔôXSÍҵîÇÚ¶€l–ٶdÓcłV$Ş$Y+čFÚ´, tŁx¤(­•.óPî®ŘFÖұ‰<5cµHTIéĐłZ$j«Ä`$ŻlGp#Cµ¸Q´¬již¨EAî«E˘ř«ĆK->ůnq¨X-RDIŃŐŚoľG&§±`$*Ď´QšDŞĐŚ´Ä"Č.kúNöÍČP0Ңě-ÇK Č& á¬I™\‹ĺŚ#Q—'ł‡#Q—aŮ0yTsĐgľT¨'ćá3_w×Z>CĹHŹB=‰TŚ¤č{S3ufÜĘ­7TŚŚ¨-”deĹȻȚŔ÷zD'´»k˝˘±^$Şc_Ë1QÝŁ¦Ô6Y¬«ŇX2UŽAČÁËu…’‘–qZ ^Ćw·¬é_W"kŠ©\qŠŚ%#Qß)mĆ’‘Ŕ’Ą‰+‚x)Δ>ńu…)˛¦O|]ËM­©4C%©ęŞŹ(…\¶z“Ë8E†z‘™µŻÖčdÖ”ČX.2łÖä^‹jŤĺ"ÇÂ[C.ŐH‡â\cąHŐj(s‹ î¨č5V‹ÔCŐŻ±\d* ő"«ž8ďl×zb gö˝žXrźi[óP—l¬é‡Úec˝H=7[č×µÚúv…±™"\Ql´^¬YřBńĚrâ+…ÉQ×mëŠF\‹¸­«žđZçm¸ĹJéLˇYz­7VŚ+ČŤ#G|!cĹH>Qňˇ.ÝX.2N„˛W†ËRfµČ]Čzn{=ţ˘ô+&Q´Ă‹ą#…ßgľß[Wܵ@ßz){9ţ˘Ř^Ž/iÝUEp˘ô}Í%fq»¸ĺ…`á'3"®°Ćj‘v¦Řĺ_`¨™éLˇ zĹ@0V‹ôĄnq®”‡Hŕ †j‘qúp8WB F®g?a ëDn(3 ĆV¶L—źw˘0;ęD)q|V\ľëĂÉ'J ±+eÄŠ÷µ;Źú‘Ň):O”ĽĽRJđrEőX+ŇΔ cW óŁN”ą@tbŰŹ-ŽĎ•’âř\)eçĺ˘ŘÎËEi;/嫡ZÄň™230iŔź(Ě:Q!u˘ŘŽ{"Ĺ"ó@ Ľ•Mˇ¬?Ő‰ţýBOrÓUčT§çO])WŚĄÂď|őăS;ĺú”á“/ýętĄžşĹq\Şń¬đ#ŞÓö𖻞pęG'Ŕ˙L÷ĺ ´s…¶YxM‹rD>zé©Ŕ>Ŕ:íoî°Në©#®ÓţÔŽë´?uvÚźÚťö§ČNűS Ůič ít;źĂC0¶S!ĐyţŻ…íô2ćPýñťďĺŰéëOß}yüúËoŕVlĄßżű|uÂýź©†î_Ô鏂RZď.P'CĐŚ— ;¨ÓţĚę´?tęôňŇą©€ă¸ą2<¬ äŔµX€żx˙íŻ ‹Ţy˙ôîá-żRű}ýO8gpŤÍ×éá-žše«ăköî}Ů|™ă…Ţîż?6ôéOřËFžóţĂzŞůßľ°HôKţw´:đr˙‡_řä» ĹÜ[âźxÁúý7‡'>G›ţÄ/Ž/>‰ŚŻ/Ç÷©UNóÚń·çźź?ż˙ôžEd-ťfőřôř1žE•¬wpzói )Őű÷ß]ßĂľůÓżťŰ‘!üä“ź‚íî«oŢÜ˙âczřęžq 5Ä®sůĚßÇ,Ő•fY_™%®‚ňýoŽcاoí´ŠŹ_/ÜŘo ďÍO îÉ\ŽłÓżüôôţ˙™ďkn¸Čą˙ňřÁŧ}Ân{;¬(žrG{˧e9Ťăý×ÇN±°lŮ™>ë[ą<7@:Ř4çᡯŹ˝:ľń'ŻtŻ^‡OM˝‹‰ôz˙sß”3¸´űt|úň3ôŹ>Ű–đím˝ůŐ/'+„Ě+ß~O'™ńůWGyđ%ö~~‹—ětŇ|Ř5ü¸]ősÇvŤížĹĚĂ ż~˙Ím'~~ŁAÍĆý§VK}Iöíď좞B¶ÚëöĚË’6ĂÄs#ĺ~ÉM?·÷‡<šý˝Űă˝Í<¶÷÷ľ—ŢâîpαŘđ|;ż(}pŕjIŇGűĺůäm7ŰC=>ťě, %*ÄB,÷hĎ"ń'ž>}ř;ełűłÜGŞÔÉoâ߶GÉÜFnßŮGúÓ§Ź×oE"BŤ€Ĺî”tü†]!éĆĐě>>ţóűŹčÝŹ€Ýź&ę Ł’Ć~A{…N|<ˇ˝ĆÜ•Wi܆ÁZ:żúůËűŹx‰ă|.ĐI˙˝T'ôźK©“ęôŢQľSNęňWG^é'Î}‘FÄë­Ü>uv\¨«7rMˇ–m„x÷ćČ^˙vkµź/ 3GŁěÚµŢç/OŹZ>ß9żýĽxšNÓţô’lüĹł!Ć€§}˙ôĺFô]yŠMʬ–ÓŰÚ¤0Ŕ¶]o_'r}ă˙őO˙<Ţ.ĺţ7Żëűď4Y˛[b~¨?üę5“ťłźůőĺó­Đ\cxü.†ŕŰńg÷/Édăfw_B8¤«–y{ýS˘ĺ%%‚B$ki˝ţł‡·çđkň mś·úuaŰ‘w84Ö„˝énńíˇAo6^˛)|‹¸ů“‡—·íQěĽ~´^NřbqľNď%;mÚŐćěć‡ńÉyŹäĚäK-Ë·‚5í›÷/\żöži"?Ű{H(Úܧ;+ípŽ`‡űZŹŐô;L}>e/ Ëaęî)',=ňž|ÂĐŮüÓŹĂż®Î.¸‘±r‡„:ëóŹÖŮü,ćVŹíýý­łňŇŃâUo ˝+ŘâǧŹ/ih|•±”]C˙F‡ĆwĺάűĎďnö›ŘSÎŇôń‹yóżżÇ ~ň]˛Čă”™Đ[_N›ú)řâjî$^t´ąqí¦6wŐ.ö·ÍîO;ű‹tq/kVÚ‚×Ýyúá{$#!/OH"ţé¦ČăŃĚü&č®ÝíđöPfUDşŮţŹźOľĂăĎŹ"ć·«‰|^őĂ.˙ §¶Ě_˝űýéoÎľřâúf€Ś.nqÝ8–käµůjနy˙ŰŐřsµgÝĂżőó~…iTy·^ÔZgc“—ňĂÚD3oŻh“Ă@¸1hŢ^#ż:ŤăŰőF=›„ŹźŻJňPríĂű/_(ç8ô>ţ8ËěÚLj&Űý˙¦č9żĽłĂzĂ6nĄµ“Óy˝ÖFžŻm”gjíůFΚ„÷3·Ź8ĂĘę˝…“„Őhé5íůôŰŐäîZ¶ňŁwíł˝şĆ˙sé,ohuëľÜ3.řwłY׼ň«S˙ĺAJí+|š7›ľŮLďż=ü¶Ň^z®¨(~ｳ+ŕmߨ˙ëd˙ťĚ”S4ä[řrÇ_aÇÔßüţFµ^×ůăÍ®YKýŚH ťu> ’©“ńŁ‚alĂ®–`Şg}%©«ó’žÂ·]zîWk/úwď¦ć®`ľ şĺűĎ';鑆 ćk~u( šaRŢ˙ŰőĄűä¸^xa'­w•ÄŹç…~ńă 68<·^UĹxÄysň4ľhYi%ö/ôčűŇ5205óÎSr ‹Ń§˝µ›ŔÝÉÂ{:íęϧMýá›ĂŻź¬ Z>öăi«®¸‚E·*¶°şlÜ˙ű×L~ŇŁ+Đ×ÚÍyřÇ5ż_ vĹ×z˝é^kf((XcŻŮĄ» G}¦úß>ł†.ë?kĺ·”.®?Ž}|÷Ý«h†â]‘·OżŔ߸m÷?ÁyŔÖp?â݇ř?E_Ň»Ă}_óŻ‚«‡§oß}÷ő»|Îů4zäÔݦ˙éűäťÄ?Äă/zŔEvĘ»řĄôţđţkŇ7·â:äY(Ů·µ˝Ë#läďŤ q~Ľťř˝B#̿ǫX_ăŐŠer?,"$‡'?/źWŻ]+Žż˝•gŞ…Ł·ß;„Ź×’ü6]oĽżóPáÔ3őę8áPŻˇt{i‹gĽÎݲřŐŔô‡Ď׎a§q7–g"Ć?S{|íeá…đÇ×'Ťřéó‰ąŕrVÝÝ;:>=}Ś7†ú?˙‚\ SŠĘćúŻâ˙ěđI đćŰÓmZ…÷7ě»:¬Y&áćꍶürë~bćúěz ¸Lévů"‚t¶4˘›/źÖ¬ÓŮ\<ŢXQŘŃĄĐ%~ ÍµÝXlßčÝióÔřŃŚř˛ČĎăžě¶ýčÝ‘‘ĺ“Š°ÁÍnz5°z˙ô“‡eNýŮO˙«ç¬’MŠÄ źűikůüöĹ»ŁđÁžÔ˙qE6Ó\Ţ|P×ÜĎLGŠÖ˘“=ť¤×q´Ł^iö‰:oČ›{¶ĚčŻţˇŹC¬ ăkůĐbJ&KCMĎĺŻă)„ň'Ś7zîTžýűg‘KÖ´‰LőŠËł6Â3Ç=dȇ·ńžŰW'nŽÚ:eŮîoĄîC¦ĽfţŤÉžž 9nş@ ŕg;{·řŽËôţíľŃĘě38Š,…­÷˙ó»5ßsßśöܡŮ/ďOá„ź<0űăążŃÎý~–•—ňÄü÷Řšś“óöéÓ‡Ő€›‹ĐŽŘ ÚquôŘć§ pŽô#şĎnlľ¦R_ł‘3SěźČýďµaž…ÄaÖq«'ľ<ťŻ‹cűĂ"-ĺ^gę¤×#ô—ĄŰ^óŰo˝łu»üééŐMńôěČpL7§őq ĐĎŇăż{ť±_Öíú – pëć3u’)ě<¨ÇsĺĹí¶+FUĆyOěz’€‹­ µM¦ßK ŐeÚŤxcëéäÄśďÎq]Đąëűőµuq?«ą.{1ĘýŐĂ(’4ěR‘“árŇ8Gő KEoôóvAH` ,ŹßĹC~`žYľ«$'wXţ)DKĘÎw?şoÜ\ő łéÓ‘ą_އĄyk~âńŰp™†:^ÝŮ·'>~¸˛Ź±|M jn+ľz őM ·ĽSDŁ/D™×’Ţî1ŇŰaŁ~çě˛ŰłŇNűL\îP˘/DoVčĹqDk~+±7G~-€ý/¤/uź~ %žzI Dv›µÂ{iľŢc[ţÎŹÝźS×u§x#űíőą\Tăý,|w=8ÇčAě­ů’2M”•ôľâW4ň¸ŻNŞ.n?´ĄhŚ&XVv˙¨?].Ľn‰"‚ ŮaÖNYHO·^ö¸ő°Ń‰‹‚}§čŃ[O•˛Ę0.»Uq?ĽSŘ–ýHI{ Ő ľŻ)šŇÜ ęÓsxíéó»xĘÎľţÉsY[ȥ٧ó•oÇ+ĺĺoä—ĽĎ¸ß čť[çőűϧôĄÇÝ ýmŚÍÍ<d^łŻ?G‡›AźLéü5#iWÎVŽşčeĺśëłřËQ9“NĘą÷nˇśŮúU9’%”s$ÉţUŁ±ęendstream endobj 565 0 obj << /Filter /FlateDecode /Length 2332 >> stream xśµY[ŹŰĆ~ßßAčèŤ¦ś;Çh؆¤ŘŢĽęÓnPp%JËš7$׎ #ż˝çĚ /CQ[iŕSäĚąźď;3űă"ˇl‘ŕżđ˙öx•,W?^1÷vţŰŻ6W|›2xCmbŮbłżň[ŘŢe¨j±9^‘®6˙Ĺ,ŃęDSĆ-ěŘě®nÉë§UB% K,9®8ěO…$ă·eÖďýcIľZ !i"%ą.NŁeďđ§ÖJň×jµć)M¶d7Z{ńGĘRť’˛Á ‚&IJ>í˙eµ đ<żç‡Í_śC*rH+šhďy{ÁgŞSŢąü8’žmťcíĎ^—N$—˝.3$匳NRU{ďĽCQ4˛rĺ%Řd,`-8xśŠĹZ(šjíĺě«úřTf/VkĹ%&€ÔóÓáßŰęxĎń-¸ňsxd‚l«S›m[§„ ޤĺ‹ÍőŐć÷·¤Ůfe˛2(Śü<^‹ vY‹şxb-~˙Pśr÷MQõU‹5„ľqo\Yś µôSçÍCUî:C-9U÷Mře)«Ăuń®3X“—ßżvv(r*ÚĽî>prĚ~˘‡:ëIthGżëmIEëÖ“}™˙TÜ—9!ÁbK Ｓd-ĺÉ Ňj*ě HŢ‘äněgT¤ůš±AëZR–˙q§w uőşĘ÷űb[䧶yŐĄ!y}Ä1@oš¶8fm>dď¦ÝŃ!(oęşąţiHâű¬|ʇ/˙¨ďČ7ź?}{ť9ť&ĺő„4~Ě!ŕś%Pk <‚D­ÖŇ8‰äo/ˇ‹JúgíKžQbçÖu⵫•!›ŰČYÜűĄ6¸ś¦ż±ËóęĆžw*ÖŚ2#óu˘™űCźlΫůÜĹŔů˙ößW[$ş«&¶ćźĹZ ;,U«Öx?§Nz”1‰ŚZĄ¸)=ĐçJ<ۤëv ß NI›0ĆH[‹O9„@‚c…âÁlkČ./ˇűAGĚ:•í”ü« đ'S]y}ĐÜöhîß4·@s!&©ę šěŞo˘ÇĘ($¸`8«O#DZrZ!ifH;‹Č.6đ!Ů–Ç9}śŹA=Žy,;ˇŻ@|J“űB‡Ő •ŇÓdÄ M[Źą5’ÔFü¸ĶUNRGkZ/KY¨LR÷†p’u9Ó|ĘTvn@ŞŐiجRÉOď‹zA.ŻNGč†Ů¨MÓ¤ŹJDŰYüÁĄ“1%óµL5"ťôŔîĽbR#a2—XŐţŻbŠeŞ«ĄúˇšË,3”ő>~ tDÚ úIp°Z2©ńVľýfÄ× =üHÉźÖǧG`ŰüŽěŹěë\a˙ůŰ—×7oňM8|,ű”óćU„µg%ÜÓV ćá;4ď–ý0´|ĚęĄDE–§2;Ţď˛e ć%2üŇ YöO§ţÇÎýč8ůVGÇ ˇočCŢ4ËŔ´î|ôâT–˝Ňmłś°nT·¬·uą/Ú6GiČ|dů5Ôq×rę˛)GôŠk€É%şäsySí÷Ë>ĘŞ‹ń-Óc 7ýú}lŠ^NĹńG­ë_ńA˘Ł… “GVżbËyđÄD;0Ѩ®‹±Úő%™C2Í ´g5•c ~0 Á´ŘĆŚŚ{)oĐ׫“€áQÄŔTÇ3s™OAËm2’4Ź˙¤`ń¬I+ľş€0ôV§`3 Ď><"NŽťĆhűä(0çŮŁŚ“p]NŹ2Nq ĂîPôěQ¦Ű ŠĚ+Ç–\<8Î ő"BÁc¸đĐ' ĚÔm]lÇŮĚb‡±2<ţ˝błÉüPć×|í—ÄbR*´N:¬}Ĺ…ŕë—ÜĚJI.XO:Ů) Ş$´şx$µg:ΫÜĺZiE˘ţši/“McU ‚˝ľ™V(ŞPjnď·°vělUp˘lŞK–űő*Q¤ÍâqcŘÖBř^?ÓBkĎL$”OŔŮ_X0pţęL‰ź¬&}äÁąâ,¤čŻqźË÷{ŹC0ÇÇ5ŘtˡqĎÁÇŞCüëń¤wb\úoł3ŢÝ® ‘Ăgç]CK.7™‹0ä˛m‚@żăŕŐM>đéćČ:Hŕ4=]5łÜᯚXÂS Ř÷Ě-S ©pb1éeĺ†Zc&ĆÄüÚŔ€Ća¦E&,hô‰úOggž—Á¸ëxHďXQH6µÔ1xÇž«Ő¨Ëá”ĵ?†­€HżAőp  ƻ˶ݥęŃŹéĄęń9ÓÄÝ˙Ś"0‡˛¨ůc›†sŽîçöĂ%K8>v†ŕ!¤bçţ}ěPqBć4Śž¤Ő۱81=Ä®ăali#Š®ăkQ­t«Ëü”űE‰nä©š)Sč†_YˇÄGž˝“ř÷a\mĺÇĹdÂŃ/`d΢ÍÝö¸ @hSŕw…ŁţšáĐSŁĺ‚Ś$á%\ŕY+©î «Ă²x·ę®ŇŁÂ*‹qItSŞÂőB»HCĂZaČ™?9 ČĺčîOhsů” Éö×Ţw+‡xP`žśPţ%-ŤÚ¸©Äßü{3ÉW§A0M[Iöüon Ě]Ź¸×j.€jÇ8q’ç;ÇŐs:.&R*EŇ…b.”Š‚Ôte sŢ&č‹–|Ńä»8\M‘Mŕ{-`ĆÓ  VčÂĚč-)—Üš‘xžżěÁŕnz¦C°›6`ţňľphŔľčj˙ě(ÓŐ~8Îú2±PŚ]ń%ďÂźŁŕ(:Ť«˙;;‹«Ó­Ě/¨bçătś¶Ô\”Ú´YÝNiŢ™’:ĐÁÁë ęL'OŻD9^đ{g˙\ř+î§1ÚVŃ'_Ńg·^(ŘÓßzŮtöÖëw5ž»źšÜvDSŚpcŐjÖ†ţBëüVl{׫Ç|ýÁ‚7›«Âż˙‚‡łůendstream endobj 566 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 272 >> stream xśúţLMRoman10-Bold‹€ůŃůM‹ ‹ °÷rĐÍĘTheta‡”÷¬˙~p€±÷•÷ ÷”ŻË÷"Ěş÷•şťş‹÷"±ůŃ÷č÷^ű÷/űűŹűű4űYűb÷#ű%÷÷÷÷)÷^ű"‹J†3[F\H@sI‹S‹2žVĺfʆڋɋԓ̻ܳÖئ΋NŐ‹×k·C°N•@‹:J1÷Q\iű•­\űQş­÷•i€–řP”÷^ •–ş ÷  To ¬ŽŽŚŚŤŹŚ’’­Ç ńÁs@endstream endobj 567 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 195 >> stream xścd`ab`ddôń ĘĎMĚ3Ó JM/ÍI, Jtw˙čý©ËÚÍĂÜÍòţ»¦Đ)ÁăüG@€ŃA‰‘‘%đűľ˙LÉR Ý›~Ěßtşśńű҇Ě?zĹ6%°«tĎX#˙cűĘöî\9OoŐîônŽöĄÝg»Ź/çřÓËžŐ]§"—Âv¨˙f÷a ĽŮ}¨ťŻlÁçYßó§N^Ŕ¶‰ë·KH>çęžŢžľžŢI=˝“Źóđ00ľEăendstream endobj 568 0 obj << /Filter /FlateDecode /Length 2473 >> stream xśíYKŹŰČľë/$„˝¸ĺXLż›46쵝Äy¬WŔěhŤf†1%Î{gűŰSŐ˛›˘Ć;đ)ˇřč®wW}UĽYŇŚ-)ţü˙vż ËËĹ͂٧K˙·Ý/_lzè€GYA ¶Ü\,ܶäBgŚóĄQ&+„Znö‹·äÍŠçe”“Űͨ†Ń‚˘ëÝj-„̨aäű2^ô~µć(1E\#˛"ĎÉ wI'ß]E«ŰŞë>ČY®sĎC6u§Ţü{óWP(g±>đÖaý&:p®XnËtRš¸^^y KčÝ>†ń}ÓWiŤ­ë;»ü7UŔ łEU3Ey€±EuĐ`Ň™Ů5PPrŤ#±éÓj?ÓŠ2iKÝÝ&Eʉ/,zxźtOQS—’n­ď19Ą˝ß˘zžĽHĘ0jJ1·Ua|LµJ»ŚŹŐL«xÜ™L+˝¤§€Ń5YvBśä3(űr­Vą->›™ŽŰSŘ/‹ă0 ę  ˛pgę&9B†41~€~=nlç1! !É4ąóZł Ű&‰`61Bş7NęÚ3P¦É>śG!O7ôu7„‹ÇŰç»đß\f‘"ÎÔ÷ĚĄ ÍŤůjźö«±3ŁĆ4–|h^e2†ÁńŚ|&UîçrşËš$utŽ-Ŕş5ć=ßN¤V«¦Ňbv„r‡p Y ‰Ďޤ—ZďćbÚ(N8Č%•ôfXfĆĐŕĂ}C‰˝…/"Íő 1¤z‹`ťObřz±ç#žúv=ľŘÖűwV§Ăĺ1â¶'#¦<‡S;xˇ)¬;OBgAgŇ÷ác¬VĺA˝Ú‹š&BŻŢ?hä2#ŰŰým +?F·®Ć»=ĽşsÍ€/¨óz ^4-’KJíć§#ŻţŞÝuWM}©ĘÍ>Z÷ëŃĘÜŁce HŘ\VýČä˘Ţý\!¬źiëŔ†ˇî•ţăřb@ĐÁ‹÷1ź3СɮK‰B›€ÇáůŮwc“Äl ˝~“u}q;ŹśuÜFÄćÚkPÁŢWŢÇůŁy­±gb°šJlč@ŽrDrťAŻ5 ‡c3ŔĆWĂi^ĐČ×3-Ë×Năk§ń˙Ńi0GůSŚ:¤ÍH;i „8ŃNÚ¨¶đ*)v†Fu 6Ý” Çxc0Đt¤M‚1nď­é ‰R7DŃpĽUWĐž M‚÷°ŞnÜgFˇBĄ[oH¦RKR“°÷¦Ľž3ežĺcÔ˝ S2®ˇ}¸=QíW.młŘ«hÍQc¤-ö<î‹ š…Š+†S»X]ŤŤ‰DCg{~Śµ­ŃtÚüLż»+ çëĽm®gcK 1*±cPdĎcřp­EćÖI=žh~ą„f§áp›ţő\Wâ^)÷ń wÍ4E\ŮM›€Üd®YöM{ç·QÇĆç&¨N9™}'Ëü· ťÄ«* ¨ÓoW 㣀ćéĐ·ö†iIšzµ6č}°ŽÉ™ű@˘đ#DÁŐ‹{·‘M§Já9Âř´Ţ'^'Ó~ËË?oŞĐÉź `ŕ™6÷ŕkżGăá]×ĎŹ‡čÜ;ĆúÚC…Ăĺ8ÔĹXk÷#M€Ż;üZ뿀Ěkü‘íS€ řůŚĎ…H†saÎ[đ‡W`^żŮŚH0€»Ů q/{h»gaF\D6{OĎ’)°cŁ~ĄyęxĆß­©9jź(Of€áţ3PEp˘ÍW0ř ţAű1ú‡ĹhNjendstream endobj 569 0 obj << /Filter /FlateDecode /Length 15774 >> stream xśµ}[ŹÉ‘ŕGb˙ ŁßÜ´ĹVU^˘2{]aw±‚lX#ű0Új†3j©IJ$ĄYůAżÝy.Y—fĎhíB†ßaeVVdddDdäáďn–»őfÁ˙üß/Ţ<[nľ~ö»g+Ń˙ç‹77˙ňŮ?kë@îúŇ×›—_=S“őf [Ýîz®7/ß<»MË󗿯Kľ<˝ÄÝšúhńňËgźßţř÷Ď—»Ąćm]úí›çi´oąÜžŃ‡Wď˙ żŮúíëç/r.wK)·?˝{zě7ř‹t×{ąýßďžżHínYŁß~yzd´ĹŹ¶¶h·Đ ß-K»ýćţăŻô«Gľ~şÍżľü ?¨^>(ęÝúžŰĎľĺ›ď˘ĄůÉż=őţę ~XÁř_}­wĹRRŮßµť;*ë]ZÓ:{z÷^_§şHăŐĂsôđ/źý –oľţ0¦3-ąÝEą©5-weĚbŻénźł­ĺ.Ö›÷Żoţĺćíłr·ć’·›oĆÜţdü˙×CţéYZ1’ŤŰvWĘÍ Ły3Ňo€ŚŽŚţÄ]6˛iw«m‘´čgkúąŢ qéę5e »ŤY­Bę] !kŮîR’Ümz"$«çĽÜ5·*FŇ!ęf(WŐo7ŹpżcTDĆ(ܦg!ý®ŕ Ś™Ú’U.ů®!Io*Ő’éwE—Í’éx–Čx…[…şÜmnŐ4Ŕ1‡Ő­şú©ĺŤúĐÉŻ†d3?Ń$šdŤ¦ŽţI/Ö»pż:2ćť„7T?…€®±Ä&Ńô˙%Ň(š$ő˛ŤţBHQŁ-a6T˝{+wYŔćF°BôEŰ&Áô4”UH—`’ôLý%!EŮň]v« Z…ţizU‹ai€ Ű ńać$˝ "IBŠfw4Ď~ĆzßËťinw ‘2u¸ox'klď– ”piY-šbuK‚$Ň‹ T/…4llkB¤řię, ÔńXË’M˝k›dŮ„UvhßŘd?RˇaD¤Cę!"Ň˝ń w h|ÜŞgĆr–l6ëyË9 . Č˛ ¤ëU)dYzłŢ¤ÔhY %I™6ŚHÓ€ÇbNÔ›nĄH™Â&"HąĘ¸ dó3ŤK,0ľBř4‘¬Âň6!›ľa¬ç±¸˛z:S)XDf« qâŮëąHłŃXΰ.@Š†3–óZ„lNű[ĺ93µÂt‘Kcç­Eçs,čĚŹÚĄVcEŻM§/2~V(&Ř"Zš)Ćř˝g,gľ&ć´ŚĺśV!ZRi,ç…ĎlSž[¦Ů˘‘lC7Ýw´)ĽŤ†’VPëya«îő’ÚXµ]ܸPj¬‘dÖiÇöČs]§ŠŽ óÄĎŔĐŕĂ×i_ŇXÉ[F*Tq yfĂč‰ĚgşÄµD ćˇB°/@b’îTiÜŤ‰l~$ áfD¤aZ‰hŰĚă)ž±&ĄJy|Nă§ko$ÓŔ©]H…ÁČX3F6P"îxü†§Ŕř…3V¶LdN ö€” Ź űă/üQcEç,Ä+zĹ' sP«Žő?bMĎy,ť.DŰĽ´ĘVŐşź3ÍÜ@b~ÂXŇkŇÜOÇP˛Ů|ä˛@ŻŇlÖsI°ŽD¤•y,éÂV´ËD‚&&†ń‘iÍ…>É@Ö9ćұ‰h-ćşÂŇ $YżňXÓ=ŹŻŃśÇšNlU¬My¬iščłĆ®M 3>X¶+Ç‚? $´˛r$IgH ű‘ó=!mč~d“BÚÜM—BŞúĚm…Ć dµ%ÍcUS8en¸y,k gŘĆU>öíÎVsÓË[“ŤµÔŰŰ"Sެ<–uÁx†°ŐM+’M٦üĆŞ¦l`PÝhĂ\¤{SÎpšĐŞN3žás ŐKg¬ęŚá «ë……mĂ3$G-csCĎuZŇÜ›¬ ćŚă)cUW¶ kS«šVfĚâD Ä2ć5Q†YĄxę´heXDŠgL¬Ţ>bY™a˝ŐÍşĘČŚ©–ę”±Şidŕ  ¨Xđ(–EYCŇ.[5Ň$xXŢl´Ięk—mš ÁKda†vČß+cŇoÓ”´I4cXÝo—h†ľř#Ç …nž,UË€&fhô­ä"34H>`:N ×O@“d6Ú' e‘h†JůUC9icÚjkQ†rŇĆ´äĎzG3śCUŮdáj˘ TM +N*Dá µł@k–‰iÍ¦Ş …ˇ‰#®—ő ‰ŠÝŞÉţî.iÁÔcyúßĚVÍ~{ßÜŮŞĂ‚­ĘÔĂšč˛ dB5UÉgXj™ĆŠ=—4T„ŘlµY7*Bl¶jłlzhµ›á:Ö6˘šm¬!ŹA6€ěˇb·"RĽ(+ŹŹ¨1?˝Pi+łNz‚l¶ę^A6¦bXOą@A6;Ą>A6†3¬Ą”·"ČĆG`Q ŕĂQM©Ů†qTSaú‡XoBMdE,C¤Ó!ۆ)´Heă¶éßTq|ĂXdžš Ş dłA¨Áe6îĹUaŁń ŤŢ%1Śx¬şŞál RlĆ$ŃŇlcŐ)j­ł1ś±ę l4Ă[kŢy+âl|C_ěmUÄŮčáş^…8­2ë;aJŮŞŘĄ­łŮ*°44â q1ÄŮřÝ1‡ôŁ¶eqL€0f¦a·Użč´-yj::c“:ĹŮ™KHXCź¶jž„Q÷Ú2ł,Ś’Ć$´ŐŰ05 ‹´ i41m,ŇÄ@ĚÁ6ÓŹGđ€pŻÁÇP(—¶N5‚ÓÓŇbă‡ɤ6­Ś\s–’3dđĽíµ±EkÁ«F´×°E‡Ś%möÖŕĂş4Ö~ 1“Ôň˘Ů‡—‹×äąyÂE"©Ť˙şS&c«=ĽS &O­‚3 ŰŇrĚáf:iiž|ř•‰­ú"lŚfüŤâSúŚ’ő"†Sňü„ÂĚŢ@¦{Iď@Ř^ĂŐ[ŮhóNWɤVÚśJŘM]ě·ÂŤŁlŕ:şŐr ÉŮ:¸h+[e)0\´ÎF3ĆGF`ş‰tż0šşŮ:ÂÝ*ě×)É€EÁďî„|+–3ďß †ĄEš/BŤ±Dvŕ ż‰˘‰]=ÇR†hb¦‰ŕ%-l4Ý xIŤŤ6›‘@„  9Ä…OT9šľ#M’AŞOzcŽ·Őůx@Č%µń-Úłáďll•ďܨҮ´mć+ŕÜ Ňkř8˝ ń5€°1‡'CŮŕk«%©Ű6S đdŘďôş7„×h§ĹŤw""{ş­‹d3d$Ő‡ŰBŮ Ieá¤Đ´ űWüŚňÔ­/» Kź­Şw¸$«Y z$NxÁĂ#ˇivYaÁ–§ŕń%ĺ©Űn©é~p4]& Ţ­cëö'ŕ}P6c~,ż¬Ť|JŰ€LÁ G©Ue©ŰPí{phY‘t/ĚRđ'Ć"ËŇ›Łqú E+ŠÓĽďmˇ45îg”§n˝Oq†ňÔ@ÜBë&DËţi›ŰYéˢźĘQŹź˛¶Ť9jVé¦5-nx°+@ä4Ŕ€dčłVoB¬yMIj ˛ć[S’ú„te©O­V_†RçW!Ş.—v&©ŹoŔ6_Óů3ąÍ»‘ěrCPmqĘ9ÂNß-NŮš† Z€ŰtL _Í]ÝŹhQ¶•9jέş]« Đ«ŃíÍ&–»¸UMŤS'Úk°eÓ°ôÍî¶l–!ő‚Ű*­4,6íMZŻôxK]6&’‚=šfe :ôi©µśŞ"łźI@0rÁ˘ÔG#˘®,޲X0ɲ+JOĂt#YV1mRw«˛Ů·Ńrj¨WŮ"E;ŘY×µ=~nŐ?ĺr7„ÓI6OilŁ˛·3đæ){« ęm«Qî]YË;$mĘ0ÚŠß°!† űěg“µMŽ"°ŮÉÚ®rä°ł­Y†Qělç°ÍH屑ѨŚĹŞ•Ă}«h· ·j2*Č{¨6%ozJfâĄçĐźöŚńöNťĂŕ‹iT0 ą)9Ť‘ĘLCöiŐ>íąě«,.2<Ă9l÷~ygŢš¤5-räź`AĐ׌j·Śëu“ď!ĐÇ>ŤpŇ/F2Ă9ĚP6BíČęµŇGËńŃ<ôEąiĚ»BÉľ*9 ‡J:ŃWrÓéRż˘7ąeÚ”;ňęÍP±ĹÝ4űrɱn_•ś†žę­'%§ŰŮöÄóż í–óŢEÓ˙Ü,ŔĂűťr]Q4=ŇęÝ˝#Š¦G:·Ëž•śĆú“¦tDŃO™ë®Źőśč /ö;ÂhŚ'O§ #Ś¦ŹżŮŹíŁoč®K-zQnö"üS-&%ů™Ť‰#-ÖŽ(šý,^ť˝*9 c%k‚rę Ä=We§r÷F Et{Ćż#ŽfD”˝SôĘŤ‘‘ÇJOÓŕę]ˇôt[űF(=ŤŕK±#Žf€˛jŽáŕpF3ŻÓŹî›˛ÓŘ3äaôMéé¶úx˝oĘN# ´"ŽĆh–͆¨o]ŇYf2ż·UŇŮOězSvŰžćĽ)9Ý–ŐÇ[˝)9˝íç™a4"˙}[ęđîşBmŹ4âü=ŁŘ»’ÓŰ~‚Ý»’Ó[OS—»’ÓŰî-öŢ•5j] 2/Ą«2´zÉĘŃ”ŽźĘMĂů(F”›†Bs6妷!ÓĽ¬ôń`"n I)µa0ą‰¤(g4SĆQzšî“e§á`mzŐŞěô6óŐyỈ1‘j•˛dΤ¤H63,Hě)Ł®ďNÍ9#ď4yÉ‹sFIţ÷@-0ŇSEăA<íVÓ»r•xĆ2ČzWV~©°¦ÍĘOoÓ˘ĺĄ(?˝9@¦ ŢĆLzůđŔ•Q[x $$žbou JO#Ág™VĄ§·PDéixô*j¦ť˙H•xŠsDŮ$ža¬f?NOcµi„áôtŢä$ŃĘ (Ůô]CĽĚ ÁeőzU"Ő:‡ÚÉÖ˘·oNO#$ŇwmNOcÚ°tc› Č@X>ÁÜoŐË·M9µy`9.ń¤4…ŃśťNëTÔ6łÓÚePhd®.úN„~L{orçŇ$ťŐ›j^ŕL!§6óMqrz¬ 5ęÎMŻ«üĎTĺî×eŽAő¦L˝Ő wçîť“Č«÷aő_'¦—"2'¦ÇbĎ~Ɖé%)Á=¦Äý,˘Č¨(ăŮ)b!«*†íň«t”ΓžMDyi¤9Dyé@!Í*¤ëx°'EyM‹ÎN‡:H˘7†Ü„ÖŢŠäO‚ş\΄ŽgqÚ@”FÖCÓ€23Űli!Şć“ý’uzÚ’<řTí˛ŻŞ7^P^šiuŚ¸€Ź¬$ťmęčZŠ¤ł9BHčtާ€¦ÓÁ-űEŞ«Î슾>Nč\/a©IE2Ęß4–tÖaŕb`óń sef<ŚâC\˝ę˛é"©R ĘÔ ÄŐEÇ™áVAg ů4O^(/Ť”[ő3]Çă UCŢVťV;ŕÉŞ¨^ă+7žŃ$Ďqµ;­›˛ŇH i‹Žkńj][Ňń`ÍóÝ­‹Î•' ópöR7)ϧĂý(5Ť3lYɵ+5359¬ăA8”6ńUÇĺ]T9Ż=ıE‡ěÚćŇÂÜ4rŞ2­iQnyW©[Z”śĆ ?CŢŚZłŞĐÔ¤a#ëEQQŕ:’kČđJÓÓşşa®Ş$_ŠôAâšÍSBdťTÖ°ů®2ą¬gŕé…UϤäÚŚą ®ŚĄHX~ť˛á¬Ä0°©F+O3•[ß°zĂÓźXó!Ńe×~%çgrb‰U‚ŇČYK˘^Zc(ĺŐ¦,*ĐÚ÷—„ŘÚ…,Yo*.ýĂőS”™FAŚY*ĘLń€[ß°®F&*!´NBI¦fI&Ą9Ů•™i$hcMU™i «e¦Q¤Ý$©LµBrÝâë&Äß0–1ˉš xRXHÄ JMÇôĚÂÔ4Ď âk–h…·pÔ™uV7U— BüQ›rÓ8fiîGąi ň”RSnE[›‘Ő%Zw’U˘•ě%™%!ň^RSn5dţÎĆÜ4?Ň•›Ć±l~RŮ)Ď]/Î<%HH8ÉúNE˛4NÎKVí"‘*@ąi‹‘|ç’;™źŚč: aµÎ@6Éf ëh^š …"3Z–ĄzÂłdBDJ‘^‡UÝ Ľvĺáć~š«]TQeFÓ2Ć)ĹÎRE"ŇŠ Ť 7%&†Y+ŮÜfłh’mI¦±\¦wźłRÓ8óÓÚÍ*Ę"˘Ý T˙ąz9gDÖłţS/b9íY‡ëD,NI–šJůran€ěiF`íjTíčąđ„™U­0kWľjóËUÉi žm3D´çŞä4Î?-ňŞ.GÖ[¬ţ™ü@wilĚĐîJD-XaÄßZ„9Ş+ËĂS›+Ë«ňNi*ş<âŚČĘőÉîFž‘ägŠkË‹ă)Ô’-łZŁa%ŞĄő[·`ŠCĄŚÚĺҞʖU[îęšT×–goĂ(.Sqyöjj͵ĺŮžvî‹%“•0-©*ÉŐq/{my¸UumůÜP3Ďş ČĎʨө°=éĄjßCHflWç‰L.Şá%n..w˝Ţ@Ú^xŻGS»îŢŻBLíz~µY)¶˝ä?[Ý Đ«×MĄĺ‹#ᢠ›ănA.iuiů ő "ę8]QČEű™n1lBBµĺó¦Ă@ =˘*ĚăÂÄ@Ň]:ݩȨ#[ŚdőbŢÄ°ÝąWŹ%łőqÁ#—˛Şę~^É(#[ÎER$_%@P2ó˛ÉÚ~iE–Ľ n§K+I,ş n+ËŇtÓEFÇőlŞąßŁ”R»/­lsĽ±Ę®Ě{8ą( qÜŐW-¨2ďÚoć•"MU÷Úî€(" âoŘüjĹţeËű}­Á˘ó["ÚťŠŽkč'Źf+ŠD´J[}™'l·‹˛óDd“K+ľĚ^Éa´˝ą±ŕ€HŐ,éHB€U—y\g4%¦h‘–^}™'lJß|™Çűé ç€h?@1YwĎňX«jü‰ČŠÔE©éÚüSyi”Ď0C?*IucK6R„¬ŚçÎH–UiŐŁ®ĘKÉB”—"s…ş±e3˘ĎŻyFVĄ¦ĎH¶•)ÚÔ×ô~‚IűĐváĐ™ÉH¶1ĹńbË%_‘js <ĂĽ }Ť„Ňמs¶Ť):ăËß[ż"as ŤYű‚hş^‘´‹f"ŮFĆW,2Ň![˝"›­ĚtŰŕ©ë.ź‰ä]>)¶2¶2Ňlev$Ű`×hf¤Ľ¦|&’wůL¤îff"Űnf&Ňw3cd[m$íň™HŮĺ3‘Ř ÍDÚnh”Ç•Q]ŐVř@ň.ź‰Ô]>ŮvC3‘ľ#}Ý ÍD’Íđ_>°'v m74B6Ő\u74É»!žH=äcdł/ć*îŚ xšYšI64Rl$,ź™w«¤ŰĐěHZmh$ŰĐHµ!>Íň9y˝zG[_[ĺd[s ĹĆć@†ř@ÚcůĚ Ö;€ŘúÚ¨d›a‚ú l6ĂŇKgż_} ɶć@ŠmÍ(A}F6Ç3˘ÖëcáD¶©9jSs ›MŤŻ«d” ·rAćëâ;Ö'¤ŘÔHŘÔČfSs ýîúČĽd}B|Éú„T[š [ši¶4;‚ňúó–ő Ń-ëPÔČfCs ݆f"8N/éŠřšő ń5ëŽkÄô ˛.64’ňîYźßł>!›#›éwqˇ"_!ČľŽfŢł>!ľg}Bšc›É‹c›I‡™1ň¨I},߲>#ý°1BĘj ‡ɇŤ1RőH<–ŤnYź€ş&ĆH2‡Ăä»~Ş9d{,_˛>!±6ĆH2‡Ă”ĂĆ s8/ZźT_‡ł­‡‰1’ďŐqßlĘ&ť]´>!m},ś–™ÔĎĹŁVńČÄ tď* ßł>#ëcáô|µ0¬q|Ôh{daP·ą^FÓ}ÍúŚ¤»G@yd`úŹ LG¸}ÖĹa߬ŹdÓ}ËúŚÔG¦ŻŰ#ú˛‹ůůNąČtřÍÎö1‘‡Éö!ŕĚäpA`a4ł4ĐÂ\x\ŢU;#br¸ ČÄ_€˛x"´0 ˛3 &‡ ÂŁĽ ÂÄ„6ć‚ĐĆ\29ś19\žć É.mĚŤ9br¸ ,•˝ <λ ,úż 42„FćŚÉŠ;ÁäpůÉâą B&‡ ҦŢ•Ăáˇča±ě!—Ăá9®3—Ă—ĂaŢü‚°žč‚Ä.›‰đ$p­|9s9\r9\r9\¦Ż.‹_.H·|ćMzŮ3sţM"‡3Ŕ“3ŔRYş[.‡ BsAh`.i¨0Đ4„§ÓgDD•†tů]D„w /‡AÄ—čEäpFDäpA˛íËTŰ—ysŐD„DgDDDĘ™Čá‚[Iüd"‡ Ňla„5xDŞiXóyAX,+Ä, $r¸ ›-Ě4[ćZb39\´ËG*&‡3@&š 19\n3«ęÍäpAň.VÉęÉÍäpAšmLó}39\ÖĘć7Kǧ-“Ęá‚°VšČęVÝFFg6“Éá °TV€IŞĄă“źIä ÄÔÍ&f"&r RLŇlbćĄb9©¦v¨–N÷ ›ČH"˘ŰÄěč‚ľĄŐ˛Dôn90űCŰe3Y[źĄM*‡Ŕ ©pŢ\BĚîPe€Ű2ďĚ‹Ëdj."&nXeeÚ$3•Ý^1•@„ěo[vş‡&áH…v.!©¸ś©h|âr rár/g.!Ž¸¬ćiȲ2mŇ–™ËČdnYPKh˛Ámť˘r ⯕7d™6Ż×™ĘM6F ;“3TÉA:“‘d¶‡"ÓŇÎ˙˛1ÍŇ“Éů(Ää@Dćfr b† 19 ÄT™–'3‡hűD4D.4DĚÇ,šY“n"rmÍâ@Äc‹CŔŇ,ćZXdaZń=2ł8ńE|±8Ńmł8qŁM&¦íwŘEâ@DľŹI‚E’ěo›w;Ěá@¤¸QX8ŐÖĂD6·ę˛0­ÎW‰Ă!`?ÍI "ľR/"&D‡‘3…v¦páĹô I& Y<ă#`® 280‚\Ő«ąV6/ç‹ÁČdg¨ŠfÚĽ‰g‡Ŕ¦ ĺ`"Éd ‹-ŚKm&…łÂ!F§źÁX¦/“ł@ü D48Ń70ˇč"÷Égú"RkÓ7‘|ĹŢ@ŔôboÔČź{rfo r&ol|&yCx+|ŘŮ\Řtó0˝!P­bB­H"˛Îfo âą{C`“•4{‘07ĂrçGĚ^"ú†Ŕ>ěi}‘ŘéĆO˙y“UéónĽąhĚÝŘɵ¶ÍÝ@Ät ân ŇĎä j›ÉřĐdYú¤’yCŔ!XÍşŔŮ°‹đ°ł7é&x`]\°hÇÝ˝)ÄŢt,Ľ€îKšĽ!PéăŰű©ęgÝä AWÄÉLÚ°7DŃ×?ěě D,±7Ş…ć3,%bV±7<šĹŻ.©ćj {C Ćh9ł7ńĺ}˛7Ü ŐŹ„%Óçg‹˝!P™d’ ˛70W‡ŘÂľÓĂÎŢ0Ó2ĐdâçüHQ7Ľ+«¨RAÔ ‚'…ćn ŇÍć€ Ů€KV °B6ŕ“­g—ö0ÉUR˛C&o"˙°“7±R‹Ľ!XJ%`“`ŇĽ -îJc»!Plĺ‰wCŘů{Ü ¬®ânÔc… šD*˘n¸‡ë™ş!ě0>ěÔ ’-랸.¤ą%ÄÝ%ÍUÜ Q»!ŕeš—Ô :ŻęG°ÜÎl˘R7 żV?ÂęX"ľ„/ꆀkj†Q7\Ó0 Md :Ě|˘n8«2§¦n’çÝmQ7Ľ×ĺLÝ@¤ź©EeÍĽ …†Ą,;ßCČ°”uŽFÔ —W+ĚÜ Q´A>ěÜ şłrćnxÁz“¨•hŮČ&ĂR&? ¨•iŮ T¨€—l¦ Q7kŐôI¤n¸ÍęBĚ Ú5“\ą!ŕGO¤Ë®Ô2‡"ć†@=› HÝp¬‹ąŞĚJÝ椺!ŕk[#Hݨx ,,2+Š¨vę†@ ś©îx3˛+QlĺLÝpÇW#]¦%&ű©©şLŃDSyŮdnxěÚWLި›k¦{h4,ŰĽ]nň†@ĺśMä ţĚÝ,ĄSżânřô2 ćn˛§°ĚÝeŹ’ÍÝđňÍ…Aî†({„bŰoťwC ŕNy#q7M”ąx›Y”–F Ţb^†"Ó˛»mćnĺů†<ą˘ěľ’ÉUyęEÜ ŘŔ änTéiĹ™»!PĄ'›kî†@°PýL“hş/^Nň†@° a™Ľ!P·Wý ÉáŻĐ‹˝!>dS> B6PËw&o”ňÉż6yC žđ'Ľ!N´3yCÔuUš˝!Pۧ~ĹŢ(í3c‚؆Ç+ú†čĹânDĺĚݬôsîňJż3uC Ü0E¨áF23úŽÜ¤nşS7ÂŹ0˝«c•ć{C ü¨ća {CÔ©5LáH@Dt‡]Şy”–bţQ8i¦yč˛Ŕ}V>šÂ!PÎkrQ81)($?„ŚLź5ó¦p¸ ]6¸óPÁá d go#‡ó›Dŕ Ä­”—>ŤŹ×äĎź ‡ógŠÁA˘˛0=Oö18)g "Z‰¦pĐĨ•(8y¦Ň …ć׏l20řGt4Ůĺ|v"V 18łŚ¨Ž“÷˛DĚĹ "şfjľ©5Äŕ@DwÉĚŕŔ¤K_˘p ŕi…˘)Dá@ÄĎÂëy3=C˛}q.oR8Đ.bB×´hMĽftăŽH>S8ĐiůšÂľS 4e¦ŰÍÝä} C8«÷°38ĐlšÝ€ 4¬őĚŕ@sl.ĺ§HLŕ@žĚÁT:íĽ/Ö“Á[,­¸@ Üddě’l|¶Z›ÁűŇjN‡&Álűux18p“Á1÷@_uC8±ú°38p/-î‡Ĺ±ÜoµDáŔ-Ů€(¸mëîł9¸łÓ<0?ÍVAlšf čD$“/đÜ›Ž†IDâ@gd1˘Ş/¸0¦Ä‰C WíKţ"q ăcÎ’8Đ72c‹cé>éBś9čb­'şe~‘8‚ô!¦‚P†š÷\LÇ@:|îXt M­A‡@Rż™ÔAę ĘÉá@˙ÓTäp ‹jŇ q8nďlgşşr_Ěá@wŘäâpŢ ň3ĘQĂ­¶RĂž· 8Äá8ń»dßĐ÷«t­‘>ľI&t©5b&.ĚáŔPÁ.‡Ŕ Ť%ÄáŔĂÚ&†%^vâpý¸cq80Ľ‘i3‡Cŕ–ě–I&™$$[_Í” UÂYÓĽJ/DdúÉ 5ď’ ŁşĹ| I–e‰Éł F‡nĚ’'{„dN’e¨q!N\%&p`¬*ß]ÁůKÝÁ!ďjN‡M9¶>ď fĹÄNĂL‡¨>Oť żÍu!†čŐĎ„2lm’­Ŕ‘~1Ł2Ô¬żŐ›DŕŔŚIHูč'ŞIł~hň7DťőĄ“żé‹dŢe¨ënOÍßŔ4\ó7®_şQ(Ź´Mâ®ĚQ´)JŃ70#ł­AŮidmLÍAţ†Ŕ!ődx “?“ŃaS)L : DŇŘÄ߸©*s`ţ¦˘´řÍß8dźl äo`J+™Ńü [˛›;îL]Ě&!ú†Ŕżą#łÓ®xŘéufY}ótVMń7D-iަřď[Ďü * Tü áJ†‡ťż!Pě0űazŮGOŠř·•ĂĽ «d““Ă/ó7 -4dó70Ş;ó˘o”klgú&U}Í^ü צ łrĚߨ‘űfćwÍJ°*=˝ş '§q`yfo`Ů4boT˛lćs(ĚęŘb˛7ዑ9m™"Ó70í˝Đ~g ŇĆż‹ä˛L˝2{Cŕ˘|7ĺĂvç Ľ,úféW/¬ÎŰ/VXÓ70Ű?ÉŠŽg!ůF˛ôćoŕÁ‚95ÄßŔłíVâo—.=ěü <Á0G…xČa†8đhDkÎş)zŔ*¦Ő]L\!‡`9–[Ѧóěf’<Ŕç;V8đČĚół­Ma‰Ŕ!@ŇnRU°Ĺä…ĎŁL€ YyvĹáŔ.÷,‡(Óʙ‡c–yx~fľ Q8đŚmR-pŕ<…ó›ČáŔŁ;™ĂÇ{&‡C ţ΄âpࡠ‘Âç†&_ Źu9^<}Ôťvń7đ|2ąŤ2Óc“>4ťî-38đ$T»¶xZjb18„+vžşjK3Ojĺ˙™Á§ą2řfpŕ‰Żv938YĚΠę.űíbpŕA˛éÄŕŔłf3$ÂçŃ«ŮČáŔ3k C<×Öz6‡Ďľ‹”šĆů¸)3Ťum Q8đ”Ýä˘pŕŃĽDáŔă{ ´\LáŔ3C¦p`]€´Í¬żl Öřĺ˘p`U™€Ĺ%V2¨Ť(Xë Ä¬‡0@ÖPt7 ‰&ÍÝĎ ¬ĽČćtPZŐ"A1K:ô¬gÖč@¬‘Ť7‘ĺLŕŔ’ϦX–"Ka–˛Č^›ŔH2Ą X##e–Í÷DDĚő!ÖÚtBDĽ"DŕŔšťb¤I<ë4&p ˛šxAyi”…ĄĄ±żjŃżĹü ,L’í5‘dꥥË:7~ó7YĎárń‡ťÁ/«‹ÂĹURs8°$«Q^>Ý$,íę&zP^ş,3ö7‰KÄć3]âÁIљĕfýLâ@DŽ˛I€č§’Ňđ|´÷›ÁyÄŕŔ*¸0óB’pöĂ ,¦ s:() äLŕŔš8ŃŇ1k­Ű™ŔAőŘęY*Ů–|Dŕ@DŰł Tů­V"pPu¸€˛W”+2jĚ5dń7™ż!|Őçaço8ĘŮ'JŢTU”»°cŇ7‘¦ľAĹőú&Ń7‘îľ5úĘE›ľAuün®(W©˙doĐmwÓď hÓ2{Ăq©`˛7ŃOU~ĺÝ7un/HR˘n8n8Lę"V$Q7%&uĂq™bR7‘ÇfęŢŃ°Ňň–‘.mh€ş§r\ěÔ ÇĺŹIÝp\™Ô Ç%’IÝp\4™Ô Çe”IÝ +,’©tÉE#Vť8PÔ ÇŐIÝp\ź™Ô ştł a帆3©ö›:“ąA×{şe§÷ ?“ąA—‚˛¤ÂňyqČĚ şm|ŻzŢ?šĚ Ç%37PÖĂĚ ÇM§ÉÜűm¨ÉÜ@Ä5ďUĎ[U“ą!ö›W“ą!öŰY“ą!ö+]dnŕOú6oUĎ[`“ą!ö›b“ą!öŰd“ąá¸q6™Ž[i“ąá¸ą6™öËm&n8®żMâ†ý†Üäm8.Ń™·á¸y7yŽŰy“·á‚Ě+Ő3ü7oĂqďoň6w'oĂqŁpň6\ߪîSľâmŘo*NÚ†ăvŁi.€2Óű•ČIŰp\¤ś´ gD´ ÇőËIŰpAĘ~sX !Ó6—?MŰpNWŞŰ™¶á‚äyqXů*Ó6\ÍĽpĚÚpýtˇZŢA?nTO@©éý.í$m¸ íÎoÖÎa҆ rÜ©žČq§Z*a҆ ˘Üô~±x’6ČĎźĄ%_X`ŢŚ§úzĺ•8žŠťÚa>5<µÜ|ýěwĎÖĺ˙óľxsó÷/źýđł YkXo^~őlŐ7ÔS#H7/ß<»ýâÝĂ—Ď_ţúŮ‹±tę2l6éřę—_>űüö›ç8¶č·ŻŢ?Áš-ÝľyţŻ/ňě^>ű‹†ÇЇ$oćO\“éăçăĹô˙ëÍżŽ?~ů ׇß|ăgýĹąi Ž"˙9Č}Ësö7pzčsw‹l„÷łŰůČÓŤňŇuhÎâÁ':©ŢÉ~ţ˛®OČ˝ě˛Î”ő/!h‰ÍĽńű<ÁÁ 6^™–$Pś& Çní¨V™˙y˙úć_nŢúĄďżKžbbŞŢ őŃ ńw˘Ô‡—âÇă8F«Ă~˝€ëś†p‡fÜ®óąSż¨S®C ÎĎ}ßţŇý!»=E ľW•Źĺ'şCX˝Ž¦|¦đ/^ŮgNs2qâfşBI†NŻpâ‡yVť\o~2ţ˙kKţłŇu1ňÇá_XHP#çůG)äůü<˙})Çů —gĘj®ý!#˙Qšö”á;j}MáĺeŮť·_}ńńG7oßí˛Őñ#ó7¬>/Ę,éŻVcÜ/ŞcGűwSc”C¦/-Nđyę÷Pâş đ?B‰%u(1ňŠK=íeŮP’¤Ă[mgN¤7;rz(/%ťyŘŢěČůˇÔ–óřyúëď­ÂßCËžTaxźś—F ţüPá?>gőxYo_8¶Ćź}ë †S„ŚŔŇ×ó@Ž¸˘ §ŞűĽ˙ú÷Ď‘¤@ţ ßľýüŹ_·¸M?zţ9˙eŤŰ~x8?öáăűWďß˝ŐĂ=Ż·ďľÂźQG\nßžž|÷ćţüóŐk·ă5Ű:śŐŰ˙|ůőĹsäJP†rűńź#Xo.˝úňÔ©ßP{iíökŔ2šżsóe»˝<}áűËŻ·ĎQ‹QS»ýčŻëůöĂĺ ďHţn¤ţ«çźô¸ĹąÝ~řŐY&çŃěťmcë~D{¬Wů\$řµĺÜĘí«ßâ©>6őˇż==óp˙BîEëç/‡Ö¬¸ 7üî—?}öňż~ű˙¶´ÔǸ†÷…J†Ţ¶9€ŃÇř°W_<ǸĘç_ád@Ë>#zć|¤oýÚôAĎ/+Eµż #ůág}9«(üŕuxą íő^VçŞËą‹áí,rďßzŘCnŻ<ĽˇŻ>>5±Ăłü8Ç4]ëp:ď_ýň,˝×ţűŃß˝Z•–oŻ˝˝˙íIç®ôQKăčđ_ŹˇÜ§ż:=sLJĘT˝ý‡S׿;/»GďF€ ¶çŰÍÍÓÖ€—OGPŹsÇ:â ějk:m•q‡Ř{‡m>wxGĎÔAř›8_o©iîţnh? Ƨž5řŐűŹú‹E¦…ĎÔ<—ôő5p$ 딫t:wh%Ö*W­|˙ő#Ő8Ţ|™ˇů†’nµňÚoĎKů‘ĺš«ä7~đü)GíčšúTń‡7O©wZGäÝwőţ _ěĂü=z^˛ĘPú€LbXăű‹]ü¨5\âöŹÇ´ĽűęŞq?ül´ËGá´>ę?=őIpv¶e˙¤ˇë8ě=ÝŢß]ěä˙j oÝ®ăőqŽ(_żÝ¶)·€mâ#eLđ;}JĘ#şÜJ“°I}"ś}řÄŕ;;ü‹ÝXbÔÝŰ—üV"Oón3:Ě»ü0.o^}|˙oÓ*ĺŰűÓř\ŐÎëZ=ĽřňŰgú[7®W®űÄ5•|.śĚýżVäŁýČ«çşiĽqVi~CÚ÷p˙LÁ˛–ühG¸>üŹń‹†´eĘcsŕ«Ć6±ňŹŘó vmo®ë-üěÜL®ÖřĂÜ«Ç~÷ÄŽĽ ’+Kóţťż˛ —çÝűÝŽקéŻ@“Ťëčŕ“˝| pÉc:>üţäĽ9żóě:eozllÁOŮ ž7 WóĎoŤĂ“^Zš í—Ú˝V,h*6Ďú[}¤Ů_śuůť‡Şé›ăcďÚ»´OL1wŻHšxČ)»÷—U"©·ľOýú‰(ŃăšQ¬§<ä8ŰŐ¸ýÖUňđáć/nź˙őűdâżčnXfĐŠöÉĺŻŘ'Q‡\FX|ęđóŰ_<ź>@Â2<«íÉżÓç€rkŰősţšmÜŹô#>ýúYŻöŮĚŻçÝĂ uł˙͇YůsĘç·ĽHvS^đä.«´öłżń «ţĆj{űîŻ~qűŐ›ő‡‰űęÍÝŰwoĆ0žZRü÷żó´‹?˝˙Í롟ďŢ}y4·Ĺ©iěŻ?ŔéÇĺňéôëÍĂxţţÍy˙‡×Gˇű·ż9~˝y÷ĺë ŃÇű©đ},h~ČWÆŽ>F¸ŐʲܾEĚôęáGó…ýýčxýÇ_˝ýáWc›ů‘µ;˝¬é!Š±RV@Ëxľýzö·ňiHÇzßÇú?ć_äÝĘěŔźVÚ, éöáÝ×÷Ź}őđúßî9ç=Âhű–ŁY8ŢýçDz ‡îO§×[ßńĘ‹X§Ţľ»ű-ʸ6,ÎßýóŹźżX—ÂŁ·1çÇ(~úŮ݇ŹŻN_űĺiŽ˙ďű_ÜţíŹu˙áwV¦«Č[;‰|lő6ŽoZySçxŃ vôÄnÎâKhąí§v(H×văKć´[śoƆߕsśŐţ-/ÖúGľ%´~ísn^>˛áÇ.ßµ‹Ëpáł Š“¶řě§<üŃ!>ż˙řńáµ,ýé€ŰţĂη˘ťOśoŽ 1ÄCÝ$\ÓOÜZľ°bF_Ě˝oąî÷—\{H_ľuS˙ŕ÷ŮźPgzâÝßpśŰp4‡űÎŕćż÷VĹ7őü‰Íç[Ëö-oݦ4S ݢĎÓBąěß/öZ§|¸˙ú<§÷˙ĺÓ`h÷ éM ‚ľŠ™ń®âťőáj˙ţ±+¤˝ě±§pŐ\XFźôŚq+`¸ZoŻ“ĹŽ–GSúÇ.ŇśďϱŻhźFŹF{ňŃ ţb§±09ůµßé4â»á3ŽőŚĺ4Tć,Ě'˝GpŽu‹MI›?ܿ۳ÖŠ/ýäřă÷đ3OɡÝţ˙·OťL?9ŁŠîw{8Ă ŘÆT #J nČn˙ţČzŠ6Ţ}řp˙ËłťÁ4°68”Ôc‹«*}řx˙†ß®ó)™öî<Ąúěa(/ߨ뙩§ż‘gŤ\ŽŐ>‚Bo4G˛;ňĐąs&~ô"ź»-§ížź~›ňçC8—GS=~±Çéő»€O}Ţ?ůvÜN]ťßţü©`ˇA›±Â#ëóX`×—€ľ 9 \1h]ç ňp®˘}Ę_¨Ä‹ółóÔ7>)â_‹s[Ł|_çßOÄ­·ď+ăOfřŰeĽěs•ĐŢ'6p}/1 ů«7SŤËiÉĺ;v¤{ŰxzŘe\E€óăwźţ¸WÚ#WńšÝvĆń k-űĂ řťź\Ö}¦“ňvJ¤Ëö´@ŐběÍ× ¶—]­ČhC†=Ŕ5Ş^e|¦îSĄ÷o+ę#†;[ńäŰłţ–Ŕą ˛X®±^xäekâĐ+ÓdŹs͸·ăqÖxĘ`ýł#'ŻľőfFßc঴<¤o8ŠeŮÓqŔĂĂĐ’nŽÝéźsünĘs)Wga8Äźî¤ŢW.źő+h kyäźť‹wJ˝Źňa„ŹóľTţCk>^ý…={†´ýĚÓ5xbeśu¶"ăwńlžČřfGϧ ź¬Pľm{2„e˘ë›O“%Ú™żź/ř-ńďőĘa;Ç˝ŠŇ¶üĎÇ_~ńđć§pKŢźŽg˙\č÷#řš+gäťâÂďjřĺ«ŹŻć;N­Vęőš? Rř˝ß’ł,8ĽĚžý’8go|xä˘řŽścúFaÁ. ™Y*Ë9Wh/ř:é-nżůÖĽű[?TÖŰwíÍ0…˙ď;ŹđđŇľiía0Źł’>xĘCh?mĽr|ş Z˝|Oe›ýxOZ\]ľő^©őTŹý(§§¶­Ä€ďb2g„•ňŮöü×Ë3÷O̡(#úóç”OŰz$‰ůR|ýá)«üŁ˝÷#ŹşŹş»ą˙çďžęfEŻÎg~t*}ř˙ <»âendstream endobj 570 0 obj << /Filter /FlateDecode /Length 3220 >> stream xśŐZKŹ·6r\ä ×``0GNÓ|“­ŔlĂ€H"ď%X%@kwv5ö<䙑% ˙öTńŃMöp^‘}tP÷vM±XĹúęÁúaÂ(ź0ü˙ż]^±ÉĂŐWÜ˙u˙»]Nľ¸ľúä9gţD[ÖňÉőýUř źi(bbµĄ­Ô“ëĺŐ y>Ž2Îy3e”ii9kÉ*{žM)e–“g]NôrÚś¸&k¤‘´uŽ|äËWőfľÝ+üăθ¸†nüh{čËżŻ˙r<ߏpš:ë`O×wW„·Óëe9MŁź4ŤA˛rżŢ,ß,ş§ÓF ’J˛évóŐľkĘ!żÄG|7[ľžâÚ\R­Z1ąţćęúÉ Y­—óU·Čür»^íşŰť§F’»n‡‹Ö¶@@ŢÎW3˙MS+L«'Ť°ľ‰ Őbľú~Úp¦Ů˝Ú̶ŻÖ‹»ÄĚ°~ąŤo­&‹őĂ7óďy?˙úKX‡3P'«ůn¶IßYvďčæëy)rŢŃg˝Ŕlľóôä~1{7ąˇ „n‰đ¬-.Kg¨ŕĂŞĽeT‰áÝĽ ěĹ4îSŁfđ8,«¨›}̸_·)uŕĽýľ\Ďîďç·óŮj·}Š¦ÔT®ÚIÓëőŐv7_vx‚’ćżÝÝŃA9_m6ël˙?'[Jňc·x3ľücó‚|öřó#ČdĘ—Óa14˙Űnł ę%‚j8e tFŐR{í wŘže.l_rÖ03,ţäÉż išfú‘×ü·ó‡Őüž4·ë»l˝g¦áÔKˇ 7fŕU-ŹÇţŁÚ©Oú $¸¶'3˛”;qŚçTiŮF Xă° ŤşH¤şDĹz‡EŇ|©.€™‘ú(§‘DU6H㸼HGú°@öŃ 4gi耂>˘`O!‡ÇpęJ¦99ń !ŤŚNlmŕt˝Ź^·…g#÷–ëäľ6vluˇc{'.÷Á}Aľ^2ŢÎ^ďz”j8•B2 _ŕŃFČÁýAĄ–=PŠGąÇś N(Ł<Ź“€ŠVą„› ÷\䣪rA=0–s1Ú°‹¦Šóž‹zÔU.ŠĂDÎŦJ.¦Źg:E3ÔO _?Ͷ‘(ÇpÍŁr8ĺ†g‡ŞkY-4˘žjĚ4‡Ą{M·Ž™¦!Ę:ŞŠăő9H J®ÔOŤP2¸ÖčbCÂ]5Ďśěuő9°“†ůw“«Ś$Ý >h›ZůŚr+Ă}Ň„ÔÖöąM+á'd”č„źJÂ>çQN€ů6ëeüĐJH ˛/‰-0Zç©ŘîuöR|HŚ G»ţ^sunZj{üŘľY.»ÍOCJ˝(Hy D7IŔ>Y¶·IâEşţE•éĺ:Ih=ýđë‡ňu»ťŻ“ľ@Á·ů·uĐ{+$‚J†řó§‚f>Ň<˘`Ś×ŠĹy)|KĂźî’Ąe4W\}S…NČ$xŔŽ¤\±¦T6÷ň\ÉyĄĽÜłl8 ޲rë˝#2ś6Żt­ĽŇ»ţĹŔË’µŇZ&a_ĂóŞyxďiWZ:Y'&đů'üŹd[7)LŇTČŞťPČÝ6JÔPAš~yKćůfRb„1¢†or¬Ĺ-IJQůŁCůSčeYp~Tř%˙ű]ésM4sSÎk/g#@¬9Ď_P{Ćź pfx¶~‹cóăß™6ĺß7ĹąŘ柼ą± V¶ô…‘…Ă/5ér´Íźóâ|%ąx뺊đ3Ę\Ę3φ8« ’ °Ýł=Ŕí—çŤc|SŁÄ¨ţđĹ0芸ŕ¨u6ĺ€ĎkŇÁŁéÓĺ›ĂĆľĎ(ł˘™„\łĺ`¦â¨v»eń–óč; Éâ`lńmęMň‚T­Ŕ%Đ›ů>D3l(KŻvÖvÜZĚmÚ1fbQ–łŘ00‘‡âí(–äĐăm% Ë-ÚĘPËM‡g8ć0Úuđ#7 *ćcMfžÔ/Pgd.<¶† ůs(ťÝó?/—¶…•×‹ĹÚŚ+‰˝dFNąu›nY€y7IҶXçMÖLĘ)°`ÚbQňÉsřX&B†J8đŤ@_j[*ţN×eŚ‡üx´Ř’âŢżČď#mÉŚŞL_KÁQ ĺ+śMAU!Úx®ďAD^8?h;ŐđTY…ÇZäkR•ő žcŹrś|šžIéńhó…MŘő´Ę„d,µę´¨*±ôŻŐý|‚µßpTaoiďčY*Çô-ŇĘcĆĂZ@ZŚI˙xŞ ¸“e±úć%jB™©<ĺwUI•N`˙5Ł|¨Ę qš›¸ďO«Ü8ÖO*éďţ*#î-žé{{ŐŘč qĐX˘5ÉňcŮŘ{É“ˇßGe“OÉň :<,©Ł%yÔAyNűVf.cęČ?ŞHôpx-sĘ[ěĄsŠ&§hĎ\ë&~6x €T"–Ôä—éG'á´ĺ%ść.i€€ř—4§\ňüň¤ ě!T•ÚRĂú&ăč»Z×·čŘöÖE(îFü ‘D1qŇsĎńć’@ć†ýrcu™ĎE›łdBUťŃ™2Ţý~2_†ŘĆţßčą?©k^…­“¨µ·V™¤;¤śŚcËČEżç28TPĚL໊!úüˇË“Ô”ÂA*b3W:CşĂIĹA;7©•%N»>ť++©űý˘/v‰ śä*d˙k|Öy»§˙ţÉ/ieŮvdÜJ(éŇ ×3ˇPP"ÁŹż­č-f¬"Zź”!íü@ jA^3É)?­ŁµÄÖÍ^®Ľ×V˝x7Gű<{ €ĐśőwÖEˇ_î®oe¦>ľ»śňŚÝĄX4ŞŕŃä¶o0l‹>ĆnWnŢ”Ć7»Ţćź/Ň)±˛ÖÎúR‡ř[W,‹R#¬Ú± …ď^ÇjxóŤAîo‡ť,ŰëUpÎÉÂŃ=-¤““śň€î9uÂńSG öőÜĄG ŻdÜ…GËHyb{xŇsĘ#ŰëŁ]ź0Ťv‡Ć1}{¨+űU…*/ŰÓ‘:ĎŰ`HĎ)ôíiPN[Ż§•8ú¢˙%ĘŹ‘’ăĄT-˙ýU’^¨AΑ.‰ň¬žĂ‘¤’÷I/ZŞĐÔ’ŢţŢüHŇ;T uy…:˘m.űÝ{ $tČŘ·hľŤb”ÔĚBÂ^—qéň¬?±đÁµt°ÔX}™·îwŁÎŐjű«­Ôk]!fť»j+Ú‹YĐÝĹö¸VŕÚčv­$őĚĺ¨S:şŢzXo~Şwz¸ŁÉbßUs-ĘA =‚á•}Ř’%]Ü“t†řf Dš–ü軏xŹ?‹¤Š Úńi¶Tö× ůűsř‰oéŞě'ŁîěľOW˙u¨&Ę:۬gĎEÝT÷5 (FÇGzÔŔĎ+ˢŃV^†¦iĽ·ĂuĂűßťŘtw2NlË˝:N–öGĚ\nőiU­–j;ĚŞÔÁ»ČŹoJńßĺíŕěD”Q9u@ÇPl¤ł16BÎbű[4Nă0†Ćţ˛˘ŽĂŤ’8ł¦‹{Ćsů$űúoŻ“´_#BÜ>Ý0çRďł]Ţ@dőÎßĹ ÍĂ »ËJ_ý+ÉsX?—É#ë;SžÁěőnĎĺörÇ:š§2a)?O×p-±ÇďÖl ××ăŮš–ů¬ŃeyyS9ľ’—SuŃu{YĽx¦Ľ7ۤżË»[A!“WA`˛X„±c`ĹgË.âö¸=9 $‹&l˝dhE1ś°dN‹µ©˙$ýŇŢ­aë+Ă3†oF2C1Y´>5}<ř]˝9b5¤ĎIÜVŘĚß j)î ýX2Çr¬ ©Ő(żk¦±¬E3Ń|ÇnÓ#cűSExŁ)ń‚´ĐÎÓ~¸çŠB‘ÝŢ=˙l‰ľ_ŇŐzůçëWł]WżęF°WÖort/`2q#MkćŹG pöůQâäłňĂěňQ /ę1Ś76=Ďrř2 Lű g=Hg/•ě'ĆqŚRáLu qq&R©|ç•ćQµqî0öůżÄKxé8@~?Ť Fs(ۇŮRŽ)ĽpnXIÂ!jŤP~ĄŻ®Żţ ˙ţ |”Çfendstream endobj 571 0 obj << /Filter /FlateDecode /Length 3250 >> stream xś˝ZÍoÜĆ/Đ›N˝;]ŠĚ:]vľ9c´Z7@R¸@j«'«(hi%łŮ]:K:Š#{ß{3CÎpą˛…â’3ďűýŢ›ŹďĎy%Î9ţĹ˙W»3~~{öý™ ·çńßŐîüŻg|<÷âüâć,Lçđ¶6uĺ•9żŘť1)W˙…Á‚«b4·•f\\ź˝dOß®xĹŤŞ÷l·’0ß)Íň·Űfh_jĎ6«µRşâZłgí>ö~•÷šýŁ[­Ą«¸°ž]gC`.ţpÂYǶ=NPçŽÝµĂëđË[ĹŕyyÎż/ţN ™B!k*n>ěů ť+ëdRůMF˝ą"Ĺ4ĘßÜ^–k©G^uNH‹J )Ąî´ Öh¶«@ÁóśŔZIĐŘ©óµ2•ł6Đąé»·ŰćÉjm¤F°Ř|‹żA9nŮĎńQH6lvoâ@oŘébWÝ~h®â+Te´—çĎÎ.żdýUłÝyaj¤Ď~&"8ż^7ň–Ü{üx×î7ôÍTµ´ŢśŻÁDđMa·í\ Nŕŕ¨Ă¦ÝmŻ“ŕží»Wý$ݶ»}Ö~7©ń—ožÁÁN‚íŰasHß$Ű5?V·‡f¤ĄQˇëęëQL Ö4žÝl7?¶Ż¶”CĐžŐ2içŮÚŮJë‰+x§rnúí.ż\EL%ÍfÍýÄVT|ó—Äw]ÚŔQ=í677íU»Ůý 8 ţ-Ž6úŞÚ]3l&‡ľ®«É._]¦úO“h¶o7Ó—o—ěË÷?˝qIśÄÉ>čƻ氣Z"ŔdeĄ×ô›l‘oůäyU9Ą&úŕAUOÚ?~üx´xŚ¨w›žQW»śQ\L LÉ@ÖZĺ >[Ż×«Ď‰Í‹övßŢTy$_oú'ÁAČ“Ç\R˛Ě|ąäc6˛ĎCę—ů–܆ n4hN¨®D‡e:BTÚ¨š¤”X¤Ȩ¬~HËüN‹dÄ$ҲD€ĂV™{)Í$Z$cśP˛‘9-PýU'šĆ|”…NHâc‚ôĎS x\Bđ|8#Šk¤03F¸“ÝíšpwÇ«8b!ť´ö˙/ř(Ů%I'Ih ÎóFŮ€Őđ Eč `yĄ¤ž Żjm‰AÉPu.ŽËñ˘=sTűTőIŐśîhXń^NJ®EĄŚä;ǤTć¬%ť›Š©Ő’ďU€CŔBY+žc!$€Ę±Đq7˘©zŻă=ź t7aŠWň4©¦.mj™”ÍŰÖ¶í«ěEŢ'Ţ5łí#^ł>çÝŢdťbämĄµ˛`›Ng‹šâx夎“şz3CLmtBç'qČŚ ř’»Ô([µH'<Ć1ŹâĐ®ć4ÂBaΡQ7 / űmV\]iéŕqťŤ|É.ˇ-<·ť·÷kČ*9¨·Y´íłçv豓 &‡ľ0űtčv1&śIńâ°b„H!üÁ]śđqGQŔµeˇ§ŠŻ ‘»ĽË/˘„"aúť"A°ćÄ”Eo Hdt^`˝­ĆĆç´»…LőŃřOvw ľ×Ý0"¸;Ž|Ý3>wG“gScŔxp7ËmU~Ě^‘ůLłÓ¨ŇĎ2ütńr€•s§>@ACś'ďuI Cuéâl/k‹‘Ŕ±őE˘đ 8V…ЇútĘZH"z»f!Ľ‘>Ę5Yď(,"pś m÷ @ Ä —ŇĆz2Ź*őćăBÇů{‘š ŻCčÄ‘/ÓŁč~ö!yQ:ű ‰I”; ę'”†‡î)=KO ˘ži]DěŹyh_˛e‘džÁż[de*ĚČT€Pč‚ą+v6*©GͨŚ¤ŠQ¸y!|b÷›EJ®2Ôj„1WčŻ%©Ę¶űrE0^;Úâřó ] ÓÔŻeţŘžźČć«˝Ź(»/ä̱¦kÍ]ĺę˛/żű wâ)˝)ü“±˙ŢÖU­$W3sţ÷ó`¤i[đTĄO¸×Â?¤'ü,úĄŰׄš ¬˛ŚşR8mäHXH(%Ŕ’.ŐneBíNŻ!D ŞkE.úş ” ń¨Ë8 ű˘Š|Ůëţ!JË“ît­;̶U±¬ř˛g *rÂÁ…}ŃP…SAU⾎~łä9TmRlĆ_Bűł}[˛"e ·Î»X\‘ĚâX´4ľ/ŠeŞy“Ôke`ĺ˘ĺlť–Ś ëJĹż ‡˘qH ÔÁş# q@Ź{eŤd¸Ľ÷4¶+ [aě˘hĐç˛ö@C,ÔŰ2w±¦Ođ"tŮ–!žn'hň‘Ćłč§Č ¸On%…V}ÚIr¶5·’i¨7Űą ď|çy9Ď_’AčL†ů.â*±_0i™Ž¸©%§ľóĹ)đ Ő–4+VQŇfŰwQV› ű‘˛.Úsîň…L—q*NY ›]‰"ĺ¬~<ű¸Ë3ş €!kŤˇ fO˛Ř»ĎŚÉpB‘yˇŰ8pehh”Cś ˛a)ĹîŮ?ěŰsqĺGS ÎľÔGďay˝mż[Ą»‚ĄeŰr“eť˘˝XŤŢJŰ'Ń=ž)÷”ŚČ)S˛<‘[Ľ¦'ś©D­łŁłk±dËr#{Mú ¤¶őÖü÷#šňd¸X4=Ż:7Çë 7ęU=˙rş"1eĺ%»Ů‰xăăčöJyŕbC5 ŻÔ!T´ÂëÍÍÍćjčnwüú—uHüřëo7Ó}Ťt™0\;ńń2aĽ÷öěůEÄ…k/O_·éÚKNx> stream xśµZKŹÜ¸ľĎoȡad±lÇ­O‘sX 1|Ř…$Ţrđř w«gw·f$ÍŚ˝0ňŰSŇDŞŐłžn‰d±X¬úę«ŇÜ-ňŚ.rüç˙ß.ňĹőĹݵoţżÍań×őĹźßi o2“şXď.Üş€·…,2Ăĺb}¸ L,×˙†É4çÉě\e”X±Ţ^Ľ'Żď—y–K^ĐÜĂ’Áz͉ßîËľ~p#…!ŐrĹąČr!ČŰúMű„,3Fż5ËÓYN•!Űh ¬ĹMµŇdßážĺą&Źu㞌â~ĎŻů°ţĹH&R2Ë•;ywćĚ™Ň,ů6’^něÁę_^»˝T.ö*bA‚fŚ2$5­;ť;PbŤrżtL Xq'Ö|±â2ÓJ99}u¸},ŰXM18 %,Š3ű,Ŕ¤$Ď$UžscđYdE±\I;( Í´¨Vąňo´ /_ľ´űSžIaŘbýöbýň=Ů4ÇľÜô_*°=•…ÝŠf2×yĽ•((·âQ0zCyNąÝ—râw!«ŐjůŁÝá×úúXď˛qʦŮVÝĄ€ŰĺŢ.śĄ·]Ś·,ůŃ]cj;™Lé§ŕ í¤© "Łá®çĺPš É}¸3ÍJ/çJrŁµ“´ľi«î¦ŮoC„đëj·«7uuěÁ˝QşŇpŚb±bWľéúúPöUXČÉŻý6C÷MŰ6­×3gä·1pĘý}eŻÉA§>趢kEŃť]4K07…ŽFŔHaeb¬v·ĺ¦>^đŞÂŁeĚÄPŔŔč*Pw·-”·dšX 9Y;š—0ŚĘň‚§ČŰ–Źí†„’>yj1;ÔBźO!“%‡“<¤‘p}’]¬r‚Ąď[/Y°7éâ!ô‚ń©óŕÂʶr»ä ZĽy9&Ď EýˇžPă±]ôVĎŇĎ-â†\‘YÇçR† {’ŤŞônuµô’MAĘř„‘E¬Ă *¬ü©ÇNÜ‚ˇ[(´aŽˇ·:MÎŃeűűt«ŻýjíňĐśŚ€ą© ›Ř;’I]â8É<Ç|ś]§Ľw”ć;<Ĺ*ĆÎÝ j&Uáo%DçĚŤjr6^ ŠßYO} ÷+9”±Yoź †Î&IßmÓÓÖ]0Ľ:Íihş§¶ţ-~BŮ'.Ă„Ę”ś‚śÝO]ß´É˝Y?«Žçpóř©—ŔDUľ]"8r°ř.zך1°3F‹ M˝mv^¦8Ą¤N¨$ż€Ź˘ZFšŹN,P`Jęň8.‡ Đ֟ǣśs°×Áz>sű.ké4(ß%I¦9ŕÉŔ}%(Ű;Ńă©:GËy{ęřětćěH’94N<Ö çYľ— #[«(»I˝.Üą23Ólz(?ą€dš$®ĐůŞRh݇şŽŐPQ¸Ů®ţ9Ćľňł$sÎŽĄ ÜL"ősߦÔűmfŚbeß ¶vő±Ň‰-·ľD\˙h/M@~«¨Sť„Ĺ« ]äł‚ÜÝ[UŚĂN6 üÚF/»>Avw|Ĺ”‚ŐŃ9»ľ˝ŹjźdZ?±]ç±e^öČŕ’R "‘)Ä»źFŢ´m›Ű+˛;dŐÝ}ýGmúáĺa˘¶Ělxµ|żą"/˘÷âUX§É ˛/®– ŽfSĄŻVHq´ń¸Dż2K›,Mb_ůřŔżŠńA|•Îť)‰;{¶&„ŻŻ(đ/ H‚Ź"_VŹo$* ¨ĎŃ0«ă<ł÷U@ei Č%¦€™"l—ő)pGÚAšMÓn€S˛‹ćź’]YşÜ§aRş]¨(Aďą°éĆłţ…y~ËB „;ĐŰm-Đׯ‡pŠ»°źÇÝőMŐ—sŔk]?ŔîwC­ŐR-B­5Ř”Łߌ´îBä)ŇJmápĘŁŔ&Ł'»K<`ß řűxJ°©Ąë©ÓŘůě•ş\iółú\ň.—˘5€őµ!ÎM†í޸Ô]$FšG4ż¬ň[ `7%2|t;s™NÜ°;#Ó‰5HQ=™#ç”}˘ž’~Oťâňp}śbđń (Eč¨íłEĂz<„Ě{ňäp×Tcp[7Ţ‚ĄwőÍ>LŢtÂţbĘ޸´>(ŕU }:źń%żćÇ»!EűÎ%fĄsîŇňX†ř(u‡ OłQ’y&`ů9—ßP)pŰ9ë|ŽŚÝ;éÂqŤGďoÍa6K9CűÎçŢłĄKwš8 âɱ±X2€şÇTŕP•Ç+˛­wçC¶§é饀4~&‘cB|O?Śî·Ň¶lËÉÄn0Ë P±Ô% 21Ö®_  ă×6|•`’źŻ_#ź˙Ůt…ĄÓ dÖ¶úÔqĎËAfé [Qâeí{d]“hö›@frr [Ć#ŘQwŐŐ×ǨD­ăjkŠ1Š BŘ Bŕß]”‚ő‘6(,bµŠÉ‡…©檍z¦dt©»-?FŮ&B×î†=™/Q‘´¤ß'zżnż~źöƜЂ\—®BGD·BŽ; ×®t™¬äá¤őo)3ĂÚL‡Śf[<ďKÓ«ĐŐŁäěuĚTΆQO,)íK ,‡Ň%(ÁăV]ĘŐzk«»IľľŤg»Ęőžj·ză„ż©`§5í]Ě´ĘýţËř§Ý̱ű—2Ű‹śĄ†~ĹSÔ0łđf}ńOř÷_®Ťçendstream endobj 573 0 obj << /Filter /FlateDecode /Length 2388 >> stream xśíY[o7~÷_č>})•dfy2h tSMánŰDű”, Y–śŮHW#'qaô·ď9Ľ Ii” Ú}Y~°†Cžëw>rťĐšM(ţ…˙‹Íť\źýzĆÜč$ü[l&˙ťýý™a0R[jŮd¶:óKŘFŐÔV¨ÉlsF¸žÎţ“ĹlŞkĆ-¬]ť˝ On§´¦J4ŚZ˛™rXo„$ůčzľoßř7Ť%Ëi%„¬©”ä˘ÝfÓ^ă ^[+Éݴ⦦L[r•Mµř`ц¬{\ jJ yŰî_ů'«ßăkţ=űŢ9¤ ‡´Ş©öţg'|®µáŃĺ›Lú|á“h˙üÚëŇTr9čjrA’Őśq%u;ďťw¨Ć|=őĘ\U‚ÇFL*ˇjŁµ—ăĄHĂ­%ígE”vĹÓvŠaUL“ý´’Ik y3UĘ™ďÚů6“µđk­€ő1ţˇŻ§•Ön™˝Â7VŚýĺ60O“ËĚť¶Ęťëvđ/ ČÓŤđ€E§ÓSÍňă`°¨»ôr4Kf(ň·Lâ~_ČĽ K%#ű.ĘgCZ‚éi f‹ÂÔů~^X4¬ Â’»äc{ұ«Čľ]ep¸+_Gó'űđ›5dŢ;0Q+iůdvq6{đ‚€-° &pňäâ‡ř c™4-–f±Ň»î2‡Ó>,űÖe˝”B“,B đÎÉ… _ĺI_Ż;Ď đíˇsŢőaĐŔĂGĆ Ĺ(őMóúŕ TBAóĚóCFq‚• ko€’ rßvŰjIşUřÍ›1vŇ\kŢ`"1{yF§Ďi¤Ň˘ ·i¬g7‰iűý®ÍÓ™‡!ś+Őé8ŢřXKkq›ä‹-c!tŮĎf–Ľj€AD ŢźžýříÓo=˙–¤'@=¤'˛ćŰ<€íz ©*´y“^DđCŕ(9ż8Łžw´‰I±™&¬n,„§0üť˙egjĽ„ńRąźĄ,@°Ô÷ń6:}Ň’yŮ/ & Rv${×DZšeS.tĽš˛Ůr{Jó~:­şh¤ôáě™î7ZaK»G*˛Ý»ů&7Ú…řÝw0äŮ” ×fĂIT!PG-ÝmNd2ÁvI±ŇÁšÁtŔ+v^MCŤ¦lź€Í6HÖět˙«čAőŹťOB•łň‡ę&ĂĐ®‹Ý´Fě\ß2Ůpß\vÖCÎâ „ëŞČ^ŮhCăÍAX«Fb({ŁG7/x­Ĺ“7 sl#Ü÷,cŃĄ§yĚĂŠ< ÔěőyG{™†G<żş>4k\lV'š'Ż.†8űy°ĄÁNĹDž˘ńLABJÝ®‚ęມ ízn*÷Ý``óçS›ł„yjCkĄ6TŻ»:Éq  »ĘÁ»Ĺ«c”Ł€rĽ%q‚Áɲ‹>߆YŞiŁŁÍ@ůó”ĂtÎßG9}‘¨ ®cŹ‰ĺˇăn°o}Ś*Ç8˝ż›Ţ4Ž GŻ ĚŃPÖi?fćxËTŔţl•ä‚ăÖťN3P.÷úU°SHźŘĘL{H «±K(ěˇG˙ôČ­‡uq;¸ř¢qňMéĎ©›˛ I`(Ă‹>ĆŔep°/žśúۢđkેĻ_!ÇxŘĎ®ÖRńä'@Z4ÝÔŕz%Ë[Îň*µ¤”~¸*hăµĹÁžŤxbś‘7áúoä$qŻ`,ŢbĄ2MîÂݹҧŇĎÍŃe´§P5ęN<.<>u‹Ë‡áĘáâ¨1żÚü˛í6©Źüo¶čÚ>tçp@ §•‘p„ţ#wçłłźáďż‘‹d§endstream endobj 574 0 obj << /Filter /FlateDecode /Length 2641 >> stream xś˝]sŰ6ňݡ/šľJ#–ř2×δin.7™¶çčžâ›-ÉkJtH9N^úŰoE€¤d;ť»qfŔ~ďb?>ĚňŚÎrü ˙Ż¶gůěúěĂu»łđßj;űiyöÝ9Í9le6·t¶Ľ:ówčŚq•QĆfZęĚr9[nĎŢ‘ó93YNsFîćy–K®inÉ.Zoć ÎE–kJţQć.ç ¦•¤Ć3<łĆźü2§ŚĽ|ťnĘv pĂPŁLŔ!­€Kí±/˙Yţ24懙m€§ĺúŚ0=_ţq¶‚Î>(…ŰďČŹHťÍňś“U®…â¤ŢŢ:đÂ0kIdŐ;ÔW¸4™–ěßGç}–G-Óđ[)˛­q ś IÖ©Ôz†Ş6€5‚´±Pę9޵Ś“űÖÁě°úĎĹ>0AUúˇ#@3Ň®bLEµ W$Miř*ů•\Ú·\.I«>9Őlŕ‹•RĺŠ-~±Vă‰qĹHÜW–Tĺ r FTÁMž[Ű©0Î…Ž—ë ˇH›Z_żn÷ĹÎٱf ·˛¨ŞĎs´Ę3),›-ßś-ź˝ îÚFýŻk0Z)A†Ôń>Ŕń(M?lÂľ”©i|Ú7EwEŰX—M± G˝Í§ŢĐdó…ĚŃD$Y¤čŔiAŠŘŔÖN’s¸\Î)Đn9ćŃšń‚U™3—Ö‰G×ŰDËEŐqĎN›LŽZP¨ćo(g—1ŹM=ďÔö±<ę m ĘrŇÉ*פ݂Úü9Ĺ”bš4á8ÍI«ŚÍ? $h¨÷EÂH+˛DÁ%2 Zź¶D&K®Pâ §I¬ ®`(Ü+bçvĺu¸gDSšÄr6!nBL™˛(`źfQí‹ąźś%ďc׼sŠóŔđŠ™“«íďU˝*ĽIćMâo‹ţŔÝíşŘo.đŕeą«›íóţ\»rÁ§űů}XRNţě—ôb~đL9EB±«?1%z€MHâޮްߝŰgj꥖üŘ‹ŕAdDQőÓĐ{”,·öI"HT®µWÇ®În‹¦fÉŹŻ_"7Âý¨ęk°ÇÜ›ó ޱ}OÚ:˛żßš ňĂË÷eű!XzŞ”ýH˙@7š&ˇyĎąä=RLKX&{-˘%Ť´čőh IĂ@Ňú°®žgĆâ Ď°!ŃsŤÜ*Ĺ;x†<{öě¸á“ "ă)"ä_jL „„”]¨4UÁ°$¤q~vé 1śqۆŽĘ%w\1s>Â2`'6>JőéĚ"ů…™·ŔBŐjČ ŇĽ×ˇ„ô6.ĘE’á6[Ěj/ŕ®®HS.j¬űĽĚ§śAކšj ¶i:)H5,„Ł$6M¶ÖZ¨ŽŐŃGóá&ŕ¶tT?y!ŠľĘäâD•ŮÁ‘侌!uyp\ŔLÔÂş<6M?'ËF˙ s%a©Ë̶ĹMďÚÂČS$ĂMë‡Rť®Ł•fPtEý!1ö¦…„U‡Ň,ÁĄ@ŚfT  íh9(K=Űeđl¸<-©a ˇ„gĂR“ue'::(ą> 'Őd9SUI% Â~T`qęJÉbÖ‚b>Űßöbü)0µvX•ŚOqHÓŰ[/I5™2‘ĐY€7RŽ-Žqg\ďńjÇűP$†¦ Čú~hsŰWI,č÷'š%°f öň+’<š †…hĐô¤ đö¤$Ĺj¸ńáîĂ;g—:ç©\E©ˇDýÜ !ĺ X‡ &Ů Ť'I­ĆńZ;ŮÁŢ©%řkůÔŤ/n©µÎńZ‹‹ŇćľŮ€kËÍqU~,ű°Ě7 ÎU˘µÓ>+-o%9¶RŢń†xOé…ů;cőtH¨c‘Wî‡×±?–v6îËö r˝¨› N­żDÇţR®Ďqé:1‚*ňy*ąŕ)đ\ý¤§Ŕ5€mÚGwŮ\#¤SőDoő~Ţ…áéšĐ@ÓC- ĘĆ!Mrz¬ç‡ęt90|ÎÜO°89¸kťQ(8öŚbůÜ„+ŕ’1wÎW¸ŕBM‰ÎşśA*Ż±ťč.Ă‹ÔU8®W…K5Śś¨ß7ň!ŹvpčDÚ€Oä•]xíd EBBb¶SQ±…uî"†ź(>j‰ň±näáÜÖ!¶iáăâŚÂéÁ8íÎ…‹FÇíäH«iÎý îëżĎŤŔ·Z%Ѹ "›Ͷnóz$ę¤iÝ›—ăPůüÓa5Ě×FůsČ×Ňü*Đ./ő’’n€+«Oĺ÷©ŁŤ ŘřúŐŰ/â°˝ů:±SůŘ‚ŞKą]=u!Lůk—‹Ţ$öűîťÔ?~ŃĘۧ‹>lëöpKŹŹűŠ ÷čą÷P7‹/Sů5wăO'_îe} 䥴öŘ:íÔäé#Ł‡UUýž t2{XUŰ‹¤—¶Ă^îó~ăQ# Ľő|ŞŤýí|aDž“u±/ú>¤­ďnŁ6ěż˙zv˙ľ}Úi>{ňżŚĂŃ+†´Z&˙­ţ§Ç2@}$áXmé¶ďźšËó˙žËhဧ3ÇĆ0RË©1ĚdPGčÂ;sĺď> stream xśí}Ko$Irćžë®;oJ.ÄTřŰC+é ­vatPw{čÖÓOjČć4ÉžÚćÇŻ™}fîćÉd=X˝łX`¦1¨LŁ‡‡?ěńąĹg?_lÇp±ńúď7wo¶‹Ţüü&ôB˙ůćîâźŢľůŰ/z Éqßöpńöű7¸$\´•vÜSąx{÷ć¶Ë·˙IŤĂ––Ö[=†¸Óoż}óŐ៹܎[I-lűáî2Ňő=ĺ—Ţ^?Ýüiűá»Ë«”ňqËů𛛟\łßńâqßóáßî/Żb?nˇî‡o]ş–żôĐk?Ü>ňé¸mýđîćéG|Űk:Đçó×üÇŰ• •eBµ·ŠůľxaÎÇÚŁMů÷®÷ëodb™ÇýîU·ó¸WóĺpŚ!ëéţłĂ„–Ő¸ľ˝äţĺí›ç K?<ňvĆÜŽĄ\Ô´÷#Ť¨óÍk¸(ąëľ_<|wńż.~z“é†mă;ÚŰĄ˙˙'iĂ˙¤‹[?†ý˘ö´{ľ¸#I/t=Kұ–‹[’ěô©ł¤seIÚÂ1–ěÇŘ ŮŹŻĘń¸A*é K2‹%1kf ýĐććH’˛cI&}ĺ« m;®˘Ö´R$ˇů€?đpJ?Ć.’šŽ‰'Qi»HZŔpč/%@B«ĂWŐJ *’^y‚$éÚńžŹ‰/˘‹7é&ońxÄŤşiěĽN$±nrhÇĘs d´‰ĺx}Ó™gZËŔsčô/ÚdůIŠ®iÎýXx˝z.ő(ÝěGŚ¦f^ŰÚ÷ČkÄiăkhä1@˛óÚ’„Żeuĺ˘ÎbÉ^xč•ôáĄăBÓl•%ńĺÖ…´$–Đ-;$ť·$…·%‘– ˛„šf“«öc‚„´›oEÝut“w)I"kKh–¤¦$IÖ†ć)à ņÓ"Ż-IŞjNˇµŤŇ3­V†¤‰Ţî4P MT†vU‹şĄcćIDO d~<‰ŽµBŇEo÷ą-Kh˘|óHŽEV°’łĘ’"¬¤ölF,ŮU»FŰ™J~´6Hú%/“ú"!=cµuW±éÍuÄ˝‹±$‹vUŢë‚w`Łm :‡ ý4šgĎ't§ŃŞÔ€µ€¶7ň)b›Ü«Ąr XdXZŁyö€­)é–Ží«č†íR64°±„m®A/®˘‰Ęp(rT´éAĽŘN[őo¤÷)AO+®Ú Ö妚Űi˘<žÎ.Júé¤X%ÂjŞ,j§ &XZÂEG`ź¸U§yŠµrě˘=Óꊄ¦'‚`GUî(RőCUŚš}K+p^÷n™Í›\^1IŹbG=51Ű7_wUAž_ă9đf±€Ť.óhIˇ^ĽÜlGť=$4Mňµíä 謶Ťf łł˙&ů;(öN®™öŁ6ň¨č&I–R™mU‰ Ş6˛lď^›h-…¤c–mŮiŐh •Té¸ăÖ4I¶!ÖgXŢľo<]RyŇđI#Şi•ÇM`Ih¶bhq r=™ŽÄ–°ťŇUÝR‡d—ńR.™VÜhiIŁk¦‘îč™c­E&ťßxEż¤úó›^i©¨˙">Ł_/¤*úĎűg˘ ±+Ѩ{Ç73 ßäy«))Fö%»@ěĂl5$®U „łŐ¸V˝ËÖąVC2[ťŽŐŹ~¶z\$ĽvŃČ„7rÇ/R´¦@I7#Çł“Öhüęp•.ŻvŠnépőS9\…Ë+‚.äÝĘaŁŹ… @:„‰p®)´ĺ´9wS2ć—g[ml˛&XUŠ5äýf#,ŤíPtmđ}i˘mÜ>rĹxµ®xŮéxf‡N@ŰnKĆkҨ×^i©¶3ËrµöăÇ0vŤpSă]ă°AŽ•ˇ~řSdÜ;†ą3v#PÉ«DŠ2Ě/ľS OFŇK:|wq{˙ĂŐíÍď.9¨l)ľ»˝ůńţţŰ9ţ˙xČúY"Í)\P÷e#Üô4Žo?„dmiíÉ69x$Ű*ąÜě‘l#6†dů0„C˛­÷$ŰhUöČ’: t KN QpYŠP¸É’^$#ŢD˛´öÉ2¨Ü$›F˛ŮúPv€ďe‹Aöei Δe YěÉRXiiA˛„ÚĘî‘,-2pဲMĆŕˇ,Aä(KłSđmX–"f Ë2$†Ä°l§żŕć†e'žXvÓp:±lâu[°l±žËÜímÁ˛´{]±lP1±lâĄ]°ě@·ËVn{‚eÖ<–MíËćgX6?ò¸×Ŕ˛Q‡ě±lŢO±¬BÎ? –ÝO±,č±,ćŕ±,ćé±,ÖbbY[ŻemI'–µeźXÖ¶fbYŰľeÇO,kj0±¬©ĘIJ¦M†e§Ć–ťZ9°ěĐ\òCą–0°ě0’e‡! 0;Śm€ŮaĚŁ`vŘőłĂöť0ŮŔ¬ąf‡—`vx"łÓ[)šťMŃěôy†f§_48;}§ÁŮé_ ÎNlpvúiłÓ—śťţŢଅ„fGÔhvD–fGôhvD¨fGhV#ŽŻ46’ʡËÁ?“đň”4°o¬»I^•6ŠŤâBcĐM¶C™đcK 8Śţ•łYäC+»IŔđFźXç ©V€¤@É YŚŘNl¤8¬óef ©[äŁ퇜B#iXéŮ™uôÓˇd„đőčĐŘDŕeśńb'CăáTŇU9ŠĹÎY8ší4<Iş §NŔžő(9ŻÚx7ц&ë|““lěYŽdt@Úˇ©$ŮĹU7Ś" oÉ ßŠžŞb'oÉ ßj<˘ÓqxăąĘęÉẲ©Ŕ,@Q#çxDáY Ąv&˘đ䊊̑ݔ(<Í #‘Ż˘™ÉwÚyŃwN•JÇ{bÜÉĆŕ–ăNf‡Ô]WŐÝÉW¦‚´\ĆUäB‚:şĄ9ö߀ŐÝÉQ˛¶łÁśvZůáu*ĆKţc_•á:ăNłěęÎX6ň“ěĄ9é•ŠHH3d,{‡cJăOÍhIţŹ$md$©¨—ÖcÚČQ"hD.ÓVDźH’9°‹¤kÔhti#m.jD@ó“ qź˝’~ÝĹt8ćEtIŞž5ľĘé4r‘±şhšBłµ—DÉ^ř«ČÍĺę{&<)¦3ďNŽýŠDĘýđO‡U˛‹ľňĹL đÂ*›O<˲za];5žÄÖa“)đI!/ˇ mO4&†R¤ż ”ec—‹"ÚŞńL¶ r”OČ‹JD!É(Ű5‡"ÍSÂůQ(I$o'ş!ę¤H±%#.…*ŠG‚dÉ:#FCłëa‡…{7Î9KЉč…¦Y´ě‰3¤dNą@’tX'+eâi“ŔKfŮ˙J´ĽŤµ™—ŁD$ŰDëéë.ÖĂ‘j”(Ißd]â#;{„’¬ }bŰ2ľr>ś]SgmAgs ßeꜸŽ.[°>ŘJhťŽř;g“Řk6 Í$ŮcÉŃYR€tŇi‚_+9<ńL)s˙•tB.6eš^ăŽ9á'cÉiŁ'żÖTŇE[ í™xč”Yť yšŽ4˝ĆÉź´Á9¤LÁ-KÚt[éŚĘŞšYBŔą#Îý™b©3ů>v嬹¨”IŰřV'ůˇČgAÚîWä‡(Öá8:±Ś¬¬ůˇç­¦Äekşo¶’ŮŠüYCžw׊@ĄčŮl5$®UâsßŇ׸V'3ňsü¬,aíK‰üůĺUŚ /ű!ŕ 9ž¤3˝0` «W’µ2‰ËŃśk•;’†,­řđµ%ßJ%K«ĆزűV*YZŤÔŃhőąŁČÇ6ÚčDÜQ(´8 R8\NłŽ‚‡sËô+f‘(4’[ĎK)ţ)-Y¤Čyp`ţ˛H‰`?)‹ä€­l9ę„Řę1ŃŰŔ°Ă[ň>@bŘĹ:Řn|’Ypí·9q-a•-z\KĘÓňŠk#đÜ€µ­ŕÔ8a-9Ĺ­­°vS„7amÔáMd›Źy¶|Âl ˛Í'ú‰l9CPhK±g+ÚrÂ.,ж7ť·AŰ´­°m‹ÁÉm/ő‚m˘óĶöčÚaŰj0z`ۤťŘvă /đ¶âŔěŕmÔYLx‹'Ě şĹv:t»•Ý& ‹Ý",zt‹6ŃmÁht ĚáŃm,ĎĐm:E·±Ý‚ü˙ŕ¦S|‹I:|»źŕ[[«‰om=ľĹ’O|kŰ2ń­mÝÄ·¶˝ßš L|«Zâđ-ÉÁ[Őµ‰oU'ľ5•ťřÖÔzâ[Ő|‡owCĽ†oÍ‚&ľ5+›řÖ,qŕŰa­ß:Ä«׬~B\ó âšó×Ě@ąć&Ę5?5Q®ş2€ÜáęĘîp˘\s™ĺš[ť(W=ďąćśČţ{€Üáăr-LŚkabb\ %†qG´wD¤qGԷجgÖĚq÷ć@ˇJN˛F4ĺ(1`‰ąĺă˛F94hWarOˇŰdĆžś$fČ/ź$Đ.Iw‘‹¬rtČ8Ëç¸ÉÉ_ÖPÎé9ˇÄČ:ËĘ“O7jŮpş§Íž mWF.7ÇLK*mĎ‘Ľ;h2|d5r,HZ7cÂd]E€b“#ź,*ÎY˛96<ŢhdF ’Žś5§#ş!{—ÇŤśE?0 R˙Ť3¸$aHŸb<ĂĎäĹAsB%'#*ÖhG*®˘q$ś6ErJ&%7žIĹAł'\Q2Ĥ®*Ř‘ ¶ějN4IIgŐäśZV¶zRm¨Ă‚Ž6üěT˘¤ş’4MďzóĚ9ń´¤ęrćG˘ i!9EdÚNdI­q/Z?¸Ds›tšŠ‚¸V9ĐgúßŃč"2śĚÄŚŽ»äH‚|5ť"$U‹$ď:&‹—'-vČĚ™y\áÓĘ;Öüč:y?|%—­âQ‹1”r VfĎ-2?µîČń˘d?VD8ÜŞ¤¦ŹZ”}”Ůúě$±ˇ M´űřšK•Ăů"éú¨e\Ť¶şôLíią;§ó2@r•i™DĄĄ®°‰VšhÇZŔřlW‚K¬eáěXSńO$éXt9ie~@Ţ6:Éd’Üń ĄCB.Qp;ňÉ®śˇ*‰ ÚŢ*NšŹĐ’ŤÍµgĄ ™`&‹¨mWZQ¦Č0Ă/}k⤙(°#7¶.ˇ 6µÂĆ …gŔÜظšfLqQęxţkYŐĚA,kć>Ş1¤ąŚůú |ˇŞĂĺ‡ňü—ů "hŔĺśÜ‘[×C*mÖŽí˝!sąJĘiG %Iah×ç”Vđč>w<ËŁč[űÉ8Ö&eŁe|śo Ŕ2?ŐaLŃ`¸˝’WKńćNµ4đ‡°ţśÇKY'¸Ť@.żáŃAf†CQ~ę ;ZÇŇŞŃ…SŹŚ' ?łĽpČ–ĺĺÇôY6 [8–eOň ‚ô±é–ěyps’?J| Ü_•?˘˛‹w!9óÓ±š–üŃ™VC230™q kŢl5$®•<•ńŮś)q­gË= iJ\«“±úŃVfÇ]ŘŔ}jDś bęD:$˙…vnć váN¶.đC%.s¦Ő¶ ,*YZ•,–ŕZ©di%Ď—ľT˛´âŢ–ľT˛´ ¤Ńę3HĚ Ů»l y|K E!d1|Ř…|D‚ĆÁĐgއ_›AĘ Žö•‡”ţ”— !w2î_'ô‘hö“2HäV \ä©Č­@%†pyÍăŠpIuŇp ť„´Ü¶©G—ť¦ŕîz(—6DŁ’\~Ľ3.źŤÚpSVÔ9.޸\ŠŔµ-—\7bń¸-ŕH:.ÁŮrpwC•p©mŘ=ŔíÔnÝ.7mŕĆÍđî¸M±˙¸t‰p퉱C¸ f‡p•ţďîn€| \eřN„«Ôap‹FÍp»5ř¶č†{|›źáŰROđm>Á·qhÁ·€}߆x|«8ů/řöŐřk1ń­­—Ç·¸ŐŔ·XtŹo±1ßÚś&ľµ žřÖ”`\Ó“ pM—&Ŕ5}Ŕ5}ś×Tv\ÓęoMď'ľ5ŰřvŘĎÄ·fcß;řvŘęŔ·ĂžŔ6ow:¸Óo „;|‹!Üá~Â.j ÜáĆ®n ÜáÄ5Źi w:UąÓńČťÎŮ@îtŕä'Ż wĆą3VĘťńDQî8†rgP2”«QË ®†5ź>ĘL{\ž<ÉIúČżyoÂëzţŘé˝”{ĐeóľK…ÔÝ Ë–6X™Ńe çbÁĂ[¶D®ŔylŮÂHYéĽ`Ë–ÄG~_řUŇčXٲ%e+yS¶lIµńlŮ’HyPç˘tŮ’l·Ś.[2'Pşlátbr…_%Ç#1şlˇč¨%"J—%‰•Ô(]¶Ë×* ĄË‰ ž.[řä‚! ]–%¦ËF—-'.&[¶d3cË TX°e BkĘ„-KÇŞh[`Ë’¤č¬ŠžŽřY=ƧlŮÂŃĚNeËÎ^*lY’d¤źŤ-KĺJ[–$MëX”-[8ji-X[ 9ľI•ĺŻZxŞ, 4kTŮÂkQެH0:PeE u` Ę’$)·Q©˛^ެż TYt쩲¸ą§Ęʱ/J•ÉB••Y_öE ˇ DŁĘbiĐF¨˛˛zÝ€*++ě«ľ +”Öo)+ŰR¦,Iś«1eIbKŞLYŮđ aĘŠRh0eIî*h˛˘Gľâ«0hA"X˛$ĐŁ¦±dE=Áx¶ň6=!LČ;P±A^B@z§yŁxB^CRňk3 o[ ÄĹĄńîz¬pW8AŻ Ç^ űôúú0ŹM˙߀^ Đ^ĚÁ^ĚÓ^¬…˝§w)s‹>AôÚćMĐ;Fc w(Á˝CQ&č5]š ×Vgâ^UÉ{‡ÖîŠ=qŻęţ€˝Ă<ě&4`ď0ł{‡)Ř;ĚuŔŢaŃ÷šŃŘ;ü€˝Ăw Ř;üË€˝Ă Ř;ü”ÁŢáĘ öo7`ďđöŻ9`ďđ¬öďk°wzh˝Ó‹ěťžŢ`ŻzGĽ¨wÄ”{GÜ°wĦ{Gü¸WcÜąâ°NŠ¤” ŠkqŘ«ň4ơťyăĐr„ĆŠ‡¶EŚYphËV´DŇ8´E‡ľ8¬lĚeB‘8´„ę6%»*‰¶P"'‰¶PÔ±"3!Ń–`ĎćŤD[Č•©,ÚBšŁ«Ż,Úą¸ WE["ëÝĹ$Ѧ9W\m‰%ő,Z (j¶Ć˘-ŃΫƢ-q/8¤‹VRTJ‘má§#ÉžEKş Ücц |X°h ?ýŔ"+‹¶0iNů°`Ń*IŞeěŽQ­O,ZÉkeĺŐv=ëEăĚ‚E+'Äî‹Ä䤙|‘¸ ¬»Ňh%±•p•$&ä° ŇśŇh ŁÔ)Ť–|á¦T<ĄŃŠż ľHLň YĐhÉëú 1qÝMëÁÄ:áđµf¬kŕČ%ơ•ôIE Î3ç"$Ú™¦1íŚsF˘ťą&#ŃÎj$Z/‰Ö_­ëYI´îîJ˘uĂS­›‚˛h1Mq…EëVBY´nµ”EkË -Ň2(´nK”B‹mCQ(´ŘZéU)´˛ýÍ—ACp(´˘EPĺĐŠ¦Ç ­(ăî9´Eé“C+J]q+áĐ"h`4ŕĐŠmčťŔˇ%űi0găĐ’Ť™D9´b‡ĹshĹVÁk…VĚąř*12yŮ$ĺĎŠOXJÄČmt»üYq-XsđgÉűDř,ăĎ.Ă ôى ›ÍqgIV»5 -ůB«ŻT m‰äa”ű F"ůTőFˇ%ż»ëę)‡–|s˛ň2¤'Č}7ĺ+‡VŇţ°0ćĐ–€GÇ“D[!|ˇXa"Ć"ÚÂĆŞ4\phË–őśqhË­6N9´d(AsľLě9%ŠŚ‚”gHNl ŰšSzŢjJ\†‡s[ч÷)q­všU[˛XC2[‘o‘źpă×*&ÁP®Ő¸V¬Ŕ¤O®Ő¸V'óö+ńYů)ŽłäwÖü”~ŇXQ@¦_ú!éÂÖĚ:S3U8¶hˇ—J\–ç\+z™dmlâ[A˛´ LŹöh&YZĹ"O*]+•,­R’ß(q­T˛´b伔Ľ™di5Ň]ŁŐg们Ťźô`ż˘l#ęĂU˝ĽÚ?đÚů§¤žíĚŻ™đ"ĐCłű„×W‡§ďî~˙î’éÇ×—Wu7:˙îd4ĎęÜ~ŤTŘG‚ńWŐąQ€'Gľ@tSŇ Ń—·Â üŰŔçUĎĂź÷ŞÄÄçś[Ş+>ßě ź§nmźł›đEn¤ö'>ÇAh‚s%48pľŮo9 t^ Ut®ĹťëĂš‰ÎíѦCçŃzčĽÚńAŃyPRľCç›:ŹöSťçcZÁyEo΋î‚ç›/q“3jŻ§ŕ«ăÁąĎ9p^ü/8Ňâ9Îă)6Ďĺ›ăŃŚĂćč›g_âölţ›§ĎĆć­|6Ź§Ř<űň6·ý›‡gŘ\ĐÁaóSh®Uhš+zwĐUhšc&4WËpĐĽZőÝ€ćjaš+fІ꠹ڲć‹:7źŕĐąş ‡Îă :7ďăĐąz(Ďíg<7Oçŕůf<«3ŕy?Áćęs'67ż<±ąąî‰ÍÍ˝+67˙?±ąĹ‰Í-Ž pnˇf‚óĄşm+CćĎη-PV$§Y/ŁŻÖSš?˘¸ŤĆ$ŠiĽ_ÉzíN©żäôČiÔ_:‡4ăă‚űK'«¨Pî/ťf–ݸżtâQs6îoú-¸żtl˛rĺţŇŃ**yP5FŇ^Ć3ťi/ăţ"í…6 ˙JÚ«BňŻä˝’Ňw†ć/ůžÍ*ŮŔü˙ď¨ĚßÂŘC+ĚŔü%?gţ[™żä ÍĎ)ó—üeb3ę/ůÔ¨%ÍÂĎ‘ĐŞé?Łţđ,.&őWžZhPĺɆVÎ ő·p+ó•ĺ9xZ3_ň;J„L8iŻi°ÎOXwMé_ŇńL­mţŽ_Ĺ1‰Ď÷śiĄj&ń­˙ßĘ$K+>·ää[©diÉăˇÖĘZ©di•Űľ´RÉŇŠk8—Z=“,­Fćk´úŚĚ—Uáqć‹N|Kćkç7†Hć+0˛ÜÂ’ůú0d}E?S&Ďłdľľą˙ééú›§?ÎTŐăšń˛şĽ_#ăő‘@üUuyÔ§Ľ®aâó©ťźG«ôř<+“`âóŞ‡Ţ‰ĎůŚćkóČ +ł}âsrľZegřś2çü+¸qçu”<ďz€uđĐ·gĐqÄđ»żô?#@Ç’{€ŢüOO¸­ó“ô*ŕzőĄyN“á,qBt5Ö‰ĐÍžB6?ş9…‰ĐÍoL„nľĹúp?ˇŹş;CčĂŤM„n®n ôá'B7—9úp«ˇ×;úpϡ›}8yč3 €>bĹč#ž €>bÎč#.)@w±kô¦Ż#z^ ç-$§)°O|7`ŽB’X˙?n~đoř{ŕ—úEţŞ|¨wyEţůđĄŕÍ7ţÍ}úJľť3ô‡G˝4”Ăý÷ü™ůŃŢáG»ľăťÚýׇźÖ?Ěž~串_ßřőĄöLc1PŇ ””~ňNÁ˙ę@~ ˇöf/$Ěíđ­v•ęá{×ëQvRŚ‘ß2ó§›űźôňRi.Ź÷·7ţ‡'ŻĆŇ÷ý ?®o|¸ľ[Ć˙´|{xÔËzY^.Wî›ßčÄě[r`x â÷w/B\µ!Ę{»˝ľđ{÷ňÂ9Ä|îý‹• Kl|ă+ć™G2Ľ«Ŕ'ŠeŇ×»›“}ĺ#]¶Ľ˙ńúéúČÚ•ř9ěáż_?ţř’.|‹ö\iOzé’Źzęliä﹪îő“ÚĎŢ®ýE¤ŠßpC&5´Ăµß4˙ůá~ĽóßÜ]‹zĚż>j-é˝Ţv{ľĽ"oéšÍ÷]5›‘!©đ˛µżp?{⚶÷iö%«-©ĐU\źĚőú…eeMňúíoŢĽýŻ_ţ€aÇ<†M*žlý±Ż×·ö–Đpříb Źú^Ń?Ľ—Ú×ÓwúQšűÝ5mŔŮ×—Ţé‹EI±muů˝¤ď78¤Ĺ ~űIůD źxçU˙ńx”3’Ľ_+ě¶DoO´ťóxôU÷ âűŰŰű1‹wËBü@WDţEĺ±sXÓ…gŻZE˙ýTaŃş¶Ąů//éĹ:/ít+Ď”7#ť?+†˝J;˛×ÇuÁe˝c:ĽűIg™«>“©ž XË[aĺ8Š7č–‹‡O}sn*Ť'u‘Ńń[6•¨vűÉýUyĚďş#ůăŞČ ,ŻQ8aŐXM¤+Ĺ5$?¶­±ýúćáöŹÚj'%»9±ą†ĽÝ‹ćć‡e¦t‹ßb6•|ĂĂ©ÓŕµéÔič4ŻîźĎÎ|Z=ő±ŚŚŕÔ˘đŰŃŔĐbĹ Ł«ýđożů×ŮöŔ*÷Â4ěŽ%Ţů8d ä'đxŞ(űE( &…!ČOţďđW—Í 7¸ü«’™ŠGţA~ ťő〟;‡_H ¬ý˘ż8myřĂe)¤qŤ®źž]Ž2őeU»yzü{35]oq‰|ž.I*'ÁăÖšmNJůô×# • D±ţZ qÔŐJqyíőUÚ.®ř챥+öĹ?^^Iđ%ńÔß)Şh?üýŐÉźżf$ů7*Ü ůˇ»ß~{Íß‹Ů?čGŢ1ÂľĎPżßﯾ>Ü}˙p˙nŢp\ß|}îNéëKס¸ť3]ŢŢ?}='˘śjÍXtđB(-úüPäç`8ÍÉ ?;”ů»ćűűęđ¸ş×Č”P~‹:Ny“fZĎ_×Oü‡ř’Óţ¤ł“Ü îŻ=;Efç“7ĽyÄgĆ{g\µüéý&‡&É9äĄÉ©F¨ĽN˝N¦LéÖ…Žy«ď˝ť§TÂ+ëźlŕaťůíýâ+~‚?ť×âYĎpröbT ‹ŮµÎsśjĂlšçÝýăÓDŐ/<5¤.ßŔňűş)ĺüĆ”"îwŠMůi­xŔ'|Ţ÷ô, mę‹zřđpF9+EzńZ=ä!Z#l% b…Ŕ,-91<Ăsčv˛§—Ś%z íĽ”-Ü A5š ßIÎŚcNlR8ţáŘóüř—´=ńL´ŁU<âeHőpď÷ô‰Ď?Ľ>[<=˙ŕÖíđµť7vľŹ'[x6†§]^¦´Â_!©đ‘Q<ô]¸tůoZP~ţĂaś‹ë ó×ăž˙‹öś»kÇď,˘ÍÔ›—s ~Ç9w s®3ŠÔôŠÓü­4KŃ4…׹ČTČ27VN¬×¬üBż”O"°:š\łżřäĂ'c{§ť'ľ^`ʢDż¬öţÜ™đ=™ŚËŰ‹ą$ŔI.iööÁÓ«Ťť;µ»ŐrzĽtµ\ţp§z…Ż'ŞëAËU–_ŮídĽÎŹN¨ăĽžŰGÄ*ˆLč-Ó ˝‡RuŔĎ’HÜnĎ’l'ĐăĎ€jąü¤# ŕĐ>9„˝úţÎśBŮÇä.nŽ?KĄďŻ"…ÔŹĎś9§=Źł\€N8ĺćÉî—žgpë¶&P5-Bšž§E"űj[÷p ˝±âŽkýy)ńhÖuhQÍ ’»ŚÔ{đ}~br÷ ~ÉÓ‡ÍLŻż;“Uý>IÔ1l\…˛Â†ëĹď-_–ĂÔő ŕ8­m'éCBY!rýśĄ_.ąf;ÜOŃFý$˘Ţ?¬p ÚzĎđ7´\@^íöQ\L“3ď‡gLo 72CčâĘŢ—Ż’٤ř,ă/ËÂ(Ńç˛÷ö—OÖYµô§roő\”ŘĺĐţďwĆŃ˝(ź=Ô‘Łt\=ááîzŃĚSkµÎ˛}|šžŤcŹš†ĺ…x°p±üs8äÔ¤xŹ7w7·×/–ON‰ĎNĘŃ•é|úÁŁ2wďć7wPÎW>îDľ»ň‡jͤ|ú±ÚŹ*.Çęóçôy¨ŽîT­„ź˙Ž¨endstream endobj 576 0 obj << /Type /XRef /Length 382 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 577 /ID [<9efc4441522992ea1695bdff99caf000><40fa170ccfdff539d74310e07a174748>] >> stream xśí’Í+DaĆď{}Ť1cĚ4× Ň”Ż…Ĺ(kŤĘG˛%+ E5Y)  ŮX)5ĘÎN¬l­$±eA%Šâ>?YżwńëtŢ÷<çś÷>®ŁĎ5ŽŻŽ«„±´ü7Ż;ďÇĄăňŇÝ‘ő’e!.j=Ůńýs±iýcY¸‹:fňľ‹Ž_¬‹, wŃ@»\tĐf]dY¸‹˛éĽǢrQV6‹MÝb`ELÝŠĄ‡bÝŞOÍ+ŽMr–t‰ĺ#b4#ş×büL@ }ŠgđśĚ(7‰'Äđ.:=č_ŠćŽ1ˇf012ńl«˙ôOQK‰µ bń=ݧ‰—Ř(„2sš!±Ś Ă}d ŤbQ–›űôť˝~u÷®'‡ĹšyŞ’lTK-j¦^ĎÄ{¨ńbUlá.Šą âwŢ–|hNúuUT=Á4Űń2Ţ2űöŠ‘Ř)sbF˙ČĚ®“ˇŞ÷›—¤ÖĺO™zN߸˙@Çv˙bţ N·ĄÜRÜşćüޱK; endstream endobj startxref 404358 %%EOF ordinal/inst/doc/clm_article.R0000644000176200001440000006151315130020361016022 0ustar liggesusers### R code from vignette source 'clm_article.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) library("ordinal") library("xtable") ################################################### ### code chunk number 2: clm_article.Rnw:742-744 ################################################### clm_args <- gsub("function ", "clm", deparse(args(clm))) cat(paste(clm_args[-length(clm_args)], "\n")) ################################################### ### code chunk number 3: clm_article.Rnw:759-761 ################################################### cc_args <- gsub("function ", "clm.control", deparse(args(clm.control))) cat(paste(cc_args[-length(cc_args)], "\n")) ################################################### ### code chunk number 4: clm_article.Rnw:792-802 ################################################### ## data(wine) tab <- with(wine, table(temp:contact, rating)) mat <- cbind(rep(c("cold", "warm"), each = 2), rep(c("no", "yes"), 2), tab) colnames(mat) <- c("Temperature", "Contact", paste("~~", 1:5, sep = "")) xtab <- xtable(mat) print(xtab, only.contents = TRUE, include.rownames = FALSE, sanitize.text.function = function(x) x) ################################################### ### code chunk number 5: clm_article.Rnw:830-833 ################################################### library("ordinal") fm1 <- clm(rating ~ temp + contact, data = wine) summary(fm1) ################################################### ### code chunk number 6: latent_dist_1 ################################################### fm1_fig <- clm(rating ~ contact + temp, data=wine, link="probit") ## Version with arbitrary location and scale parameterization: alpha_ast <- .6 sigma_ast <- 1.4 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 5, 1), line=1, labels = seq(-2, 5, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: mtext(expression(paste(alpha, '*')), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta, '*'))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1], '*')), expression(paste(theta[2], '*')), expression(paste(theta[3], '*')), expression(paste(theta[4], '*'))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") ################################################### ### code chunk number 7: latent_dist_2 ################################################### ## Version of figure with standardized location and scale: alpha_ast <- 0 sigma_ast <- 1 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 4, 1), line=1, labels = seq(-2, 4, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1])), expression(paste(theta[2])), expression(paste(theta[3])), expression(paste(theta[4]))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") ################################################### ### code chunk number 8: clm_article.Rnw:973-974 ################################################### anova(fm1, type = "III") ################################################### ### code chunk number 9: clm_article.Rnw:978-980 ################################################### fm2 <- clm(rating ~ temp, data = wine) anova(fm2, fm1) ################################################### ### code chunk number 10: clm_article.Rnw:986-987 ################################################### drop1(fm1, test = "Chi") ################################################### ### code chunk number 11: clm_article.Rnw:992-994 ################################################### fm0 <- clm(rating ~ 1, data = wine) add1(fm0, scope = ~ temp + contact, test = "Chi") ################################################### ### code chunk number 12: clm_article.Rnw:998-999 ################################################### confint(fm1) ################################################### ### code chunk number 13: clm_article.Rnw:1034-1036 ################################################### fm.nom <- clm(rating ~ temp, nominal = ~ contact, data = wine) summary(fm.nom) ################################################### ### code chunk number 14: figNom2 ################################################### fm_fig.nom <- clm(rating ~ temp, nominal =~ contact, data=wine, link="probit") th1 <- unlist(fm_fig.nom$Theta[1, 2:5]) # thresholds for contact: "no" th2 <- unlist(fm_fig.nom$Theta[2, 2:5]) # thresholds for contact: "yes" ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.nom$beta[1])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.nom$beta[1], H+dnorm(0), fm_fig.nom$beta[1], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.nom$beta[1], H+.3+dnorm(0), length=.1) text(fm_fig.nom$beta[1]-.2, loft-.22, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th1, side=1, col="red") segments(th1, -.05, th1, loft, col="red") mtext("contact: no", at=4.3, side=1, col="red") mtext(theta.text, at=th2, side=3, col="blue") segments(th2, 0, th2, loft+.05, col="blue") mtext("contact: yes", at=4.3, side=3, col="blue") ################################################### ### code chunk number 15: clm_article.Rnw:1100-1101 ################################################### fm.nom$Theta ################################################### ### code chunk number 16: clm_article.Rnw:1110-1111 ################################################### anova(fm1, fm.nom) ################################################### ### code chunk number 17: clm_article.Rnw:1122-1123 ################################################### fm.nom2 <- clm(rating ~ temp + contact, nominal = ~ contact, data = wine) ################################################### ### code chunk number 18: clm_article.Rnw:1126-1127 ################################################### fm.nom2 ################################################### ### code chunk number 19: clm_article.Rnw:1131-1132 ################################################### nominal_test(fm1) ################################################### ### code chunk number 20: clm_article.Rnw:1151-1153 ################################################### fm.sca <- clm(rating ~ temp + contact, scale = ~ temp, data = wine) summary(fm.sca) ################################################### ### code chunk number 21: clm_article.Rnw:1158-1159 ################################################### scale_test(fm1) ################################################### ### code chunk number 22: figSca ################################################### ## Scale differences: fm_fig.sca <- clm(rating ~ contact + temp, scale=~temp, data=wine, link="probit") ## Exagerate the scale for better visual: sca <- 1.5 # exp(fm_fig.sca$zeta) ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.sca$beta[2], sca)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0, ,sca)+H+.3, lty=3, lwd=2) segments(fm_fig.sca$beta[2], H+dnorm(0, ,sca), fm_fig.sca$beta[2], dnorm(0, ,sca)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, ,sca), fm_fig.sca$beta[2], H+.3+dnorm(0, ,sca), length=.1) text(fm_fig.sca$beta[2]-.2, loft-.35, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=fm_fig.sca$alpha, side=1) segments(fm_fig.sca$alpha, -2, fm_fig.sca$alpha, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, fm_fig.sca$alpha+.5), col="red") ################################################### ### code chunk number 23: clm_article.Rnw:1216-1219 ################################################### fm.equi <- clm(rating ~ temp + contact, data = wine, threshold = "equidistant") summary(fm.equi) ################################################### ### code chunk number 24: clm_article.Rnw:1226-1227 ################################################### drop(fm.equi$tJac %*% coef(fm.equi)[c("threshold.1", "spacing")]) ################################################### ### code chunk number 25: clm_article.Rnw:1234-1235 ################################################### mean(diff(coef(fm1)[1:4])) ################################################### ### code chunk number 26: clm_article.Rnw:1241-1242 ################################################### anova(fm1, fm.equi) ################################################### ### code chunk number 27: figFlex ################################################### fm_fig.flex <- clm(rating ~ contact + temp, data=wine, link="probit") th <- fm_fig.flex$alpha par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.flex$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: # mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.flex$beta[2], H+dnorm(0), fm_fig.flex$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.flex$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.flex$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta[1]), expression(Delta[2]), expression(Delta[3]))) ################################################### ### code chunk number 28: figEqui ################################################### fm_fig.equi <- clm(rating ~ contact + temp, data=wine, threshold="equidistant", link="probit") th <- c(fm_fig.equi$alpha[1], fm_fig.equi$alpha[1] + cumsum(rep(fm_fig.equi$alpha[2], 3))) par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.equi$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.equi$beta[2], H+dnorm(0), fm_fig.equi$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.equi$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.equi$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta), expression(Delta), expression(Delta))) ################################################### ### code chunk number 29: clm_article.Rnw:1336-1337 ################################################### with(soup, table(PROD, PRODID)) ################################################### ### code chunk number 30: clm_article.Rnw:1341-1344 ################################################### fm_binorm <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="probit") summary(fm_binorm) ################################################### ### code chunk number 31: clm_article.Rnw:1347-1349 ################################################### fm_nom <- clm(SURENESS ~ PRODID, nominal = ~ PROD, data = soup, link="probit") ################################################### ### code chunk number 32: clm_article.Rnw:1353-1355 ################################################### fm_location <- update(fm_binorm, scale = ~ 1) anova(fm_location, fm_binorm, fm_nom) ################################################### ### code chunk number 33: clm_article.Rnw:1360-1365 ################################################### fm_cll_scale <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="cloglog") fm_cll <- clm(SURENESS ~ PRODID, data = soup, link="cloglog") anova(fm_cll, fm_cll_scale, fm_binorm) ################################################### ### code chunk number 34: clm_article.Rnw:1369-1371 ################################################### fm_loggamma <- clm(SURENESS ~ PRODID, data = soup, link="log-gamma") summary(fm_loggamma) ################################################### ### code chunk number 35: profileLikelihood ################################################### pr1 <- profile(fm1, alpha = 1e-4) plot(pr1) ################################################### ### code chunk number 36: prof1 ################################################### plot(pr1, which.par = 1) ################################################### ### code chunk number 37: prof2 ################################################### plot(pr1, which.par = 2) ################################################### ### code chunk number 38: clm_article.Rnw:1430-1433 ################################################### slice.fm1 <- slice(fm1, lambda = 5) par(mfrow = c(2, 3)) plot(slice.fm1) ################################################### ### code chunk number 39: slice11 ################################################### plot(slice.fm1, parm = 1) ################################################### ### code chunk number 40: slice12 ################################################### plot(slice.fm1, parm = 2) ################################################### ### code chunk number 41: slice13 ################################################### plot(slice.fm1, parm = 3) ################################################### ### code chunk number 42: slice14 ################################################### plot(slice.fm1, parm = 4) ################################################### ### code chunk number 43: slice15 ################################################### plot(slice.fm1, parm = 5) ################################################### ### code chunk number 44: slice16 ################################################### plot(slice.fm1, parm = 6) ################################################### ### code chunk number 45: slice2 ################################################### slice2.fm1 <- slice(fm1, parm = 4:5, lambda = 1e-5) par(mfrow = c(1, 2)) plot(slice2.fm1) ################################################### ### code chunk number 46: slice24 ################################################### plot(slice2.fm1, parm = 1) ################################################### ### code chunk number 47: slice25 ################################################### plot(slice2.fm1, parm = 2) ################################################### ### code chunk number 48: clm_article.Rnw:1494-1495 ################################################### convergence(fm1) ################################################### ### code chunk number 49: clm_article.Rnw:1521-1522 ################################################### head(pred <- predict(fm1, newdata = subset(wine, select = -rating))$fit) ################################################### ### code chunk number 50: clm_article.Rnw:1526-1529 ################################################### stopifnot(isTRUE(all.equal(fitted(fm1), t(pred)[ t(col(pred) == wine$rating)])), isTRUE(all.equal(fitted(fm1), predict(fm1, newdata = wine)$fit))) ################################################### ### code chunk number 51: clm_article.Rnw:1532-1536 ################################################### newData <- expand.grid(temp = levels(wine$temp), contact = levels(wine$contact)) cbind(newData, round(predict(fm1, newdata = newData)$fit, 3), "class" = predict(fm1, newdata = newData, type = "class")$fit) ################################################### ### code chunk number 52: clm_article.Rnw:1539-1540 ################################################### head(apply(pred, 1, function(x) round(weighted.mean(1:5, x)))) ################################################### ### code chunk number 53: clm_article.Rnw:1543-1547 ################################################### p1 <- apply(predict(fm1, newdata = subset(wine, select=-rating))$fit, 1, function(x) round(weighted.mean(1:5, x))) p2 <- as.numeric(as.character(predict(fm1, type = "class")$fit)) stopifnot(isTRUE(all.equal(p1, p2, check.attributes = FALSE))) ################################################### ### code chunk number 54: clm_article.Rnw:1552-1554 ################################################### predictions <- predict(fm1, se.fit = TRUE, interval = TRUE) head(do.call("cbind", predictions)) ################################################### ### code chunk number 55: clm_article.Rnw:1590-1596 ################################################### wine <- within(wine, { rating_comb3 <- factor(rating, labels = c("1", "2-4", "2-4", "2-4", "5")) }) ftable(rating_comb3 ~ temp, data = wine) fm.comb3 <- clm(rating_comb3 ~ temp, data = wine) summary(fm.comb3) ################################################### ### code chunk number 56: clm_article.Rnw:1601-1603 ################################################### fm.comb3_b <- clm(rating_comb3 ~ 1, data = wine) anova(fm.comb3, fm.comb3_b) ################################################### ### code chunk number 57: clm_article.Rnw:1608-1610 ################################################### fm.nom2 <- clm(rating ~ contact, nominal = ~ temp, data = wine) summary(fm.nom2) ################################################### ### code chunk number 58: clm_article.Rnw:1621-1623 ################################################### fm.soup <- clm(SURENESS ~ PRODID * DAY, data = soup) summary(fm.soup) ################################################### ### code chunk number 59: clm_article.Rnw:1626-1627 ################################################### with(soup, table(DAY, PRODID)) ################################################### ### code chunk number 60: clm_article.Rnw:1638-1644 ################################################### wine <- within(wine, { rating_comb2 <- factor(rating, labels = c("1-2", "1-2", "3-5", "3-5", "3-5")) }) ftable(rating_comb2 ~ contact, data = wine) fm.comb2 <- clm(rating_comb2 ~ contact, scale = ~ contact, data = wine) summary(fm.comb2) ################################################### ### code chunk number 61: clm_article.Rnw:1647-1661 ################################################### ## Example with unidentified parameters with 3 response categories ## not shown in paper: wine <- within(wine, { rating_comb3b <- rating levels(rating_comb3b) <- c("1-2", "1-2", "3", "4-5", "4-5") }) wine$rating_comb3b[1] <- "4-5" # Remove the zero here to avoid inf MLE ftable(rating_comb3b ~ temp + contact, data = wine) fm.comb3_c <- clm(rating_comb3b ~ contact * temp, scale = ~contact * temp, nominal = ~contact, data = wine) summary(fm.comb3_c) convergence(fm.comb3_c) ################################################### ### code chunk number 62: clm_article.Rnw:1670-1672 ################################################### rho <- update(fm1, doFit=FALSE) names(rho) ################################################### ### code chunk number 63: clm_article.Rnw:1675-1677 ################################################### rho$clm.nll(rho) c(rho$clm.grad(rho)) ################################################### ### code chunk number 64: clm_article.Rnw:1680-1682 ################################################### rho$clm.nll(rho, par = coef(fm1)) print(c(rho$clm.grad(rho)), digits = 3) ################################################### ### code chunk number 65: clm_article.Rnw:1687-1697 ################################################### nll <- function(par, envir) { envir$par <- par envir$clm.nll(envir) } grad <- function(par, envir) { envir$par <- par envir$clm.nll(envir) envir$clm.grad(envir) } nlminb(rho$par, nll, grad, upper = c(rep(Inf, 4), 2, 2), envir = rho)$par ################################################### ### code chunk number 66: clm_article.Rnw:1706-1711 ################################################### artery <- data.frame(disease = factor(rep(0:4, 2), ordered = TRUE), smoker = factor(rep(c("no", "yes"), each = 5)), freq = c(334, 99, 117, 159, 30, 350, 307, 345, 481, 67)) addmargins(xtabs(freq ~ smoker + disease, data = artery), margin = 2) ################################################### ### code chunk number 67: clm_article.Rnw:1715-1717 ################################################### fm <- clm(disease ~ smoker, weights = freq, data = artery) exp(fm$beta) ################################################### ### code chunk number 68: clm_article.Rnw:1722-1725 ################################################### fm.nom <- clm(disease ~ 1, nominal = ~ smoker, weights = freq, data = artery, sign.nominal = "negative") coef(fm.nom)[5:8] ################################################### ### code chunk number 69: clm_article.Rnw:1728-1729 ################################################### coef(fm.lm <- lm(I(coef(fm.nom)[5:8]) ~ I(0:3))) ################################################### ### code chunk number 70: clm_article.Rnw:1732-1739 ################################################### nll2 <- function(par, envir) { envir$par <- c(par[1:4], par[5] + par[6] * (0:3)) envir$clm.nll(envir) } start <- unname(c(coef(fm.nom)[1:4], coef(fm.lm))) fit <- nlminb(start, nll2, envir = update(fm.nom, doFit = FALSE)) round(fit$par[5:6], 2) ordinal/inst/doc/clm_article.Rnw0000644000176200001440000034437515125475162016422 0ustar liggesusers% \documentclass[article]{article} % \documentclass[article]{jss} \documentclass[nojss]{jss} %% -- Latex packages and custom commands --------------------------------------- %% recommended packages \usepackage{thumbpdf,lmodern,amsmath,amssymb,bm,url} \usepackage{textcomp} \usepackage[utf8]{inputenc} %% another package (only for this demo article) \usepackage{framed} %% new custom commands \newcommand{\class}[1]{`\code{#1}'} \newcommand{\fct}[1]{\code{#1()}} %% For Sweave-based articles about R packages: %% need no \usepackage{Sweave} \SweaveOpts{engine=R, eps=FALSE, keep.source = TRUE, prefix.string=clmjss} <>= options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) library("ordinal") library("xtable") @ %%\VignetteIndexEntry{Cumulative Link Models for Ordinal Regression} %%\VignetteDepends{ordinal, xtable} %% -- Article metainformation (author, title, ...) ----------------------------- %% - \author{} with primary affiliation %% - \Plainauthor{} without affiliations %% - Separate authors by \And or \AND (in \author) or by comma (in \Plainauthor). %% - \AND starts a new line, \And does not. \author{Rune Haubo B Christensen\\Technical University of Denmark\\ \& \\ Christensen Statistics} \Plainauthor{Rune Haubo B Christensen} %% - \title{} in title case %% - \Plaintitle{} without LaTeX markup (if any) %% - \Shorttitle{} with LaTeX markup (if any), used as running title \title{Cumulative Link Models for Ordinal Regression with the \proglang{R} Package \pkg{ordinal}} \Plaintitle{Cumulative Link Models for Ordinal Regression with the R Package ordinal} \Shorttitle{Cumulative Link Models with the \proglang{R} package \pkg{ordinal}} %% - \Abstract{} almost as usual \Abstract{ This paper introduces the R-package \pkg{ordinal} for the analysis of ordinal data using cumulative link models. The model framework implemented in \pkg{ordinal} includes partial proportional odds, structured thresholds, scale effects and flexible link functions. The package also support cumulative link models with random effects which are covered in a future paper. A speedy and reliable regularized Newton estimation scheme using analytical derivatives provides maximum likelihood estimation of the model class. The paper describes the implementation in the package as well as how to use the functionality in the package for analysis of ordinal data including topics on model identifiability and customized modelling. The package implements methods for profile likelihood confidence intervals, analysis of deviance tables with type I, II and III tests, predictions of various kinds as well as methods for checking the convergence of the fitted models. } %% - \Keywords{} with LaTeX markup, at least one required %% - \Plainkeywords{} without LaTeX markup (if necessary) %% - Should be comma-separated and in sentence case. \Keywords{ordinal, cumulative link models, proportional odds, scale effects, \proglang{R}} \Plainkeywords{ordinal, cumulative link models, proportional odds, scale effects, R} %% - \Address{} of at least one author %% - May contain multiple affiliations for each author %% (in extra lines, separated by \emph{and}\\). %% - May contain multiple authors for the same affiliation %% (in the same first line, separated by comma). \Address{ Rune Haubo Bojesen Christensen\\ Section for Statistics and Data Analysis\\ Department of Applied Mathematics and Computer Science\\ DTU Compute\\ Technical University of Denmark\\ Richard Petersens Plads \\ Building 324 \\ DK-2800 Kgs. Lyngby, Denmark\\ \emph{and}\\ Christensen Statistics\\ Bringetoften 7\\ DK-3500 V\ae rl\o se, Denmark \\ E-mail: \email{Rune.Haubo@gmail.com}; \email{Rune@ChristensenStatistics.dk}%\\ % URL: \url{http://christensenstatistics.dk/} } \begin{document} This is a copy of an article that is no longer submitted for publication in Journal of Statistical Software (\url{https://www.jstatsoft.org/}). %% -- Introduction ------------------------------------------------------------- %% - In principle "as usual". %% - But should typically have some discussion of both _software_ and _methods_. %% - Use \proglang{}, \pkg{}, and \code{} markup throughout the manuscript. %% - If such markup is in (sub)section titles, a plain text version has to be %% added as well. %% - All software mentioned should be properly \cite-d. %% - All abbreviations should be introduced. %% - Unless the expansions of abbreviations are proper names (like "Journal %% of Statistical Software" above) they should be in sentence case (like %% "generalized linear models" below). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} \label{sec:intro} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Ordered categorical data, or simply \emph{ordinal} data, are common in a multitude of empirical sciences and in particular in scientific disciplines where humans are used as measurement instruments. Examples include school grades, ratings of preference in consumer studies, degree of tumor involvement in MR images and animal fitness in ecology. Cumulative link models (CLM) are a powerful model class for such data since observations are treated correctly as categorical, the ordered nature is exploited and the flexible regression framework allows for in-depth analyses. This paper introduces the \pkg{ordinal} package \citep{ordinal-pkg} for \proglang{R} \citep{R} for the analysis of ordinal data with cumulative link models. The paper describes how \pkg{ordinal} supports the fitting of CLMs with various models structures, model assessment and inferential options including tests of partial proportional odds, scale effects, threshold structures and flexible link functions. The implementation, its flexibility in allowing for costumizable models and an effective fitting algorithm is also described. The \pkg{ordinal} package also supports cumulative link \emph{mixed} models (CLMM); CLMs with normally distributed random effects. The support of this model class will not be given further treatment here but remain a topic for a future paper. The name, \emph{cumulative link models} is adopted from \citet{agresti02}, but the model class has been referred to by several other names in the literature, such as \emph{ordered logit models} and \emph{ordered probit models} \citep{greene10} for the logit and probit link functions. The cumulative link model with a logit link is widely known as the \emph{proportional odds model} due to \citet{mccullagh80} and with a complementary log-log link, the model is sometimes referred to as the \emph{proportional hazards model} for grouped survival times. CLMs is one of several types of models specifically developed for ordinal data. Alternatives to CLMs include continuation ratio models, adjacent category models, and stereotype models \citep{ananth97} but only models in the CLM framework will be considered in this paper. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Software review} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Cumulative link models can be fitted by all the major software packages and while some software packages support scale effects, partial proportional odds (also referred to as unequal slopes, partial effects, and nominal effects), different link functions and structured thresholds all model structures are not available in any one package or implementation. The following brief software review is based on the publicly available documentation at software package websites retrieved in May 2020. \proglang{IBM SPSS} \citep{SPSS} implements McCullagh's \pkg{PLUM} \citep{mccullagh80} procedure, allows for the five standard link functions (cf. Table~\ref{tab:linkFunctions}) and scale effects. Estimation is via Fisher-Scoring and a test for equal slopes is available for the location-only model while it is not possible to estimate a partial proportional odds model. \proglang{Stata} \citep{Stata} includes the \code{ologit} and \code{oprobit} procedures for CLMs with logistic and probit links but without support for scale effects, partial effect or structured thresholds. The add-on package \pkg{oglm} \citep{oglm} allows for all five standard link functions and scale effects. The \pkg{GLLAMM} package \citep{gllamm} also has some support for CLMs in addition to some support for random effects. \proglang{SAS} \citep{SAS} implements CLMs with logit links in \code{proc logistic} and CLMs with the 5 standard links in \code{prog genmod}. \proglang{Matlab} \citep{Matlab} fits CLMs with the \code{mnrfit} function allowing for logit, probit, complementary log-log and log-log links. \proglang{Python} has a package \pkg{mord} \citep{mord} for ordinal classification and prediction focused at machine learning applications. In \proglang{R}, several packages on the Comprehensive \proglang{R} Archive Network (CRAN) implements CLMs. \code{polr} from \pkg{MASS} \citep{MASS} implements standard CLMs allowing for the 5 standard link functions but no further extensions; the \pkg{VGAM} package \citep{VGAM} includes CLMs via the \code{vglm} function using the \code{cumulative} link. \code{vglm} allows for several link functions as well as partial effects. The \code{lrm} and \code{orm} functions from the \pkg{rms} package \citep{rms} also implements CLMs with the 5 standard link functions but without scale effects, partial or structured thresholds. A Bayesian alternative is implemented in the \pkg{brms} package \citep{brms, brms2} which includes structured thresholds in addition to random-effects. In addition, several other \proglang{R} packages include methods for analyses of ordinal data including \pkg{oglmx} \citep{oglmx}, \pkg{MCMCpack} \citep{MCMCpack}, \pkg{mvord} \citep{mvord}, \pkg{CUB} \citep{CUB}, and \pkg{ordinalgmifs} \citep{ordinalgmifs}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[ordinal package overview]{\pkg{ordinal} package overview} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{ordinal} package implements CLMs and CLMMs along with functions and methods to support these model classes as summarized in Table~\ref{tab:functions_in_ordinal}. The two key functions in \pkg{ordinal} are \code{clm} and \code{clmm} which fits CLMs and CLMMs respectively; \code{clm2} and \code{clmm2}\footnote{A brief tutorial on \code{clmm2} is currently available at the package website on CRAN: \url{https://CRAN.R-project.org/package=ordinal}} provide legacy implementations primarily retained for backwards compatibility. This paper introduces \code{clm} and its associated functionality covering CLMs with location, scale and nominal effects, structured thresholds and flexible link functions. \code{clm.fit} is the main work horse behind \code{clm} and an analogue to \code{lm.fit} for linear models. The package includes methods for assessment of convergence with \code{convergence} and \code{slice}, an auxiliary method for removing linearly dependent columns from a design matrix in \code{drop.coef}. Distributional support functions in \pkg{ordinal} provide support for Gumbel and log-gamma distributions as well as gradients\footnote{gradients with respect to $x$, the quantile; not the parameters of the distributions} of normal, logistic and Cauchy probability density functions which are used in the iterative methods implemented in \code{clm} and \code{clmm}. \begin{table}[t!] \centering \renewcommand*{\arraystretch}{1.2} \begin{tabular}{llll} \hline \rotatebox{0}{Fitting} & \rotatebox{0}{Miscellaneous} & \rotatebox{0}{Former impl.} & \rotatebox{0}{Distributions} \\ \hline \code{clm} & \code{convergence} & \code{clm2} & \code{[pdqrg]gumbel}$^{\textsf{c}}$ \\ \code{clmm}$^{\textsf{c}}$ & \code{slice} & \code{clmm2}$^{\textsf{c}}$ & \code{[pdg]lgamma}$^{\textsf{c}}$ \\ \code{clm.fit} & \code{drop.coef} & \code{clm2.control} & \code{gnorm}$^{\textsf{c}}$ \\ \code{clm.control} & & \code{clmm2.control} & \code{glogis}$^{\textsf{c}}$ \\ \code{clmm.control} & & & \code{gcauchy}$^{\textsf{c}}$ \\ \hline \end{tabular} \\ \caption{Key functions in \pkg{ordinal}. Superscript "c" indicates (partial or full) implementation in \proglang{C}.\label{tab:functions_in_ordinal}} \end{table} As summarized in Table~\ref{tab:clm_methods}, \pkg{ordinal} provides the familiar suite of extractor and print methods for \code{clm} objects known from \code{lm} and \code{glm}. These methods all behave in ways similar to those for \code{glm}-objects with the exception of \code{model.matrix} which returns a list of model matrices and \code{terms} which can return the \code{terms} object for each of three formulae. The inference methods facilitate profile likelihood confidence intervals via \code{profile} and \code{confint}, likelihood ratio tests for model comparison via \code{anova}, model assessment by tests of removal of model terms via \code{drop1} and addition of new terms via \code{add1} or AIC-based model selection via \code{step}. Calling \code{anova} on a single \code{clm}-object provides an analysis of deviance table with type I, II or III Wald-based $\chi^2$ tests following the \proglang{SAS}-definitions of such tests \citep{SAStype}. In addition to standard use of \code{clm}, the implementation facilitates extraction a model environment containing a complete representation of the model allowing the user to fit costumized models containing, for instance, special structures on the threshold parameters, restrictions on regression parameters or other case-specific model requirements. As CLMMs are not covered by this paper methods for \code{clmm} objects will not be discussed. Other packages including \pkg{emmeans} \citep{emmeans}, \pkg{margins} \citep{margins}, \pkg{ggeffects} \citep{ggeffects}, \pkg{generalhoslem} \citep{generalhoslem} and \pkg{effects} \citep{effects1, effects2} extend the \pkg{ordinal} package by providing methods marginal means, tests of functions of the coefficients, goodness-of-fit tests and methods for illustration of fitted models. \begin{table}[t!] \centering \renewcommand*{\arraystretch}{1.2} \begin{tabular}{llll} \hline \multicolumn{2}{l}{Extractor and Print} & Inference & Checking \\[3pt] \hline \code{coef} & \code{print} & \code{anova} & \code{slice} \\ \code{fitted} & \code{summary} & \code{drop1} & \code{convergence}\\ \code{logLik} & \code{model.frame} & \code{add1} & \\ \code{nobs} & \code{model.matrix} & \code{confint} & \\ \code{vcov} & \code{update} & \code{profile} & \\ \code{AIC}, \code{BIC} & & \code{predict} & \\ \code{extractAIC} & & \code{step}, \code{stepAIC} & \\ \hline \end{tabular} \caption{Key methods for \code{clm} objects.\label{tab:clm_methods}} \end{table} The \pkg{ordinal} package is therefore unique in providing a comprehensive framework for cumulative link models exceeding that of other software packages with its functionality extended by a series of additional \proglang{R} packages. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Organization of the paper} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The remainder of the paper is organized as follows. The next section establishes notation by defining CLMs and associated log-likelihood functions, then describes the extended class of CLMs that is implemented in \pkg{ordinal} including details about scale effects, structured thresholds, partial proportional odds and flexible link functions. The third section describes how maximum likelihood (ML) estimation of CLMs is implemented in \pkg{ordinal}. The fourth section describes how CLMs are fitted and ordinal data are analysed with \pkg{ordinal} including sections on nominal effects, scale effects, structured thresholds, flexible link functions, profile likelihoods, assessment of model convergence, fitted values and predictions. The final parts of section four is on a more advanced level and include issues around model identifiability and customizable fitting of models not otherwise covered by the \pkg{ordinal} API. We end in section~\ref{sec:conclusions} with Conclusions. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Cumulative link models} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A cumulative link model is a model for ordinal-scale observations, i.e., observations that fall in an ordered finite set of categories. Ordinal observations can be represented by a random variable $Y_i$ that takes a value $j$ if the $i$th ordinal observations falls in the $j$'th category where $j = 1, \ldots, J$ and $J \geq 2$.\footnote{binomial models ($J = 2$) are also included.}% % A basic cumulative link model is \begin{equation} \label{eq:BasicCLM} \gamma_{ij} = F(\eta_{ij})~, \quad \eta_{ij} = \theta_j - \bm x_i^\top \bm\beta~, \quad i = 1,\ldots,n~, \quad j = 1, \ldots, J-1 ~, \end{equation} where \begin{equation*} %% \label{eq:cum} \gamma_{ij} = \Prob (Y_i \leq j) = \pi_{i1} + \ldots + \pi_{ij} \quad \mathrm{with} \quad \sum_{j=1}^J \pi_{ij} = 1 \end{equation*} are cumulative probabilities\footnote{we have suppressed the conditioning on the covariate vector, $\bm x_i$, i.e., $\gamma_{ij} = \gamma_j(\bm x_i)$ and $P(Y_i \leq j) = P(Y \leq j | \bm x_i)$.}, $\pi_{ij}$ is the probability that the $i$th observation falls in the $j$th category, $\eta_{ij}$ is the linear predictor and $\bm x_i^\top$ is a $p$-vector of regression variables for the parameters, $\bm\beta$ without a leading column for an intercept and $F$ is the inverse link function. % The thresholds (also known as cut-points or intercepts) are strictly ordered: \begin{equation*} -\infty \equiv \theta_0 \leq \theta_1 \leq \ldots \leq \theta_{J-1} \leq \theta_J \equiv \infty. \end{equation*} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{The multinomial distribution and the log-likelihood function} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The ordinal observation $Y_i$ which assumes the value $j$ can be represented by a multinomially distributed variable $\bm Y_i^* \sim \mathrm{multinom}(\bm\pi_i, 1)$, where $\bm Y_i^*$ is a $J$-vector with a $1$ at the $j$'th entry and 0 otherwise, and with probability mass function % \begin{equation} \label{eq:multinom_pmf} \Prob(\bm Y_i^* = \bm y_i^*) = \prod_j \pi_{ij}^{y_{ij}^*} ~. \end{equation} % The log-likelihood function can therefore be written as % \begin{equation*} \ell(\bm\theta, \bm\beta; \bm y^*) = \sum_i \sum_j y_{ij}^* \log \pi_{ij} \end{equation*} % or equivalently % \begin{align*} \ell(\bm\theta, \bm\beta; \bm y) =~& \sum_i \sum_j \mathrm I (y_i = j) \log \pi_{ij} \\ =~& \sum_i \log \tilde\pi_i \end{align*} % where $\tilde\pi_i$ is the $j$'th entry in $J$-vector $\bm \pi_i$ with elements $\pi_{ij}$ and $\mathrm I(\cdot)$ is the indicator function. Allowing for observation-level weights (case weights), $w_i$ leads finally to % \begin{equation} \label{eq:clm-log-likelihood} \ell(\bm\theta, \bm\beta; \bm y) = \sum_i w_i \log \tilde\pi_i ~. \end{equation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Likelihood based inference} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Confidence intervals for model parameters are obtained by appealing to the asymptotic normal distribution of a statistic $s(\cdot)$ for a scalar parameter of interest $\beta_a$ and defined as \begin{equation*} CI:~\left\{ \beta_a; |s(\beta_a)| < z_{1 - \alpha/2} \right\} . \end{equation*} where $z_{1 - \alpha/2}$ is the $(1 - \alpha/2)$ quantile of the standard normal cumulative distribution function. Taking $s(\cdot)$ to be the Wald statistic $s(\beta_a):~ w(\beta_a) = (\hat\beta_a - \beta_a)/\hat{\mathrm{se}}(\hat\beta_a)$ leads to the classical symmetric intervals. Better confidence intervals can be obtained by choosing instead the likelihood root statistic \citep[see e.g.,][]{pawitan01, brazzale07}: \begin{equation*} s(\beta_a):~ r(\beta_a) = \mathrm{sign}(\hat\beta_a - \beta_a) \sqrt{-2 [ \ell(\hat{\bm\theta}, \hat{\bm\beta}; \bm y) - \ell_p(\beta_a; \bm y)]} \end{equation*} where \begin{equation*} \ell_p(\beta_a; \bm y) = \max_{\bm\theta, \bm\beta_{-a}} \ell(\bm\theta, \bm\beta; \bm y)~, \end{equation*} is the profile likelihood for the scalar parameter $\beta_a$ and $\bm\beta_{-a}$ is the vector of regression parameters without the $a$'th one. While the profile likelihood has to be optimized over all parameters except $\beta_a$ we define a \emph{log-likelihood slice} as \begin{equation} \label{eq:slice} \ell_{\mathrm{slice}}(\beta_a; \bm y) = \ell(\beta_a; \hat{\bm\theta}, \hat{\bm\beta}_{-a}, \bm y)~, \end{equation} which is the log-likelihood function evaluated at $\beta_a$ while keeping the remaining parameters fixed at their ML estimates. A quadratic approximation to the log-likelihood slice is $(\hat\beta_a - \beta_a)^2 / 2\tau_a^2$ where the \emph{curvature unit} $\tau_a$ is the square root of $a$'th diagonal element of the Hessian of $-\ell(\hat{\bm\theta}, \hat{\bm\beta}; \bm y)$. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A commonly used link function is the logit link which leads to % \begin{equation} \label{eq:cum_logit_model} \mathrm{logit}(\gamma_{ij}) = \log \frac{\Prob (Y_i \leq j)}{1 - \Prob(Y_i \leq j)} \end{equation} % The odds ratio (OR) of the event $Y_i \leq j$ at $\bm x_1$ relative to the same event at $\bm x_2$ is then % \begin{equation} \label{eq:odds_ratio} \mathrm{OR} = \frac{\gamma_j(\bm x_1) / [1 - \gamma_j(\bm x_1)]} {\gamma_j(\bm x_2) / [1 - \gamma_j(\bm x_2)]} = \frac{\exp(\theta_j - \bm x_1^\top \bm\beta)} {\exp(\theta_j - \bm x_2^\top \bm\beta)} %% =&~ \exp(\theta_j - \theta_j - \bm x_1 \bm\beta + \bm x_2 \bm\beta) = \exp[(\bm x_2^\top - \bm x_1^\top)\bm\beta] \end{equation} which is independent of $j$. Thus the cumulative odds ratio is proportional to the distance between $\bm x_1$ and $\bm x_2$ which motivated \citet{mccullagh80} to denote the cumulative logit model a \emph{proportional odds model}. If $x$ represent a treatment variable with two levels (e.g., placebo and treatment), then $x_2 - x_1 = 1$ and the odds ratio is $\exp(-\beta_\textup{treatment})$. Similarly the odds ratio of the event $Y \geq j$ is $\exp(\beta_\textup{treatment})$. The probit link has its own interpretation through a normal linear model for a latent variable which is considered in section~\ref{sec:latent-variable-motivation}. The complementary log-log (clog-log) link is also sometimes used because of its interpretation as a proportional hazards model for grouped survival times: \begin{equation*} -\log\{1 - \gamma_{j}(\bm x_i) \} = \exp( \theta_j - \bm x_i^T \bm\beta ) \end{equation*} Here $1 - \gamma_{j}(\bm x_i)$ is the probability or survival beyond category $j$ given $\bm x_i$. The proportional hazards model has the property that \begin{equation*} \log \{ \gamma_{j}(\bm x_1) \} = \exp[ (\bm x_2^T - \bm x_1^T) \bm\beta ] \log \{ \gamma_{j}(\bm x_2) \}~. \end{equation*} thus the ratio of hazards at $\bm x_1$ relative to $\bm x_2$ are proportional. If the log-log link is used on the response categories in the reverse order, this is equivalent to using the clog-log link on the response in the original order. This reverses the sign of $\bm\beta$ as well as the sign and order of $\{\theta_j\}$ while the likelihood and standard errors remain unchanged. % % Thus, similar to the proportional odds % model, the ratio of hazard functions beyond category $j$ at $\bm x_1$ % relative to $\bm x_2$ (the hazard ratio, $HR$) is: % \begin{equation*} % HR = \frac{-\log\{1 - \gamma_{j}(\bm x_2) \}} % {-\log\{1 - \gamma_{j}(\bm x_1) \}} = % \frac{\exp( \theta_j - \bm x_1^T \bm\beta )} % {\exp( \theta_j - \bm x_2^T \bm\beta )} = % \exp[(\bm x_2 - \bm x_1)\bm\beta] % \end{equation*} % Details of the most common link functions are described in Table~\ref{tab:linkFunctions}. \begin{table}[t!] \begin{center} %\footnotesize \begin{tabular}{llll} \hline Name & logit & probit & log-log \\ \hline Distribution & logistic & normal & Gumbel (max)$^b$ \\ Shape & symmetric & symmetric & right skew\\ Link function ($F^{-1}$) & $\log[\gamma / (1 - \gamma)]$ & $\Phi^{-1}(\gamma)$ & $-\log[-\log(\gamma)]$ \\ Inverse link ($F$) & $1 / [1 + \exp(\eta)]$ & $\Phi(\eta)$ & $\exp(-\exp(-\eta))$ \\ Density ($f = F'$) & $\exp(-\eta) / [1 + \exp(-\eta)]^2$ & $\phi(\eta)$ \\ \hline \hline Name & clog-log$^a$ & cauchit \\ \hline Distribution & Gumbel (min)$^b$ & Cauchy$^c$ \\ Shape & left skew & kurtotic \\ Link function ($F^{-1}$) & $\log[ -\log(1 - \gamma)]$ & $\tan[\pi (\gamma - 0.5)]$ \\ Inverse link ($F$) & $1 - \exp[-\exp(\eta)]$ & $\arctan(\eta)/\pi + 0.5$ \\ Density ($f = F'$) & $\exp[-\exp(\eta) + \eta]$ & $1 / [\pi(1 + \eta^2)]$ \\ \hline \end{tabular} \end{center} % \footnotesize % % $^a$: the \emph{complementary log-log} link \\ % $^b$: the Gumbel distribution is also known as the extreme value % (type I) distribution for extreme minima or maxima. It is also % sometimes referred to as the Weibull (or log-Weibull) distribution % (\url{http://en.wikipedia.org/wiki/Gumbel_distribution}). \\ % $^c$: the Cauchy distribution is a $t$-distribution with one df \caption{Summary of the five standard link functions. $^a$: the \emph{complementary log-log} link; $^b$: the Gumbel distribution is also known as the extreme value (type I) distribution for extreme minima or maxima. It is also sometimes referred to as the Weibull (or log-Weibull) distribution; $^c$: the Cauchy distribution is a $t$-distribution with one degree of freedom. \label{tab:linkFunctions}} \end{table} The \pkg{ordinal} package allows for the estimation of an extended class of cumulative link models in which the basic model~(\ref{eq:BasicCLM}) is extended in a number of ways including structured thresholds, partial proportional odds, scale effects and flexible link functions. The following sections will describe these extensions of the basic CLM. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Extensions of cumulative link models} \label{sec:extensions-of-clms} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A general formulation of the class of models (excluding random effects) that is implemented in \pkg{ordinal} can be written % \begin{equation} \gamma_{ij} = F_{\lambda}(\eta_{ij}), \quad \eta_{ij} = \frac{g_{\bm\alpha} (\theta_j) - \bm x_i^\top \bm\beta - \bm w_i^\top \tilde{\bm\beta}_j}{\exp(\bm z_i\bm\zeta)} \end{equation} % where \begin{description} \item[$F_{\lambda}$] is the inverse link function. It may be parameterized by the scalar parameter $\lambda$ in which case we refer to $F_{\lambda}^{-1}$ as a \emph{flexible link function}, % \item[$g_{\bm\alpha}(\theta_j)$] parameterises thresholds $\{\theta_j\}$ by the vector $\bm\alpha$ such that $g$ restricts $\{\theta_j\}$ to be for example symmetric or equidistant. We denote this \emph{structured thresholds}. % \item[$\bm x_i^\top\bm\beta$] are the ordinary regression effects, % \item[$\bm w_i^\top \tilde{\bm\beta}_j$] are regression effects which are allowed to depend on the response category $j$ and they are denoted \emph{partial} or \emph{non-proportional odds} \citep{peterson90} when the logit link is applied. To include other link functions in the terminology we denote these effects \emph{nominal effects} (in text and code) because these effects are not integral to the ordinal nature of the data. % \item[$\exp(\bm z_i\bm\zeta)$] are \emph{scale effects} since in a latent variable view these effects model the scale of the underlying location-scale distribution. \end{description} With the exception of the structured thresholds, these extensions of the basic CLM have been considered individually in a number of sources but to the author's best knowledge not previously in a unified framework. % For example partial proportional odds have been considered by \citet{peterson90} and scale effect have been considered by \citet{mccullagh80} and \citet{cox95}. % \citet{agresti02} is a good introduction to cumulative link models in the context of categorical data analysis and includes discussions of scale effects. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Latent variable motivation of CLMs} \label{sec:latent-variable-motivation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% It is natural to motivate the CLM from a linear model for a categorized version of a latent variable. Assume the following linear model for an unobserved latent variable: % \begin{equation} \label{eq:latent} S_i = \alpha^* + \bm x_i^\top \bm\beta^* + \varepsilon_i, \quad \varepsilon_i \sim N(0, \sigma^{*2}) \end{equation} % If $S_i$ falls between two thresholds, $\theta_{j-1}^* < S_i \leq \theta_j^*$ where % \begin{equation} \label{eq:thresholds} -\infty \equiv \theta_0^* < \theta_1^* < \ldots < \theta^*_{J-1} < \theta_{J}^* \equiv \infty \end{equation} % then $Y_i = j$ is observed and the cumulative probabilities are: % \begin{equation*} \gamma_{ij} = \Prob (Y_i \leq j) = \Prob(S_i \leq \theta_j^*) = \Prob \left( Z \leq \frac{\theta_j^* - \alpha^* - \bm x_i^\top \bm\beta^*}{% \sigma^*} \right) = \Phi ( \theta_j - \bm x_i^\top \bm\beta ) \end{equation*} % where $Z$ follows a standard normal distribution, $\Phi$ denotes the standard normal cumulative distribution function, parameters with an ``$^*$'' exist on the latent scale, $\theta_j = (\theta_j^* - \alpha^*) / \sigma^*$ and $\bm\beta = \bm\beta^* / \sigma^*$. Note that $\alpha^*$, $\bm\beta^*$ and $\sigma^*$ would have been identifiable if the latent variable $S$ was directly observed, but they are not identifiable with ordinal observations. See Figure~\ref{fig:standard_clm} for an illustration. If we allow a log-linear model for the scale such that % \begin{equation*} \varepsilon_i \sim N(0, \sigma^{*2}_i), \quad \sigma_i^* = \exp(\mu + \bm z_i^\top \bm\zeta) = \sigma^* \exp(\bm z_i^\top \bm\zeta) \end{equation*} % where $\bm z_i$ is the $i$'th row of a design matrix $\bm Z$ without a leading column for an intercept and $\sigma^* = \exp(\mu)$, then \begin{equation*} \gamma_{ij} = \Prob \left( Z \leq \frac{\theta_j^* - \alpha^* - \bm x_i^\top \bm\beta^*}{% \sigma^*_i} \right) = \Phi \left( \frac{\theta_j - \bm x_i^T \bm\beta}{\sigma_i} \right) \end{equation*} where $\sigma_i = \sigma_i^* / \sigma^* = \exp(\bm z_i^\top \bm\zeta)$ is the \emph{relative} scale. The common link functions: probit, logit, log-log, c-log-log and cauchit correspond to inverse cumulative distribution functions of the normal, logistic, Gumbel(max), Gumbel(min) and Cauchy distributions respectively. These distributions are all members of the location-scale family with common form $F(\mu, \sigma)$, with location $\mu$ and non-negative scale $\sigma$, for example, the logistic distribution has mean $\mu$ and standard deviation $\sigma \pi / \sqrt{3}$. Choosing a link function therefore corresponds to assuming a particular distribution for the latent variable $S$ in which $\bm x_i^\top \bm\beta$ and $\exp(\bm z_i^\top \bm\zeta)$ models location \emph{differences} and scale \emph{ratios} respectively of that distribution. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Structured thresholds} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Structured thresholds, $\{ g(\bm\alpha)_j \}$ makes it possible to impose restrictions on the thresholds $\bm\theta = g(\bm\alpha)$. For instance restricting the thresholds to be equidistant means that only the location of, say, the first threshold and the spacing between adjacent thresholds has to be estimated, thus only two parameters are used to parameterize the thresholds irrespective of the number of response categories. \pkg{ordinal} takes $g(\bm\alpha)$ to be a linear function and operates with \begin{equation*} g(\bm\alpha) = \mathcal{J}^\top \bm\alpha = \bm \theta \end{equation*} where the Jacobian $\mathcal{J}$ defines the mapping from the parameters $\bm\alpha$ to the thresholds $\bm\theta$. The traditional ordered but otherwise unrestricted thresholds are denoted \emph{flexible thresholds} and obtained by taking $\mathcal{J}$ to be an identity matrix. Assuming $J=6$ ordered categories, the Jacobians for equidistant and symmetric thresholds (denoted \code{equidistant} and \code{symmetric} in the \code{clm}-argument \code{threshold}) are \begin{equation*} \mathcal{J}_{\mathrm{equidistant}} = \begin{bmatrix} 1 & 1 & 1 & 1 & 1 \\ 0 & 1 & 2 & 3 & 4 \\ \end{bmatrix}, \quad \mathcal{J}_{\mathrm{symmetric}} = \begin{bmatrix} 1 & 1 & 1 & 1 & 1 \\ 0 & -1 & 0 & 1 & 0 \\ -1 & 0 & 0 & 0 & 1 \\ \end{bmatrix}. \end{equation*} Another version of symmetric thresholds (denoted \code{symmetric2}) is sometimes relevant with an unequal number of response categories here illustrated with $J=5$ together with the \code{symmetric} thresholds: \begin{equation*} \mathcal{J}_{\mathrm{symmetric2}} = \begin{bmatrix} 0 & -1 & 1 & 0 \\ -1 & 0 & 0 & 1 \\ \end{bmatrix}, \quad \mathcal{J}_{\mathrm{symmetric}} = \begin{bmatrix} 1 & 1 & 0 & 0 \\ 0 & 0 & 1 & 1 \\ -1 & 0 & 0 & 1 \\ \end{bmatrix} \end{equation*} The nature of $\mathcal{J}$ for a particular model can always be inspected by printing the \code{tJac} component of the \code{clm} fit. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Partial proportional odds and nominal effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The nominal effects $\bm w_i^\top\tilde{\bm\beta}_j$ can be considered an extension of the regression part of the model $\bm x_i^\top \bm\beta$ in which the regression effects are allowed to vary with $j$. % The nominal effects can also be considered an extension of the thresholds $\theta_j$ which allows them to depend on variables $\bm w_i^\top$: $\tilde{\theta}_{ij}(\bm w_i^\top) = \theta_j - \bm w_i^\top \tilde{\bm\beta}_j$ is the $j$'th threshold for the $i$'th observation. The following treatment assumes for latter view. In general let $\bm W$ denote the design matrix for the nominal effects without a leading column for an intercept; the nominal-effects parameter vector $\tilde{\bm\beta}_j$ is then $\mathrm{ncol}(\bm W)$ long and $\tilde{\bm\beta}$ is $\mathrm{ncol}(\bm W) \cdot (J-1)$ long. If $\bm W$ is the design matrix for the nominal effects containing a single column for a continuous variable then $\tilde{\beta}_j$ is the slope parameter corresponding to the $j$'th threshold and $\theta_j$ is the $j$'th intercept, i.e., the threshold when the covariate is zero. Looking at $\tilde{\theta}_{ij}(\bm w_i^\top) = \theta_j - \bm w_i^\top \tilde{\bm\beta}_j$ as a linear model for the thresholds facilitates the interpretation. If, on the other hand, $\bm W$ is the design matrix for a categorical variable (a \code{factor} in \proglang{R}) then the interpretation of $\tilde{\bm\beta}_j$ depends on the contrast-coding of $\bm W$. If we assume that the categorical variable has 3 levels, then $\tilde{\bm\beta}_j$ is a 2-vector. In the default treatment contrast-coding (\code{"contr.treatment"}) $\theta_j$ is the $j$'th threshold for the first (base) level of the factor, $\tilde{\beta}_{1j}$ is the differences between thresholds for the first and second level and $\tilde{\beta}_{2j}$ is the difference between the thresholds for the first and third level. In general we define $\bm\Theta$ as a matrix with $J-1$ columns and with 1 row for each combination of the levels of factors in $\bm W$. This matrix is available in the \code{Theta} component of the model fit. Note that variables in $\bm X$ cannot also be part of $\bm W$ if the model is to remain identifiable. \pkg{ordinal} detects this and automatically removes the offending variables from $\bm X$. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Flexible link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \pkg{ordinal} package allows for two kinds of flexible link functions due to \citet{aranda-ordaz83} and \citet{genter85}. The link function proposed by \citet{aranda-ordaz83} reads % \begin{equation*} F^{-1}_\lambda (\gamma_{ij}) = \log \left\{ \frac{(1 - \gamma_{ij})^{-\lambda} - 1} {\lambda} \right\}~, \end{equation*} which depends on the auxiliary parameter $\lambda \in ]0, \infty[$. When $\lambda = 1$, the logistic link function arise, and when $\lambda \rightarrow 0$, \begin{equation*} \{ (1 - \gamma_{ij})^{-\lambda} - 1 \} / \lambda \rightarrow \log (1 - \gamma_{ij})^{-1}~, \end{equation*} so the log-log link arise. The inverse link function and its derivative are given by \begin{align*} F(\eta) =&~ 1 - (\lambda \exp(\eta) + 1)^{-\lambda^{-1}} \\ f(\eta) =&~ \exp(\eta) (\lambda \exp(\eta) + 1)^{-\lambda^{-1} - 1} \end{align*} The density implied by the inverse link function is left-skewed if $0 < \lambda < 1$, symmetric if $\lambda = 1$ and right-skewed if $\lambda > 1$, so the link function can be used to assess the evidence about possible skewness of the latent distribution. The log-gamma link function proposed by \citet{genter85} is based on the log-gamma density by \citet{farewell77}. The cumulative distribution function and hence inverse link function reads \begin{equation*} F_\lambda(\eta) = \begin{cases} 1 - G(q; \lambda^{-2}) & \lambda < 0 \\ \Phi(\eta) & \lambda = 0 \\ G(q; \lambda^{-2}) & \lambda > 0 \end{cases} \end{equation*} where $q = \lambda^{-2}\exp(\lambda \eta)$ and $G(\cdot; \alpha)$ denotes the Gamma distribution with shape parameter $\alpha$ and unit rate parameter, and $\Phi$ denotes the standard normal cumulative distribution function. The corresponding density function reads \begin{equation*} f_\lambda(\eta) = \begin{cases} |\lambda| k^k \Gamma(k)^{-1} \exp\{ k(\lambda\eta - \exp(\lambda\eta)) \} & \lambda \neq 0 \\ \phi(\eta) & \lambda = 0 \end{cases} \end{equation*} where $k=\lambda^{-2}$, $\Gamma(\cdot)$ is the gamma function and $\phi$ is the standard normal density function. By attaining the Gumbel(max) distribution at $\lambda = -1$, the standard normal distribution at $\lambda = 0$ and the Gumbel(min) distribution at $\lambda = 1$ the log-gamma link bridges the log-log, probit and complementary log-log links providing right-skew, symmetric and left-skewed latent distributions in a single family of link functions. Note that choice and parameterization of the predictor, $\eta_{ij}$, e.g., the use of scale effects, can affect the evidence about the shape of the latent distribution. There are usually several link functions which provide essentially the same fit to the data and choosing among the good candidates is often better done by appealing to arguments such as ease of interpretation rather than arguments related to fit. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Implementation of ML Estimation of CLMs in ordinal]{Implementation of ML Estimation of CLMs in \pkg{ordinal}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the \pkg{ordinal} package cumulative link models are (by default) estimated with a regularized Newton-Raphson (NR) algorithm with step-halving (line search) using analytical expressions for the gradient and Hessian of the negative log-likelihood function. This NR algorithm with analytical derivatives is used irrespective of whether the model contains structured thresholds, nominal effects or scale effects; the only exception being models with flexible link functions for which a general-purpose quasi-Newton optimizer is used. Due to computationally cheap and efficient evaluation of the analytical derivatives, the relative well-behaved log-likelihood function (with exceptions described below) and the speedy convergence of the Newton-Raphson algorithm, the estimation of CLMs is virtually instant on a modern computer even with complicated models on large datasets. This also facilitates simulation studies. More important than speed is perhaps that the algorithm is reliable and accurate. Technical aspects of the regularized NR algorithm with step-halving (line search) are described in appendix~\ref{sec:algorithm} and analytical gradients are described in detail in \citet{mythesis}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Properties of the log-likelihood function for extended CLMs} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \citet{pratt81} and \citet{burridge81} showed (seemingly independent of each other) that the log-likelihood function of the basic cumulative link model~(\ref{eq:BasicCLM}) is concave. This means that there is a unique global optimum of the log-likelihood function and therefore no risk of convergence to a local optimum. It also means that the Hessian matrix for the negative log-likelihood is strictly positive definite and therefore also that the Newton step is always in direction of higher likelihood. The genuine Newton step may be too long to actually cause an increase in likelihood from one iteration to the next (this is called ``overshoot''). This is easily overcome by successively halving the length of the Newton step until an increase in likelihood is achieved. Exceptions to the strict concavity of the log-likelihood function include models using the cauchit link, flexible link functions as well as models with scale effects. Notably models with structured thresholds as well as nominal effects do not affect the linearity of the predictor, $\eta_{ij}$ and so are also guaranteed to have concave log-likelihoods. The restriction of the threshold parameters $\{\theta_j\}$ being non-decreasing is dealt with by defining $\ell(\bm\theta, \bm\beta; y) = \infty$ when $\{\theta_j\}$ are not in a non-decreasing sequence. If the algorithm attempts evaluation at such illegal values step-halving effectively brings the algorithm back on track. Other implementations of CLMs re-parameterize $\{\theta_j\}$ such that the non-decreasing nature of $\{\theta_j\}$ is enforced by the parameterization, for example, \code{MASS::polr} (package version 7.3.49) optimize the likelihood using \begin{equation*} \tilde\theta_1 = \theta_1, ~\tilde{\theta}_2 = \exp(\theta_2 - \theta_1),~\ldots, ~ \tilde{\theta}_{J-1} = \exp(\theta_{J-2} - \theta_{J-1}) \end{equation*} This is deliberately not used in \pkg{ordinal} because the log-likelihood function is generally closer to quadratic in the original parameterization in our experience which facilitates faster convergence. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Starting values} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% For the basic CLMs~(\ref{eq:BasicCLM}) the threshold parameters are initialized to an increasing sequence such that the cumulative density of a logistic distribution between consecutive thresholds (and below the lowest or above the highest threshold) is constant. The regression parameters $\bm\beta$, scale parameters $\bm\zeta$ as well as nominal effect $\bm\beta^*$ are initialized to 0. If the model specifies a cauchit link or includes scale parameters estimation starts at the parameter estimates of a model using the probit link and/or without the scale-part of the model. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Estimation problems} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% With many nominal effects it may be difficult to find a model in which the threshold parameters are strictly increasing for all combinations of the parameters. Upon convergence of the NR algorithm the model evaluates the $\bm\Theta$-matrix and checks that each row of threshold estimates are increasing. When a continuous variable is included among the nominal effects it is often helpful if the continuous variable is centered at an appropriate value (at least within the observed range of the data). This is because $\{\theta_j\}$ represent the thresholds when the continuous variable is zero and $\{\theta_j\}$ are enforced to be a non-decreasing sequence. Since the nominal effects represent different slopes for the continuous variable the thresholds will necessarily be ordered differently at some other value of the continuous variable. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Convergence codes} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Irrespective of the fitting algorithm, \pkg{ordinal} reports the following convergence codes for CLMs in which negative values indicate convergence failure: % \begin{description} \item[-3] Not all thresholds are increasing. This is only possible with nominal effects and the resulting fit is invalid. \item[-2] The Hessian has at least one negative eigenvalue. This means that the point at which the algorithm terminated does not represent an optimum. \item[-1] Absolute convergence criterion (maximum absolute gradient) was not satisfied. This means that the algorithm couldn't get close enough to a stationary point of the log-likelihood function. \item[0] Successful convergence. \item[1] The Hessian is singular (i.e., at least one eigenvalue is zero). This means that some parameters are not uniquely determined. \end{description} % Note that with convergence code \textbf{1} the optimum of the log-likelihood function has been found although it is not a single point but a line (or in general a (hyper) plane), so while some parameters are not uniquely determined the value of the likelihood is valid enough and can be compared to that of other models. In addition to these convergence codes, the NR algorithm in \pkg{ordinal} reports the following messages: \begin{description} \item[0] Absolute and relative convergence criteria were met \item[1] Absolute convergence criterion was met, but relative criterion was not met \item[2] iteration limit reached \item[3] step factor reduced below minimum \item[4] maximum number of consecutive Newton modifications reached \end{description} Note that convergence is assessed irrespective of potential messages from the fitting algorithm and irrespective of whether the tailored NR algorithm or a general-purpose quasi-Newton optimizer is used. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section[Fitting cumulative link models in ordinal with clm]{Fitting cumulative link models in \pkg{ordinal} with \code{clm}} \label{sec:fitting-clms} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The \code{clm} function takes the following arguments: % <>= clm_args <- gsub("function ", "clm", deparse(args(clm))) cat(paste(clm_args[-length(clm_args)], "\n")) @ % Several arguments are standard and well-known from \code{lm} and \code{glm} and will not be described in detail; \code{formula}, \code{data}, \code{weights}, \code{subset} and \code{na.action} are all parts of the standard model specification in \proglang{R}. \code{scale} and \code{nominal} are interpreted as \proglang{R}-formulae with no left hand sides and specifies the scale and nominal effects of the model respectively, see sections~\ref{sec:scale-effects} and \ref{sec:nominal-effects} for details; \code{start} is an optional vector of starting values; \code{doFit} can be set to \code{FALSE} to prompt \code{clm} to return a model \emph{environment}, for details see section~\ref{sec:customized-modelling}; \code{model} controls whether the \code{model.frame} should be included in the returned model fit; \code{link} specifies the link function and \code{threshold} specifies an optional threshold structure, for details see section~\ref{sec:threshold-effects}. Note the absence of a separate \code{offset} argument. Since \code{clm} allows for different offsets in \code{formula} and \code{scale}, offsets have to be specified within a each formulae, e.g., \verb!scale = ~ x1 + offset(x2)!. Methods for \code{clm} model fits are summarized in Table~\ref{tab:clm_methods} and introduced in the following sections. Control parameters can either be specified as a named list, among the optional \code{...} arguments, or directly as a call to \code{clm.control} --- in the first two cases the arguments are passed on to \code{clm.control}. \code{clm.control} takes the following arguments: % <>= cc_args <- gsub("function ", "clm.control", deparse(args(clm.control))) cat(paste(cc_args[-length(cc_args)], "\n")) @ % The \code{method} argument specifies the optimization and/or return method. The default estimation method (\code{Newton}) is the regularized Newton-Raphson estimation scheme described in section~\ref{sec:algorithm}; options \code{model.frame} and \code{design} prompts \code{clm} to return respectively the \code{model.frame} and a list of objects that represent the internal representation instead of fitting the model; options \code{ucminf}, \code{nlminb} and \code{optim} represent different general-purpose optimizers which may be used to fit the model (the former from package \pkg{ucminf} \citep{ucminf}, the latter two from package \pkg{stats}). The \code{sign.location} and \code{sign.nominal} options allow the user to flip the signs on the location and nominal model terms. The \code{convergence} argument instructs \code{clm} how to alert the user of potential convergence problems; \code{...} are optional arguments passed on to the general purpose optimizers; \code{trace} applies across all optimizers and positive values lead to printing of progress during iterations; the remaining arguments (\code{maxIter, gradTol, maxLineIter, relTol, tol}) control the behavior of the regularized NR algorithm described in appendix~\ref{sec:algorithm}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection[Fitting a basic cumulative link model with clm]{Fitting a basic cumulative link model with \code{clm}} \label{sec:fitting-basic-clm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In the following examples we will use the wine data from \citet{randall89} available in the object \code{wine} in package \pkg{ordinal}, cf., Table~\ref{tab:wineData}. The data represent a factorial experiment on factors determining the bitterness of wine with 1 = ``least bitter'' and 5 = ``most bitter''. Two treatment factors (temperature and contact) each have two levels. Temperature and contact between juice and skins can be controlled when crushing grapes during wine production. Nine judges each assessed wine from two bottles from each of the four treatment conditions, hence there are 72 observations in all. The main objective is to examine the effect of contact and temperature on the perceived bitterness of wine. \begin{table}[t!] \centering \begin{tabular}{llrrrrr} \hline & & \multicolumn{5}{c}{Least---Most bitter} \\ \cline{3-7} <>= ## data(wine) tab <- with(wine, table(temp:contact, rating)) mat <- cbind(rep(c("cold", "warm"), each = 2), rep(c("no", "yes"), 2), tab) colnames(mat) <- c("Temperature", "Contact", paste("~~", 1:5, sep = "")) xtab <- xtable(mat) print(xtab, only.contents = TRUE, include.rownames = FALSE, sanitize.text.function = function(x) x) @ \end{tabular} \caption{The number of ratings from nine judges in bitterness categories 1 --- 5. Wine data from \citet{randall89} aggregated over bottles and judges.% \label{tab:wineData}} \end{table}% Initially we consider the following cumulative link model for the wine data: \begin{equation} \label{eq:CLM} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j - \beta_1 (\mathtt{temp}_i) - \beta_2(\mathtt{contact}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation}% % where $\beta_1(\mathtt{temp}_i)$ attains the values $\beta_1(\mathtt{cold})$ and $\beta_1(\mathtt{warm})$, and $\beta_2(\mathtt{contact}_i)$ attains the values $\beta_2(\mathtt{no})$ and $\beta_2(\mathtt{yes})$. The effect of temperature in this model is illustrated in Figure~\ref{fig:standard_clm}. This is a model for the cumulative probability of the $i$th rating falling in the $j$th category or below, where $i$ index all observations ($n=72$), $j = 1, \ldots, J$ index the response categories ($J = 5$) and $\theta_j$ is the intercept or threshold for the $j$th cumulative logit: $\textup{logit}(P(Y_i \leq j))$. Fitting the model with \code{clm} we obtain: <<>>= library("ordinal") fm1 <- clm(rating ~ temp + contact, data = wine) summary(fm1) @ The \code{summary} method prints basic information about the fitted model. % most of which is self explanatory. % The primary result is the coefficient table with parameter estimates, standard errors and Wald based $p$~values for tests of the parameters being zero. If one of the flexible link functions (\code{link = "log-gamma"} or \code{link = "Aranda-Ordaz"}) is used a coefficient table for the link parameter, $\lambda$ is also included. The maximum likelihood estimates of the model coefficients are:% % \begin{equation} \label{eq:parameters} \begin{gathered} \hat\beta_1(\mathtt{warm} - \mathtt{cold})= 2.50, ~~\hat\beta_2(\mathtt{yes} - \mathtt{no}) = 1.53, \\ \{\hat\theta_j\} = \{-1.34,~ 1.25,~ 3.47,~ 5.01\}. \end{gathered} \end{equation} % The coefficients for \code{temp} and \code{contact} are positive indicating that higher temperature and contact increase the bitterness of wine, i.e., rating in higher categories is more likely. % Because the treatment contrast coding which is the default in \proglang{R} was used, $\{\hat\theta_j\}$ refers to the thresholds at the setting with $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{no}$. % Three natural and complementing interpretations of this model are % \begin{enumerate} \item The thresholds $\{ \hat\theta_j \}$ at $\mathtt{contact}_i = \mathtt{yes}$ conditions have been shifted a constant amount $1.53$ relative to the thresholds $\{ \hat\theta_j \}$ at $\mathtt{contact}_i = \mathtt{no}$ conditions. \item The location of the latent distribution has been shifted $+1.53 \sigma^*$ (scale units) at $\mathtt{contact}_i = \mathtt{yes}$ relative to $\mathtt{contact}_i = \mathtt{no}$. \item The odds ratio of bitterness being rated in category $j$ or above ($\mathrm{OR}(Y \geq j)$) is $\exp(\hat\beta_2(\mathtt{yes} - \mathtt{no})) = 4.61$. \end{enumerate} % Note that there are no $p$~values displayed for the threshold coefficients because it usually does not make sense to test the hypothesis that they equal zero. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm1_fig <- clm(rating ~ contact + temp, data=wine, link="probit") ## Version with arbitrary location and scale parameterization: alpha_ast <- .6 sigma_ast <- 1.4 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 5, 1), line=1, labels = seq(-2, 5, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: mtext(expression(paste(alpha, '*')), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta, '*'))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1], '*')), expression(paste(theta[2], '*')), expression(paste(theta[3], '*')), expression(paste(theta[4], '*'))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") @ <>= ## Version of figure with standardized location and scale: alpha_ast <- 0 sigma_ast <- 1 theta <- fm1_fig$alpha beta <- fm1_fig$beta[2] theta_ast <- theta * sigma_ast beta_ast <- beta * sigma_ast par(mar = c(3,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") axis(1, at=-alpha_ast + seq(-2, 4, 1), line=1, labels = seq(-2, 4, 1)) lines(xx, dnorm(xx, sd = sigma_ast)) lines(xx, H+dnorm(xx, beta_ast, sd=sigma_ast)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0, sd=sigma_ast), 0, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) segments(beta_ast, H+dnorm(0, sd=sigma_ast), beta_ast, dnorm(0, sd=sigma_ast)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, sd=sigma_ast), beta_ast, H+.3+dnorm(0, sd=sigma_ast), length=.1) text(beta_ast-.25, H+.3+dnorm(0, sd=sigma_ast)+.05, expression(paste(beta))) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(paste(theta[1])), expression(paste(theta[2])), expression(paste(theta[3])), expression(paste(theta[4]))) mtext(theta.text, at=theta_ast, side=1) segments(theta_ast, -2, theta_ast, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, theta_ast+.5), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") @ \caption{Illustration of the effect of temperature in the standard cumulative link model in Equation~\ref{eq:CLM} for the wine data in Table~\ref{tab:wineData} through a latent variable interpretation. Left: Arbitrary location ($\alpha^*$) and scale ($\sigma^*$) and right: Standardized parameters.\label{fig:standard_clm}} \end{figure} The number of Newton-Raphson iterations is given below \code{niter} with the number of step-halvings in parenthesis. \code{max.grad} is the maximum absolute gradient of the log-likelihood function with respect to the parameters. % The condition number of the Hessian (\code{cond.H}) is well below $10^4$ and so does not indicate a problem with the model. The \code{anova} method produces an analysis of deviance (ANODE) table also based on Wald $\chi^2$-tests and provides tables with type I, II and III hypothesis tests using the \proglang{SAS} definitions. A type I table, the \proglang{R} default for linear models fitted with \code{lm}, sequentially tests terms from first to last, type II tests attempt to respect the principle of marginality and test each term after all others while ignoring higher order interactions, and type III tables are based on orthogonalized contrasts and tests of main effects or lower order terms can often be interpreted as averaged over higher order terms. Note that in this implementation any type of contrasts (e.g., \code{contr.treatment} or \code{contr.SAS} as well as \code{contr.sum}) can be used to produce type III tests. For further details on the interpretation and definition of type I, II and III tests, please see \citep{kuznetsova17} and \citep{SAStype}. Here we illustrate with a type III ANODE table, which in this case is equivalent to type I and II tables since the variables are balanced: <<>>= anova(fm1, type = "III") @ Likelihood ratio tests, though asymptotically equivalent to the Wald tests usually better reflect the evidence in the data. These tests can be obtained by comparing nested models with the \code{anova} method, for example, the likelihood ratio test of \code{contact} is <<>>= fm2 <- clm(rating ~ temp, data = wine) anova(fm2, fm1) @ which in this case produces a slightly lower $p$~value. Equivalently we can use \code{drop1} to obtain likelihood ratio tests of the explanatory variables while \emph{controlling} for the remaining variables: <<>>= drop1(fm1, test = "Chi") @ Likelihood ratio tests of the explanatory variables while \emph{ignoring} the remaining variables are provided by the \code{add1} method: <<>>= fm0 <- clm(rating ~ 1, data = wine) add1(fm0, scope = ~ temp + contact, test = "Chi") @ % Confidence intervals of the parameter estimates are provided by the \code{confint} method which by default compute the so-called profile likelihood confidence intervals: <<>>= confint(fm1) @ The cumulative link model in Equation~\ref{eq:CLM} assumes that the thresholds, $\{\theta_j\}$ are constant for all values of the remaining explanatory variables, here \code{temp} and \code{contact}. This is generally referred to as the \emph{proportional odds assumption} or \emph{equal slopes assumption}. We can relax this assumption in two general ways: with nominal effects and scale effects examples of which will now be presented in turn. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Partial and non-proportional odds: nominal effects} \label{sec:nominal-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The CLM in Equation~\ref{eq:CLM} specifies a structure in which the regression parameters, $\bm\beta$ are not allowed to vary with $j$ or equivalently that the threshold parameters $\{\theta_j\}$ are not allowed to depend on regression variables. In the following model this assumption is relaxed and the threshold parameters are allowed to depend on \code{contact}. This leads to the so-called partial proportional odds for \code{contact}: % \begin{equation} \label{eq:CLM_nominal} \begin{array}{c} \textup{logit}(P(Y_i \leq j)) = \theta_j + \tilde{\beta}_{j} (\mathtt{contact}_i) - \beta (\mathtt{temp}_i) \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{array} \end{equation} % One way to view this model is to think of two sets of thresholds being applied at conditions with and without contact as illustrated in Figure~\ref{fig:clm_nominal}. The model is specified as follows with \code{clm}: <<>>= fm.nom <- clm(rating ~ temp, nominal = ~ contact, data = wine) summary(fm.nom) @ As can be seen from the output of \code{summary} there are no regression coefficient estimated for \code{contact}, but there are additional threshold coefficients estimated instead. % The naming and meaning of the threshold coefficients depend on the contrast coding applied to \code{contact}. Here the \proglang{R} default treatment contrasts (\code{"contr.treatment"}) are used. Here coefficients translate to the following parameter functions: \begin{equation} \label{eq:nom_parameters} \begin{gathered} \hat\beta(\mathtt{warm} - \mathtt{cold})= 2.52, \\ \{\hat\theta_j\} = \{-1.32,~ 1.25,~ 3.55,~ 4.66\}, \\ \{ \hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}) \} = \{-1.62,~ -1.51,~ -1.67,~ -1.05\}. \end{gathered} \end{equation} % Again $\{ \theta_j \}$ refer to the thresholds at $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{no}$ settings while the thresholds at $\mathtt{temp}_i = \mathtt{cold}$ and $\mathtt{contact}_i = \mathtt{yes}$ are $\{ \hat\theta_j + \hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}) \}$. % The odds ratio of bitterness being rated in category $j$ or above ($\mathrm{OR}(Y \geq j)$) now depend on $j$: $\{\exp(-\hat{\tilde{\beta}}_j(\mathtt{yes} - \mathtt{no}))\} = \{ 5.03,~ 4.53,~ 5.34,~ 2.86\}$. % \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm_fig.nom <- clm(rating ~ temp, nominal =~ contact, data=wine, link="probit") th1 <- unlist(fm_fig.nom$Theta[1, 2:5]) # thresholds for contact: "no" th2 <- unlist(fm_fig.nom$Theta[2, 2:5]) # thresholds for contact: "yes" ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.nom$beta[1])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.nom$beta[1], H+dnorm(0), fm_fig.nom$beta[1], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.nom$beta[1], H+.3+dnorm(0), length=.1) text(fm_fig.nom$beta[1]-.2, loft-.22, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th1, side=1, col="red") segments(th1, -.05, th1, loft, col="red") mtext("contact: no", at=4.3, side=1, col="red") mtext(theta.text, at=th2, side=3, col="blue") segments(th2, 0, th2, loft+.05, col="blue") mtext("contact: yes", at=4.3, side=3, col="blue") @ \caption{Illustration of nominal effects leading to different sets of thresholds being applied for each level of \code{contact} in a latent variable interpretation, cf., Equation~\ref{eq:CLM_nominal}.\label{fig:clm_nominal}} \end{figure} The resulting thresholds for each level of \code{contact}, i.e., the estimated $\bm\Theta$-matrix can be extracted with: <<>>= fm.nom$Theta @ As part of the convergence checks, \code{clm} checks the validity of $\bm\Theta$, i.e., that each row of the threshold matrix is non-decreasing. We can perform a likelihood ratio test of the proportional odds assumption for \code{contact} by comparing the likelihoods of models (\ref{eq:CLM}) and (\ref{eq:CLM_nominal}) as follows: <<>>= anova(fm1, fm.nom) @ There is only little difference in the log-likelihoods of the two models and the test is insignificant. Thus there is no evidence that the proportional odds assumption is violated for \code{contact}. It is not possible to estimate both $\beta_2(\mathtt{contact}_i)$ and $\tilde{\beta}_{j}(\mathtt{contact}_i)$ in the same model. Consequently variables that appear in \code{nominal} cannot enter in \code{formula} as well. For instance, not all parameters are identifiable in the following model: <<>>= fm.nom2 <- clm(rating ~ temp + contact, nominal = ~ contact, data = wine) @ We are made aware of this when summarizing or printing the model in which the coefficient for \code{contactyes} is \code{NA}: <<>>= fm.nom2 @ To test the proportional odds assumption for all variables, we can use <<>>= nominal_test(fm1) @ This function \emph{moves} all terms in \code{formula} to \code{nominal} and \emph{copies} all terms in \code{scale} to \code{nominal} one by one and produces an \code{add1}-like table with likelihood ratio tests of each term. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Modelling scale effects} \label{sec:scale-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % To allow the scale of the latent variable distribution to depend on explanatory variables we could for instance consider the following model where the scale is allowed to differ between cold and warm conditions. The location of the latent distribution is allowed to depend on both temperature and contact: \begin{equation} \label{eq:CLM_scale_wine} \begin{gathered} \textup{logit}(P(Y_i \leq j)) = \frac{\theta_j - \beta_1 (\mathtt{temp}_i) - \beta_{2} (\mathtt{contact}_i)} {\exp( \zeta (\mathtt{temp}_i))} \\ i = 1,\ldots, n, \quad j = 1, \ldots, J-1 \end{gathered} \end{equation} This model structure is illustrated in Figure~\ref{fig:clm_scale} and can be estimated with: <<>>= fm.sca <- clm(rating ~ temp + contact, scale = ~ temp, data = wine) summary(fm.sca) @ In a latent variable interpretation the location of the latent distribution is shifted $2.63\sigma^*$ (scale units) from cold to warm conditions and $1.59\sigma^*$ from absence to presence of contact. The scale of the latent distribution is $\sigma^*$ at cold conditions but $\sigma^* \exp(\zeta(\mathtt{warm} - \mathtt{cold})) = \sigma^*\exp(0.095) = 1.10 \sigma^*$, i.e., 10\% higher, at warm conditions. However, observe that the $p$~value for the scale effect in the summary output shows that the ratio of scales is not significantly different from 1 (or equivalently that the difference on the log-scale is not different from 0). Scale effects offer an alternative to nominal effects (partial proportional odds) when non-proportional odds structures are encountered in the data. Using scale effects is often a better approach because the model is well-defined for all values of the explanatory variables irrespective of translocation and scaling of covariates. Scale effects also use fewer parameters which often lead to more sensitive tests than nominal effects. Potential scale effects of variables already included in \code{formula} can be discovered using \code{scale_test}. This function adds each model term in \code{formula} to \code{scale} in turn and reports the likelihood ratio statistic in an \code{add1}-like fashion: <<>>= scale_test(fm1) @ \code{confint} and \code{anova} methods apply with no change to models with scale and nominal parts, but \code{drop1}, \code{add1} and \code{step} methods will only drop or add terms to the (location) \code{formula}. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= ## Scale differences: fm_fig.sca <- clm(rating ~ contact + temp, scale=~temp, data=wine, link="probit") ## Exagerate the scale for better visual: sca <- 1.5 # exp(fm_fig.sca$zeta) ## Figure: par(mar = c(2,0,1,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.sca$beta[2], sca)) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0, ,sca)+H+.3, lty=3, lwd=2) segments(fm_fig.sca$beta[2], H+dnorm(0, ,sca), fm_fig.sca$beta[2], dnorm(0, ,sca)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0, ,sca), fm_fig.sca$beta[2], H+.3+dnorm(0, ,sca), length=.1) text(fm_fig.sca$beta[2]-.2, loft-.35, expression(beta)) abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=fm_fig.sca$alpha, side=1) segments(fm_fig.sca$alpha, -2, fm_fig.sca$alpha, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, fm_fig.sca$alpha+.5), col="red") @ \caption{Illustration of scale effects leading to different scales of the latent variable, cf., Equation~\ref{eq:CLM_scale_wine}.\label{fig:clm_scale}} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Structured thresholds} \label{sec:threshold-effects} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In section~\ref{sec:nominal-effects} nominal effects were described where the assumption that regression parameters have the same effect across all thresholds was relaxed. In this section additional restrictions on the thresholds will be imposed instead. The following model requires that the thresholds, $\{ \theta_j \}$ are equidistant or equally spaced. This allows us to assess an assumption that judges are using the response scale in such a way that there is the same distance between adjacent response categories, i.e., that $\theta_j - \theta_{j-1} = \textup{constant}$ for $j = 2, ..., J-1$. The effect of equidistant thresholds is illustrated in Figure~\ref{fig:clm_structured_thresholds} and can be fitted with: <<>>= fm.equi <- clm(rating ~ temp + contact, data = wine, threshold = "equidistant") summary(fm.equi) @ The parameters determining the thresholds are now the first threshold (\code{threshold.1}) and the spacing among consecutive thresholds (\code{spacing}). The mapping to this parameterization is stored in the transpose of the Jacobian matrix (\code{tJac}) component of the model fit. This makes it possible to extract the thresholds imposed by the equidistance structure with <<>>= drop(fm.equi$tJac %*% coef(fm.equi)[c("threshold.1", "spacing")]) @ These thresholds are in fact already stored in the \code{Theta} component of the model fit. % The following shows that the average distance between consecutive thresholds in \code{fm1} which did not restrict the thresholds is very close to the \code{spacing} parameter from \code{fm.equi}: <<>>= mean(diff(coef(fm1)[1:4])) @ One advantage of imposing additional restrictions on the thresholds is the use of fewer parameters. Whether the restrictions are warranted by the data can be assessed in a likelihood ratio test: <<>>= anova(fm1, fm.equi) @ In this case the test is non-significant, so there is no considerable loss of fit at the gain of saving two parameters, hence we may retain the model with equally spaced thresholds. Note that the shape of the latent distribution (determined by the choice of link function) also affects the distances between the thresholds. If thresholds are equidistant under a normal distribution (i.e., with the logit link) they will in general\footnote{The exception is perfect fits such as CLMs with flexible thresholds and no predictors where models have the same likelihood irrespective of link function.} not be equidistant under a differently shaped latent distribution such as a skew latent distribution (e.g., with the log-log or clog-log link). \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= fm_fig.flex <- clm(rating ~ contact + temp, data=wine, link="probit") th <- fm_fig.flex$alpha par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.flex$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: # mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.flex$beta[2], H+dnorm(0), fm_fig.flex$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.flex$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.flex$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta[1]), expression(Delta[2]), expression(Delta[3]))) @ <>= fm_fig.equi <- clm(rating ~ contact + temp, data=wine, threshold="equidistant", link="probit") th <- c(fm_fig.equi$alpha[1], fm_fig.equi$alpha[1] + cumsum(rep(fm_fig.equi$alpha[2], 3))) par(mar = c(2,0,0.5,0)+.2) Min <- -3; Max <- 5; H <- 1; loft <- 2 xx <- seq(Min, Max, len=1e3) plot(c(Min, Max), c(0, loft), type = "n", axes=FALSE, xlab="", ylab="") lines(xx, dnorm(xx)) lines(xx, H+dnorm(xx, fm_fig.equi$beta[2])) abline(h=c(0, H)) text(Max-.3, .15, "cold") text(Max-.3, H+.15, "warm") ## alpha: ## mtext(expression(alpha), side=1, at=0) segments(0, -.02, 0, .02) ## beta arrow: segments(0, dnorm(0), 0, dnorm(0)+H+.3, lty=3, lwd=2) segments(fm_fig.equi$beta[2], H+dnorm(0), fm_fig.equi$beta[2], dnorm(0)+H+.3, lty=3, lwd=2) arrows(0, H+.3+dnorm(0), fm_fig.equi$beta[2], H+.3+dnorm(0), length=.1) text(fm_fig.equi$beta[2]-.2, loft-.22, expression(beta)) ## add thresholds and Y-scale: abline(h=loft) theta.text <- c(expression(theta[1]), expression(theta[2]), expression(theta[3]), expression(theta[4])) mtext(theta.text, at=th, side=1) segments(th, -2, th, 10, col="red") mtext(c("Y:", 1:5), side=3, line=-.5, at=c(-2.5, -1.5, th+.6), col="red") text(-2, H/2, expression(paste("P(Y = 2|cold)")), col="red") arrows(-2, H/2-.04, -.2, .2, length=.1, col="red") arrows(th[-4], loft-.05, th[-1], loft-.05, length=.1) text(th[-4]+.6, loft-.1, c(expression(Delta), expression(Delta), expression(Delta))) @ \caption{Illustration of flexible (left) and equidistant (right) thresholds being applied in a cumulative link model in a latent variable interpretation.\label{fig:clm_structured_thresholds}} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Scale effects, nominal effects and link functions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This section presents an example that connects aspects of scale effects, nominal effects and link functions. The example is based on the \code{soup} data available in the \pkg{ordinal} package. This dataset represents a sensory discrimination study of packet soup in which 185 respondents assessed a reference product and one of 5 test products on an ordinal sureness-scale with 6 levels from "reference, sure" to "test, sure". The two key explanatory variables in this example are \code{PRODID} and \code{PROD}. \code{PRODID} identifies all 6 products while \code{PROD} distinguishes test and reference products: <<>>= with(soup, table(PROD, PRODID)) @ The so-called bi-normal model plays a special role in the field of signal detection theory \citep{decarlo98, macmillan05} and in sensometrics \citep{christensen11} and assumes the existence of normal latent distributions potentially with different variances. The bi-normal model can be fitted to ordinal data by identifying it as a CLM with a probit link. The following bi-normal model assumes that the location of the normal latent distribution depends on \code{PRODID} while the scale only varies with \code{PROD}: <<>>= fm_binorm <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="probit") summary(fm_binorm) @ Here we observe significant differences in scale for reference and test products and this is an example of what would have been denoted non-proportional odds had the link function been the logit function. In this context differences in scale are interpreted to mean that a location shift of the latent normal distribution is not enough to represent the data. Another test of such non-location effects is provided by the nominal effects: <<>>= fm_nom <- clm(SURENESS ~ PRODID, nominal = ~ PROD, data = soup, link="probit") @ A comparison of these models shows that the scale effects increase the likelihood substantially using only one extra parameter. The addition of nominal effects provides a smaller increase in likelihood using three extra parameters: <<>>= fm_location <- update(fm_binorm, scale = ~ 1) anova(fm_location, fm_binorm, fm_nom) @ Note that both the location-only and bi-normal models are nested under the model with nominal effects making these models comparable in likelihood ratio tests. This example illustrates an often seen aspect: that models allowing for scale differences frequently capture the majority of deviations from location-only effects that could otherwise be captured by nominal effects using fewer parameters. The role of link functions in relation to the evidence of non-location effects is also illustrated by this example. If we consider the complementary log-log link it is apparent that there is no evidence of scale differences. Furthermore, the likelihood of a complementary log-log model with constant scale is almost the same as that of the bi-normal model: <<>>= fm_cll_scale <- clm(SURENESS ~ PRODID, scale = ~ PROD, data = soup, link="cloglog") fm_cll <- clm(SURENESS ~ PRODID, data = soup, link="cloglog") anova(fm_cll, fm_cll_scale, fm_binorm) @ Using the log-gamma link we can also confirm that a left-skewed latent distribution ($\lambda > 0$) is best supported by the data and that the estimate of $\lambda$ is close to 1 at which the complementary log-log link is obtained: <<>>= fm_loggamma <- clm(SURENESS ~ PRODID, data = soup, link="log-gamma") summary(fm_loggamma) @ The analysis of link functions shown here can be thought of as providing a framework analogous to that of Box-Cox transformations for linear models. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Profile likelihood} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In addition to facilitating the generally quite accurate profile likelihood confidence intervals which were illustrated in section~\ref{sec:fitting-basic-clm}, the profile likelihood function can also be used to illustrate the relative importance of parameter values. As an example, the profile likelihood of model coefficients for \code{temp} and \code{contact} in \code{fm1} can be obtained with % <>= pr1 <- profile(fm1, alpha = 1e-4) plot(pr1) @ The resulting plots are provided in Figure~\ref{fig:ProfileLikelihood}. The \code{alpha} argument controls how far from the maximum likelihood estimate the likelihood function should be profiled: the profile strays no further from the MLE when values outside an (\code{1 - alpha})-level profile likelihood confidence interval. From the relative profile likelihood in Figure~\ref{fig:ProfileLikelihood} for \code{tempwarm} we see that parameter values between 1 and 4 are reasonably well supported by the data, and values outside this range has little likelihood. Values between 2 and 3 are very well supported by the data and have high likelihood. \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= plot(pr1, which.par = 1) @ <>= plot(pr1, which.par = 2) @ \caption{Relative profile likelihoods for the regression parameters in \code{fm1} for the wine data. Horizontal lines indicate 95\% and 99\% confidence bounds.} \label{fig:ProfileLikelihood} \end{figure} Profiling is implemented for regression ($\beta$) and scale ($\zeta$) parameters but not available for threshold, nominal and flexible link parameters. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Assessment of model convergence} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Likelihood slices} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The maximum likelihood estimates of the parameters in cumulative link models do not have closed form expressions, so iterative methods have to be applied to fit the models. Further, CLMs are non-linear models and in general the likelihood function is not guaranteed to be well-behaved or even uni-model. In addition, the special role of the threshold parameters and the restriction on them being ordered can affect the appearance of the likelihood function. To confirm that an unequivocal optimum has been reached and that the likelihood function is reasonably well-behaved around the reported optimum we can inspect the likelihood function in a neighborhood around the reported optimum. For these purposes we can display slices of the likelihood function. The following code produces the slices shown in Figure~\ref{fig:slice1} which displays the shape of the log-likelihood function in a fairly wide neighborhood around the reported MLE; here we use $\lambda=5$ curvature units, as well as it's quadratic approximation. <<>>= slice.fm1 <- slice(fm1, lambda = 5) par(mfrow = c(2, 3)) plot(slice.fm1) @ Figure~\ref{fig:slice1} shows that log-likelihood function is fairly well behaved and relatively closely quadratic for most parameters. \setkeys{Gin}{width=.32\textwidth} \begin{figure} \centering <>= plot(slice.fm1, parm = 1) @ <>= plot(slice.fm1, parm = 2) @ <>= plot(slice.fm1, parm = 3) @ <>= plot(slice.fm1, parm = 4) @ <>= plot(slice.fm1, parm = 5) @ <>= plot(slice.fm1, parm = 6) @ \caption{Slices of the (negative) log-likelihood function (solid) for parameters in \code{fm1} for the wine data. Dashed lines indicate quadratic approximations to the log-likelihood function and vertical bars indicate maximum likelihood estimates.} \label{fig:slice1} \end{figure} Looking at the log-likelihood function much closer to the reported optimum (using $\lambda = 10^{-5}$) we can probe how accurately the parameter estimates are determined. The likelihood slices in Figure~\ref{fig:slice2} which are produced with the following code shows that the parameters are determined accurately with at least 5 correct decimals. Slices are shown for two parameters and the slices for the remaining 4 parameters are very similar. <>= slice2.fm1 <- slice(fm1, parm = 4:5, lambda = 1e-5) par(mfrow = c(1, 2)) plot(slice2.fm1) @ \setkeys{Gin}{width=.45\textwidth} \begin{figure} \centering <>= plot(slice2.fm1, parm = 1) @ <>= plot(slice2.fm1, parm = 2) @ \caption{Slices of the (negative) log-likelihood function (solid) for parameters in \code{fm1} for the wine data very close to the MLEs. Dashed lines (indistinguishable from the solid lines) indicate quadratic approximations to the log-likelihood function and vertical bars the indicate maximum likelihood estimates.} \label{fig:slice2} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Parameter accuracy} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% As discussed in section~\ref{sec:algorithm} the method independent error estimate provides an assessment of the accuracy with which the ML estimates of the parameters have been determined by the fitting algorithm. This error estimate is implemented in the \code{convergence} method which we now illustrate on a model fit: <<>>= convergence(fm1) @ The most important information is the number of correct decimals (\code{Cor.Dec}) and the number of significant digits (\code{Sig.Dig}) with which the parameters are determined. In this case all parameters are very accurately determined, so there is no reason to lower the convergence tolerance. The \code{logLik.error} shows that the error in the reported value of the log-likelihood is below $10^{-10}$, which is by far small enough that likelihood ratio tests based on this model are accurate. Note that the assessment of the number of correctly determined decimals and significant digits is only reliable sufficiently close to the optimum so in practice we caution against this assessment if the algorithm did not converge successfully. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Fitted values and predictions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Several types of fitted values and predictions can be extracted from a CLM depending on how it is viewed. By \emph{fitted values} we denote the values ($i=1, \ldots, n$) \begin{equation*} \hat{\tilde\pi}_i = \tilde\pi_i(\hat{\bm\psi}) \end{equation*} that is, the value of $\tilde\pi_i$, cf., Equation~\ref{eq:clm-log-likelihood} evaluated at the ML estimates $\hat{\bm\psi}$. These are the values returned by the \code{fitted} and \code{fitted.values} extractor methods and stored in the \code{fitted.values} component of the model fit. The values of $\pi_{ij}$ (cf., Equation~\ref{eq:multinom_pmf}) evaluated at the ML estimates of the parameters (i.e., $\hat\pi_{ij}$) can also be thought of as fitted values for the multinomially distributed variable $\bm Y_i^*$. These values can be obtained from the model fit by use of the \code{predict} method: <<>>= head(pred <- predict(fm1, newdata = subset(wine, select = -rating))$fit) @ Note that the original data set should be supplied in the \code{newdata} argument \emph{without} the response variable (here \code{rating}). If the response variable is \emph{present} in \code{newdata} predictions are produced for only those rating categories which were observed and we get back the fitted values: <<>>= stopifnot(isTRUE(all.equal(fitted(fm1), t(pred)[ t(col(pred) == wine$rating)])), isTRUE(all.equal(fitted(fm1), predict(fm1, newdata = wine)$fit))) @ Class predictions are also available and defined here as the response class with the highest probability, that is, for the $i$'th observation the class prediction is the mode of $\bm\pi_{i}$. To obtain class predictions use \code{type = "class"} as illustrated in the following small table: <<>>= newData <- expand.grid(temp = levels(wine$temp), contact = levels(wine$contact)) cbind(newData, round(predict(fm1, newdata = newData)$fit, 3), "class" = predict(fm1, newdata = newData, type = "class")$fit) @ Other definitions of class predictions can be applied, e.g., nearest mean predictions: <<>>= head(apply(pred, 1, function(x) round(weighted.mean(1:5, x)))) @ which in this case happens to be identical to the default class predictions. <>= p1 <- apply(predict(fm1, newdata = subset(wine, select=-rating))$fit, 1, function(x) round(weighted.mean(1:5, x))) p2 <- as.numeric(as.character(predict(fm1, type = "class")$fit)) stopifnot(isTRUE(all.equal(p1, p2, check.attributes = FALSE))) @ Standard errors and confidence intervals of predictions are also available, for example: <<>>= predictions <- predict(fm1, se.fit = TRUE, interval = TRUE) head(do.call("cbind", predictions)) @ where the default 95\% confidence level can be changed with the \code{level} argument. Here the standard errors of fitted values or predictions, $\hat{\tilde{\pi}} = \tilde{\pi}(\hat{\bm\psi})$ are obtained by application of the delta method: \begin{equation*} \mathsf{Var}(\hat{\tilde{\bm\pi}}) = \bm C \mathsf{Var}(\hat{\bm\psi}) \bm C^\top, \quad \bm C = \frac{\partial \tilde{\bm\pi}(\bm\psi)}{\partial \bm\psi} \Big|_{\bm\psi = \hat{\bm\psi}} \end{equation*} where $\mathsf{Var}(\hat{\bm\psi})$ is the estimated variance-covariance matrix of the parameters $\bm\psi$ evaluated at the ML estimates $\hat{\bm\psi}$ as given by the observed Fisher Information matrix and finally the standard errors are extracted as the square root of the diagonal elements of $\mathsf{Var}(\hat{\tilde{\bm\pi}})$. Since symmetric confidence intervals for probabilities are not appropriate unless perhaps if they are close to one half a more generally applicable approach is to form symmetric Wald intervals on the logit scale and then subsequently transform the confidence bounds to the probability scale. \code{predict.clm} takes this approach and computes the standard error of $\hat\kappa_i = \mathrm{logit}(\hat{\tilde{\pi}}_i)$ by yet an application of the delta method: \begin{equation*} \mathrm{se}(\hat\kappa_i) = \frac{\partial g(\hat{\tilde{\pi}}_i)}{\partial \hat{\tilde{\pi}}_i} \mathrm{se}(\hat{\tilde{\pi}}_i) = \frac{\mathrm{se}(\hat{\tilde{\pi}}_i)}{% \hat{\tilde{\pi}}_i(1 - \hat{\tilde{\pi}}_i)}, \quad g(\hat{\tilde{\pi}}_i) = \log \frac{\hat{\tilde{\pi}}_i}{1 - \hat{\tilde{\pi}}_i}. \end{equation*} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Model identifiability} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Unidentifiable models or unidentifiable parameters may happen in CLMs for several reasons some of which are special to the model class. In this section we describe issues around model identifiability and how this is handled by \code{ordinal::clm}. Material in the remainder of this section is generally on a more advanced level than up to now. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Complete separation} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% In binary logistic regression the issue of \emph{complete separation} is well known. This may happen, for example if only ``success'' or only ``failure'' is observed for a level of a treatment factor. In CLMs the issue may appear even when outcomes are observed in more than one response category. This can be illustrated using the \code{wine} data set if we combine the three central categories: <<>>= wine <- within(wine, { rating_comb3 <- factor(rating, labels = c("1", "2-4", "2-4", "2-4", "5")) }) ftable(rating_comb3 ~ temp, data = wine) fm.comb3 <- clm(rating_comb3 ~ temp, data = wine) summary(fm.comb3) @ Here the true ML estimates of the coefficients for \code{temp} and the second threshold are at infinity but the algorithm in \code{clm} terminates when the likelihood function is sufficiently flat. This means that the reported values of the coefficients for \code{temp} and the second threshold are arbitrary and will change if the convergence criteria are changed or a different optimization method is used. The standard errors of the coefficients are not available because the Hessian is effectively singular and so cannot be inverted to produce the variance-covariance matrix of the parameters. The ill-determined nature of the Hessian is seen from the very large condition number of the Hessian, \code{cond.H}. Note, however, that while the model parameters cannot be uniquely determined, the likelihood of the model is well defined and as such it can be compared to the likelihood of other models. For example, we could compare it to a model that excludes \code{temp} <<>>= fm.comb3_b <- clm(rating_comb3 ~ 1, data = wine) anova(fm.comb3, fm.comb3_b) @ The difference in log-likelihood is substantial, however, the criteria for the validity of the likelihood ratio test are not fulfilled, so the $p$~value should not be taken at face value. The complete-separation issue may also appear in less obvious situations. If, for example, the following model is considered allowing for nominal effects of \code{temp} the issue shows up: <<>>= fm.nom2 <- clm(rating ~ contact, nominal = ~ temp, data = wine) summary(fm.nom2) @ Analytical detection of which coefficients suffer from unidentifiability due to \emph{complete separation} is a topic for future research and therefore unavailable in current versions of \pkg{ordinal}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Aliased coefficients} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Aliased coefficients can occur in all kinds of models that build on a design matrix including linear models as well as generalized linear models. \code{lm} and \code{glm} determine the rank deficiency of the design matrix using the rank-revealing implementation of the QR-decomposition in \code{LINPACK} and displays the aliased coefficients as \code{NA}s\footnote{if the \code{singular.ok = TRUE} which is the default.}. Though the QR decomposition is not used during iterations in \code{clm}, it is used initially to determine aliased coefficients. An example is provided using the \code{soup} data available in the \pkg{ordinal} package: <<>>= fm.soup <- clm(SURENESS ~ PRODID * DAY, data = soup) summary(fm.soup) @ The source of the singularity is revealed in the following table: <<>>= with(soup, table(DAY, PRODID)) @ which shows that the third \code{PRODID} was not presented at the second day. The issue of aliased coefficients extends in CLMs to nominal effects since the joint design matrix for location and nominal effects will be singular if the same variables are included in both location and nominal formulae. \code{clm} handles this by not estimating the offending coefficients in the location formula as illustrated with the \code{fm.nom2} model fit in section~\ref{sec:nominal-effects}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Over parameterization} \label{sec:over-parameterization} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The scope of model structures allowed in \code{clm} makes it possible to specify models which are over parameterized in ways that do not lead to rank deficient design matrices and as such are not easily detected before fitting the model. An example is given here which includes both additive (location) and multiplicative (scale) effects of \code{contact} for a binomial response variable but the issue can also occur with more than two response categories: <<>>= wine <- within(wine, { rating_comb2 <- factor(rating, labels = c("1-2", "1-2", "3-5", "3-5", "3-5")) }) ftable(rating_comb2 ~ contact, data = wine) fm.comb2 <- clm(rating_comb2 ~ contact, scale = ~ contact, data = wine) summary(fm.comb2) @ <>= ## Example with unidentified parameters with 3 response categories ## not shown in paper: wine <- within(wine, { rating_comb3b <- rating levels(rating_comb3b) <- c("1-2", "1-2", "3", "4-5", "4-5") }) wine$rating_comb3b[1] <- "4-5" # Remove the zero here to avoid inf MLE ftable(rating_comb3b ~ temp + contact, data = wine) fm.comb3_c <- clm(rating_comb3b ~ contact * temp, scale = ~contact * temp, nominal = ~contact, data = wine) summary(fm.comb3_c) convergence(fm.comb3_c) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Customized modelling} \label{sec:customized-modelling} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Using the \code{doFit} argument \code{clm} can be instructed to return a \emph{model environment} that we denote \code{rho}: <<>>= rho <- update(fm1, doFit=FALSE) names(rho) @ This environment holds a complete specification of the cumulative link models including design matrices \code{B1}, \code{B2}, \code{S} and other components. The environment also contains the cumulative distribution function that defines the inverse link function \code{pfun} and its first and second derivatives, i.e., the corresponding density function \code{dfun} and gradient \code{gfun}. Of direct interest here is the parameter vector \code{par} and functions that readily evaluate the negative log-likelihood (\code{clm.nll}), its gradient with respect to the parameters (\code{clm.grad}) and the Hessian (\code{clm.hess}). The negative log-likelihood and the gradient at the starting values is therefore <<>>= rho$clm.nll(rho) c(rho$clm.grad(rho)) @ Similarly at the MLE they are: <<>>= rho$clm.nll(rho, par = coef(fm1)) print(c(rho$clm.grad(rho)), digits = 3) @ Note that the gradient function \code{clm.grad} assumes that \code{clm.nll} has been evaluated at the current parameter values; similarly, \code{clm.hess} assumes that \code{clm.grad} has been evaluated at the current parameter values. The NR algorithm in \pkg{ordinal} takes advantage of this so as to minimize the computational load. If interest is in fitting a \emph{custom} CLM with, say, restrictions on the parameter space, this can be achieved by a combination of a general purpose optimizer and the functions \code{clm.nll} and optionally \code{clm.grad}. Assume for instance we know that the regression parameters can be no larger than 2, then the model can be fitted with the following code: <<>>= nll <- function(par, envir) { envir$par <- par envir$clm.nll(envir) } grad <- function(par, envir) { envir$par <- par envir$clm.nll(envir) envir$clm.grad(envir) } nlminb(rho$par, nll, grad, upper = c(rep(Inf, 4), 2, 2), envir = rho)$par @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsubsection{Constrained partial proportional odds} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A type of models which are not implemented in full generality in \pkg{ordinal} are the so-called \emph{constrained} partial proportional odds models proposed by \citet{peterson90}. These models impose restrictions on the nominal effects considered in section~\ref{sec:nominal-effects} and are well suited to illustrate the customisable modelling options available in the \pkg{ordinal} package. We consider an example from \citet{peterson90} in which disease status is tabulated by smoking status: <<>>= artery <- data.frame(disease = factor(rep(0:4, 2), ordered = TRUE), smoker = factor(rep(c("no", "yes"), each = 5)), freq = c(334, 99, 117, 159, 30, 350, 307, 345, 481, 67)) addmargins(xtabs(freq ~ smoker + disease, data = artery), margin = 2) @ The overall odds-ratio of smoking is <<>>= fm <- clm(disease ~ smoker, weights = freq, data = artery) exp(fm$beta) @ showing that overall the odds of worse disease rating is twice as high for smokers compared to non-smokers. Allowing for nominal effects we see that the log odds-ratio for smoking clearly changes with disease status, and that it does so in an almost linearly decreasing manor: <<>>= fm.nom <- clm(disease ~ 1, nominal = ~ smoker, weights = freq, data = artery, sign.nominal = "negative") coef(fm.nom)[5:8] @ \citet{peterson90} suggested a model which restricts the log odds-ratios to be linearly decreasing with disease status modelling only the intercept (first threshold) and slope of the log odds-ratios: <<>>= coef(fm.lm <- lm(I(coef(fm.nom)[5:8]) ~ I(0:3))) @ We can implement the log-likelihood of this model as follows. As starting values we combine parameter estimates from \code{fm.nom} and the linear model \code{fm.lm}, and finally optimize the log-likelihood utilizing the \code{fm.nom} model environment: <<>>= nll2 <- function(par, envir) { envir$par <- c(par[1:4], par[5] + par[6] * (0:3)) envir$clm.nll(envir) } start <- unname(c(coef(fm.nom)[1:4], coef(fm.lm))) fit <- nlminb(start, nll2, envir = update(fm.nom, doFit = FALSE)) round(fit$par[5:6], 2) @ Thus the log-odds decrease linearly from 1.02 for the first two disease categories by 0.3 per disease category. %% -- Illustrations ------------------------------------------------------------ %% - Virtually all JSS manuscripts list source code along with the generated %% output. The style files provide dedicated environments for this. %% - In R, the environments {Sinput} and {Soutput} - as produced by Sweave() or %% or knitr using the render_sweave() hook - are used (without the need to %% load Sweave.sty). %% - Equivalently, {CodeInput} and {CodeOutput} can be used. %% - The code input should use "the usual" command prompt in the respective %% software system. %% - For R code, the prompt "R> " should be used with "+ " as the %% continuation prompt. %% - Comments within the code chunks should be avoided - these should be made %% within the regular LaTeX text. %% -- Summary/conclusions/discussion ------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Conclusions} \label{sec:conclusions} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% This paper has described the class of cumulative link models for the analysis of ordinal data and the implementation of such models in the \proglang{R} package \pkg{ordinal}. It is shown how the package supports model building and assessment of CLMs with scale effects, partial proportional odds, structured thresholds, flexible link functions and how models can be costumized to specific needs. A number of examples have been given illustrating analyses of ordinal data using \code{clm} in practice. The significant flexibility of model structures available in \pkg{ordinal} is in one respect a clear advantage but it can also be a challenge when particular model variants turn out to be unidentifiable. Analytical detection of unidentifiable models could prove very useful in the analysis of ordinal data, but it is, unfortunately, a difficult question that remains a topic of future research. In a wider data analysis perspective, cumulative link models have been described as a very rich model class---a class that sits in between, in a sense, the perhaps the two most important model classes in statistics; linear models and logistic regression models. The greater flexibility of CLMs relative to binary logistic regression models facilitates the ability to check assumptions such as the partial proportional odds assumption. A latent variable interpretation connects cumulative link models to linear models in a natural way and also motivates non-linear structures such as scale effects. In addition to nominal effects and the non-linear scale effects, the ordered nature of the thresholds gives rise to computational challenges that we have described here and addressed in the \pkg{ordinal} package. In addition to computational challenges, practical data analysis with CLMs can also be challenging. In our experience a top-down approach in which a ``full'' model is fitted and gradually simplified is often problematic, not only because this easily leads to unidentifiable models but also because there are many different ways in which models can be reduced or expanded. A more pragmatic approach is often preferred; understanding the data through plots, tables, and even linear models can aid in finding a suitable intermediate ordinal starting model. Attempts to identify a ``correct'' model will also often lead to frustrations; the greater the model framework, the greater the risk that there are multiple models which fit the data (almost) equally well. It is well known statistical wisdom that with enough data many goodness of fit tests become sensitive to even minor deviations of little practical relevance. This is particularly true for tests of partial proportional odds; in the author's experience almost all CLMs on real data show some evidence of non-proportional odds for one or more variables but it is not always the case that models with partial or non-proportional odds are the most useful. Such effects complicate the interpretation and often generalize poorly outside the observed data and models assuming proportional odds or including scale effects are often more appropriate. %% -- Optional special unnumbered sections ------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section*{Computational details} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % \begin{leftbar} % If necessary or useful, information about certain computational details % such as version numbers, operating systems, or compilers could be included % in an unnumbered section. Also, auxiliary packages (say, for visualizations, % maps, tables, \dots) that are not cited in the main text can be credited here. % \end{leftbar} The results in this paper were obtained using \proglang{R}~\Sexpr{paste(R.Version()[6:7], collapse = ".")} with \pkg{ordinal}, version~\Sexpr{packageVersion("ordinal")}. \proglang{R} itself and all packages used are available from CRAN at \url{https://CRAN.R-project.org/}. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % \section*{Acknowledgments} % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % \begin{leftbar} % % All acknowledgments (note the AE spelling) should be collected in this % unnumbered section before the references. It may contain the usual information % about funding and feedback from colleagues/reviewers/etc. Furthermore, % information such as relative contributions of the authors may be added here % (if any). % \end{leftbar} %% -- Bibliography ------------------------------------------------------------- %% - References need to be provided in a .bib BibTeX database. %% - All references should be made with \cite, \citet, \citep, \citealp etc. %% (and never hard-coded). See the FAQ for details. %% - JSS-specific markup (\proglang, \pkg, \code) should be used in the .bib. %% - Titles in the .bib should be in title case. %% - DOIs should be included where available. \bibliography{clm_article_refs} %% -- Appendix (if any) -------------------------------------------------------- %% - After the bibliography with page break. %% - With proper section titles and _not_ just "Appendix". \newpage \begin{appendix} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{A regularized Newton-Raphson algorithm with step halving} \label{sec:algorithm} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The regularized NR algorithm is an iterative method that produce a sequence of estimates $\bm\psi^{(0)}, \ldots, \bm\psi^{(i)}, \ldots$, where parenthesized superscripts denote iterations. From the $i$th estimate, the $(i+1)$'th estimate is given by % \begin{equation*} \bm\psi^{(i+1)} = \bm\psi^{(i)} - c_1 \bm h^{(i)}, \quad \bm h^{(i)} = \tilde{\bm H}(\bm\psi^{(i)}; \bm y)^{-1} \bm g(\bm\psi^{(i)}; \bm y) \end{equation*} where \begin{equation*} \tilde{\bm H}(\bm\psi^{(i)}; \bm y) = \bm H(\bm\psi^{(i)}; \bm y) + c_2 (c_3 + \min(\bm e^{(i)})) \bm I, \end{equation*} % % where % $\bm h^{(i)}$ is the step of the $i$th iteration, $\bm H(\bm\psi^{(i)} ; \bm y)$ and $\bm g(\bm\psi^{(i)}; \bm y)$ are the Hessian and gradient of the negative log-likelihood function with respect to the parameters evaluated at the current estimates; $\bm e^{(i)}$ is a vector of eigenvalues of $\bm H(\bm\psi^{(i)}; \bm y)$, $\bm h^{(i)}$ is the $i$'th step, $c_1$ is a scalar parameter which controls the step halving, and $c_2$, $c_3$ are scalar parameters which control the regularization of the Hessian. Regularization is only enforced when the Hessian is not positive definite, so $c_2 = 1$ when $\min(\bm e^{(i)}) < \tau$ and zero otherwise, were $\tau$ is an appropriate tolerance. The choice of $c_3$ is to some extent arbitrary (though required positive) and the algorithm in \pkg{ordinal} sets $c_3 = 1$. Step-halving is enforced when the full step $\bm h^{(i)}$ causes a decrease in the likelihood function in which case $c_1$ is consecutively halved, $c_1 = \frac{1}{2}, \frac{1}{4}, \frac{1}{8}, \ldots$ until the step $c_1 \bm h^{(i)}$ is small enough to cause an increase in the likelihood or until the maximum allowed number of consecutive step-halvings has been reached. The algorithm in \pkg{ordinal} also deals with a couple of numerical issues that may occur. For example, the likelihood function may be sufficiently flat that the change in log-likelihood is smaller than what can be represented in double precision, and so, while the new parameters may be closer to the true ML estimates and be associated with a smaller gradient, it is not possible to measure progress by the change in log-likelihood. The NR algorithm in \pkg{ordinal} has two convergence criteria: (1) an absolute criterion requesting that $\max | \bm g(\bm\psi^{(i)}; \bm y) | < \tau_1$ and (2) a relative criterion requesting that $\max | \bm h^{(i)} | < \tau_2$ where the default thresholds are $\tau_1 = \tau_2 = 10^{-6}$. Here the first criterion attempts to establish closeness of $\bm\psi^{(i)}$ to the true ML estimates in absolute terms; the second criterion is an estimate of relative closeness of to the true ML estimates. % Both convergence criteria are needed if both small (e.g., $\approx 0.0001$) and large (e.g., $\approx 1000$) parameter estimates are to be determined accurately with an appropriate number of correct decimals as well as significant digits. The NR algorithm in \pkg{ordinal} attempts to satisfy the absolute criterion first and will then only attempt to satisfy the relative criterion if it can take the full un-regularized NR step and then only for a maximum of 5 steps. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Convergence properties and parameter accuracy} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Convergence to a well-defined optimum is achieved when the gradient of the negative log-likelihood function with respect to the parameters is small and the Hessian is positive definite i.e., having only positive eigenvalues away from zero. % Identifiability problems occur when the likelihood function is flat in directions of one or more parameters (or linear functions of the parameters) while well-defined, i.e., pointy in other directions. It may happen that a parameter is exactly unidentifiable and \code{clm} is in some cases (including rank-deficient design matrices) able to detect this and exclude the parameter from the optimization procedure. In other cases the likelihood is almost flat in one or more directions. These cases are not uncommon in practice and it is not possible to reduce the parameter space before optimizing the model. To measure the degree of empirical identifiability \code{clm} reports the condition number of the Hessian which is the ratio of the largest to the smallest eigenvalue. A large condition number of the Hessian does not necessarily mean there is a problem with the model, but it can be. A small condition number of the Hessian, say smaller than about $10^4$ or $10^6$, on the other hand is a good assurance that a well-defined optimum has been reached. A key problem for optimization methods is when to stop iterating: when have the parameters that determine the optimum of the function been found with sufficient accuracy? The \emph{method independent error estimate} \citep{elden04} provides a way to approximate the error in the parameter estimates. Sufficiently close to the optimum the Newton-Raphson step provides this estimate: \begin{equation*} |\hat{\bm\alpha}^{(i)} - \bm\alpha^*| \lesssim \bm h^{(i)}, \quad \bm h^{(i)} = \bm H(\bm\psi^{(i)}; \bm y)^{-1} \bm g(\bm\psi^{(i)}; \bm y) \end{equation*} where $\bm\alpha^*$ is the exact (but unknown) value of the ML estimate, $\hat{\bm\alpha}^{(i)}$ is the ML estimator of $\bm\alpha$ at the $i$'th iteration and $\bm h^{(i)}$ is the full unregularized NR step at the $i$'th iteration. % Since the gradient and Hessian of the negative log-likelihood function with respect to the parameters is already evaluated and part of the model fit at convergence, it is essentially computationally cost-free to approximate the error in the parameter estimates. Based on the error estimate the number of correctly determined decimals and significant digits is determined for each parameter. The assessment of the number of correctly determined decimals and significant digits is only reliable sufficiently close to the optimum and when the NR algorithm converges without regularization and step-halving. In practice we caution against this assessment if the algorithm did not converge successfully. % % \begin{leftbar} % Appendices can be included after the bibliography (with a page break). Each % section within the appendix should have a proper section title (rather than % just \emph{Appendix}). % % For more technical style details, please check out JSS's style FAQ at % \url{https://www.jstatsoft.org/pages/view/style#frequently-asked-questions} % which includes the following topics: % \begin{itemize} % \item Title vs.\ sentence case. % \item Graphics formatting. % \item Naming conventions. % \item Turning JSS manuscripts into \proglang{R} package vignettes. % \item Trouble shooting. % \item Many other potentially helpful details\dots % \end{itemize} % \end{leftbar} % % % \section[Using BibTeX]{Using \textsc{Bib}{\TeX}} \label{app:bibtex} % % \begin{leftbar} % References need to be provided in a \textsc{Bib}{\TeX} file (\code{.bib}). All % references should be made with \verb|\cite|, \verb|\citet|, \verb|\citep|, % \verb|\citealp| etc.\ (and never hard-coded). This commands yield different % formats of author-year citations and allow to include additional details (e.g., % pages, chapters, \dots) in brackets. In case you are not familiar with these % commands see the JSS style FAQ for details. % % Cleaning up \textsc{Bib}{\TeX} files is a somewhat tedious task -- especially % when acquiring the entries automatically from mixed online sources. However, % it is important that informations are complete and presented in a consistent % style to avoid confusions. JSS requires the following format. % \begin{itemize} % \item JSS-specific markup (\verb|\proglang|, \verb|\pkg|, \verb|\code|) should % be used in the references. % \item Titles should be in title case. % \item Journal titles should not be abbreviated and in title case. % \item DOIs should be included where available. % \item Software should be properly cited as well. For \proglang{R} packages % \code{citation("pkgname")} typically provides a good starting point. % \end{itemize} % \end{leftbar} % \end{appendix} %% ----------------------------------------------------------------------------- \end{document} ordinal/inst/doc/clmm2_tutorial.R0000644000176200001440000002164715130020364016510 0ustar liggesusers### R code from vignette source 'clmm2_tutorial.Rnw' ################################################### ### code chunk number 1: Initialize ################################################### ## Load common packages, functions and set settings: library(ordinal) library(xtable) ## RUN <- FALSE #redo computations and write .RData files ## Change options: op <- options() ## To be able to reset settings options("digits" = 7) options(help_type = "html") ## options("width" = 75) options("SweaveHooks" = list(fig=function() par(mar=c(4,4,.5,0)+.5))) options(continue=" ") ################################################### ### code chunk number 2: clmm2_tutorial.Rnw:152-155 ################################################### data(wine) head(wine) str(wine) ################################################### ### code chunk number 3: clmm2_tutorial.Rnw:176-190 ################################################### data(wine) temp.contact.bottle <- with(wine, temp:contact:bottle)[drop=TRUE] tab <- xtabs(as.numeric(rating) ~ temp.contact.bottle + judge, data=wine) class(tab) <- "matrix" attr(tab, "call") <- NULL mat <- cbind(rep(c("cold", "warm"), each = 4), rep(rep(c("no", "yes"), each=2), 2), 1:8, tab) colnames(mat) <- c("Temperature", "Contact", "Bottle", 1:9) xtab <- xtable(mat) print(xtab, only.contents=TRUE, include.rownames=FALSE, sanitize.text.function = function(x) x) ################################################### ### code chunk number 4: clmm2_tutorial.Rnw:217-219 ################################################### fm1 <- clmm2(rating ~ temp + contact, random=judge, data=wine) fm1 ################################################### ### code chunk number 5: clmm2_tutorial.Rnw:226-229 ################################################### fm2 <- clmm2(rating ~ temp + contact, random=judge, data=wine, Hess=TRUE, nAGQ=10) summary(fm2) ################################################### ### code chunk number 6: clmm2_tutorial.Rnw:265-266 ################################################### exp(coef(fm2)[5]) ################################################### ### code chunk number 7: clmm2_tutorial.Rnw:274-276 ################################################### fm3 <- clmm2(rating ~ temp, random=judge, data=wine, nAGQ=10) anova(fm3, fm2) ################################################### ### code chunk number 8: clmm2_tutorial.Rnw:282-284 ################################################### fm4 <- clm2(rating ~ temp + contact, data=wine) anova(fm4, fm2) ################################################### ### code chunk number 9: clmm2_tutorial.Rnw:295-297 ################################################### pr2 <- profile(fm2, range=c(.1, 4), nSteps=30, trace=0) confint(pr2) ################################################### ### code chunk number 10: profilePlot ################################################### getOption("SweaveHooks")[["fig"]]() plot(pr2) ################################################### ### code chunk number 11: profileFig ################################################### getOption("SweaveHooks")[["fig"]]() plot(pr2) ################################################### ### code chunk number 12: ranefPlot ################################################### getOption("SweaveHooks")[["fig"]]() ci <- fm2$ranef + qnorm(0.975) * sqrt(fm2$condVar) %o% c(-1, 1) ord.re <- order(fm2$ranef) ci <- ci[order(fm2$ranef),] plot(1:9, fm2$ranef[ord.re], axes=FALSE, ylim=range(ci), xlab="Judge", ylab="Judge effect") axis(1, at=1:9, labels = ord.re) axis(2) for(i in 1:9) segments(i, ci[i,1], i, ci[i, 2]) abline(h = 0, lty=2) ################################################### ### code chunk number 13: clmm2_tutorial.Rnw:348-349 ################################################### getOption("SweaveHooks")[["fig"]]() ci <- fm2$ranef + qnorm(0.975) * sqrt(fm2$condVar) %o% c(-1, 1) ord.re <- order(fm2$ranef) ci <- ci[order(fm2$ranef),] plot(1:9, fm2$ranef[ord.re], axes=FALSE, ylim=range(ci), xlab="Judge", ylab="Judge effect") axis(1, at=1:9, labels = ord.re) axis(2) for(i in 1:9) segments(i, ci[i,1], i, ci[i, 2]) abline(h = 0, lty=2) ################################################### ### code chunk number 14: clmm2_tutorial.Rnw:361-362 ################################################### head(cbind(wine, fitted(fm2))) ################################################### ### code chunk number 15: clmm2_tutorial.Rnw:367-368 ################################################### head(cbind(wine, pred=predict(fm2, newdata=wine))) ################################################### ### code chunk number 16: clmm2_tutorial.Rnw:386-388 ################################################### plogis(fm2$Theta[3] - fm2$beta[2]) - plogis(fm2$Theta[2] - fm2$beta[2]) ################################################### ### code chunk number 17: clmm2_tutorial.Rnw:396-397 ################################################### qnorm(0.95) * c(-1, 1) * fm2$stDev ################################################### ### code chunk number 18: clmm2_tutorial.Rnw:402-410 ################################################### pred <- function(eta, theta, cat = 1:(length(theta)+1), inv.link = plogis) { Theta <- c(-1e3, theta, 1e3) sapply(cat, function(j) inv.link(Theta[j+1] - eta) - inv.link(Theta[j] - eta) ) } pred(qnorm(0.05) * fm2$stDev, fm2$Theta) ################################################### ### code chunk number 19: clmm2_tutorial.Rnw:416-434 ################################################### mat <- expand.grid(judge = qnorm(0.95) * c(-1, 0, 1) * fm2$stDev, contact = c(0, fm2$beta[2]), temp = c(0, fm2$beta[1])) pred.mat <- pred(eta=rowSums(mat), theta=fm2$Theta) lab <- paste("contact=", rep(levels(wine$contact), 2), ", ", "temp=", rep(levels(wine$temp), each=2), sep="") par(mfrow=c(2, 2)) for(k in c(1, 4, 7, 10)) { plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") } ################################################### ### code chunk number 20: clmm2_tutorial.Rnw:439-449 ################################################### getOption("SweaveHooks")[["fig"]]() k <- 1 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") ################################################### ### code chunk number 21: clmm2_tutorial.Rnw:451-461 ################################################### getOption("SweaveHooks")[["fig"]]() k <- 4 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") ################################################### ### code chunk number 22: clmm2_tutorial.Rnw:463-473 ################################################### getOption("SweaveHooks")[["fig"]]() k <- 7 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") ################################################### ### code chunk number 23: clmm2_tutorial.Rnw:475-485 ################################################### getOption("SweaveHooks")[["fig"]]() k <- 10 plot(1:5, pred.mat[k,], lty=2, type = "l", ylim=c(0,1), xlab="Bitterness rating scale", axes=FALSE, ylab="Probability", main=lab[ceiling(k/3)], las=1) axis(1); axis(2) lines(1:5, pred.mat[k+1, ], lty=1) lines(1:5, pred.mat[k+2, ], lty=3) legend("topright", c("avg. judge", "5th %-tile judge", "95th %-tile judge"), lty=1:3, bty="n") ################################################### ### code chunk number 24: clmm2_tutorial.Rnw:495-496 ################################################### exp(2*qnorm(0.95) * fm2$stDev) ################################################### ### code chunk number 25: clmm2_tutorial.Rnw:502-503 ################################################### exp(2*qnorm(0.75) * fm2$stDev) ################################################### ### code chunk number 26: misc (eval = FALSE) ################################################### ## ordinal/build/0000755000176200001440000000000015130020364012773 5ustar liggesusersordinal/build/vignette.rds0000644000176200001440000000042115130020364015327 0ustar liggesusers‹ŤOÁNĂ0 ÍÚ®c“űü=đ L»M¸MˇIQDšLIJáĆ—Ż¸ť´Óqěgżççç!$"É8"Q iĽ„Â[p2…˙"Wĺ–Y/s%˛Ť®ľ¸ĽŢúĘ+™ę:}âŐMUVŠyů.čťÔoôŢpˇ-ŚĄ–KÍÝW+ś“F#鼓ĄAö—/ţńŇvúÄyďĂ[v¤>ybn±L?<{QâÔˇżŠä÷OZl„ÓcÍJá°™"¬%ŕŔ“ô?Eü¸Zc: ·LVb'4wXžÝŠĎąÁ˘©5u–Í[g_š¦Ů効ŕ(€3Î<Ë |¨öß*Z]?ordinal/man/0000755000176200001440000000000015125475162012465 5ustar liggesusersordinal/man/dropCoef.Rd0000644000176200001440000000275015125475162014521 0ustar liggesusers\name{drop.coef} \alias{drop.coef} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Ensure Full Rank Design Matrix } \description{ Coefficients (columns) are dropped from a design matrix to ensure that it has full rank. } \usage{ drop.coef(X, silent = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{X}{ a design matrix, e.g., the result of \code{\link{model.matrix}} possibly of less than full column rank, i.e., with redundant parameters. Works for \code{ncol(X) >= 0} and \code{nrow(X) >= 0}. } \item{silent}{ should a message not be issued if X is column rank deficient? } } \details{ Redundant columns of the design matrix are identified with the LINPACK implementation of the \code{\link{qr}} decomposition and removed. The returned design matrix will have \code{qr(X)$rank} columns. } \value{ The design matrix \code{X} without redundant columns. } \author{ Rune Haubo B Christensen } \seealso{ \code{\link{qr}} and \code{\link{lm}} } \examples{ X <- model.matrix( ~ PRODID * DAY, data = soup) ncol(X) newX <- drop.coef(X) ncol(newX) ## Essentially this is being computed: qr.X <- qr(X, tol = 1e-7, LAPACK = FALSE) newX <- X[, qr.X$pivot[1:qr.X$rank], drop = FALSE] ## is newX of full column rank? ncol(newX) == qr(newX)$rank ## the number of columns being dropped: ncol(X) - ncol(newX) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/man/clmm.control.Rd0000644000176200001440000000401015125475162015356 0ustar liggesusers\name{clmm.control} \alias{clmm.control} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Set control parameters for cumulative link mixed models } \description{ Set control parameters for cumulative link mixed models } \usage{ clmm.control(method = c("nlminb", "ucminf", "model.frame"), ..., trace = 0, maxIter = 50, gradTol = 1e-4, maxLineIter = 50, useMatrix = FALSE, innerCtrl = c("warnOnly", "noWarn", "giveError"), checkRanef = c("warn", "error", "message")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{method}{ the optimizer used to maximize the marginal likelihood function. } \item{\dots}{control arguments passed on to the optimizer; see \code{\link[ucminf]{ucminf}} for details. \code{ucminf} for details. } \item{trace}{numerical, if > 0 information is printed about and during the outer optimization process, if < 0 information is also printed about the inner optimization process. Defaults to \code{0}. } \item{maxIter}{the maximum number of Newton updates of the inner optimization. \code{50}. } \item{gradTol}{the maximum absolute gradient of the inner optimization. } \item{maxLineIter}{the maximum number of step halfings allowed if a Newton(-Raphson) step over shoots during the inner optimization. } \item{useMatrix}{if \code{TRUE}, a general implementation of the Laplace approximation using the Matrix package is used, while if \code{FALSE} (default), a C implementation of the Laplace approximation valid only for models with a single random effects term is used when possible. \code{TRUE} is not valid for models fitted with quadrature methods. } \item{innerCtrl}{the use of warnings/errors if the inner optimization fails to converge. } \item{checkRanef}{the use of message/warning/error if there are more random effects than observations. } } \value{ a list of control parameters } \author{ Rune Haubo B Christensen } \seealso{ \code{\link{clmm}} } \keyword{models} ordinal/man/soup.Rd0000755000176200001440000000470015125475162013746 0ustar liggesusers\name{soup} \alias{soup} \title{ Discrimination study of packet soup } \description{ The \code{soup} data frame has 1847 rows and 13 variables. 185 respondents participated in an A-not A discrimination test with sureness. Before experimentation the respondents were familiarized with the reference product and during experimentation, the respondents were asked to rate samples on an ordered scale with six categories given by combinations of (reference, not reference) and (sure, not sure, guess) from 'referene, sure' = 1 to 'not reference, sure' = 6. %given by the levels of the \code{SURENESS} variable. } \usage{ soup } \format{ \describe{ \item{\code{RESP}}{ factor with 185 levels: the respondents in the study. } \item{\code{PROD}}{ factor with 2 levels: index reference and test products. } \item{\code{PRODID}}{ factor with 6 levels: index reference and the five test product variants. } \item{\code{SURENESS}}{ ordered factor with 6 levels: the respondents ratings of soup samples. } \item{\code{DAY}}{ factor with two levels: experimentation was split over two days. } \item{\code{SOUPTYPE}}{ factor with three levels: the type of soup regularly consumed by the respondent. } \item{\code{SOUPFREQ}}{ factor with 3 levels: the frequency with which the respondent consumes soup. } \item{\code{COLD}}{ factor with two levels: does the respondent have a cold? } \item{\code{EASY}}{ factor with ten levels: How easy did the respondent find the discrimation test? 1 = difficult, 10 = easy. } \item{\code{GENDER}}{ factor with two levels: gender of the respondent. } \item{\code{AGEGROUP}}{ factor with four levels: the age of the respondent. } \item{\code{LOCATION}}{ factor with three levels: three different locations where experimentation took place. } %% \item{\code{SEQ}}{ %% integer vector: the sequence at which experimentation took %% place. Numbering restarted at the second day of experimentation. %% } }} \source{ Data are produced by Unilever Research. Permission to publish the data is granted. } \references{ Christensen, R. H. B., Cleaver, G. and Brockhoff, P. B.(2011) Statistical and Thurstonian models for the A-not A protocol with and without sureness. \emph{Food Quality and Preference, 22}, pp. 542-549. } \keyword{datasets} ordinal/man/gumbel.Rd0000644000176200001440000000614015125475162014230 0ustar liggesusers\name{gumbel} \alias{dgumbel} \alias{pgumbel} \alias{qgumbel} \alias{rgumbel} \alias{ggumbel} \title{ The Gumbel Distribution %% ~~function to do ... ~~ } \description{ Density, distribution function, quantile function, random generation, and gradient of density of the extreme value (maximum and minimum) distributions. The Gumbel distribution is also known as the extreme value maximum distribution, the double-exponential distribution and the log-Weibull distribution. %% ~~ A concise (1-5 lines) description of what the function does. ~~ } \usage{ dgumbel(x, location = 0, scale = 1, log = FALSE, max = TRUE) pgumbel(q, location = 0, scale = 1, lower.tail = TRUE, max = TRUE) qgumbel(p, location = 0, scale = 1, lower.tail = TRUE, max = TRUE) rgumbel(n, location = 0, scale = 1, max = TRUE) ggumbel(x, max = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x,q}{ numeric vector of quantiles. } \item{p}{ vector of probabilities. } \item{n}{ number of observations. } \item{location}{ numeric scalar. } \item{scale}{ numeric scalar. } \item{lower.tail}{ logical; if \code{TRUE} (default), probabilities are \eqn{P[X \leq x]}{P[X <= x]} otherwise, \eqn{P[X > x]}. } \item{log}{ logical; if \code{TRUE}, probabilities p are given as log(p). } \item{max}{ distribution for extreme maxima (default) or minima? The default corresponds to the standard right-skew Gumbel distribution. } } \details{ \code{dgumbel}, \code{pgumbel} and \code{ggumbel} are implemented in C for speed and care is taken that 'correct' results are provided for values of \code{NA}, \code{NaN}, \code{Inf}, \code{-Inf} or just extremely small or large. The distribution functions, densities and gradients are used in the Newton-Raphson algorithms in fitting cumulative link models with \code{\link{clm}} and cumulative link mixed models with \code{\link{clmm}}. } \value{ \code{pgumbel} gives the distribution function, \code{dgumbel} gives the density, \code{ggumbel} gives the gradient of the density, \code{qgumbel} is the quantile function, and \code{rgumbel} generates random deviates. } \references{ \url{https://en.wikipedia.org/wiki/Gumbel_distribution} } \seealso{ Gradients of densities are also implemented for the normal, logistic, cauchy, cf. \code{\link[=gnorm]{gfun}} and the log-gamma distribution, cf. \code{\link{lgamma}}. } \author{ Rune Haubo B Christensen } \examples{ ## Illustrating the symmetry of the distribution functions: pgumbel(5) == 1 - pgumbel(-5, max=FALSE) ## TRUE dgumbel(5) == dgumbel(-5, max=FALSE) ## TRUE ggumbel(5) == -ggumbel(-5, max=FALSE) ## TRUE ## More examples: x <- -5:5 (pp <- pgumbel(x)) qgumbel(pp) dgumbel(x) ggumbel(x) (ppp <- pgumbel(x, max=FALSE)) ## Observe that probabilities close to 0 are more accurately determined than ## probabilities close to 1: qgumbel(ppp, max=FALSE) dgumbel(x, max=FALSE) ggumbel(x, max=FALSE) ## random deviates: set.seed(1) (r1 <- rgumbel(10)) set.seed(1) r2 <- -rgumbel(10, max = FALSE) all(r1 == r2) ## TRUE } \keyword{distribution} ordinal/man/ranef.Rd0000644000176200001440000000533215125475162014052 0ustar liggesusers\name{condVar} \alias{ranef} \alias{condVar} \alias{ranef.clmm} \alias{condVar.clmm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract conditional modes and conditional variances from clmm objects } \description{ The ranef function extracts the conditional modes of the random effects from a clmm object. That is, the modes of the distributions for the random effects given the observed data and estimated model parameters. In a Bayesian language they are posterior modes. The conditional variances are computed from the second order derivatives of the conditional distribution of the random effects. Note that these variances are computed at a fixed value of the model parameters and thus do not take the uncertainty of the latter into account. } \usage{ condVar(object, ...) \method{ranef}{clmm}(object, condVar=FALSE, ...) \method{condVar}{clmm}(object, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{a \code{\link{clmm}} object. } \item{condVar}{ an optional logical argument indicating of conditional variances should be added as attributes to the conditional modes. } \item{\dots}{ currently not used by the \code{clmm} methods. } } \details{ The \code{ranef} method returns a list of \code{data.frame}s; one for each distinct grouping factor. Each \code{data.frame} has as many rows as there are levels for that grouping factor and as many columns as there are random effects for each level. For example a model can contain a random intercept (one column) or a random intercept and a random slope (two columns) for the same grouping factor. If conditional variances are requested, they are returned in the same structure as the conditional modes (random effect estimates/predictions). } \value{ The \code{ranef} method returns a list of \code{data.frame}s with the random effects predictions/estimates computed as conditional modes. If \code{condVar = TRUE} a \code{data.frame} with the conditional variances is stored as an attribute on each \code{data.frame} with conditional modes. The \code{condVar} method returns a list of \code{data.frame}s with the conditional variances. It is a convenience function that simply computes the conditional modes and variances, then extracts and returns only the latter. } \author{ Rune Haubo B Christensen } \examples{ fm1 <- clmm(rating ~ contact + temp + (1|judge), data=wine) ## Extract random effect estimates/conditional modes: re <- ranef(fm1, condVar=TRUE) ## Get conditional variances: attr(re$judge, "condVar") ## Alternatively: condVar(fm1) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/man/clmOld.Rd0000644000176200001440000003167415125475162014201 0ustar liggesusers\name{clm2} \alias{clm2} \title{Cumulative link models} \description{ A new improved implementation of CLMs is available in \code{\link{clm}}. Fits cumulative link models with an additive model for the location and a multiplicative model for the scale. The function allows for structured thresholds. A popular special case of a CLM is the proportional odds model. In addition to the standard link functions, two flexible link functions, "Arandar-Ordaz" and "log-gamma" are available, where an extra link function parameter provides additional flexibility. A subset of the predictors can be allowed to have nominal rather than ordinal effects. This has been termed "partial proportional odds" when the link is the logistic. } \usage{ clm2(location, scale, nominal, data, weights, start, subset, na.action, contrasts, Hess = TRUE, model, link = c("logistic", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), lambda, doFit = TRUE, control, threshold = c("flexible", "symmetric", "equidistant"), ...) } \arguments{ \item{location}{ a formula expression as for regression models, of the form \code{response ~ predictors}. The response should be a factor (preferably an ordered factor), which will be interpreted as an ordinal response with levels ordered as in the factor. The model must have an intercept: attempts to remove one will lead to a warning and will be ignored. An offset may be used. See the documentation of \code{\link{formula}} for other details. } \item{scale}{ a optional formula expression as for the location part, of the form \code{ ~ predictors}, i.e. with an empty left hand side. An offset may be used. See the documentation of \code{\link{formula}} for other details. } \item{nominal}{ an optional formula of the form \code{ ~ predictors}, i.e. with an empty left hand side. The effects of the predictors in this formula are assumed to nominal. } \item{data}{ an optional data frame in which to interpret the variables occurring in the formulas. } \item{weights}{ optional case weights in fitting. Defaults to 1. } \item{start}{ initial values for the parameters in the format \code{c(alpha, beta, log(zeta), lambda)}. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. All observations are included by default. } \item{na.action}{ a function to filter missing data. Applies to terms in all three formulae. } \item{contrasts}{ a list of contrasts to be used for some or all of the factors appearing as variables in the model formula. } \item{Hess}{ logical for whether the Hessian (the inverse of the observed information matrix) should be computed. Use \code{Hess = TRUE} if you intend to call \code{summary} or \code{vcov} on the fit and \code{Hess = FALSE} in all other instances to save computing time. The argument is ignored if \code{method = "Newton"} where the Hessian is always computed and returned. Defaults to \code{TRUE}. } \item{model}{ logical for whether the model frames should be part of the returned object. } \item{link}{link function, i.e. the type of location-scale distribution assumed for the latent distribution. The \code{Aranda-Ordaz} and \code{log-gamma} links add additional flexibility with a link function parameter, \code{lambda}. The \code{Aranda-Ordaz} link (Aranda-Ordaz, 1983) equals the logistic link, when \code{lambda = 1} and approaches the \code{loglog} link when \code{lambda} approaches zero. The \code{log-gamma} link (Genter and Farewell, 1985) equals the \code{loglog} link when \code{lambda = 1}, the \code{probit} link when \code{lambda = 0} and the \code{cloglog} link when \code{lambda = -1}. } \item{lambda}{numerical scalar: the link function parameter. Used in combination with link \code{Aranda-Ordaz} or \code{log-gamma} and otherwise ignored. If lambda is specified, the model is estimated with lambda fixed at this value and otherwise lambda is estimated by ML. For \code{Aranda-Ordaz} lambda has to be positive; \code{> 1e-5} for numerical reasons. } \item{doFit}{logical for whether the model should be fit or the model environment should be returned. } \item{control}{a call to \code{\link{clm2.control}}. } \item{threshold}{specifies a potential structure for the thresholds (cut-points). \code{"flexible"} provides the standard unstructured thresholds, \code{"symmetric"} restricts the distance between the thresholds to be symmetric around the central one or two thresholds for odd or equal numbers or thresholds respectively, and \code{"equidistant"} restricts the distance between consecutive thresholds to the same value. } \item{\dots}{ additional arguments are passed on to \code{\link{clm2.control}} and possibly further on to the optimizer, which can lead to surprising error or warning messages when mistyping arguments etc. } } \details{ There are methods for the standard model-fitting functions, including \code{\link{summary}}, \code{\link{vcov}}, \code{\link[ordinal]{predict}}, \code{\link[=anova.clm2]{anova}}, \code{\link{logLik}}, \code{\link[=profile.clm2]{profile}}, \code{\link[=profile.clm2]{plot.profile}}, \code{\link[=confint.clm2]{confint}}, \code{\link[=update.clm2]{update}}, \code{\link[=addterm.clm2]{dropterm}}, \code{\link[=addterm.clm2]{addterm}}, and an \code{extractAIC} method. The design of the implementation is inspired by an idea proposed by Douglas Bates in the talk "Exploiting sparsity in model matrices" presented at the DSC conference in Copenhagen, July 14 2009. Basically an environment is set up with all the information needed to optimize the likelihood function. Extractor functions are then used to get the value of likelihood at current or given parameter values and to extract current values of the parameters. All computations are performed inside the environment and relevant variables are updated during the fitting process. After optimizer termination relevant variables are extracted from the environment and the remaining are discarded. Some aspects of \code{clm2}, for instance, how starting values are obtained, and of the associated methods are inspired by \code{\link[MASS]{polr}} from package \code{MASS}. } \value{ If \code{doFit = FALSE} the result is an environment representing the model ready to be optimized. If \code{doFit = TRUE} the result is an object of class \code{"clm2"} with the following components: \item{beta}{the parameter estimates of the location part. } \item{zeta}{the parameter estimates of the scale part on the log scale; the scale parameter estimates on the original scale are given by \code{exp(zeta)}. } \item{Alpha}{vector or matrix of the threshold parameters. } \item{Theta}{vector or matrix of the thresholds. } \item{xi}{vector of threshold parameters, which, given a threshold function (e.g. \code{"equidistant"}), and possible nominal effects define the class boundaries, \code{Theta}. } \item{lambda}{the value of lambda if lambda is supplied or estimated, otherwise missing. } \item{coefficients}{the coefficients of the intercepts (\code{theta}), the location (\code{beta}), the scale (\code{zeta}), and the link function parameter (\code{lambda}). } \item{df.residual}{the number of residual degrees of freedoms, calculated using the weights. } \item{fitted.values}{vector of fitted values for each observation. An observation here is each of the scalar elements of the multinomial table and not a multinomial vector. } \item{convergence}{\code{TRUE} if the gradient based convergence criterion is met and \code{FALSE} otherwise. } \item{gradient}{vector of gradients for all the parameters at termination of the optimizer. } \item{optRes}{list with results from the optimizer. The contents of the list depends on the choice of optimizer. } \item{logLik}{the log likelihood of the model at optimizer termination. } \item{Hessian}{if the model was fitted with \code{Hess = TRUE}, this is the Hessian matrix of the parameters at the optimum. } \item{scale}{\code{model.frame} for the scale model. } \item{location}{\code{model.frame} for the location model. } \item{nominal}{\code{model.frame} for the nominal model. } \item{edf}{the (effective) number of degrees of freedom used by the model. } \item{start}{the starting values. } \item{convTol}{convergence tolerance for the maximum absolute gradient of the parameters at termination of the optimizer. } \item{method}{character, the optimizer. } \item{y}{the response variable. } \item{lev}{the names of the levels of the response variable. } \item{nobs}{the (effective) number of observations, calculated as the sum of the weights. } \item{threshold}{character, the threshold function used in the model. } \item{estimLambda}{\code{1} if lambda is estimated in one of the flexible link functions and \code{0} otherwise. } \item{link}{character, the link function used in the model. } \item{call}{the matched call. } \item{contrasts}{contrasts applied to terms in location and scale models. } \item{na.action}{the function used to filter missing data. } } \author{Rune Haubo B Christensen} \references{ Agresti, A. (2002) \emph{Categorical Data Analysis.} Second edition. Wiley. Aranda-Ordaz, F. J. (1983) An Extension of the Proportional-Hazards Model for Grouped Data. \emph{Biometrics}, 39, 109-117. Genter, F. C. and Farewell, V. T. (1985) Goodness-of-link testing in ordinal regression models. \emph{The Canadian Journal of Statistics}, 13(1), 37-44. Christensen, R. H. B., Cleaver, G. and Brockhoff, P. B. (2011) Statistical and Thurstonian models for the A-not A protocol with and without sureness. \emph{Food Quality and Preference, 22}, pp. 542-549. } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) ## A tabular data set: (tab26 <- with(soup, table("Product" = PROD, "Response" = SURENESS))) dimnames(tab26)[[2]] <- c("Sure", "Not Sure", "Guess", "Guess", "Not Sure", "Sure") dat26 <- expand.grid(sureness = as.factor(1:6), prod = c("Ref", "Test")) dat26$wghts <- c(t(tab26)) m1 <- clm2(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logistic") ## print, summary, vcov, logLik, AIC: m1 summary(m1) vcov(m1) logLik(m1) AIC(m1) coef(m1) coef(summary(m1)) ## link functions: m2 <- update(m1, link = "probit") m3 <- update(m1, link = "cloglog") m4 <- update(m1, link = "loglog") m5 <- update(m1, link = "cauchit", start = coef(m1)) m6 <- update(m1, link = "Aranda-Ordaz", lambda = 1) m7 <- update(m1, link = "Aranda-Ordaz") m8 <- update(m1, link = "log-gamma", lambda = 1) m9 <- update(m1, link = "log-gamma") ## nominal effects: mN1 <- clm2(sureness ~ 1, nominal = ~ prod, data = dat26, weights = wghts, link = "logistic") anova(m1, mN1) ## optimizer / method: update(m1, scale = ~ 1, method = "Newton") update(m1, scale = ~ 1, method = "nlminb") update(m1, scale = ~ 1, method = "optim") \dontshow{ update(m1, scale = ~ 1, method = "model.frame") update(m1, location = ~.-prod, scale = ~ 1, nominal = ~ prod, method = "model.frame") } ## threshold functions mT1 <- update(m1, threshold = "symmetric") mT2 <- update(m1, threshold = "equidistant") anova(m1, mT1, mT2) ## Extend example from polr in package MASS: ## Fit model from polr example: if(require(MASS)) { fm1 <- clm2(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) fm1 summary(fm1) ## With probit link: summary(update(fm1, link = "probit")) ## Allow scale to depend on Cont-variable summary(fm2 <- update(fm1, scale =~ Cont)) anova(fm1, fm2) ## which seems to improve the fit } ################################# ## It is possible to fit multinomial models (i.e. with nominal ## effects) as the following example shows: if(require(nnet)) { (hous1.mu <- multinom(Sat ~ 1, weights = Freq, data = housing)) (hous1.clm <- clm2(Sat ~ 1, weights = Freq, data = housing)) ## It is the same likelihood: all.equal(logLik(hous1.mu), logLik(hous1.clm)) ## and the same fitted values: fitHous.mu <- t(fitted(hous1.mu))[t(col(fitted(hous1.mu)) == unclass(housing$Sat))] all.equal(fitted(hous1.clm), fitHous.mu) ## The coefficients of multinom can be retrieved from the clm2-object ## by: Pi <- diff(c(0, plogis(hous1.clm$xi), 1)) log(Pi[2:3]/Pi[1]) ## A larger model with explanatory variables: (hous.mu <- multinom(Sat ~ Infl + Type + Cont, weights = Freq, data = housing)) (hous.clm <- clm2(Sat ~ 1, nominal = ~ Infl + Type + Cont, weights = Freq, data = housing)) ## Almost the same likelihood: all.equal(logLik(hous.mu), logLik(hous.clm)) ## And almost the same fitted values: fitHous.mu <- t(fitted(hous.mu))[t(col(fitted(hous.mu)) == unclass(housing$Sat))] all.equal(fitted(hous.clm), fitHous.mu) all.equal(round(fitted(hous.clm), 5), round(fitHous.mu), 5) } } \keyword{models} ordinal/man/updateOld.Rd0000644000176200001440000000316515125475162014702 0ustar liggesusers\name{update.clm2} \alias{update.clm2} \alias{update.clmm2} \title{Update method for cumulative link models} \description{ Update method for cumulative link models fitted with \code{clm2}. This makes it possible to use e.g. \code{update(obj, location = ~ . - var1, scale = ~ . + var2)} } \usage{ \method{update}{clm2}(object, formula., location, scale, nominal,..., evaluate = TRUE) \method{update}{clmm2}(object, formula., location, scale, nominal,..., evaluate = TRUE) } \arguments{ \item{object}{a \code{\link{clm2}} object. } \item{formula.}{not used---unfortunately this argument is part of the default method. } \item{location}{an optional new formula for the location; see \code{\link{update.formula}} for details. } \item{scale}{an optional new formula for the scale; see \code{\link{update.formula}} for details. } \item{nominal}{an optional new formula for nominal effects; see \code{\link{update.formula}} for details. } \item{\dots}{additional arguments to the call, or arguments with changed values. } \item{evaluate}{if true evaluate the new call else return the call. } } \value{ If \code{evaluate = TRUE} the fitted object is returned, otherwise the updated call. } \author{Rune Haubo B Christensen} \examples{ options(contrasts = c("contr.treatment", "contr.poly")) m1 <- clm2(SURENESS ~ PROD, scale = ~PROD, data = soup, link = "logistic") m2 <- update(m1, link = "probit") m3 <- update(m1, link = "cloglog") m4 <- update(m1, link = "loglog") anova(m1, update(m1, scale = ~.-PROD)) mT1 <- update(m1, threshold = "symmetric") } \keyword{internal} ordinal/man/clmm.controlOld.Rd0000755000176200001440000000322315125475162016025 0ustar liggesusers\name{clmm2.control} \alias{clmm2.control} \title{Set control parameters for cumulative link mixed models} \description{ Set control parameters for cumulative link mixed models } \usage{ clmm2.control(method = c("ucminf", "nlminb", "model.frame"), ..., trace = 0, maxIter = 50, gradTol = 1e-4, maxLineIter = 50, innerCtrl = c("warnOnly", "noWarn", "giveError")) } \arguments{ \item{method}{ the optimizer used to maximize the marginal likelihood function. } \item{\dots}{control arguments passed on to the chosen optimizer; see \code{\link[ucminf]{ucminf}}, \code{\link{optim}}, and \code{\link{nlminb}} for details. } \item{trace}{numerical, if > 0 information is printed about and during the outer optimization process, if < 0 information is also printed about the inner optimization process. Defaults to \code{0}. } \item{maxIter}{the maximum number of Newton updates of the inner optimization. \code{50}. } \item{gradTol}{the maximum absolute gradient of the inner optimization. } \item{maxLineIter}{the maximum number of step halfings allowed if a Newton(-Raphson) step over shoots during the inner optimization. } \item{innerCtrl}{the use of warnings/errors if the inner optimization fails to converge. } } \details{ When the default optimizer, \code{ucminf} is used, the default values of that optimizers control options are changed to \code{grtol = 1e-5} and \code{grad = "central"}. } \value{ a list of control parameters. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{clmm2}} } \keyword{models} ordinal/man/gfun.Rd0000755000176200001440000000375415125475162013727 0ustar liggesusers\name{gfun} \alias{gnorm} \alias{glogis} \alias{gcauchy} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Gradients of common densities %% ~~function to do ... ~~ } \description{ Gradients of common density functions in their standard forms, i.e., with zero location (mean) and unit scale. These are implemented in C for speed and care is taken that the correct results are provided for the argument being \code{NA}, \code{NaN}, \code{Inf}, \code{-Inf} or just extremely small or large. %% ~~ A concise (1-5 lines) description of what the function does. ~~ } \usage{ gnorm(x) glogis(x) gcauchy(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ numeric vector of quantiles. } } \details{ The gradients are given by: \itemize{ \item{gnorm: If \eqn{f(x)} is the normal density with mean 0 and spread 1, then the gradient is \deqn{f'(x) = -x f(x)} } \item{glogis: If \eqn{f(x)} is the logistic density with mean 0 and scale 1, then the gradient is \deqn{f'(x) = 2 \exp(-x)^2 (1 + \exp(-x))^{-3} - \exp(-x)(1+\exp(-x))^{-2}} } \item{pcauchy: If \eqn{f(x) = [\pi(1 + x^2)^2]^{-1}}{f(x) =1 / [pi (1 + x^2)^2]} is the cauchy density with mean 0 and scale 1, then the gradient is \deqn{f'(x) = -2x [\pi(1 + x^2)^2]^{-1}}{f'(x) = -2x / [pi (1 + x^2)^2]} } } These gradients are used in the Newton-Raphson algorithms in fitting cumulative link models with \code{\link{clm}} and cumulative link mixed models with \code{\link{clmm}}. } \value{ a numeric vector of gradients. } \seealso{ Gradients of densities are also implemented for the extreme value distribtion (\code{\link[=dgumbel]{gumbel}}) and the the log-gamma distribution (\code{\link[=lgamma]{log-gamma}}). } \author{ Rune Haubo B Christensen } \examples{ x <- -5:5 gnorm(x) glogis(x) gcauchy(x) } \keyword{distribution} ordinal/man/clmm.Rd0000644000176200001440000001572115125475162013712 0ustar liggesusers\name{clmm} \alias{clmm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Cumulative Link Mixed Models } \description{ Fits Cumulative Link Mixed Models with one or more random effects via the Laplace approximation or quadrature methods } \usage{ clmm(formula, data, weights, start, subset, na.action, contrasts, Hess = TRUE, model = TRUE, link = c("logit", "probit", "cloglog", "loglog", "cauchit"), doFit = TRUE, control = list(), nAGQ = 1L, threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) %% also document getNLA(rho, par) here and include examples } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ a two-sided linear formula object describing the fixed-effects part of the model, with the response on the left of a ~ operator and the terms, separated by + operators, on the right. The vertical bar character "|" separates an expression for a model matrix and a grouping factor. } \item{data}{ an optional data frame in which to interpret the variables occurring in the formula. } \item{weights}{ optional case weights in fitting. Defaults to 1. } \item{start}{ optional initial values for the parameters in the format \code{c(alpha, beta, tau)}, where \code{alpha} are the threshold parameters, \code{beta} are the fixed regression parameters and \code{tau} are variance parameters for the random effects on the log scale. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. All observations are included by default. } \item{na.action}{ a function to filter missing data. } \item{contrasts}{ a list of contrasts to be used for some or all of the factors appearing as variables in the model formula. } \item{Hess}{ logical for whether the Hessian (the inverse of the observed information matrix) should be computed. Use \code{Hess = TRUE} if you intend to call \code{summary} or \code{vcov} on the fit and \code{Hess = FALSE} in all other instances to save computing time. } \item{model}{ logical for whether the model frames should be part of the returned object. } \item{link}{ link function, i.e. the type of location-scale distribution assumed for the latent distribution. The default \code{"logit"} link gives the proportional odds mixed model. } \item{doFit}{ logical for whether the model should be fit or the model environment should be returned. } \item{control}{ a call to \code{\link{clmm.control}} } \item{nAGQ}{ integer; the number of quadrature points to use in the adaptive Gauss-Hermite quadrature approximation to the likelihood function. The default (\code{1}) gives the Laplace approximation. Higher values generally provide higher precision at the expense of longer computation times, and values between 5 and 10 generally provide accurate maximum likelihood estimates. Negative values give the non-adaptive Gauss-Hermite quadrature approximation, which is generally faster but less accurate than the adaptive version. See the references for further details. Quadrature methods are only available with a single random effects term; the Laplace approximation is always available. } \item{threshold}{ specifies a potential structure for the thresholds (cut-points). \code{"flexible"} provides the standard unstructured thresholds, \code{"symmetric"} restricts the distance between the thresholds to be symmetric around the central one or two thresholds for odd or equal numbers or thresholds respectively, \code{"symmetric2"} restricts the latent mean in the reference group to zero; this means that the central threshold (even no. response levels) is zero or that the two central thresholds are equal apart from their sign (uneven no. response levels), and \code{"equidistant"} restricts the distance between consecutive thresholds to be of the same size. } \item{\dots}{ additional arguments are passed on to \code{\link{clm.control}}. } } \details{ This is a new (as of August 2011) improved implementation of CLMMs. The old implementation is available in \code{\link{clmm2}}. Some features are not yet available in \code{clmm}; for instance scale effects, nominal effects and flexible link functions are currently only available in \code{clmm2}. \code{clmm} is expected to take over \code{clmm2} at some point. There are standard print, summary and anova methods implemented for \code{"clmm"} objects. } \value{ a list containing \item{alpha}{threshold parameters.} \item{beta}{fixed effect regression parameters.} \item{stDev}{standard deviation of the random effect terms.} \item{tau}{\code{log(stDev)} - the scale at which the log-likelihood function is optimized.} \item{coefficients}{the estimated model parameters = \code{c(alpha, beta, tau)}.} \item{control}{List of control parameters as generated by \code{\link{clm.control}}. } \item{Hessian}{Hessian of the model coefficients.} \item{edf}{the estimated degrees of freedom used by the model = \code{length(coefficients)}.} \item{nobs}{\code{sum(weights)}.} \item{n}{length(y).} \item{fitted.values}{fitted values evaluated with the random effects at their conditional modes.} \item{df.residual}{residual degrees of freedom; \code{length(y) - sum(weights)}} \item{tJac}{Jacobian of the threshold function corresponding to the mapping from standard flexible thresholds to those used in the model.} \item{terms}{the terms object for the fixed effects.} \item{contrasts}{contrasts applied to the fixed model terms.} \item{na.action}{the function used to filter missing data.} \item{call}{the matched call.} \item{logLik}{value of the log-likelihood function for the model at the optimum.} \item{Niter}{number of Newton iterations in the inner loop update of the conditional modes of the random effects.} \item{optRes}{list of results from the optimizer.} \item{ranef}{list of the conditional modes of the random effects.} \item{condVar}{list of the conditional variance of the random effects at their conditional modes.} } %% \references{ bla %% %% ~put references to the literature/web site here ~ %% } \author{ Rune Haubo B Christensen } \examples{ ## Cumulative link model with one random term: fmm1 <- clmm(rating ~ temp + contact + (1|judge), data = wine) summary(fmm1) \dontrun{ ## May take a couple of seconds to run this. ## Cumulative link mixed model with two random terms: mm1 <- clmm(SURENESS ~ PROD + (1|RESP) + (1|RESP:PROD), data = soup, link = "probit", threshold = "equidistant") mm1 summary(mm1) ## test random effect: mm2 <- clmm(SURENESS ~ PROD + (1|RESP), data = soup, link = "probit", threshold = "equidistant") anova(mm1, mm2) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/man/clm.anova.Rd0000644000176200001440000000366415125475162014643 0ustar liggesusers\name{anova.clm} %%\alias{anova} \alias{anova.clm} \title{ANODE Tables and Likelihood ratio test of cumulative link models} \description{ Type I, II, and III analysis of deviance (ANODE) tables for cumulative link models and comparison of cumulative link models with likelihood ratio tests. Models may differ by terms in location, scale and nominal formulae, in link, threshold function. } \usage{ \method{anova}{clm}(object, ..., type = c("I", "II", "III", "1", "2", "3")) } \arguments{ \item{object}{a \code{\link{clm}} object. } \item{\dots}{optionally one or more additional \code{\link{clm}} objects. } \item{type}{the type of hypothesis test if \code{anova} is called with a single model; ignored if more than one model is passed to the method. } } \details{ The ANODE table returned when \code{anova} is called with a single model apply only to terms in \code{formula}, that is, terms in \code{nominal} and \code{scale} are ignored. } \value{ An analysis of deviance table based on Wald chi-square test if called with a single model and a comparison of models with likelihood ratio tests if called with more than one model. } \author{Rune Haubo B Christensen} \seealso{ \code{\link[ordinal]{clm}} } \examples{ ## Analysis of deviance tables with Wald chi-square tests: fm <- clm(rating ~ temp * contact, scale=~contact, data=wine) anova(fm, type="I") anova(fm, type="II") anova(fm, type="III") options(contrasts = c("contr.treatment", "contr.poly")) m1 <- clm2(SURENESS ~ PROD, scale = ~PROD, data = soup, link = "logistic") ## anova anova(m1, update(m1, scale = ~.-PROD)) mN1 <- clm2(SURENESS ~ 1, nominal = ~PROD, data = soup, link = "logistic") anova(m1, mN1) anova(m1, update(m1, scale = ~.-PROD), mN1) ## Fit model from polr example: if(require(MASS)) { fm1 <- clm2(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) anova(fm1, update(fm1, scale =~ Cont)) } } \keyword{models} ordinal/man/predict.Rd0000644000176200001440000001136015125475162014407 0ustar liggesusers\name{predict.clm} \alias{predict.clm} \title{Predict Method for CLM fits} \description{ Obtains predictions from a cumulative link model. } \usage{ \method{predict}{clm}(object, newdata, se.fit = FALSE, interval = FALSE, level = 0.95, type = c("prob", "class", "cum.prob", "linear.predictor"), na.action = na.pass, ...) } \arguments{ \item{object}{a fitted object of class inheriting from \code{clm}.} \item{newdata}{optionally, a data frame in which to look for variables with which to predict. Note that all predictor variables should be present having the same names as the variables used to fit the model. If the response variable is present in \code{newdata} predictions are obtained for the levels of the response as given by \code{newdata}. If the response variable is omitted from \code{newdata} predictions are obtained for all levels of the response variable for each of the rows of \code{newdata}. } \item{se.fit}{should standard errors of the predictions be provided? Not applicable and ignored when \code{type = "class"}. } \item{interval}{should confidence intervals for the predictions be provided? Not applicable and ignored when \code{type = "class"}. } \item{level}{the confidence level. } \item{type}{the type of predictions. \code{"prob"} gives probabilities, \code{"class"} gives predicted response class membership defined as highest probability prediction, \code{"cum.prob"} gives cumulative probabilities (see details) and \code{"linear.predictor"} gives predictions on the scale of the linear predictor including the boundary categories. } \item{na.action}{function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}. } \item{\dots}{further arguments passed to or from other methods. } } \details{ If \code{newdata} is omitted and \code{type = "prob"} a vector of fitted probabilities are returned identical to the result from \code{fitted}. If \code{newdata} is supplied and the response variable is omitted, then predictions, standard errors and intervals are matrices rather than vectors with the same number of rows as \code{newdata} and with one column for each response class. If \code{type = "class"} predictions are always a vector. If \code{newdata} is omitted, the way missing values in the original fit are handled is determined by the \code{na.action} argument of that fit. If \code{na.action = na.omit} omitted cases will not appear in the residuals, whereas if \code{na.action = na.exclude} they will appear (in predictions, standard errors or interval limits), with residual value \code{NA}. See also \code{\link{napredict}}. If \code{type = "cum.prob"} or \code{type = "linear.predictor"} there will be two sets of predictions, standard errors and intervals; one for j and one for j-1 (in the usual notation) where j = 1, ..., J index the response classes. If newdata is supplied and the response variable is omitted, then \code{predict.clm} returns much the same thing as \code{predict.polr} (matrices of predictions). Similarly, if \code{type = "class"}. If the fit is rank-deficient, some of the columns of the design matrix will have been dropped. Prediction from such a fit only makes sense if newdata is contained in the same subspace as the original data. That cannot be checked accurately, so a warning is issued (cf. \code{\link{predict.lm}}). If a flexible link function is used (\code{Aranda-Ordaz} or \code{log-gamma}) standard errors and confidence intervals of predictions do not take the uncertainty in the link-parameter into account. } \value{ A list containing the following components \item{fit}{predictions or fitted values if \code{newdata} is not supplied. } \item{se.fit}{if \code{se.fit=TRUE} standard errors of the predictions otherwise \code{NULL}. } \item{upr, lwr}{if \code{interval=TRUE} lower and upper confidence limits.} } \author{Rune Haubo B Christensen} \seealso{ \code{\link[ordinal]{clm}}, \code{\link[ordinal]{clmm}}. } \examples{ ## simple model: fm1 <- clm(rating ~ contact + temp, data=wine) summary(fm1) ## Fitted values with standard errors and confidence intervals: predict(fm1, se.fit=TRUE, interval=TRUE) # type="prob" ## class predictions for the observations: predict(fm1, type="class") newData <- expand.grid(temp = c("cold", "warm"), contact = c("no", "yes")) ## Predicted probabilities in all five response categories for each of ## the four cases in newData: predict(fm1, newdata=newData, type="prob") ## now include standard errors and intervals: predict(fm1, newdata=newData, se.fit=TRUE, interval=TRUE, type="prob") } \keyword{models} ordinal/man/clm.controlOld.Rd0000755000176200001440000000332515125475162015653 0ustar liggesusers\name{clm2.control} \alias{clm2.control} \title{Set control parameters for cumulative link models} \description{ Set control parameters for cumulative link models } \usage{ clm2.control(method = c("ucminf", "Newton", "nlminb", "optim", "model.frame"), ..., convTol = 1e-4, trace = 0, maxIter = 100, gradTol = 1e-5, maxLineIter = 10) } \arguments{ \item{method}{ the optimizer used to maximize the likelihood function. \code{"Newton"} only works for models without \code{scale}, structured thresholds and flexible link functions, but is considerably faster than the other optimizers when applicable. \code{model.frame} simply returns a list of model frames with the location, scale and nominal model frames. \code{"optim"} uses the \code{"BFGS"} method. } \item{\dots}{control arguments passed on to the chosen optimizer; see \code{\link[ucminf]{ucminf}}, \code{\link{optim}}, and \code{\link{nlminb}} for details. } \item{convTol}{convergence criterion on the size of the maximum absolute gradient. } \item{trace}{numerical, if > 0 information is printed about and during the optimization process. Defaults to \code{0}. } \item{maxIter}{the maximum number of Newton-Raphson iterations. Defaults to \code{100}. } \item{gradTol}{the maximum absolute gradient. This is the termination criterion and defaults to \code{1e-5}. } \item{maxLineIter}{the maximum number of step halfings allowed if a Newton(-Raphson) step over shoots. Defaults to \code{10}. } } \value{ a list of control parameters. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{clm2}} } \keyword{models} ordinal/man/addtermOld.Rd0000644000176200001440000000655015125475162015041 0ustar liggesusers\name{addterm.clm2} \alias{addterm.clm2} \alias{dropterm.clm2} \title{ Try all one-term additions to and deletions from a model } \description{ Try fitting all models that differ from the current model by adding or deleting a single term from those supplied while maintaining marginality. } \usage{ \method{addterm}{clm2}(object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, which = c("location", "scale"), \dots) \method{dropterm}{clm2}(object, scope, scale = 0, test = c("none", "Chisq"), k = 2, sorted = FALSE, trace = FALSE, which = c("location", "scale"), \dots) } \arguments{ \item{object}{ A \code{\link{clm2}} object. } \item{scope}{ for \code{addterm}: a formula specifying a maximal model which should include the current one. All additional terms in the maximal model with all marginal terms in the original model are tried. For \code{dropterm}: a formula giving terms which might be dropped. By default, the model formula. Only terms that can be dropped and maintain marginality are actually tried. } \item{scale}{ used in the definition of the AIC statistic for selecting the models. Specifying \code{scale} asserts that the dispersion is known. } \item{test}{ should the results include a test statistic relative to the original model? The Chisq test is a likelihood-ratio test. } \item{k}{ the multiple of the number of degrees of freedom used for the penalty. Only \code{k=2} gives the genuine AIC: \code{k = log(n)} is sometimes referred to as BIC or SBC. } \item{sorted}{ should the results be sorted on the value of AIC? } \item{trace}{ if \code{TRUE} additional information may be given on the fits as they are tried. } \item{which}{should additions or deletions occur in location or scale models? } \item{\dots}{ arguments passed to or from other methods. }} \value{ A table of class \code{"anova"} containing columns for the change in degrees of freedom, AIC and the likelihood ratio statistic. If \code{test = "Chisq"} a column also contains the p-value from the Chisq test. } \details{ The definition of AIC is only up to an additive constant because the likelihood function is only defined up to an additive constant. } \author{Rune Haubo B Christensen} \seealso{ \code{\link[ordinal]{clm2}}, \code{\link[=anova.clm2]{anova}}, \code{\link[MASS]{addterm.default}} and \code{\link[MASS]{dropterm.default}} } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) if(require(MASS)) { ## dropterm, addterm, housing mB1 <- clm2(SURENESS ~ PROD + GENDER + SOUPTYPE, scale = ~ COLD, data = soup, link = "probit", Hess = FALSE) dropterm(mB1, test = "Chi") # or dropterm(mB1, which = "location", test = "Chi") dropterm(mB1, which = "scale", test = "Chi") addterm(mB1, scope = ~.^2, test = "Chi", which = "location") addterm(mB1, scope = ~ . + GENDER + SOUPTYPE, test = "Chi", which = "scale") addterm(mB1, scope = ~ . + AGEGROUP + SOUPFREQ, test = "Chi", which = "location") ## Fit model from polr example: fm1 <- clm2(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) addterm(fm1, ~ Infl + Type + Cont, test= "Chisq", which = "scale") dropterm(fm1, test = "Chisq") } } \keyword{internal} ordinal/man/clm.fit.Rd0000644000176200001440000000756715125475162014327 0ustar liggesusers\name{clm.fit} \alias{clm.fit} \alias{clm.fit.default} \alias{clm.fit.factor} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Fit Cumulative Link Models %% ~~function to do ... ~~ } \description{ A direct fitter of cumulative link models. } \usage{ clm.fit(y, ...) \method{clm.fit}{default}(y, ...) \method{clm.fit}{factor}(y, X, S, N, weights = rep(1, nrow(X)), offset = rep(0, nrow(X)), S.offset = rep(0, nrow(X)), control = list(), start, doFit=TRUE, link = c("logit", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{y}{for the default method a list of model components. For the factor method the response variable; a factor, preferably and ordered factor. } \item{X, S, N}{optional design matrices for the regression parameters, scale parameters and nominal parameters respectively. } \item{weights}{optional case weights. } \item{offset}{an optional offset. } \item{S.offset}{an optional offset for the scale part of the model. } \item{control}{a list of control parameters, optionally a call to \code{\link{clm.control}}. } \item{start}{an optional list of starting values of the form \code{c(alpha, beta, zeta)} for the thresholds and nominal effects (\code{alpha}), regression parameters (\code{beta}) and scale parameters (\code{zeta}). } \item{doFit}{logical for whether the model should be fit or the model environment should be returned. } \item{link}{the link function. } \item{threshold}{the threshold structure, see further at \code{\link{clm}}. } \item{\dots}{currently not used.} } \details{ This function does almost the same thing that \code{\link{clm}} does: it fits a cumulative link model. The main differences are that \code{clm.fit} does not setup design matrices from formulae and only does minimal post processing after parameter estimation. Compared to \code{\link{clm}}, \code{clm.fit} does little to warn the user of any problems with data or model. However, \code{clm.fit} will attempt to identify column rank defecient designs. Any unidentified parameters are indicated in the \code{aliased} component of the fit. \code{clm.fit.factor} is not able to check if all thresholds are increasing when nominal effects are specified since it needs access to the terms object for the nominal model. If the terms object for the nominal model (\code{nom.terms}) is included in \code{y}, the default method is able to chech if all thresholds are increasing. %% In contrast to \code{\link{clm}}, \code{clm.fit} allows non-positive %% weights. } \value{ A list with the following components: \code{aliased, alpha, coefficients, cond.H, convergence, df.residual, edf, fitted.values, gradient, Hessian, logLik, maxGradient, message, n, niter, nobs, tJac, vcov} and optionally \code{beta, zeta} These components are documented in \code{\link{clm}}. } %% \references{ bla %% %% ~put references to the literature/web site here ~ %% } \author{ Rune Haubo B Christensen } %% \note{ bla %% %% ~~further notes~~ %% } %% %% %% ~Make other sections like Warning with \section{Warning }{....} ~ %% \seealso{ \code{\link{clm}} } \examples{ ## A simple example: fm1 <- clm(rating ~ contact + temp, data=wine) summary(fm1) ## get the model frame containing y and X: mf1 <- update(fm1, method="design") names(mf1) res <- clm.fit(mf1$y, mf1$X) ## invoking the factor method stopifnot(all.equal(coef(res), coef(fm1))) names(res) ## Fitting with the default method: mf1$control$method <- "Newton" res2 <- clm.fit(mf1) stopifnot(all.equal(coef(res2), coef(fm1))) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/man/clm.Rd0000644000176200001440000002540215125475162013532 0ustar liggesusers\name{clm} \alias{clm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Cumulative Link Models %% ~~function to do ... ~~ } \description{ Fits cumulative link models (CLMs) such as the propotional odds model. The model allows for various link functions and structured thresholds that restricts the thresholds or cut-points to be e.g., equidistant or symmetrically arranged around the central threshold(s). Nominal effects (partial proportional odds with the logit link) are also allowed. A modified Newton algorithm is used to optimize the likelihood function. %% ~~ A concise (1-5 lines) description of what the function does. ~~ } \usage{ clm(formula, scale, nominal, data, weights, start, subset, doFit = TRUE, na.action, contrasts, model = TRUE, control=list(), link = c("logit", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), threshold = c("flexible", "symmetric", "symmetric2", "equidistant"), ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ a formula expression as for regression models, of the form \code{response ~ predictors}. The response should be a factor (preferably an ordered factor), which will be interpreted as an ordinal response with levels ordered as in the factor. The model must have an intercept: attempts to remove one will lead to a warning and will be ignored. An offset may be used. See the documentation of \code{\link{formula}} for other details. } \item{scale}{ an optional formula expression, of the form \code{ ~ predictors}, i.e. with an empty left hand side. An offset may be used. Variables included here will have multiplicative effects and can be interpreted as effects on the scale (or dispersion) of a latent distribution. } \item{nominal}{ an optional formula of the form \code{ ~ predictors}, i.e. with an empty left hand side. The effects of the predictors in this formula are assumed to be nominal rather than ordinal - this corresponds to the so-called partial proportional odds (with the logit link). } \item{data}{ an optional data frame in which to interpret the variables occurring in the formulas. } \item{weights}{ optional case weights in fitting. Defaults to 1. Negative weights are not allowed. } \item{start}{ initial values for the parameters in the format \code{c(alpha, beta, zeta)}, where \code{alpha} are the threshold parameters (adjusted for potential nominal effects), \code{beta} are the regression parameters and \code{zeta} are the scale parameters. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. All observations are included by default. } \item{doFit}{ logical for whether the model should be fitted or the model environment should be returned. } \item{na.action}{ a function to filter missing data. Applies to terms in all three formulae. } \item{contrasts}{ a list of contrasts to be used for some or all of the factors appearing as variables in the model formula. } \item{model}{ logical for whether the model frame should be part of the returned object. } \item{control}{ a list of control parameters passed on to \code{\link{clm.control}}. } \item{link}{ link function, i.e., the type of location-scale distribution assumed for the latent distribution. The default \code{"logit"} link gives the proportional odds model. } \item{threshold}{ specifies a potential structure for the thresholds (cut-points). \code{"flexible"} provides the standard unstructured thresholds, \code{"symmetric"} restricts the distance between the thresholds to be symmetric around the central one or two thresholds for odd or equal numbers or thresholds respectively, \code{"symmetric2"} restricts the latent mean in the reference group to zero; this means that the central threshold (even no. response levels) is zero or that the two central thresholds are equal apart from their sign (uneven no. response levels), and \code{"equidistant"} restricts the distance between consecutive thresholds to be of the same size. } \item{\dots}{ additional arguments are passed on to \code{\link{clm.control}}. } } \details{ This is a new (as of August 2011) improved implementation of CLMs. The old implementation is available in \code{\link{clm2}}, but will probably be removed at some point. There are methods for the standard model-fitting functions, including \code{\link{summary}}, \code{\link{anova}}, \code{\link{model.frame}}, \code{\link{model.matrix}}, \code{\link{drop1}}, \code{\link[MASS]{dropterm}}, \code{\link{step}}, \code{\link[MASS]{stepAIC}}, \code{\link{extractAIC}}, \code{\link{AIC}}, \code{\link{coef}}, \code{\link{nobs}}, \code{\link{profile}}, \code{\link{confint}}, \code{\link{vcov}} and \code{\link[=slice.clm]{slice}}. %% \code{slice}. } \value{ If \code{doFit = FALSE} the result is an environment representing the model ready to be optimized. If \code{doFit = TRUE} the result is an object of class \code{"clm"} with the components listed below. Note that some components are only present if \code{scale} and \code{nominal} are used. \item{aliased}{list of length 3 or less with components \code{alpha}, \code{beta} and \code{zeta} each being logical vectors containing alias information for the parameters of the same names. } \item{alpha}{a vector of threshold parameters. } \item{alpha.mat}{(where relevant) a table (\code{data.frame}) of threshold parameters where each row corresponds to an effect in the \code{nominal} formula. } \item{beta}{(where relevant) a vector of regression parameters. } \item{call}{the mathed call. } \item{coefficients}{a vector of coefficients of the form \code{c(alpha, beta, zeta)} } \item{cond.H}{condition number of the Hessian matrix at the optimum (i.e. the ratio of the largest to the smallest eigenvalue). } \item{contrasts}{(where relevant) the contrasts used for the \code{formula} part of the model. } \item{control}{list of control parameters as generated by \code{\link{clm.control}}. } \item{convergence}{convergence code where 0 indicates successful convergence and negative values indicate convergence failure; 1 indicates successful convergence to a non-unique optimum. } \item{edf}{the estimated degrees of freedom, i.e., the number of parameters in the model fit. } \item{fitted.values}{the fitted probabilities. } \item{gradient}{a vector of gradients for the coefficients at the estimated optimum. } \item{Hessian}{the Hessian matrix for the parameters at the estimated optimum. } \item{info}{a table of basic model information for printing. } \item{link}{character, the link function used. } \item{logLik}{the value of the log-likelihood at the estimated optimum. } \item{maxGradient}{the maximum absolute gradient, i.e., \code{max(abs(gradient))}. } \item{model}{if requested (the default), the \code{\link{model.frame}} containing variables from \code{formula}, \code{scale} and \code{nominal} parts. } \item{n}{the number of observations counted as \code{nrow(X)}, where \code{X} is the design matrix. } \item{na.action}{(where relevant) information returned by \code{\link{model.frame}} on the special handling of \code{NA}s. } \item{nobs}{the number of observations counted as \code{sum(weights)}. } \item{nom.contrasts}{(where relevant) the contrasts used for the \code{nominal} part of the model. } \item{nom.terms}{(where relevant) the terms object for the \code{nominal} part. } \item{nom.xlevels}{(where relevant) a record of the levels of the factors used in fitting for the \code{nominal} part. } \item{start}{the parameter values at which the optimization has started. An attribute \code{start.iter} gives the number of iterations to obtain starting values for models where \code{scale} is specified or where the \code{cauchit} link is chosen. } \item{S.contrasts}{(where relevant) the contrasts used for the \code{scale} part of the model. } \item{S.terms}{(where relevant) the terms object for the \code{scale} part. } \item{S.xlevels}{(where relevant) a record of the levels of the factors used in fitting for the \code{scale} part. } \item{terms}{the terms object for the \code{formula} part. } \item{Theta}{(where relevant) a table (\code{data.frame}) of thresholds for all combinations of levels of factors in the \code{nominal} formula. } \item{threshold}{character, the threshold structure used. } \item{tJac}{the transpose of the Jacobian for the threshold structure. } \item{xlevels}{(where relevant) a record of the levels of the factors used in fitting for the \code{formula} part. } \item{y.levels}{the levels of the response variable after removing levels for which all weights are zero. } \item{zeta}{(where relevant) a vector of scale regression parameters. } } \author{ Rune Haubo B Christensen } \examples{ fm1 <- clm(rating ~ temp * contact, data = wine) fm1 ## print method summary(fm1) fm2 <- update(fm1, ~.-temp:contact) anova(fm1, fm2) drop1(fm1, test = "Chi") add1(fm1, ~.+judge, test = "Chi") fm2 <- step(fm1) summary(fm2) coef(fm1) vcov(fm1) AIC(fm1) extractAIC(fm1) logLik(fm1) fitted(fm1) confint(fm1) ## type = "profile" confint(fm1, type = "Wald") pr1 <- profile(fm1) confint(pr1) ## plotting the profiles: par(mfrow = c(2, 2)) plot(pr1, root = TRUE) ## check for linearity par(mfrow = c(2, 2)) plot(pr1) par(mfrow = c(2, 2)) plot(pr1, approx = TRUE) par(mfrow = c(2, 2)) plot(pr1, Log = TRUE) par(mfrow = c(2, 2)) plot(pr1, Log = TRUE, relative = FALSE) ## other link functions: fm4.lgt <- update(fm1, link = "logit") ## default fm4.prt <- update(fm1, link = "probit") fm4.ll <- update(fm1, link = "loglog") fm4.cll <- update(fm1, link = "cloglog") fm4.cct <- update(fm1, link = "cauchit") anova(fm4.lgt, fm4.prt, fm4.ll, fm4.cll, fm4.cct) ## structured thresholds: fm5 <- update(fm1, threshold = "symmetric") fm6 <- update(fm1, threshold = "equidistant") anova(fm1, fm5, fm6) ## the slice methods: slice.fm1 <- slice(fm1) par(mfrow = c(3, 3)) plot(slice.fm1) ## see more at '?slice.clm' ## Another example: fm.soup <- clm(SURENESS ~ PRODID, data = soup) summary(fm.soup) if(require(MASS)) { ## dropterm, addterm, stepAIC, housing fm1 <- clm(rating ~ temp * contact, data = wine) dropterm(fm1, test = "Chi") addterm(fm1, ~.+judge, test = "Chi") fm3 <- stepAIC(fm1) summary(fm3) ## Example from MASS::polr: fm1 <- clm(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) summary(fm1) } } \keyword{models} ordinal/man/wine.Rd0000644000176200001440000000443015125475162013717 0ustar liggesusers\name{wine} \alias{wine} \title{ Bitterness of wine } \description{ The \code{wine} data set is adopted from Randall(1989) and from a factorial experiment on factors determining the bitterness of wine. Two treatment factors (temperature and contact) each have two levels. Temperature and contact between juice and skins can be controlled when cruching grapes during wine production. Nine judges each assessed wine from two bottles from each of the four treatment conditions, hence there are 72 observations in all. } \usage{ wine } \format{ \describe{ \item{\code{response}}{ scorings of wine bitterness on a 0---100 continuous scale. } \item{\code{rating}}{ ordered factor with 5 levels; a grouped version of \code{response}. } \item{\code{temp}}{ temperature: factor with two levels. } \item{\code{contact}}{ factor with two levels (\code{"no"} and \code{"yes"}). } \item{\code{bottle}}{ factor with eight levels. } \item{\code{judge}}{ factor with nine levels. } }} \source{ Data are adopted from Randall (1989). } \references{ Randall, J (1989). The analysis of sensory data by generalised linear model. \emph{Biometrical journal 7}, pp. 781--793. Tutz, G. and W. Hennevogl (1996). Random effects in ordinal regression models. \emph{Computational Statistics & Data Analysis 22}, pp. 537--557. } \examples{ head(wine) str(wine) ## Variables 'rating' and 'response' are related in the following way: (intervals <- seq(0,100, by = 20)) all(wine$rating == findInterval(wine$response, intervals)) ## ok ## A few illustrative tabulations: ## Table matching Table 5 in Randall (1989): temp.contact.bottle <- with(wine, temp:contact:bottle)[drop=TRUE] xtabs(response ~ temp.contact.bottle + judge, data = wine) ## Table matching Table 6 in Randall (1989): with(wine, { tcb <- temp:contact:bottle tcb <- tcb[drop=TRUE] table(tcb, rating) }) ## or simply: with(wine, table(bottle, rating)) ## Table matching Table 1 in Tutz & Hennevogl (1996): tab <- xtabs(as.numeric(rating) ~ judge + temp.contact.bottle, data = wine) colnames(tab) <- paste(rep(c("c","w"), each = 4), rep(c("n", "n", "y", "y"), 2), 1:8, sep=".") tab ## A simple model: m1 <- clm(rating ~ temp * contact, data = wine) summary(m1) } \keyword{datasets} ordinal/man/income.Rd0000644000176200001440000000315715125475162014234 0ustar liggesusers\name{income} \alias{income} \title{ Income distribution (percentages) in the Northeast US } \description{ Income distribution (percentages) in the Northeast US in 1960 and 1970 adopted from McCullagh (1980). } \usage{ income } \format{ \describe{ \item{\code{year}}{ year. } \item{\code{pct}}{ percentage of population in income class per year. } \item{\code{income}}{ income groups. The unit is thousands of constant (1973) US dollars. } } } \source{ Data are adopted from McCullagh (1980). } \references{ McCullagh, P. (1980) Regression Models for Ordinal Data. \emph{Journal of the Royal Statistical Society. Series B (Methodological)}, Vol. 42, No. 2., pp. 109-142. } \examples{ print(income) ## Convenient table: (tab <- xtabs(pct ~ year + income, income)) ## small rounding error in 1970: rowSums(tab) ## compare link functions via the log-likelihood: links <- c("logit", "probit", "cloglog", "loglog", "cauchit") sapply(links, function(link) { clm(income ~ year, data=income, weights=pct, link=link)$logLik }) ## a heavy tailed (cauchy) or left skew (cloglog) latent distribution ## is fitting best. ## The data are defined as: income.levels <- c(0, 3, 5, 7, 10, 12, 15) income <- paste(income.levels, c(rep("-", 6), "+"), c(income.levels[-1], ""), sep = "") income <- data.frame(year=factor(rep(c("1960", "1970"), each = 7)), pct = c(6.5, 8.2, 11.3, 23.5, 15.6, 12.7, 22.2, 4.3, 6, 7.7, 13.2, 10.5, 16.3, 42.1), income=factor(rep(income, 2), ordered=TRUE, levels=income)) } \keyword{datasets} ordinal/man/confintOld.Rd0000644000176200001440000001370315125475162015057 0ustar liggesusers\name{confint.clm2} \alias{confint.clm2} \alias{confint.profile.clm2} \alias{profile.clm2} \alias{plot.profile.clm2} \title{ Confidence intervals and profile likelihoods for parameters in cumulative link models } \description{ Computes confidence intervals from the profiled likelihood for one or more parameters in a fitted cumulative link model, or plots the profile likelihood function. } \usage{ \method{confint}{clm2}(object, parm, level = 0.95, whichL = seq_len(p), whichS = seq_len(k), lambda = TRUE, trace = 0, \dots) \method{confint}{profile.clm2}(object, parm = seq_along(Pnames), level = 0.95, \dots) \method{profile}{clm2}(fitted, whichL = seq_len(p), whichS = seq_len(k), lambda = TRUE, alpha = 0.01, maxSteps = 50, delta = LrootMax/10, trace = 0, stepWarn = 8, \dots) \method{plot}{profile.clm2}(x, parm = seq_along(Pnames), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, fig = TRUE, n = 1e3, ..., ylim = NULL) } \arguments{ \item{object}{ a fitted \code{\link{clm2}} object or a \code{profile.clm2} object. } \item{fitted}{ a fitted \code{\link{clm2}} object. } \item{x}{a \code{profile.clm2} object. } \item{parm}{not used in \code{confint.clm2}. For \code{confint.profile.clm2}: a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered. For \code{plot.profile.clm2}: a specification of which parameters the profile likelihood are to be plotted for, either a vector of numbers or a vector of names. If missing, all parameters are considered. } \item{level}{ the confidence level required. } \item{whichL}{ a specification of which \emph{location} parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all location parameters are considered. } \item{whichS}{ a specification of which \emph{scale} parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all scale parameters are considered. } \item{lambda}{ logical. Should profile or confidence intervals be computed for the link function parameter? Only used when one of the flexible link functions are used; see the \code{link}-argument in \code{\link{clm2}}. } \item{trace}{ logical. Should profiling be traced? } \item{alpha}{Determines the range of profiling. By default the likelihood is profiled in the 99\% confidence interval region as determined by the profile likelihood. } \item{maxSteps}{the maximum number of profiling steps in each direction (up and down) for each parameter. } \item{delta}{the length of profiling steps. To some extent this parameter determines the degree of accuracy of the profile likelihood in that smaller values, i.e. smaller steps gives a higher accuracy. Note however that a spline interpolation is used when constructing confidence intervals so fairly long steps can provide high accuracy. } \item{stepWarn}{a warning is issued if the no. steps in each direction (up or down) for a parameter is less than \code{stepWarn} (defaults to 8 steps) because this indicates an unreliable profile. } \item{Log}{should the profile likelihood be plotted on the log-scale? } \item{relative}{should the relative or the absolute likelihood be plotted? } \item{fig}{should the profile likelihood be plotted? } \item{n}{the no. points used in the spline interpolation of the profile likelihood. } \item{ylim}{overrules default y-limits on the plot of the profile likelihood. } \item{\dots}{ additional argument(s) for methods including \code{range} (for the hidden function \code{profileLambda}) that sets the range of values of \code{lambda} at which the likelihood should be profiled for this parameter. } } \value{ \code{confint}: A matrix (or vector) with columns giving lower and upper confidence limits for each parameter. These will be labelled as (1-level)/2 and 1 - (1-level)/2 in \% (by default 2.5\% and 97.5\%). The parameter names are preceded with \code{"loc."} or \code{"sca."} to indicate whether the confidence interval applies to a location or a scale parameter. \code{plot.profile.clm2} invisibly returns the profile object. } \details{ These \code{confint} methods call the appropriate profile method, then finds the confidence intervals by interpolation of the profile traces. If the profile object is already available, this should be used as the main argument rather than the fitted model object itself. In \code{plot.profile.clm2}: at least one of \code{Log} and \code{relative} arguments have to be \code{TRUE}. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{profile}} and \code{\link{confint}} } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) ## More manageable data set: (tab26 <- with(soup, table("Product" = PROD, "Response" = SURENESS))) dimnames(tab26)[[2]] <- c("Sure", "Not Sure", "Guess", "Guess", "Not Sure", "Sure") dat26 <- expand.grid(sureness = as.factor(1:6), prod = c("Ref", "Test")) dat26$wghts <- c(t(tab26)) m1 <- clm2(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logistic") ## profile pr1 <- profile(m1) par(mfrow = c(2, 2)) plot(pr1) m9 <- update(m1, link = "log-gamma") pr9 <- profile(m9, whichL = numeric(0), whichS = numeric(0)) par(mfrow = c(1, 1)) plot(pr9) plot(pr9, Log=TRUE, relative = TRUE) plot(pr9, Log=TRUE, relative = TRUE, ylim = c(-4, 0)) plot(pr9, Log=TRUE, relative = FALSE) ## confint confint(pr9) confint(pr1) ## Extend example from polr in package MASS: ## Fit model from polr example: if(require(MASS)) { fm1 <- clm2(Sat ~ Infl + Type + Cont, scale = ~ Cont, weights = Freq, data = housing) pr1 <- profile(fm1) confint(pr1) par(mfrow=c(2,2)) plot(pr1) } } \keyword{internal} ordinal/man/predictOld.Rd0000644000176200001440000000573115125475162015053 0ustar liggesusers\name{predict.clm2} \alias{predict.clm2} \alias{predict.clmm2} \title{Predict Method for CLM fits} \description{ Obtains predictions from a cumulative link (mixed) model. } \usage{ \method{predict}{clm2}(object, newdata, ...) %% \method{predict}{clmm}(object, newdata, ...) } \arguments{ \item{object}{a fitted object of class inheriting from \code{clm2} including \code{clmm2} objects.} \item{newdata}{optionally, a data frame in which to look for variables with which to predict. Observe that the response variable should also be present.} \item{\dots}{further arguments passed to or from other methods.} } \details{ This method does not duplicate the behavior of \code{predict.polr} in package \code{MASS} which produces a matrix instead of a vector of predictions. The behavior of \code{predict.polr} can be mimiced as shown in the examples. If \code{newdata} is not supplied, the fitted values are obtained. For \code{clmm2} fits this means predictions that are controlled for the observed value of the random effects. If the predictions for a random effect of zero, i.e. an average 'subject', are wanted, the same data used to fit the model should be supplied in the \code{newdata} argument. For \code{clm2} fits those two sets of predictions are identical. } \value{ A vector of predicted probabilities. } \author{Rune Haubo B Christensen} \seealso{ \code{\link[ordinal]{clm2}}, \code{\link[ordinal]{clmm2}}. } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) ## More manageable data set for less voluminous printing: (tab26 <- with(soup, table("Product" = PROD, "Response" = SURENESS))) dimnames(tab26)[[2]] <- c("Sure", "Not Sure", "Guess", "Guess", "Not Sure", "Sure") dat26 <- expand.grid(sureness = as.factor(1:6), prod = c("Ref", "Test")) dat26$wghts <- c(t(tab26)) dat26 m1 <- clm2(sureness ~ prod, scale = ~prod, data = dat26, weights = wghts, link = "logistic") predict(m1) mN1 <- clm2(sureness ~ 1, nominal = ~prod, data = dat26, weights = wghts) predict(mN1) predict(update(m1, scale = ~.-prod)) ################################# ## Mimicing the behavior of predict.polr: if(require(MASS)) { ## Fit model from polr example: fm1 <- clm2(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) predict(fm1) set.seed(123) nlev <- 3 y <- gl(nlev, 5) x <- as.numeric(y) + rnorm(15) fm.clm <- clm2(y ~ x) fm.polr <- polr(y ~ x) ## The equivalent of predict.polr(object, type = "probs"): (pmat.polr <- predict(fm.polr, type = "probs")) ndat <- expand.grid(y = gl(nlev,1), x = x) (pmat.clm <- matrix(predict(fm.clm, newdata = ndat), ncol=nlev, byrow = TRUE)) all.equal(c(pmat.clm), c(pmat.polr), tol = 1e-5) # TRUE ## The equivalent of predict.polr(object, type = "class"): (class.polr <- predict(fm.polr)) (class.clm <- factor(apply(pmat.clm, 1, which.max))) all.equal(class.clm, class.polr) ## TRUE } } \keyword{internal} ordinal/man/clm.control.Rd0000644000176200001440000000530015125475162015204 0ustar liggesusers\name{clm.control} \alias{clm.control} %- Also NEED an '\alias' for EACH other topic documented here. \title{Set control parameters for cumulative link models} \description{ Set control parameters for cumulative link models } \usage{ clm.control(method = c("Newton", "model.frame", "design", "ucminf", "nlminb", "optim"), sign.location = c("negative", "positive"), sign.nominal = c("positive", "negative"), ..., trace = 0L, maxIter = 100L, gradTol = 1e-06, maxLineIter = 15L, relTol = 1e-6, tol = sqrt(.Machine$double.eps), maxModIter = 5L, convergence = c("warn", "silent", "stop", "message")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{method}{\code{"Newton"} fits the model by maximum likelihood and \code{"model.frame"} cause \code{\link{clm}} to return the \code{model.frame}, \code{"design"} causes \code{\link{clm}} to return a list of design matrices etc. that can be used with \code{\link{clm.fit}}. \code{ucminf}, \code{nlminb} and \code{optim} refer to general purpose optimizers. } \item{sign.location}{change sign of the location part of the model. } \item{sign.nominal}{change sign of the nominal part of the model. } \item{trace}{numerical, if \code{> 0} information is printed about and during the optimization process. Defaults to \code{0}. } \item{maxIter}{the maximum number of Newton-Raphson iterations. Defaults to \code{100}. } \item{gradTol}{the maximum absolute gradient; defaults to \code{1e-6}. } \item{maxLineIter}{the maximum number of step halfings allowed if a Newton(-Raphson) step over shoots. Defaults to \code{15}. } \item{relTol}{relative convergence tolerence: relative change in the parameter estimates between Newton iterations. Defaults to \code{1e-6}. } \item{tol}{numerical tolerence on eigenvalues to determine negative-definiteness of Hessian. If the Hessian of a model fit is negative definite, the fitting algorithm did not converge. If the Hessian is singular, the fitting algorithm did converge albeit not to a \emph{unique} optimum, so one or more parameters are not uniquely determined even though the log-likelihood value is. } \item{maxModIter}{the maximum allowable number of consecutive iterations where the Newton step needs to be modified to be a decent direction. Defaults to \code{5}. } \item{convergence}{action to take if the fitting algorithm did not converge. } \item{\dots}{control arguments parsed on to \code{\link[ucminf]{ucminf}}, \code{\link{nlminb}} or \code{\link{optim}}. } } \value{ a list of control parameters. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{clm}} } \keyword{models} ordinal/man/anovaOld.Rd0000644000176200001440000000432515125475162014523 0ustar liggesusers\name{anova.clm2} %%\alias{anova} \alias{anova.clm2} \alias{anova.clmm2} \title{Likelihood ratio test of cumulative link models} \description{ Comparison of cumulative link models in likelihood ratio tests. The models may differ by terms in location, scale and nominal formulae, in link, threshold function and random effect structure. } \usage{ \method{anova}{clm2}(object, ..., test = c("Chisq", "none")) \method{anova}{clmm2}(object, ..., test = c("Chisq", "none")) } \arguments{ \item{object}{a \code{\link{clm2}} object. } \item{\dots}{one or more additional \code{\link{clm2}} objects. } \item{test}{if \code{test = "none"} the p-value for the likelihood ratio test is suppressed. } } \value{ The method returns an object of class \code{Anova} (for printing) and \code{data.frame} with the following elements \item{Model}{character description of the cumulative link models being compared. Location, scale and nominal formulae are separated by "|"s in this order. } \item{Resid.df}{the residual degrees of freedom } \item{-2logLik}{twice the negative log likelihood (proportional to the deviance)} \item{Test}{indication of which models are being compared. } \item{DF}{the difference in the degrees of freedom in the models being compared, i.e. the degrees of freedom for the chi-squared test. } \item{LR stat.}{the likelihood ratio statistic. } \item{Pr(Chi)}{the p-value from the likelihood ratio test. Absent if \code{test = "none"}. } } \author{Rune Haubo B Christensen} \seealso{ \code{\link[ordinal]{clm2}}, \code{\link[=addterm.clm2]{addterm}}, \code{\link[ordinal:addtermOld]{dropterm}} and \code{\link[=anova]{anova.default}} } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) m1 <- clm2(SURENESS ~ PROD, scale = ~PROD, data = soup, link = "logistic") ## anova anova(m1, update(m1, scale = ~.-PROD)) mN1 <- clm2(SURENESS ~ 1, nominal = ~PROD, data = soup, link = "logistic") anova(m1, mN1) anova(m1, update(m1, scale = ~.-PROD), mN1) ## Fit model from polr example: if(require(MASS)) { fm1 <- clm2(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) anova(fm1, update(fm1, scale =~ Cont)) } } \keyword{internal} ordinal/man/clmmOld.Rd0000644000176200001440000002266115125475162014352 0ustar liggesusers\name{clmm2} \alias{clmm2} \title{Cumulative link mixed models} \description{ Fits cumulative link mixed models, i.e. cumulative link models with random effects via the Laplace approximation or the standard and the adaptive Gauss-Hermite quadrature approximation. The functionality in \code{\link{clm2}} is also implemented here. Currently only a single random term is allowed in the location-part of the model. A new implementation is available in \code{\link{clmm}} that allows for more than one random effect. } \usage{ clmm2(location, scale, nominal, random, data, weights, start, subset, na.action, contrasts, Hess = FALSE, model = TRUE, sdFixed, link = c("logistic", "probit", "cloglog", "loglog", "cauchit", "Aranda-Ordaz", "log-gamma"), lambda, doFit = TRUE, control, nAGQ = 1, threshold = c("flexible", "symmetric", "equidistant"), ...) } \arguments{ \item{location}{ as in \code{\link{clm2}}. } \item{scale}{ as in \code{\link{clm2}}. } \item{nominal}{ as in \code{\link{clm2}}. } \item{random}{ a factor for the random effects in the location-part of the model. } \item{data}{ as in \code{\link{clm2}}. } \item{weights}{ as in \code{\link{clm2}}. } \item{start}{ initial values for the parameters in the format \code{c(alpha, beta, log(zeta), lambda, log(stDev))} where \code{stDev} is the standard deviation of the random effects. } \item{subset}{ as in \code{\link{clm2}}. } \item{na.action}{ as in \code{\link{clm2}}. } \item{contrasts}{ as in \code{\link{clm2}}. } \item{Hess}{ logical for whether the Hessian (the inverse of the observed information matrix) should be computed. Use \code{Hess = TRUE} if you intend to call \code{summary} or \code{vcov} on the fit and \code{Hess = FALSE} in all other instances to save computing time. } \item{model}{ as in \code{\link{clm2}}. } \item{sdFixed}{ If \code{sdFixed} is specified (a positive scalar), a model is fitted where the standard deviation for the random term is fixed at the value of \code{sdFixed}. If \code{sdFixed} is left unspecified, the standard deviation of the random term is estimated from data. } \item{link}{ as in \code{\link{clm2}}. } \item{lambda}{ as in \code{\link{clm2}}. } \item{doFit}{ as in \code{\link{clm2}} although it can also be one of \code{c("no", "R" "C")}, where \code{"R"} use the R-implementation for fitting, \code{"C"} (default) use C-implementation for fitting and \code{"no"} behaves as \code{FALSE} and returns the environment. } \item{control}{ a call to \code{\link{clmm2.control}}. } \item{threshold}{ as in \code{\link{clm2}}. } \item{nAGQ}{ the number of quadrature points to be used in the adaptive Gauss-Hermite quadrature approximation to the marginal likelihood. Defaults to \code{1} which leads to the Laplace approximation. An odd number of quadrature points is encouraged and 3, 5 or 7 are usually enough to achive high precision. Negative values give the standard, i.e. non-adaptive Gauss-Hermite quadrature. } \item{\dots}{ additional arguments are passed on to \code{\link{clm2.control}} and possibly further on to the optimizer, which can lead to surprising error or warning messages when mistyping arguments etc. } } \details{ There are methods for the standard model-fitting functions, including \code{\link{summary}}, \code{\link{vcov}}, \code{\link[=profile.clmm2]{profile}}, \code{\link[=profile.clmm2]{plot.profile}}, \code{\link[=confint.profile.clmm2]{confint}}, \code{\link[=anova.clm2]{anova}}, \code{\link{logLik}}, \code{\link[=predict.clmm2]{predict}} and an \code{extractAIC} method. A Newton scheme is used to obtain the conditional modes of the random effects for Laplace and AGQ approximations, and a non-linear optimization is performed over the fixed parameter set to get the maximum likelihood estimates. The Newton scheme uses the observed Hessian rather than the expected as is done in e.g. \code{\link[lme4]{glmer}}, so results from the Laplace approximation for binomial fits should in general be more precise - particularly for other links than the \code{"logistic"}. Core parts of the function are implemented in C-code for speed. The function calls \code{\link{clm2}} to up an environment and to get starting values. } \value{ If \code{doFit = FALSE} the result is an environment representing the model ready to be optimized. If \code{doFit = TRUE} the result is an object of class \code{"clmm2"} with the following components: \item{stDev}{ the standard deviation of the random effects. } \item{Niter}{ the total number of iterations in the Newton updates of the conditional modes of the random effects. } \item{grFac}{ the grouping factor defining the random effects. } \item{nAGQ}{ the number of quadrature points used in the adaptive Gauss-Hermite Quadrature approximation to the marginal likelihood. } \item{ranef}{ the conditional modes of the random effects, sometimes referred to as "random effect estimates". } \item{condVar}{ the conditional variances of the random effects at their conditional modes. } \item{beta}{the parameter estimates of the location part. } \item{zeta}{the parameter estimates of the scale part on the log scale; the scale parameter estimates on the original scale are given by \code{exp(zeta)}. } \item{Alpha}{vector or matrix of the threshold parameters. } \item{Theta}{vector or matrix of the thresholds. } \item{xi}{vector of threshold parameters, which, given a threshold function (e.g. \code{"equidistant"}), and possible nominal effects define the class boundaries, \code{Theta}. } \item{lambda}{the value of lambda if lambda is supplied or estimated, otherwise missing. } \item{coefficients}{the coefficients of the intercepts (\code{theta}), the location (\code{beta}), the scale (\code{zeta}), and the link function parameter (\code{lambda}). } \item{df.residual}{the number of residual degrees of freedoms, calculated using the weights. } \item{fitted.values}{vector of fitted values conditional on the values of the random effects. Use \code{\link[=predict.clm2]{predict}} to get the fitted values for a random effect of zero. An observation here is taken to be each of the scalar elements of the multinomial table and not a multinomial vector. } \item{convergence}{\code{TRUE} if the optimizer terminates wihtout error and \code{FALSE} otherwise. } \item{gradient}{vector of gradients for the unit-variance random effects at their conditional modes. } \item{optRes}{list with results from the optimizer. The contents of the list depends on the choice of optimizer. } \item{logLik}{the log likelihood of the model at optimizer termination. } \item{Hessian}{if the model was fitted with \code{Hess = TRUE}, this is the Hessian matrix of the parameters at the optimum. } \item{scale}{\code{model.frame} for the scale model. } \item{location}{\code{model.frame} for the location model. } \item{nominal}{\code{model.frame} for the nominal model. } \item{edf}{the (effective) number of degrees of freedom used by the model. } \item{start}{the starting values. } \item{method}{character, the optimizer. } \item{y}{the response variable. } \item{lev}{the names of the levels of the response variable. } \item{nobs}{the (effective) number of observations, calculated as the sum of the weights. } \item{threshold}{character, the threshold function used in the model. } \item{estimLambda}{\code{1} if lambda is estimated in one of the flexible link functions and \code{0} otherwise. } \item{link}{character, the link function used in the model. } \item{call}{the matched call. } \item{contrasts}{contrasts applied to terms in location and scale models. } \item{na.action}{the function used to filter missing data. } } \author{Rune Haubo B Christensen} \references{ Agresti, A. (2002) \emph{Categorical Data Analysis.} Second edition. Wiley. } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) ## More manageable data set: dat <- subset(soup, as.numeric(as.character(RESP)) <= 24) dat$RESP <- dat$RESP[drop=TRUE] m1 <- clmm2(SURENESS ~ PROD, random = RESP, data = dat, link="probit", Hess = TRUE, method="ucminf", threshold = "symmetric") m1 summary(m1) logLik(m1) vcov(m1) extractAIC(m1) anova(m1, update(m1, location = SURENESS ~ 1, Hess = FALSE)) anova(m1, update(m1, random = NULL)) ## Use adaptive Gauss-Hermite quadrature rather than the Laplace ## approximation: update(m1, Hess = FALSE, nAGQ = 3) ## Use standard Gauss-Hermite quadrature: update(m1, Hess = FALSE, nAGQ = -7) ################################################################## ## Binomial example with the cbpp data from the lme4-package: if(require(lme4)) { cbpp2 <- rbind(cbpp[,-(2:3)], cbpp[,-(2:3)]) cbpp2 <- within(cbpp2, { incidence <- as.factor(rep(0:1, each=nrow(cbpp))) freq <- with(cbpp, c(incidence, size - incidence)) }) ## Fit with Laplace approximation: fm1 <- clmm2(incidence ~ period, random = herd, weights = freq, data = cbpp2, Hess = 1) summary(fm1) ## Fit with the adaptive Gauss-Hermite quadrature approximation: fm2 <- clmm2(incidence ~ period, random = herd, weights = freq, data = cbpp2, Hess = 1, nAGQ = 7) summary(fm2) } } \keyword{models} ordinal/man/lgamma.Rd0000755000176200001440000000673115125475162014224 0ustar liggesusers\name{lgamma} \alias{plgamma} \alias{dlgamma} \alias{glgamma} %- Also NEED an '\alias' for EACH other topic documented here. \title{ The log-gamma distribution %% ~~function to do ... ~~ } \description{ Density, distribution function and gradient of density for the log-gamma distribution. These are implemented in C for speed and care is taken that the correct results are provided for values of \code{NA}, \code{NaN}, \code{Inf}, \code{-Inf} or just extremely small or large values. The log-gamma is a flexible location-scale distribution on the real line with an extra parameter, \eqn{\lambda}. For \eqn{\lambda = 0} the distribution equals the normal or Gaussian distribution, and for \eqn{\lambda} equal to 1 and -1, the Gumbel minimum and maximum distributions are obtained. %% ~~ A concise (1-5 lines) description of what the function does. ~~ } \usage{ plgamma(q, lambda, lower.tail = TRUE) dlgamma(x, lambda, log = FALSE) glgamma(x, lambda) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x,q}{ numeric vector of quantiles. } \item{lambda}{ numerical scalar } %% \item{location}{ %% numeric scalar. %% } %% \item{scale}{ %% numeric scalar. %% } \item{lower.tail}{ logical; if \code{TRUE} (default), probabilities are \eqn{P[X \leq x]}{P[X <= x]} otherwise, \eqn{P[X > x]}. } \item{log}{ logical; if \code{TRUE}, probabilities p are given as log(p). } } \details{ If \eqn{\lambda < 0} the distribution is right skew, if \eqn{\lambda = 0} the distribution is symmetric (and equals the normal distribution), and if \eqn{\lambda > 0} the distribution is left skew. % % The log-gamma distribution function is defined as \ldots pending. % % The density and gradient of the density are defined as\ldots pending. These distribution functions, densities and gradients are used in the Newton-Raphson algorithms in fitting cumulative link models with \code{\link{clm2}} and cumulative link mixed models with \code{\link{clmm2}} using the log-gamma link. } \value{ \code{plgamma} gives the distribution function, \code{dlgamma} gives the density and \code{glgamma} gives the gradient of the density. } \references{ Genter, F. C. and Farewell, V. T. (1985) Goodness-of-link testing in ordinal regression models. \emph{The Canadian Journal of Statistics}, 13(1), 37-44. } \seealso{ Gradients of densities are also implemented for the normal, logistic, cauchy, cf. \code{\link[=gnorm]{gfun}} and the Gumbel distribution, cf. \code{\link[=dgumbel]{gumbel}}. } \author{ Rune Haubo B Christensen } \examples{ ## Illustrating the link to other distribution functions: x <- -5:5 plgamma(x, lambda = 0) == pnorm(x) all.equal(plgamma(x, lambda = -1), pgumbel(x)) ## TRUE, but: plgamma(x, lambda = -1) == pgumbel(x) plgamma(x, lambda = 1) == pgumbel(x, max = FALSE) dlgamma(x, lambda = 0) == dnorm(x) dlgamma(x, lambda = -1) == dgumbel(x) dlgamma(x, lambda = 1) == dgumbel(x, max = FALSE) glgamma(x, lambda = 0) == gnorm(x) all.equal(glgamma(x, lambda = -1), ggumbel(x)) ## TRUE, but: glgamma(x, lambda = -1) == ggumbel(x) all.equal(glgamma(x, lambda = 1), ggumbel(x, max = FALSE)) ## TRUE, but: glgamma(x, lambda = 1) == ggumbel(x, max = FALSE) ## There is a loss of accuracy, but the difference is very small: glgamma(x, lambda = 1) - ggumbel(x, max = FALSE) ## More examples: x <- -5:5 plgamma(x, lambda = .5) dlgamma(x, lambda = .5) glgamma(x, lambda = .5) } \keyword{distribution} ordinal/man/slice.clm.Rd0000644000176200001440000000701415125475162014627 0ustar liggesusers\name{slice} \alias{slice} \alias{slice.clm} \alias{plot.slice.clm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Slice the likelihood of a clm } \description{ Slice likelihood and plot the slice. This is usefull for illustrating the likelihood surface around the MLE (maximum likelihood estimate) and provides graphics to substantiate (non-)convergence of a model fit. Also, the closeness of a quadratic approximation to the log-likelihood function can be inspected for relevant parameters. A slice is considerably less computationally demanding than a profile. } \usage{ slice(object, ...) \method{slice}{clm}(object, parm = seq_along(par), lambda = 3, grid = 100, quad.approx = TRUE, ...) \method{plot}{slice.clm}(x, parm = seq_along(x), type = c("quadratic", "linear"), plot.mle = TRUE, ask = prod(par("mfcol")) < length(parm) && dev.interactive(), ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{for the \code{clm} method an object of class \code{"clm"}, i.e., the result of a call to \code{clm}. } \item{x}{ a \code{slice.clm} object, i.e., the result of \code{slice(clm.object)}. } \item{parm}{ for \code{slice.clm} a numeric or character vector indexing parameters, for \code{plot.slice.clm} only a numeric vector is accepted. By default all parameters are selected. } \item{lambda}{ the number of curvature units on each side of the MLE the slice should cover. } \item{grid}{ the number of values at which to compute the log-likelihood for each parameter. } \item{quad.approx}{ compute and include the quadratic approximation to the log-likelihood function? } \item{type}{ \code{"quadratic"} plots the log-likelihood function which is approximately quadratic, and \code{"linear"} plots the signed square root of the log-likelihood function which is approximately linear. } \item{plot.mle}{ include a vertical line at the MLE (maximum likelihood estimate) when \code{type = "quadratic"}? Ignored for \code{type = "linear"}. } \item{ask}{ logical; if \code{TRUE}, the user is asked before each plot, see \code{\link{par}}\code{(ask=.)}. } \item{\dots}{ further arguments to \code{plot.default} for the plot method. Not used in the slice method. } } %% \details{ bla %% %% ~~ If necessary, more details than the description above ~~ %% } \value{ The \code{slice} method returns a list of \code{data.frame}s with one \code{data.frame} for each parameter slice. Each \code{data.frame} contains in the first column the values of the parameter and in the second column the values of the (positive) log-likelihood \code{"logLik"}. A third column is present if \code{quad.approx = TRUE} and contains the corresponding quadratic approximation to the log-likelihood. The original model fit is included as the attribute \code{"original.fit"}. The \code{plot} method produces a plot of the likelihood slice for each parameter. } \author{ Rune Haubo B Christensen } \examples{ ## fit model: fm1 <- clm(rating ~ contact + temp, data = wine) ## slice the likelihood: sl1 <- slice(fm1) ## three different ways to plot the slices: par(mfrow = c(2,3)) plot(sl1) plot(sl1, type = "quadratic", plot.mle = FALSE) plot(sl1, type = "linear") ## Verify convergence to the optimum: sl2 <- slice(fm1, lambda = 1e-5, quad.approx = FALSE) plot(sl2) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/man/nominal.test.Rd0000644000176200001440000000521415125475162015371 0ustar liggesusers\name{nominal_test} \alias{nominal_test} \alias{scale_test} \alias{nominal_test.clm} \alias{scale_test.clm} \title{ Likelihood ratio tests of model terms in scale and nominal formulae } \description{ Add all model terms to scale and nominal formulae and perform likelihood ratio tests. These tests can be viewed as goodness-of-fit tests. With the logit link, \code{nominal_test} provides likelihood ratio tests of the proportional odds assumption. The \code{scale_test} tests can be given a similar interpretation. } \usage{ nominal_test(object, ...) \method{nominal_test}{clm}(object, scope, trace=FALSE, ...) scale_test(object, ...) \method{scale_test}{clm}(object, scope, trace=FALSE, ...) } \arguments{ \item{object}{for the \code{clm} method an object of class \code{"clm"}, i.e., the result of a call to \code{clm}. } \item{scope}{ a formula or character vector specifying the terms to add to scale or nominal. In \code{nominal_test} terms in scope already in \code{nominal} are ignored. In \code{scale_test} terms in scope already in \code{scale} are ignored. In \code{nominal_test} the default is to add all terms from \code{formula} (location part) and \code{scale} that are not also in \code{nominal}. In \code{scale_test} the default is to add all terms from \code{formula} (location part) that are not also in \code{scale}. } \item{trace}{ if \code{TRUE} additional information may be given on the fits as they are tried. } \item{\dots}{ arguments passed to or from other methods. } } \value{ A table of class \code{"anova"} containing columns for the change in degrees of freedom, AIC, the likelihood ratio statistic and a p-value based on the asymptotic chi-square distribtion of the likelihood ratio statistic under the null hypothesis. } \details{ The definition of AIC is only up to an additive constant because the likelihood function is only defined up to an additive constant. } \author{Rune Haubo B Christensen} \examples{ ## Fit cumulative link model: fm <- clm(rating ~ temp + contact, data=wine) summary(fm) ## test partial proportional odds assumption for temp and contact: nominal_test(fm) ## no evidence of non-proportional odds. ## test if there are signs of scale effects: scale_test(fm) ## no evidence of scale effects. ## tests of scale and nominal effects for the housing data from MASS: if(require(MASS)) { fm1 <- clm(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) scale_test(fm1) nominal_test(fm1) ## Evidence of multiplicative/scale effect of 'Cont'. This is a breach ## of the proportional odds assumption. } } \keyword{models} ordinal/man/ordinal-package.Rd0000644000176200001440000001103615125475162015776 0ustar liggesusers\name{ordinal-package} \alias{ordinal-package} \alias{ordinal} \docType{package} \title{ Regression Models for Ordinal Data via Cumulative Link (Mixed) Models } \description{ This package facilitates analysis of ordinal (ordered categorical data) via cumulative link models (CLMs) and cumulative link mixed models (CLMMs). Robust and efficient computational methods gives speedy and accurate estimation. A wide range of methods for model fits aids the data analysis. } \details{ \tabular{ll}{ Package: \tab ordinal\cr Type: \tab Package\cr License: \tab GPL (>= 2)\cr LazyLoad: \tab yes\cr } This package implements cumualtive link models and cumulative link models with normally distributed random effects, denoted cumulative link mixed (effects) models. Cumulative link models are also known as ordered regression models, proportional odds models, proportional hazards models for grouped survival times and ordered logit/probit/... models. Cumulative link models are fitted with \code{\link{clm}} and the main features are: \itemize{ \item{A range of standard link functions are available.} \item{In addition to the standard location (additive) effects, scale (multiplicative) effects are also allowed.} \item{nominal effects are allowed for any subset of the predictors --- these effects are also known as partial proportional odds effects when using the logit link.} \item{Restrictions can be imposed on the thresholds/cut-points, e.g., symmetry or equidistance.} \item{A (modified) Newton-Raphson algorithm provides the maximum likelihood estimates of the parameters. The estimation scheme is robust, fast and accurate.} \item{Rank-deficient designs are identified and unidentified coefficients exposed in \code{print} and \code{summary} methods as with \code{\link{glm}}.} \item{A suite of standard methods are available including \code{anova}, \code{add}/\code{drop}-methods, \code{step}, \code{profile}, \code{confint}.} \item{A \code{slice} method facilitates illustration of the likelihood function and a \code{convergence} method summarizes the accuracy of the model estimation.} \item{The \code{predict} method can predict probabilities, response class-predictions and cumulative probabilities, and it provides standard errors and confidence intervals for the predictions.} } Cumulative link mixed models are fitted with \code{\link{clmm}} and the main features are: \itemize{ \item{Any number of random effect terms can be included.} \item{The syntax for the model formula resembles that of \code{\link[lme4]{lmer}} from the \code{lme4} package.} \item{Nested random effects, crossed random effects and partially nested/crossed random effects are allowed.} \item{Estimation is via maximum likelihood using the Laplace approximation or adaptive Gauss-Hermite quadrature (one random effect).} \item{Vector-valued and correlated random effects such as random slopes (random coefficient models) are fitted with the Laplace approximation.} \item{Estimation employs sparse matrix methods from the \code{\link[Matrix]{Matrix}} package. } \item{During model fitting a Newton-Raphson algorithm updates the conditional modes of the random effects a large number of times. The likelihood function is optimized with a general purpose optimizer.} } A major update of the package in August 2011 introduced new and improved implementations of \code{\link{clm}} and \code{\link{clmm}}. The old implementations are available with \code{\link{clm2}} and \code{\link{clmm2}}. At the time of writing there is functionality in \code{clm2} and \code{clmm2} not yet available in \code{clm} and \code{clmm}. This includes flexible link functions (log-gamma and Aranda-Ordaz links) and a profile method for random effect variance parameters in CLMMs. The new implementations are expected to take over the old implementations at some point, hence the latter will eventually be \code{\link[=.Deprecated]{deprecated}} and \code{\link[=.Defunct]{defunct}}. } \author{ Rune Haubo B Christensen Maintainer: Rune Haubo B Christensen } %% \references{ %% ~~ Literature or other references for background information ~~ %% } \keyword{ package } %% \seealso{ %% ~~ Optional links to other man pages, e.g. ~~ %% %% ~~ \code{\link[:-package]{}} ~~ %% } \examples{ ## A simple cumulative link model: fm1 <- clm(rating ~ contact + temp, data=wine) summary(fm1) ## A simple cumulative link mixed model: fmm1 <- clmm(rating ~ contact + temp + (1|judge), data=wine) summary(fmm1) } ordinal/man/convergence.clm.Rd0000644000176200001440000000474015125475162016031 0ustar liggesusers\name{convergence} \alias{convergence} \alias{convergence.clm} \alias{print.convergence.clm} \title{Check convergence of cumulative link models} \description{ Check the accuracy of the parameter estimates of cumulative link models. The number of correct decimals and number of significant digits is given for the maximum likelihood estimates of the parameters in a cumulative link model fitted with \code{\link{clm}}. } \usage{ convergence(object, ...) \method{convergence}{clm}(object, digits = max(3, getOption("digits") - 3), tol = sqrt(.Machine$double.eps), ...) } \arguments{ \item{object}{for the \code{clm} method an object of class \code{"clm"}, i.e., the result of a call to \code{clm}. } \item{digits}{the number of digits in the printed table. } \item{tol}{numerical tolerence to judge if the Hessian is positive definite from its smallest eigenvalue. } \item{...}{arguments to a from methods. Not used by the \code{clm} method. } } \value{ Convergence information. In particular a table where the \code{Error} column gives the numerical error in the parameter estimates. These numbers express how far the parameter estimates in the fitted model are from the true maximum likelihood estimates for this model. The \code{Cor.Dec} gives the number of correct decimals with which the the parameters are determined and the \code{Sig.Dig} gives the number of significant digits with which the parameters are determined. The number denoted \code{logLik.error} is the error in the value of log-likelihood in the fitted model at the parameter values of that fit. An accurate determination of the log-likelihood is essential for accurate likelihood ratio tests in model comparison. } \details{ The number of correct decimals is defined as... The number of significant digits is defined as ... The number of correct decimals and the number of significant digits are determined from the numerical errors in the parameter estimates. The numerical errors are determined from the Method Independent Error Theorem (Elden et al, 2004) and is based on the Newton step evaluated at convergence. } \references{ Elden, L., Wittmeyer-Koch, L. and Nielsen, H. B. (2004) \emph{Introduction to Numerical Computation --- analysis and Matlab illustrations.} Studentliteratur. } %% \seealso{ %% } \examples{ ## Simple model: fm1 <- clm(rating ~ contact + temp, data=wine) summary(fm1) convergence(fm1) } \author{Rune Haubo B Christensen} \keyword{models} ordinal/man/confint.clmmOld.Rd0000644000176200001440000001075015125475162016005 0ustar liggesusers\name{profile.clmm2} \alias{profile.clmm2} \alias{confint.clmm2} \alias{confint.profile.clmm2} \alias{profile.clmm2} \alias{plot.profile.clmm2} \title{ Confidence intervals and profile likelihoods for the standard deviation for the random term in cumulative link mixed models } \description{ Computes confidence intervals from the profiled likelihood for the standard devation for the random term in a fitted cumulative link mixed model, or plots the associated profile likelihood function. } \usage{ \method{confint}{profile.clmm2}(object, parm = seq_along(Pnames), level = 0.95, \dots) \method{profile}{clmm2}(fitted, alpha = 0.01, range, nSteps = 20, trace = 1, \dots) \method{plot}{profile.clmm2}(x, parm = seq_along(Pnames), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, fig = TRUE, n = 1e3, ..., ylim = NULL) } \arguments{ \item{object}{ a fitted \code{profile.clmm2} object. } \item{fitted}{ a fitted \code{\link{clmm2}} object. } \item{x}{a \code{profile.clmm2} object. } \item{parm}{ For \code{confint.profile.clmm2}: a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered. Currently only \code{"stDev"} or \code{1} are supported. For \code{plot.profile.clmm2}: a specification of which parameters the profile likelihood are to be plotted for, either a vector of numbers or a vector of names. If missing, all parameters are considered. Currently only \code{"stDev"} or \code{1} are supported. } \item{level}{ the confidence level required. Observe that the model has to be profiled in the appropriate region; otherwise the limits are \code{NA}. } \item{trace}{ logical. Should profiling be traced? Defaults to \code{TRUE} due to the time consuming nature of the computation. } \item{alpha}{Determines the range of profiling. By default the likelihood is profiled approximately in the 99\% confidence interval region as determined by the Wald approximation. This is usually sufficient for 95\% profile likelihood confidence limits. } \item{range}{if range is specified, this overrules the range computation based on \code{alpha}. \code{range} should be all positive and \code{stDev} is profiled in \code{range(range)}. } \item{nSteps}{the number of points at which to profile the likelihood function. This determines the resolution and accuracy of the profile likelihood function; higher values gives a higher resolution, but also longer computation times. } \item{Log}{should the profile likelihood be plotted on the log-scale? } \item{relative}{should the relative or the absolute likelihood be plotted? } \item{fig}{should the profile likelihood be plotted? } \item{n}{the no. points used in the spline interpolation of the profile likelihood for plotting. } \item{ylim}{overrules default y-limits on the plot of the profile likelihood. } \item{\dots}{ additional argument(s), e.g. graphical parameters for the \code{plot} method. } } \details{ A \code{confint.clmm2} method deliberately does not exist due to the time consuming nature of the computations. The user is required to compute the profile object first and then call \code{confint} on the profile object to obtain profile likelihood confidence intervals. In \code{plot.profile.clm2}: at least one of \code{Log} and \code{relative} arguments have to be \code{TRUE}. } \value{ \code{confint}: A matrix with columns giving lower and upper confidence limits. These will be labelled as (1-level)/2 and 1 - (1-level)/2 in \% (by default 2.5\% and 97.5\%). \code{plot.profile.clm2} invisibly returns the profile object. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{profile}} and \code{\link{confint}} } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) if(require(lme4)) { ## access cbpp data cbpp2 <- rbind(cbpp[,-(2:3)], cbpp[,-(2:3)]) cbpp2 <- within(cbpp2, { incidence <- as.factor(rep(0:1, each=nrow(cbpp))) freq <- with(cbpp, c(incidence, size - incidence)) }) ## Fit with Laplace approximation: fm1 <- clmm2(incidence ~ period, random = herd, weights = freq, data = cbpp2, Hess = 1) pr.fm1 <- profile(fm1) confint(pr.fm1) par(mfrow = c(2,2)) plot(pr.fm1) plot(pr.fm1, Log=TRUE, relative = TRUE) plot(pr.fm1, Log=TRUE, relative = FALSE) } } \keyword{models} ordinal/man/confint.clm.Rd0000644000176200001440000001302215125475162015164 0ustar liggesusers\name{confint} \alias{confint.clm} \alias{confint.profile.clm} \alias{profile.clm} \alias{plot.profile.clm} \title{ Confidence intervals and profile likelihoods for parameters in cumulative link models } \description{ Computes confidence intervals from the profiled likelihood for one or more parameters in a cumulative link model, or plots the profile likelihood. } \usage{ \method{confint}{clm}(object, parm, level = 0.95, type = c("profile", "Wald"), trace = FALSE, ...) \method{confint}{profile.clm}(object, parm = seq_len(nprofiles), level = 0.95, ...) \method{profile}{clm}(fitted, which.beta = seq_len(nbeta), which.zeta = seq_len(nzeta), alpha = 0.001, max.steps = 50, nsteps = 8, trace = FALSE, step.warn = 5, control = list(), ...) \method{plot}{profile.clm}(x, which.par = seq_len(nprofiles), level = c(0.95, 0.99), Log = FALSE, relative = TRUE, root = FALSE, fig = TRUE, approx = root, n = 1e3, ask = prod(par("mfcol")) < length(which.par) && dev.interactive(), ..., ylim = NULL) } \arguments{ \item{object, fitted, x}{ a fitted \code{\link{clm}} object or a \code{profile.clm} object. } \item{parm, which.par, which.beta, which.zeta}{ a numeric or character vector indicating which regression coefficients should be profiled. By default all coefficients are profiled. Ignored for \code{confint.clm} where all parameters are considered. } \item{level}{ the confidence level. For the \code{plot} method a vector of levels for which horizontal lines should be drawn. } \item{type}{ the type of confidence interval. } \item{trace}{ if \code{trace} is \code{TRUE} or positive, information about progress is printed. } \item{Log}{ should the profile likelihood be plotted on the log-scale? } \item{relative}{ should the relative or the absolute likelihood be plotted? } \item{root}{ should the (approximately linear) likelihood root statistic be plotted? } \item{approx}{ should the Gaussian or quadratic approximation to the (log) likelihood be included? } \item{fig}{ should the profile likelihood be plotted? } \item{ask}{ logical; if \code{TRUE}, the user is asked before each plot, see \code{\link{par}}\code{(ask=.)}. } \item{n}{ the no. points used in the spline interpolation of the profile likelihood. } \item{ylim}{overrules default y-limits on the plot of the profile likelihood. } \item{alpha}{ the likelihood is profiled in the 100*(1-alpha)\% confidence region as determined by the profile likelihood. } \item{control}{ a list of control parameters for \code{\link{clm}}. Possibly use \code{\link{clm.control}} to set these. } %%\item{lambda}{ %% logical. Should profile or confidence intervals be computed for the %% link function parameter? Only used when one of the flexible link %% functions are used; see the \code{link}-argument in %% \code{\link{clm}}. %%} \item{max.steps}{ the maximum number of profiling steps in each direction for each parameter. } \item{nsteps}{ the (approximate) number of steps to take in each direction of the profile for each parameter. The step length is determined accordingly assuming a quadratic approximation to the log-likelihood function. The actual number of steps will often be close to \code{nsteps}, but will deviate when the log-likelihood functions is irregular. } \item{step.warn}{ a warning is issued if the number of steps in each direction (up or down) for a parameter is less than \code{step.warn}. If few steps are taken, the profile will be unreliable and derived confidence intervals will be inaccurate. } \item{\dots}{ additional arguments to be parsed on to methods. } } \value{ \code{confint}: A matrix with columns giving lower and upper confidence limits for each parameter. These will be labelled as (1-level)/2 and 1 - (1-level)/2 in \% (by default 2.5\% and 97.5\%). \code{plot.profile.clm} invisibly returns the profile object, i.e., a list of \code{\link{data.frame}}s with an \code{lroot} component for the likelihood root statistic and a matrix \code{par.vals} with values of the parameters. } \details{ These \code{confint} methods call the appropriate profile method, then finds the confidence intervals by interpolation of the profile traces. If the profile object is already available, this should be used as the main argument rather than the fitted model object itself. } \author{Rune Haubo B Christensen} \seealso{ \code{\link{profile}} and \code{\link{confint}} } \examples{ ## Accurate profile likelihood confidence intervals compared to the ## conventional Wald intervals: fm1 <- clm(rating ~ temp * contact, data = wine) confint(fm1) ## type = "profile" confint(fm1, type = "Wald") pr1 <- profile(fm1) confint(pr1) ## plotting the profiles: par(mfrow = c(2, 2)) plot(pr1, root = TRUE) ## check for linearity par(mfrow = c(2, 2)) plot(pr1) par(mfrow = c(2, 2)) plot(pr1, approx = TRUE) par(mfrow = c(2, 2)) plot(pr1, Log = TRUE) par(mfrow = c(2, 2)) plot(pr1, Log = TRUE, relative = FALSE) ## Not likely to be useful but allowed for completeness: par(mfrow = c(2, 2)) plot(pr1, Log = FALSE, relative = FALSE) ## Example from polr in package MASS: ## Fit model from polr example: if(require(MASS)) { fm1 <- clm(Sat ~ Infl + Type + Cont, weights = Freq, data = housing) pr1 <- profile(fm1) confint(pr1) par(mfrow=c(2,2)) plot(pr1) } } \keyword{models} ordinal/man/VarCorr.Rd0000644000176200001440000000315715125475162014340 0ustar liggesusers\name{VarCorr} \alias{VarCorr} \alias{VarCorr.clmm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract variance and correlation parameters } \description{ The VarCorr function extracts the variance and (if present) correlation parameters for random effect terms in a cumulative link mixed model (CLMM) fitted with \code{clmm}. } \usage{ \method{VarCorr}{clmm}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a \code{\link{clmm}} object. } \item{\dots}{ currently not used by the \code{clmm} method. } } \details{ The \code{VarCorr} method returns a list of \code{data.frame}s; one for each distinct grouping factor. Each \code{data.frame} has as many rows as there are levels for that grouping factor and as many columns as there are random effects for each level. For example a model can contain a random intercept (one column) or a random intercept and a random slope (two columns) for the same grouping factor. If conditional variances are requested, they are returned in the same structure as the conditional modes (random effect estimates/predictions). } \value{ A list of matrices with variances in the diagonal and correlation parameters in the off-diagonal --- one matrix for each random effects term in the model. Standard deviations are provided as attributes to the matrices. } \author{ Rune Haubo B Christensen } \examples{ fm1 <- clmm(rating ~ contact + temp + (1|judge), data=wine) VarCorr(fm1) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{models} ordinal/DESCRIPTION0000644000176200001440000000306215130436352013413 0ustar liggesusersPackage: ordinal Type: Package Title: Regression Models for Ordinal Data Version: 2025.12-29 Date: 2025-12-29 Authors@R: person(given="Rune Haubo Bojesen", family="Christensen", email="rune.haubo@gmail.com", role=c("aut", "cre")) LazyData: true ByteCompile: yes Depends: R (>= 2.13.0), stats, methods Imports: ucminf, MASS, Matrix, numDeriv, nlme Suggests: lme4, nnet, xtable, testthat (>= 0.8), tools Description: Implementation of cumulative link (mixed) models also known as ordered regression models, proportional odds models, proportional hazards models for grouped survival times and ordered logit/probit/... models. Estimation is via maximum likelihood and mixed models are fitted with the Laplace approximation and adaptive Gauss-Hermite quadrature. Multiple random effect terms are allowed and they may be nested, crossed or partially nested/crossed. Restrictions of symmetry and equidistance can be imposed on the thresholds (cut-points/intercepts). Standard model methods are available (summary, anova, drop-methods, step, confint, predict etc.) in addition to profile methods and slice methods for visualizing the likelihood function and checking convergence. License: GPL (>= 2) NeedsCompilation: yes URL: https://github.com/runehaubo/ordinal BugReports: https://github.com/runehaubo/ordinal/issues Packaged: 2026-01-08 21:26:14 UTC; runechristensen Author: Rune Haubo Bojesen Christensen [aut, cre] Maintainer: Rune Haubo Bojesen Christensen Repository: CRAN Date/Publication: 2026-01-10 11:50:02 UTC