lme4/0000755000176200001440000000000015226147320011115 5ustar liggesuserslme4/tests/0000755000176200001440000000000015225703727012267 5ustar liggesuserslme4/tests/glmmWeights.R0000644000176200001440000000741615036542626014710 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... ## hand-coded Pearson residuals {for sumFun() } mypresid <- function(x) { mu <- fitted(x) (getME(x,"y") - mu) * sqrt(weights(x)) / sqrt(x@resp$family$variance(mu)) } ## should be equal (up to numerical error) to weights(.,type="working") workingWeights <- function(mod) mod@resp$weights*(mod@resp$muEta()^2)/mod@resp$variance() ##' Sum of weighted residuals, 4 ways; the last three are identical sumFun <- function(m) { wrss1 <- m@devcomp$cmp["wrss"] wrss2 <- sum(residuals(m,type="pearson")^2) wrss3 <- sum(m@resp$wtres^2) ## compare to hand-fitted Pearson resids ... wrss4 <- sum(mypresid(m)^2) c(wrss1,wrss2,wrss3,wrss4) } ## The relative "error"/differences of the weights w[] entries rel.diff <- function(w) abs(1 - w[-1]/w[1]) set.seed(101) ## GAMMA g0 <- glmer(y~x+(1|block),data=gSim(),family=Gamma) expect_true(all(rel.diff(sumFun(g0)) < 1e-13)) expect_equal(weights(g0, type = "working"), workingWeights(g0), tolerance = 1e-4) ## FIXME: why is such a high tolerance required? ## BERNOULLI g1 <- glmer(y~x+(1|block),data=gSim(family=binomial(),nbinom=1), family=binomial) expect_true(all(rel.diff(sumFun(g1)) < 1e-13)) expect_equal(weights(g1, type = "working"), workingWeights(g1), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? ## POISSON (n <- nrow(d.P <- gSim(family=poisson()))) g2 <- glmer(y ~ x + (1|block), data = d.P, family=poisson) g2W <- glmer(y ~ x + (1|block), data = d.P, family=poisson, weights = rep(2,n)) expect_true(all(rel.diff(sumFun(g2 )) < 1e-13)) expect_true(all(rel.diff(sumFun(g2W)) < 1e-13)) ## correct expect_equal(weights(g2, type = "working"), workingWeights(g2), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? expect_equal(weights(g2W, type = "working"), workingWeights(g2W), tolerance = 1e-5) ## FIXME: why is such a high tolerance required? ## non-Bernoulli BINOMIAL g3 <- glmer(y ~ x + (1|block), data= gSim(family=binomial(), nbinom=10), family=binomial) expect_true(all(rel.diff(sumFun(g3)) < 1e-13)) expect_equal(weights(g3, type = "working"), workingWeights(g3), tolerance = 1e-4) ## FIXME: why is such a high tolerance required? d.b.2 <- gSim(nperblk = 2, family=binomial()) g.b.2 <- glmer(y ~ x + (1|block), data=d.b.2, family=binomial) expect_true(all(rel.diff(sumFun(g.b.2 )) < 1e-13)) ## Many blocks of only 2 observations each - (but nicely balanced) ## Want this "as" https://github.com/lme4/lme4/issues/47 ## (but it "FAILS" survival already): ## ## n2 = n/2 : n2 <- 2048 if(FALSE) n2 <- 100 # for building/testing set.seed(47) dB2 <- gSim(n2, nperblk = 2, x= rep(0:1, each= n2), family=binomial()) ## -- -- --- -------- gB2 <- glmer(y ~ x + (1|block), data=dB2, family=binomial) expect_true(all(rel.diff(sumFun(gB2)) < 1e-13)) ## NB: Finite sample bias of \hat\sigma_1 and \hat\beta_1 ("Intercept") ## tend to zero only slowly for n2 -> Inf, e.g., for ## n2 = 2048, b1 ~= 4.3 (instead of 4); s1 ~= 1.3 (instead of 1) ## FAILS ----- ## library(survival) ## (gSurv.B2 <- clogit(y ~ x + strata(block), data=dB2)) ## ## --> Error in Surv(rep(1, 200L), y) : Time and status are different lengths ## summary(gSurv.B2) ## (SE.surf <- sqrt(diag(vcov(gSurv.B2)))) g3 <- glmer(y ~ x + (1|block),data=gSim(family=binomial(),nbinom=10), family=binomial) expect_equal(var(sumFun(g3)),0) ## check dispersion parameter ## (lowered tolerance to pass checks on my machine -- SCW) expect_equal(sigma(g0)^2, 0.4888248, tolerance=1e-4) } ## skip on windows (for speed) lme4/tests/dynload.R0000644000176200001440000000367114234301437014042 0ustar liggesusers## this is the simpler version of the code for testing/exercising ## https://github.com/lme4/lme4/issues/35 ## see also ../misc/issues/dynload.R for more complexity pkg <- so_name <- "lme4"; doUnload <- FALSE; doTest <- TRUE ## pkg <- so_name <- "RcppEigen"; doUnload <- TRUE; doTest <- TRUE ## need to deal with the fact that DLL name != package name for lme4.0 ... ### pkg <- "lme4.0"; so_name <- "lme4"; doUnload <- TRUE instPkgs <- as.data.frame(installed.packages(),stringsAsFactors=FALSE) Load <- function() { library(pkg,character.only=TRUE) } Unload <- function() { ld <- library.dynam() pnames <- sapply(ld,"[[","name") names(ld) <- pnames lp <- gsub("/libs/.*$","",ld[[so_name]][["path"]]) cat("unloading from",lp,"\n") library.dynam.unload(so_name, lp) } Detach <- function() { detach(paste0("package:",pkg),character.only=TRUE,unload=TRUE) if (doUnload) Unload() } tmpf <- function() { g <- getLoadedDLLs() lnames <- names(g)[is.na(instPkgs[names(g),"Priority"])] cat("loaded DLLs:",lnames,"\n") g <- g[na.omit(match(c(so_name,"nlme"),names(g)))] class(g) <- "DLLInfoList" g } test <- function() { if (doTest) { if (pkg %in% c("lme4","lme4.0")) { fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, devFunOnly=TRUE) } if (pkg=="RcppEigen") { data(trees, package="datasets") mm <- cbind(1, log(trees$Girth)) # model matrix y <- log(trees$Volume) # response ## bare-bones direct interface flm <- fastLmPure(mm, y) } } } if (FALSE) { ## FIXME: disabled test for now for (i in 1:6) { cat("Attempt #",i,"\n",sep="") cat("loading",pkg,"\n") Load() tmpf() test() cat("detaching",pkg,"\n") Detach() cat("loading nlme\n") library("nlme") tmpf() detach("package:nlme",unload=TRUE) cat("detaching nlme\n") } } lme4/tests/nbinom.R0000644000176200001440000001513115036542626013674 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) cat("lme4 testing level: ", testLevel <- lme4:::testLevel(), "\n") getNBdisp <- function(x) getME(x,"glmer.nb.theta") ## for now, use hidden functions [MM: this is a sign, we should *export* them] refitNB <- lme4:::refitNB simfun <- function(sd.u=1, NBtheta=0.5, nblock = 25, fform = ~x, beta = c(1,2), nrep = 40, seed) { levelset <- c(LETTERS,letters) stopifnot(2 <= nblock, nblock <= length(levelset)) if (!missing(seed)) set.seed(seed) ntot <- nblock*nrep d1 <- data.frame(x = runif(ntot), f = factor(rep(levelset[1:nblock], each=nrep))) u_f <- rnorm(nblock, sd=sd.u) X <- model.matrix(fform, data=d1) transform(d1, z = rnbinom(ntot, mu = exp(X %*% beta + u_f[f]), size = NBtheta)) } ##' simplified logLik() so we can compare with "glmmADMB" (and other) results logLik.m <- function(x) { L <- logLik(x) attributes(L) <- attributes(L)[c("class","df","nobs")] L } if (testLevel > 1) withAutoprint({ set.seed(102) d.1 <- simfun() t1 <- system.time(g1 <- glmer.nb(z ~ x + (1|f), data=d.1, verbose=TRUE)) g1 d1 <- getNBdisp(g1) (g1B <- refitNB(g1, theta = d1)) (ddev <- deviance(g1) - deviance(g1B)) (reld <- (fixef(g1) - fixef(g1B)) / fixef(g1)) stopifnot(abs(ddev) < 1e-6, # was 6.18e-7, 1.045e-6, -6.367e-5, now 0 abs(reld) < 1e-6)# 0, then 4.63e-6, now 0 ## 2 Aug 2015: ddev==reld==0 on 32-bit Ubuntu 12.04 if(FALSE) { ## comment out to avoid R CMD check warning : ## library(glmmADMB) t2 <- system.time(g2 <- glmmadmb(z~x+(1|f), data = d.1, family="nbinom")) ## matrix not pos definite in sparse choleski t2 # 17.1 sec elapsed glmmADMB_vals <- list(fixef= fixef(g2), LL = logLik(g2), theta= g2$alpha) } else { glmmADMB_vals <- list(fixef = c("(Intercept)" = 0.928710, x = 2.05072), LL = structure(-2944.62, class = "logLik", df = 4, nobs = 1000L), theta = 0.4487) } stopifnot(exprs = { all.equal( d1, glmmADMB_vals$ theta, tolerance=0.003) # 0.0015907 all.equal(fixef(g1B), glmmADMB_vals$ fixef, tolerance=0.02)# was 0.009387 ! ## Ubuntu 12.04/32-bit: 0.0094 all.equal(logLik.m(g1B), glmmADMB_vals$ LL, tolerance=1e-4)# 1.681e-5; Ubuntu 12.04/32-b: 1.61e-5 }) })## end if( testLevel > 1 ) if(FALSE) { ## simulation study -------------------- ## library(glmmADMB) ## avoid R CMD check warning simsumfun <- function(...) { d <- simfun(...) t1 <- system.time(g1 <- glmer.nb(z~x+(1|f),data=d)) t2 <- system.time(g2 <- glmmadmb(z~x+(1|f), data=d,family="nbinom")) c(t.glmer=unname(t1["elapsed"]),nevals.glmer=g1$nevals, theta.glmer=exp(g1$minimum), t.glmmadmb=unname(t2["elapsed"]),theta.glmmadmb=g2$alpha) } ## library(plyr) ## sim50 <- raply(50,simsumfun(),.progress="text") save("sim50",file="nbinomsim1.RData") ## library(reshape) ## m1 <- melt(data.frame(run=seq(nrow(sim50)),sim50),id.var="run") ## m1 <- data.frame(m1,colsplit(m1$variable,"\\.",c("v","method"))) ## m2 <- cast(subset(m1,v=="theta",select=c(run,value,method)), ## run~method) library(ggplot2) ggplot(subset(m1,v=="theta"),aes(x=method,y=value))+ geom_boxplot()+geom_point()+geom_hline(yintercept=0.5,colour="red") ggplot(subset(m1,v=="theta"),aes(x=method,y=value))+ stat_summary(fun.data=mean_cl_normal)+ geom_hline(yintercept=0.5,colour="red") ggplot(m2,aes(x=glmer-glmmadmb))+geom_histogram() ## glmer is slightly more biased (but maybe the MLE itself is biased???) }## end{simulation study}------------------------- ### epilepsy example: data(epil, package="MASS") epil2 <- transform(epil, Visit = (period-2.5)/5, Base = log(base/4), Age = log(age), subject= factor(subject)) if(FALSE) { ## comment out to avoid R CMD check warning : ## library(glmmADMB) t3 <- system.time(g3 <- glmmadmb(y~Base*trt+Age+Visit+(Visit|subject), data=epil2, family="nbinom")) # t3 : 8.67 sec glmmADMB_epil_vals <- list(fixef= fixef(g3), LL = logLik(g3), theta= g3$alpha) } else { glmmADMB_epil_vals <- list(fixef = c("(Intercept)"= -1.33, "Base"=0.8839167, "trtprogabide"= -0.9299658, "Age"= 0.4751434, "Visit"=-0.2701603, "Base:trtprogabide"=0.3372421), LL = structure(-624.551, class = "logLik", df = 9, nobs = 236L), theta = 7.4702) } if (testLevel > 2) withAutoprint({ ## "too slow" for regular testing -- 49 (MM@lynne: 33, then 26, then 14) seconds: (t4 <- system.time(g4 <- glmer.nb(y ~ Base*trt + Age + Visit + (Visit|subject), data = epil2, verbose=TRUE))) ## 1.1-7 : Warning in checkConv().. failed .. with max|grad| = 0.0089 (tol = 0.001, comp. 4) ## 1.1-21: 2 Warnings: max|grad| = 0.00859, then 0.1176 (0.002, comp. 1) stopifnot(exprs = { all.equal(getNBdisp(g4), glmmADMB_epil_vals$ theta, tolerance= 0.03) # 0.0019777 all.equal(fixef (g4), glmmADMB_epil_vals$ fixef, tolerance= 0.04) # 0.003731 (0.00374 on U 12.04) ## FIXME: even df differ (10 vs 9) ! ## all.equal(logLik.m(g4), - glmmADMB_epil_vals$ LL, tolerance= 0.0) ## was 0.0002 all.equal(logLik.m(g4), # for now {this is not *the* truth, just our current approximation of it}: structure(-624.48418, class = "logLik", df = 10, nobs = 236L), ## tolerance loosened 24-03-2025, failed at 1.7e-4 tolerance = 5e-4) }) }) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' } ## skip on windows (for speed) lme4/tests/README0000644000176200001440000000125514234301437013141 0ustar liggesusersCatalog of currently-failing examples (commented out, testsx, etc.): glmmExt.R: "fail for MM" on Gaussian/inverse examples -- seems fine for me lmer-0.R: sstudy9 example. Should *not* work; is a meaningful error message possible? prLogistic.R: Thailand/clustered-data example from ?prLogisticDelta example in prLogistic package Presumably the problem is that 100/411 random-effect levels have only zeros -- but should this mess things up? glmmML and lme4.0 give nearly identical answers profile.R: fails on CBPP profiling from testsx: testcolonizer: definite case where complete separation occurs, GLM does not really give a fit testcrabs: ?? not sure ?? lme4/tests/testcolonizer.R0000644000176200001440000000140315036542626015313 0ustar liggesusers## library(lme4.0) ## Emacs M- --> setwd() correctly ## m0.0 <- glm(colonizers~Treatment*homespecies*respspecies, data=randdat, family=poisson) ## with(randdat,tapply(colonizers,list(Treatment,homespecies,respspecies),sum)) ## summary(m1.0 <- glmer(form1, data=randdat, family=poisson)) ## summary(m2.0 <- glmer(form2, data=randdat, family=poisson)) ## detach("package:lme4.0", unload=TRUE) load(system.file("testdata","colonizer_rand.rda",package="lme4")) library("lme4") packageVersion("lme4") if (.Platform$OS.type != "windows") { m1 <- glmer(form1,data=randdat, family=poisson) ## PIRLS step failed m2 <- glmer(form1,data=randdat, family=poisson, nAGQ=0) ## OK m3 <- glmer(form2,data=randdat, family=poisson) ## ditto } ## skip on windows (for speed) lme4/tests/testcrab.R0000644000176200001440000001056015225703727014223 0ustar liggesuserslibrary("lme4") L <- load(system.file("testdata","crabs_randdata2.Rda",package="lme4")) ## randdata0: simulated data, in form suitable for plotting ## randdata: simulated data, in form suitable for analysis ## fr ## alive/dead formula ## fr2 ## proportion alive formula (use with weights=initial.snail.density) ## FIXME: there are still bigger differences than I'd like between the approaches ## (mostly in the random-effects correlation). It's not clear who's right; ## lme4 thinks its parameters are better, but ?? Could be explored further. if (FALSE) { ## library(ggplot2) ## commented to avoid triggering Suggests: requirement library(grid) zmargin <- theme(panel.margin=unit(0,"lines")) theme_set(theme_bw()) g1 <- ggplot(randdata0,aes(x=snail.size,y=surv,colour=snail.size,fill=snail.size))+ geom_hline(yintercept=1,colour="black")+ stat_sum(aes(size=factor(..n..)),alpha=0.6)+ facet_grid(.~ttt)+zmargin+ geom_boxplot(fill=NA,outlier.colour=NULL,outlier.shape=3)+ ## set outliers to same colour as points ## (hard to see which are outliers, but it doesn't really matter in this case) scale_size_discrete("# obs",range=c(2,5)) } if (.Platform$OS.type != "windows") { t1 <- system.time(glmer1 <- glmer(fr2,weights=initial.snail.density, family ="binomial", data=randdata)) t1B <- system.time(glmer1B <- glmer(fr,family ="binomial", data=randdata)) res1 <- c(fixef(glmer1),c(VarCorr(glmer1)$plot)) res1B <- c(fixef(glmer1B),c(VarCorr(glmer1B)$plot)) p1 <- unlist(getME(glmer1,c("theta","beta"))) stopifnot(all.equal(res1,res1B)) dfun <- update(glmer1,devFunOnly=TRUE) stopifnot(all.equal(dfun(p1),c(-2*logLik(glmer1)))) ## ## library(lme4.0) ## version 0.999999.2 results ## t1_lme4.0 <- system.time(glmer1X <- ## glmer(fr2,weights=initial.snail.density, ## family ="binomial", data=randdata)) ## dput(c(fixef(glmer1X),c(VarCorr(glmer1X)$plot))) ## p1X <- c(getME(glmer1X,"theta"),getME(glmer1X,"beta")) p1X <- c(0.681301656652347, -1.14775239687404, 0.436143018123226, 2.77730476938968, 0.609023583738824, -1.60055813739844, 2.0324468778545, 0.624173873057839, -1.7908793509579, -2.44540201631615, -1.42365990002708, -2.26780929006268, 0.700928084600075, -1.26220238391029, 0.369024582097804, 3.44325347343035, 2.26400391093108) stopifnot(all.equal(unname(p1),p1X,tolerance=0.03)) dfun(p1X) dfun(p1) ## ~ 1.8 seconds elapsed time lme4.0_res <- structure(c(2.77730476938968, 0.609023583738824, -1.60055813739844, 2.0324468778545, 0.624173873057839, -1.7908793509579, -2.44540201631615, -1.42365990002708, -2.26780929006268, 0.700928084600075, -1.26220238391029, 0.369024582097804, 3.44325347343035, 2.26400391093108, 0.464171947357232, -0.532754465140956, -0.532754465140956, 0.801690946568518), names = c("(Intercept)", "crab.speciesS", "crab.speciesW", "crab.sizeS", "crab.sizeM", "snail.sizeS", "crab.speciesS:crab.sizeS", "crab.speciesS:crab.sizeM", "crab.speciesS:snail.sizeS", "crab.speciesW:snail.sizeS", "crab.sizeS:snail.sizeS", "crab.sizeM:snail.sizeS", "crab.speciesS:crab.sizeS:snail.sizeS", "crab.speciesS:crab.sizeM:snail.sizeS", "", "", "", "")) stopifnot(all.equal(res1,lme4.0_res,tolerance=0.015)) ## library("glmmADMB") ## prop/weights formulation: ~ 7 seconds ## t1_glmmadmb <- system.time(glmer1B <- glmmadmb(fr,family ="binomial", ## corStruct="full",data=randdata)) ## dput(c(fixef(glmer1B),c(VarCorr(glmer1B)$plot))) glmmADMB_res <- structure(c(2.7773101267224, 0.609026276823218, -1.60055704634712, 2.03244174458562, 0.624171008585953, -1.79088398816641, -2.44540300134182, -1.42366043619683, -2.26780858382505, 0.700927141726545, -1.26219964572264, 0.369029052442189, 3.44326297908383, 2.26403738918967, 0.46417, -0.53253, -0.53253, 0.80169), names = c("(Intercept)", "crab.speciesS", "crab.speciesW", "crab.sizeS", "crab.sizeM", "snail.sizeS", "crab.speciesS:crab.sizeS", "crab.speciesS:crab.sizeM", "crab.speciesS:snail.sizeS", "crab.speciesW:snail.sizeS", "crab.sizeS:snail.sizeS", "crab.sizeM:snail.sizeS", "crab.speciesS:crab.sizeS:snail.sizeS", "crab.speciesS:crab.sizeM:snail.sizeS", "", "", "", "")) stopifnot(all.equal(res1B,glmmADMB_res,tolerance=0.015)) } ## skip on windows (for speed) lme4/tests/drop.R0000644000176200001440000000127115036542626013356 0ustar liggesusersif (.Platform$OS.type != "windows") withAutoprint({ library(lme4) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## slightly weird model but plausible --- not that ## one would want to try drop1() on this model ... fm2 <- lmer(Reaction ~ 1+ (Days|Subject), sleepstudy) drop1(fm2) ## empty update(fm1, . ~ . - Days) anova(fm2) ## empty terms(fm1) terms(fm1,fixed.only=FALSE) extractAIC(fm1) drop1(fm1) drop1(fm1, test="Chisq") gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ=25L) drop1(gm1, test="Chisq") }) ## skip on windows (for speed) lme4/tests/vcov-etc.R0000644000176200001440000001063715036542626014146 0ustar liggesusersstopifnot(require(lme4)) (testLevel <- lme4:::testLevel()) source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> unn() ## "MEMSS" is just 'Suggest' -- must still work, when it's missing: if (suppressWarnings(!require(MEMSS, quietly=TRUE)) || (data(ergoStool, package="MEMSS") != "ergoStool")) { cat("'ergoStool' data from package 'MEMSS' is not available --> skipping test\n") } else { fm1 <- lmer (effort ~ Type + (1|Subject), data = ergoStool) ##sp no longer supported since ~ 2012-3: ##sp fm1.s <- lmer (effort ~ Type + (1|Subject), data = ergoStool, sparseX=TRUE) ## was segfaulting with sparseX (a while upto 2010-04-06) fe1 <- fixef(fm1) ##sp fe1.s <- fixef(fm1.s) print(s1.d <- summary(fm1)) ##sp print(s1.s <- summary(fm1.s)) Tse1.d <- c(0.57601226, rep(0.51868384, 3)) stopifnot(exprs = { ##sp all.equal(fe1, fe1.s, tolerance= 1e-12) all.equal(Tse1.d, unname(se1.d <- coef(s1.d)[,"Std. Error"]), tolerance = 1e-6) # std.err.: no too much accuracy is(V.d <- vcov(fm1), "symmetricMatrix") ##sp all.equal(se1.d, coef(s1.s)[,"Std. Error"])#, tol = 1e-10 ##sp all.equal( V.d, vcov(fm1.s))#, tol = 1e-9 all.equal(Matrix::diag(V.d), unn(se1.d)^2, tolerance= 1e-12) }) }## if( ergoStool is available from pkg MEMSS ) ### -------------------------- a "large" example ------------------------- str(InstEval) if (FALSE) { # sparse X is not currently implemented, so forget about this: system.time(## works with 'sparseX'; d has 1128 levels fm7 <- lmer(y ~ d + service + studage + lectage + (1|s), data = InstEval, sparseX=TRUE, verbose=1L, REML=FALSE) ) system.time(sfm7 <- summary(fm7)) fm7 # takes a while as it computes summary() again ! range(t.fm7 <- coef(sfm7)[,"t value"])## -10.94173 10.61535 for REML, -11.03438 10.70103 for ML m.t.7 <- mean(abs(t.fm7), trim = .01) #stopifnot(all.equal(m.t.7, 1.55326395545110, tolerance = 1.e-9)) ##REML value stopifnot(all.equal(m.t.7, 1.56642013605506, tolerance = 1.e-6)) ## ML hist.t <- cut(t.fm7, floor(min(t.fm7)) : ceiling(max(t.fm7))) cbind(table(hist.t)) }# fixed effect 'd' -- with 'sparseX' only -------------------------------- if(testLevel <= 1) { cat('Time elapsed: ', proc.time(),'\n'); q("no") } ## ELSE : (testLevel > 1) : library(lattice) source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##--> all.equal(), isOptimized(), ... system.time( fm8.N <- lmer(y ~ service * dept + studage + lectage + (1|s) + (1|d), InstEval, REML=FALSE, control=lmerControl("Nelder_Mead"), verbose = 1L) ) ## 14 sec [MM@lynne; 2022-11] ## 62 sec [MM@lynne; 2013-11] ## 59.5 sec [nb-mm3; 2013-12-31] system.time( fm8.B <- lmer(y ~ service * dept + studage + lectage + (1|s) + (1|d), InstEval, REML=FALSE, control=lmerControl("bobyqa"), verbose = 2L) ) ## 7.8 sec [MM@lynne; 2022-11] ## 34.1 sec [nb-mm3; 2013-12-31] system.time( fm8 <- lmer(y ~ service * dept + studage + lectage + (1|s) + (1|d), InstEval, REML=FALSE, verbose = 1L) ) ## 7.8 sec [MM@lynne; 2022-11] stopifnot(isOptimized(fm8.N), isOptimized(fm8.B), isOptimized(fm8)) all.equal(fm8.B, fm8, tolerance=0)# 9.78e-9 (2022-11); both versions of bobyqa all.equal(fm8.B, fm8.N, tolerance=0) ## "Mean relative difference: 3.31 e-06" [nb-mm3; 2013-12-31] stopifnot(isOptimized(fm8.N), isOptimized(fm8.B), isOptimized(fm8)) str(baseOpti(fm8)) str(baseOpti(fm8.N)) str(baseOpti(fm8.B)) (sm8 <- summary(fm8.B)) str(r8 <- ranef(fm8.B)) noquote(sapply(r8, summary)) r.m8 <- cov2cor(vcov(sm8)) Matrix::image(r.m8, main="cor()") if(testLevel <= 2) { cat('Time elapsed: ', proc.time(),'\n'); q("no") } ## ELSE: testLevel > 2 ## Clearly smaller X, but more RE pars ## ==> currently considerably slower than the above system.time( fm9 <- lmer(y ~ studage + lectage + (1|s) + (1|d) + (1|dept:service) + (1|dept), InstEval, verbose = 1L, REML=FALSE) ) ## 25.6 secs [MM@lynne; 2022-11] ## 410 secs [MM@lynne; 2013-11] fm9 (sm9 <- summary(fm9)) rr <- ranef(fm9, condVar = TRUE) ## ~ 6 secs noquote(sapply(rr, summary)) qqr <- qqmath(rr, strip=FALSE) ## NB: x-axis range <==> scale of RE <==> "importance" of effect qqr$d qqr$s dotplot(rr,strip=FALSE)$`dept:service` cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' lme4/tests/prLogistic.R0000644000176200001440000000220514234301437014517 0ustar liggesusers## data set and formula extracted from ?prLogisticDelta example ## (Thailand, clustered-data) in prLogistic package load(system.file("testdata","prLogistic.RData",package="lme4")) library(lme4) (testLevel <- lme4:::testLevel()) if (testLevel > 2) { print(system.time( lme4_est <- glmer(rgi ~ sex + pped + (1|schoolid), data = dataset, family=binomial) )) lme4_results <- list(sigma= sqrt(unname(unlist(VarCorr(lme4_est)))), beta = fixef(lme4_est)) ## stored results from other pkgs glmmML_est <- list(sigma = 1.25365353546143, beta = c("(Intercept)" = -2.19478801858317, "sex" = 0.548884468743364, "pped"= -0.623835613907385)) lme4.0_est <- list(sigma = 1.25369539060849, beta = c("(Intercept)" = -2.19474529099587, "sex" = 0.548900267825802, "pped"= -0.623934772981894)) source(system.file("test-tools-1.R", package = "Matrix"))#-> assert.EQ() etc assert.EQ.(lme4_results, glmmML_est, tol=3e-3) assert.EQ.(lme4_results, lme4.0_est, tol=3e-3) print(lme4_est) } lme4/tests/hatvalues.R0000644000176200001440000000246615036542626014415 0ustar liggesusersif (.Platform$OS.type != "windows") withAutoprint({ library(lme4) source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> unn() m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) bruteForceHat <- function(object) { with(getME(object, c("Lambdat", "Lambda", "Zt", "Z", "q", "X")), { ## cp:= the cross product block matrix in (17) and (18): W <- Diagonal(x = weights(object)) I <- Diagonal(q) A.21 <- t(X) %*% W %*% Z %*% Lambda cp <- rbind(cbind(Lambdat %*% Zt %*% W %*% Z %*% Lambda + I, t(A.21)), cbind(A.21, t(X) %*% W %*% X)) mm <- cbind(Z %*% Lambda, X) ## a bit efficient: both cp and mm are typically quite sparse ## mm %*% solve(as.matrix(cp)) %*% t(mm) mm %*% solve(cp, t(mm), sparse=FALSE) }) } str(H <- bruteForceHat(m)) set.seed(7) ii <- sample(nrow(sleepstudy), 500, replace=TRUE) m2 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy[ii, ]) stopifnot(all.equal(diag(H), unn(hatvalues(m)), tol= 1e-14), all.equal(diag(bruteForceHat(m2)), unn(hatvalues(m2)), tol= 1e-14) ) }) ## skip on windows (for speed) lme4/tests/glmerWarn.R0000644000176200001440000000450515036542626014353 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) ## [glmer(*, gaussian) warns to rather use lmer()] m3 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) m5 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)) expect_equal(fixef(m3),fixef(m5)) ## hack call -- comes out unimportantly different m4@call[[1]] <- quote(lme4::lmer) expect_equal(m3,m4) expect_equal(m3,m5) ## would like m3==m5 != m4 ?? expect_equal(VarCorr(m4), VarCorr(m5), tolerance = 1e-14) print(th4 <- getME(m4,"theta")) expect_equal(th4, getME(m5,"theta"), tolerance = 1e-14) ## glmer() - poly() + interaction if (requireNamespace("mlmRev")) withAutoprint({ data(Contraception, package="mlmRev") ## ch := with child Contraception <- within(Contraception, ch <- livch != "0") ## gmC1 <- glmer(use ~ poly(age,2) + ch + age:ch + urban + (1|district), ## Contraception, binomial) ### not a 'warning' per se {cannot suppressWarnings(.)}: ### fixed-effect model matrix is rank deficient so dropping 1 column / coefficient ### also printed with print(): labeled as "fit warnings" ## ==> from ../R/modular.R chkRank.drop.cols() ## --> Use control = glmerControl(check.rankX = "ignore+drop.cols")) ## because further investigation shows "the problem" is really already ## in model.matrix(): set.seed(101) dd <- data.frame(ch = c("Y","N")[1+rbinom(12, 1, 0.7)], age = rlnorm(12, 16)) colnames(mm1 <- model.matrix( ~ poly(age,2) + ch + age:ch, dd)) ## "(Int.)" "poly(age, 2)1" "poly(age, 2)2" "chY" "chN:age" "chY:age" ## If we make the poly() columns to regular variables, can interact: d2 <- within(dd, { p2 <- poly(age,2); ageL <- p2[,1]; ageQ <- p2[,2]; rm(p2)}) ## then, we can easily get what want (mm2 <- model.matrix( ~ ageL+ageQ + ch + ageL:ch, d2)) ## actually even more compactly now ("drawback": 'ageQ' at end): (mm2. <- model.matrix( ~ ageL*ch + ageQ, d2)) cn2 <- colnames(mm2) stopifnot(identical(mm2[,cn2], mm2.[,cn2])) }) } ## skip on windows (for speed) lme4/tests/optimizer.R0000644000176200001440000000500415036542626014432 0ustar liggesuserslibrary(lme4) source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ## N.B. is.all.equal4() and assert.EQ() use 'tol', not 'tolerance' ## should be able to run any example with any bounds-constrained optimizer ... ## Nelder_Mead, bobyqa built in; optimx/nlminb, optimx/L-BFGS-B ## optimx/Rcgmin will require a bit more wrapping/interface work (requires gradient) if (.Platform$OS.type != "windows") { fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## Nelder_Mead fm1B <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerControl(optimizer="bobyqa")) stopifnot(all.equal(fixef(fm1),fixef(fm1B))) require(optimx) lmerCtrl.optx <- function(method, ...) lmerControl(optimizer="optimx", ..., optCtrl=list(method=method)) glmerCtrl.optx <- function(method, ...) glmerControl(optimizer="optimx", ..., optCtrl=list(method=method)) (testLevel <- lme4:::testLevel()) ## FAILS on Windows (on r-forge only, not win-builder)... 'function is infeasible at initial parameters' ## (can we test whether we are on r-forge??) if (.Platform$OS.type != "windows") { fm1C <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerCtrl.optx(method="nlminb")) fm1D <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, control=lmerCtrl.optx(method="L-BFGS-B")) stopifnot(is.all.equal4(fixef(fm1),fixef(fm1B),fixef(fm1C),fixef(fm1D))) fm1E <- update(fm1,control=lmerCtrl.optx(method=c("nlminb","L-BFGS-B"))) ## hack equivalence of call and optinfo fm1E@call <- fm1C@call fm1E@optinfo <- fm1C@optinfo assert.EQ(fm1C,fm1E, tol=1e-5, giveRE=TRUE)# prints unless tolerance=0--equality } gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=glmerControl(tolPwrss=1e-13)) gm1B <- update(gm1, control=glmerControl (tolPwrss=1e-13, optimizer="bobyqa")) gm1C <- update(gm1, control=glmerCtrl.optx(tolPwrss=1e-13, method="nlminb")) gm1D <- update(gm1, control=glmerCtrl.optx(tolPwrss=1e-13, method="L-BFGS-B")) stopifnot(is.all.equal4(fixef(gm1),fixef(gm1B),fixef(gm1C),fixef(gm1D), tol=1e-5)) if (testLevel > 1) { gm1E <- update(gm1, control= glmerCtrl.optx(tolPwrss=1e-13, method=c("nlminb","L-BFGS-B"))) ## hack equivalence of call and optinfo gm1E@call <- gm1C@call gm1E@optinfo <- gm1C@optinfo assert.EQ(gm1E,gm1C, tol=1e-5, giveRE=TRUE)# prints unless tol=0--equality } } ## skip on windows (for speed) lme4/tests/varcorr.R0000644000176200001440000000113615036542626014070 0ustar liggesuserslibrary(lme4) if (.Platform$OS.type != "windows") { data(Orthodont, package="nlme") fm1 <- lmer(distance ~ age + (age|Subject), data = Orthodont) VarCorr(fm1) fm2ML <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin, REML=0) VarCorr(fm2ML) gm1 <- glmer(cbind(incidence,size-incidence) ~ period + (1|herd),data=cbpp, family=binomial) VarCorr(gm1) cbpp$obs <- factor(seq(nrow(cbpp))) gm2 <- update(gm1,.~.+(1|obs)) VarCorr(gm2) if (FALSE) { ## testing lme4/lme4 incompatibility ## library(lme4) VarCorr(fm1) lme4:::VarCorr.merMod(fm1) ## OK } } ## skip on windows (for speed) lme4/tests/confint.R0000644000176200001440000000322715134016345014046 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type != "windows") withAutoprint({ library("lme4") library("testthat") L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) ## -> "fit_*" objects fm1 <- fit_sleepstudy_2 c0 <- confint(fm1, method="Wald") c0B <- confint(fm1, method="Wald",parm="Days") expect_equal(c0["Days",],c0B["Days",]) expect_equal(c(c0B),c(7.437592,13.496980),tolerance=1e-6) set.seed(101) for (bt in c("norm", "basic", "perc")) { suppressWarnings( confint(fm1, method="boot", boot.type=bt, nsim=10,quiet=TRUE)) } for (bt in c("stud","bca","junk")) { expect_error(confint(fm1, method="boot", boot.type=bt, nsim=10), "should be one of") } if((testLevel <- lme4:::testLevel()) > 1) { pr1.56 <- profile(fm1, which = 5:6) c1 <- confint(pr1.56, method="profile") expect_equal(c0[5:6,],c1,tolerance=2e-3) ## expect Wald and profile _reasonably_ close print(c1,digits=3) ## c6 <- confint(pr1.56, "Days") expect_equal(c1[2, , drop=FALSE], c6) c2 <- confint(fm1,method="boot",nsim=50,parm=5:6) ## expect_error(confint(fm1,method="boot",nsim=50,parm="Days"), ## "must be specified as an integer") expect_equal(c1,c2,tolerance=2e-2) print(c2,digits=3) } if (testLevel > 10) { set.seed(101) print(c1B <- confint(fm1, method="profile")) print(c2B <- confint(fm1, method="boot")) expect_equal(unname(c1B), unname(c2B), tolerance=2e-2) } }) ## skip if windows/testLevel<1 lme4/tests/refit.R0000644000176200001440000001546015036542626013530 0ustar liggesusers#### Testing refit() #### ---------------- library(lme4) set.seed(101) testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 ## for each type of model, should be able to ## (1) refit with same data and get the same answer, ## at least structurally (small numerical differences ## are probably unavoidable) ## (2) refit with simulate()d data if (testLevel>1) { getinfo <- function(x) { c(fixef(x), logLik(x), unlist(ranef(x)), unlist(VarCorr(x))) } dropterms <- function(x) { attr(x@frame,"terms") <- NULL x } if (getRversion() >= "3.0.0") { attach(system.file("testdata", "lme-tst-fits.rda", package="lme4")) } else { ## saved fits are not safe with old R versions; just re-compute ("cheat"!): fit_sleepstudy_2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) cbpp$obs <- factor(seq(nrow(cbpp))) ## intercept-only fixed effect fit_cbpp_0 <- glmer(cbind(incidence, size-incidence) ~ 1 + (1|herd), cbpp, family=binomial) ## include fixed effect of period fit_cbpp_1 <- update(fit_cbpp_0, . ~ . + period) if(FALSE) ## include observation-level RE fit_cbpp_2 <- update(fit_cbpp_1, . ~ . + (1|obs)) ## specify formula by proportion/weights instead fit_cbpp_3 <- update(fit_cbpp_1, incidence/size ~ period + (1 | herd), weights = size) } ## LMM fm1 <- fit_sleepstudy_2 fm1R <- refit(fm1, sleepstudy$Reaction) fm1S <- refit(fm1, simulate(fm1)[[1]]) stopifnot(all.equal(getinfo(fm1 ), getinfo(fm1R), tolerance = 6e-3), all.equal(getinfo(fm1 ), getinfo(fm1S), tolerance = 0.5) # <- simulate() ) if(FALSE) { ## show all differences sapply(slotNames(fm1), function(.) all.equal( slot(fm1,.), slot(fm1R,.), tolerance=0)) } if (getRversion() >= "3.4.0") { ## differences: FALSE for resp, theta, u, devcomp, pp, optinfo? ## FIXME: this isn't actually tested in any way ... sapply(slotNames(fm1), function(.) isTRUE(all.equal( slot(fm1,.), slot(fm1R,.), tolerance= 1.5e-5))) str(fm1 @ optinfo) str(fm1R@ optinfo) } fm1ML <- refitML(fm1) stopifnot( all.equal(getinfo(fm1), getinfo(fm1ML), tolerance=0.05)# 0.029998 ) ## binomial GLMM (two-column) gm1 <- fit_cbpp_1 gm1R <- refit(gm1, with(cbpp, cbind(incidence,size-incidence))) sim1Z <- simulate(gm1)[[1]] sim1Z[4,] <- c(0,0) (gm1. <- refit(gm1, sim1Z)) # earlier gave Error: ... PIRLS ... failed ... all.equal(getinfo(gm1), getinfo(gm1R), tolerance=0) # to see it --> 5.52e-4 # because glmer() uses Laplace approx. (? -- still, have *same* y !) stopifnot(all.equal(getinfo(gm1), getinfo(gm1R), tolerance = 1e-4)) gm1S <- refit(gm1, simulate(gm1)[[1]]) all.equal(getinfo(gm1), getinfo(gm1S), tolerance=0) # to see: stopifnot(all.equal(getinfo(gm1), getinfo(gm1S), tolerance = 0.4)) ## binomial GLMM (prob/weights) formula(gm2 <- fit_cbpp_3) ## glmer(incidence/size ~ period + (1 | herd), cbpp, binomial, weights=size) gm2R <- refit(gm2, with(cbpp, incidence/size)) all.equal(getinfo(gm2), getinfo(gm2R), tolerance= 0) stopifnot(all.equal(getinfo(gm2), getinfo(gm2R), tolerance= 6e-4)) ## FIXME: check on Windows == 2015-06: be brave gm2S <- refit(gm2, simulate(gm2)[[1]]) all.equal(getinfo(gm2), getinfo(gm2S), tolerance=0)# 0.17 .. upto 0.28 stopifnot(all.equal(getinfo(gm2), getinfo(gm2S), tolerance=0.40)) ## from Alexandra Kuznetsova set.seed(101) Y <- matrix(rnorm(1000),ncol=2) d <- data.frame(y1=Y[,1], x=rnorm(100), f=rep(1:10,10)) fit1 <- lmer(y1 ~ x+(1|f),data=d) fit2 <- refit(fit1, newresp = Y[,2], rename.response=TRUE) ## check, but ignore terms attribute of model frame ... tools::assertWarning(refit(fit1, newresp = Y[,2], junk=TRUE)) if (isTRUE(all.equal(fit1,fit2))) stop("fit1 and fit2 should not be equal") ## hack number of function evaluations u2 <- update(fit2) fit2@optinfo$feval <- u2@optinfo$feval <- NA d1 <- dropterms(fit2) d2 <- dropterms( u2 ) ## They are not "all equal", but mostly : for (i in slotNames(d1)) { ae <- all.equal(slot(d1,i), slot(d2,i)) cat(sprintf("%10s: %s\n", i, if(isTRUE(ae)) "all.equal" else paste(ae, collapse="\n "))) } all.equal(getinfo(d1), getinfo(d2), tolerance = 0)# -> 0.00126 stopifnot(all.equal(getinfo(d1), getinfo(d2), tolerance = 0.005)) ## Bernoulli GLMM (specified as factor) if (requireNamespace("mlmRev")) { data(Contraception, package="mlmRev") gm3 <- glmer(use ~ urban + age + livch + (1|district), Contraception, binomial) gm3R <- refit(gm3, Contraception$use) gm3S <- refit(gm3, simulate(gm3)[[1]]) stopifnot(all.equal(getinfo(gm3 ), getinfo(gm3R), tolerance = 1e-5),# 64b_Lx: 7.99e-7 all.equal(getinfo(gm3 ), getinfo(gm3S), tolerance = 0.05) # <- simulated data ) cat("gm3: glmer(..):\n" ); print(getinfo(gm3)) cat("gm3R: refit(*, y):\n" ); print(getinfo(gm3R)) cat("gm3S: refit(*, sim.()):\n"); print(getinfo(gm3S)) data(Mmmec, package="mlmRev") if (lme4:::testLevel() > 1) { gm4 <- glmer(deaths ~ uvb + (1|region), data=Mmmec, family = poisson, offset = log(expected)) ## FIXME: Fails to converge (with larger maxit: "downdate .. not pos.def..") try( gm4R <- refit(gm4, Mmmec $ deaths) ) try( gm4S <- refit(gm4, simulate(gm4)[[1]]) ) if(FALSE) { ## FIXME (above) cat("gm4R: refit(*,y):\n" ); print( getinfo(gm4R) ) cat("gm4S: refit(*,y):\n" ); print( getinfo(gm4S) ) stopifnot(all.equal(getinfo(gm4),getinfo(gm4R),tolerance=6e-5)) } } } ## ---------------------------------------------------------------------- ## issue: #231, http://ms.mcmaster.ca/~bolker/misc/boot_reset.html ## commits: 1a34cd0, e33d698, 53ce966, 7dbfff1, 73aa1bb, a693ba9, 8dc8cf0 ## ---------------------------------------------------------------------- formGrouse <- TICKS ~ YEAR + scale(HEIGHT) + (1 | BROOD) + (1 | INDEX) + (1 | LOCATION) gmGrouse <- glmer(formGrouse, family = "poisson", data = grouseticks) set.seed(105) simTICKS <- simulate(gmGrouse)[[1]] newdata <- transform(grouseticks, TICKS = simTICKS) gmGrouseUpdate <- update(gmGrouse, data = newdata) gmGrouseRefit <- refit(gmGrouse, newresp = simTICKS) ## compute and print tolerances all.equal(bet.U <- fixef(gmGrouseUpdate), bet.R <- fixef(gmGrouseRefit), tolerance = 0) all.equal(th.U <- getME(gmGrouseUpdate, "theta"), th.R <- getME(gmGrouseRefit, "theta"), tolerance = 0) all.equal(dev.U <- deviance(gmGrouseUpdate), dev.R <- deviance(gmGrouseRefit), tolerance = 0) stopifnot( all.equal(bet.U, bet.R, tolerance = 6e-5), # saw 1.0e-5 all.equal( th.U, th.R, tolerance = 4e-5), # saw 1.2e-5 all.equal(dev.U, dev.R, tolerance = 2e-5)) # saw 4.6e-6 } ## testLevel>1 lme4/tests/nlmer.R0000644000176200001440000000473215036542626013534 0ustar liggesuserslibrary(lme4) allEQ <- function(x,y, tolerance = 4e-4, ...) all.equal.numeric(x,y, tolerance=tolerance, ...) (nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ (Asym|Tree), Orange, start = c(Asym = 200, xmid = 725, scal = 350))) fixef(nm1) if (lme4:::testLevel() > 2) { ## 'Theoph' Data modeling Th.start <- c(lKe = -2.5, lKa = 0.5, lCl = -3) system.time(nm2 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe+lKa+lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm2, corr=FALSE) system.time(nm3 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe|Subject) + (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) print(nm3, corr=FALSE) ## dropping lKe from random effects: system.time(nm4 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa+lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm4, corr=FALSE) system.time(nm5 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start, control=nlmerControl(tolPwrss=1e-8))) print(nm5, corr=FALSE) ## this has not worked in a *long* time anyway, and PKPDmodels is currently archived, so ... ## if (require("PKPDmodels")) { ## oral1cptSdlkalVlCl <- ## PKmod("oral", "sd", list(ka ~ exp(lka), Cl ~ exp(lCl), V ~ exp(lV))) ## if (FALSE) { ## ## FIXME: Error in get(nm, envir = nlenv) : object 'k' not found ## ## probably with environments/call stack etc.? ## ## 'pnames' is c("lV","lka","k") -- not ("lV","lka","lCl") ## ## nlmer -> nlformula -> MkRespMod ## ## pnames are OK in nlformula, but in MkRespMod we try to recover ## ## them from the column names of the gradient attribute of the ## ## model evaluated in nlenv -- which are wrong. ## system.time(nm2a <- nlmer(conc ~ oral1cptSdlkalVlCl(Dose, Time, lV, lka, lCl) ~ ## (lV+lka+lCl|Subject), ## Theoph, start = c(lV=-1, lka=-0.5, lCl=-3), tolPwrss=1e-8)) ## print(nm2a, corr=FALSE) ## } ## } } ## testLevel > 2 lme4/tests/respiratory.R0000644000176200001440000000150615036542626014776 0ustar liggesusers## Data originally from Davis 1991 Stat. Med., as packaged in geepack ## and transformed (center, id -> factor, idctr created, levels labeled) library(lme4) if (.Platform$OS.type != "windows") { load(system.file("testdata","respiratory.RData",package="lme4")) m_glmer_4.L <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory) m_glmer_4.GHQ5 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=5) m_glmer_4.GHQ8 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=8) m_glmer_4.GHQ16 <- glmer(outcome~center+treat+sex+age+baseline+(1|idctr), family=binomial,data=respiratory,nAGQ=16) } ## skip on windows (for speed) lme4/tests/polytomous.R0000644000176200001440000000247115036542626014647 0ustar liggesuserslibrary(lme4) ## setup ## library(polytomous) ## data(think) ## think.polytomous.lmer1 <- polytomous(Lexeme ~ Agent + Patient + (1|Register), ## data=think, heuristic="poisson.reformulation") ## save("formula.poisson","data.poisson",file="polytomous_test.RData") load(system.file("testdata","polytomous_test.RData",package="lme4")) if (FALSE) { ## infinite loop glmer(formula.poisson,data=data.poisson,family=poisson,verbose=10) ## Cholmod not positive definite -> infinite loop glmer(formula.poisson,data=data.poisson,family=poisson, verbose=10,control=glmerControl(optimizer="bobyqa")) ## caught warning: maxfun < 10 * length(par)^2 is not recommended. -> infinite loop } ## works but sloooow .... if (FALSE) { try(g1 <- glmer(formula.poisson,data=data.poisson,family=poisson, control=glmerControl(compDev=FALSE),verbose=1)) ## runs for 2880 steps until: ## Error in pp$updateDecomp() : Downdated VtV is not positive definite } (testLevel <- lme4:::testLevel()) if (testLevel > 2) { glmer(formula.poisson,data=data.poisson,family=poisson, control=glmerControl(compDev=FALSE,optimizer="bobyqa")) ## caught warning: maxfun < 10 * length(par)^2 is not recommended. ## but runs to completion } lme4/tests/lmList-tst.R0000644000176200001440000000500315036542626014463 0ustar liggesuserslibrary(lme4) options(nwarnings = 1000) if(getRversion() < "3.2.0") { if(interactive()) break # gives an error else q() # <- undesirable when interactive ! } ## Try all "standard" (statistical) S3 methods: .S3generics <- function(class) { s3m <- .S3methods(class=class) ii <- attr(s3m, "info") ii[!ii[, "isS4"], "generic"] } set.seed(12) d <- data.frame( g = sample(c("A","B","C","D","E"), 250, replace=TRUE), y1 = runif(250, max=100), y2 = sample(c(0,1), 250, replace=TRUE) ) fm3.1 <- lmList(y1 ~ 1 | g, data=d) fm3.2 <- lmList(y2 ~ 1 | g, data=d, family=binomial) data(Orthodont, package="nlme") Orthodont <- as.data.frame(Orthodont) # no "groupedData" fm2 <- lmList(distance ~ age | Subject, Orthodont) s3fn <- .S3generics(class= class(fm3.1)[1]) ## works for "old and new" class noquote(s3fn <- s3fn[s3fn != "print"])# <-- it is show() not print() that works ## [1] coef confint fitted fixef formula logLik pairs plot ## [9] predict qqnorm ranef residuals sigma summary update ## In lme4 1.1-7 (July 2014), only these worked: ## coef(), confint(), formula(), logLik(), summary(), update() ## pairs() is excluded for fm3.1 which has only intercept: ## no errors otherwise: evs <- sapply(s3fn[s3fn != "pairs"], do.call, args = list(fm3.1)) cls <- sapply(evs, function(.) class(.)[1]) clsOk <- cls[c("confint", "fixef", "formula", "logLik", "ranef", "sigma", "summary", "update")] stopifnot(identical(unname(clsOk), c("lmList4.confint", "numeric", "formula", "logLik", "ranef.lmList", "numeric", "summary.lmList", "lmList4"))) ## --- fm2 --- non-trivial X: can use pairs(), too: evs2 <- sapply(s3fn, do.call, args = list(fm2)) ## --- fm3.2 --- no failures for this "glmList" : ss <- function(...) suppressMessages(suppressWarnings(...)) ss(evs3.2 <- sapply(s3fn[s3fn != "pairs"], do.call, args = list(fm3.2))) ## --- fm4 --- evs4 <- sapply(s3fn, function(fn) tryCatch(do.call(fn, list(fm4)), error=function(e) e)) length(warnings()) summary(warnings()) ## 4 kinds; glm.fit: fitted probabilities numerically 0 or 1 occurred str(sapply(evs4, class)) # more errors than above isok4 <- !sapply(evs4, is, class2="error") ## includes a nice pairs(): evs4[isok4] ## Error msgs of those with errors, first 5, now 3, then 2 : str(errs4 <- lapply(evs4[!isok4], conditionMessage)) ## $ logLik : chr "log-likelihood not available with NULL fits" ## $ summary: chr "subscript out of bounds" stopifnot(length(errs4) <= 2) lme4/tests/simulate.R0000644000176200001440000001451415036542626014241 0ustar liggesuserslibrary(lme4) library(testthat) (testLevel <- lme4:::testLevel()) L <- load(system.file("testdata/lme-tst-fits.rda", package="lme4", mustWork=TRUE)) if (testLevel>1) { if (getRversion() > "3.0.0") { ## saved fits are not safe with old R versions fm1 <- fit_sleepstudy_1 s1 <- simulate(fm1,seed=101)[[1]] s2 <- simulate(fm1,seed=101,use.u=TRUE) s3 <- simulate(fm1,seed=101,nsim=10) s4 <- simulate(fm1,seed=101,use.u=TRUE,nsim=10) stopifnot(length(s3)==10,all(sapply(s3,length)==180), length(s4)==10,all(sapply(s4,length)==180)) # test hook for cluster random effects fakerand <- function(n) seq(from=1.0, by=0.4, length.out=n) # In fact there are 10 observations/subject for each, but more robustly ns <- tabulate(model.frame(fm1)$Subject) s5 <- simulate(fm1, nsim=1, seed=12345, cluster.rand=fakerand) su <- as.data.frame(VarCorr(fm1))[1, "sdcor"] # sd if cluster effects y1 <- predict(fm1, re.form = ~0, se.fit=FALSE) # fixed effect y2 <- su*rep(fakerand(length(ns)), times = ns) # cluster effect, per individual set.seed(12345) y3 <- sigma(fm1)*rnorm(length(y1)) # individual error terms y <- y1+y2+y3 # testthat::expect_equal automatically incorporates the tolerance *if* # it is in 3rd edition mode. Currently, this package does not use that mode. stopifnot(all(abs(s5-y)< testthat_tolerance())) ## binomial (2-column and prob/weights) gm1 <- fit_cbpp_1 gm2 <- fit_cbpp_3 gm1_s1 <- simulate(gm1,seed=101)[[1]] gm1_s2 <- simulate(gm2,seed=101)[[1]] stopifnot(all.equal(gm1_s1[,1]/rowSums(gm1_s1),gm1_s2)) gm1_s3 <- simulate(gm1,seed=101,use.u=TRUE) gm1_s4 <- simulate(gm1,seed=101,nsim=10) gm1_s5 <- simulate(gm2,seed=101,nsim=10) stopifnot(length(gm1_s4)==10,all(sapply(gm1_s4,ncol)==2),all(sapply(gm1_s4,nrow)==56)) stopifnot(length(gm1_s5)==10,all(sapply(gm1_s5,length)==56)) ## binomial (factor): Kubovy bug report 1 Aug 2013 d <- data.frame(y=factor(rep(letters[1:2],each=100)), f=factor(rep(1:10,10))) g1 <- glmer(y~(1|f),data=d,family=binomial) s6 <- simulate(g1,nsim=10) stopifnot(length(s6)==10,all(sapply(s6,length)==200)) ## test explicitly stated link function gm3 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial(link="logit")) s4 <- simulate(gm3,seed=101)[[1]] stopifnot(all.equal(gm1_s1,s4)) cbpp$obs <- factor(seq(nrow(cbpp))) gm4 <- fit_cbpp_2 ## glmer(cbind(incidence, size - incidence) ~ period + ## (1 | herd) + (1|obs), data = cbpp, family = binomial) s5 <- simulate(gm4,seed=101)[[1]] s6 <- simulate(gm4,seed=101,use.u=TRUE)[[1]] ## Bernoulli ## works, but too slow if (testLevel > 2) { if(require("mlmRev")) { data(guImmun, package="mlmRev") table(guImmun$immun) ## N Y ## 1195 964 g1i <- glmer(immun ~ kid2p+mom25p+ord+ethn+momEd+husEd+momWork+rural+pcInd81+ (1|comm/mom), family="binomial", data=guImmun) ## In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : ## Model failed to converge with max|grad| = 0.326795 (tol = 0.002, component 1) sg1 <- simulate(g1i) if(FALSE) { ## similar: not relevant here {comment out for 'R CMD check'}: ## if(require("glmmTMB")) { g2 <- glmmTMB(immun ~ kid2p+mom25p+ord+ethn+momEd+husEd+momWork+rural+pcInd81+ (1|comm/mom), family="binomial", data=guImmun) sg2 <- simulate(g2) ## } } } } set.seed(101) d <- data.frame(f = factor(rep(LETTERS[1:10],each=10))) d$x <- runif(nrow(d)) u <- rnorm(10) d$eta <- with(d, 1 + 2*x + u[f]) d$y <- rbinom(nrow(d), size=1, prob = plogis(d$eta)) g1 <- glmer(y ~ x + (1|f), data=d, family="binomial") ## tolPwrss=1e-5: no longer necessary if (testLevel > 2) { ## trying a set of glmerControl(tolPwrss = 10^t) : allcoef <- function(x) c(dev = deviance(x), th = getME(x,"theta"), beta = getME(x,"beta")) tfun <- function(t) { gg <- try( ## << errors (too small tolPwrss) are still printed : glmer(y~x+(1|f),data=d,family="binomial", control = glmerControl(tolPwrss = 10^t))) if (inherits(gg,"try-error")) rep(NA,4) else allcoef(gg) } tvec <- seq(-4,-16,by=-0.25) tres <- cbind(t = tvec, t(sapply(tvec, tfun))) print(tres) } gm_s5 <- simulate(g1, seed=102)[[1]] d$y <- factor(c("N","Y")[d$y+1]) g1B <- glmer(y ~ x + (1|f), data=d, family="binomial") ## ,tolPwrss=1e-5) s1B <- simulate(g1B, seed=102)[[1]] stopifnot(all.equal(gm_s5,as.numeric(s1B)-1)) ## another Bernoulli if(requireNamespace("mlmRev")) { data(Contraception, package="mlmRev") gm5 <- glmer(use ~ urban+age+livch+(1|district), Contraception, binomial) s3 <- simulate(gm5) } d$y <- rpois(nrow(d),exp(d$eta)) gm6 <- glmer(y~x+(1|f),data=d,family="poisson") s4 <- simulate(gm6) ## simulation 'from scratch' with formulas: ## binomial ## form <- formula(gm1)[-2] form <- ~ (1|herd) + period gm1_s4 <- simulate(form,newdata=model.frame(gm1), newparams=list(theta=getME(gm1,"theta"), beta=fixef(gm1)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101)[[1]] stopifnot(all.equal(gm1_s2,gm1_s4)) gm1_s5 <- simulate(formula(gm1),newdata=cbpp, newparams=list(theta=getME(gm1,"theta"), beta=fixef(gm1)), family=binomial, seed=101)[[1]] stopifnot(all.equal(gm1_s1,gm1_s5)) tt <- getME(gm1,"theta") bb <- fixef(gm1) expect_error(simulate(form,newdata=model.frame(gm1), newparams=list(theta=setNames(tt,"abc"), beta=fixef(gm1)), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"mismatch between") expect_error(simulate(form,newdata=model.frame(gm1), newparams=list(theta=tt, beta=setNames(bb,c("abc",names(bb)[-1]))), family=binomial, weights=rowSums(model.frame(gm1)[[1]]), seed=101),"mismatch between") ## Gaussian form <- formula(fm1)[-2] s7 <- simulate(form,newdata=model.frame(fm1), newparams=list(theta=getME(fm1,"theta"), beta=fixef(fm1), sigma=sigma(fm1)), family=gaussian, seed=101)[[1]] stopifnot(all.equal(s7,s1)) ## TO DO: wider range of tests, including offsets ... }# R >= 3.0.0 } ## testLevel>1 lme4/tests/HSAURtrees.R0000644000176200001440000000455715225703727014352 0ustar liggesusersif (.Platform$OS.type != "windows") withAutoprint({ library("lme4") ## example from HSAUR2 package; data from 'multcomp'; see ../inst/testdata/trees513.R load(system.file("testdata","trees513.RData",package="lme4")) ## model formula: modForm <- damage ~ species - 1 + (1 | lattice / plot) dfun <- glmer(modForm, data = trees513B, family = binomial, devFunOnly = TRUE) ls.str(environment(dfun))# "for your information" .not.call <- function(x) x[names(x) != "call"] if(lme4:::testLevel() < 2) q("no") ## else (testLevel >= 2) : -------------------------------------------------- ## Generate oldres: ## ---------------- ## library(lme4.0) ## system.time(mmod0 <- glmer(damage ~ species - 1 + (1 | lattice / plot), ## data = trees513, family = binomial())) ## ## 4 seconds ## oldres <- c(fixef(mmod0),getME(mmod0,"theta")) ## detach("package:lme4.0") ## dput(oldres) oldres <- structure(c(5.23645064474105, 4.73568475545248, 2.65289926317093, 1.29043984816924, 1.59329381563025, 0.532663142106669, 1.16703186884403 ), names = c("speciesspruce", "speciespine", "speciesbeech", "speciesoak", "specieshardwood", "plot:lattice.(Intercept)", "lattice.(Intercept)")) system.time(mmodA <- glmer(modForm, data = trees513A, family = binomial())) ## 7 seconds newres <- c(fixef(mmodA), getME(mmodA,"theta")) stopifnot(all.equal(oldres, newres, tolerance=1.5e-3)) system.time(mmodB <- glmer(modForm, data = trees513B, family = binomial())) ## 10.4 seconds ## if(FALSE) { ## defuncted in 2019-05 [been deprecated since 2013-06] ## lmer( + family) -> diverts to glmer() with a warning [TODO: use assertWarning(.) eventually] system.time(lmodB <- lmer(modForm, data = trees513B, family = binomial())) stopifnot(all.equal(.not.call(summary(mmodB)), .not.call(summary(lmodB)))) newresB <- c(fixef(mmodB),getME(mmodB,"theta")) stopifnot(length(newresB) == length(oldres) + 1)# extra: species[ash/maple/elm/lime] } }) ## skip on windows (for speed) lme4/tests/evalCall.R0000644000176200001440000000073215036542626014136 0ustar liggesusersif (.Platform$OS.type != "windows") { ## see if we can still run lme4 functions when lme4 is not attached if ("package:lme4" %in% search()) detach("package:lme4") data(sleepstudy,package="lme4") data(cbpp,package="lme4") fm1 <- lme4::lmer(Reaction ~ Days + (Days|Subject), sleepstudy) gm1 <- lme4::glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) } ## skip on windows (for speed) lme4/tests/glmerControlPass.R0000644000176200001440000000157215036542626015714 0ustar liggesusersif (.Platform$OS.type != "windows") { ## test redirection from lmer to glmer (correct options passed, ## specifically glmerControl -> tolPwrss library("lme4") library("testthat") ## data("trees513", package = "multcomp") load(system.file("testdata","trees513.RData",package="lme4")) expect_is(mmod1 <- glmer(damage ~ species - 1 + (1 | lattice / plot), data = trees513B, family = binomial()),"glmerMod") if(FALSE) { ## Now (2019-05) defunct; was deprecated since 2013-06: expect_warning(mmod2 <- lmer(damage ~ species - 1 + (1 | lattice / plot), data = trees513B, family = binomial()), "calling lmer with .* is deprecated") mmod2@call <- mmod1@call ## hack calls to equality expect_equal(mmod1,mmod2) } } ## skip on windows (for speed) lme4/tests/boundary.R0000644000176200001440000002124215211110147014215 0ustar liggesusers## In both of these cases boundary fit (i.e. estimate of zero RE ## variance) is *incorrect*. (Nelder_Mead, restart_edge=FALSE) is the ## only case where we get stuck; either optimizer=bobyqa or ## restart_edge=TRUE (default) works if (.Platform$OS.type != "windows") { library(lme4) library(testthat) if(!dev.interactive(orNone=TRUE)) pdf("boundary_plots.pdf") ## Stephane Laurent: dat <- read.csv(system.file("testdata","dat20101314.csv", package="lme4")) fit <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="Nelder_Mead")) fit_b <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="bobyqa", restart_edge=FALSE)) fit_c <- lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl(optimizer="Nelder_Mead", restart_edge=FALSE, check.conv.hess="ignore")) ## final fit gives degenerate-Hessian warning ## FIXME: use fit_c with expect_warning() as a check on convergence tests ## tolerance=1e-5 seems OK in interactive use but not in R CMD check ... ?? stopifnot(all.equal(getME(fit, "theta") -> th.f, getME(fit_b,"theta"), tolerance=5e-5), all(th.f > 0)) ## Manuel Koller source(system.file("testdata", "koller-data.R", package="lme4")) ldata <- getData(13) ## old (backward compatible/buggy) fm4 <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", use.last.params=TRUE), start=list(theta=1)) fm4b <- lmer(y ~ (1|Var2), ldata, control = lmerControl(optimizer="Nelder_Mead", use.last.params=TRUE, restart_edge = FALSE, check.conv.hess="ignore", check.conv.grad="ignore"), start = list(theta=1)) ## FIXME: use as convergence test check stopifnot(getME(fm4b,"theta") == 0) fm4c <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="bobyqa", use.last.params=TRUE), start=list(theta=1)) stopifnot(all.equal(getME(fm4, "theta") -> th4, getME(fm4c,"theta"), tolerance=1e-4), th4 > 0) ## new: doesn't get stuck at edge any more, but gets stuck somewhere else ... fm5 <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", check.conv.hess="ignore", check.conv.grad="ignore"), start=list(theta=1)) fm5b <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="Nelder_Mead", restart_edge=FALSE, check.conv.hess="ignore", check.conv.grad="ignore"), start = list(theta = 1)) fm5c <- lmer(y ~ (1|Var2), ldata, control=lmerControl(optimizer="bobyqa"), start = list(theta = 1)) stopifnot(all.equal(unname(getME(fm5c,"theta")), 0.21067645, tolerance = 1e-7)) # 0.21067644264 [64-bit, lynne] if (require("optimx")) { ## additional stuff for diagnosing Nelder-Mead problems. fm5d <- update(fm5,control=lmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B"))) fm5e <- update(fm5, control=lmerControl(optimizer="nloptwrap")) mList <- setNames(list(fm4,fm4b,fm4c,fm5,fm5b,fm5c,fm5d,fm5e), c("NM/uselast","NM/uselast/norestart","bobyqa/uselast", "NM","NM/norestart","bobyqa","LBFGSB","nloptr/bobyqa")) pp <- profile(fm5c,which=1) dd <- as.data.frame(pp) par(las=1,bty="l") v <- sapply(mList, function(x) sqrt(VarCorr(x)[[1]])) plot(.zeta^2~.sig01, data=dd, type="b") abline(v=v) res <- cbind(VCorr = sapply(mList, function(x) sqrt(VarCorr(x)[[1]])), theta = sapply(mList, getME,"theta"), loglik = sapply(mList, logLik)) res print(sessionInfo(), locale=FALSE) } ###################### library(lattice) ## testing boundary and near-boundary cases tmpf <- function(i,...) { set.seed(i) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10))) d$y <- simulate(~x+(1|f),family=gaussian,newdata=d, newparams=list(theta=0.01,beta=c(1,1),sigma=5))[[1]] lmer(y~x+(1|f),data=d,...) } sumf <- function(m) { unlist(VarCorr(m))[1] } if (FALSE) { ## figuring out which seeds will give boundary and ## near-boundary solutions mList <- lapply(1:201,tmpf) # [FIXME tons of messages "theta parameters vector not named"] ss <- sapply(mList,sumf)+1e-50 par(las=1,bty="l") hist(log(ss),col="gray",breaks=50) ## values lying on boundary which(log(ss)<(-40)) ## 5, 7-13, 15, 21, ... ## values close to boundary (if check.edge not set) which(log(ss)>(-40) & log(ss) <(-20)) ## 16, 44, 80, 86, 116, ... } ## diagnostic plot tmpplot <- function(i, FUN=tmpf) { dd <- FUN(i, devFunOnly=TRUE) x <- 10^seq(-10,-6.5,length=201) dvec <- sapply(x,dd) op <- par(las=1,bty="l"); on.exit(par(op)) plot(x,dvec-min(dvec)+1e-16, log="xy", type="b") r <- FUN(i) abline(v = getME(r,"theta"), col=2) invisible(r) } ## Case #1: boundary estimate with or without boundary.tol m5 <- tmpf(5) m5B <- tmpf(5,control=lmerControl(boundary.tol=0)) stopifnot(getME(m5, "theta")==0, getME(m5B,"theta")==0) p5 <- profile(m5) ## bobyqa warnings but results look reasonable xyplot(p5) ## reveals slight glitch (bottom row of plots doesn't look right) expect_warning(splom(p5),"unreliable for singular fits") p5B <- profile(m5, signames=FALSE) # -> bobyqa convergence warning (code 3) expect_warning(splom(p5B), "unreliable for singular fits") if(lme4:::testLevel() >= 2) { ## avoid failure to warn ## Case #2: near-boundary estimate, but boundary.tol can't fix it m16 <- tmpplot(16) ## sometimes[2014-11-11] fails (??) : p16 <- profile(m16) ## warning message*s* (non-monotonic profile and more) plotOb <- xyplot(p16) ## NB: It's the print()ing of 'plotOb' which warns ==> need to do this explicitly: expect_warning(print(plotOb), ## warns about linear interpolation in profile for variable 1 "using linear interpolation") d16 <- as.data.frame(p16) xyplot(.zeta ~ .focal|.par, data=d16, type=c("p","l"), scales = list(x=list(relation="free"))) try(splom(p16)) ## breaks when calling predict(.) } ## bottom line: ## * xyplot.thpr could still be improved ## * most of the near-boundary cases are noisy and can't easily be ## fixed tmpf2 <- function(i,...) { set.seed(i) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10)), w=rep(10,60)) d$y <- simulate(~x+(1|f),family=binomial, weights=d$w,newdata=d, newparams=list(theta=0.01,beta=c(1,1)))[[1]] glmer(y~x+(1|f),data=d,family=binomial,weights=w,...) } if (FALSE) { ## figuring out which seeds will give boundary and ## near-boundary solutions mList <- lapply(1:201,tmpf2) ss <- sapply(mList,sumf)+1e-50 par(las=1,bty="l") hist(log(ss),col="gray",breaks=50) ## values lying on boundary head(which(log(ss)<(-50))) ## 1-5, 7 ... ## values close to boundary (if check.edge not set) which(log(ss)>(-50) & log(ss) <(-20)) ## 44, 46, 52, ... } ## m1 <- tmpf2(1) ## FIXME: doesn't work if we generate m1 via tmpf2(1) -- ## some environment lookup problem ... set.seed(1) d <- data.frame(x=rnorm(60),f=factor(rep(1:6,each=10)), w=rep(10,60)) d$y <- simulate(~x+(1|f),family=binomial, weights=d$w,newdata=d, newparams=list(theta=0.01,beta=c(1,1)))[[1]] m1 <- glmer(y~x+(1|f),data=d,family=binomial,weights=w) p1 <- profile(m1) xyplot(p1) expect_warning(splom(p1),"splom is unreliable") ## from Michael Chirico, GH #979 m16 <- tmpf(16) p16 <- profile(m16) expect_warning(lattice::splom(p16), "Dropping parameters") } ## skip on windows (for speed) lme4/tests/falsezero_dorie.R0000644000176200001440000000156015036542626015567 0ustar liggesusersif (.Platform$OS.type != "windows") { ## test of false zero problem reported by Vince Dorie ## (no longer occurs with current development lme4) ## https://github.com/lme4/lme4/issues/17 library(lme4) sigma.eps <- 2 sigma.the <- 0.75 mu <- 2 n <- 5 J <- 10 g <- gl(J, n) set.seed(1) theta <- rnorm(J, 0, sigma.eps * sigma.the) y <- rnorm(n * J, mu + theta[g], sigma.eps) lmerFit <- lmer(y ~ 1 + (1 | g), REML = FALSE, verbose=TRUE) y.bar <- mean(y) y.bar.j <- sapply(1:J, function(j) mean(y[g == j])) S.w <- sum((y - y.bar.j[g])^2) S.b <- n * sum((y.bar.j - y.bar)^2) R <- S.b / S.w sigma.the.hat <- sqrt(max((n - 1) * R / n - 1 / n, 0)) stopifnot(all.equal(sigma.the.hat,lme4Sigma <- unname(getME(lmerFit,"theta")), tolerance=2e-5)) } ## skip on windows (for speed) lme4/tests/devCritFun.R0000644000176200001440000000165015036542626014464 0ustar liggesusersif (.Platform$OS.type!="windows") { library(lme4) ## ---------------------------------------------------------------------- ## test that deviance(REMLfit, REML = FALSE) gives the same answer as ## the ML objective function at the REML fit ## ---------------------------------------------------------------------- set.seed(1) w <- runif(nrow(sleepstudy)) fm <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, weights = w) dfun <- update(fm, devFunOnly = TRUE, REML = FALSE) stopifnot(all.equal(deviance(fm, REML = FALSE), dfun(getME(fm, "theta")))) ## ---------------------------------------------------------------------- ## TODO: test the opposite case that deviance(MLfit, REML = TRUE) ## gives the same answer as the REML objective function at the ML fit ## ---------------------------------------------------------------------- } lme4/tests/glmmExt.R0000644000176200001440000001176715225703727014043 0ustar liggesusers## Tests of a variety of GLMM families and links ## coding: family {g=Gamma, P=Poisson, G=Gaussian, B=binomial} ## link {l=log, i=inverse, c=cloglog, i=identity} ## model {1 = intercept-only, 2 = with continuous predictor} library("lme4") source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... str(gSim) ## function (nblk = 26, nperblk = 100, sigma = 1, beta = c(4, 3), ## x = runif(n), shape = 2, nbinom = 10, family = Gamma()) if (.Platform$OS.type != "windows") withAutoprint({ set.seed(101) ## Gamma, inverse link (= default) : d <- gSim() ## Gamma, log link eta = log(mu) : dgl <- gSim(dInitial = d, family = Gamma(link = log)) ## Poisson, log link dP <- gSim(dInitial = d, family = poisson()) ## Gaussian, log link --- need to use a non-identity link, otherwise glmer calls lmer dG <- gSim(dInitial = d, family = gaussian(link = log), sd = 2) ## Gaussian with inverse link : (sd small enough to avoid negative values) : dGi <- gSim(dInitial = d, family = gaussian(link = inverse), sd = 0.01) ## binomial with cloglog link dBc <- d dBc$eta <- d$eta - 5 # <==> beta intercept 5 less: otherwise y will be constant dBc <- gSim(dInitial = dBc, ## beta = c(-1, 3), nbinom = 1, family = binomial(link="cloglog")) ## binomial with identity link dBi <- d dBc$eta <- d$eta / 10 # <==> beta slope / 10 : scale so range goes from 0.2-0.8 dBi <- gSim(dInitial = dBc, ## beta = c(4, 3/10), nbinom = 1, family = binomial(link="identity")) ############ ## Gamma/inverse ## GLMs gm0 <- glm(y ~ 1, data=d, family=Gamma) gm1 <- glm(y ~ block-1, data=d, family=Gamma) stopifnot(all.equal(sd(coef(gm1)),1.00753942148611)) gm2 <- glmer(y ~ 1 + (1|block), d, Gamma, nAGQ=0) gm3 <- glmer(y ~ x + (1|block), d, Gamma, nAGQ=0) gm2B <- glmer(y ~ 1 + (1|block), d, Gamma) gm3B <- glmer(y ~ x + (1|block), d, Gamma) ## y ~ x + (1|block), Gamma is TRUE model summary(gm3) summary(gm3B)# should be better ## Both have "correct" beta ~= (4, 3) -- but *too* small (sigma_B, sigma) !! stopifnot(exprs = { all.equal(fixef(gm3 ), c(`(Intercept)` = 4.07253, x = 3.080585), tol = 1e-5) # 1.21e-7 all.equal(fixef(gm3B), c(`(Intercept)` = 4.159398, x = 3.058521),tol = 1e-5) # 1.13e-7 }) VarCorr(gm3) # both variances / std.dev. should be ~ 1 but are too small ## ## library(hglm) ## h1 <- hglm2(y~x+(1|block), data=d, family=Gamma()) ## lme4.0 fails on all of these ... ## Gamma/log ggl1 <- glmer(y ~ 1 + (1|block), data=dgl, family=Gamma(link="log")) ggl2 <- glmer(y ~ x + (1|block), data=dgl, family=Gamma(link="log"))# true model (h.1.2 <- anova(ggl1, ggl2)) stopifnot( all.equal(unlist(h.1.2[2,]), c(npar = 4, AIC = 34216.014, BIC = 34239.467, logLik = -17104.007, "-2*log(L)" = 34208.014, Chisq = 2458.5792, Df = 1, `Pr(>Chisq)` = 0)) ) ## "true" model : summary(ggl2) VarCorr(ggl2) ## ## library(lme4.0) ## ggl1 <- glmer(y ~ 1 + (1|block), data=dgl, family=Gamma(link="log"), verbose= 2) ## fails ## Poisson/log gP1 <- glmer(y ~ 1 + (1|block), data=dP, family=poisson) gP2 <- glmer(y ~ x + (1|block), data=dP, family=poisson) ## Gaussian/log gG1 <- glmer(y ~ 1 + (1|block), data=dG, family=gaussian(link="log")) gG2 <- glmer(y ~ x + (1|block), data=dG, family=gaussian(link="log")) ## works with lme4.0 but AIC/BIC/logLik are crazy, and scale ## parameter is not reported ## glmmML etc. doesn't allow models with scale parameters ## gG1B <- glmmadmb(y ~ 1 + (1|block), data=dG, ## family="gaussian",link="log",verbose=TRUE) ## what is the best guess at the estimate of the scale parameter? ## is it the same as sigma? ## gG1B$alpha ## if(Sys.info()["user"] != "maechler") { # <- seg.faults (MM) ## Gaussian/inverse gGi1 <- glmer(y ~ 1 + (1|block), data=dGi, family=gaussian(link="inverse")) gGi2 <- glmer(y ~ x + (1|block), data=dGi, family=gaussian(link="inverse")) ## Binomial/cloglog gBc1 <- glmer(y ~ 1 + (1|block), data=dBc, family=binomial(link="cloglog")) gBc2 <- glmer(y ~ x + (1|block), data=dBc, family=binomial(link="cloglog")) ## library("glmmADMB") ## glmmadmbfit <- glmmadmb(y ~ x + (1|block), data=dBc, ## family="binomial",link="cloglog") glmmadmbfit <- list(fixef = c("(Intercept)" = -0.717146132730349, x =2.83642900561633), VarCorr = structure(list( block = structure(0.79992, dim = c(1L, 1L), dimnames = list("(Intercept)", "(Intercept)"))), class = "VarCorr")) stopifnot(all.equal(fixef(gBc2), glmmadmbfit$fixef, tolerance=5e-3)) ## pretty loose tolerance ... stopifnot(all.equal(unname(unlist(VarCorr(gBc2))), c(glmmadmbfit$VarCorr$block), tolerance=2e-2)) gBi1 <- glmer(y ~ 1 + (1|block), data=dBi, family=binomial(link="identity")) gBi2 <- glmer(y ~ x + (1|block), data=dBi, family=binomial(link="identity")) ## FIXME: should test more of the *results* of these efforts, not ## just that they run without crashing ... }) ## skip on windows (for speed) lme4/tests/bootMer.R0000644000176200001440000000727215155634017014026 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) mySumm <- function(.) { s <- sigma(.) c(beta =getME(., "beta"), sigma = s, sig01 = unname(s * getME(., "theta"))) } fm1 <- lmer(Yield ~ 1|Batch, Dyestuff) boo01 <- bootMer(fm1, mySumm, nsim = 10) boo02 <- bootMer(fm1, mySumm, nsim = 10, use.u = TRUE) ## boo02 <- bootMer(fm1, mySumm, nsim = 500, use.u = TRUE) if (require(boot)) { boot.ci(boo02,index=2,type="perc") } fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) boo03 <- bootMer(fm2, mySumm, nsim = 10) boo04 <- bootMer(fm2, mySumm, nsim = 10, use.u = TRUE) if (lme4:::testLevel() > 1) { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) boo05 <- bootMer(gm1, mySumm, nsim = 10) boo06 <- bootMer(gm1, mySumm, nsim = 10, use.u = TRUE) cbpp$obs <- factor(seq(nrow(cbpp))) gm2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd) + (1|obs), family = binomial, data = cbpp) boo03 <- bootMer(gm2, mySumm, nsim = 10) boo04 <- bootMer(gm2, mySumm, nsim = 10, use.u = TRUE) } load(system.file("testdata","culcita_dat.RData",package="lme4")) cmod <- glmer(predation~ttt+(1|block),family=binomial,data=culcita_dat) set.seed(101) ## FIXME: sensitive to step-halving PIRLS tests ## expect_warning(cc <- confint(cmod,method="boot",nsim=10,quiet=TRUE, ## .progress="txt",PBargs=list(style=3)),"some bootstrap runs failed") library(parallel) if (max(detectCores(), 1L, na.rm = TRUE) > 1) { ## http://stackoverflow.com/questions/12983137/how-do-detect-if-travis-ci-or-not travis <- nchar(Sys.getenv("TRAVIS"))>0 if(.Platform$OS.type != "windows" && !travis) { boo01P <- bootMer(fm1, mySumm, nsim = 10, parallel="multicore", ncpus=2) } ## works in Solaris from an interactive console but not ??? ## via R CMD BATCH if (Sys.info()["sysname"] != "SunOS") boo01P.snow <- bootMer(fm1, mySumm, nsim = 10, parallel="snow", ncpus=2) if (require("future.apply", quietly = TRUE)) { plan(sequential) boo01P.future.seq <- bootMer(fm1, mySumm, nsim = 10, seed = 101, parallel = "future") plan(multisession) boo01P.future.multi <- bootMer(fm1, mySumm, nsim = 10, seed = 101, parallel = "future") stopifnot(all.equal(boo01P.future.seq$t, boo01P.future.multi$t)) plan(sequential) } } set.seed(101) dd <- data.frame(x=runif(200), f=rep(1:20,each=10), o=rnorm(200,mean=2)) dd$y <- suppressMessages(simulate(~x+(1|f)+offset(o), family="poisson", newdata=dd, newparams=list(theta=1,beta=c(0,2)))[[1]]) ## fails under flexLambda dd$y2 <- suppressMessages(simulate(~x+(1|f)+offset(o), family="gaussian", newdata=dd, newparams=list(theta=1,beta=c(0,2),sigma=1))[[1]]) fm3 <- glmer(y~x+(1|f)+offset(o), data=dd,family="poisson") fm4 <- lmer(y2~x+(1|f)+offset(o), data=dd) mySumm2 <- function(fit) return(c(fixef(fit),getME(fit,'theta'))) ## still some issues to fix here bb <- bootMer(fm3,mySumm2,nsim=10) attr(bb,"boot.fail.msgs") bb2 <- bootMer(fm4,mySumm2,nsim=10) } ## skip on windows (for speed) lme4/tests/extras.R0000644000176200001440000000153314234301437013711 0ustar liggesuserslibrary(lme4) ## This example takes long : only for testLevel >= 3 : d.ok <- isTRUE(try(data(star, package = 'mlmRev')) == 'star') if(!interactive() && (lme4:::testLevel() < 3 || !d.ok)) q("no") ## This worked in an *older* version of lme4.0 ## fm1 <- lme4:::carryOver(math ~ gr+sx*eth+cltype+(yrs|id)+(1|tch)+(yrs|sch), ## star, yrs ~ tch/id, ## control = list(msV = 1, nit = 0, grad = 0)) system.time( fm1 <- lmer(math ~ gr + sx*eth + cltype + schtype + hdeg + clad + exp + trace + (yrs | id) + (1 | tch) + (yrs | sch), data = star, verbose = TRUE) ) ## user system elapsed ## 34.991 0.037 35.132 -- lme4.0 ## 36.599 0.031 36.745 -- lme4 {bobyqa; 2014-01-09 @ lynne} sm1 <- summary(fm1) print(sm1, corr=TRUE, symbolic.cor=TRUE)# now message *and* gives the correlation lme4/tests/is.R0000644000176200001440000000160615036542626013027 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) stopifnot(isREML(fm1), isLMM(fm1), !isGLMM(fm1), !isNLMM(fm1)) fm1ML <- refitML(fm1) stopifnot(!isREML(fm1ML), isLMM(fm1ML), !isGLMM(fm1ML), !isNLMM(fm1ML)) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) stopifnot(!isREML(gm1), !isLMM(gm1), isGLMM(gm1), !isNLMM(gm1)) nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = c(Asym = 200, xmid = 725, scal = 350)) stopifnot(!isREML(nm1), !isLMM(nm1), !isGLMM(nm1), isNLMM(nm1)) } ## skip on windows (for speed) lme4/tests/glmer-1.R0000644000176200001440000002657715225703727013677 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") withAutoprint({ ## generalized linear mixed model stopifnot(suppressPackageStartupMessages(require(lme4))) options(show.signif.stars = FALSE) source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ## ##' Check that coefficient +- "2" * SD contains true value ##' ##' @title Check that confidence interval for coefficients contains true value ##' @param fm fitted model, e.g., from lm(), lmer(), glmer(), .. ##' @param true.coef numeric vector of true (fixed effect) coefficients ##' @param conf.level confidence level for confidence interval ##' @param sd.factor the "2", i.e. default 1.96 factor for the confidence interval ##' @return TRUE or a string of "error" ##' @author Martin Maechler chkFixed <- function(fm, true.coef, conf.level = 0.95, sd.factor = qnorm((1+conf.level)/2)) { stopifnot(is.matrix(cf <- coefficients(summary(fm))), ncol(cf) >= 2) cc <- cf[,1] sd <- cf[,2] if(any(out1 <- true.coef < cc - sd.factor*sd)) return(sprintf("true coefficient[j], j=%s, is smaller than lower confidence limit", paste(which(out1), collapse=", "))) if(any(out2 <- true.coef > cc + sd.factor*sd)) return(sprintf("true coefficient[j], j=%s, is larger than upper confidence limit", paste(which(out2), collapse=", "))) ## else, return TRUE } ## TODO: (1) move these to ./glmer-ex.R [DONE] ## ---- (2) "rationalize" with ../man/cbpp.Rd #m1e <- glmer1(cbind(incidence, size - incidence) ~ period + (1 | herd), # family = binomial, data = cbpp, doFit = FALSE) ## now #bobyqa(m1e, control = list(iprint = 2L)) m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp) m1. <- update(m1, start = getME(m1, c("theta", "fixef"))) dm1 <- drop1(m1) stopifnot(all.equal(drop1(m1.), dm1, tol = 1e-10))# Lnx(F28) 64b: 4e-12 ## response as a vector of probabilities and usage of argument "weights" m1p <- glmer(incidence / size ~ period + (1 | herd), weights = size, family = binomial, data = cbpp) ## Confirm that these are equivalent: stopifnot(all.equal(fixef(m1), fixef(m1p)), all.equal(ranef(m1), ranef(m1p)), TRUE) ## for(m in c(m1, m1p)) { ## cat("-------\\n\\nCall: ", ## paste(format(getCall(m)), collapse="\\n"), "\\n") ## print(logLik(m)); cat("AIC:", AIC(m), "\\n") ; cat("BIC:", BIC(m),"\\n") ## } stopifnot(all.equal(logLik(m1), logLik(m1p)), all.equal(AIC(m1), AIC(m1p)), all.equal(BIC(m1), BIC(m1p))) ## changed tolPwrss to 1e-7 to match other default m1b <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, verbose = 2L, control = glmerControl(optimizer="bobyqa", tolPwrss=1e-7, optCtrl=list(rhobeg=0.2, rhoend=2e-7))) ## using nAGQ=9L provides a better evaluation of the deviance m.9 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ = 9) ## check with nAGQ = 25 m2 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, nAGQ = 25) ## loosened tolerance on parameters stopifnot(is((cm2 <- coef(m2)), "coef.mer"), dim(cm2$herd) == c(15,4), all.equal(fixef(m2), ### lme4a [from an Ubuntu 11.10 amd64 system] c(-1.39922533406847, -0.991407294757321, -1.12782184600404, -1.57946627431248), ##c(-1.3766013, -1.0058773, ## -1.1430128, -1.5922817), tolerance = 5.e-4, check.attributes=FALSE), all.equal(c(-2*logLik(m2)), 100.010030538022, tolerance=1e-9), all.equal(deviance(m2), 73.373, tolerance=1e-5) ## with bobyqa first (AGQ=0), then ##all.equal(deviance(m2), 101.119749563, tolerance=1e-9) ) ## 32-bit Ubuntu 10.04: coef_m1_lme4.0 <- structure(c(-1.39853505102576, -0.992334712470269, -1.12867541092127, -1.58037389566025), names = c("(Intercept)", "period2", "period3", "period4")) ## library(glmmADMB) ## mg <- glmmadmb(cbind(incidence, size - incidence) ~ period + (1 | herd), ## family = "binomial", data = cbpp) coef_m1_glmmadmb <- structure(c(-1.39853810064827, -0.99233330126975, -1.12867317840779, -1.58031150854503), names = c("(Intercept)", "period2", "period3", "period4")) ## library(glmmML) ## mm <- glmmML(cbind(incidence, size - incidence) ~ period, ## cluster=herd, ## family = "binomial", data = cbpp) coef_m1_glmmML <- structure(c(-1.39853234657711, -0.992336901732793, -1.12867036466201, -1.58030977686564), names = c("(Intercept)", "period2", "period3", "period4")) ## lme4[r 1636], 64-bit ubuntu 11.10: ## c(-1.3788385, -1.0589543, ## -1.1936382, -1.6306271), stopifnot(is((cm1 <- coef(m1b)), "coef.mer"), dim(cm1$herd) == c(15,4), all.equal(fixef(m1b),fixef(m1),tolerance=4e-5), is.all.equal4(fixef(m1b), coef_m1_glmmadmb, coef_m1_lme4.0, coef_m1_glmmML, tol = 5e-4) ) ## Deviance for the new algorithm is lower, eventually we should change the previous test ##stopifnot(deviance(m1) <= deviance(m1e)) showProc.time() # if (require('MASS', quietly = TRUE)) { bacteria$wk2 <- bacteria$week > 2 contrasts(bacteria$trt) <- structure(contr.sdif(3), dimnames = list(NULL, c("diag", "encourage"))) print(fm5 <- glmer(y ~ trt + wk2 + (1|ID), data=bacteria, family=binomial)) showProc.time() # stopifnot( all.equal(logLik(fm5), ## was -96.127838 structure(-96.13069, nobs = 220L, nall = 220L, df = 5L, REML = FALSE, class = "logLik"), tolerance = 5e-4, check.attributes = FALSE) , all.equal(fixef(fm5), ## was 2.834218798 -1.367099481 c("(Intercept)"= 2.831609490, "trtdiag"= -1.366722631, ## now 0.5842291915, -1.599148773 "trtencourage"=0.5840147802, "wk2TRUE"=-1.598591346), tolerance = 1e-4 ) ) } ## Failure to specify a random effects term - used to give an obscure message ## Ensure *NON*-translated message; works on Linux,... : if(.Platform$OS.type == "unix") { Sys.setlocale("LC_MESSAGES", "C") tc <- tryCatch( m2 <- glmer(incidence / size ~ period, weights = size, family = binomial, data = cbpp) , error = function(.) .) stopifnot(inherits(tc, "error"), identical(tc$message, "No random effects terms specified in formula")) } ## glmer - Modeling overdispersion as "mixture" aka ## ----- - *ONE* random effect *PER OBSERVATION" -- example inspired by Ben Bolker: ##' ##' ##'
##' @title ##' @param ng number of groups ##' @param nr number of "runs", i.e., observations per groups ##' @param sd standard deviations of group and "Individual" random effects, ##' (\sigma_f, \sigma_I) ##' @param b true beta (fixed effects) ##' @return a data frame (to be used in glmer()) with columns ##' (x, f, obs, eta0, eta, mu, y), where y ~ Pois(lambda(x)), ##' log(lambda(x_i)) = b_1 + b_2 * x + G_{f(i)} + I_i ##' and G_k ~ N(0, \sigma_f); I_i ~ N(0, \sigma_I) ##' @author Ben Bolker and Martin Maechler rPoisGLMMi <- function(ng, nr, sd=c(f = 1, ind = 0.5), b=c(1,2)) { stopifnot(nr >= 1, ng >= 1, is.numeric(sd), names(sd) %in% c("f","ind"), sd >= 0) ntot <- nr*ng b.reff <- rnorm(ng, sd= sd[["f"]]) b.rind <- rnorm(ntot,sd= sd[["ind"]]) x <- runif(ntot) within(data.frame(x, f = factor(rep(LETTERS[1:ng], each=nr)), obs = 1:ntot, eta0 = cbind(1, x) %*% b), { eta <- eta0 + b.reff[f] + b.rind[obs] mu <- exp(eta) y <- rpois(ntot, lambda=mu) }) } set.seed(1) dd <- rPoisGLMMi(12, 20) m0 <- glmer(y~x + (1|f), family="poisson", data=dd) m1 <- glmer(y~x + (1|f) + (1|obs), family="poisson", data=dd) stopifnot(isTRUE(chkFixed(m0, true.coef = c(1,2))), isTRUE(chkFixed(m1, true.coef = c(1,2)))) (a01 <- anova(m0, m1)) stopifnot(all.equal(a01$Chisq[2], 554.334056, tolerance=1e-5), all.equal(a01$logLik, c(-1073.77193, -796.604902), tolerance=1e-6), a01$ npar == 3:4, na.omit(a01$ Df) == 1) if(lme4:::testLevel() > 1) { nsim <- 10 set.seed(2) system.time( simR <- lapply(1:nsim, function(i) { cat(i,"", if(i %% 20 == 0)"\n") dd <- rPoisGLMMi(10 + rpois(1, lambda=3), 16 + rpois(1, lambda=5)) m0 <- glmer(y~x + (1|f), family="poisson", data=dd) m1 <- glmer(y~x + (1|f) + (1|obs), family="poisson", data=dd) a01 <- anova(m0, m1) stopifnot(a01$ npar == 3:4, na.omit(a01$ Df) == 1) list(chk0 = chkFixed(m0, true.coef = c(1,2)), chk1 = chkFixed(m1, true.coef = c(1,2)), chisq= a01$Chisq[2], lLik = a01$logLik) })) ## m0 is the wrong model, so we don't expect much here: table(unlist(lapply(simR, `[[`, "chk0"))) ## If the fixed effect estimates were unbiased and the standard errors correct, ## and N(0,sigma^2) instead of t_{nu} good enough for the fixed effects, ## the confidence interval should contain the true coef in ~95 out of 100: table(unlist(lapply(simR, `[[`, "chk1"))) ## The tests are all highly significantly in favor of m1 : summary(chi2s <- sapply(simR, `[[`, "chisq")) ## Min. 1st Qu. Median Mean 3rd Qu. Max. ## 158.9 439.0 611.4 698.2 864.3 2268.0 stopifnot(chi2s > qchisq(0.9999, df = 1)) } showProc.time() }) ## skip if windows and testLevel<1 lme4/tests/methods.R0000644000176200001440000000166515036542626014064 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) expect_equal(colnames(model.frame(fm1)),c("Reaction","Days","Subject")) expect_equal(colnames(model.frame(fm1,fixed.only=TRUE)),c("Reaction","Days")) expect_equal(formula(fm1),Reaction ~ Days + (Days | Subject)) expect_equal(formula(fm1,fixed.only=TRUE),Reaction ~ Days) ## ugly example: model frame with compound elements fm2 <- lmer(log(Reaction) ~ splines::ns(Days,3) + + I(1+Days^3) + (Days|Subject), sleepstudy) expect_equal(names(model.frame(fm2)), c("log(Reaction)", "splines::ns(Days, 3)", "I(1 + Days^3)", "Days", "Subject")) expect_equal(names(model.frame(fm2,fixed.only=TRUE)), c("log(Reaction)", "splines::ns(Days, 3)", "I(1 + Days^3)")) } ## skip on windows (for speed) lme4/tests/lmer-0.R0000644000176200001440000001206415036542626013510 0ustar liggesusersrequire(lme4) source(system.file("test-tools-1.R", package = "Matrix"))# identical3() etc ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } ## Check that quasi families throw an error assertError(lmer(cbind(incidence, size - incidence) ~ period + (1|herd), data = cbpp, family = quasibinomial)) assertError(lmer(incidence ~ period + (1|herd), data = cbpp, family = quasipoisson)) assertError(lmer(incidence ~ period + (1|herd), data = cbpp, family = quasi)) ## check bug found by Kevin Buhr set.seed(7) n <- 10 X <- data.frame(y=runif(n), x=rnorm(n), z=sample(c("A","B"), n, TRUE)) fm <- lmer(log(y) ~ x | z, data=X) ## ignore grouping factors with ## gave error inside model.frame() stopifnot(all.equal(c(`(Intercept)` = -0.834544), fixef(fm), tolerance=.01)) ## is "Nelder_Mead" default optimizer? (isNM <- formals(lmerControl)$optimizer == "Nelder_Mead") (isOldB <- formals(lmerControl)$optimizer == "bobyqa") (isOldTol <- environment(nloptwrap)$defaultControl$xtol_abs == 1e-6) if (.Platform$OS.type != "windows") withAutoprint({ source(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> uc() ## check working of Matrix methods on vcov(.) etc ---------------------- fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) V <- vcov(fm) (V1 <- vcov(fm1)) (C1 <- chol(V1)) dput(dV <- as.numeric(diag(V))) # 0.17607818634.. [x86_64, F Lnx 36] TOL <- 0 # to show the differences below TOL <- 1e-5 # for the check stopifnot(exprs = { all.equal(dV, uc(if(isNM) 0.176076 else if(isOldB) 0.176068575 else if(isOldTol) 0.1761714 else 0.1760782), tolerance = 9*TOL) # seen 7.8e-8; Apple clang 14.0.3 had 6.3783e-5 all.equal(sqrt(dV), as.numeric(chol(V)), tol = 1e-12) all.equal(diag(V1), uc(`(Intercept)` = 46.5751, Days = 2.38947), tolerance = 40*TOL)# 5e-7 (for "all" algos) is(C1, "dtrMatrix") # was inherits(C1, "Cholesky") dim(C1) == c(2,2) all.equal(as.numeric(C1), # 6.8245967 0. -0.2126263 1.5310962 [x86_64, F Lnx 36] c(6.82377, 0, -0.212575, 1.53127), tolerance=20*TOL)# 1.2e-4 ("all" algos) dim(chol(crossprod(getME(fm1, "Z")))) == 36 }) ## printing signif(chol(crossprod(getME(fm, "Z"))), 5) # -> simple 4 x 4 sparse showProc.time() # ## From: Stephane Laurent ## To: r-sig-mixed-models@.. ## "crash with the latest update of lme4" ## ## .. example for which lmer() crashes with the last update of lme4 ...{R-forge}, ## .. but not with version CRAN version (0.999999-0) lsDat <- data.frame( Operator = as.factor(rep(1:5, c(3,4,8,8,8))), Part = as.factor( c(2L, 3L, 5L, 1L, 1L, 2L, 3L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 5L, 1L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 1L, 2L, 2L, 3L, 3L, 4L, 5L, 5L)), y = c(0.34, -1.23, -2.46, -0.84, -1.57,-0.31, -0.18, -0.94, -0.81, 0.77, 0.4, -2.37, -2.78, 1.29, -0.95, -1.58, -2.06, -3.11,-3.2, -0.1, -0.49,-2.02, -0.75, 1.71, -0.85, -1.19, 0.13, 1.35, 1.92, 1.04, 1.08)) xtabs( ~ Operator + Part, data=lsDat) # --> 4 empty cells, quite a few with only one obs.: ## Part ## Operator 1 2 3 4 5 ## 1 0 1 1 0 1 ## 2 2 1 1 0 0 ## 3 2 2 2 1 1 ## 4 1 1 2 2 2 ## 5 1 2 2 1 2 lsD29 <- lsDat[1:29, ] ## FIXME: rank-Z test should probably not happen in this case: (sm3 <- summary(m3 <- lm(y ~ Part*Operator, data=lsDat)))# ok: some interactions not estimable stopifnot(21 == nrow(coef(sm3)))# 21 *are* estimable sm4 <- summary(m4 <- lm(y ~ Part*Operator, data=lsD29)) stopifnot(20 == nrow(coef(sm4)))# 20 *are* estimable lf <- lFormula(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsDat) dim(Zt <- lf$reTrms$Zt)## 31 x 31 c(rankMatrix(Zt)) ## 21 c(rankMatrix(Zt,method="qr")) ## 31 || 29 (64 bit Lnx), then 21 (!) c(rankMatrix(t(Zt),method="qr")) ## 30, then 21 ! nrow(lsDat) fm3 <- lmer(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsDat, control=lmerControl(check.nobs.vs.rankZ="warningSmall")) lf29 <- lFormula(y ~ (1|Part) + (1|Operator) + (1|Part:Operator), data = lsD29) (fm4 <- update(fm3, data=lsD29)) fm4. <- update(fm4, REML=FALSE, control=lmerControl(optimizer="nloptwrap", optCtrl=list(ftol_abs=1e-6, xtol_abs=1e-6))) ## summary(fm4.) stopifnot( all.equal(as.numeric(formatVC(VarCorr(fm4.), digits = 7)[,"Std.Dev."]), c(1.040664, 0.6359187, 0.5291422, 0.4824796), tol = 1e-4) ) showProc.time() }) ## skip on windows (for speed) cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' lme4/tests/minval.R0000644000176200001440000000242715036542626013704 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ## example posted by Stéphane Laurent ## exercises bug where Nelder-Mead min objective function value was >0 set.seed(666) sims <- function(I, J, sigmab0, sigmaw0){ Mu <- rnorm(I, mean=0, sd=sigmab0) y <- c(sapply(Mu, function(mu) rnorm(J, mu, sigmaw0))) data.frame(y=y, group=gl(I,J)) } I <- 3 # number of groups J <- 8 # number of repeats per group sigmab0 <- 0.15 # between standard deviation sigmaw0 <- 0.15 # within standard deviation dat <- sims(I, J, sigmab0, sigmaw0) library(lme4) isOldTol <- environment(nloptwrap)$defaultControl$xtol_abs == 1e-6 fm3 <- lmer(y ~ (1|group), data=dat) stopifnot(all.equal(unname(unlist(VarCorr(fm3))), switch(fm3@optinfo$optimizer, "Nelder_Mead" = 0.029662844, "bobyqa" = 0.029662698, "nloptwrap" = if (isOldTol) 0.029679755 else 0.029662699, stop("need new case here: value is ",unname(unlist(VarCorr(fm3)))) ), tolerance = 1e-7)) } ## skip on windows (for speed) lme4/tests/fewlevels.R0000644000176200001440000000132015036542626014401 0ustar liggesusers#### example originally from Gabor Grothendieck source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##--> rSim.11() testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { set.seed(1) d1 <- rSim.11(10000, k=4) library(nlme) m.lme <- lme(y ~ x, random=~ 1|fac , data=d1) (VC.lme <- VarCorr(m.lme)) detach("package:nlme") ## library(lme4) fm.NM <- lmer(y ~ x + (1|fac), data=d1, control=lmerControl("Nelder_Mead")) fm.Bq <- update(fm.NM, control=lmerControl("bobyqa")) v.lmer <- VarCorr(fm.NM)[[1]][1,1] stopifnot(all.equal(v.lmer,19.55,tolerance=1e-3)) ## was 19.5482 with old starting values (1), 19.5493 with new start algorithm } ## testLevel>1 lme4/tests/throw.R0000644000176200001440000000157215036542626013561 0ustar liggesusers## original code was designed to detect segfaults/hangs from error handling library(lme4) set.seed(101) d <- expand.grid(block = LETTERS[1:26], rep = 1:100) d$x <- runif(nrow(d)) reff_f <- rnorm(length(levels(d$block)),sd=1) ## need intercept large enough to avoid negative values d$eta0 <- 4+3*d$x ## version without random effects d$eta <- d$eta0+reff_f[d$block] ## inverse link d$mu <- 1/d$eta d$y <- rgamma(nrow(d), scale=d$mu/2, shape=2) if (.Platform$OS.type != "windows") { gm0 <- glmer(y ~ 1|block, d, Gamma) gm0.A25 <- glmer(y ~ 1|block, d, Gamma, nAGQ=25L) gm1 <- glmer(y ~ x + (1|block), d, Gamma) gm1.A25 <- glmer(y ~ x + (1|block), d, Gamma, nAGQ=25L) ## strange things happening for logLik ==> AIC, etc for nAGQ ??? anova(gm0, gm1) anova(gm0, gm0.A25) anova(gm1, gm1.A25) summary(gm1) # "fine" summary(gm1.A25) # Inf logLik etc ? } lme4/tests/resids.R0000644000176200001440000000115114234301437013670 0ustar liggesuserslibrary(lme4) ## raw residuals for LMMs fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) stopifnot(all.equal(residuals(fm1),sleepstudy$Reaction-fitted(fm1))) r1 <- residuals(fm1,type="pearson") ## deviance/Pearson residuals for GLMMs gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp) p <- fitted(gm1) n <- cbpp$size v <- n*p*(1-p) obs_p <- cbpp$incidence/cbpp$size rp <- residuals(gm1,"pearson") rp1 <- (obs_p-p)/sqrt(p*(1-p)) rp2 <- rp1*n ## FIXME:: restore this test ## stopifnot(all.equal(rp,rp2)) r2 <- residuals(gm1,type="deviance") lme4/tests/offset.R0000644000176200001440000000263615036542626013706 0ustar liggesusers## simple examples with offsets, to exercise methods etc. library(lme4) if (.Platform$OS.type != "windows") { ## generate a basic Gamma/random effects sim set.seed(101) d <- expand.grid(block=LETTERS[1:26],rep=1:100) d$x <- runif(nrow(d)) ## sd=1 reff_f <- rnorm(length(levels(d$block)),sd=1) ## need intercept large enough to avoid negative values d$eta0 <- 4+3*d$x ## version without random effects d$eta <- d$eta0+reff_f[d$block] ## lmer() test: d$mu <- d$eta d$y <- rnorm(nrow(d),mean=d$mu,sd=1) fm1 <- lmer(y~x+(1|block), data=d) fm1off <- lmer(y~x+(1|block)+offset(3*x),data=d) ## check equality stopifnot(all.equal(fixef(fm1)[2]-3,fixef(fm1off)[2])) p0 <- predict(fm1) p1 <- predict(fm1,newdata=d) p2 <- predict(fm1off,newdata=d) stopifnot(all.equal(p0,p1), all.equal(p1,p2)) ## glmer() test: d$mu <- exp(d$eta) d$y <- rpois(nrow(d),d$mu) gm1 <- glmer(y~x+(1|block), data=d,family=poisson, control=glmerControl(check.conv.grad="ignore")) gm1off <- glmer(y~x+(1|block)+offset(3*x),data=d,family=poisson, control=glmerControl(check.conv.grad="ignore")) ## check equality stopifnot(all.equal(fixef(gm1)[2]-3,fixef(gm1off)[2],tolerance=3e-4)) p0 <- predict(gm1) p1 <- predict(gm1,newdata=d) p2 <- predict(gm1off,newdata=d) stopifnot(all.equal(p0,p1), all.equal(p1,p2)) ## FIXME: should also test simulations } ## skip on windows (for speed) lme4/tests/ST.R0000644000176200001440000000067614234301437012740 0ustar liggesusersrequire(lme4) # sorry for fitting yet another sleepstudy model in the tests m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ST <- getME(m, "ST")$Subject # copied from vince dorie's simmer.R in arm: dimension <- nrow(ST) T <- ST diag(T) <- rep(1, dimension) S <- diag(diag(ST), dimension) vc0 <- getME(m, 'sigma')^2*tcrossprod(T %*% S) vc1 <- VarCorr(m)$Subject[,] dimnames(vc0) <- dimnames(vc1) all.equal(vc0, vc1, tolerance = 1e-6) lme4/tests/predict_basis.R0000644000176200001440000000304115036542626015222 0ustar liggesusers## test for models containing data-defined bases ## ?makepredictcall ## ?model.frame ## ???? data(sleepstudy,package="lme4") library(splines) ## lm0 <- lm(Reaction~ns(Days,2),sleepstudy) ## attr(terms(lm0),"predvars") ## library(nlme) ## lme1 <- lme(Reaction~ns(Days,2),random=~1|Subject,sleepstudy) ## attr(terms(lme1),"predvars") ## no! ## attr(lme1$terms,"predvars") ## yes ## detach("package:nlme") library(lme4) fm1 <- lmer(Reaction ~ ns(Days,2) + (1|Subject), sleepstudy) fm2 <- lmer(Reaction ~ poly(Days,2) + (1|Subject), sleepstudy) fm3 <- lmer(Reaction ~ poly(Days,2,raw=TRUE) + (1|Subject), sleepstudy) newdat0 <- data.frame(Days = unique(sleepstudy$Days)) newdat <- data.frame(Days = 5:12) tmpf <- function(fit) { with(sleepstudy, { plot (Reaction~Days, xlim=c(0,12)) points(Days, predict(fit), col=2) }) lines(newdat0$ Days, predict(fit,re.form=NA,newdata=newdat0), col=4) lines(newdat $ Days, predict(fit,re.form=NA,newdata=newdat ), col=5) } stopifnot(all.equal(predict(fm2,newdat,re.form=NA), predict(fm3,newdat,re.form=NA))) ## pictures tmpf(fm1) tmpf(fm2) tmpf(fm3) ## test for GLMMs set.seed(101) d <- data.frame(y=rbinom(10,size=1,prob=0.5), x=1:10, f=factor(rep(1:5,each=2))) gm1 <- glmer(y ~ poly(x,2) + (1|f), d, family=binomial) gm2 <- glmer(y ~ poly(x,2,raw=TRUE) + (1|f), d, family=binomial) newdat <- data.frame(x=c(1,4,6)) stopifnot(all.equal(predict(gm1,newdat,re.form=NA), predict(gm2,newdat,re.form=NA),tolerance=3e-6)) lme4/tests/testOptControl.R0000644000176200001440000000327215036542626015420 0ustar liggesusers## https://github.com/lme4/lme4/issues/59 library(lme4) dat <- read.csv(system.file("testdata","dat20101314.csv",package="lme4")) NMcopy <- lme4:::Nelder_Mead cc <- capture.output(lmer(y ~ (1|Operator)+(1|Part)+(1|Part:Operator), data=dat, control= lmerControl("NMcopy", optCtrl= list(iprint=20)))) ## check that printing goes through step 140 twice and up to 240 once ## findStep <- function(str,n) sum(grepl(paste0("\\(NM\\) ",n,": "),str)) cc <- paste(cc,collapse="") countStep <- function(str,n) { length(gregexpr(paste0("\\(NM\\) ",n,": "),str)[[1]]) } stopifnot(countStep(cc,140)==2 && countStep(cc,240)==1) ## testStr <- ## "(NM) 20: f = -53.3709 at 0.706667 0.813333 1.46444(NM) 40: f = -147.132 at 0 0 19.18(NM) 60: f = -147.159 at 0 0 17.4275(NM) 80: f = -147.159 at 0 0 17.5615(NM) 100: f = -147.159 at 0 0 17.5754(NM) 120: f = -147.159 at 0 0 17.5769(NM) 140: f = -147.159 at 0 0 17.5768(NM) 20: f = -165.55 at 0.0933333 0.573333 17.3168(NM) 40: f = -173.704 at 0.23799 1.4697 16.9728(NM) 60: f = -173.849 at 0.449634 1.39998 16.9452(NM) 80: f = -174.421 at 0.52329 1.69123 18.1534(NM) 100: f = -176.747 at 0.762043 1.88271 32.8993(NM) 120: f = -176.839 at 0.751206 1.75371 37.2128(NM) 140: f = -176.853 at 0.706425 1.7307 35.7528(NM) 160: f = -176.853 at 0.710803 1.73476 35.7032(NM) 180: f = -176.853 at 0.710159 1.73449 35.6699(NM) 200: f = -176.853 at 0.710271 1.73461 35.6689(NM) 220: f = -176.853 at 0.710259 1.7346 35.6684(NM) 240: f = -176.853 at 0.710257 1.73459 35.6685Linear mixed model fit by REML ['lmerMod']" lme4/tests/getME.R0000644000176200001440000000430415036542626013413 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) #### tests of getME() ### are names correct? -------------- if(getRversion() < "2.15") paste0 <- function(...) paste(..., sep = '') hasInms <- function(x) grepl("(Intercept", names(x), fixed=TRUE) matchNms <- function(fm, PAR) { stopifnot(is.character(vnms <- names(fm@cnms))) mapply(grepl, paste0("^", vnms), names(PAR)) } chkIMod <- function(fm) {## check "intercept only" model b1 <- getME(fm,"beta") f1 <- fixef(fm) stopifnot(hasInms(f1), f1 == b1, hasInms(t1 <- getME(fm,"theta")), matchNms(fm, t1)) } fm1 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) chkIMod(fm1) fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) stopifnot(fixef(fm2) == getME(fm2,"beta")) getME(fm2,"theta") getME(fm3 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy), "theta") getME(fm4 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy), "theta") ## internal consistency check ensuring that all allowed 'name's work (and are not empty): (nmME <- eval(formals(lme4:::getME.merMod)$name)) chkMEs <- function(fm, nms) { stopifnot(is.character(nms)) str(parts <- sapply(nms, getME, object = fm, simplify=FALSE)) isN <- sapply(parts, is.null) stopifnot(identical(names(isN), nms), !any(isN)) } chkMEs(fm1, nmME) chkMEs(fm2, nmME) chkMEs(fm3, nmME) chkMEs(fm4, nmME) ## multiple components can now be retrieved at once gg <- getME(fm2,c("theta","beta")) gg2 <- getME(fm2,c("theta","beta","X")) ## list of Zt for each random-effects factor lapply(getME(fm2,c("Ztlist")),dim) ## Cholesky factors returned as a list of matrices getME(fm1,"ST") getME(fm2,"ST") ## distinction between number of RE terms ## and number of RE grouping factors stopifnot(getME(fm2,"n_rtrms")==1) stopifnot(getME(fm2,"n_rfacs")==1) lapply(getME(fm4,c("Ztlist")),dim) stopifnot(getME(fm4,"n_rtrms")==2) stopifnot(getME(fm4,"n_rfacs")==1) stopifnot(getME(fm1,"sigma")==sigma(fm1)) } ## skip on windows (for speed) lme4/tests/test-glmernbref.R0000644000176200001440000000047615036542626015520 0ustar liggesusers## DON'T load lme4; test is to see if glmer.nb works when ## lme4 is not loaded set.seed(101) dd <- data.frame(x=runif(200), f= rep(1:20, each=10)) b <- rnorm(20) dd <- transform(dd, y = rnbinom(200, mu = exp(1 + 2*x + b[f]), size = 2)) g <- lme4::glmer.nb(y~x + (1|f), data = dd) stopifnot(inherits(g, "glmerMod")) lme4/tests/lmer-1.R0000644000176200001440000003143415225703727013514 0ustar liggesusers### suppressPackageStartupMessages(...) as we have an *.Rout.save to Rdiff against stopifnot(suppressPackageStartupMessages(require(lme4))) options(show.signif.stars = FALSE, useFancyQuotes=FALSE) source(system.file("test-tools-1.R", package = "Matrix"))# identical3() etc all.EQ <- function(u,v, ...) all.equal.X(u, v, except = c("call", "frame"), ...) S4_2list <- function(obj) { # no longer used sn <- slotNames(obj) setNames(lapply(sn, slot, object = obj), sn) } if (lme4:::testLevel() <= 1) quit("no") ## otherwise *print* normally: oldOpts <- options(digits=2) (fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)) (fm1a <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, REML = FALSE)) (fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) anova(fm1, fm2) ## Now works for glmer fm1. <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) ## default family=gaussian/identity link -> automatically calls lmer() (but with a warning) ## hack call -- comes out unimportantly different fm1.@call[[1]] <- quote(lmer) stopifnot(all.equal(fm1, fm1.)) ## Test against previous version in lmer1 (using bobyqa for consistency) #(fm1. <- lmer1(Reaction ~ Days + (Days|Subject), sleepstudy, opt = "bobyqa")) #stopifnot(all.equal(fm1@devcomp$cmp['REML'], fm1.@devcomp$cmp['REML']), # all.equal(fixef(fm1), fixef(fm1.)), # all.equal(fm1@re@theta, fm1.@theta, tolerance = 1.e-7), # all.equal(ranef(fm1), ranef(fm1.))) ## compDev = FALSE no longer applies to lmer ## Test 'compDev = FALSE' (vs TRUE) ## fm1. <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, ## compDev = FALSE)#--> use R code (not C++) for deviance computation ## stopifnot(all.equal(fm1@devcomp$cmp['REML'], fm1.@devcomp$cmp['REML']), ## all.equal(fixef(fm1), fixef(fm1.)), ## all.equal(fm1@re@theta, fm1.@re@theta, tolerance = 1.e-7), ## all.equal(ranef(fm1), ranef(fm1.), tolerance = 1.e-7)) vv <- vcov(fm1) cc <- Matrix::cov2cor(vv) dimnames(cc) <- dimnames(vv) ## work around Matrix 1.5.2 buglet stopifnot( all.equal(fixef(fm1), fixef(fm2), tolerance = 1.e-13) , all.equal(unname(fixef(fm1)), c(251.405104848485, 10.467285959595), tolerance = 1e-13) , all.equal(cc["(Intercept)", "Days"], -0.1375, tolerance = 4e-4) ) fm1ML <- refitML(fm1) fm2ML <- refitML(fm2) (cbind(AIC= c(m1= AIC(fm1ML), m2= AIC(fm2ML)), BIC= c( BIC(fm1ML), BIC(fm2ML))) -> ICm) stopifnot(all.equal(c(ICm), c(1763.94, 1762, 1783.1, 1777.97), tolerance = 1e-5))# see 1.2e-6 (fm3 <- lmer(Yield ~ 1|Batch, Dyestuff2)) stopifnot(all.equal(coef(summary(fm3)), array(c(5.6656, 0.67838803150, 8.3515624346), c(1,3), dimnames = list("(Intercept)", c("Estimate", "Std. Error", "t value"))))) showProc.time() # ### {from ../man/lmer.Rd } --- compare lmer & lmer1 --------------- (fmX1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)) (fm.1 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) #(fmX2 <- lmer2(Reaction ~ Days + (Days|Subject), sleepstudy)) #(fm.2 <- lmer2(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) ## check update(, ): fm.3 <- update(fmX1, . ~ Days + (1|Subject) + (0+Days|Subject)) stopifnot(all.equal(fm.1, fm.3)) fmX1s <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy )# no longer:, sparseX=TRUE) #fmX2s <- lmer2(Reaction ~ Days + (Days|Subject), sleepstudy, sparseX=TRUE) options(oldOpts) ## restore digits showProc.time() # for(nm in c("coef", "fixef", "ranef", "sigma", "model.matrix", "model.frame" , "terms")) { cat(sprintf("%15s : ", nm)) FUN <- get(nm) F.fmX1s <- FUN(fmX1s) # F.fmX2s <- FUN(fmX2s) # if(nm == "model.matrix") { # F.fmX1s <- as(F.fmX1s, "denseMatrix") # F.fmX2s <- as(F.fmX2s, "denseMatrix") # FF <- function(.) {r <- FUN(.); row.names(r) <- NULL # as(r, "generalMatrix") } # } # else FF <- FUN stopifnot( all.equal( FF(fmX1), F.fmX1s, tolerance = 1e-6) # , # all.equal( FF(fmX2), F.fmX2s, tolerance = 1e-5) # , # all.equal( FF(fm.1), F.fmX2s, tolerance = 9e-6) ## these are different models # , # all.equal(F.fmX2s, F.fmX1s, tolerance = 6e-6) # , # all.equal(FUN(fm.1), FUN(fm.2), tolerance = 6e-6) , TRUE) cat("[Ok]\n") } ## transformed vars should work[even if non-sensical as here;failed in 0.995-1] fm2l <- lmer(log(Reaction) ~ log(Days+1) + (log(Days+1)|Subject), data = sleepstudy, REML = FALSE) ## no need for an expand method now : xfm2 <- expand(fm2) stopifnot(dim(ranef(fm2l)[[1]]) == c(18, 2), is((c3 <- coef(fm3)), "coef.mer"), all(fixef(fm3) == c3$Batch),## <-- IFF \hat{\sigma^2} == 0 TRUE) ## Simple example by Andrew Gelman (2006-01-10) ---- n.groups <- 10 ; n.reps <- 2 n <- length(group.id <- gl(n.groups, n.reps)) ## simulate the varying parameters and the data: set.seed(0) a.group <- rnorm(n.groups, 1, 2) y <- rnorm (n, a.group[group.id], 1) ## fit and summarize the model fit.1 <- lmer (y ~ 1 + (1 | group.id)) oldOpts <- options(digits=3) coef (fit.1) options(oldOpts) ## check show( <"summary.mer"> ): (sf1 <- summary(fit.1)) # --> now looks as for fit.1 stopifnot(all.equal(fixef(fit.1), c("(Intercept)" = 1.571312129)), all.equal(unname(ranef(fit.1, drop=TRUE)[["group.id"]]), structure( c(1.8046888, -1.8097665, 1.6146451, 1.5408268, -0.1331995, -3.3306655, -1.8259277, -0.8735145, -0.3591311, 3.3720441), postVar = rep.int(0.311091076, 10)), tolerance = 1e-5) ) ## ranef and coef rr <- ranef(fm1) stopifnot(is.list(rr), length(rr) == 1, is.data.frame(rr[[1]])) print(plot(rr)) stopifnot(is(cc <- coef(fm1), "coef.mer"), is.list(cc), length(cc) == 1, is.data.frame(cc[[1]])) print(plot(cc)) rr <- ranef(fm2) stopifnot(is.list(rr), length(rr) == 1, is.data.frame(rr[[1]])) print(plot(rr)) stopifnot(is(cc <- coef(fm2), "coef.mer"), is.list(cc), length(cc) == 1, is.data.frame(cc[[1]])) print(plot(cc)) showProc.time() # ## Invalid factor specification -- used to seg.fault: set.seed(1) dat <- within(data.frame(lagoon = factor(rep(1:4,each = 25)), habitat = factor(rep(1:20, each = 5))), { y <- round(10*rnorm(100, m = 10*as.numeric(lagoon))) }) tt <- suppressWarnings(try(reg <- lmer(y ~ habitat + (1|habitat*lagoon), data = dat) ) # did seg.fault) ) # now gives error ^- should be ":" ## suppress warning that uses different quoting conventions on ## R-release vs. R-devel ## ignore singular fits as well as hess/grad problems ## (Windows gets singular fits, other platforms don't ...) ctrl0 <- lmerControl( check.conv.singular="ignore", check.conv.hess="ignore", check.conv.grad="ignore") r1 <- lmer(y ~ 0+habitat + (1|habitat:lagoon), data = dat, control=ctrl0) # ok, but senseless r1b <- lmer(y ~ 0+habitat + (1|habitat), data = dat, control=ctrl0) # same model, clearly unidentifiable ## "TODO" : summary(r1) should ideally warn the user stopifnot(all.equal(fixef(r1), fixef(r1b), tolerance= 1e-15), all.equal(ranef(r1), ranef(r1b), tolerance= 1e-15, check.attributes=FALSE)) ## Use a more sensible model: r2.0 <- lmer(y ~ 0+lagoon + (1|habitat:lagoon), data = dat) # ok r2 <- lmer(y ~ 0+lagoon + (1|habitat), data = dat) # ok, and more clear stopifnot(all.equal(fixef(r2), fixef(r2.0), tolerance= 1e-15), all.equal(ranef(r2), ranef(r2.0), tolerance= 1e-15, check.attributes=FALSE)) V2 <- vcov(r2) assert.EQ.mat(V2, diag(x = 9.9833/3, nr = 4)) stopifnot(all.equal(unname(fixef(r2)) - (1:4)*100, c(1.72, 0.28, 1.76, 0.8), tolerance = 1e-13)) ## sparseX version should give same numbers: ## (only gives a warning now -- sparseX disregarded) if(FALSE) { ## no longer r2. <- lmer(y ~ 0+lagoon + (1|habitat), data = dat, sparseX = TRUE) ## the summary() components we do want to compare 'dense X' vs 'sparse X': nmsSumm <- c("methTitle", "devcomp", "logLik", "ngrps", "coefficients", "sigma", "REmat", "AICtab") sr2 <- summary(r2) sr2. <- summary(r2.) sr2.$devcomp$dims['spFe'] <- 0L # to allow for comparisons below stopifnot(all.equal(sr2[nmsSumm], sr2.[nmsSumm], tolerance= 1e-14) , all.equal(ranef(r2), ranef(r2.), tolerance= 1e-14) , Matrix:::isDiagonal(vcov(r2.)) # ok , all.equal(Matrix::diag(vcov(r2.)), rep.int(V2[1,1], 4), tolerance= 1e-13) # , all(vcov(r2.)@factors$correlation == diag(4)) # not sure why this fails , TRUE) r2. } ### mcmcsamp() : ## From: Andrew Gelman ## Date: Wed, 18 Jan 2006 22:00:53 -0500 if (FALSE) { # mcmcsamp still needs work ## NB: Need to restore coda to the Suggests: field of DESCRIPTION ## file if this code block is reinstated. ## has.coda <- require(coda) ## if(!has.coda) ## cat("'coda' package not available; some outputs will look suboptimal\n") ## Very simple example y <- 1:10 group <- gl(2,5) (M1 <- lmer (y ~ 1 + (1 | group))) # works fine (r1 <- mcmcsamp (M1)) # dito r2 <- mcmcsamp (M1, saveb = TRUE) # gave error in 0.99-* and 0.995-[12] (r10 <- mcmcsamp (M1, n = 10, saveb = TRUE)) ## another one, still simple y <- (1:20)*pi x <- (1:20)^2 group <- gl(2,10) M1 <- lmer (y ~ 1 | group) mcmcsamp (M1, n = 2, saveb=TRUE) # fine M2 <- lmer (y ~ 1 + x + (1 + x | group)) # false convergence ## should be identical (and is) M2 <- lmer (y ~ x + ( x | group))# false convergence -> simulation doesn't work: if(FALSE) ## try(..) fails here (in R CMD check) [[why ??]] mcmcsamp (M2, saveb=TRUE) ## Error: inconsistent degrees of freedom and dimension ... ## mcmc for glmer: rG1k <- mcmcsamp(m1, n = 1000) summary(rG1k) rG2 <- mcmcsamp(m1, n = 3, verbose = TRUE) } ## Spencer Graves' example (from a post to S-news, 2006-08-03) ---------------- ## it should give an error, rather than silent non-sense: tstDF <- data.frame(group = letters[1:5], y = 1:5) assertError(## Now throws an error, as desired : lmer(y ~ 1 + (1|group), data = tstDF) ) showProc.time() # ## Wrong formula gave a seg.fault at times: set.seed(2)# ! D <- data.frame(y= rnorm(12,10), ff = gl(3,2,12), x1=round(rnorm(12,3),1), x2=round(rnorm(12,7),1)) ## NB: The first two are the same, having a length-3 R.E. with 3 x 3 vcov-matrix: ## --> do need CPU ## suppressWarnings() for warning about too-few random effects levels tmpf <- function(form) lmer(form, data = D , control=lmerControl(check.conv.singular="ignore", check.nobs.vs.nRE="ignore", calc.derivs=FALSE)) m0 <- tmpf(y ~ (x1 + x2)|ff) m1 <- tmpf(y ~ x1 + x2|ff) m2 <- tmpf(y ~ x1 + (x2|ff)) m3 <- tmpf(y ~ (x2|ff) + x1) suppressWarnings(stopifnot(all.equal(ranef(m0), ranef(m1), tolerance = 1e-5), all.equal(ranef(m2), ranef(m3), tolerance = 1e-5), inherits(tryCatch(lmer(y ~ x2|ff + x1, data = D), error = function(e)e), "error"))) showProc.time() # ## Reordering of grouping factors should not change the internal structure #Pm1 <- lmer1(strength ~ (1|batch) + (1|sample), Pastes, doFit = FALSE) #Pm2 <- lmer1(strength ~ (1|sample) + (1|batch), Pastes, doFit = FALSE) #P2.1 <- lmer (strength ~ (1|batch) + (1|sample), Pastes, devFunOnly = TRUE) #P2.2 <- lmer (strength ~ (1|sample) + (1|batch), Pastes, devFunOnly = TRUE) ## The environments of Pm1 and Pm2 should be identical except for ## "call" and "frame": #stopifnot(## all.EQ(env(Pm1), env(Pm2)), # all.EQ(S4_2list(P2.1), # S4_2list(P2.2))) ## example from Kevin Thorpe: synthesized equivalent ## http://thread.gmane.org/gmane.comp.lang.r.lme4.devel/9835 ## NA issue: simpler example d <- data.frame(y=1:60,f=factor(rep(1:6,each=10))) d$y[2] <- NA d$f[3:4] <- NA lmer(y~(1|f),data=d) glmer(y~(1|f),data=d,family=poisson) ## we originally thought that these examples should be ## estimating non-zero variances, but they shouldn't ... ## number of levels with each level of replication levs <- c(800,300,150,100,50,50,50,20,20,5,2,2,2,2) n <- seq_along(levs) flevels <- seq(sum(levs)) set.seed(101) fakedat <- data.frame(DA = factor(rep(flevels,rep(n,levs))), zbmi=rnorm(sum(n*levs))) ## add NA values fakedat[sample(nrow(fakedat),100),"zbmi"] <- NA fakedat[sample(nrow(fakedat),100),"DA"] <- NA m5 <- lmer(zbmi ~ (1|DA) , data = fakedat, control=lmerControl(check.nobs.vs.rankZ="ignore")) m6 <- update(m5, data=na.omit(fakedat)) stopifnot(VarCorr(m5)[["DA"]] == 0, VarCorr(m6)[["DA"]] == 0) showProc.time() lme4/tests/profile-tst.R0000644000176200001440000001441415225703727014666 0ustar liggesuserslibrary(lme4) library(testthat) library(lattice) testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 options(nwarnings = 5000)# instead of 50, and then use summary(warnings()) if (testLevel>1) { ### __ was ./profile_plots.R ___ fm1 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy) pfile <- system.file("testdata","tprfm1.RData", package="lme4") if(file.exists(pfile)) print(load(pfile)) else withAutoprint({ system.time( tpr.fm1 <- profile(fm1, optimizer="Nelder_Mead") ) ## 5 sec (2018); >= 50 warnings !? save(tpr.fm1, file= "../../inst/testdata/tprfm1.RData") }) oo <- options(warn = 2) # {warnings are errors from here on} if(!dev.interactive(orNone=TRUE)) pdf("profile_plots.pdf") xyplot(tpr.fm1) splom(tpr.fm1) densityplot(tpr.fm1, main="densityplot( profile(lmer(..)) )") ## various scale options xyplot(tpr.fm1,scale=list(x=list(relation="same"))) ## stupid xyplot(tpr.fm1,scale=list(y=list(relation="same"))) xyplot(tpr.fm1,scale=list(y=list(relation="same"),tck=0)) ## expect_error(xyplot(tpr.fm1,conf=50),"must be strictly between 0 and 1") ### end {profile_plots.R} fm01ML <- lmer(Yield ~ 1|Batch, Dyestuff, REML = FALSE) ## 0.8s (on a 5600 MIPS 64bit fast(year 2009) desktop "AMD Phenom(tm) II X4 925"): ## system.time( tpr <- profile(fm01ML) ) ## test all combinations of 'which', including plots (but don't show plots) wlist <- list(1:3,1:2,1,2:3,2,3,c(1,3)) invisible(lapply(wlist,function(w) xyplot(profile(fm01ML,which=w)))) (confint(tpr) -> CIpr) print(xyplot(tpr)) ## comparing against lme4a reference values -- but lme4 returns sigma ## rather than log(sigma) stopifnot(dim(CIpr) == c(3,2), all.equal(unname(CIpr[".sigma",]),exp(c(3.64362, 4.21446)), tolerance=1e-6), all.equal(unname(CIpr["(Intercept)",]),c(1486.451500,1568.548494))) options(oo)# warnings allowed .. ## fixed-effect profiling with vector RE data(Pastes) fmoB <- lmer(strength ~ 1 + (cask | batch), data=Pastes, control = lmerControl(optimizer = "bobyqa")) (pfmoB <- profile(fmoB, which = "beta_", alphamax=.001)) xyplot(pfmoB)# nice and easy .. summary( fm <- lmer(strength ~ 1 + (cask | batch), data=Pastes, control = lmerControl(optimizer = "nloptwrap", calc.derivs= FALSE)) ) ls.str(environment(nloptwrap))# showing *its* defaults pfm <- profile(fm, which = "beta_", alphamax=.001) # 197 warnings for "nloptwrap" summary(warnings()) str(pfm) # only 3 rows, .zeta = c(0, NaN, Inf) !!! try( xyplot(pfm) ) ## FIXME or rather the profiling or rather the "wrap on nloptr" (testLevel <- lme4:::testLevel()) if(testLevel > 2) { ## 2D profiles fm2ML <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin, REML=0) system.time(pr2 <- profile(fm2ML)) # 5.2 sec, 2018-05: 2.1" (confint(pr2) -> CIpr2) lme4a_CIpr2 <- structure(c(0.633565787613112, 1.09578224011285, -0.721864513060904, 21.2666273835452, 1.1821039843372, 3.55631937954106, -0.462903300019305, 24.6778176174587), dim = c(4L, 2L), dimnames = list(c(".sig01", ".sig02", ".lsig", "(Intercept)"), c("2.5 %", "97.5 %"))) lme4a_CIpr2[".lsig",] <- exp(lme4a_CIpr2[".lsig",]) stopifnot(all.equal(unname(CIpr2),unname(lme4a_CIpr2),tolerance=1e-6)) print(xyplot(pr2, absVal=0, aspect=1.3, layout=c(4,1))) print(splom(pr2)) gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## GLMM profiles system.time(pr4 <- profile(gm1)) ## ~ 10 seconds pr4.3 <- profile(gm1,which=3) xyplot(pr4,layout=c(5,1),as.table=TRUE) splom(pr4) ## used to fail because of NAs nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = c(Asym = 200, xmid = 725, scal = 350)) if (FALSE) { ## not working yet: detecting (slightly) lower deviance; not converging in 10k pr5 <- profile(nm1,which=1,verbose=1,maxmult=1.2) xyplot(.zeta~.focal|.par,type=c("l","p"),data=lme4:::as.data.frame.thpr(pr5), scale=list(x=list(relation="free")), as.table=TRUE) } } ## testLevel > 2 if (testLevel > 3) { fm3ML <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, REML=FALSE) ## ~ 4 theta-variables (+ 2 fixed), 19 seconds | 2018-05: 7.4" print(system.time(pr3 <- profile(fm3ML))) print(xyplot(pr3)) print(splom(pr3)) if (testLevel > 4) { if(requireNamespace("mlmRev")) { data("Contraception", package="mlmRev") ## fit already takes ~ 3 sec (2018-05) fm2 <- glmer(use ~ urban+age+livch + (urban|district), Contraception, binomial) print(system.time(pr5 <- profile(fm2,verbose=10))) # 2018-05: 462 sec = 7'42" ## -> 5 warnings notably "non-monotonic profile for .sig02" (the RE's corr.) print(xyplot(pr5)) } } ## testLevel > 4 } ## testLevel > 3 library("parallel") if (max(detectCores(), 1L, na.rm = TRUE) > 1) { p0 <- profile(fm1, which="theta_") ## http://stackoverflow.com/questions/12983137/how-do-detect-if-travis-ci-or-not travis <- nchar(Sys.getenv("TRAVIS")) > 0 if(.Platform$OS.type != "windows" && !travis) { prof01P <- profile(fm1, which="theta_", parallel="multicore", ncpus=2) stopifnot(all.equal(p0,prof01P)) } ## works in Solaris from an interactive console but not ??? ## via R CMD BATCH if (Sys.info()["sysname"] != "SunOS" && !travis) { prof01P.snow <- profile(fm1, which="theta_", parallel="snow", ncpus=2) stopifnot(all.equal(p0,prof01P.snow)) } if (require("future.apply", quietly = TRUE)) { plan(sequential) prof01P.future.seq <- profile(fm1, which = "theta_", parallel = "future") stopifnot(all.equal(p0, prof01P.future.seq)) plan(multisession) prof01P.future.multi <- profile(fm1, which = "theta_", parallel = "future") stopifnot(all.equal(p0, prof01P.future.multi)) plan(sequential) } } ## test profile/update from within functions foo <- function() { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) ## return profile(gm1, which="theta_") } stopifnot(inherits(foo(), "thpr")) } ## testLevel>1 lme4/tests/elston.R0000644000176200001440000000706315225703727013724 0ustar liggesusers## original code for reading/aggregating: ## tickdata <- read.table("Elston2001_tickdata.txt",header=TRUE, ## colClasses=c("factor","numeric","factor","numeric","factor","factor")) ## tickdata <- transform(tickdata,cHEIGHT=scale(HEIGHT,scale=FALSE)) ## for (i in names(tickdata)) { ## if (is.factor(tickdata[[i]])) { ## tickdata[[i]] <- factor(tickdata[[i]],levels=sort(as.numeric(levels(tickdata[[i]])))) ## } ## } ## summary(tickdata) ## grouseticks <- tickdata ## library(reshape) ## meantick <- rename(aggregate(TICKS~BROOD,data=tickdata,FUN=mean), ## c(TICKS="meanTICKS")) ## vartick <- rename(aggregate(TICKS~BROOD,data=tickdata,FUN=var), ## c(TICKS="varTICKS")) ## uniqtick <- unique(subset(tickdata,select=-c(INDEX,TICKS))) ## grouseticks_agg <- Reduce(merge,list(meantick,vartick,uniqtick)) ## save("grouseticks","grouseticks_agg",file="grouseticks.rda") if (.Platform$OS.type != "windows") { library(lme4) data(grouseticks) do.plots <- FALSE form <- TICKS~YEAR+HEIGHT+(1|BROOD)+(1|INDEX)+(1|LOCATION) ## fit with lme4 ## library(lme4) ## t1 <- system.time(full_mod1 <- glmer(form, family="poisson",data=grouseticks)) ## c1 <- c(fixef(full_mod1),unlist(VarCorr(full_mod1)), logLik=logLik(full_mod1),time=t1["elapsed"]) ## allcoefs1 <- c(unlist(full_mod1@ST),fixef(full_mod1)) ## detach("package:lme4") ## lme4 summary results: t1 <- structure(c(1.288, 0.048, 1.36, 0, 0), class = "proc_time", names = c("user.self", "sys.self", "elapsed", "user.child", "sys.child")) c1 <- structure(c(11.3559080756861, 1.1804105508475, -0.978704335712111, -0.0237607330254979, 0.293232458048324, 0.562551624933584, 0.279548178949372, -424.771990224991, 1.36), names = c("(Intercept)", "YEAR96", "YEAR97", "HEIGHT", "INDEX", "BROOD", "LOCATION", "logLik", "time.elapsed" )) allcoefs1 <- structure(c(0.541509425632023, 0.750034415832756, 0.528723159081737, 11.3559080756861, 1.1804105508475, -0.978704335712111, -0.0237607330254979 ), names = c("", "", "", "(Intercept)", "YEAR96", "YEAR97", "HEIGHT")) pars <- function(x) unlist(getME(x,c("theta","beta"))) if (lme4:::testLevel() > 1) { t2 <- system.time(full_mod2 <- glmer(form, family="poisson",data=grouseticks)) ##>> 2 x checkConv(.. "derivs") warning: 1. failed to conv. 2. nearly unidentifiable c2 <- c(fixef(full_mod2), unlist(VarCorr(full_mod2)), logLik = logLik(full_mod2), time= t2["elapsed"]) ## refit ## FIXME: eventually would like to get _exactly_ identical answers on refit() full_mod3 <- refit(full_mod2, grouseticks$TICKS) print( all.equal(pars(full_mod2), pars(full_mod3), tolerance=0))# -> 1.2e-5 stopifnot(all.equal(pars(full_mod2), pars(full_mod3), tolerance=8e-5)) } ## deviance function ## FIXME: does compDev do _anything_ any more? mm <- glmer(form, family="poisson", data=grouseticks, devFunOnly=TRUE) mm2 <- glmer(form, family="poisson", data=grouseticks, devFunOnly=TRUE,control=glmerControl(compDev=TRUE)) stopifnot(all.equal(1780.5427072, mm(allcoefs1), tol = 1e-7)) } ## skip on windows (for speed) lme4/tests/priorWeightsModComp.R0000644000176200001440000000703515036542626016363 0ustar liggesuserslibrary(lme4) n <- nrow(sleepstudy) op <- options(warn = 1, # show as they happen ("false" convergence warnings) useFancyQuotes = FALSE) if (.Platform$OS.type != "windows") { ##' remove all attributes but names dropA <- function(x) `attributes<-`(x, list(names = names(x))) ##' transform result of "numeric" all.equal.list() to a named vector all.eqL <- function(x1, x2, ...) { r <- sub("^Component ", '', all.equal(x1, x2, tolerance = 0, ...)) r <- strsplit(sub(": Mean relative difference:", "&&", r), split="&&", fixed=TRUE) setNames(as.numeric(vapply(r, `[`, "1.234", 2L)), ## drop surrounding "..." nm = sub('"$', '', substring(vapply(r, `[`, "nam", 1L), first=2))) } seedF <- function(s) { if(s %in% c(6, 39, 52, 57, 63, 74, 76, 86)) switch(as.character(s) , "52"=, "63"=, "74" = 2 , "6"=, "39" = 3 , "86" = 8 # needs 4 on Lnx-64b , "76" = 70 # needs 42 on Lnx-64b , "57" = 90 # needs 52 on Lnx-64b ) else if(s %in% c(1, 12, 15, 34, 36, 41, 42, 43, 49, 55, 59, 67, 80, 85)) ## seeds 41,59, .. 15 1.0 else ## seeds 22, 20, and better 0.25 } ## be fast, running only 10 seeds by default: sMax <- if(lme4:::testLevel() > 1) 99L else 9L mySeeds <- 0L:sMax lapply(setNames(,mySeeds), function(seed) { cat("\n------ random seed =", seed, "---------\n") set.seed(seed) v <- rpois(n,1) + 1 w <- 1/v cat("weights w:\n") fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, REML=FALSE, weights = w); cat("..2:\n") fm2 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy, REML=FALSE, weights = w) cat("weights w*10:\n") fm1.10 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, REML=FALSE, weights = w*10);cat("..2:\n") fm2.10 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy, REML=FALSE, weights = w*10) ## ano12... <- dropA(anova(fm1, fm2 )) ano12.10 <- dropA(anova(fm1.10, fm2.10)) print(aEQ <- all.eqL(ano12..., ano12.10)) # showing differences if(!exists("notChisq")) notChisq <<- local({ n <- names(ano12...) grep("Chisq", n, value=TRUE, fixed=TRUE, invert=TRUE) }) stopifnot( all.equal(ano12...$Chisq, ano12.10$Chisq, tol = 1e-6 * seedF(seed)) , all.equal(ano12...[notChisq], ano12.10[notChisq], tol= 1.5e-8 * seedF(seed)) ) aEQ }) -> rallEQ cat("=====================================\n") rallEQ <- t(simplify2array(rallEQ)) notChisq <- intersect(notChisq, colnames(rallEQ)) ## sort according to "severity": srallEQ <- rallEQ[with(as.data.frame(rallEQ), order(AIC, Chisq)), ] round(log10(srallEQ), 2) saveRDS(srallEQ, "priorWeightsMod_relerr.rds") if(!dev.interactive(orNone=TRUE)) pdf("priorWeightsMod_relerr.pdf") matplot(mySeeds, log10(srallEQ), type="l", xlab=NA) ; grid() legend("topleft", ncol=3, bty="n", paste(1:6, colnames(srallEQ), sep = ": "), col=1:6, lty=1:6) tolD <- sqrt(.Machine$double.eps) # sqrt(eps_C) abline(h = log10(tolD), col = "forest green", lty=3) axis(4, at=log10(tolD), label=quote(sqrt(epsilon[c])), las=1) LRG <- which(srallEQ[,"AIC"] > tolD) if (length(LRG)>0) { text(LRG, log10(srallEQ[LRG, "AIC"]), names(LRG), cex = .8) } ## how close are we .. str(tF <- sapply(mySeeds, seedF)) round(sort( rallEQ[, "Chisq"] / (tF * 1e-6 ), decreasing=TRUE), 1) round(sort(apply(rallEQ[,notChisq] / (tF * 1.5e-8), 1, max), decreasing=TRUE), 1) } ## skip on windows (for speed) options(op) lme4/tests/lme4_nlme.R0000644000176200001440000000302215036542626014262 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type != "windows") withAutoprint({ ## testing whether lme4 and nlme play nicely. Only known issue ## is lmList-masking ... library("lme4") library("nlme") fm1_lmer <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm1_lme <- lme (Reaction ~ Days, random = ~Days|Subject, sleepstudy) ## variance-covariance matrices: annoyingly different structures vc_lmer <- VarCorr(fm1_lmer) vc_lme <- VarCorr(fm1_lme, rdig = 8) suppressWarnings(storage.mode(vc_lme) <- "numeric")# 2 NAs vc_lmerx <- c(diag(vc_lmer[[1]]), attr(vc_lmer[[1]],"correlation")[1,2]) vc_lmex <- c( vc_lme[1:2,1], vc_lme[2,3]) stopifnot( all.equal(vc_lmex, vc_lmerx, tolerance= 4e-4) # had 3e-5, now see 0.000296 , ## fixed effects (much easier) : all.equal(fixef(fm1_lmer), fixef(fm1_lme)) # 3.6e-15 , all.equal(unname(unlist(unclass(ranef(fm1_lmer)))), unname(unlist(unclass(ranef(fm1_lme)))), tolerance = 2e-4) # had 2e-5, now see 8.41e-5 ) fm1L_lme <- nlme::lmList(distance ~ age | Subject, Orthodont) fm1L_lmer <- lme4::lmList(distance ~ age | Subject, Orthodont) stopifnot(all.equal(fixef(fm1L_lmer), fixef(fm1L_lme))) sm1L_e <- summary(fm1L_lme) sm1L_er <- summary(fm1L_lmer) stopifnot( all.equal(coef(sm1L_e), coef(sm1L_er), tol=1e-12)# even tol=0 works on some Lnx 64b ) ## FIXME: test opposite order }) lme4/tests/AAAtest-all.R0000644000176200001440000000154615036542626014447 0ustar liggesusersif (base::require("testthat", quietly = TRUE)) { pkg <- "lme4" require(pkg, character.only=TRUE, quietly=TRUE) if(getRversion() < "3.5.0") { withAutoprint <- identity ; prt <- print } else { prt <- identity } if(Sys.getenv("USER") %in% c("maechler", "bbolker")) withAutoprint({ ## for developers' sake: lP <- .libPaths() # ---- .libPaths() : ---- prt(lP) ## ---- Entries in .libPaths()[1] : ---- prt(list.files(lP[1], include.dirs=TRUE)) prt(sessionInfo()) prt(packageDescription("Matrix")) ## 'lme4' from packageDescription "file" : prt(attr(packageDescription("lme4"), "file")) }) test_check(pkg) ##======== ^^^ print(warnings()) # TODO? catch most of these by expect_warning(..) } else { cat( "package 'testthat' not available, cannot run unit tests\n" ) } lme4/tests/testthat/0000755000176200001440000000000015225715200014114 5ustar liggesuserslme4/tests/testthat/test-utils.R0000644000176200001440000000423015214006123016346 0ustar liggesusers## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } #context("Utilities (including *non*-exported ones)") test_that("namedList", { nList <- lme4:::namedList a <- b <- c <- 1 expect_identical(nList(a,b,c), list(a = 1, b = 1, c = 1)) expect_identical(nList(a,b,d=c),list(a = 1, b = 1, d = 1)) expect_identical(nList(a, d=pi, c), list(a = 1, d = pi, c = 1)) }) test_that("Var-Cov factor conversions", { ## from ../../R/vcconv.R mlist2vec <- lme4:::mlist2vec Cv_to_Vv <- lme4:::Cv_to_Vv Cv_to_Sv <- lme4:::Cv_to_Sv Sv_to_Cv <- lme4:::Sv_to_Cv Vv_to_Cv <- lme4:::Vv_to_Cv ## set.seed(1); cvec1 <- sample(10, 6) v1 <- Cv_to_Vv(cvec1) expect_equal(unname(v1), structure(c(9, 12, 15, 65, 34, 93), clen = 3)) expect_equal(2, as.vector(Vv_to_Cv(Cv_to_Vv(2)))) expect_equivalent(c(v1, 1), Cv_to_Vv(cvec1, s=3) / 3^2) expect_equal(as.vector(ss1 <- Sv_to_Cv(Cv_to_Sv(cvec1))), cvec1) expect_equal(as.vector(vv1 <- Vv_to_Cv(Cv_to_Vv(cvec1))), cvec1) ## for length-1 matrices, Cv_to_Sv should be equivalent ## to multiplying Cv by sigma and appending sigma .... clist2 <- list(matrix(1),matrix(2),matrix(3)) cvec2 <- mlist2vec(clist2) expect_equal(cvec2, structure(1:3, clen = rep(1,3)), tolerance=0) expect_true(all((cvec3 <- Cv_to_Sv(cvec2, s=2)) == c(cvec2*2,2))) n3 <- length(cvec3) expect_equivalent(Sv_to_Cv(cvec3, n=rep(1,3), s=2), cvec3[-n3]/cvec3[n3]) }) ## moved to lme4 test_that("getData", { ## test what happens when wrong version of 'data' is found in environment of formula ... f <- round(Reaction) ~ 1 + (1|Subject) g <- function() { data <- sleepstudy m1 <- glmer(f, data = data, family = poisson) } m1 <- g() expect_error(getData(m1), "is not a data frame or matrix.*masked by a built-in", perl = TRUE) p1 <- suppressMessages(predict(m1, newparams = list(beta = 5, theta = 1), type = "response", re.form = ~ 1|Subject)) expect_equal(unname(head(p1, 2)), c(444.407382298401, 444.407382298401)) }) lme4/tests/testthat/test-allFit.R0000644000176200001440000001604015221572572016441 0ustar liggesuserstestLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) had_pars <- exists("pars", envir = globalenv(), inherits = FALSE) had_ctrl <- exists("ctrl", envir = globalenv(), inherits = FALSE) gm_all <- allFit(fit_cbpp_1, verbose=FALSE) gm_all_nostart <- allFit(fit_cbpp_1, verbose=FALSE, start_from_mle = FALSE) test_that("pars and ctrl did not leak into the environment", { expect_equal(exists("pars", envir = globalenv(), inherits = FALSE), had_pars) expect_equal(exists("ctrl", envir = globalenv(), inherits = FALSE), had_ctrl) }) summary(gm_all)$times[,"elapsed"] summary(gm_all_nostart)$times[,"elapsed"] sapply(gm_all, function(x) x@optinfo$feval) sapply(gm_all_nostart, function(x) x@optinfo$feval) ## library(microbenchmark) ## mb1 <- microbenchmark( ## start = allFit(fit_cbpp_1, verbose=FALSE), ## nostart = allFit(fit_cbpp_1, verbose=FALSE, start_from_mle = FALSE) ## ) test_that("allFit print/summary is fine", { expect_is(gm_all, "allFit") expect_is(summary(gm_all), "summary.allFit") }) test_that("nloptwrap switches optimizer correctly", { expect_equal(attr(gm_all[["nloptwrap.NLOPT_LN_BOBYQA"]],"optCtrl"), list(maxeval = 1e5, algorithm = "NLOPT_LN_BOBYQA")) expect_equal(attr(gm_all[["nloptwrap.NLOPT_LN_NELDERMEAD"]],"optCtrl"), list(maxeval = 1e5, algorithm = "NLOPT_LN_NELDERMEAD")) }) test_that("lmerControl() arg works too", { fm0 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) fm <- update(fm0, control = lmerControl(optCtrl = list(xtol_rel = 1e-8, ftol_rel = 1e-8), calc.derivs=FALSE)) afm0 <- allFit(fm0,verbose=FALSE) afm <- allFit(fm,verbose=FALSE) # used to fail drop_ <- function(x) { x[setdiff(names(x), c("times","feval"))] } ## should be approximately the same expect_equal(drop_(summary(afm0)), drop_(summary(afm)), tolerance = 1e-2) ## should NOT be the same! expect_false(isTRUE(all.equal(drop_(summary(afm0)), drop_(summary(afm)), tolerance=1e-10))) }) test_that("glmerControl() arg + optimizer", { ## GH #523? fit_cbpp_1u <- update(fit_cbpp_1, control=glmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-10, ftol_abs=1e-10))) af2 <- allFit(fit_cbpp_1u, verbose=FALSE) expect_equal(class(af2),"allFit") }) test_that("control passed as a variable does not break allFit (GH #985)", { ## previously: getCall(object)$control was a bare symbol (not a ## call), so allFit() failed with ## "object of type 'symbol' is not subsettable" cc <- lmerControl(optimizer="bobyqa", optCtrl = list(maxfun = 1e5)) fm <- lmer(Reaction ~ Days + (1|Subject), control = cc, data = sleepstudy) aa <- expect_no_error(allFit(fm, verbose=FALSE)) expect_true(all(summary(aa)$which.OK)) }) test_that("allFit does not corrupt nmkbw's optCtrl (GH #985)", { ## previously: a stale 'maxfun' entry (valid for bobyqa but not ## for nmkbw) survived sanitize() alongside the correct ## 'maxfeval' entry, causing dfoptim::nmkb() to warn ## "number of items to replace is not a multiple of replacement length" gm <- glmer(round(Reaction) ~ Days + (1|Subject), control = glmerControl(optimizer="bobyqa", optCtrl = list(maxfun = 1e5)), data = sleepstudy, family = poisson) warnings_seen <- character(0) aa <- withCallingHandlers( allFit(gm, verbose=FALSE), warning = function(w) { warnings_seen <<- c(warnings_seen, conditionMessage(w)) invokeRestart("muffleWarning") } ) expect_true(all(summary(aa)$which.OK)) expect_false(any(grepl("number of items to replace", warnings_seen, fixed=TRUE))) }) test_that("i in model call is OK", { ## GH #538 ## ugh, testthat scoping is insane ... ## if d and i are ## assigned normally with <- outside expect_true(), test fails ## BUT global assignment of 'd' breaks downstream tests in ## 'data= argument and formula evaluation' (test-formulaEval.R) ## ddd breaks similar test in 'fitting lmer models' (test-lmer.R) ## (where 'd' is supposed to be nonexistent) ## if we do global assignment with <<- ## can't figure out how to remove d (or ddd) after it's created to leave ## the environment clean ... ## tried to encapsulate all the necessary assignments ## within expect_true({ ... }) but that fails in other ways nr <- nrow(sleepstudy) ..dd <<- list(sleepstudy[1:nr,], sleepstudy[-(1:nr)]) i <<- 1 fm0 <- lmer(Reaction ~ Days + (1 | Subject), data=..dd[[i]]) aa <- allFit(fm0, verbose=FALSE) expect_true( all(summary(aa)$which.OK) ) }) test_that("allFit/update scoping", { ## GH #601 fit_func <- function(dataset) { gm1 <- glmer( cbind(incidence, size - incidence) ~ period + (1 | herd), data = dataset, family = binomial ) gm1@call$data <- dataset allFit(gm1, catch.errs=FALSE) } cc <- capture.output(ff <- fit_func(cbpp)) expect_true(all(summary(ff)$which.OK)) }) test_that("maxfun works", { gm_it10 <- suppressWarnings(allFit(fit_cbpp_1, verbose=FALSE, maxfun = 10)) v <- vapply(gm_it10, function(x) as.integer(x@optinfo$feval), FUN.VALUE=1L) ## function values are sometimes off a bit (due to initialization or Hessian calculation) ## but close enough ... expect_true(all(is.na(v) | v < 12)) }) test_that("parallel = 'future' works", { if (require("future.apply", quietly = TRUE)) { plan(sequential) gm_all_future_seq <- allFit(fit_cbpp_1, verbose = FALSE, parallel = "future") expect_is(gm_all_future_seq, "allFit") expect_equal(names(gm_all_future_seq), names(gm_all)) plan(multisession) gm_all_future_multi <- allFit(fit_cbpp_1, verbose = FALSE, parallel = "future") expect_is(gm_all_future_multi, "allFit") ## Comparing results is tricky due to timing/environment differences ## but the set of optimizers that worked should be the same expect_equal(names(gm_all_future_multi), names(gm_all)) plan(sequential) } }) } ## testLevel lme4/tests/testthat/test-catch.R0000644000176200001440000000101315127735433016304 0ustar liggesusers#context("storing warnings, convergence status, etc.") test_that("storewarning", { gCtrl <- glmerControl(optimizer = "Nelder_Mead", optCtrl = list(maxfun=3)) expect_warning(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data=cbpp, family=binomial, control=gCtrl), "failure to converge in 3") expect_equal(gm1@optinfo$warnings[[1]],"failure to converge in 3 evaluations") ## FIXME: why is conv==0 here? }) lme4/tests/testthat/test-nlmer.R0000644000176200001440000000070315127735433016344 0ustar liggesuserstestLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 #context("lower/upper bounds on nlmer models") test_that("nlmer", { startvec <- c(Asym = 200, xmid = 725, scal = 350) nm1 <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = startvec, control=nlmerControl(optCtrl=list(lower=c(0,200,-Inf,-Inf)))) expect_equal(unname(fixef(nm1)[1]),200) }) lme4/tests/testthat/test-glmer.R0000644000176200001440000004462415135663430016343 0ustar liggesuserssource(system.file("testdata", "lme-tst-funs.R", package="lme4", mustWork=TRUE))# -> uc() [back-compatible c()] testLevel <- lme4:::testLevel() gives_error_or_warning <- function (regexp = NULL, all = FALSE, ...) { function(expr) { res <- try(evaluate_promise(expr),silent=TRUE) no_error <- !inherits(res, "try-error") if (no_error) { warnings <- res$warnings if (!is.null(regexp) && length(warnings) > 0) { return(matches(regexp, all = FALSE, ...)(warnings)) } else { return(expectation(length(warnings) > 0, "no warnings or errors given", paste0(length(warnings), " warnings created"))) } } if (!is.null(regexp)) { return(matches(regexp, ...)(res)) } else { expectation(TRUE, "no error thrown", "threw an error") } } } ## expect_that(stop("foo"),gives_error_or_warning("foo")) ## expect_that(warning("foo"),gives_error_or_warning("foo")) ## expect_that(TRUE,gives_error_or_warning("foo")) ## expect_that(stop("bar"),gives_error_or_warning("foo")) ## expect_that(warning("bar"),gives_error_or_warning("foo")) if(testLevel > 1) { #context("fitting glmer models") test_that("glmer", { set.seed(101) d <- data.frame(z=rbinom(200,size=1,prob=0.5), f=factor(sample(1:10,200,replace=TRUE))) ## Using 'method=*' defunct in 2019-05 (after 6 years of deprecation) ## expect_warning(glmer(z~ 1|f, d, family=binomial, method="abc"),"Use the nAGQ argument") ## expect_warning(glmer(z~ 1|f, d, family=binomial, method="Laplace"),"Use the nAGQ argument") ##sp expect_warning(glmer(z~ 1|f, d, sparseX=TRUE),"has no effect at present") expect_that(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial), is_a("glmerMod")) expect_that(gm1@resp, is_a("glmResp")) expect_that(gm1@pp, is_a("merPredD")) expect_equal(ge1 <- unname(fixef(gm1)), c(-1.39854982537216, -0.992335519118859, -1.12867532780426, -1.58030423764517), tolerance=5e-4) expect_equal(c(VarCorr(gm1)[[1]]), 0.41245527438386, tolerance=6e-4) ### expect_that(family(gm1), equals(binomial())) ### ?? binomial() has an 'initialize' component ... and the order is different expect_equal(deviance(gm1), 73.47428, tolerance=1e-5) ## was -2L = 184.05267459802 expect_equal(sigma(gm1), 1) expect_equal(extractAIC(gm1), c(5, 194.052674598026), tolerance=1e-5) expect_equal(theta <- unname(getME(gm1, "theta")), 0.642226809144453, tolerance=6e-4) expect_that(X <- getME(gm1, "X"), is_equivalent_to( model.matrix(model.frame(~ period, data=cbpp), cbpp))) expect_that(Zt <- getME(gm1, "Zt"), is_a("dgCMatrix")) expect_equal(dim(Zt), c(15L, 56L)) expect_equal(Zt@x, rep.int(1, 56L)) expect_that(Lambdat <- getME(gm1, "Lambdat"), is_a("dgCMatrix")) expect_equivalent(as(Lambdat, "matrix"), diag(theta, 15L, 15L)) expect_is(gm1_probit <- update(gm1,family=binomial(link="probit")),"merMod") expect_equal(family(gm1_probit)$link,"probit") ## FIXME: test user-specified/custom family? expect_error(glFormula(cbind(incidence, size - incidence) ~ period + (1 | herd), data = subset(cbpp, herd==levels(herd)[1]), family = binomial), "must have > 1") expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = subset(cbpp, herd %in% levels(herd)[1:4]), family = binomial, control=glmerControl(check.nlev.gtreq.5="warning")), "< 5 sampled levels") expect_warning(fm1. <- glmer(Reaction ~ Days + (Days|Subject), sleepstudy), regexp="calling .* with family=gaussian .* as a shortcut") options(warn=2) options(glmerControl=list(junk=1,check.conv.grad="ignore")) expect_warning(glmer(z~ 1|f, d, family=binomial), "some options") options(glmerControl=NULL) cbppX <- transform(cbpp,prop=incidence/size) expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, start=NULL), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, verbose=0L), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, subset=TRUE), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, na.action="na.exclude"), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, offset=rep(0,nrow(cbppX))), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, contrasts=NULL), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, devFunOnly=FALSE), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, control=glmerControl(optimizer="Nelder_Mead")), "glmerMod") expect_is(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, control=glmerControl()), "glmerMod") options(warn=0) expect_error(glmer(prop ~ period + (1 | herd), data = cbppX, family = binomial, weights=size, junkArg=TRUE), "unused argument") if(FALSE) { ## Hadley broke this expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=list()), "instead of passing a list of class") expect_warning(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=lmerControl()), "instead of passing a list of class") } ## load(system.file("testdata","radinger_dat.RData",package="lme4")) mod <- glmer(presabs~predictor+(1|species),family=binomial, radinger_dat) expect_is(mod,"merMod") ## tolerance: 32-bit Windows (CRAN) reported ave.diff of 5.33e-8 ## 64-bit Win-builder r73242 now reports ave. diff of 1.31e-5 ... expect_equal(unname(fixef(mod)), c(0.5425528,6.4289962), tolerance = 1e-4) set.seed(101) ## complete separation case d <- data.frame(y=rbinom(1000,size=1,p=0.5), x=runif(1000), f=factor(rep(1:20,each=50)), x2=rep(0:1,c(999,1))) expect_message(mod2 <- glmer(y~x+x2+(1|f),data=d,family=binomial, control=glmerControl(check.conv.hess="ignore", check.conv.grad="ignore")), "singular") expect_equal(unname(fixef(mod2))[1:2], c(-0.10036244,0.03548523), tolerance=1e-4) expect_true(unname(fixef(mod2)[3] < -10)) expect_message(mod3 <- update(mod2, family=binomial(link="probit")), "singular") # singular Hessian warning expect_equal(unname(fixef(mod3))[1:2], c(-0.062889, 0.022241), tolerance=1e-4) expect_true(fixef(mod3)[3] < -4) expect_message(mod4 <- update(mod2, family=binomial(link="cauchit"), control=glmerControl(check.conv.hess="ignore", check.conv.grad="ignore")))#--> singular Hessian warning ## on-the-fly creation of index variables if (FALSE) { ## FIXME: fails in testthat context -- 'd' is not found ## in the parent environment of glmer() -- but works fine ## otherwise ... set.seed(101) d <- data.frame(y1=rpois(100,1), x=rnorm(100), ID=1:100) fit1 <- glmer(y1 ~ x+(1|ID),data=d,family=poisson) fit2 <- update(fit1, .~ x+(1|rownames(d))) expect_equal(unname(unlist(VarCorr(fit1))), unname(unlist(VarCorr(fit2)))) } ## if(testLevel > 2) { load(system.file("testdata","mastitis.rda",package="lme4")) t1 <- system.time(g1 <- suppressWarnings(glmer(NCM ~ birth + calvingYear + (1|sire) + (1|herd), mastitis, poisson, ## current (2014-04-24) default: --> Warning control=glmerControl( # max|grad| = 0.021 .. optimizer=c("bobyqa","Nelder_Mead"))))) t2 <- system.time(g2 <- suppressWarnings(update(g1, control=glmerControl(optimizer="bobyqa")))) ## rbind(t1,t2)[,"elapsed"] ## 20 (then 13.0) seconds N-M vs 8 (then 4.8) seconds bobyqa ... ## print(t1[3] / t2[3]) # 0.37; => 1.25 should be on the safe side expect_lte(t2[3], 1.25 * t1[3]) ## problem is fairly ill-conditioned so parameters ## are relatively far apart even though likelihoods are OK expect_equal(logLik(g1),logLik(g2),tolerance=2e-7) } ## test bootstrap/refit with nAGQ>1 gm1AGQ <- update(gm1,nAGQ=2) s1 <- simulate(gm1AGQ) expect_equal(attr(bootMer(gm1AGQ,fixef),"bootFail"),0) ## do.call(new,...) bug new <- "foo" expect_that(gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial), is_a("glmerMod")) rm("new") ## test issue #47, from Wolfgang Viechtbauer ## create some data n <- 100 ai <- rep(0:1, each = n/2) bi <- 1-ai ci <- c(rep(0,42), rep(1,8), rep(0,18), rep(1,32)) di <- 1-ci event <- c(rbind(ai,ci)) group <- rep(c(1,0), times=n) id <- rep(1:n, each=2) gm3 <- glmer(event ~ group + (1 | id), family=binomial, nAGQ=21) sd3 <- sqrt(diag(vcov(gm3))) expect_equal(uc(`(Intercept)` = 0.42542855, group = 0.42492581), sd3, tolerance=1e-5) # 7e-9 {Lnx} ## unfortunately these answers aren't reliably "wrong" any more (2024-07-02 Pop!OS Linux) expect_warning(vcov(gm3, use.hessian=FALSE), "finite-difference Hessian") expect_equal(suppressWarnings(sqrt(diag(vcov(gm3,use.hessian=FALSE)))), uc(`(Intercept)` = 0.3840921, group = 0.3768747), tolerance=1e-7) # 6.5e-8 expect_equal(sd3, unn(coef(summary(gm3))[,"Std. Error"])) ## test non-pos-def finite-difference Hessian ... if(getRversion() > "3.0.0") { ## saved fits are not safe with old R versions L <- load(system.file("testdata","polytomous_vcov_ex.RData", package="lme4", mustWork=TRUE)) expect_warning(vcov(polytomous_vcov_ex),"falling back to var-cov") } ## damage Hessian to make it singular ## (example thanks to J. Dushoff) gm1H <- gm1 gm1H@optinfo$derivs$Hessian[5,] <- 0 expect_warning(vcov(gm1H),"falling back to var-cov") ## test convergence warnings L <- load(system.file("testdata","gopherdat2.RData", package="lme4", mustWork=TRUE)) g0 <- glmer(shells~prev + (1|Site)+offset(log(Area)), family=poisson, data=Gdat) ## fit year as factor: OK gc <- glmerControl(check.conv.grad="stop") expect_is(update(g0,.~.+factor(year), control=gc), "glmerMod") ## error/warning with year as numeric: ## don't have full knowledge of which platforms lead to which ## results, and can't detect whether we're running on valgrind, ## which changes the result on 32-bit linux ... ## SEGFAULT on MacOS? why? if (FALSE) { expect_that(update(g0,.~.+year), gives_error_or_warning("(failed to converge|pwrssUpdate did not converge)")) } ## ("(failed to converge|pwrssUpdate did not converge in)")) ## if (sessionInfo()$platform=="i686-pc-linux-gnu (32-bit)") { ## expect_warning(update(g0, .~. +year), "failed to converge") ## } else { ## ## MacOS x86_64-apple-darwin10.8.0 (64-bit) ## ## MM's platform ## ## "pwrssUpdate did not converge in (maxit) iterations" ## expect_error(update(g0, .~. +year), "pwrssUpdate did not converge in") ## } ## OK if we scale & center it expect_is(update(g0,.~. + scale(year), control=gc), "glmerMod") ## not OK if we scale and don't center expect_warning(update(g0,.~. + scale(year,center=FALSE)), "failed to converge with max|grad|") ## OK if center and don't scale expect_is(update(g0,.~. + scale(year,center=TRUE,scale=FALSE), control=gc), "glmerMod") ## try higher-order AGQ expect_is (update(gm1,nAGQ=90), "glmerMod") expect_error(update(gm1,nAGQ=101),"nAGQ <= 100") ## non-numeric response variables ss <- transform(sleepstudy, Reaction = as.character(Reaction)) expect_error(glmer(Reaction~(1|Days), family="poisson", data=ss), "response must be numeric") expect_error(glmer(Reaction~(1|Days), family="binomial", data=ss), "response must be numeric or factor") ss2 <- transform(ss,rr=rep(c(TRUE,FALSE),length.out=nrow(ss))) ## should work OK with logical too expect_is(glmer(rr~(1|Days),family="binomial",data=ss2),"merMod") ## starting values with log(.) link -- thanks to Eric Weese @ Yale: grp <- rep(letters[1:5], 20); set.seed(1); x <- rnorm(100) expect_error(glmer(x ~ 1 + (1|grp), family=gaussian(link="log")), "valid starting values") ## related to GH 231 ## fails on some platforms, skip for now if (FALSE) { rr <- gm1@resp$copy() ff <- setdiff(ls(gm1@resp),c("copy","initialize","initialize#lmResp","ptr", "updateMu","updateWts","resDev","setOffset","wrss")) for (i in ff) { expect_equal(gm1@resp[[i]],rr[[i]]) } } ## bad start case load(system.file("testdata","fakesim.RData",package="lme4")) rfit <- glmer(Inew/S ~ R0-1 + offset(log(I/N)) + (1|R0:trial) , family=binomial(link="cloglog") , data=dat , weight=S , control=glmerControl(optimizer="bobyqa", nAGQ0initStep=FALSE) , start = list(fixef=c(0,0,0),theta=1)) expect_equal(exp(fixef(rfit)), c(R01 = 1.2735051, R02 = 2.0330635, R03 = 2.9764088), tolerance=1e-5) ## gaussian with log link and zero values in response ... ## fixed simulation code, passing mustart properly dd <- expand.grid(x = seq(-2,3,length.out=10), f = factor(1:10)) dd$y <- simulate(~x+(1|f), family=gaussian(link="log"), newdata=dd, newparams=list(beta=c(0,1),theta=1,sigma=1), seed=101)[[1]] dd$y <- pmax(dd$y,0) expect_error(glmer (y ~ x + (1|f), family = gaussian(link="log"), data=dd),"cannot find valid starting values") g1 <- glmer (y ~ x + (1|f), family = gaussian(link="log"), data=dd, mustart=pmax(dd$y,0.1)) msum <- c(fixef(g1),unlist(c(VarCorr(g1))),c(logLik(g1))) expect_equal(msum, c(`(Intercept)` = 0.23389405, x = 1.0017436, f = 0.3187655, -156.7773), tolerance=1e-5) ## GH 415 expect_warning(glmer (round(Reaction) ~ Days + (1|Subject), data=sleepstudy[1:100,], family=poisson, control=lmerControl()), "please use glmerControl") }) } ## testlevel>1 test_that("glmer with etastart", { ## make sure etastart is passed through ## (fixed in commit b6fb1ac83885ff06 but never tested?) m1 <- glmer(incidence/size ~ period + (1|herd), weights = size, family = binomial, data = cbpp) m1E <- update(m1, etastart = rep(1, nrow(cbpp))) expect_true(!identical(fixef(m1), fixef(m1E))) }) test_that("turn off conv checking for nobs > check.conv.nobsmax", { ## calc derivs and check convergence gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) nn <- nrow(cbpp)-1 ## neither derivs nor conv check gm2 <- update(gm1, control = glmerControl(check.conv.nobsmax = nn)) ## no conv check, do calc derivs gm3 <- update(gm1, control = glmerControl(check.conv.nobsmax = nn, calc.derivs = TRUE)) expect_null(gm2@optinfo$derivs) expect_false(is.null(gm1@optinfo$derivs)) expect_false(is.null(gm3@optinfo$derivs)) expect_equal(gm1@optinfo$conv$lme4, list()) expect_null(gm2@optinfo$conv$lme4) expect_null(gm3@optinfo$conv$lme4) }) test_that("turn off conv checking for npara > check.conv.nparmax", { ## Code suggestion from Claude ai: ## https://claude.ai/share/06aa5947-f447-4e08-b65b-92f36c4b19a9 set.seed(1) n_groups <- 50 n_per_group <- 20 n <- n_groups * n_per_group dat <- data.frame( group = rep(1:n_groups, each = n_per_group), x1 = rnorm(n), x2 = rnorm(n) ) set.seed(101) form <- y ~ 1 + x1 * x2 + (1|group) dat$y <- simulate(form[-2], ## one-sided formula newdata = dat, family = binomial, newparams = list(beta = c(-3, 2.5, 3, 1.5), theta = 2.5))[[1]] # note: maxfun had to be artificially low for convergence warnings... mod1 <- suppressWarnings( glmer(form, data = dat, family = binomial, control = glmerControl(optCtrl = list(maxfun = 100))) ) mod2 <- suppressWarnings( update(mod1, control = glmerControl(optCtrl = list(maxfun = 100), check.conv.nparmax = 2)) ) ## First should give a warning expect_false(is.null(mod1@optinfo$conv$lme4)) ## Second shouldn't be evaluated expect_null(mod2@optinfo$conv$lme4) }) lme4/tests/testthat/test-lmerResp.R0000644000176200001440000000431515127735433017023 0ustar liggesusers data(Dyestuff, package="lme4") n <- nrow(Dyestuff) ones <- rep.int(1, n) zeros <- rep.int(0, n) YY <- Dyestuff$Yield mYY <- mean(YY) #context("lmerResp objects") test_that("lmerResp", { mres <- YY - mYY rr <- lmerResp$new(y=YY) expect_that(rr$weights, equals(ones)) expect_that(rr$sqrtrwt, equals(ones)) expect_that(rr$sqrtXwt, equals(ones)) expect_that(rr$offset, equals(zeros)) expect_that(rr$mu, equals(zeros)) expect_that(rr$wtres, equals(YY)) expect_that(rr$wrss(), equals(sum(YY^2))) expect_that(rr$updateMu(rep.int(mYY, n)), equals(sum(mres^2))) expect_that(rr$REML, equals(0L)) rr$REML <- 1L expect_that(rr$REML, equals(1L)) }) mlYY <- mean(log(YY)) gmeanYY <- exp(mlYY) # geometric mean #context("glmResp objects") test_that("glmResp", { mres <- YY - gmeanYY gmean <- rep.int(gmeanYY, n) rr <- glmResp$new(family=poisson(), y=YY) expect_that(rr$weights, equals(ones)) expect_that(rr$sqrtrwt, equals(ones)) expect_that(rr$sqrtXwt, equals(ones)) expect_that(rr$offset, equals(zeros)) expect_that(rr$mu, equals(zeros)) expect_that(rr$wtres, equals(YY)) expect_that(rr$n, equals(ones)) ## wrss() causes an update of mu which becomes ones, wtres also changes expect_that(rr$wrss(), equals(sum((YY-1)^2))) expect_that(rr$mu, equals(ones)) expect_that(rr$wtres, equals(YY-ones)) expect_that(rr$updateMu(rep.int(mlYY, n)), equals(sum(mres^2))) expect_that(rr$mu, equals(gmean)) expect_that(rr$muEta(), equals(gmean)) expect_that(rr$variance(), equals(gmean)) rr$updateWts() expect_that(1/sqrt(rr$variance()), equals(rr$sqrtrwt)) expect_that(as.vector(rr$sqrtXwt), equals(rr$sqrtrwt * rr$muEta())) }) lme4/tests/testthat/test-stepHalving.R0000644000176200001440000000055015127735433017513 0ustar liggesusersload(system.file("testdata","survdat_reduced.Rda",package="lme4")) test_that('Step-halving works properly', { # this example is known to require step-halving (or at least has in the past # required step-halving) form <- survprop~(1|nobs) m <- glmer(form,weights=eggs,data=survdat_reduced,family=binomial,nAGQ=1L) expect_that(m, is_a("glmerMod")) }) lme4/tests/testthat/_problems/0000755000176200001440000000000015222552575016111 5ustar liggesuserslme4/tests/testthat/_problems/test-predict-679.R0000644000176200001440000005163415222552575021177 0ustar liggesusers# Extracted from test-predict.R:679 # setup ------------------------------------------------------------------------ library(testthat) test_env <- simulate_test_env(package = "lme4", path = "..") attach(test_env, warn.conflicts = FALSE) # prequel ---------------------------------------------------------------------- library("lattice") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } do.plots <- TRUE L <- load(system.file("testdata/lme-tst-fits.rda", package="lme4", mustWork=TRUE)) if (getRversion() > "3.0.0") { ## saved fits are not safe with old R versions gm1 <- fit_cbpp_1 fm1 <- fit_sleepstudy_1 fm2 <- fit_sleepstudy_2 fm3 <- fit_penicillin_1 fm4 <- fit_cake_1 } else { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) fm1 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy) fm2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm3 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) fm4 <- lmer(angle ~ temp + recipe + (1 | replicate), data=cake) } if (testLevel>1) { #context("predict") test_that("fitted values", { p0 <- predict(gm1) p0B <- predict(gm1, newdata=cbpp) expect_equal(p0, p0B, tolerance=2e-5) ## ? not sure why high tolerance necessary ? works OK on Linux/R 3.5.0 ## fitted values, unconditional (level-0) p1 <- predict(gm1, re.form=NA) expect_true(length(unique(p1))==length(unique(cbpp$period))) ## fitted values, random-only p1R <- predict(gm1, random.only=TRUE) expect_equal(p1+p1R,p0) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") ## neither fixed nor random -- all zero expect_equal(unique(predict(gm1,re.form=NA,random.only=TRUE)),0) }) test_that("predict with newdata", { newdata <- with(cbpp, expand.grid(period=unique(period),herd=unique(herd))) ## new data, all RE p2 <- predict(gm1,newdata) ## new data, level-0 p3 <- predict(gm1,newdata, re.form=NA) p3R <- predict(gm1,newdata, random.only=TRUE) expect_equal(p3+p3R,p2) if (do.plots) matplot(cbind(p2,p3),col=1:2,type="b") }) test_that("predict on response scale", { p0 <- predict(gm1) p5 <- predict(gm1,type="response") expect_equal(p5, plogis(p0)) }) test_that("predict with newdata and RE", { newdata <- with(cbpp,expand.grid(period=unique(period),herd=unique(herd))) ## explicitly specify RE p2 <- predict(gm1,newdata) p4 <- predict(gm1,newdata, re.form=~(1|herd)) expect_equal(p2, p4) }) test_that("effects of new RE levels", { newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) newdata2 <- rbind(newdata, data.frame(period=as.character(1:4), herd=rep("new",4))) expect_error(predict(gm1, newdata2), "new levels detected in newdata: new") newdata3 <- rbind(newdata, data.frame(period=as.character(1), herd = paste0("new", 1:50))) expect_error(predict(gm1, newdata3), "new levels detected in newdata: new1, new2,") p2 <- predict(gm1, newdata) p6 <- predict(gm1, newdata2, allow.new.levels=TRUE) expect_equal(p2, p6[1:length(p2)]) ## original values should match ## last 4 values should match unconditional values expect_true(all(tail(p6,4) == predict(gm1, newdata=data.frame(period=factor(1:4)), re.form=NA))) }) test_that("multi-group model", { ## fitted values p0 <- predict(fm3) expect_equal(head(round(p0,4)), c(`1` = 25.9638, `2` = 22.7663, `3` = 25.7147, `4` = 23.6799, `5` = 23.7629, `6` = 20.773)) ## fitted values, unconditional (level-0) p1 <- predict(fm3, re.form=NA) expect_equal(unique(p1),22.9722222222251) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") }) test_that("multi-group model with new data", { newdata <- with(Penicillin,expand.grid(plate=unique(plate),sample=unique(sample))) ## new data, all RE p2 <- predict(fm3, newdata) ## new data, level-0 p3 <- predict(fm3, newdata, re.form=NA) ## explicitly specify RE p4 <- predict(fm3, newdata, re.form= ~(1|plate)+(~1|sample)) p4B <- predict(fm3, newdata, re.form= ~(1|sample)+(~1|plate)) ## **** expect_equal(p2,p4) expect_equal(p4,p4B) p5 <- predict(fm3,newdata, re.form=~(1|sample)) p6 <- predict(fm3,newdata, re.form=~(1|plate)) if (do.plots) matplot(cbind(p2,p3,p5,p6),type="b",lty=1,pch=16) }) test_that("random-slopes model", { p0 <- predict(fm2) p1 <- predict(fm2, re.form=NA) ## linear model, so results should be identical patterns but smaller -- ## not including intermediate days newdata <- with(sleepstudy,expand.grid(Days=range(Days),Subject=unique(Subject))) newdata$p2 <- predict(fm2,newdata) newdata$p3 <- predict(fm2,newdata, re.form=NA) newdata$p4 <- predict(fm2,newdata, re.form=~(0+Days|Subject)) newdata$p5 <- predict(fm2,newdata, re.form=~(1|Subject)) ## reference values from an apparently-working run refval <- structure( list(Days = c(0, 9, 0, 9, 0, 9), Subject = structure(c(1L, 1L, 2L, 2L, 3L, 3L), .Label = c("308", "309", "310", "330", "331", "332", "333", "334", "335", "337", "349", "350", "351", "352", "369", "370", "371", "372"), class = "factor"), p2 = c(253.663652396798, 430.66001930835, 211.006415533628, 227.634788908917, 212.444742696829, 257.61053840953), p3 = c(251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848), p4 = c(251.405104848485, 428.401471760037, 251.405104848485, 268.033478223774, 251.405104848485, 296.570900561186), p5 = c(253.663652396798, 347.869226033161, 211.006415533628, 305.211989169991, 212.444742696829, 306.650316333193)), out.attrs = list(dim = c(Days = 2L, Subject = 18L), dimnames = list( Days = c("Days=0", "Days=9"), Subject = c("Subject=308", "Subject=309", "Subject=310", "Subject=330", "Subject=331", "Subject=332", "Subject=333", "Subject=334", "Subject=335", "Subject=337", "Subject=349", "Subject=350", "Subject=351", "Subject=352", "Subject=369", "Subject=370", "Subject=371", "Subject=372")) ), row.names = c(NA, 6L), class = "data.frame") expect_equal(head(newdata), refval, tol=5e-7) }) test_that("predict and plot random slopes", { tmpf <- function(data,...) { data$Reaction <- predict(fm2,data,...) if (do.plots) xyplot(Reaction~Days,group=Subject,data=data,type="l") return(unname(head(round(data$Reaction,3)))) } expect_equal(tmpf(sleepstudy),c(253.664, 273.33, 292.996, 312.662, 332.329, 351.995)) expect_equal(tmpf(sleepstudy, re.form=NA), c(251.405, 261.872, 272.34, 282.807, 293.274, 303.742)) expect_equal(tmpf(sleepstudy, re.form= ~(0+Days|Subject)), c(251.405, 271.071, 290.738, 310.404, 330.07, 349.736)) expect_equal(tmpf(sleepstudy, re.form= ~(1|Subject)), c(253.664, 264.131, 274.598, 285.066, 295.533, 306)) }) test_that("fewer random effect levels than original", { ## from 'Colonel Triq' summary(fm4) ## replicate 1 only appears in rows 1:18. ## rownames(cake[cake$replicate==1,]) predict(fm4, newdata=cake[-1:-17,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=NA) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate), allow.new.levels=TRUE) ## p0 <- predict(fm1,newdata=data.frame(Days=6,Subject=c("308","309"))) p1 <- predict(fm1,newdata=data.frame(Days=rep(6,4), Subject=c("308","309"))) expect_equal(rep(unname(p0),2),unname(p1)) p2 <- predict(fm1,newdata=data.frame(Days=6,Subject="308")) nd <- data.frame(Days=6, Subject=factor("308",levels=levels(sleepstudy$Subject))) p3 <- predict(fm1,newdata=nd) expect_equal(p2,p3) expect_equal(p2,p0[1]) }) test_that("only drop columns when using new data", { ## Stack Overflow 34221564: ## should only drop columns from model matrix when using *new* data ## NB: Fit depends on optimizer somewhat: "nloptwrap" is really better than "bobyqa" library(splines) sleep <- sleepstudy #get the sleep data set.seed(1234567) sleep$age <- as.factor(sample(1:3,length(sleep),rep=TRUE)) form1 <- Reaction ~ Days + ns(Days, df=4) + age + Days:age + (Days | Subject) m4 <- lmer(form1, sleep) # fixed-effect model matrix is rank deficient so dropping 1 column / coefficient expect_lte(REMLcrit(m4), 1713.171) # FIXME !? why this regression?? had 1700.6431; "bobyqa" gave 1713.171 expect_equal(unname(head(predict(m4, re.form=NA))), c(255.203, 259.688, 265.71, 282.583, 294.784, 304.933), tolerance = 0.008) }) test_that("only look for columns that exist in re.form", { ## GH 457 set.seed(101) n <- 200 dd <- data.frame(x=1:n, f=factor(rep(1:10,n/10)), g=factor(rep(1:20,each=n/20)), h=factor(rep(1:5,n/5)), y=rnorm(n)) m1 <- lmer(y~1 + f + (1|h/f) + (poly(x,2)|g), data=dd, control=lmerControl(calc.derivs=FALSE)) expect_equal(unname(predict(m1,re.form= ~1 | h/f, newdata=dd[1,])), 0.14786, tolerance=1e-4) expect_equal(unname(predict(m1,re.form= ~poly(x,2) | g, newdata=dd[1,])), 0.1533, tolerance=.001) ## *last* RE not included (off-by-one error) m1B <- lmer(y~1 + f + (1|g) + (1|h), data=dd, control=lmerControl(calc.derivs=FALSE, check.conv.singular = "ignore")) expect_equal(unname(predict(m1B,re.form=~(1|g),newdata=data.frame(f="1",g="2"))),0.1512895,tolerance=1e-5) set.seed(101) n <- 100 xx <- c("r1", "r2", "r3", "r4", "r5") xxx <- c("e1", "e2", "e3") p <- 0.3 School <- factor(sample(xxx, n, replace=TRUE), levels=xxx, ordered=FALSE) Rank <- factor(sample(xx, n, replace=TRUE), levels=xx, ordered=FALSE) df1 <- data.frame( ID = as.integer(runif(n, min = 1, max = n/7)), xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School, Rank, yx = as.factor(rbinom(n, size = 1, prob = p)) ) df1 <- df1[order(df1$ID, decreasing=FALSE),] mm2 <- glmer(yx ~ xx1 + xx2 + xx3 + Rank + (1 | ID) + (1 | School / Rank), data = df1, family = "binomial",control = glmerControl(calc.derivs =FALSE)) n11 <- data.frame(School= factor("e1", levels = levels(df1$School),ordered=FALSE), Rank = factor("r1", levels = levels(df1$Rank), ordered=FALSE), xx1=8.58, xx2=8.75, xx3=7.92) expect_equal(unname(predict(mm2, n11, type="response",re.form= ~(1 | School / Rank))), 0.1174628,tolerance=1e-5) ## bad factor levels mm3 <- update(mm2, . ~ . - (1|ID)) n12 = data.frame(School="e3",Rank="r2",xx1=8.58,xx2=8.75,xx3=7.92) expect_equal(unname(predict(mm3, n12, type="response")),0.1832894,tolerance=1e-5) ## GH #452 ## FIXME: would like to find a smaller/faster example that would test the same warning (10+ seconds) set.seed(101) n <- 300 df2 <- data.frame( xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School = factor(sample(xxx, n,replace=TRUE)), Rank = factor(sample(xx, n, replace=TRUE)), yx = as.factor(rbinom(n, size = 1, prob = p)) ) mm4 <- suppressWarnings(glmer(yx ~ xx1 + xx2 + xx3 + Rank + (Rank|School), data = df2, family = "binomial",control = glmerControl(calc.derivs =FALSE))) ## set tolerance to 0.1 (!) to pass win-builder on R-devel/i386 (only: ## tolerance = 3e-5 is OK for other combinations of (R-release, R-devel) x (i386,x64) expect_equal(unname(predict(mm4, n11, type="response")), 0.2675081, tolerance=0.1) }) test_that("simulation works with non-factor", { set.seed(12345) dd <- data.frame(a=gl(10,100), b = rnorm(1000)) test2 <- suppressMessages(simulate(~1+(b|a), newdata=dd, family=poisson, newparams= list(beta = c("(Intercept)" = 1), theta = c(1,1,1)))) expect_is(test2,"data.frame") }) set.seed(666) n <- 500 df <- data.frame(y=statmod::rinvgauss(n, mean=1, shape=2), id=factor(1:20)) model_fit <- glmer(y ~ 1 + (1|id), family = inverse.gaussian(link = "inverse"), data = df, control=glmerControl(check.conv.singular="ignore")) test_that("simulation works for inverse gaussian", { expect_equal(mean(simulate(model_fit)[[1]]), 1.02704392575914, tolerance=1e-5) }) test_that("simulation complains appropriately about bad family", { ig <- inverse.gaussian() ig$family <- "junk" model_fit2 <- glmer(y ~ 1 + (1|id), family = ig, data = df, control=glmerControl(check.conv.singular="ignore")) expect_error(simulate(model_fit2),"simulation not implemented for family") }) test_that("prediction from large factors", { set.seed(101) N <- 50000 X <- data.frame(y=rpois(N, 5), obs=as.factor(1:N)) fm <- glmer(y ~ (1|obs), family="poisson", data=X, control=glmerControl(check.conv.singular="ignore")) ## FIXME: weak tests. The main issue here is that these should ## be reasonably speedy and non-memory-hogging, but those are ## hard to test portably ... expect_is(predict(fm, re.form=~(1|obs)), "numeric") expect_is(predict(fm, newdata=X), "numeric") }) test_that("prediction with gamm4", { if (suppressWarnings(requireNamespace("gamm4"))) { ## loading gamm4 warngs "replacing previous import 'Matrix::update' by 'lme4::update' when loading 'gamm4'" ## from ?gamm4 set.seed(0) ## simulate 4 term additive truth dat <- mgcv::gamSim(1,n=400,scale=2,verbose=FALSE) ## Now add 20 level random effect `fac'... dat$fac <- fac <- as.factor(sample(1:20,400,replace=TRUE)) dat$y <- dat$y + model.matrix(~fac-1)%*%rnorm(20)*.5 br <- gamm4::gamm4(y~s(x0)+x1+s(x2),data=dat,random=~(1|fac)) expect_warning(ss <- simulate(br$mer), "modified RE names") expect_equal(dim(ss), c(400,1)) } }) test_that("prediction with spaces in variable names", { cbpp$`silly period` <- cbpp$period m <- glmer(cbind(incidence,size-incidence) ~ `silly period` + (1|herd), family=binomial, data=cbpp) expect_equal(round(head(predict(m)),3), c(`1` = -0.809, `2` = -1.801, `3` = -1.937, `4` = -2.388, `5` = -1.697, `6` = -2.689)) }) if (requireNamespace("statmod")) { test_that("simulate with rinvgauss", { dd <- data.frame(f=factor(rep(1:20,each=10))) dd$y <- simulate(~1+(1|f), seed=101, family=inverse.gaussian, newdata=dd, ## ?? gives NaN (sqrt(eta)) for low beta ? newparams=list(beta=5,theta=1,sigma=1))[[1]] suppressMessages(m <- glmer(y~1+(1|f), family=inverse.gaussian, data=dd)) set.seed(101) expect_equal(head(unlist(simulate(m))), c(sim_11 = 0.451329390087728, sim_12 = 0.629516371309772, sim_13 = 0.481236633500098, sim_14 = 0.170060386109077, sim_15 = 0.258742371516342, sim_16 = 0.949617440586848)) }) } ## GH 631 test_that("sparse contrasts don't mess up predict()", { dd <- expand.grid(f = factor(1:101), rep1 = factor(1:2), rep2 = 1:2) dd$y <- suppressMessages(simulate(~1 + (rep1|f), seed = 101, newdata = dd, newparams = list(beta = 1, theta = rep(1,3), sigma = 1), family = gaussian)[[1]]) m1 <- lmer( y ~ 1 + (1|f), data = dd) p1 <- predict(m1) p2 <- predict(m1, newdata = dd) expect_identical(p1, p2) }) } # test ------------------------------------------------------------------------- set.seed(123) dat <- data.frame( outcome = rbinom(n = 100, size = 1, prob = 0.35), var_binom = as.factor(rbinom(n = 100, size = 1, prob = 0.7)), var_cont = rnorm(n = 100, mean = 10, sd = 7), grp = as.factor(sample(letters[1:4], size = 100, replace = TRUE)) ) m1 <- lme4::glmer( outcome ~ var_binom + var_cont + (1 | grp), data = dat, family = binomial(link = "logit") ) d <- data.frame(var_binom = factor(0:1), var_cont = c(9.24717241397544, 9.24717241397544), grp = factor(c("a","b"), levels = letters[1:4])) pp <- suppressWarnings(predict(m1, newdata = d, se.fit = TRUE)) expect_equal(pp, list(fit = c(`1` = -0.4338277, `2` = -0.5993396), se.fit = c(`1` = 0.4255397, `2` = 0.2779372)), tol = 1e-6) d2 <- dat[sample(1:nrow(dat), size = 20),] d2 <- d2[!("c" == d2$grp), ] pp2 <- suppressWarnings(predict(m1, newdata = d2, se.fit = TRUE)) expect_identical(lengths(pp2), c(fit=16L, se.fit=16L)) expect_equal(lapply(pp2, head, 2), list(fit = c(`37` = -0.5109994, `29` = -0.5704263), se.fit = c(`37` = 0.5151070, `29` = 0.3258730)), tol = 1e-7) set.seed(123) dat2 <- expand.grid( grp.1 = factor(c("a.1", "b.1", "c.1", "d.1")), grp.2 = factor(c("a.1", "b.1", "c.1", "d.1")), rep = 1:10) dat2$y <- simulate(~ 1 + (1|grp.1) + (1|grp.2), family = binomial, newdata = dat2, newparams = list(beta = 0, theta = c(1, 1)))[[1]] m2 <- lme4::glmer( y ~ 1 + (1|grp.1) + (1|grp.2), data = dat2, family = binomial(link = "logit") ) dsub <- expand.grid( grp.1 = c("a.1", "b.1"), grp.2 = c("a.1", "b.1")) p1 <- suppressWarnings(predict(m2, newdata = dsub, se.fit = TRUE)) p2 <- suppressWarnings(predict(m2, se.fit = TRUE)) ss <- subset(dat2, grp.1 %in% c("a.1", "b.1") & grp.2 %in% c("a.1", "b.1")) w <- as.numeric(rownames(ss)[1:4]) expect_equal(lapply(p2, function(x) x[w]), p1, check.attributes = FALSE) set.seed(1) dat3 <- expand.grid( g1 = factor(c("a", "b", "c", "d")), g2 = factor(c("a", "b", "c", "d")), rep = 1:10 ) dat3$y <- simulate(~ 1 + (1|g1) + (1|g2), family = binomial, newdata = dat3, newparams = list(beta = 0, theta = c(1, 1)))[[1]] m3 <- lme4::glmer( y ~ 1 + (1|g1) + (1|g2), data = dat3, family = binomial(link = "logit") ) dsub2 <- expand.grid( g1 = c("a", "b"), g2 = c("c", "d")) tp1 <- suppressWarnings(predict(m3, se.fit = TRUE)) tp2 <- suppressWarnings(predict(m3, newdata = dsub2, se.fit = TRUE)) ss2 <- subset(dat3, g1 %in% c("a", "b") & g2 %in% c("c", "d")) w2 <- as.numeric(rownames(ss2)[1:4]) expect_equal(lapply(tp1, function(x) x[w2]), tp2, check.attributes = FALSE) set.seed(1) sleepstudy$Subject2 <- rep(1:5, each = 36) m5 <- lmer(Reaction ~ Days + (1 + Days | Subject) + (1 | Subject2), data = sleepstudy) d <- sleepstudy[sample(1:nrow(sleepstudy), size = 30), ] pms1 <- predict(m5, se.fit = TRUE, re.form = NULL, allow.new.levels = FALSE) pms2 <- predict(m5, newdata = d, se.fit = TRUE, re.form = NULL, allow.new.levels = FALSE) psw <- as.numeric(rownames(d)) expect_equal(lapply(pms1, function(x) x[psw]), pms2, check.attributes = FALSE) lm1 <- lmer(Reaction ~ Days + (1 + Days | Subject), data = sleepstudy) d373 <- data.frame(Days = 0, Subject = "373") pred373 <- predict(lm1, newdata = d373, se.fit = TRUE, re.form = NULL, allow.new.levels = TRUE) expected_373 <- fixef(lm1)["(Intercept)"] + fixef(lm1)["Days"] * d373$Days expect_equal(pred373$fit, expected_373, check.attributes = FALSE, tol = 10e-16) dsub3 <- expand.grid( g1 = c("k", "m"), g2 = c("k", "m")) tp3 <- suppressWarnings(predict(m3, newdata = dsub3, se.fit = TRUE, allow.new.levels = TRUE)) expected_tp3 <- fixef(m3)["(Intercept)"] expect_true(all(tp3$fit == expected_tp3)) tp4 <- suppressWarnings(predict(m3, se.fit = TRUE, allow.new.levels = TRUE)) expect_equal(lapply(tp4, function(x) x[w2]), tp2, check.attributes = FALSE) gm1 <- glmer(round(Reaction) ~ Days + (1 + Days | Subject), data = sleepstudy, family = poisson) lme4/tests/testthat/test-ranef.R0000644000176200001440000000736015225703727016330 0ustar liggesusersstopifnot(require("testthat"), require("lme4")) set.seed(101) n <- 500 d <- data.frame(x=rnorm(n), f=factor(sample(1:10,n,replace=TRUE), labels=LETTERS[1:10]), g=factor(sample(1:25,n,replace=TRUE), labels=letters[1:25])) d$y <- suppressMessages(simulate(~1+x+(1|f)+(x|g),family=binomial, newdata=d, newparams=list(beta=c(0,1), theta=c(1,1,2,1)))[[1]]) fm1 <- glmer(y~(1|f)+(x|g),family=binomial,data=d) #context("ranef") test_that("warn extra args", { expect_warning(ranef(fm1,transf=exp),"additional arguments") }) test_that("dotplot_ranef", { rr <- ranef(fm1,condVar=TRUE) expect_is(lattice::dotplot(rr,scales=list(x = list(relation = 'free')))$g, "trellis") expect_is(lattice::dotplot(rr,transf=exp, scales=list(x = list(relation = 'free')))$g, "trellis") expect_is(as.data.frame(rr),"data.frame") rr0 <- ranef(fm1) expect_is(as.data.frame(rr0),"data.frame") }) test_that("Dyestuff consistent with lme4.0", { lme4.0condVarDyestuff <- c(362.3583, 362.3583, 362.3583, 362.3583, 362.3583, 362.3583) fm <- lmer(Yield ~ 1|Batch, Dyestuff, REML=FALSE) lme4condVarDyestuff <- drop(attr(ranef(fm,condVar=TRUE)$Batch,"postVar")) expect_equal(lme4.0condVarDyestuff, lme4condVarDyestuff, tolerance = 1e-3) }) test_that("sleepstudy consistent with lme4.0", { lme4.0condVarsleepstudy <- matrix(c(145.71273, -21.440414, -21.44041, 5.310927), 2, 2) fm <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) lme4condVarsleepstudy <- attr(ranef(fm,condVar=TRUE)$Subject,"postVar")[,,1] expect_equal(lme4.0condVarsleepstudy, lme4condVarsleepstudy, tolerance = 2e-4) }) test_that("cbpp consistent with lme4.0", { lme4.0condVarcbpp <- c(0.12128867, 0.13363275, 0.08839850, 0.17337928, 0.12277914, 0.14436663, 0.10658333, 0.10309812, 0.21289738, 0.13740279, 0.09555677, 0.19460241, 0.14808316, 0.12631006, 0.15816769) gm <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) lme4condVarcbpp <- as.numeric(attr(ranef(gm,condVar=TRUE)$herd,"postVar")) expect_equal(lme4.0condVarcbpp, lme4condVarcbpp, tolerance = 1e-3) }) #context("multiple terms per factor") test_that("multiple terms work", { fm <- lmer(Reaction ~ Days + (1|Subject)+ (0+Days | Subject), sleepstudy, control=lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6))) rr <- ranef(fm, condVar=TRUE) expect_equal(as.data.frame(rr)[c(1,19),], structure( list(grpvar = c("Subject", "Subject"), term = structure(1:2, levels = c("(Intercept)", "Days"), class = "factor"), grp = structure(c(9L, 9L), levels = c("309", "310", "370", "349", "350", "334", "335", "371", "308", "369", "351", "332", "372", "333", "352", "331", "330", "337"), class = "factor"), condval = c(1.5116973008, 9.32373076098), condsd = c(12.238845590, 2.33546851406)), row.names = c(1L, 19L), class = "data.frame"), tolerance = 1e-5) cv <- attr(rr$Subject, "postVar") expect_equal(lapply(cv, drop), list(`(Intercept)` = rep(149.79166, 18), Days = rep(5.4543894, 18)), tolerance = 1e-4) }) lme4/tests/testthat/test-oldRZXfailure.R0000644000176200001440000000072215127735433017762 0ustar liggesusersload(system.file("testdata","crabs_randdata00.Rda",package="lme4")) test_that('RZX is being calculated properly', { # this is a test for an old problem, documented here: # http://stevencarlislewalker.github.io/notebook/RZX_problems.html fr <- cbind(final.snail.density, snails.lost) ~ crab.speciesS + crab.sizeS + crab.speciesS:crab.sizeS + (snail.size | plot) m <- glmer(fr, data = randdata00, family = binomial) expect_that(m, is_a("glmerMod")) }) lme4/tests/testthat/test-glmmFail.R0000644000176200001440000000263515127735433016765 0ustar liggesusersdata("sleepstudy", package = "lme4") source(system.file("testdata/lme-tst-funs.R", package="lme4", mustWork=TRUE)) ##-> gSim(), a general simulation function ... set.seed(101) dBc <- gSim(family=binomial(link="cloglog"), nbinom = 1) # {0,1} Binomial ## m1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), ## family = binomial, data = cbpp) #context("Errors and warnings from glmer") test_that("glmer", { expect_error(glmer(y ~ 1 + (1|block), data=dBc, family=binomial(link="cloglog")), "Response is constant") expect_error(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), family = binomial, data = cbpp, REML=TRUE), "unused argument.*REML") expect_warning(glmer(Reaction ~ Days + (Days|Subject), sleepstudy), "calling glmer.*family=gaussian.*deprecated") expect_warning(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian), "calling glmer.*family=gaussian.*deprecated") m3 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy)) m4 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) m5 <- suppressWarnings(glmer(Reaction ~ Days + (Days|Subject), sleepstudy, family=gaussian)) expect_equal(fixef(m3),fixef(m5)) m3@call[[1]] <- m5@call[[1]] <- quote(lmer) ## hack call expect_equal(m3,m4) expect_equal(m3,m5) }) lme4/tests/testthat/test-glmernb.R0000644000176200001440000000565315225703727016666 0ustar liggesuserstestLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 if (testLevel>1) { #context("glmer.nb") test_that("basic", { set.seed(101) dd <- expand.grid(f1 = factor(1:3), f2 = LETTERS[1:2], g=1:9, rep=1:15, KEEP.OUT.ATTRS=FALSE) mu <- 5*(-4 + with(dd, as.integer(f1) + 4*as.numeric(f2))) dd$y <- rnbinom(nrow(dd), mu = mu, size = 0.5) require("MASS") m.glm <- glm.nb(y ~ f1*f2, data=dd) m.nb <- glmer.nb(y ~ f1*f2 + (1|g), data=dd) expect_equal(unname(fixef(m.nb)), c(1.65008, 0.76715, 1.01147, 1.51241, -0.61506, -0.6104), tol=1e-5) expect_is(m.nb,"glmerMod") ## 'family' properly quoted/not expanded in call? expect_true(grepl("negative\\.binomial\\(theta *= *[0-9]*\\.[0-9]+\\)", deparse(m.nb@call$family))) expect_null(m.nb@call$verbose) ## check: GH #321 expect_equal(fixef(m.nb), coef (m.glm), tol=1e-5) ## GH #319 ## GH #285 m.nb1 <- glmer(Reaction > 250 ~ Days + (1|Subject), data = sleepstudy, family=poisson) ## previously failing on Travis-CI m.nb2 <- glmer.nb(y ~ f1*f2 + (1|g), data=dd, subset = g!=8) expect_equal(unname(ngrps(m.nb2)),8) ## expect parameters, ngrps *not* to equal full model expect_equal(unname(fixef(m.nb2)), c(1.629240234, 0.76028840, 1.008629913, 1.6172507, -0.6814426, -0.66468330),tol=1e-5) ## control handling ... this should suppress warnings ... old.opts <- options(warning=2) m.nb2 <- glmer.nb(round(Reaction) ~ Days + (1|Subject), data = sleepstudy, subset = Subject != 370, control=glmerControl(check.conv.grad="ignore")) expect_is(m.nb2,"glmerMod") options(old.opts) m.nb3 <- glmer.nb(y~f1+(1|g), data=dd, contrasts=list(f1=contr.sum)) ## make sure *different* fixed effects from previous fit ... expect_equal(fixef(m.nb3), structure(c(2.93061, -0.29779, 0.02586), names = c("(Intercept)", "f11", "f12")),tol=1e-5) ## make sure 'data' is in call even if unnamed m.nb4 <- glmer.nb(y~f1+(1|g), dd) expect_equal(names(m.nb4@call),c("","formula","data","family")) ## GH 322; allow offset m.nb2 <- glmer.nb(y~f1+(1|g), data=dd, offset=rep(0,nrow(dd))) }) if (requireNamespace("merDeriv")) { test_that("summary not broken by merDeriv", { library(merDeriv) data(Arabidopsis) mod <- glmer.nb(total.fruits~status+nutrient+(1|gen), data=Arabidopsis) ## trivial test of existence/non-failure ... expect_is(summary(mod), "summary.merMod") ## may? expose other problems as S3 methods won't be unloaded properly ... detach("package:merDeriv") }) } } ## testLevel > 1 lme4/tests/testthat/test-simulate_formula.R0000644000176200001440000000647115225714450020602 0ustar liggesusersquietly <- TRUE ## factory for making methods mk_method <- function(class, print_dims=FALSE) { method <- sprintf("simulate.formula_lhs_%s",class) sim_generic <- function(object, nsim=1, seed=NULL, ...) { if (!quietly) message(sprintf("%s called",method)) if (!quietly) cat(".Basis from attributes:\n") if (!quietly) print(attr(object,".Basis")) # NULL if (print_dims) { if (!quietly) print(dim(attr(object,".Basis"))) } return(attr(object,".Basis")) } assign(method,sim_generic,.GlobalEnv) invisible(NULL) } ## (**) these methods should (??) _mask_ package versions ... ## works in source(), not in devtools::test() ... mk_method("NULL") mk_method("numeric") mk_method("array",print_dims=TRUE) mk_method("") test_that("simple numerics", { ## expect_equal(simulate(1~.),1) ## FIXME re-enable if we resolve (**) above ## One-sided formula is not the same as an LHS that evaluates to NULL: expect_equal(simulate(NULL~.),NULL) }) test_that("raw formulas", { expect_error(suppressWarnings(simulate(x~.)), "Error evaluating") }) simulate.formula_lhs_character <- function(object, nsim=1, seed=NULL, ...) { if (!quietly) message("simulate.formula_lhs_character() called.") if (!quietly) print(ls(all.names=TRUE)) NextMethod() # Calls simulate.formula(), resulting in an infinite recursion. } test_that("prevent recursion", { expect_error(simulate("a"~.), "No applicable method") }) dd <- expand.grid(A=factor(1:3),B=factor(1:10),rep=1:10) test_that("two-sided formula warning", { expect_error(suppressMessages(simulate(.~1 + (A|B), newdata=dd, newparams=list(beta=1,theta=rep(1,6), sigma=1), family=gaussian, seed=101))[[1]], "object '.' not found") }) ## cleanup: mk_method() assigns into .GlobalEnv, so remove explicitly from there suppressWarnings(try(rm(list = c("simulate.formula_lhs_", "simulate.formula_lhs_numeric", "simulate.formula_lhs_array"), envir = .GlobalEnv), silent = TRUE)) ## a one-sided formula with neither 'family' nor 'newparams' used to fall ## through to the generic (and unhelpful) "No applicable method for LHS of ## type 'NULL'" error; it should instead report the missing arguments. test_that("one-sided formula without family/newparams gives an informative error", { expect_error(simulate(~1 + (1|Days), newdata=sleepstudy), "must specify all of.*formula.*newdata.*newparams") }) ## GH#948: simulate with re.form=NULL should work when a predictor is a 1-col ## matrix (e.g. from scale()) used inside poly() -- poly() with pre-specified ## coefs rejects matrix input, so mkNewReTrms must drop such columns first test_that("simulate re.form=NULL works with poly(scale(x)) predictor (GH#948)", { ss_sc <- transform(sleepstudy, Days = scale(Days)) fit1 <- lmer(Reaction ~ 1 + poly(Days, 2) + (1|Subject), data = sleepstudy) fit_sc <- update(fit1, data = ss_sc) s1 <- simulate(fit_sc, seed = 101, re.form = NULL) s2 <- simulate(fit_sc, seed = 101, re.form = NULL) expect_equal(s1, s2) }) lme4/tests/testthat/test-resids.R0000644000176200001440000001015715155634017016521 0ustar liggesusers#context("residuals") test_that("lmer", { C1 <- lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)) fm1 <- lmer(Reaction ~ Days + (Days|Subject),sleepstudy, control=C1) fm2 <- lmer(Reaction ~ Days + (Days|Subject),sleepstudy, control=lmerControl(calc.derivs=FALSE, optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6))) expect_equal(resid(fm1), resid(fm2)) expect_equal(range(resid(fm1)), c(-101.17996, 132.54664), tolerance=1e-6) expect_equal(range(resid(fm1, scaled=TRUE)), c(-3.9536067, 5.1792598), tolerance=1e-6) expect_equal(resid(fm1,"response"),resid(fm1)) expect_equal(resid(fm1,"response"),resid(fm1,type="working")) expect_equal(resid(fm1,"deviance"),resid(fm1,type="pearson")) expect_equal(resid(fm1),resid(fm1,type="pearson")) ## because no weights given expect_error(residuals(fm1,"partial"), "partial residuals are not implemented yet") sleepstudyNA <- sleepstudy na_ind <- c(10,50) sleepstudyNA[na_ind,"Days"] <- NA fm1NA <- update(fm1,data=sleepstudyNA) fm1NA_exclude <- update(fm1,data=sleepstudyNA,na.action="na.exclude") expect_equal(length(resid(fm1)),length(resid(fm1NA_exclude))) expect_true(all(is.na(resid(fm1NA_exclude)[na_ind]))) expect_true(!any(is.na(resid(fm1NA_exclude)[-na_ind]))) }) test_that("glmer", { gm1 <- glmer(incidence/size ~ period + (1|herd), cbpp, family=binomial, weights=size) gm2 <- update(gm1,control=glmerControl(calc.derivs=FALSE)) gm1.old <- update(gm1,control=glmerControl(calc.derivs=FALSE, use.last.params=TRUE)) expect_equal(resid(gm1),resid(gm2)) ## y, wtres, mu change ?? ## FIX ME:: why does turning on derivative calculation make these tests fail??? expect_equal(range(resid(gm1.old)), c(-3.197512,2.356677), tolerance=1e-6) expect_equal(range(resid(gm1)), c(-3.1975034,2.35668826), tolerance=1e-6) expect_equal(range(resid(gm1.old, "response")), c(-0.1946736,0.3184579), tolerance=1e-6) expect_equal(range(resid(gm1,"response")),c(-0.194674747774946, 0.318458889275477)) expect_equal(range(resid(gm1.old, "pearson")), c(-2.381643,2.879069),tolerance=1e-5) expect_equal(range(resid(gm1,"pearson")), c(-2.38163599828335, 2.87908806084918)) expect_equal(range(resid(gm1.old, "working")), c(-1.241733,5.410587),tolerance=1e-5) expect_equal(range(resid(gm1, "working")), c(-1.24173431447365, 5.41064465283686)) expect_equal(resid(gm1),resid(gm1,scaled=TRUE)) ## since sigma==1 expect_error(resid(gm1,"partial"), "partial residuals are not implemented yet") cbppNA <- cbpp na_ind <- c(10,50) cbppNA[na_ind,"period"] <- NA gm1NA <- update(gm1,data=cbppNA) gm1NA_exclude <- update(gm1,data=cbppNA,na.action="na.exclude") expect_equal(length(resid(gm1)),length(resid(gm1NA_exclude))) expect_true(all(is.na(resid(gm1NA_exclude)[na_ind]))) expect_true(!any(is.na(resid(gm1NA_exclude)[-na_ind]))) }) test_that("floating-point issues -> NaN dev resids", { dat <- data.frame(x=1:5, n=100, id=1:5) res <- glmer(cbind(x,n-x) ~ 1 + (1 | id), data=dat, family=binomial, control = glmerControl(check.conv.singular = "ignore")) r <- residuals(res, type="deviance") expect_equal(unname(r[3]), 0) }) test_that("weighted residuals", { skip_if(getRversion() < "4.6.0") ## methods have changed to match r-devel ss <- sleepstudy ## make sure napredict() is exercised ss$Reaction[1] <- NA_real_ fm1 <- lmer(Reaction ~ 1 + (1|Subject), ss, na.action = na.exclude) expect_equal(head(weighted.residuals(fm1), 3), structure(c(NA, -86.4020327538219, -94.3061327538219), names = c(NA, "2", "3"))) gm1 <- glmer(round(Reaction) ~ 1 + (1|Subject), ss, na.action = na.exclude, family = poisson) expect_equal(head(weighted.residuals(gm1), 3), structure(c(NA, -4.9271857060919, -5.35397661950064), names = c(NA, "2", "3"))) }) lme4/tests/testthat/test-covariance_structures.R0000644000176200001440000007262015224173400021637 0ustar liggesusers## read system file other_mod <- readRDS( system.file("testdata", "test-covariance_structures_data.rds", package = "lme4") ) Contraception <- readRDS( system.file("testdata", "Contraception.rds", package = "lme4") ) ###################################################################### # Below is code frequently used for testing # see: test-covariance_structures.R and test-covariance_nlmer.R all.equal.nocheck <- function(x, y, ..., check.attributes = FALSE, check.class = FALSE) { require("Matrix", quietly = TRUE) ## working around mode-matching headaches if (is(x, "Matrix")) x <- matrix(x) if (is(y, "Matrix")) y <- matrix(y) all.equal(x, y, ..., check.attributes = check.attributes, check.class = check.class) } ## set default tolerance to 5e-5 since we mostly use that ## 'tolerance' must be written out in full since it comes after ... expect_equal_nocheck <- function(..., tolerance = 5e-5) { aa <- all.equal.nocheck(..., tolerance = tolerance) if (!isTRUE(aa)) cat("tolerance: ", tolerance, "\n", aa, "\n") expect_true(isTRUE(aa)) } ## Getting all equal as a number (in the all.equal examples documentation; ## don't know why they didn't make an argument instead!?) all.eqNum <- function(...) { an <- all.equal.nocheck(...) if (isTRUE(an)) return(0) ## if check is less than tolerance all.equal returns TRUE, so sub() coerces to "TRUE" ## and as.numeric() returns NA ... as.numeric(sub(".*:", '', an)) } test_that("unit test for unstructured covariances", { for (nc in c(0:4, 16L, 64L, 256L)){ x.us <- new("Covariance.us", nc = nc, simulate = TRUE) ## Basic sanity tests expect_s4_class(x.us, "Covariance.us") expect_true(validObject(x.us)) ## par should be the same as theta expect_equal(getPar(x.us), getTheta(x.us)) ## checking for specific par/theta lengths expect_equal(getParLength(x.us), (nc * (nc+1)/2)) expect_equal(getParLength(x.us), getThetaLength(x.us)) expect_equal(length(getThetaIndex(x.us)), getThetaIndexLength(x.us)) expect_equal(getLambdat.dp(x.us), seq_len(nc)) ## Testing getUpper() and getLower() in a different manner expect_equal(getUpper(x.us), rep(Inf, getThetaIndexLength(x.us))) if(nc > 1L){ test_low <- rep(-Inf, nc * (nc + 1) / 2) diag_positions <- c(1, cumsum(nc:2) + 1) test_low[diag_positions] <- 0 } else if (nc == 1L){ test_low <- 0 } else if (nc == 0L){ test_low <- numeric(0) } expect_equal(getLower(x.us), test_low) ## Testing getLambdat.i in a different manner expect_equal(getLambdat.i(x.us), (row(matrix(0, nc, nc)) - 1)[upper.tri(matrix(0, nc, nc), diag = TRUE)]) ## Testing getLambda in a different manner mat <- matrix(0, nc, nc) mat[upper.tri(mat, diag = TRUE)] <- getTheta(x.us)[getThetaIndex(x.us)] expect_equal(getLambda(x.us), t(mat)) ## This is quite similar to what is in setMethod("getVC", ...) but using ## getPar() to make sure everything is working as planned ## TODO: think of a more creative method? if (nc <= 1L) { vcomp_test <- getPar(x.us) ccomp_test <- double(0L) } else { ii <- seq.int(from = 1L, by = nc + 1L, length.out = nc) i0 <- sequence.default(from = seq.int(from = 2L, by = nc + 1L, length.out = nc - 1L), by = 1L, nvec = (nc - 1L):1L) i1 <- sequence.default(from = ii, by = 1L, nvec = nc:1L) L <- matrix(0, nc, nc) L[i1] <- getPar(x.us) S <- tcrossprod(L) vcomp_test <- sqrt(S[ii]) ccomp_test <- (S/vcomp_test/rep(vcomp_test, each = nc))[i0] } vc <- getVC(x.us) expect_equal(vc$vcomp, vcomp_test) expect_equal(vc$ccomp, ccomp_test) # Testing getProfPar expect_equal(c(vcomp_test, ccomp_test), getProfPar(x.us)) expect_equal(c(vcomp_test*2, ccomp_test), getProfPar(x.us, sc = 2)) expect_equal(c(rep(0, length(vc$vcomp)), rep(-1, length(vc$ccomp))), getProfLower(x.us)) expect_equal(c(rep(Inf, length(vc$vcomp)), rep(1, length(vc$ccomp))), getProfUpper(x.us)) } }) test_that("unit tests for diagonal covariances", { for (nc in c(0:4, 16L, 64L, 256L)){ for(hom_test in c(TRUE, FALSE)){ x.di <- new("Covariance.diag", nc = nc, hom = hom_test, simulate = TRUE) ## Basic sanity tests expect_s4_class(x.di, "Covariance.diag") expect_true(validObject(x.di)) ## par should be the same as theta expect_equal(getPar(x.di), getTheta(x.di)) ## checking for specific par/theta lengths if(hom_test){ expect_equal(getParLength(x.di), if (nc > 0L) 1 else 0) } else { expect_equal(getParLength(x.di), if (nc > 0L) nc else 0) } expect_equal(getParLength(x.di), getThetaLength(x.di)) expect_equal(length(getThetaIndex(x.di)), getThetaIndexLength(x.di)) expect_equal(getLambdat.dp(x.di), rep(1L, nc)) ## Testing getUpper() and getLower() in a different manner if(hom_test){ expect_equal(getUpper(x.di), if(nc > 0L) Inf else numeric(0)) expect_equal(getLower(x.di), if(nc > 0L) 0 else numeric(0)) } else { expect_equal(getUpper(x.di), if(nc > 0L) rep(Inf, nc) else numeric(0)) expect_equal(getLower(x.di), if(nc > 0L) rep(0, nc) else numeric(0)) } ## Testing getLambdat.i in a different manner expect_equal(getLambdat.i(x.di), if(nc > 0L) 0:(nc-1) else integer(0)) ## Testing getLambda in a different manner expect_equal(getLambda(x.di), diag(nc) * getPar(x.di)) ## Testing getVC vc <- getVC(x.di) expect_equal(vc$ccomp, numeric(0)) expect_equal(vc$vcomp, getPar(x.di)) # Testing getProfPar expect_equal(vc$vcomp, getProfPar(x.di)) expect_equal(vc$vcomp*2, getProfPar(x.di, sc = 2)) expect_equal(vc$vcomp^2, getProfPar(x.di, profscale = "varcov")) expect_equal(rep(0, length(vc$vcomp)), getProfLower(x.di)) expect_equal(rep(Inf, length(vc$vcomp)), getProfUpper(x.di)) } } }) test_that("unit tests for compound symmetry covariances", { for (nc in c(0:4, 16L, 64L, 256L)){ for(hom_test in c(TRUE, FALSE)){ x.cs <- new("Covariance.cs", nc = nc, hom = hom_test, simulate = TRUE) ## Basic sanity tests expect_s4_class(x.cs, "Covariance.cs") expect_true(validObject(x.cs)) ## par should be the same as vcomp and ccomp from getVC expect_equal(getPar(x.cs), c(getVC(x.cs)$vcomp, getVC(x.cs)$ccomp)) ## testing for getTheta via the structure of getLambda ## (odd way of looking at things, but it nicely compares the relationship ## between these two functions.) lam_mat <- getLambda(x.cs) collected <- 1 if(nc > 0L){ if(hom_test){ ## for homogenous structures only collect <- numeric(nc*2-1) collected <- 1 for(i in 1:nc){ if(i != nc){ collect[collected:(collected+1)] <- lam_mat[i:(i+1),i] } else { collect[collected:collected] <- lam_mat[i,i] } collected = collected + 2 } } else { ## for non-homogenous structures grab <- nc collect <- numeric((nc * (nc+1)/2)) for(i in 1:nc){ if(i != nc){ collect[collected:(collected + (nc-i))] <- lam_mat[i:nc,i] } else { collect[collected:collected] <- lam_mat[i,i] } collected = collected + (nc - i + 1) } } } else { collect = numeric(0) } expect_equal(getTheta(x.cs), collect) ## Testing getParLength if(hom_test){ ## for homogenous, should be no more than 2 if(nc <= 2L){ expect_equal(getParLength(x.cs), nc) } else { expect_equal(getParLength(x.cs), 2L) } } else { ## Comparing length to vcomp and ccomp expect_equal(getParLength(x.cs), sum(lengths(getVC(x.cs)[c("vcomp", "ccomp")]))) } expect_equal(getParLength(x.cs), length(getPar(x.cs))) expect_equal(getThetaLength(x.cs), length(getTheta(x.cs))) ## Testing getThetaLength expect_equal(length(getThetaIndex(x.cs)), getThetaIndexLength(x.cs)) if(hom_test){ expect_equal(getThetaLength(x.cs), if(nc > 0L) (nc*2 - 1) else 0) } else { expect_equal(getThetaLength(x.cs), (nc * (nc+1)/2)) } expect_equal(getLambdat.dp(x.cs), if(nc > 0L) 1:nc else integer(0)) ## Testing getUpper() and getLower() if(nc > 1L){ if(hom_test) { expect_equal(getUpper(x.cs), c(Inf, 1)) expect_equal(getLower(x.cs), c(0.0, -1/(nc-1))) } else { expect_equal(getUpper(x.cs), c(rep(Inf, nc), 1)) expect_equal(getLower(x.cs), c(rep(0.0, nc), -1/(nc-1))) } } else if (nc == 1L) { expect_equal(getUpper(x.cs), Inf) expect_equal(getLower(x.cs), 0) } else { expect_equal(getUpper(x.cs), numeric(0)) expect_equal(getLower(x.cs), numeric(0)) } ## Testing getLambdat.i in a different manner expect_equal(getLambdat.i(x.cs), (row(matrix(0, nc, nc)) - 1)[upper.tri(matrix(0, nc, nc), diag = TRUE)]) ## Testing getProfPar expect_equal(getPar(x.cs), getProfPar(x.cs)) vc.cs <- getVC(x.cs) expect_equal(c(vc.cs$vcomp*2, vc.cs$ccomp), getProfPar(x.cs, sc = 2)) expect_equal(c(rep(0, length(vc.cs$vcomp)), rep(-1/(nc-1), length(vc.cs$ccomp))), getProfLower(x.cs)) expect_equal(c(rep(Inf, length(vc.cs$vcomp)), rep(1, length(vc.cs$ccomp))), getProfUpper(x.cs)) } } }) test_that("unit tests for autoregressive covariances", { for (nc in c(0:4, 16L, 64L, 256L)){ for(hom_test in c(TRUE, FALSE)){ x.ar1 <- new("Covariance.ar1", nc = nc, hom = hom_test, simulate = TRUE) ## Basic sanity tests expect_s4_class(x.ar1, "Covariance.ar1") expect_true(validObject(x.ar1)) getVC_t <- getVC(x.ar1); vcomp_t <- getVC_t$vcomp; ccomp_t <- getVC_t$ccomp ## par should be the same as vcomp and ccomp from getVC expect_equal(getPar(x.ar1), c(vcomp_t, ccomp_t)) ## getTheta test by relating to getVC v1 <- ccomp_t^(0L:(nc - 1L)) v2 <- ccomp_t^(0L:(nc - 2L)) * sqrt(1 - ccomp_t^2) if(hom_test){ if(nc > 1L){ theta_test <- vcomp_t * c(v1, v2) } else { theta_test <- vcomp_t } } else { if(nc > 1L){ theta_test <- vcomp_t[sequence.default(from = 1L:nc, nvec = nc:1L)] * c(v1, v2[sequence.default(from = 1L, nvec = (nc - 1L):1L)]) } else { theta_test <- vcomp_t } } expect_equal(getTheta(x.ar1), theta_test) ## Testing for theta and par lengths expect_equal(getThetaLength(x.ar1), length(getTheta(x.ar1))) expect_equal(getParLength(x.ar1), length(getPar(x.ar1))) expect_equal(getParLength(x.ar1), sum(lengths(getVC(x.ar1)[c("vcomp", "ccomp")]))) lam_test <- matrix(0, nc, nc) if(nc > 0L){ lam_test[lower.tri(lam_test, diag = TRUE)] <- if(hom_test){ theta_test[sequence.default(from = rep(c(1L, nc + 1L), c(1L, nc - 1L)), nvec = nc:1L)] } else { theta_test } } expect_equal(getLambda(x.ar1), lam_test) expect_equal(getLambdat.dp(x.ar1), if(nc > 0L) 1:nc else integer(0)) ## Testing getUpper and getLower if(nc > 1L){ if(hom_test) { expect_equal(getUpper(x.ar1), c(Inf, 1)) expect_equal(getLower(x.ar1), c(0, -1)) } else { expect_equal(getUpper(x.ar1), c(rep(Inf, nc), 1)) expect_equal(getLower(x.ar1), c(rep(0.0, nc), -1)) } } else if (nc == 1L) { expect_equal(getUpper(x.ar1), Inf) expect_equal(getLower(x.ar1), 0) } else { expect_equal(getUpper(x.ar1), numeric(0)) expect_equal(getLower(x.ar1), numeric(0)) } ## Testing getLambdat.i in a different manner expect_equal(getLambdat.i(x.ar1), (row(matrix(0, nc, nc)) - 1)[upper.tri(matrix(0, nc, nc), diag = TRUE)]) ## Testing getProfPar expect_equal(unname(unlist(getVC(x.ar1))), getProfPar(x.ar1)) vc.ar1 <- getVC(x.ar1) expect_equal(c(vc.ar1$vcomp*2, vc.ar1$ccomp), getProfPar(x.ar1, sc = 2)) expect_equal(c(rep(0, length(vc.ar1$vcomp)), rep(-1, length(vc.ar1$ccomp))), getProfLower(x.ar1)) expect_equal(c(rep(Inf, length(vc.ar1$vcomp)), rep(1, length(vc.ar1$ccomp))), getProfUpper(x.ar1)) } } }) ## lme4 linear mixed models fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy, REML = FALSE) fm1.us <- lmer(Reaction ~ Days + us(Days | Subject), sleepstudy, REML = FALSE) fm1.cs <- lmer(Reaction ~ Days + cs(Days | Subject), sleepstudy, REML = FALSE) fm1.diag <- lmer(Reaction ~ Days + diag(Days | Subject), sleepstudy, REML = FALSE) sleepstudy$Daysf <- factor(sleepstudy$Days, ordered = TRUE) fm1.ar1 <- lmer(Reaction ~ Daysf + ar1(0 + Daysf | Subject, hom = TRUE), sleepstudy, REML = FALSE) fm1.ar1A <- lmer(Reaction ~ Daysf + ar1(0 + Daysf | Subject), sleepstudy, REML = FALSE) test_that("AR1 homogeneous by default", { expect_equal(getME(fm1.ar1A, "par"), getME(fm1.ar1, "par")) }) fm1.REML <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) fm1.us.REML <- lmer(Reaction ~ Days + us(Days | Subject), sleepstudy) fm1.cs.REML <- lmer(Reaction ~ Days + cs(Days | Subject), sleepstudy) fm1.diag.REML <- lmer(Reaction ~ Days + diag(Days | Subject), sleepstudy) fm1.ar1.REML <- lmer(Reaction ~ Daysf + ar1(0 + Daysf | Subject, hom = TRUE), sleepstudy) ## lme4 generalized linear mixed models gm <- glmer(use ~ age + urban + (1 + urban | district), data = Contraception, family = binomial) # unstructured gm.us <- glmer(use ~ age + urban + us(1 + urban | district), data = Contraception, family = binomial) # compound symmetry gm.cs <- glmer(use ~ age + urban + cs(1 + urban | district), data = Contraception, family = binomial) # diagonal gm.diag <- glmer(use ~ age + urban + diag(1 + urban | district), data = Contraception, family = binomial) test_that("integration tests for coef and fixef", { ## Ensuring unstructured covariance results are the same as default expect_equal(coef(fm1), coef(fm1.us)) expect_equal(coef(fm1.REML), coef(fm1.us.REML)) expect_equal(fixef(fm1), fixef(fm1.us)) expect_equal(fixef(fm1.REML), fixef(fm1.us.REML)) expect_equal(coef(gm), coef(gm.us)) expect_equal(fixef(gm), fixef(gm.us)) ## One of the expected summaries opt <- options(useFancyQuotes = FALSE) tmpf <- function(x) capture.output(print(summary(x),digits=1)) tfun <- function(cc) { w <- grep("Fixed effects:", cc) cc[w:length(cc)] } expected_summary <- c("Fixed effects:", " Estimate Std. Error t value", "(Intercept) 251 7 38", "Days 10 2 7", "", "Correlation of Fixed Effects:", " (Intr)", "Days -0.138") expect_equal(tfun(tmpf(fm1)), expected_summary) expected_sum2 <- c("Fixed effects:", " Estimate Std. Error z value Pr(>|z|) ", "(Intercept) -0.720 0.103 -7 3e-12 ***", "age 0.009 0.005 2 0.09 . ", "urbanY 0.742 0.169 4 1e-05 ***", "---", "Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1", "", "Correlation of Fixed Effects:", " (Intr) age ", "age -0.022 ", "urbanY -0.648 0.006") expect_equal(tfun(tmpf(gm.us)), expected_sum2) options(opt) }) test_that("integration tests for sigma", { ## Ensuring unstructured covariance results are the same as default expect_equal(sigma(fm1), sigma(fm1.us)) expect_equal(sigma(fm1.REML), sigma(fm1.us.REML)) expect_equal(sigma(gm), sigma(gm.us)) ## Ensuring computing sigma is consistent for lme4 ## against other packages expect_equal_nocheck(sigma(fm1), other_mod$fm1.glmmTMB_sigma) expect_equal_nocheck(sigma(fm1.cs), other_mod$fm1.glmmTMB.cs_sigma) expect_equal_nocheck(sigma(fm1.diag), other_mod$fm1.glmmTMB.diag_sigma) expect_equal_nocheck(sigma(fm1.ar1), other_mod$fm1.glmmTMB.ar1_sigma) expect_equal_nocheck(sigma(fm1), other_mod$fm1.nlme_sigma) expect_equal_nocheck(sigma(fm1.cs), other_mod$fm1.nlme.cs_sigma) expect_equal_nocheck(sigma(fm1.REML), other_mod$fm1.nlme.REML_sigma) expect_equal_nocheck(sigma(fm1.cs.REML), other_mod$fm1.nlme.cs.REML_sigma) ## Tests for glmer expect_true(all.equal(sigma(gm.us), other_mod$gm.glmmTMB_sigma)) expect_true(all.equal(sigma(gm.cs), other_mod$gm.glmmTMB.cs_sigma)) expect_true(all.equal(sigma(gm.diag), other_mod$gm.glmmTMB.diag_sigma)) }) test_that("Log likelihood tests", { ## Note: when it comes to more complicated models such as GLMMs ## we see that the mean relative difference between fitted models from ## different packages will be quite large. ## Idea: if log likelihoods are the same, then we're okay. expect_equal(logLik(fm1), logLik(fm1.us)) expect_equal(logLik(fm1.REML), logLik(fm1.us.REML)) expect_equal(logLik(gm), logLik(gm.us)) ## comparing against glmmTMB expect_true(all.equal.nocheck(as.numeric(logLik(fm1)), other_mod$fm1.glmmTMB_logLik)) expect_true(all.equal.nocheck(as.numeric(logLik(fm1.cs)), other_mod$fm1.glmmTMB.cs_logLik)) expect_true(all.equal.nocheck(as.numeric(logLik(fm1.diag)), other_mod$fm1.glmmTMB.diag_logLik)) expect_true(all.equal.nocheck(as.numeric(logLik(fm1.ar1)), other_mod$fm1.glmmTMB.ar1_logLik)) ## comparing against nlme expect_true(all.equal.nocheck(logLik(fm1), other_mod$fm1.nlme_logLik)) expect_true(all.equal.nocheck(logLik(fm1.cs), other_mod$fm1.nlme.cs_logLik)) expect_true(all.equal.nocheck(logLik(fm1.REML), other_mod$fm1.nlme.REML_logLik)) expect_true(all.equal.nocheck(logLik(fm1.cs.REML), other_mod$fm1.nlme.cs.REML_logLik)) ## glmer expect_equal_nocheck(as.numeric(logLik(gm.us)), other_mod$gm.glmmTMB_logLik) expect_equal_nocheck(as.numeric(logLik(gm.cs)), other_mod$gm.glmmTMB.cs_logLik) expect_equal_nocheck(as.numeric(logLik(gm.diag)), other_mod$gm.glmmTMB.diag_logLik) }) test_that("integration tests for vcov", { ## Ensuring unstructured covariance results are the same as default expect_equal(vcov(fm1), vcov(fm1.us)) expect_equal(vcov(fm1.REML), vcov(fm1.us.REML)) expect_equal(vcov(gm), vcov(gm.us)) ## Ensuring variance-covariance matrix are consistent between lme4 ## and other packages expect_equal_nocheck(vcov(fm1), other_mod$fm1.glmmTMB_vcov) expect_equal_nocheck(vcov(fm1.cs), other_mod$fm1.glmmTMB.cs_vcov) expect_equal_nocheck(vcov(fm1.diag), other_mod$fm1.glmmTMB.diag_vcov) expect_equal_nocheck(vcov(fm1.ar1), other_mod$fm1.glmmTMB.ar1_vcov) expect_equal_nocheck(vcov(fm1), other_mod$fm1.nlme_vcov) expect_equal_nocheck(vcov(fm1.cs), other_mod$fm1.nlme.cs_vcov) expect_equal_nocheck(vcov(fm1.REML), other_mod$fm1.nlme.REML_vcov) ## larger tolerance; likelihood matched fairly well expect_equal_nocheck(as.numeric(vcov(fm1.cs.REML)), as.numeric(other_mod$fm1.nlme.cs.REML_vcov), tolerance = 2e-4) ## Tests for glmer ## The differences are somewhat large, however, the log likelihoods are ## quite similar... Leaving these with a larger tolerance. expect_equal_nocheck(vcov(gm.us), other_mod$gm.glmmTMB_vcov, tolerance = 3e-3) expect_equal_nocheck(vcov(gm.cs), other_mod$gm.glmmTMB.cs_vcov, tolerance = 3e-3) expect_equal_nocheck(vcov(gm.diag), other_mod$gm.glmmTMB.diag_vcov, tolerance = 3e-3) }) test_that("integration tests for VarCorr", { ## Ensuring unstructured covariance results are the same as default expect_equal(VarCorr(fm1), VarCorr(fm1.us)) expect_equal(VarCorr(fm1.REML), VarCorr(fm1.us.REML)) expect_equal(VarCorr(gm), VarCorr(gm.us)) ## Ensuring variance components are consistent for lme4 ## against other packages x1 <- c(as.matrix(VarCorr(fm1)[[1]])) x2 <- c(as.matrix(VarCorr(fm1.us)[[1]])) ## Testing unstructured expect_equal_nocheck(x1, c(other_mod$fm1.glmmTMB_var)) expect_equal_nocheck(x2, c(other_mod$fm1.glmmTMB.us_var)) expect_equal_nocheck(c(as.matrix(VarCorr(fm1.REML)[[1]])), c(other_mod$fm1.nlme.REML_var)) expect_equal_nocheck(x2, c(other_mod$fm1.nlme_var), tolerance = 5e-4) ## Testing cs (compound symmetry) x3 <- c(as.matrix(VarCorr(fm1.cs)[[1]])) expect_equal_nocheck(x3, c(other_mod$fm1.glmmTMB.cs_var), tolerance = 5e-4) expect_equal_nocheck(x3, c(other_mod$fm1.nlme.cs_var), tolerance = 5e-4) x3.REML <- c(as.matrix(VarCorr(fm1.cs.REML)[[1]])) z3.REML <- c(other_mod$fm1.nlme.cs.REML_var) expect_equal_nocheck(x3.REML, z3.REML, tolerance = 5e-4) ## Testing diag expect_equal_nocheck(c(as.matrix(VarCorr(fm1.diag)[[1]])), c(other_mod$fm1.glmmTMB.diag_var)) ## Testing ar1 expect_equal_nocheck(c(as.matrix(VarCorr(fm1.ar1)[[1]])), c(other_mod$fm1.glmmTMB.ar1_var)) ## glmer ## Similar to before; likelihoods are quite similar, so leaving these ## with a higher tolerance... expect_equal_nocheck(c(as.matrix(VarCorr(gm.us)[[1]])), c(other_mod$gm.glmmTMB_var), tolerance = 5e-4) expect_equal_nocheck(c(as.matrix(VarCorr(gm.cs)[[1]])), c(other_mod$gm.glmmTMB.cs_var), tolerance = 5e-4) expect_equal_nocheck(c(as.matrix(VarCorr(gm.us)[[1]])), c(other_mod$gm.glmmTMB_var), tolerance = 5e-4) }) test_that("integration tests for ranef", { ## Ensuring unstructured covariance results are the same as default expect_equal(ranef(fm1), ranef(fm1.us)) expect_equal(ranef(fm1.REML), ranef(fm1.us.REML)) expect_equal(ranef(gm), ranef(gm.us)) ## Ensuring extracting random modes of the random effects ## are consistent for lme4 against other packages expect_true(all.equal.nocheck(other_mod$fm1.glmmTMB_ranef$cond$Subject, ranef(fm1)$Subject)) expect_true(all.equal.nocheck(other_mod$fm1.glmmTMB.cs_ranef$cond$Subject, ranef(fm1.cs)$Subject)) expect_true(all.equal.nocheck(other_mod$fm1.glmmTMB.diag_ranef$cond$Subject, ranef(fm1.diag)$Subject)) expect_true(all.equal.nocheck(other_mod$fm1.glmmTMB.ar1_ranef$cond$Subject, ranef(fm1.ar1)$Subject)) expect_equal_nocheck(as.matrix(other_mod$fm1.nlme_ranef), as.matrix(ranef(fm1)$Subject)) expect_equal_nocheck(as.matrix(other_mod$fm1.nlme.REML_ranef), as.matrix(ranef(fm1.REML)$Subject)) expect_equal_nocheck(as.matrix(other_mod$fm1.nlme.cs_ranef), as.matrix(ranef(fm1.cs)$Subject)) expect_equal_nocheck(as.matrix(other_mod$fm1.nlme.cs.REML_ranef), as.matrix(ranef(fm1.cs.REML)$Subject)) ## glmer expect_true(all.equal.nocheck(other_mod$gm.glmmTMB_ranef$cond$district, ranef(gm.us)$district)) expect_true(all.equal.nocheck(other_mod$gm.glmmTMB.cs_ranef$cond$district, ranef(gm.cs)$district)) expect_true(all.equal.nocheck(other_mod$gm.glmmTMB.diag_ranef$cond$district, ranef(gm.diag)$district)) }) test_that("integration tests for predict", { ## Ensuring unstructured covariance results are the same as default expect_equal(predict(fm1), predict(fm1.us)) expect_equal(predict(fm1.REML), predict(fm1.us.REML)) expect_equal(predict(gm), predict(gm.us)) ## Ensuring extracting predictions are consistent for ## lme4 against other packages expect_equal_nocheck(other_mod$fm1.glmmTMB_predict, predict(fm1)) expect_equal_nocheck(other_mod$fm1.glmmTMB.cs_predict, predict(fm1.cs)) expect_equal_nocheck(other_mod$fm1.glmmTMB.diag_predict, predict(fm1.diag)) expect_equal_nocheck(other_mod$fm1.glmmTMB.ar1_predict, predict(fm1.ar1)) expect_equal_nocheck(other_mod$fm1.nlme_predict, predict(fm1)) expect_equal_nocheck(other_mod$fm1.nlme.REML_predict, predict(fm1.REML)) expect_equal_nocheck(other_mod$fm1.nlme.cs_predict, predict(fm1.cs)) expect_equal_nocheck(other_mod$fm1.nlme.cs.REML_predict, predict(fm1.cs.REML)) ## glmer expect_equal_nocheck(other_mod$gm.glmmTMB_predict, predict(gm.us)) expect_equal_nocheck(other_mod$gm.glmmTMB.cs_predict, predict(gm.cs)) expect_equal_nocheck(other_mod$gm.glmmTMB.diag_predict, predict(gm.diag)) }) simfun_gamma <- function(ngrp = 50, nrep = 50, shape_gam = 2, intercept = 1, theta_val = 2, seed = NULL) { if (!is.null(seed)) set.seed(seed) dd <- expand.grid(group = 1:ngrp, rep = 1:nrep) dd$y <- simulate(~ 1 + (1 | group), newdata = dd, family = Gamma(link = "log"), newparams = list( theta = theta_val, beta = 1, sigma = 1/sqrt(shape_gam)))[[1]] dd } simfun_pois <- function(ngrp = 50, nrep = 50, intercept = 1, theta_val = 1, seed = NULL) { if (!is.null(seed)) set.seed(seed) dd <- expand.grid(group = 1:ngrp, rep = 1:nrep) dd$y <- simulate(~ 1 + (1 | group), newdata = dd, family = poisson(link = "log"), newparams = list(theta = theta_val, beta = intercept))[[1]] dd } dd2 <- simfun_gamma(seed = 101) dd3 <- simfun_pois(seed = 101) glmer1 <- glmer(y ~ 1 + (1|group), family = Gamma(link = "log"), data = dd2) lme4_v1 <- VarCorr(glmer1)$group glmer2 <- glmer(y ~ 1 + (1|group), family = poisson(link = "log"), data = dd3) lme4_v2 <- VarCorr(glmer2)$group test_that("correct stdevs for glmm", { # high tolerance, but the numbers are relatively similar. expect_equal_nocheck(lme4_v1, other_mod$TMB_v1, tolerance = 1e-2) expect_equal_nocheck(attr(lme4_v1, 'stddev'), attr(other_mod$TMB_v1, 'stddev'), tolerance = 5e-3) expect_equal_nocheck(attr(lme4_v1, 'correlation'), attr(other_mod$TMB_v1, 'correlation')) }) test_that("'xst' length matches objective function argument length", { m <- glmer(incidence/size ~ 1 + ar1(0 + period | herd), weights = size, data = cbpp, family = binomial, control = glmerControl(check.nobs.vs.nRE = "ignore")) ## Error ....: length(xst <- as.numeric(xst)) == n is not TRUE expect_s4_class(m, "glmerMod") }) test_that("stop on unspecified sigma", { expect_error(simulate( ~ 1 + (1 | Subject), newdata = sleepstudy, newparams = list(beta = 0, theta = 1)), "must specify sigma") }) test_that("stop on unspecified sigma, two-sided formula + family=gaussian", { expect_error(simulate(Reaction ~ Days + (Days | Subject), newdata = sleepstudy, family = gaussian, newparams = list(beta = c(250, 10), theta = 1)), "must specify sigma") }) test_that("predict() on an already-fitted object may omit sigma from newparams", { ## unlike de novo simulation from a formula (above), setParams() ## should *not* require sigma when modifying an already-fitted ## object's parameters: the existing sigma is retained. This is ## relied upon by glmertree's internal backfitting, which calls ## predict(lme, newdata=data, newparams=list(beta=b)) without sigma. fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) b <- fixef(fm1) b[] <- 0 expect_no_error( suppressWarnings(suppressMessages( predict(fm1, newdata = sleepstudy, newparams = list(beta = b)) )) ) }) test_that("correct ordering of cov strucs", { set.seed(101) dd <- expand.grid(f1 = 1:10, f2 = 1:20, rep = 1:10) dd$f <- factor(sample(1:4, size = nrow(dd), replace = TRUE)) form <- y ~ 1 + cs(f | f1, hom = TRUE) + diag(f | f2) dd$y <- simulate( form[-2], newdata = dd, newparams = list(beta = 0, theta = rep(0.5, 11), sigma = 1))[[1]] fit <- lmer(form, data = dd) vv <- VarCorr(fit) expect_equal(class(vv[["f1"]]), c("vcmat_homcs", "matrix", "array")) expect_equal(class(vv[["f2"]]), c("vcmat_diag", "matrix", "array")) }) lme4/tests/testthat/test-covariance_glmer.R0000644000176200001440000000303315200407131020505 0ustar liggesusers(testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1) if (testLevel > 1) { ## read system file glmmTMB_glmer_ar1 <- readRDS( system.file("testdata", "glmmTMB_glmer_ar1_comparison.rds", package = "lme4") ) Contraception <- readRDS( system.file("testdata", "Contraception.rds", package = "lme4") ) test_that("glmer + ar1 does not return zero values for fixed effects coefficients", { ## Test 1; make sure the results match as expected form <- out_bin_1 ~ ftime + trt + ar1(ftime + 0 | id_cluster) + (1 | id_individual) dd <- glmmTMB_glmer_ar1$glmer_ar1_dd lme4_1 <- glmer(form, data = dd, family = binomial) thetas <- c(getReCovs(lme4_1)[[1]]@par, getReCovs(lme4_1)[[2]]@par) betas <- fixef(lme4_1) expect_equal_nocheck(c(thetas, betas), lme4_1@optinfo$val) ## Test 2; make sure we still have nonzero results form2 <- update(form, out_gauss ~ .) lme4_2 <- lmer(form2, data = dd, REML = FALSE) expect_true(!all(fixef(lme4_2) == 0.0)) ## Test 3; make sure ncol(X) matches beta gm.ar1_0 <- glmer(use ~ age + urban + ar1(0 + urban | district), data = Contraception, family = binomial) expect_equal(length(colnames(getME(gm.ar1_0, "X"))), length(getME(gm.ar1_0, "beta"))) }) } test_that("npar test works for models with 0 FE parameters", { expect_is(glmer(round(Reaction) ~ 0 + (1|Subject), family = poisson, data = sleepstudy), "merMod") }) lme4/tests/testthat/test-reformulas-import.R0000644000176200001440000000110415221217731020701 0ustar liggesusers## these tests may fail if run a second time in the same session, because of the once-per-session warning throttling f <- ~ 1 + (1|f) test_that("deprecation warnings from lme4 formula processing", { expect_warning(subbars(f), "has moved") expect_warning(nobars(f), "has moved") expect_warning(findbars(f), "has moved") expect_warning(mkReTrms(findbars(f), fr = data.frame(f = factor(1:10))), "has moved") expect_warning(expandDoubleVerts(f), "has moved") }) test_that("reOnly shims", { reo <- reOnly(Reaction ~ 1 + (1|Subject)) expect_equal(reo, ~(1 | Subject)) }) lme4/tests/testthat/test-formulaEval.R0000644000176200001440000001712315174671503017507 0ustar liggesusers#context("data= argument and formula evaluation") ## intercept context-dependent errors ... it's too bad that ## these errors differ between devtools::test() and ## R CMD check, but finding the difference is too much ## of a nightmare ## n.b. could break in other locales *if* we ever do internationalization ... data_RE <- "(bad 'data'|variable lengths differ)" test_that("glmerFormX", { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d <- data.frame(x,y,z,r) F <- "z" rF <- "(1|r)" modStr <- (paste("x ~", "y +", F, "+", rF)) modForm <- as.formula(modStr) ## WARNING: these drop/environment tests are extremely sensitive to environment ## they may fail/not fail, or fail differently, within a "testthat" environment vs. ## when run interactively expect_that(m_data.3 <- glmer( modStr , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.4 <- glmer( "x ~ y + z + (1|r)" , data=d, family="binomial"), is_a("glmerMod")) ## interactively: (interactive() is TRUE {i.e. doesn't behave as I would expect} within testing environment ... ## if (interactive()) { ## AICvec <- c(77.0516381151634, 75.0819116367084, 75.1915023640827) ## expect_equal(drop1(m_data.3)$AIC,AICvec) ## expect_equal(drop1(m_data.4)$AIC,AICvec) ## } else { ## in test environment [NOT test_ expect_error(drop1(m_data.3),data_RE) expect_error(drop1(m_data.4),data_RE) ##} }) test_that("glmerForm", { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d <- data.frame(x,y,z,r) F <- "z" rF <- "(1|r)" modStr <- (paste("x ~", "y +", F, "+", rF)) modForm <- as.formula(modStr) ## formulas have environments associated, but character vectors don't ## data argument not specified: ## should work, but documentation warns against it expect_that(m_nodata.0 <- glmer( x ~ y + z + (1|r) , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.1 <- glmer( as.formula(modStr) , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.2 <- glmer( modForm , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.3 <- glmer( modStr , family="binomial"), is_a("glmerMod")) expect_that(m_nodata.4 <- glmer( "x ~ y + z + (1|r)" , family="binomial"), is_a("glmerMod")) ## apply drop1 to all of these ... m_nodata_List <- list(m_nodata.0, m_nodata.1,m_nodata.2,m_nodata.3,m_nodata.4) d_nodata_List <- lapply(m_nodata_List,drop1) rm(list=c("x","y","z","r")) ## data argument specified expect_that(m_data.0 <- glmer( x ~ y + z + (1|r) , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.1 <- glmer( as.formula(modStr) , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.2 <- glmer( modForm , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.3 <- glmer( modStr , data=d, family="binomial"), is_a("glmerMod")) expect_that(m_data.4 <- glmer( "x ~ y + z + (1|r)" , data=d, family="binomial"), is_a("glmerMod")) ff <- function() { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) d2 <- data.frame(x,y,z,r) glmer( x ~ y + z + (1|r), data=d2, family="binomial") } m_data.5 <- ff() ff2 <- function() { set.seed(101) n <- 50 x <- rbinom(n, 1, 1/2) y <- rnorm(n) z <- rnorm(n) r <- sample(1:5, size=n, replace=TRUE) glmer( x ~ y + z + (1|r), family="binomial") } m_data.6 <- ff2() m_data_List <- list(m_data.0,m_data.1,m_data.2,m_data.3,m_data.4,m_data.5,m_data.6) badNums <- 4:5 d_data_List <- lapply(m_data_List[-badNums],drop1) ## these do NOT fail if there is a variable 'd' living in the global environment -- ## they DO fail in the testthat context expect_error(drop1(m_data.3),data_RE) expect_error(drop1(m_data.4),data_RE) ## expect_error(lapply(m_data_List[4],drop1)) ## expect_error(lapply(m_data_List[5],drop1)) ## d_data_List <- lapply(m_data_List,drop1,evalhack="parent") ## fails on element 1 ## d_data_List <- lapply(m_data_List,drop1,evalhack="formulaenv") ## fails on element 4 ## d_data_List <- lapply(m_data_List,drop1,evalhack="nulldata") ## succeeds ## drop1(m_data.5,evalhack="parent") ## 'd2' not found ## drop1(m_data.5,evalhack="nulldata") ## 'x' not found (d2 is in environment ...) ## should we try to make update smarter ... ?? ## test equivalence of (i vs i+1) for all models, all drop1() results for (i in 1:(length(m_nodata_List)-1)) { expect_equivalent(m_nodata_List[[i]],m_nodata_List[[i+1]]) expect_equivalent(d_nodata_List[[i]],d_nodata_List[[i+1]]) } expect_equivalent(m_nodata_List[[1]],m_data_List[[1]]) expect_equivalent(d_nodata_List[[1]],d_data_List[[1]]) for (i in 1:(length(m_data_List)-1)) { expect_equivalent(m_data_List[[i]],m_data_List[[i+1]]) } ## allow for dropped 'bad' vals for (i in 1:(length(d_data_List)-1)) { expect_equivalent(d_data_List[[i]],d_data_List[[i+1]]) } }) test_that("lmerForm", { set.seed(101) x <- rnorm(10) y <- rnorm(10) z <- rnorm(10) r <- sample(1:3, size=10, replace=TRUE) d <- data.frame(x,y,z,r) ## example from Joehanes Roeby m2 <- suppressWarnings(lmer(x ~ y + z + (1|r), data=d)) ff <- function() { m1 <- suppressWarnings(lmer(x ~ y + z + (1|r), data=d)) return(anova(m1)) } ff1 <- Reaction ~ Days + (Days|Subject) fm1 <- lmer(ff1, sleepstudy) fun <- function () { ff1 <- Reaction ~ Days + (Days|Subject) fm1 <- suppressWarnings(lmer(ff1, sleepstudy)) return (anova(fm1)) } anova(m2) ff() expect_equal(anova(m2),ff()) anova(fm1) fun() expect_equal(anova(fm1),fun()) }) test_that("lapply etc.", { ## copied from dplyr failwith <- function (default = NULL, f, quiet = FALSE) { function(...) { out <- default try(out <- f(...), silent = quiet) out } } lmer_fw <- failwith(NULL,function(...) lmer(...) ,quiet=TRUE) expect_is(lmer_fw(Yield ~ 1|Batch, Dyestuff, REML = FALSE), "merMod") ## GH 369 listOfFormulas <- list( cbind(incidence, size - incidence) ~ 1 + (1 | herd), cbind(incidence, size - incidence) ~ period + (1 | herd)) expect_is(lapply(listOfFormulas,glmer,family=binomial,data=cbpp),"list") }) test_that("formula and data validation work with do.call() in artificial environment", { ## This ensures compatibility of lmer when it's called from the ## C-level Rf_eval() with an environment that doesn't exist on the ## stack (i.e. C implementation in magrittr 2.0) e <- new.env() e$. <- mtcars expect_is( do.call(lme4::lmer, list("disp ~ (1 | cyl)", quote(.)), envir = e), "merMod" ) fn <- function(data) { lme4::lmer("disp ~ (1 | cyl)", data = data) } expect_is( do.call(fn, list(quote(.)), envir = e), "merMod" ) }) test_that("correct environment on reOnly()", { ## GH 654 f <- Reaction ~ Days + (1 | Subject) e <- environment(f) m <- lmer(f, data = sleepstudy) expect_identical(environment(formula(m)), e) # TRUE expect_identical(environment(formula(m, fixed.only = TRUE)), e) # TRUE expect_identical(ee <- environment(formula(m, random.only = TRUE)), e) # FALSE }) lme4/tests/testthat/test-debug.R0000644000176200001440000000573715174671503016330 0ustar liggesusers## Tests to prevent accidentally committing debugging statements. lme4_find_src_dir <- function() { pkg_dir <- find.package("lme4", quiet = TRUE) src_dir <- file.path(pkg_dir, "src") ## C++ source files are only present in the source tree, not the installed package if (length(list.files(src_dir, pattern = "\\.cpp$")) > 0L) src_dir else NULL } lme4_find_r_dir <- function() { pkg_dir <- find.package("lme4", quiet = TRUE) r_dir <- file.path(pkg_dir, "R") if (length(list.files(r_dir, pattern = "\\.R$")) > 0L) r_dir else NULL } test_that("no active debug flags in C++ source files", { src_dir <- lme4_find_src_dir() skip_if(is.null(src_dir), "C++ source files not available (skipping in installed package)") cpp_files <- list.files(src_dir, pattern = "\\.(cpp|h|hpp)$", full.names = TRUE) expect_gt(length(cpp_files), 0L) ## sanity check: we found files bad_lines <- character(0L) for (f in cpp_files) { lines <- readLines(f, warn = FALSE) ## Flag any line where a 'debug' variable is set to a non-zero value. ## Catches: int debug=1; debug = 2; debug=10; etc. ## Ignores: int debug=0; (safe — debug disabled) ## // debug=1; (single-line comment) ## /* debug=1; */ (block comment — line starts with '/', so ## the leading [^/]* anchor prevents a match) idx <- grep("^[^/]*\\bdebug\\s*=\\s*[1-9][0-9]*", lines) if (length(idx) > 0L) { bad_lines <- c(bad_lines, sprintf("%s:%d: %s", basename(f), idx, trimws(lines[idx]))) } } expect_length(bad_lines, 0L) }) test_that("lmer and glmer do not write to stdout", { out <- capture.output( suppressMessages( suppressWarnings({ fit_lmer <- lmer(Reaction ~ Days + (Days | Subject), data = sleepstudy) fit_glmer <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) invisible(list(fit_lmer, fit_glmer)) }) ) ) expect_length(out, 0L) }) test_that("no active debugging calls in R source files", { r_dir <- lme4_find_r_dir() skip_if(is.null(r_dir), "R source files not available (skipping in installed package)") r_files <- list.files(r_dir, pattern = "\\.R$", full.names = TRUE) expect_gt(length(r_files), 0L) ## sanity check: we found files bad_lines <- character(0L) for (f in r_files) { lines <- readLines(f, warn = FALSE) ## Flag browser() calls that are not commented out. ## Catches: browser() browser(expr = ...) idx <- grep("\\bbrowser\\s*\\(", lines) if (length(idx) > 0L) { bad_lines <- c(bad_lines, sprintf("%s:%d: %s", basename(f), idx, trimws(lines[idx]))) } } expect_length(bad_lines, 0L) }) lme4/tests/testthat/test-glmernbref.R0000644000176200001440000000117615127735433017357 0ustar liggesusers## DON'T load lme4; test is to see if glmer.nb works when ## lme4 is not loaded ## this does *not* work properly in a devtools::test environment ## (lme4 is not really detached) ## see tests/test-glmernbref.R for working test ... test_that("glmer.nb ref to glmer", { set.seed(101) dd <- data.frame(x=runif(200), f= rep(1:20, each=10)) b <- rnorm(20) dd <- transform(dd, y = rnbinom(200, mu = exp(1 + 2*x + b[f]), size = 2)) ## lme4 may not be attached if running tests via devtools::test() if ("package:lme4" %in% search()) detach("package:lme4") g <- lme4::glmer.nb(y~x + (1|f), data = dd) expect_is(g, "glmerMod") }) lme4/tests/testthat/test-eval.R0000644000176200001440000000451515127735433016163 0ustar liggesusers## examples for eval lookup testthat::skip_on_cran() data("cbpp", package = "lme4") if (require(car, quietly = TRUE)) { test_that("infIndexPlot env lookup OK", { fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ## silly test; the point is to see if this errors out with ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? ## Calls: infIndexPlot -> influence -> influence.merMod -> lapply -> FUN expect_equal(car::infIndexPlot(influence(fm1, "Subject")), NULL) }) } if (require(rr2, quietly = TRUE)) { test_that("rr2 env lookup OK", { ## Error under alternate eval lookup ## Error: bad 'data': object 'd' not found set.seed(123456) p1 <- 10; nsample <- 20; n <- p1 * nsample d <- data.frame(x1 = rnorm(n = n), x2 = rnorm(n = n), u1 = rep(1:p1, each = nsample), u2 = rep(1:p1, times = nsample)) d$u1 <- as.factor(d$u1); d$u2 <- as.factor(d$u2) ## LMM: y with random intercept b1 <- 1; b2 <- -1; sd1 <- 1.5 d$y_re_intercept <- b1 * d$x1 + b2 * d$x2 + rep(rnorm(n = p1, sd = sd1), each = nsample) + # random intercept u1 rep(rnorm(n = p1, sd = sd1), times = nsample) + # random intercept u2 rnorm(n = n) z.f2 <- lme4::lmer(y_re_intercept ~ x1 + x2 + (1 | u1) + (1 | u2), data = d, REML = T) ## NOTE, fails to produce warnings on second run of devtools::test() ## (possible interference from lmerTest methods being loaded ...?) expect_warning(R2(z.f2), "mod updated with REML = F") }) } ## semEff::VIF() is here being applied to a previously fitted lmer ## model (shipley.growth[[3]]) ## previous messing around with env evaluation had messed this up if (suppressWarnings(require(semEff))) { ## suppress warning about 'cov2cor' import replacement test_that("semEff env lookup OK", { ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? ## Calls: VIF ... update.merMod -> do.call -> lapply -> FUN -> as.list.environment m <- shipley.growth[[3]] expect_equal(VIF(m), c(Date = 6.06283840168881, DD = 6.07741017455859, lat = 1.01215136160858) ) }) } lme4/tests/testthat/test-methods.R0000644000176200001440000012505415221061066016666 0ustar liggesusers(testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1) ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) L <- load(system.file("testdata", "lme-tst-fits.rda", package="lme4", mustWork=TRUE)) nosingcheck_lmer <- lmerControl(check.conv.singular = "ignore") nosingcheck_glmer <- glmerControl(check.conv.singular = "ignore") ## FIXME: should test for old R versions, skip reloading test data in that ## case? fm0 <- fit_sleepstudy_0 fm1 <- fit_sleepstudy_1 fm2 <- fit_sleepstudy_2 gm1 <- fit_cbpp_1 gm2 <- fit_cbpp_2 gm3 <- fit_cbpp_3 ## More objects to use in all contexts : set.seed(101) dNA <- data.frame( xfac= sample(letters[1:10], 100, replace=TRUE), xcov= runif(100), resp= rnorm(100)) dNA[sample(1:100, 10), "xcov"] <- NA CI.boot <- function(fm, nsim=10, seed=101, ...) { suppressMessages( suppressWarnings(confint(fm, method="boot", nsim=nsim, quiet=TRUE, seed=seed, ...)) ) } ## rSimple <- function(rep = 2, m.u = 2, kinds = c('fun', 'boring', 'meh')) { stopifnot(is.numeric(rep), rep >= 1, is.numeric(m.u), m.u >= 1, is.character(kinds), (nk <- length(kinds)) >= 1) nobs <- rep * m.u * nk data.frame(kind= rep(kinds, each=rep*m.u), unit = gl(m.u, 1, nobs), y = round(50*rnorm(nobs))) } d12 <- rSimple() data("Pixel", package="nlme") nPix <- nrow(Pixel) fmPix <- lmer(pixel ~ day + I(day^2) + (day | Dog) + (1 | Side/Dog), data = Pixel) test_that("summary", { ## test for multiple-correlation-warning bug and other 'correlation = *' variants ## Have 2 summary() versions, each with 3 print(.) ==> 6 x capture.output(.) sf.aa <- summary(fit_agridat_archbold) msg1 <- "Correlation.* not shown by default" ## message => *not* part of capture.*(.) expect_message(c1 <- capture.output(sf.aa), msg1) # correlation = NULL - default cF <- capture.output(print(sf.aa, correlation=FALSE)) ## TODO? ensure the above gives *no* message/warning/error expect_identical(c1, cF) expect_message( cT <- capture.output(print(sf.aa, correlation=TRUE)) , "Correlation.* could have been required in summary()") expect_identical(cF, cT[seq_along(cF)]) sfT.aa <- summary(fit_agridat_archbold, correlation=TRUE) ## no message any more ## expect_message(cT2 <- capture.output(sfT.aa), msg1) ## expect_identical(cF, cT2) cT3 <- capture.output(print(sfT.aa, correlation=TRUE)) expect_identical(cT, cT3) cF2 <- capture.output(print(sfT.aa, correlation=FALSE)) expect_identical(cF, cF2) }) test_that("lmer anova", { aa <- suppressMessages(anova(fm0,fm1)) expect_that(aa, is_a("anova")) expect_equal(names(aa), c("npar", "AIC", "BIC", "logLik", "-2*log(L)", "Chisq", "Df", "Pr(>Chisq)")) expect_warning(suppressMessages(do.call(anova,list(fm0,fm1))), "assigning generic names") ## dat <- data.frame(y = 1:5, u = c(rep("A",2), rep("B",3)), t = c(rep("A",3), rep("B",2))) datfun <- function(x) dat aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa <- dat expect_is(stats::anova(lmer(y ~ u + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), lmer(y ~ 1 + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE)), "anova") expect_equal(rownames(stats::anova(lmer(y ~ u + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), lmer(y ~ 1 + (1 | t), dat = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, REML=FALSE), model.names=c("a","b"))), c("b","a")) ff <- function(form) { lmer(form, dat=dat, REML=FALSE, control=nosingcheck_lmer) } expect_error(rownames(stats::anova(ff(y ~ u + (1 | t)), ff(y ~ 1 + (1 | t)), model.names=c("a","b","c"))), "different lengths") z <- 1 ## output not tested (but shouldn't fail) ss <- stats::anova(lmer(y ~ u + (1 | t), data = datfun(z), REML=FALSE), lmer(y ~ 1 + (1 | t), data = datfun(z), REML=FALSE)) ## ## from Roger Mundry via Roman Lustrik full <- lmer(resp ~ xcov + (1|xfac), data=dNA) null <- lmer(resp ~ 1 + (1|xfac), data=dNA) expect_error(anova(null,full), "models were not all fitted to the same size of dataset") }) if (requireNamespace("merDeriv")) { test_that("summary with merDeriv", { library(merDeriv) cc <- capture.output(print(summary(fm1))) expect_true(any(grepl("Correlation of Fixed Effects", cc))) ## WARNING, this will detach package but may not undo ## method loading ... detach("package:merDeriv") }) } ## Github issue #256 from Jonas Lindeløv -- issue is *not* specific for this dataset test_that("Two models with subset() within lmer()", { full3 <- lmer(y ~ kind + (1|unit), subset(d12, kind != 'boring'), REML=FALSE) null3 <- update(full3, .~. - kind) op <- options(warn = 2) # no warnings! ano3 <- anova(full3, null3)## issue #256: had warning in data != data[[1]] : ... o3 <- capture.output(ano3) # now prints with only one 'Data:' expect_equal(1, grep("^Data:", o3)) d12sub <- subset(d12, kind != 'boring') expect_is(full3s <- lmer(y ~ kind + (1|unit), d12sub, REML=FALSE), "lmerMod") expect_is(null3s <- update(full3s, .~. - kind), "lmerMod") expect_is(ano3s <- anova(full3s, null3s), "anova") expect_equal(ano3, ano3s, check.attributes=FALSE) options(op) }) test_that("anova() of glmer+glm models", { dat <<- data.frame(y = 1:5, u = c(rep("A",2), rep("B",3)), t = c(rep("A",3), rep("B",2))) cs <- glmerControl(check.conv.singular = "ignore") ## ignore singular fits gm1 <- glmer(y~(1|u), data=dat[1:4,], family=poisson, control = cs) gm0 <- glm(y~1, data=dat[1:4,], family=poisson) gm2 <- glmer(y~(1|u), data=dat[1:4,], family=poisson,nAGQ=2, control = cs) aa <- anova(gm1,gm0) expect_equal(aa[2,"Chisq"],0) expect_error(anova(gm2,gm0),"incommensurate") }) test_that("anova() of lmer+glm models", { dat2 <- dat set.seed(101) dat2$y <- rnorm(5) fm1 <- lmer(y~(1|u),data=dat2,REML=FALSE) fm0 <- lm(y~1,data=dat2) aa2 <- anova(fm1,fm0) expect_equal(aa2[2,"Chisq"],0) expect_warning(anova(fm1,type="III"),"additional arguments ignored") }) test_that("set p-values to NA for equivalent models: #583", { fm0B <- fm0 aa <- suppressMessages(anova(fm0B,fm0)) expect_true(all(is.na(aa[["Pr(>Chisq)"]]))) }) test_that("long names", { ## GH names(sleepstudy) <- c("Reaction", "Days", "Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx") fm1 <- lmer(Reaction ~ Days + (Days | Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx), sleepstudy) fm2 <- lmer(Reaction ~ Days + (Days || Subject_xxxxxxxxxxxxxxxxxxxxxxxxxxx), sleepstudy) expect_equal(length(attributes(suppressMessages(anova(fm1,fm2)))$heading),4) }) if (testLevel>1) { #context("bootMer confint()") set.seed(47) test_that("bootMer", { ## testing bug-fix for ordering of sd/cor components in sd/cor matrix with >2 rows dd <- expand.grid(A=factor(1:3), B=factor(1:10), rep=1:20) dd$y <- suppressMessages(simulate(~1 + (A|B), newdata=dd, newparams=list(beta=1,theta=rep(1,6), sigma=1), family=gaussian, seed=101))[[1]] m1 <- lmer(y ~ 1 + (A|B), data=dd, control=lmerControl(calc.deriv=FALSE)) ci <- CI.boot(m1, seed=101, signames = FALSE) ci2 <- CI.boot(m1, seed = 101, signames = FALSE) expect_equal(ci, ci2) ci_50 <- CI.boot(m1,level=0.5,seed=101) expect_true(all(ci_50[,"25 %"]>ci[,"2.5 %"])) expect_true(all(ci_50[,"75 %"]1 test_that("change in deviance name for anova", { cc <- suppressMessages(capture.output(anova(fm0,fm1))) expect_identical(sum(grepl("deviance", cc)), 0L) expect_identical(sum(grepl("-2*log(L)", cc, fixed = TRUE)), 1L) }) test_that("confint", { load(system.file("testdata", "gotway_hessianfly.rda", package = "lme4")) ## generated via: ## gotway_hessianfly_fit <- glmer(cbind(y, n-y) ~ gen + (1|block), ## data=gotway.hessianfly, family=binomial, ## control=glmerControl(check.nlev.gtreq.5="ignore")) ## gotway_hessianfly_prof <- profile(gotway_hessianfly_fit,which=1) ## save(list=ls(pattern="gotway"),file="gotway_hessianfly.rda") expect_equal(confint(gotway_hessianfly_prof)[1,1],0) ## FIXME: should add tests for {-1,1} bounds on correlations as well expect_equal(c(confint(fm1,method="Wald",parm="beta_")), c(232.301892,8.891041,270.508318,12.043531), tolerance=1e-5) ## Wald gives NA for theta values expect_true(all(is.na(confint(fm1,method="Wald",parm="theta_")))) ## check names ci1.p <- suppressWarnings(confint(fm1,quiet=TRUE)) ci1.w <- confint(fm1,method="Wald") ci1.b <- CI.boot(fm1, nsim=2) expect_equal(dimnames(ci1.p), list(c(".sig01", ".sigma", "(Intercept)", "Days"), c("2.5 %", "97.5 %"))) expect_equal(dimnames(ci1.p),dimnames(ci1.w)) expect_equal(dimnames(ci1.p),dimnames(ci1.b)) ci1.p.n <- suppressWarnings(confint(fm1, quiet=TRUE, signames=FALSE)) ci1.w.n <- confint(fm1, method="Wald", signames=FALSE) ci1.b.n <- CI.boot(fm1, nsim=2, signames=FALSE) expect_equal(dimnames(ci1.p.n), list(c("sd_(Intercept)|Subject", "sigma", "(Intercept)", "Days"), c("2.5 %", "97.5 %"))) expect_equal(dimnames(ci1.p.n),dimnames(ci1.w.n)) expect_equal(dimnames(ci1.p.n),dimnames(ci1.b.n)) }) test_that("monotonic profile but bad spline", { ## doesn't produce warnings on Solaris, or win-builder, or M1mac ... skip_on_os("windows") skip_on_os("solaris") skip_on_os("mac", arch = "aarch64") ## test case of slightly wonky (spline fit fails) but monotonic profiles: ## simfun <- function(J,n_j,g00,g10,g01,g11,sig2_0,sig01,sig2_1){ N <- sum(rep(n_j,J)) x <- rnorm(N) z <- rnorm(J) mu <- c(0,0) sig <- matrix(c(sig2_0,sig01,sig01,sig2_1),ncol=2) u <- MASS::mvrnorm(J,mu=mu,Sigma=sig) b_0j <- g00 + g01*z + u[,1] b_1j <- g10 + g11*z + u[,2] y <- rep(b_0j,each=n_j)+rep(b_1j,each=n_j)*x + rnorm(N,0,sqrt(0.5)) sim_data <- data.frame(Y=y,X=x,Z=rep(z,each=n_j), group=rep(1:J,each=n_j)) } set.seed(102) dat <- simfun(10,5,1,.3,.3,.3,(1/18),0,(1/18)) fit <- lmer(Y~X+Z+X:Z+(X||group),data=dat, control = lmerControl(check.conv.singular = "ignore")) expect_warning(pp <- profile(fit,"theta_"), "non-monotonic profile") expect_warning(cc <- confint(pp),"falling back to linear interpolation") ## very small/unstable problem, needs large tolerance expect_equal(unname(cc[2,]), c(0, 0.509), tolerance=0.09) # "bobyqa" had 0.54276 }) test_that("confint with bad profile", { badprof <- readRDS(system.file("testdata","badprof.rds", package="lme4")) expect_warning(cc <- confint(badprof), "falling back to linear") expect_equal(cc, array(c(0, -1, 2.50856219044636, 48.8305727797906, NA, NA, 33.1204478717389, 1, 7.33374326592662, 68.7254711217912, -6.90462047196017, NA), dim = c(6L, 2L), dimnames = list(c(".sig01", ".sig02", ".sig03", ".sigma", "(Intercept)", "cYear"), c("2.5 %", "97.5 %"))), tolerance=1e-3) }) test_that("refit", { s1 <- simulate(fm1) expect_is(refit(fm1,s1), "merMod") s2 <- simulate(fm1,2) expect_error(refit(fm1,s2), "refit not implemented .* lists") data(Orthodont,package = "nlme") fmOrth <- fm <- lmer(distance ~ I(age - 11) + (I(age - 11) | Subject), data = Orthodont) expect_equal(s1 <- simulate(fm,newdata = Orthodont,seed = 101), s2 <- simulate(fm,seed = 101)) ## works *without* offset ... m5 <- glmer(round(Reaction) ~ Days + (1|Subject), data = sleepstudy, family=poisson, offset=rep(0,nrow(sleepstudy))) m5R <- refit(m5) ## lots of fussy details make expect_equal() on the whole object difficult expect_equal(coef(m5),coef(m5R),tolerance=3e-6) expect_equal(VarCorr(m5),VarCorr(m5R),tolerance=1e-6) expect_equal(logLik(m5),logLik(m5R)) }) test_that("refit GLMM with multiple RE no length-mismatch warning (GH #975)", { ## upper bound vector was not extended for fixed effects when n_RE > 1, ## causing recycling warning in checkConv when n_beta %% n_theta != 0 cbpp2 <- transform(cbpp, prop = incidence/size, obs = factor(seq(nrow(cbpp)))) m <- glmer(prop ~ herd + (1|period) + (1|obs), weights = size, family = binomial, data = cbpp2, control = glmerControl(calc.derivs = FALSE)) expect_no_warning(refit(m, newresp = cbpp2$prop), message = "not a multiple") }) if (testLevel>1) { #context("predict method") test_that("predict", { ## when running via source(), cbpp has been corrupted at this point ## (replaced by a single empty factor obs() d1 <- expand.grid(period = unique(cbpp$period), herd = unique(cbpp$herd)) d2 <- data.frame(period = "1", herd = unique(cbpp$herd)) d3 <- expand.grid(period = as.character(1:3), herd = unique(cbpp$herd)) p0 <- predict(gm1) p1 <- predict(gm1,d1) p2 <- predict(gm1,d2) p3 <- predict(gm1,d3) expect_equal(p0[1], p1[1]) expect_equal(p0[1], p2[1]) expect_equal(p0[1], p3[1]) expect_error(predict(gm1, ReForm=NA)) ## matrix-valued predictors: Github #201 from Fabian S. sleepstudy$X <- cbind(1, sleepstudy$Days) m <- lmer(Reaction ~ -1 + X + (Days | Subject), sleepstudy) pm <- predict(m, newdata=sleepstudy) expect_is(pm, "numeric") expect_equal(quantile(pm, names = FALSE), c(211.0108, 260.9496, 296.873, 328.6378, 458.1584), tol=1e-5) op <- options(warn = 2) # there should be no warnings! if (require("MEMSS",quietly=TRUE)) { ## test spurious warning with factor as response variable data("Orthodont", package = "MEMSS") # (differently "coded" from the 'default' "nlme" one) silly <- glmer(Sex ~ distance + (1|Subject), data = Orthodont, family = binomial) sillypred <- data.frame(distance = c(20, 25)) ps <- predict(silly, sillypred, re.form=NA, type = "response") expect_is(ps, "numeric") expect_equal(unname(ps), c(0.999989632, 0.999997201), tolerance=1e-6) detach("package:MEMSS") } ## a case with interactions (failed in one temporary version): expect_warning(fmPixS <<- update(fmPix, .~. + Side), "nearly unidentifiable|unable to evaluate scaled gradient|failed to converge") ## (1|2|3); 2 and 3 seen (as Error??) on CRAN's Windows 32bit options(op) set.seed(1); ii <- sample(nrow(Pixel), 16) expect_equal(predict(fmPix, newdata = Pixel[ii,]), fitted(fmPix )[ii]) expect_equal(predict(fmPixS, newdata = Pixel[ii,]), fitted(fmPixS)[ii]) set.seed(7); n <- 100; y <- rnorm(n) dd <- data.frame(id = factor(sample(10, n, replace = TRUE)), x1 = 1, y = y, x2 = rnorm(n, mean = sign(y))) expect_message(m <- lmer(y ~ x1 + x2 + (1 | id), data = dd), "fixed-effect model matrix is rank deficient") expect_is(summary(m),"summary.merMod") ii <- sample(n, 16) expect_equal(predict(m, newdata = dd[ii,]), fitted(m)[ii]) ## predict(*, new..) gave Error in X %*% fixef(object) - now also drops col. ## predict(*, new..) with NA in data {and non-simple model}, issue #246: m1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) sleepst.NA <- sleepstudy ; sleepst.NA$Days[2] <- NA m2 <- update(fm1, data = sleepst.NA) ## maybe tricky for evaluation; fm1 was defined elsewhere, so data expect_equal(length(predict(m2, sleepst.NA[1:4,])),4) ## Wrong 'b' constructed in mkNewReTrms() -- issue #257 data(Orthodont,package="nlme") Orthodont <- within(Orthodont, nsex <- as.numeric(Sex == "Male")) m3 <- lmer(distance ~ age + (age|Subject) + (0 + Sex |Subject), data=Orthodont, control=lmerControl(check.conv.hess="ignore", check.conv.grad="ignore")) m4 <- lmer(distance ~ age + (age|Subject) + (0 + nsex|Subject), data=Orthodont) expect_equal(p3 <- predict(m3, Orthodont), fitted(m3), tolerance=1e-14) expect_equal(p4 <- predict(m4, Orthodont), fitted(m4), tolerance=1e-14) ## related to GH #275 (*passes*), ss <- sleepstudy set.seed(1) ss$noiseChar <- ifelse(runif(nrow(sleepstudy)) > 0.8, "Yes", "No") ss$noiseFactor <- factor(ss$noiseChar) fm4 <- lmer(Reaction ~ Days + noiseChar + (Days | Subject), ss) expect_equal(predict(fm4, newdata = model.frame(fm4)[2:3, ])[2], predict(fm4, newdata = model.frame(fm4)[3, ])) fm3 <- lmer(Reaction ~ Days + noiseFactor + (Days | Subject), ss) expect_equal(predict(fm3, newdata = model.frame(fm3)[2:3, ])[2], predict(fm3, newdata = model.frame(fm3)[3, ])) ## complex-basis functions in RANDOM effect fm5 <- lmer(Reaction~Days+(poly(Days,2)|Subject),sleepstudy) expect_equal(predict(fm5,sleepstudy[1,]),fitted(fm5)[1]) ## complex-basis functions in FIXED effect fm6 <- lmer(Reaction~poly(Days,2)+(1|Subject),sleepstudy) expect_equal(predict(fm6,sleepstudy[1,]),fitted(fm6)[1]) ## GH #414: no warning about dropping contrasts on random effects op <- options(warn = 2) # there should be no warnings! set.seed(1) dat <- data.frame( fac = factor(rep(c("a", "b"), 100)), grp = rep(1:25, each = 4)) dat$y <- 0 contr <- 0.5 * contr.sum(2) rownames(contr) <- c("a", "b") colnames(contr) <- "a" contrasts(dat$fac) <- contr m1_contr <- lmer(y~fac+(fac|grp),dat) pp <- predict(m1_contr,newdata=dat) options(op) }) ## testLevel>1 test_that("simulate", { ## simulate() will look for data in environment of formula, find ## unmodified version of cbpp -- need to re-add observation-level factor. ## ee is .GlobalEnv; ee$cbpp$obs<-... would create a corrupted list in ## .GlobalEnv shadowing lme4's cbpp, breaking later tests. ## Fix: assign a proper data frame with obs added, restore on exit. ee <- environment(formula(gm2)) on.exit(rm(list = intersect("cbpp", ls(envir = ee)), envir = ee), add = TRUE) ee$cbpp <- transform(cbpp, obs = factor(seq(nrow(cbpp)))) expect_is(simulate(gm2), "data.frame") p1 <- simulate(gm2, re.form = NULL, seed = 101) p2 <- simulate(gm2, re.form = ~0, seed = 101) p3 <- simulate(gm2, re.form = NA, seed = 101) p4 <- simulate(gm2, re.form = NULL, seed = 101) ## p5 was: sim with ReForm p6 <- simulate(gm2, re.form = NA, seed = 101) ## p7 was: sim with ReForm p8 <- simulate(gm2, re.form = ~0, seed = 101) p9 <- simulate(gm2, re.form = NA, seed = 101) p10 <- simulate(gm2,use.u = FALSE, seed = 101) p11 <- simulate(gm2,use.u = TRUE, seed = 101) ## minimal check of content: expect_identical(colSums(p1[,1]), c(incidence = 95, 747)) expect_identical(colSums(p2[,1]), c(incidence = 109, 733)) ## equivalences: ## group ~0: expect_equal(p2,p3) expect_equal(p2,p6) expect_equal(p2,p8) expect_equal(p2,p9) expect_equal(p2,p10) ## group 1: expect_equal(p1,p4) expect_equal(p1,p11) expect_error(simulate(gm2,use.u = TRUE, re.form = NA), "should specify only one") ## ## hack: test with three REs p1 <- lmer(diameter ~ (1|plate) + (1|plate) + (1|sample), Penicillin, control = lmerControl(check.conv.hess = "ignore", check.conv.grad = "ignore")) expect_is(sp1 <- simulate(p1, seed=123), "data.frame") expect_identical(dim(sp1), c(nrow(Penicillin), 1L)) expect_equal(fivenum(sp1[,1]), c(20.864, 22.587, 23.616, 24.756, 28.599), tolerance=0.01) ## Pixel example expect_identical(dim(simulate(fmPixS)), c(nPix, 1L)) expect_identical(dim(simulate(fmPix )), c(nPix, 1L)) ## simulation with newdata smaller/larger different from original fm <- lmer(diameter ~ 1 + (1|plate) + (1|sample), Penicillin) expect_is(simulate(fm,newdata=Penicillin[1:10,],allow.new.levels=TRUE),"data.frame") expect_is(simulate(fm,newdata=do.call(rbind,replicate(4,Penicillin,simplify=FALSE))),"data.frame") ## negative binomial sims set.seed(101) dd <- data.frame(f=factor(rep(1:10,each=20)), x=runif(200), y=rnbinom(200,size=2,mu=2)) g1 <- glmer.nb(y ~ x + (1|f), data=dd) th.g1 <- getME(g1, "glmer.nb.theta") ## changed to setting seed internally ts1 <- table(s1 <- simulate(g1,seed=101)[,1]) ## ts1B <- table(s1 <- simulate(g1,seed=101)[,1]) expect_equal(fixef(g1), c("(Intercept)" = 0.630067, x = -0.0167248), tolerance = 1e-4) ## ?? Travis is getting hung up here/ignoring tolerance spec?? expect_equal(th.g1, 2.013, tolerance = 1e-4) expect_equal(th.g1, g1@call$family[["theta"]])# <- important for pkg{effects} eval() expect_identical(sum(s1), 413) expect_identical(as.vector(ts1[as.character(0:5)]), ## c(51L, 54L, 36L, 21L, 14L, 9L)) c(49L,56L,32L,25L,11L,9L)) ## de novo NB simulation ... s2 <- simulate(~x + (1|f),seed=101, family=MASS::negative.binomial(theta=th.g1), newparams=getME(g1,c("theta","beta")), newdata=dd)[,1] expect_equal(s1,s2) ## Simulate with newdata with *new* RE levels: d <- sleepstudy[-1] # droping the response ("Reaction") ## d$Subject <- factor(rep(1:18, each=10)) ## Add 18 new subjects: d <- rbind(d, d) d$Subject <- factor(rep(1:36, each=10)) d$simulated <- simulate(fm1, seed=1, newdata = d, re.form=NULL, allow.new.levels = TRUE)[,1] expect_equal(mean(d$simulated), 299.9384608) ## Simulate with weights: newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) ss <- simulate(gm1, newdata=newdata[1:3,], weights=20, seed=101)[[1]] expect_equal(ss, matrix(c(4,2,0,16,18,20),nrow=3, dimnames=list(NULL,c("incidence","")))) ss <- simulate(gm3, newdata=newdata[1:3,], weights=20, seed=101)[[1]] expect_equal(ss,c(0.2,0.1,0.0)) ss <- simulate(gm1, newdata=newdata[1,], weights=20, seed=101)[[1]] expect_equal(unname(ss),matrix(c(4,16),nrow=1)) ## simulate Gamma, from function and de novo set.seed(102) dd <- data.frame(x=rep(seq(-2,2,length=15),10), f=factor(rep(1:10,each=15))) u <- rnorm(10) dd$y <- with(dd, rgamma(nrow(dd),shape=2, scale=exp(2+1*x+u[as.numeric(f)])/2)) g1 <- glmer(y~x+(1|f),family=Gamma(link="log"),dd) s1 <- simulate(g1,seed=101) s2 <- suppressMessages(simulate(~x+(1|f), family=Gamma(link="log"), seed=101, newdata=dd, newparams=getME(g1,c("theta","beta","sigma")))) expect_equal(s1, s2) dd$y2 <- s2[[1]] g2 <- glmer(y2~x+(1|f), family=Gamma(link="log"),dd) expect_equal(fixef(g2), tolerance = 4e-7, # 32-bit windows showed 1.34e-7 c(`(Intercept)` = 2.90871404438183, x = 0.988265230798941)) ## c("(Intercept)" = 2.81887136759369, x= 1.06543222163626)) ## simulate with re.form = NULL and derived/offset components in formula fm7 <- lmer(Reaction ~ Days + offset(Days) + (1|Subject), sleepstudy) s7 <- simulate(fm7, seed = 101, re.form = NULL) ## thought this would break but it doesn't ??? f_wrap <- function() { Reaction ~ Days + offset(Days) + (1|Subject) } fm8 <- lmer(f_wrap(), sleepstudy) s8 <- simulate(fm8, seed = 101, re.form = NULL) expect_identical(s7, s8) ## harder: insert NA values in the offset and see if it handles this OK?? }) #context("misc") test_that("misc", { expect_equal(df.residual(fm1),176) if (suppressWarnings(require(ggplot2))) { ## ggplot calls sample() [for silly start-up messages ## throws warning because we're using backward-compatible RNGkind expect_is(fortify.merMod(fm1), "data.frame") expect_is(fortify.merMod(gm1), "data.frame") } expect_is(as.data.frame(VarCorr(fm1)), "data.frame") }) } ## testLevel>1 #context("plot") test_that("plot", { ## test getData() within plot function: reported by Dieter Menne doFit <- function(){ data(Orthodont,package = "nlme") data1 <- Orthodont lmer(distance ~ age + (age|Subject), data = data1) } data(Orthodont, package = "nlme") fm0 <- lmer(distance ~ age + (age|Subject), data = Orthodont) expect_is(plot(fm0), "trellis") suppressWarnings(rm("Orthodont")) fm <- doFit() pp <- plot(fm, resid(., scaled = TRUE) ~ fitted(.) | Sex, abline = 0) expect_is(pp, "trellis") ## test qqmath/getIDLabels() expect_is(q1 <- lattice::qqmath(fm,id=0.05),"trellis") }) ## GH#808: getData.merMod should give informative errors when the data object ## cannot be retrieved from the formula environment test_that("getData gives informative errors (GH#808)", { form <- Reaction ~ Days + (1|Subject) ## case 1: data name not found (object lives only in the function's local env) fit_notfound <- local({ dd <- sleepstudy lmer(form, data = dd) }) expect_error(getData(fit_notfound), "not found.*re-load it into the current environment", perl = TRUE) ## case 2: name resolves to wrong type (shadows a built-in, e.g. 'data') fit_masked <- local({ data <- sleepstudy # shadows utils::data lmer(form, data = data) }) expect_error(getData(fit_masked), "is not a data frame or matrix.*masked by a built-in", perl = TRUE) }) test_that("plot (continued)", { cake2 <- transform(cake,replicate=as.numeric(replicate), recipe=as.numeric(recipe)) fm2 <- lmer(angle ~ recipe + temp + (1|recipe:replicate), cake2, REML= FALSE) expect_is(lattice::qqmath(fm2, id=0.05), "trellis") expect_is(lattice::qqmath(fm2, id=0.05, idLabels=~recipe), "trellis") expect_warning(lattice::qqmath(fm2, 0.05, ~recipe), "please specify") expect_warning(lattice::qqmath(fm2, 0.05), "please specify") }) #context("misc") test_that("summary", { ## test that family() works when $family element is weird ## FIXME: is convergence warning here a false positive? gnb <- suppressWarnings(glmer(TICKS~1+(1|BROOD), family=MASS::negative.binomial(theta=2), data=grouseticks)) expect_is(family(gnb),"family") }) test_that("profile with switched optimizer does not warn (GH #913)", { ## fm1 was fit with the default optimizer (nloptwrap); profiling with a ## different optimizer must not pass nloptwrap's stored control args (e.g. ## 'print_level') to the new optimizer, which would warn "unused control ## arguments ignored". expect_no_warning(profile(fm1, which = 1, optimizer = "bobyqa")) }) if (testLevel>1) { #context("profile") test_that("profile", { ## FIXME: can we deal with convergence warning messages here ... ? ## fit profile on default sd/cor scale ... p1 <- suppressWarnings(profile(fm1,which="theta_")) ## and now on var/cov scale ... p2 <- suppressWarnings(profile(fm1,which="theta_", prof.scale="varcov")) ## because there are no correlations, squaring the sd results ## gives the same result as profiling on the variance scale ## in the first place expect_equal(confint(p1)^2,confint(p2), tolerance=1e-5) ## or via built-in varianceProf() function expect_equal(unname(confint(varianceProf(p1))), unname(confint(p2)), tolerance=1e-5) s_inds <- c(1,2,4) ## variance terms p3 <- profile(fm2, which=s_inds) p4 <- suppressWarnings(profile(fm2, which = "theta_", prof.scale="varcov", signames=FALSE)) ## compare only for sd/var components, not corr component ## FAILS on r-patched-solaris-x86 2018-03-30 ??? ## 2/6 mismatches (average diff: 4.62) ## [1] 207 - 216 == -9.23697 ## [4] 1422 - 1422 == -0.00301 if (Sys.info()["sysname"] != "SunOS") { expect_equal(unname(confint(p3)^2), unname(confint(p4)[s_inds,]), tolerance=5e-3) } ## check naming convention properly adjusted expect_equal(as.character(unique(p4$.par)), c("var_(Intercept)|Subject", "var_Days|Subject", "cov_Days.(Intercept)|Subject", "sigma")) }) test_that("profile name/value order consistency", ## can use parallel comp since testLevel > 1, won't ## be tried on CRAN ## use snow instead of multicore for Windows safety { ## GitHub actions complains about >2 cores ... pp <- profile(fm2, parallel = "snow", ncpus = 2, signames = FALSE) ci_pp <- confint(pp) expect_all_true(abs(ci_pp["cor_Days.(Intercept)|Subject",]) < 1) ci_bb <- suppressWarnings( suppressMessages( confint(fm2, method = "boot", nsim = 10, signames = FALSE) )) expect_all_true(abs(ci_bb["cor_Days.(Intercept)|Subject",]) <= 1) }) test_that("densityplot is robust", { p <- readRDS(system.file("testdata","harmel_profile.rds", package="lme4")) expect_warning(lattice::densityplot(p), "unreliable profiles for some variables") }) } ## testLevel>1 #context("model.frame") test_that("model.frame", { ## non-syntactic names d <- sleepstudy names(d)[1] <- "Reaction Time" ee <- function(m,nm) { expect_equal(names(model.frame(m, fixed.only=TRUE)),nm) } m <- lmer(Reaction ~ 1 + (1 | Subject), sleepstudy) ee(m,"Reaction") m2 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy) ee(m2,c("Reaction","Days")) m3 <- lmer(`Reaction Time` ~ Days + (1 | Subject), d) ee(m3, c("Reaction Time","Days")) m4 <- lmer(Reaction ~ log(1+Days) + (1 | Subject), sleepstudy) ee(m4, c("Reaction","log(1 + Days)")) }) #context("influence measures") d <- as.data.frame(ChickWeight) colnames(d) <- c("y", "x", "subj", "tx") dNAs <- d dNAs$y[c(1, 3, 5)] <- NA fitNAs <- lmer(y ~ tx*x + (x | subj), data = dNAs, na.action=na.exclude) test_that("influence/hatvalues works", { ifm1 <- influence(fm1, do.coef=FALSE) expect_equal(unname(head(ifm1$hat)), c(0.107483311203734, 0.102096105816528, 0.0980557017761242, 0.0953620990825215, 0.0940152977357202, 0.0940152977357202), tolerance=1e-6) expect_equal(nrow(dNAs),length(hatvalues(fitNAs))) }) test_that("influence OK with tibbles", { if (requireNamespace("tibble")) { ## make small data set/example so influence() isn't too slow ... ss <- tibble::as_tibble(sleepstudy[1:60,]) smallfit <- lmer(Reaction ~ 1 + (1 | Subject), data = ss) i1 <- influence(smallfit, ncpus = 1) expect_equal(head(i1[["fixed.effects[-case]"]]), structure(c(286.35044481665, 286.179896199062, 286.327301507498, 285.014692121823, 284.36060419176, 283.297551183126), dim = c(6L, 1L), dimnames = list(c("1", "2", "3", "4", "5", "6"), "(Intercept)")), tolerance = 1e-6) } }) test_that("rstudent", { rfm1 <- rstudent(fm1) expect_equal(unname(head(rfm1)), c(-1.45598270922089, -1.49664543508657, -2.11747425025103, -0.0729690066951975, 0.772716397142335, 2.37859408861768), tolerance=1e-6) expect_equal(nrow(dNAs),length(rstudent(fitNAs))) }) test_that("cooks distance", { expect_equal( unname(head(cooks.distance(fm1))), c(0.127645976734753, 0.127346548123793, 0.243724627125036, 0.000280638917214881, 0.0309804642689636, 0.293554225380831), tolerance=1e-6) expect_equal(nrow(dNAs),length(cooks.distance(fitNAs))) }) test_that("cooks distance on subject-level influence", { ifm1S <- influence(fm1, "Subject", ncpus=1) expect_equal( unname(head(cooks.distance(ifm1S),2)), c(0.33921460279262, 0.290309061006305), tolerance = 1e-6) }) test_that("cooks distance on glmer models", { inf <- influence(gm1) inf.h <- influence(gm1, "herd", ncpus=1) cook <- cooks.distance(inf) expect_equal(unname(head(cook, 3)), c(0.0532998800033037, 0.0405931172763581, 0.252608337928438), tolerance = 1e-6) cook.h <- cooks.distance(inf.h) expect_equal(unname(head(cook.h, 3)), c(0.256630560723611, 0.00525856231971531, 0.103355658099396), tolerance = 1e-6) }) ## tweaked example so estimated var = 0 zerodat <- data.frame(x=seq(0,1,length.out=120), f=rep(1:3,each=40)) zerodat$y1 <- simulate(~x+(1|f), family=gaussian, seed=102, newparams=list(beta=c(1,1), theta=c(0.001), sigma=1), newdata=zerodat)[[1]] zerodat$y2 <- simulate(~x+(1|f), family=poisson, seed=102, newparams=list(beta=c(1,1), theta=c(0.001)), newdata=zerodat)[[1]] test_that("rstudent matches for zero-var cases", { skip_if(getRversion() < "4.6.0") ## methods have changed to match r-devel lmer_zero <- lmer(y1~x+(1|f), data=zerodat, control = nosingcheck_lmer) glmer_zero <- glmer(y2~x+(1|f),family=poisson, data=zerodat, control = nosingcheck_glmer) lm_zero <- lm(y1~x, data=zerodat) glm_zero <- glm(y2~x,family=poisson, data=zerodat) ## suppressWarnings() for "hatvalues may not be well defined" warning expect_equal(suppressWarnings(rstudent(glmer_zero)), rstudent(glm_zero), tolerance=0.01) expect_equal(suppressWarnings(rstudent(lmer_zero)), rstudent(lm_zero),tolerance=0.01) expect_equal(suppressWarnings(rstandard(glmer_zero)), rstandard(glm_zero), tolerance = 0.01) }) if (testLevel>1) { ## n.b. influence() doesn't work under system.time(); ## weird evaluation stuff ? ## FIXME: work on timing some more i1 <- influence(fm1, ncpus=1) test_that("full version of influence", { expect_equal(c(head(i1[["fixed.effects[-case]"]],1)), c(252.323536264131, 10.3222704729148)) }) cd <- cooks.distance(i1) expect_equal(unname(head(cd,2)), c(0.016503344184025, 0.0106634053477361)) if (max(parallel::detectCores(), 1L, na.rm = TRUE) > 1) { test_that("parallel influence", { ## function.evals can legitimately differ by 1 across parallel backends ## (optimizer non-determinism); compare all components except that one. cmp_influence <- function(a, b) { drop <- "function.evals" expect_equal(a[setdiff(names(a), drop)], b[setdiff(names(b), drop)]) } # ncores = 2 (deprecated) expect_warning( i2 <- influence(fm1, ncores=2), "argument 'ncores' is deprecated" ) i3 <- influence(fm1, parallel = "snow", ncpus = 2) cmp_influence(i1, i2) cmp_influence(i1, i3) if (.Platform$OS.type != "windows") { i4 <- influence(fm1, parallel = "multicore", ncpus = 2) cmp_influence(i1, i4) } # provide cl cl <- parallel::makeCluster(2) on.exit(parallel::stopCluster(cl)) parallel::clusterEvalQ(cl, library(lme4)) i5 <- influence(fm1, parallel = "snow", ncpus = length(cl), cl = cl) cmp_influence(i1, i5) if (require("future.apply", quietly = TRUE)) { plan(sequential) i6 <- influence(fm1, parallel = "future") cmp_influence(i1, i6) plan(multisession) i7 <- influence(fm1, parallel = "future") cmp_influence(i1, i7) plan(sequential) } }) } } ## car method testing: influence timing with ncores > 1 ... ## car version 3.0.10. ## L <- load(system.file("testdata", "lme-tst-fits.rda", ## package="lme4", mustWork=TRUE)) ## data("sleepstudy", package="lme4") ## library(lme4) ## library(car) ## WANT warning about S3 method overwrite ... ## fm1 <- fit_sleepstudy_1 ## library(pracma) ## because system.time() is weird ## tic(); i1 <- influence(fm1); toc() ## 2+ seconds ## tic(); i2 <- influence(fm1, ncores=8); toc() ## 3.4 seconds test_that("influence with nAGQ=0", { gm1Q0 <- update(gm1, nAGQ=0) expect_is(influence(gm1Q0), "influence.merMod") }) test_that("getME now has npar", { fm1 <- fit_sleepstudy_2 expect_equal(getME(fm1, "npar"), length(getReCovs(fm1)[[1]]@par)) expect_equal(getME(fm1, "npar"), length(getLower(fm1))) }) if (testLevel > 1) withAutoprint({ test_that("cook's distance comparison", { ## generate data with zero variance set.seed(101) n <- 50 dd <- data.frame(x = rnorm(n), f = factor(rep(1:2, each = n/2))) suppressMessages(dd$y <- simulate(~ x + (1|f), newdata = dd, newparams = list(beta = c(2,2), theta = 0, sigma = 5), family = gaussian)[[1]]) (fm2 <- lmer(y~x + (1|f), dd, REML = FALSE)) (fm2L <- lm(y~x , dd)) i2 <- influence(fm2) ## hatvalues version does **not** match exactly ... expect_equal(cooks.distance(i2), cooks.distance(fm2L)) expect_equal(cooks.distance(fm2), cooks.distance(fm2L), tolerance = 1e-2) }) test_that("oldNames warning in confint", { fm1 <- fit_sleepstudy_2 expect_warning(confint(fm1, parm = 1, oldNames = TRUE, quiet = TRUE)) }) }) ## testLevel > 1 lme4/tests/testthat/test-lmList.R0000644000176200001440000002416015225703727016476 0ustar liggesusers## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } data("cbpp", package = "lme4") #context("lmList") test_that("basic lmList", { set.seed(17) fm1. <- lmList(Reaction ~ Days | Subject, sleepstudy, pool=FALSE) fm1 <- lmList(Reaction ~ Days | Subject, sleepstudy) cf.fm1 <- data.frame( `(Intercept)` = c(244.19267, 205.05495, 203.48423, 289.68509, 285.73897, 264.25161, 275.01911, 240.16291, 263.03469, 290.10413, 215.11177, 225.8346, 261.14701, 276.37207, 254.96815, 210.44909, 253.63604, 267.0448), Days = c(21.764702, 2.2617855, 6.1148988, 3.0080727, 5.2660188, 9.5667679, 9.1420455, 12.253141, -2.8810339, 19.025974, 13.493933, 19.504017, 6.4334976, 13.566549, 11.348109, 18.056151, 9.1884448, 11.298073)) expect_equal(signif(coef(fm1), 8), cf.fm1, tolerance = 1e-7, check.attributes=FALSE) expect_equal(coef(fm1.), coef(fm1)) expect_true(inherits(formula(fm1), "formula")) ## <- had been wrong till 2015-04-09 sm1. <- summary(fm1.) sm1 <- summary(fm1) expect_equal(sm1$RSE, 25.5918156267, tolerance = 1e-10) cf1 <- confint(fm1) ## Calling the plot.lmList4.confint() method : expect_true(inherits(pcf1 <- plot(cf1), "trellis")) }) test_that("lmList call preserves grouping variable in summary", { fm1_lmList <- lme4::lmList(Reaction ~ Days | Subject, sleepstudy) expect_equal(typeof(attr(fm1_lmList, "groupsForm")), "language") expect_equal(attr(fm1_lmList, "groupsForm"), as.formula("~Subject")) }) test_that("orthodont", { data(Orthodont, package="nlme") fm2 <- lmList(distance ~ age | Subject, Orthodont) fe2 <- fixef(fm2) expect_equal(fe2, c("(Intercept)" = 16.7611111111111, age = 0.660185185185185)) expect_true(inherits(pairs(fm2), "trellis")) }) test_that("simulated", { set.seed(12) d <- data.frame( g = sample(c("A","B","C","D","E"), 250, replace=TRUE), y1 = runif(250, max=100), y2 = sample(c(0,1), 250, replace=TRUE) ) fm3.1 <- lmList(y1 ~ 1 | g, data=d) expect_equal(coef(fm3.1), structure(list(`(Intercept)` = c(45.8945525606396, 50.1127995110841, 49.5320538515225, 52.4286874305165, 48.7716343882989)), names = "(Intercept)", row.names = c("A", "B", "C", "D", "E"), class = "data.frame", label = "Coefficients", effectNames = "(Intercept)", standardized = FALSE)) cf31 <- confint(fm3.1) expect_true(inherits(plot(cf31), "trellis")) fm3.2 <- lmList(y2 ~ 1 | g, data=d, family=binomial) ## ^^^^^^^^ "glmList" cf32 <- suppressMessages(confint(fm3.2,quiet=TRUE)) expect_identical(dim(cf32), c(5L,2:1)) expect_true(inherits(plot(cf32), "trellis")) expect_equal(unname(getDataPart(signif(drop(cf32), 6))), cbind(c(-0.400041, -0.311489, -1.07774, -0.841075, -0.273828), c( 0.743188, 0.768538, 0.0723138, 0.274392, 0.890795))) }) test_that("cbpp", { ## "glmList" (2) -- here, herd == 8 has only one observation => not estimable expect_warning(fm4 <- lmList(cbind(incidence, size - incidence) ~ period | herd, family=binomial, data=cbpp), "Fitting failed for ") cf4 <- coef(fm4) # with some 5 NA's ## match NA locations expect_equal(dim(cf4),c(15,4)) expect_identical(which(is.na(cf4)), sort(as.integer(c(8+15*(0:3), 47)))) expect_warning(fm4B <- lme4::lmList(incidence ~ period | herd, data=cbpp), "Fitting failed") if(FALSE) { ## FIXME: this is actually an nlme bug ... ## https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16542 try(summary(fm4)) ## Error in `[<-`(`*tmp*`, use, use, ii, value = lst[[ii]]) : ## subscript out of bounds library(nlme) data("cbpp",package="lme4") fm6 <- nlme::lmList(incidence ~ period | herd, data=cbpp) try(coef(fm6)) ## coef does *not* work here try(summary(fm6)) ## this is a slightly odd example because the residual df from ## these fits are in fact zero ... so pooled.SD fails, as it should } }) test_that("pooledSD uses correct df when groups have aliased coefficients (GH #377)", { data(Pixel, package = "nlme") p2 <- subset(Pixel, Dog %in% c(7, 8, 9)) ## Dog 9 has I(day^2) aliased (4 obs, 3 params -> 1 free param after alias) ## df.residual(Dog9) = 2, but length(coef(Dog9)) = 3 overcounts by 1 L2 <- lmList(pixel ~ day + I(day^2) | Dog, p2) ps <- lme4:::pooledSD(L2) ## correct df: 5 (Dog7) + 5 (Dog8) + 2 (Dog9) = 12 expect_equal(attr(ps, "df"), 12) ## correct RSE rss <- sum(sapply(L2, function(m) sum(resid(m)^2))) expect_equal(as.numeric(ps), sqrt(rss / 12), tolerance = 1e-6) ## summary should use correct df and RSE s2 <- summary(L2) expect_equal(s2$df.residual, 12) expect_equal(s2$RSE, as.numeric(ps), tolerance = 1e-6) ## making sure things work as intended (in the non broken case) p3 <- subset(Pixel, Dog %in% c(7, 8)) L3 <- lmList(pixel ~ day + I(day^2) | Dog, p3) ps <- lme4:::pooledSD(L3) ## correct df: 5 (Dog7) + 5 (Dog8) = 10 expect_equal(attr(ps, "df"), 10) rss <- sum(sapply(L3, function(m) sum(resid(m)^2))) expect_equal(as.numeric(ps), sqrt(rss / 10), tolerance = 1e-6) s3 <- summary(L3) expect_equal(s3$df.residual, 10) expect_equal(s3$RSE, as.numeric(ps), tolerance = 1e-6) ## no NAs in coefficients: all params estimable for both groups expect_false(any(is.na(s3$coefficients))) }) test_that("NA,weights,offsets", { ## from GH #320 set.seed(101) x <- 1:8 y <- c(2,2,5,4,3,1,2,1) g <- c(1,1,1,2,2,3,3,3) dat <- data.frame(x=x, y=y, g=g) m1 <- lmList(y ~ x | g, data=dat) expect_false(any(is.na(coef(m1)))) w <- runif(nrow(sleepstudy)) m2 <- lmList(Reaction ~ Days | Subject, weights=w, sleepstudy) ss <- subset(sleepstudy,Subject==levels(Subject)[1]) m2X <- lm(Reaction ~ Days, ss, weights=w[1:nrow(ss)]) expect_equal(coef(m2X),as.matrix(coef(m2))[1,]) m3 <- lmList(Reaction ~ Days | Subject, sleepstudy) m4 <- lmList(Reaction ~ Days | Subject, offset=w, sleepstudy) m4X <- lm(Reaction ~ Days, ss, offset=w[1:nrow(ss)]) expect_equal(coef(m4X),as.matrix(coef(m4))[1,]) expect_false(identical(m2,m3)) expect_false(identical(m4,m3)) m5 <- lmList(Reaction ~ Days + offset(w) | Subject, sleepstudy) expect_equal(coef(m5),coef(m4)) ## more from GH 320 dat2 <- data.frame(dat,xx=c(NA,NA,NA,1:4,NA)) m5 <- lmList(y ~ x | g, data=dat2) expect_equal(unlist(coef(m5)[1,]), coef(lm(y~x,subset=(g==1)))) expect_equal(unlist(coef(m5)[3,]), coef(lm(y~x,subset=(g==3)))) }) test_that("pooled", { ## GH #26 fm_lme4 <- lme4:::lmList(Reaction ~ Days | Subject, sleepstudy) fm_nlme <- nlme:::lmList(Reaction ~ Days | Subject, sleepstudy) fm_nlme_nopool <- nlme:::lmList(Reaction ~ Days | Subject, sleepstudy, pool=FALSE) ci_lme4_pooled <- confint(fm_lme4,pool=TRUE) #get low and high CI estimates and pooled sd ci_nlme_pooled <- nlme:::intervals(fm_nlme,pool=TRUE) expect_equal(unname(ci_lme4_pooled[,,1]),unname(ci_nlme_pooled[,c(1,3),1])) ci_lme4_nopool1 <- confint(fm_lme4,pool=FALSE) ci_lme4_nopool2 <- confint(fm_lme4) expect_identical(ci_lme4_nopool1,ci_lme4_nopool2) ## BUG in nlme::intervals ... ? can't get CIs on unpooled fits ## nlme::intervals(fm_nlme,pool=FALSE) ## nlme::intervals(fm_nlme_nopool) expect_equal(ci_lme4_nopool1[1:3,,1], structure(c(179.433862895996, 193.026448122379, 186.785722998616, 308.951475285822, 217.083442786712, 220.182727910474), dim = c(3L, 2L), dimnames = list(c("308", "309", "310"), c("2.5 %", "97.5 %")))) }) test_that("derived variables", { fm_lme4 <- lme4:::lmList(log(Reaction) ~ Days | Subject, sleepstudy) fm_nlme <- nlme:::lmList(log(Reaction) ~ Days | Subject, sleepstudy) expect_equal(c(coef(fm_lme4)),c(coef(fm_nlme)),tolerance=1e-5) }) test_that("subset", { data(MathAchieve, package="nlme") data(MathAchSchool, package="nlme") RB <- merge(MathAchieve, MathAchSchool[, c("School", "Sector")], by="School") names(RB) <- tolower(names(RB)) RB$cses <- with(RB, ses - meanses) cat.list.nlme <- nlme::lmList(mathach ~ cses | school, subset = sector=="Catholic", data=RB) cat.list.lme4 <- lme4::lmList(mathach ~ cses | school, subset = sector=="Catholic", data=RB) expect_equal(c(coef(cat.list.lme4)), c(coef(cat.list.nlme)),tolerance=1e-5) }) if (requireNamespace("tibble")) { test_that("avoid tibble warnings", { ## GH 645 op <- options(warn = 2) m1 <- lmList(Reaction ~ Days | Subject, data = sleepstudy) m2 <- lmList(Reaction ~ Days | Subject, data = tibble::as_tibble(sleepstudy)) expect_identical(coef(m1), coef(m2)) options(op) }) } test_that("Ensure name of grouping variable matches", { lme4_lmList <- lme4::lmList(Reaction ~ Days | Subject, sleepstudy) nlme_lmList <- nlme::lmList(Reaction ~ Days | Subject, sleepstudy) lme4_sum <- summary(lme4_lmList) nlme_sum <- summary(nlme_lmList) expect_equal( attr(lme4_sum, "groupsForm"), ~Subject, ignore_formula_env = TRUE ) expect_equal( attr(lme4_sum, "groupsForm"), attr(nlme_sum, "groupsForm"), ignore_formula_env = TRUE ) }) test_that("Warning provided if user adds various grouping terms", { data(Pixel, package="nlme") expect_error( lme4::lmList(pixel ~ day + I(day^2) | Side/Dog, data = Pixel) ) expect_error( lme4::lmList(pixel ~ day + I(day^2) + (1| Side) + (1|Dog), data = Pixel) ) }) lme4/tests/testthat/test-nbinom.R0000644000176200001440000001036015127735433016511 0ustar liggesuserstestLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 set.seed(101) dd <- expand.grid(f1 = factor(1:3), f2 = LETTERS[1:2], g=1:9, rep=1:15, KEEP.OUT.ATTRS=FALSE) mu <- 5*(-4 + with(dd, as.integer(f1) + 4*as.numeric(f2))) dd$y <- rnbinom(nrow(dd), mu = mu, size = 0.5) ## mimic glmer.nb protocol if (testLevel>1) { test_that("most messages suppressed", { expect_message(glmer.nb(y ~ f1 + (1|g), data=dd[1:10,]), "singular") }) test_that("ok with negative.binomial masking", { negative.binomial <- function() {} ## use shortened version of data for speed ... m.base <- glmer.nb(y ~ f1 + (1|g), data=dd[1:200,]) expect_is(m.base,"merMod") }) test_that("ok with Poisson masking", { poisson <- NA ## use shortened version of data for speed ... m.base <- glmer.nb(y ~ f1 + (1|g), data=dd[1:200,]) expect_is(m.base,"merMod") rm(poisson) }) if (testLevel>2) { #context("testing glmer refit") test_that("glmer refit", { ## basic Poisson fit m.base <- glmer(y ~ f1*f2 + (1|g), data=dd, family=poisson) expect_equal(m.base@beta,(m.base.r <- refit(m.base))@beta, tolerance = 1e-5) th <- lme4:::est_theta(m.base,limit=20,eps=1e-4,trace=FALSE) th0 <- structure(0.482681268108477, SE = 0.0244825021248148) th1 <- structure(0.482681277470945) th2 <- 0.482681268108477 th3 <- 0.4826813 ## NB update with raw number m.numth1 <- update(m.base,family=MASS::negative.binomial(theta=0.4826813)) expect_equal(m.numth1@beta,(m.numth1.r <- refit(m.numth1))@beta) ## strip NB value m.symth4 <- update(m.base,family=MASS::negative.binomial(theta=c(th))) expect_equal(m.symth4@beta,(m.symth4.r <- refit(m.symth4))@beta) ## IDENTICAL numeric value to case #1 above m.symth6 <- update(m.base,family=MASS::negative.binomial(theta=th3)) expect_equal(m.symth6@beta,(m.symth6.r <- refit(m.symth6))@beta) ## standard NB update with computed theta from est_theta (incl SE attribute) m.symth <- update(m.base,family=MASS::negative.binomial(theta=th)) expect_equal(m.symth@beta,(m.symth.r <- refit(m.symth))@beta) ## NB update with equivalent value m.symth2 <- update(m.base,family=MASS::negative.binomial(theta=th0)) expect_equal(m.symth2@beta,(m.symth2.r <- refit(m.symth2))@beta) ## NB update with theta value (stored as variable, no SE) only m.symth3 <- update(m.base,family=MASS::negative.binomial(theta=th1)) expect_equal(m.symth3@beta,(m.symth3.r <- refit(m.symth3))@beta) ## strip NB value (off by 5e-16) m.symth5 <- update(m.base,family=MASS::negative.binomial(theta=th2)) expect_equal(m.symth5@beta,(m.symth5.r <- refit(m.symth5))@beta) }) ## GH #399 test_that("na_exclude", { dd1 <- dd[1:200,] dd1$f1[1:5] <- NA expect_error(glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.fail), "missing values in object") m1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.omit) m2 <- glmer.nb(y ~ f1 + (1|g), data=dd1, na.action=na.exclude) expect_equal(fixef(m1),fixef(m1)) expect_equal(length(predict(m2))-length(predict(m1)),5) }) ## GH 423 test_that("start_vals", { dd1 <- dd[1:200,] g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1) g2 <- glmer.nb(y ~ f1 + (1|g), data=dd1, initCtrl=list(theta=getME(g1,"glmer.nb.theta"))) expect_equal(fixef(g1),fixef(g2),tol=1e-5) }) test_that("control arguments", { dd1 <- dd[1:200,] g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, initCtrl=list(theta=10)) expect_is(g1,"merMod") ## dumb test - just checking for run w/o error suppressWarnings(g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, nb.control=glmerControl(optimizer="bobyqa"))) expect_equal(g1@optinfo$optimizer, "bobyqa") suppressWarnings(g1 <- glmer.nb(y ~ f1 + (1|g), data=dd1, nb.control=glmerControl(optCtrl=list(maxfun=2)))) expect_equal(g1@optinfo$feval,3) }) } ## testLevel>2 } ## testLevel>1 lme4/tests/testthat/test-glmFamily.R0000644000176200001440000002014015162267113017137 0ustar liggesuserseps <- .Machine$double.eps oneMeps <- 1 - eps set.seed(1) ## sample linear predictor values for the unconstrained families etas <- list( seq.int(-8, 8, by=1), runif(17, -8, 8), # random sample from wide uniform dist rnorm(17, 0, 8), # random sample from wide normal dist c(-10^30, rnorm(15, 0, 4), 10^30) ) ## sample linear predictor values for the families in which eta must be positive etapos <- list(seq.int(1, 20, by=1), rexp(20), rgamma(20, 3), pmax(.Machine$double.eps, rnorm(20, 2, 1))) ## values of mu in the (0,1) interval mubinom <- list(runif(100, 0, 1), rbeta(100, 1, 3), pmin(pmax(eps, rbeta(100, 0.1, 3)), oneMeps), pmin(pmax(eps, rbeta(100, 3, 0.1)), oneMeps)) test_that("inverse link and muEta functions", { tst.lnki <- function(fam, frm) { ff <- glmFamily$new(family=fam) ## as.numeric() needed for binomial()$linkinv breakage (also in muEta test) sapply(frm, function(x) expect_that(fam$linkinv(as.numeric(x)), equals(ff$linkInv(x)))) } tst.muEta <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$mu.eta(as.numeric(x)), equals(ff$muEta(x)))) } tst.lnki(binomial(), etas) # binomial with logit link tst.muEta(binomial(), etas) tst.lnki(binomial("probit"), etas) # binomial with probit link tst.muEta(binomial("probit"), etas) tst.lnki(binomial("cloglog"), etas) # binomial with cloglog link tst.muEta(binomial("cloglog"), etas) tst.lnki(binomial("cauchit"), etas) # binomial with cauchit link tst.muEta(binomial("cauchit"), etas) tst.lnki(poisson(), etas) # Poisson with log link tst.muEta(poisson(), etas) tst.lnki(gaussian(), etas) # Gaussian with identity link tst.muEta(gaussian(), etas) tst.lnki(Gamma(), etapos) # gamma family tst.muEta(Gamma(), etapos) tst.lnki(inverse.gaussian(), etapos) # inverse Gaussian tst.muEta(inverse.gaussian(), etapos) }) test_that("link and variance functions", { tst.link <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$linkfun(x), equals(ff$link(x)))) } tst.variance <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$variance(x), equals(ff$variance(x)))) } tst.link( binomial(), mubinom) tst.variance(binomial(), mubinom) tst.link( binomial("probit"), mubinom) tst.link( binomial("cauchit"), mubinom) tst.link( gaussian(), etas) tst.variance(gaussian(), etas) tst.link( Gamma(), etapos) tst.variance(Gamma(), etapos) tst.link( inverse.gaussian(), etapos) tst.variance(inverse.gaussian(), etapos) tst.variance(MASS::negative.binomial(1), etapos) tst.variance(MASS::negative.binomial(0.5), etapos) tst.link( poisson(), etapos) tst.variance(poisson(), etapos) }) test_that("devResid and aic", { tst.devres <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) { nn <- length(x) wt <- rep.int(1, nn) n <- wt y <- switch(fam$family, binomial = rbinom(nn, 1L, x), gaussian = rnorm(nn, x), poisson = rpois(nn, x), error("Unknown family")) dev <- ff$devResid(y, x, wt) expect_that(fam$dev.resids(y, x, wt), equals(dev)) dd <- sum(dev) expect_that(fam$aic(y, n, x, wt, dd), equals(ff$aic(y, n, x, wt, dd))) }) } tst.devres(binomial(), mubinom) tst.devres(gaussian(), etas) tst.devres(poisson(), etapos) }) test_that("variance", { tst.variance <- function(fam, frm) { ff <- glmFamily$new(family=fam) sapply(frm, function(x) expect_that(fam$variance(x), equals(ff$variance(x)))) } tst.variance(MASS::negative.binomial(1.), etapos) nb1 <- MASS::negative.binomial(1.) cppnb1 <- glmFamily$new(family=nb1) expect_that(cppnb1$theta(), equals(1)) nb2 <- MASS::negative.binomial(2.) cppnb1$setTheta(2) sapply(etapos, function(x) expect_that(cppnb1$variance(x), equals(nb2$variance(x)))) bfam <- glmFamily$new(family=binomial()) if (FALSE) { ## segfaults on MacOS mavericks 3.1.0 ... ?? expect_error(bfam$theta())#, "theta accessor applies only to negative binomial") expect_error(bfam$setTheta(2))#, "setTheta applies only to negative binomial") } }) simfun_gam <- function(ngrp = 50, nrep = 50, shape_gam = 2, intercept = 1, use_simulate = FALSE, seed = NULL) { if (!is.null(seed)) set.seed(seed) dd <- expand.grid(group = 1:ngrp, rep = 1:nrep) if (use_simulate) { dd$y <- simulate(~ 1 + (1 | group), newdata = dd, family = Gamma(link = "log"), newparams = list( theta = 1, beta = 1, sigma = 1/sqrt(shape_gam)))[[1]] return(dd) } b <- rnorm(ngrp) eta <- intercept + b mu <- exp(eta) y <- rgamma(nrow(dd), shape = shape_gam, scale = mu/shape_gam) data.frame(dd, y) } dd1 <- simfun_gam(seed = 101) dd2 <- simfun_gam(seed = 101, use_simulate = TRUE) test_that("simulated Gamma data matches with simulate()", { expect_equal(dd1$y, dd2$y) }) test_that("estimated Gamma shape is correct", { m1 <- glmer(y ~ 1 + (1|group), family = Gamma(link = "log"), data = dd2) shape_val <- 1/sigma(m1)^2 expect_equal(shape_val, 2.0, tolerance = 0.05) expect_equal(shape_val, 1.94511502080571, tolerance = 1e-6) }) test_that("glmer works for Gamma with small shape parameter", { ## shape=0.1 previously caused PIRLS divergence ## we are also testing for different values of Gamma to be safe shape_vec <- c(0.1,0.5,1,2,5) set.seed(123) for(shape_param in shape_vec){ d <- expand.grid(block = LETTERS[1:26], rep = 1:100, KEEP.OUT.ATTRS = FALSE) d$x <- runif(nrow(d)) reff_f <- rnorm(length(levels(d$block)), sd = 1) d$eta <- 4 + 3 * d$x + reff_f[d$block] d$y <- rgamma(nrow(d), scale = exp(d$eta) / shape_param, shape = shape_param) fit <- suppressWarnings( glmer(y ~ x + (1|block), data = d, family = Gamma(link = "log")) ) expect_s4_class(fit, "merMod") ## testing for the shape parameter. expect_equal(1/sigma(fit)^2, shape_param, tolerance = 0.1) ## fixed effects should be close to true values (intercept=4, slope=3) expect_equal(unname(fixef(fit)), c(4, 3), tolerance = 0.5) print(unname(fixef(fit))) } }) simfun_invgauss <- function(ngrp = 50, nrep = 500, lambda = 1, use_simulate = FALSE, seed = NULL) { if (!is.null(seed)) set.seed(seed) dd <- expand.grid(group = 1:ngrp, rep = 1:nrep) if (use_simulate) { dd$y <- simulate(~ 1 + (1 | group), newdata = dd, family = inverse.gaussian(link = "1/mu^2"), newparams = list( theta = c("group.(Intercept)" = 1), beta = c("(Intercept)" = 4), sigma = 1/sqrt(lambda)))[[1]] return(dd) } b <- rnorm(ngrp) eta <- 4 + b mu <- 1/sqrt(eta) y <- statmod::rinvgauss(nrow(dd), mean = mu, shape = lambda) data.frame(dd, y) } ddig1 <- simfun_invgauss(seed = 101, use_simulate = FALSE) ddig2 <- simfun_invgauss(seed = 101, use_simulate = TRUE) test_that("simulated Inverse Gaussian data matches with simulate()", { expect_equal(ddig1$y, ddig2$y) }) test_that("estimated Inverse Gaussian shape is correct", { m1 <- glmer(y ~ 1 + (1 | group), family = inverse.gaussian(link = "1/mu^2"), data = ddig2) shape_val <- 1/sigma(m1)^2 expect_equal(shape_val, 1, tolerance = 0.05) expect_equal(shape_val, 1.032144112298057, tolerance = 1e-6) }) lme4/tests/testthat/test-start.R0000644000176200001440000000676615127735433016403 0ustar liggesusers#context("specifying starting values") ##' Update 'mod', copying .@call and attr(.@frame, "start") from 'from' copysome <- function(mod, from) { stopifnot(all.equal(class(mod), class(from)), isS4(mod)) mod@call <- from@call attr(mod@frame, "start") <- attr(from@frame, "start") mod } ## is "Nelder_Mead" default optimizer? isNM <- formals(lmerControl)$optimizer == "Nelder_Mead" stMsg <- "NULL,.*numeric vector,.*list" test_that("lmer", { frm <- Reaction ~ Days + (Days|Subject) ctrl <- lmerControl(optCtrl = list(maxfun= if(isNM) 50 else 100)) x <- suppressWarnings(lmer(frm, data=sleepstudy, control=ctrl, REML=FALSE)) x2 <- suppressWarnings(update(x,start=c(1,0,1))) x3 <- suppressWarnings(update(x,start=list(theta=c(1,0,1)))) ff <- update(x,devFunOnly=TRUE) x2@call <- x3@call <- x@call ## hack call component expect_equal(x,x2) expect_equal(x,x3) ## warning on deprecated list ... suppressWarnings(expect_error(update(x, start = "a"), stMsg)) ## misspelled suppressWarnings( expect_error(update(x,start=list(Theta=c(1,0,1))), "invalid names") ) th0 <- getME(x,"theta") y <- suppressWarnings(update(x,start=th0)) if(isNM) { expect_equal(AIC(x), 1768.025, tolerance=1e-6) expect_equal(AIC(y), 1763.949, tolerance=1e-6) } else { ## only "bobyqa" tested: expect_equal(AIC(x), 1763.939344, tolerance=1e-6) expect_equal(AIC(x), AIC(y)) } if(isNM) expect_equal(suppressWarnings(optimizeLmer(ff,control=list(maxfun=50), start=c(1,0,1))$fval), unname(deviance(x))) expect_equal(suppressWarnings(optimizeLmer(ff,control=list(maxfun=50), start=th0)$fval), unname(deviance(y))) }) test_that("glmer", { ctrl <- glmerControl(optCtrl=list(maxfun=50)) # -> non-convergence warnings x <- suppressWarnings(glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial, control=ctrl)) ## theta only x2 <- suppressWarnings(update(x, start= 1)) x3 <- suppressWarnings(update(x, start= list(theta = 1))) ff <- update(x,devFunOnly=TRUE) x2@call <- x3@call <- x@call ## hack call component expect_equal(x,x2) expect_equal(x,x3) expect_error(update(x, start="a"), stMsg) expect_error(update(x, start=list(Theta=1)), "invalid names") ## test fixef/beta synonymy x3B <- suppressWarnings(update(x, start=list(beta = rep(1,4)))) x3C <- suppressWarnings(update(x, start=list(fixef = rep(1,4)))) ## hack to set calls equal x3B@call <- x3C@call expect_equal(x3B, x3C) ## th0 <- getME(x,"theta") y <- suppressWarnings(update(x, start=th0)) # expect_equal() fails: optinfo -> derivs -> Hessian ## theta and beta x0 <- update(x,nAGQ=0) x4 <- suppressWarnings(update(x, start = list(theta=1, fixef=fixef(x0)))) expect_equal(x, copysome(x4, from=x)) x5 <- suppressWarnings(update(x, start = list(theta=1, fixef=rep(0,4)))) expect_equal(AIC(x5), 221.5823, tolerance=1e-6) x6 <- expect_error(suppressWarnings(update(x, start = list(theta=1, fixef=rep(0,5))), "incorrect number of fixef components")) ## beta only x7 <- suppressWarnings(update(x,start=list(fixef=fixef(x0)))) expect_equal(x, copysome(x7, from=x)) x8 <- suppressWarnings(update(x,start=list(fixef=rep(0,4)))) expect_equal(x5, copysome(x8, from=x5)) }) lme4/tests/testthat/test-weights.R0000644000176200001440000000416615142204551016675 0ustar liggesusers# unit tests for weights test_that("weights for lmer is always 1", { fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ## the default should be just the prior weights, ## tried both anyways in case it changes. wgt_default <- weights(fm1) wgt_prior <- weights(fm1, "prior") wgt_working <- weights(fm1, "working") expect_equal(length(wgt_default), nrow(sleepstudy)) expect_equal(length(wgt_prior), nrow(sleepstudy)) expect_equal(length(wgt_working), nrow(sleepstudy)) ## checking it is indeed always a vector of 1 expect_equal(wgt_default, rep(1, nrow(sleepstudy))) expect_equal(wgt_prior, rep(1, nrow(sleepstudy))) expect_equal(wgt_working, rep(1, nrow(sleepstudy))) }) test_that("testing na.action", { sstud <- sleepstudy sstud$Reaction[1] <- NA fm1 <- lmer(Reaction ~ Days + (Days | Subject), sstud) fm1.exclude <- lmer(Reaction ~ Days + (Days | Subject), sstud, na.action = na.exclude) fm1.omit <- lmer(Reaction ~ Days + (Days | Subject), sstud, na.action = na.omit) expect_equal(length(weights(fm1)), nrow(sleepstudy) - 1) expect_equal(length(weights(fm1.exclude)), nrow(sleepstudy)) expect_equal(length(weights(fm1.omit)), nrow(sleepstudy) - 1) ## this is not necessarily for weights, but to ensure na.exclude and na.omit ## are acting as expected/ expect_equal(length(residuals(fm1.exclude)), nrow(sleepstudy)) expect_equal(length(residuals(fm1.omit)), nrow(sleepstudy) - 1) cbpp3 <- cbpp cbpp3$incidence[1] <- NA cbpp3$size[1] <- NA gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp3, family = binomial) gm1.exclude <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp3, family = binomial, na.action = na.exclude) gm1.omit <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp3, family = binomial, na.action = na.omit) expect_equal(length(weights(gm1)), nrow(cbpp) - 1) expect_equal(length(weights(gm1.exclude)), nrow(cbpp)) expect_equal(length(weights(gm1.omit)), nrow(cbpp) - 1) }) lme4/tests/testthat/test-lmer.R0000644000176200001440000005537415174671503016203 0ustar liggesusers## (as.function.merMod() assumes it) data("Dyestuff", package = "lme4") data("cbpp", package = "lme4") library(lme4) ## this *is* necessary, for as.function.merMod() ... ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } #context("fitting lmer models") ## is "Nelder_Mead" default optimizer? -- no longer (isNM <- formals(lmerControl)$optimizer == "Nelder_Mead") test_that("lmer", { set.seed(101) d <- data.frame(z=rnorm(200), f=factor(sample(1:10,200, replace=TRUE))) ## Using 'method=*' defunct in 2019-05 (after 6 years of deprecation) ## expect_warning(lmer(z~ 1|f, d, method="abc"),"Use the REML argument") ## expect_warning(lmer(z~ 1|f, d, method="Laplace"),"Use the REML argument") ##sp No '...' anymore ##sp expect_warning(lmer(z~ 1|f, d, sparseX=TRUE),"has no effect at present") expect_error(lmer(z~ 1|f, ddd), "bad 'data': object 'ddd' not found") expect_error(lmer(z~ 1|f), "object 'z' not found") expect_error(lmer(z~ 1|f, d[,1:1000]), "bad 'data': undefined columns selected") expect_is(fm1 <- lmer(Yield ~ 1|Batch, Dyestuff), "lmerMod") expect_is(fm1_noCD <- update(fm1,control=lmerControl(calc.derivs=FALSE)), "lmerMod") expect_equal(VarCorr(fm1),VarCorr(fm1_noCD)) ## backward compatibility version {for optimizer="Nelder-Mead" only}: if(isNM) expect_is(fm1.old <- update(fm1,control=lmerControl(use.last.params=TRUE)), "lmerMod") expect_is(fm1@resp, "lmerResp") expect_is(fm1@pp, "merPredD") expect_that(fe1 <- fixef(fm1), is_equivalent_to(1527.5)) expect_that(VarCorr(fm1)[[1]][1,1], ## "bobyqa" : 1764.050060 equals(1764.0375195, tolerance = 1e-5)) ## back-compatibility ... if(isNM) expect_that(VarCorr(fm1.old)[[1]][1,1], equals(1764.0726543)) expect_that(isREML(fm1), equals(TRUE)) expect_is(REMLfun <- as.function(fm1), "function") expect_that(REMLfun(1), equals(319.792389042002)) expect_that(REMLfun(0), equals(326.023232155879)) expect_that(family(fm1), equals(gaussian())) expect_that(isREML(fm1ML <- refitML(fm1)), equals(FALSE)) expect_that(REMLcrit(fm1), equals(319.654276842342)) expect_that(deviance(fm1ML), equals(327.327059881135)) ## "bobyqa": 49.51009984775 expect_that(sigma(fm1), equals(49.5101272946856, tolerance=1e-6)) if(isNM) expect_that(sigma(fm1.old), equals(49.5100503990048)) expect_that(sigma(fm1ML), equals(49.5100999308089)) expect_that(extractAIC(fm1), equals(c(3, 333.327059881135))) expect_that(extractAIC(fm1ML), equals(c(3, 333.327059881135))) ## "bobyqa": 375.71667627943 expect_that(vcov(fm1) [1,1], equals(375.714676744, tolerance=1e-5)) if(isNM) expect_that(vcov(fm1.old)[1,1], equals(375.72027872986)) expect_that(vcov(fm1ML) [1,1], equals(313.09721874266, tolerance=1e-7)) # was 313.0972246957 expect_is(fm2 <- refit(fm1, Dyestuff2$Yield), "lmerMod") expect_that(fixef(fm2), is_equivalent_to(5.6656)) expect_that(VarCorr(fm2)[[1]][1,1], is_equivalent_to(0)) expect_that(getME(fm2, "theta"), is_equivalent_to(0)) expect_that(X <- getME(fm1, "X"), is_equivalent_to(array(1, c(1, 30)))) expect_is(Zt <- getME(fm1, "Zt"), "dgCMatrix") expect_that(dim(Zt), equals(c(6L, 30L))) expect_that(Zt@x, equals(rep.int(1, 30L))) expect_equal(dimnames(Zt), list(levels(Dyestuff$Batch), rownames(Dyestuff))) ## "bobyqa": 0.8483237982 expect_that(theta <- getME(fm1, "theta"), equals(0.84832031, tolerance=6e-6, check.attributes=FALSE)) if(isNM) expect_that(getME(fm1.old, "theta"), is_equivalent_to(0.848330078)) expect_is(Lambdat <- getME(fm1, "Lambdat"), "dgCMatrix") expect_that(as(Lambdat, "matrix"), is_equivalent_to(diag(theta, 6L, 6L))) expect_is(fm3 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy), "lmerMod") expect_that(getME(fm3,"n_rtrms"), equals(2L)) expect_that(getME(fm3,"n_rfacs"), equals(1L)) expect_equal(getME(fm3, "lower"), c(`Subject.(Intercept)` = 0, Subject.Days = 0)) expect_error(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject==levels(Subject)[1])), "must have > 1") expect_warning(fm4 <- lFormula(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject==levels(Subject)[1]), control=lmerControl(check.nlev.gtr.1="warning")), "must have > 1") expect_warning(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject %in% levels(Subject)[1:4]), control=lmerControl(check.nlev.gtreq.5="warning")), "< 5 sampled levels") sstudy9 <- subset(sleepstudy, Days == 1 | Days == 9) expect_error(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9)), "number of observations \\(=36\\) <= number of random effects \\(=36\\)") expect_error(lFormula(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9)), "number of observations \\(=36\\) <= number of random effects \\(=36\\)") ## with most recent Matrix (1.1-1), should *not* flag this ## for insufficient rank dat <- readRDS(system.file("testdata", "rankMatrix.rds", package="lme4")) expect_is(lFormula(y ~ (1|sample) + (1|day) + (1|day:sample) + (1|operator) + (1|day:operator) + (1|sample:operator) + (1|day:sample:operator), data = dat, control = lmerControl(check.nobs.vs.rankZ = "stop")), "list") ## check scale ss <- within(sleepstudy, Days <- Days*1e6) expect_warning(lmer(Reaction ~ Days + (1|Subject), data=ss), "predictor variables are on very different scales") ## Promote warning to error so that warnings or errors will stop the test: options(warn=2) expect_is(lmer(Yield ~ 1|Batch, Dyestuff, REML=TRUE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, start=NULL), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, verbose=0L), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, subset=TRUE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, weights=rep(1,nrow(Dyestuff))), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, na.action="na.exclude"), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, offset=rep(0,nrow(Dyestuff))), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, contrasts=NULL), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, devFunOnly=FALSE), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="Nelder_Mead")), "lmerMod") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl()), "lmerMod") ## avoid _R_CHECK_LENGTH_1_LOGIC2_ errors ... if (getRversion() < "3.6.0" || (requireNamespace("optimx", quietly = TRUE) && packageVersion("optimx") > "2018.7.10")) { expect_error(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="optimx")),"must specify") expect_is(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B"))), "lmerMod") } expect_error(lmer(Yield ~ 1|Batch, Dyestuff, control=lmerControl(optimizer="junk")), "couldn't find optimizer function") ## disable test ... should be no warning expect_is(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9), control=lmerControl(check.nobs.vs.rankZ="ignore", check.nobs.vs.nRE="ignore", check.conv.hess="ignore", ## need to ignore relative gradient check too; ## surface is flat so *relative* gradient gets large check.conv.grad="ignore")), "merMod") expect_is(lmer(Reaction ~ 1 + Days + (1|obs), data = transform(sleepstudy,obs=seq(nrow(sleepstudy))), control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.nRE="ignore", check.nobs.vs.rankZ="ignore")), "merMod") expect_error(lmer(Reaction ~ 1 + Days + (1|obs), data = transform(sleepstudy,obs=seq(nrow(sleepstudy))), "number of levels of each grouping factor")) ## check for errors with illegal input checking options flags <- lme4:::.get.checkingOpts(names(formals(lmerControl))) .t <- lapply(flags, function(OPT) { ## set each to invalid string: ## cat(OPT,"\n") expect_error(lFormula(Reaction~1+Days+(1|Subject), data = sleepstudy, control = do.call(lmerControl, ## Deliberate: fake typo ## vvv setNames(list("warnign"), OPT))), "invalid control level") }) ## disable warning via options options(lmerControl=list(check.nobs.vs.rankZ="ignore",check.nobs.vs.nRE="ignore")) expect_is(fm4 <- lmer(Reaction ~ Days + (1|Subject), subset(sleepstudy,Subject %in% levels(Subject)[1:4])), "merMod") expect_is(lmer(Reaction ~ 1 + Days + (1 + Days | Subject), data = sleepstudy, subset = (Days == 1 | Days == 9), control=lmerControl(check.conv.hess="ignore", check.conv.grad="ignore")), "merMod") options(lmerControl=NULL) ## check for when ignored options are set options(lmerControl=list(junk=1,check.conv.grad="ignore")) expect_warning(lmer(Reaction ~ Days + (1|Subject),sleepstudy), "some options") options(lmerControl=NULL) options(warn=0) expect_error(lmer(Yield ~ 1|Batch, Dyestuff, junkArg=TRUE), "unused argument") expect_warning(lmer(Yield ~ 1|Batch, Dyestuff, control=list()), "passing control as list is deprecated") if(FALSE) ## Hadley broke this expect_warning(lmer(Yield ~ 1|Batch, Dyestuff, control=glmerControl()), "passing control as list is deprecated") ss <- transform(sleepstudy,obs=factor(seq(nrow(sleepstudy)))) expect_warning(lmer(Reaction ~ 1 + (1|obs), data=ss, control=lmerControl(check.nobs.vs.nlev="warning", check.nobs.vs.nRE="ignore")), "number of levels of each grouping factor") ## test deparsing of very long terms inside mkReTrms set.seed(101) longNames <- sapply(letters[1:25], function(x) paste(rep(x,8),collapse="")) tstdat <- data.frame(Y=rnorm(10), F=factor(1:10), matrix(runif(250),ncol=25, dimnames=list(NULL, longNames))) expect_is(lFormula(Y~1+(aaaaaaaa+bbbbbbbb+cccccccc+dddddddd+ eeeeeeee+ffffffff+gggggggg+hhhhhhhh+ iiiiiiii+jjjjjjjj+kkkkkkkk+llllllll|F), data=tstdat, control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.nRE="ignore", check.nobs.vs.rankZ="ignore")),"list") ## do.call(new,...) bug new <- "foo" expect_is(refit(fm1),"merMod") rm("new") ## test subset-with-( printing from summary fm1 <- lmer(z~1|f,d,subset=(z<1e9)) expect_equal(sum(grepl("Subset: \\(",capture.output(summary(fm1)))),1) ## test messed-up Hessian ## UPDATE: modified this test since we now automatically ignore Hessian ## checks when there is a singular fit fm1 <- lmer(z~ as.numeric(f) + 1|f, d) expect_equal(summary(fm1)$optinfo$conv$lme4$messages, "boundary (singular) fit: see help('isSingular')") expect_null(fm1@optinfo$derivs$Hessian) ## Previous: ##fm1@optinfo$derivs$Hessian[2,2] <- NA ##expect_warning(lme4:::checkConv(fm1@optinfo$derivs, ## coefs=c(1,1), ## ctrl=lmerControl()$checkConv,lbound=0), ## "Problem with Hessian check") ## test ordering of Ztlist names ## this is a silly model, just using it for a case ## where nlevs(RE term 1) < nlevs(RE term 2)x data(cbpp) cbpp <- transform(cbpp,obs=factor(1:nrow(cbpp))) fm0 <- lmer(incidence~1+(1|herd)+(1|obs),cbpp, control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.rankZ="ignore", check.nobs.vs.nRE="ignore", check.conv.grad="ignore", check.conv.singular="ignore", check.conv.hess="ignore")) fm0B <- update(fm0, .~1+(1|obs)+(1|herd)) expect_equal(names(getME(fm0,"Ztlist")), c("obs.(Intercept)", "herd.(Intercept)")) ## stable regardless of order in formula expect_equal(getME(fm0,"Ztlist"),getME(fm0B,"Ztlist")) ## no optimization (GH #408) fm_noopt <- lmer(z~1|f,d, control=lmerControl(optimizer=NULL)) expect_equal(unname(unlist(getME(fm_noopt,c("theta","beta")))), c(0.244179074357121, -0.0336616441209862)) expect_error(lmer(z~1|f,d, control=lmerControl(optimizer="none")), "deprecated use") my_opt <- function(fn,par,lower,upper,control) { opt <- optim(fn=fn,par=par,lower=lower, upper=upper,control=control,,method="L-BFGS-B") return(list(par=opt$par,fval=opt$value,conv=opt$convergence)) } expect_is(fm_noopt <- lmer(z~1|f,d, control=lmerControl(optimizer=my_opt)),"merMod") ## test verbose option for nloptwrap cc <- capture.output(lmer(Reaction~1+(1|Subject), data=sleepstudy, control=lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)), verbose=5)) expect_equal(sum(grepl("^iteration:",cc)),14) }) ## test_that(..) test_that("coef_lmer", { ## test coefficient extraction in the case where RE contain ## terms that are missing from the FE ... set.seed(101) d <- data.frame(resp=runif(100), var1=factor(sample(1:5,size=100,replace=TRUE)), var2=runif(100), var3=factor(sample(1:5,size=100,replace=TRUE))) mix1 <- lmer(resp ~ 0 + var1 + var1:var2 + (1|var3), data=d) c1 <- coef(mix1) expect_is(c1, "coef.mer") cd1 <- c1$var3 expect_is (cd1, "data.frame") n1 <- paste0("var1", 1:5) nn <- c(n1, paste(n1, "var2", sep=":")) expect_identical(names(cd1), c("(Intercept)", nn)) expect_equal(fixef(mix1), setNames(c(0.2703951, 0.3832911, 0.451279, 0.6528842, 0.6109819, 0.4949802, 0.1222705, 0.08702069, -0.2856431, -0.01596725), nn), tolerance= 6e-6)# 64-bit: 6.73e-9 }) test_that("getCall", { ## GH #535 getClass <- function() "foo" expect_is(glmer(round(Reaction) ~ 1 + (1|Subject), sleepstudy, family=poisson), "glmerMod") rm(getClass) }) test_that("better info about optimizer convergence", { set.seed(14) cbpp$var <- rnorm(nrow(cbpp), 10, 10) suppressWarnings(gm2 <- glmer(cbind(incidence, size - incidence) ~ period * var + (1 | herd), data = cbpp, family = binomial, control=glmerControl(optimizer=c("bobyqa","Nelder_Mead"))) ) ## FIXME: with new update, suppressWarnings(update(gm2)) will give ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? op <- options(warn=-1) gm3 <- update(gm2, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2))) options(op) cc <-capture.output(print(summary(gm2))) expect_equal(tail(cc,4)[1], "optimizer (Nelder_Mead) convergence code: 0 (OK)") }) #context("convergence warnings etc.") fm1 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy) suppressMessages(fm0 <- lmer(Reaction~ Days + (Days|Subject), sleepstudy[1:20,])) msg_in_output <- function(x, str) { cc <- capture.output(.prt.warn(x)) any(grepl(str , cc)) } test_that("convergence warnings from limited evals", { expect_warning(fm1B <- update(fm1, control=lmerControl(optCtrl=list(maxeval=3))), "convergence code 5") expect_true(msg_in_output(fm1B@optinfo, "convergence code: 5")) expect_warning(fm1C <- update(fm1, control=lmerControl(optimizer="bobyqa",optCtrl=list(maxfun=3))), "maximum number of function evaluations exceeded") expect_true(msg_in_output(fm1C@optinfo, "maximum number of function evaluations exceeded")) ## one extra (spurious) warning here ... expect_warning(fm1D <- update(fm1, control=lmerControl(optimizer="Nelder_Mead",optCtrl=list(maxfun=3))), "failure to converge in 3 evaluations") expect_true(msg_in_output(fm1D@optinfo, "failure to converge in 3 evaluations")) expect_message(fm0D <- update(fm0, control=lmerControl(optimizer="Nelder_Mead",calc.derivs=FALSE)), "boundary") expect_true(msg_in_output(fm0D@optinfo, "(OK)")) }) ## GH 533 test_that("test for zero non-NA cases", { data_bad <- sleepstudy data_bad$Days <- NA_real_ expect_error(lmer(Reaction ~ Days + (1| Subject), data_bad), "0 \\(non-NA\\) cases") }) ## test_that("catch matrix-valued responses in lmer/glmer but not in formulas", { dd <- data.frame(x = rnorm(1000), batch = factor(rep(1:20, each=50))) dd$y <- matrix(rnorm(1e4), ncol = 10) dd$y2 <- matrix(rpois(1e4, lambda = 1), ncol = 10) expect_error(lmer(y ~ x + (1|batch), dd), "matrix-valued") fr <- lFormula(y ~ x + (1|batch), dd)$fr expect_true(is.matrix(model.response(fr))) expect_error(glmer(y ~ x + (1|batch), dd, family = poisson), "matrix-valued") fr <- glFormula(y ~ x + (1|batch), dd, family = poisson)$fr }) test_that("catch matrix-valued responses", { dd <- data.frame(x = rnorm(1000), batch = factor(rep(1:20, each=50))) dd$y <- matrix(rnorm(1e4), ncol = 10) expect_error(lmer(y ~ x + (1|batch), dd), "matrix-valued") }) test_that("update works as expected", { m <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy) m1 <- lmer(Reaction ~ Days + (1 | Subject), sleepstudy) m2 <- update(m, . ~ . - (0 + Days | Subject)) if (getOption("lme4.doublevert.default", "split") == "split") { expect_equivalent(fitted(m1), fitted(m2)) } }) test_that("turn off conv checking for nobs > check.conv.nobsmax", { ## calc derivs and check convergence fm1 <- lmer(Reaction ~ 1 + (1|Days), sleepstudy) nn <- nrow(sleepstudy)-1 ## neither derivs nor conv check fm2 <- update(fm1, control = lmerControl(check.conv.nobsmax = nn)) ## no conv check, do calc derivs fm3 <- update(fm1, control = lmerControl(check.conv.nobsmax = nn, calc.derivs = TRUE)) expect_null(fm2@optinfo$derivs) expect_false(is.null(fm1@optinfo$derivs)) expect_false(is.null(fm3@optinfo$derivs)) expect_equal(fm1@optinfo$conv$lme4, list()) expect_null(fm2@optinfo$conv$lme4) expect_null(fm3@optinfo$conv$lme4) }) test_that("turn off conv checking for npara > check.conv.nparmax", { set.seed(1) n_groups <- 20 n_per_group <- 20 n <- n_groups * n_per_group dat <- data.frame( group = rep(1:n_groups, each = n_per_group), x1 = rnorm(n), x2 = rnorm(n) ) set.seed(101) form <- y ~ 1 + x1 * x2 + (1 + x1|group) dat$y <- simulate(form[-2], ## one-sided formula newdata = dat, family = gaussian, newparams = list(beta = c(-7, 5, -100, 20), theta = c(2.5, 1.4, 6.3), sigma = 2))[[1]] mod1 <- suppressWarnings(lmer(form, data = dat, control = lmerControl( optimizer = "bobyqa", optCtrl = list(maxfun = 10) ))) mod2 <- suppressWarnings(update(mod1, control = lmerControl( optimizer = "bobyqa", optCtrl = list(maxfun = 10), check.conv.nparmax = 3)) ) ## First should give a warning expect_false(is.null(mod1@optinfo$conv$lme4)) ## Second shouldn't be evaluated expect_null(mod2@optinfo$conv$lme4) }) test_that("gradient and Hessian checks are skipped when singular fit occurs",{ set.seed(1) group <- factor(rep(1:3, each = 20)) b <- rnorm(3, mean = 0, sd = 0.01) x <- rnorm(60) y <- x + b[group] + rnorm(60, sd = 1) dat <- data.frame(y, x, group) fm1 <- lmer(y ~ x + (1 | group), data = dat) expect_null(summary(fm1)$optinfo$derivs$gradient) expect_null(summary(fm1)$optinfo$derivs$Hessian) ## Always skipping derivative checks options(lme4.singular.tolerance = 1) fm2 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) expect_null(summary(fm2)$optinfo$derivs$gradient) expect_null(summary(fm2)$optinfo$derivs$Hessian) ## Switching back (in case needed) options(lme4.singular.tolerance = 1e-4) ## force calculating the derivatives even if the fit is singular fm2 <- lmer(y ~ x + (1 | group), control = lmerControl(calc.derivs = TRUE), data = dat) expect_false(is.null(summary(fm2)$optinfo$derivs)) }) test_that("doubleverts expanded in stored formula by default", { lf <- lFormula(Reaction ~ Days + (Days || Subject), sleepstudy) expect_equal(formula(lf), Reaction ~ Days + ((1 | Subject) + (0 + Days | Subject))) }) test_that("parameter counting", { m1 <- lmer(incidence ~ cs(0 + herd | period), data = cbpp) m2 <- suppressWarnings( lmer(incidence ~ cs(0 + herd | period, hom = TRUE), data = cbpp)) expect_equal(attr(logLik(m1), "df"), 18L) expect_equal(attr(logLik(m2), "df"), 4L) }) lme4/tests/testthat/test-doubleVertNotation.R0000644000176200001440000000171515127735433021062 0ustar liggesusers#context("testing '||' notation for independent ranefs") form1 <- Reaction ~ Days + (Days || Subject) form2 <- Reaction ~ Days + (1 | Subject) + (0 + Days | Subject) m1 <- lmer(form1, sleepstudy) m2 <- lmer(form2, sleepstudy) test_that("basic intercept + slope '||' works", { if (!getOption("lme4.doublevert.default", "split") == "split") skip() expect_equivalent(lFormula(form1, sleepstudy)$reTrms, lFormula(form2, sleepstudy)$reTrms) expect_equivalent(fitted(m1), fitted(m2)) if (FALSE) { ## library(glmmTMB) m3 <- glmmTMB(form1, sleepstudy, REML = TRUE, start = list(theta = log(c(25, 6)))) dput(head(fitted(m3), 4L)) } expect_equivalent(head(fitted(m2), 4L), ## fitted values from glmmTMB: c(252.917801422647, 272.708576602026, 292.499351781404, 312.290126960783), tolerance = 5e-5) }) lme4/tests/testthat/test-factors.R0000644000176200001440000000352715127735433016677 0ustar liggesuserstest_that("factors", { set.seed(101) d <- data.frame(x=runif(1000),y=runif(1000),f1=rep(1:10,each=100),f2=rep(1:10,100)) d2 <- transform(d,f1=factor(f1),f2=factor(f2)) expect_that(lm1 <- lmer(y~x+(1|f1/f2),data=d), is_a("lmerMod")) expect_that(lm2 <- lmer(y~x+(1|f1/f2),data=d2),is_a("lmerMod")) expect_equivalent(lm1,lm2) }) ## this will fail/take a long time unless we handle interactions carefully test_that("savvy interactions", { dd <- data.frame(y = 1:10000, f1 = factor(1:10000), f2 = factor(1:10000)) F1 <- lFormula(y ~ 1 + (1|f1/f2), data =dd, control = lmerControl(check.nobs.vs.nlev = "ignore", check.nobs.vs.nRE = "ignore")) expect_equal(dim(F1$reTrms$Zt), c(20000, 10000)) }) test_that("savvy factor level ordering", { check_f <- function(n = 200, frac = 0.7, fix_order = TRUE, check_order = TRUE) { dd <- expand.grid(f1 = seq(n), f2 = seq(n)) dd <- within(dd, { f1 <- factor(f1, levels = sample(unique(f1))) f2 <- factor(f2, levels = sample(unique(f2))) }) dd <- dd[sample(nrow(dd), size = round(frac*nrow(dd)), replace = FALSE), ] dd <- within(dd, { f12 <- f1:f2 f12d <- droplevels(f12) }) new_levels <- with(dd, levels(`%i%`(f1,f2, fix.order = fix_order))) ## don't want to pay the cost of checking if unneeded {for benchmarking} if (fix_order && check_order) { stopifnot(identical(levels(dd$f12d), new_levels)) } return(TRUE) } ## should fail within check_f() if levels don't match expect_true(check_f(), "'savvy' factor levels match brute-force version") ## library(microbenchmark) ## set.seed(101) ## m1 <- microbenchmark(check_f(fix_order = TRUE, check_order = FALSE), ## check_f(fix_order = FALSE)) }) lme4/tests/testthat/test-rank.R0000644000176200001440000000744215127735433016171 0ustar liggesusers#context("testing fixed-effect design matrices for full rank") test_that("lmerRank", { set.seed(101) n <- 20 x <- y <- rnorm(n) d <- data.frame(x,y, z = rnorm(n), r = sample(1:5, size=n, replace=TRUE), y2 = y + c(0.001, rep(0,n-1))) expect_message(fm <- lmer( z ~ x + y + (1|r), data=d), "fixed-effect model matrix is .*rank deficient") ## test reconstitution of full parameter vector (with NAs) expect_equal(names(fixef(fm,add.dropped=TRUE)), c("(Intercept)","x","y")) expect_equal(fixef(fm,add.dropped=TRUE)[1:2], fixef(fm)) expect_equal(nrow(anova(fm)), 1L) expect_error(lmer( z ~ x + y + (1|r), data=d, control=lmerControl(check.rankX="stop")), "rank deficient") expect_error(lmer( z ~ x + y + (1|r), data=d, control=lmerControl(check.rankX="ignore")), "not positive definite") ## should work: expect_is(lmer( z ~ x + y2 + (1|r), data=d), "lmerMod") d2 <- expand.grid(a=factor(1:4),b=factor(1:4),rep=1:10) n <- nrow(d2) d2 <- transform(d2,r=sample(1:5, size=n, replace=TRUE), z=rnorm(n)) d2 <- subset(d2,!(a=="4" & b=="4")) expect_error(lmer( z ~ a*b + (1|r), data=d2, control=lmerControl(check.rankX="stop")), "rank deficient") expect_message(fm <- lmer( z ~ a*b + (1|r), data=d2), "fixed-effect model matrix is rank deficient") d2 <- transform(d2, ab=droplevels(interaction(a,b))) ## should work: expect_is(fm2 <- lmer( z ~ ab + (1|r), data=d2), "lmerMod") expect_equal(logLik(fm), logLik(fm2)) expect_equal(sum(anova(fm)[, "npar"]), anova(fm2)[, "npar"]) expect_equal(sum(anova(fm)[, "Sum Sq"]), anova(fm2)[, "Sum Sq"]) }) test_that("glmerRank", { set.seed(111) n <- 100 x <- y <- rnorm(n) d <- data.frame(x, y, z = rbinom(n,size=1,prob=0.5), r = sample(1:5, size=n, replace=TRUE), y2 = ## y + c(0.001,rep(0,n-1)), ## too small: get convergence failures ## FIXME: figure out how small a difference will still fail? rnorm(n)) expect_message(fm <- glmer( z ~ x + y + (1|r), data=d, family=binomial), "fixed-effect model matrix is rank deficient") expect_error(glmer( z ~ x + y + (1|r), data=d, family=binomial, control=glmerControl(check.rankX="stop")), "rank deficient.*rank.X.") expect_is(glmer( z ~ x + y2 + (1|r), data=d, family=binomial), "glmerMod") }) test_that("nlmerRank", { set.seed(101) n <- 1000 nblock <- 15 x <- abs(rnorm(n)) y <- rnorm(n) z <- rnorm(n,mean=x^y) r <- sample(1:nblock, size=n, replace=TRUE) d <- data.frame(x,y,z,r) ## save("d","nlmerRank.RData") ## see what's going on with difference in contexts fModel <- function(a,b) (exp(a)*x)^(b*y) fModf <- deriv(body(fModel), namevec = c("a","b"), func = fModel) fModel2 <- function(a,b,c) (exp(a+c)*x)^(b*y) fModf2 <- deriv(body(fModel2), namevec = c("a","b","c"), func = fModel2) ## should be OK: fails in test mode? nlmer(y ~ fModf(a,b) ~ a|r, d, start = c(a=1,b=1)) ## FIXME: this doesn't get caught where I expected expect_error(nlmer(y ~ fModf2(a,b,c) ~ a|r, d, start = c(a=1,b=1,c=1)),"Downdated VtV") }) test_that("ranksim", { set.seed(101) x <- data.frame(id = factor(sample(10, 100, replace = TRUE))) x$y <- rnorm(nrow(x)) x$x1 <- 1 x$x2 <- ifelse(x$y<0, rnorm(nrow(x), mean=1), rnorm(nrow(x), mean=-1)) m <- suppressMessages(lmer(y ~ x1 + x2 + (1 | id), data=x)) expect_equal(simulate(m, nsim = 1, use.u = FALSE, newdata=x, seed=101), simulate(m, nsim = 1, use.u = FALSE, seed=101)) }) lme4/tests/testthat/test-NAhandling.R0000644000176200001440000002016215127735433017233 0ustar liggesusersstopifnot(require("testthat"), require("lme4")) #context("NA (and Inf) handling") ## Modified sleepstudy data : sleepst.a <- sleepstudy rownames(sleepst.a) <- paste0("a", rownames(sleepstudy)) sleepstudyNA <- within(sleepst.a, Reaction[1:3] <- NA) sleepstudyNA2 <- within(sleepst.a, Days[1:3] <- NA) sleepInf <- within(sleepstudy, Reaction[Reaction > 400] <- Inf) ## Modified cake data : cakeNA <- rbind(cake, tail(cake,1)) cakeNA[nrow(cakeNA), "angle"] <- NA ## Create new data frame with some NAs in fixed effect cakeNA.X <- within(cake, temp[1:5] <- NA) ## NA values in random effects -- should get treated cakeNA.Z <- within(cake, replicate[1:5] <- NA) test_that("naming", { ## baseline model fm1 <- lmer(Reaction~Days+(Days|Subject), sleepst.a) ## default: na.omit fm2 <- update(fm1, data=sleepstudyNA, control=lmerControl(check.conv.grad="ignore")) expect_equal(head(names(fitted(fm1))), paste0("a",1:6)) expect_equal(head(names(fitted(fm2))), paste0("a",4:9)) expect_equal(names(predict(fm2)), names(fitted(fm2))) expect_equal(length(p1 <- predict(fm2)), 177) ## predict with na.exclude -> has 3 NA's, but otherwise identical: expect_equal(length(p2 <- predict(fm2, na.action=na.exclude)), 180) expect_identical(p1, p2[!is.na(p2)]) expect_equal(length((s1 <- simulate(fm1,1))[[1]]),180) expect_equal(length((s2 <- simulate(fm2,1))[[1]]),177) expect_equal(head(rownames(s1)),paste0("a",1:6)) expect_equal(head(rownames(s2)),paste0("a",4:9)) ## test simulation expect_is(attr(simulate(fm2),"na.action"),"omit") expect_is(refit(fm2,simulate(fm2)),"merMod") expect_equal(fixef(fm2), fixef(refit(fm2, sleepstudyNA$Reaction)), tolerance = 1e-5) fm2ex <- update(fm2, na.action=na.exclude) expect_equal(nrow(ss2 <- simulate(fm2ex)),180) expect_is(refit(fm2,ss2[[1]]),"merMod") ## issue #197, 18 new subjects; some with NA in y d2 <- sleepstudyNA[c(1:180, 1:180),] d2[,"Subject"] <- factor(rep(1:36, each=10)) d2[d2$Subject == 19, "Reaction"] <- NA expect_equal(dim( simulate(fm1, newdata=d2, allow.new.levels=TRUE) ), c(360,1)) ## na.pass (pretty messed up) expect_error(update(fm1,data=sleepstudyNA, control=lmerControl(check.conv.grad="ignore"), na.action=na.pass), "NA/NaN/Inf in 'y'") sleepstudyNA2 <- within(sleepst.a, Days[1:3] <- NA) expect_error(fm4 <- update(fm1, data = sleepstudyNA2, control=lmerControl(check.conv.grad="ignore"), na.action=na.pass),"NA in Z") expect_is(suppressWarnings(confint(fm2,method="boot",nsim=3, quiet=TRUE)),"matrix") expect_error(update(fm1, data = sleepstudyNA2, control = lmerControl(check.conv.grad="ignore"), na.action = na.pass), "NA in Z") expect_is(suppressWarnings( ci2 <- confint(fm2, method="boot", nsim=3, quiet=TRUE)), "matrix") }) test_that("other_NA", { expect_error(lmer(Reaction ~ Days + (Days | Subject), sleepInf), "\\") fm0 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake) ## NA's in response : fm1 <- update(fm0, data = cakeNA) expect_true(all.equal( fixef(fm0), fixef(fm1))) expect_true(all.equal(VarCorr(fm0),VarCorr(fm1))) expect_true(all.equal( ranef(fm0), ranef(fm1))) fm1_omit <- update(fm1, na.action = na.omit) fm1_excl <- update(fm1, na.action = na.exclude) expect_error(update(fm1, na.action = na.pass), "NA/NaN") expect_error(update(fm1, na.action = na.fail), "missing values in object") fm1_omit@call <- fm1@call ## <- just for comparing: expect_equal(fm1, fm1_omit) expect_equal(length(fitted(fm1_omit)), 270) expect_equal(length(fitted(fm1_excl)), 271) expect_true(is.na(tail(predict(fm1_excl),1))) ## test predict.lm d <- data.frame(x = 1:10, y = c(rnorm(9),NA)) lm1 <- lm(y~x, data=d, na.action=na.exclude) expect_is(predict(lm1), "numeric") expect_equal(1, sum(is.na(predict(lm1, newdata = data.frame(x=c(1:4,NA)))))) ## Triq examples ... m.lmer <- lmer (angle ~ temp + (1 | recipe) + (1 | replicate), data=cake) ## NAs in fixed effect p1_pass <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.pass) expect_true(length(p1_pass)==nrow(cakeNA.X)) expect_true(all(is.na(p1_pass[1:5]))) p1_omit <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.omit) p1_exclude <- predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.exclude) expect_true(length(p1_omit)==nrow(na.omit(cakeNA.X))) expect_true(length(p1_exclude)==nrow(cakeNA.X)) expect_true(all.equal(c(na.omit(p1_exclude)),p1_omit)) expect_error(predict(m.lmer, newdata=cakeNA.X, re.form=NA, na.action=na.fail), "missing values in object") ## now try it with re.form==NULL p2_pass <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.pass) expect_true(length(p2_pass)==nrow(cakeNA.X)) expect_true(all(is.na(p2_pass[1:5]))) p2_omit <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.omit) p2_exclude <- predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.exclude) expect_true(length(p2_omit)==nrow(na.omit(cakeNA.X))) expect_true(all.equal(c(na.omit(p2_exclude)),p2_omit)) expect_error(predict(m.lmer, newdata=cakeNA.X, re.form=NULL, na.action=na.fail), "missing values in object") ## experiment with NA values in random effects -- should get treated expect_error(predict(m.lmer, newdata=cakeNA.Z, re.form=NULL), "NAs are not allowed in prediction data") p4 <- predict(m.lmer, newdata=cakeNA.Z, re.form=NULL, allow.new.levels=TRUE) p4B <- predict(m.lmer, newdata=cakeNA.Z, re.form=~1|recipe, allow.new.levels=TRUE) expect_true(all.equal(p4[1:5],p4B[1:5])) p4C <- predict(m.lmer, newdata=cakeNA.Z, re.form=NA) d <- data.frame(x=runif(100),f=factor(rep(1:10,10))) set.seed(101) u <- rnorm(10) d <- transform(d,y=rnorm(100,1+2*x+u[f],0.2)) d0 <- d d[c(3,5,7),"x"] <- NA ## 'omit' and 'exclude' are the only choices under which ## we will see NA values in the results fm0 <- lmer(y~x+(1|f), data=d0) ## no 'na.action' attribute because no NAs in this data set expect_equal(attr(model.frame(fm0),"na.action"),NULL) fm1 <- update(fm0, data=d) ## no NAs in predict or residuals because na.omit expect_false(any(is.na(predict(fm1)))) expect_false(any(is.na(residuals(fm1)))) fm2 <- update(fm1,na.action="na.exclude") ## no NAs in predict or residuals because na.omit nNA <- sum(is.na(d$x)) expect_equal(sum(is.na(predict(fm2))),nNA) expect_equal(sum(is.na(residuals(fm2))),nNA) expect_error(fm3 <- lmer(y~x+(1|f), data=d, na.action="na.pass"), "(Error in qr.default|NA/NaN/Inf in foreign function call)") expect_is(refit(fm0),"merMod") expect_is(refit(fm1),"merMod") expect_is(refit(fm2),"merMod") ## GH 420: NAs in training data should *not* get ## carried over into predictions! fm4 <- lmer(Reaction~Days+(1|Subject),sleepstudyNA2) pp4 <- predict(fm4,newdata=sleepstudy) expect_equal(length(pp4),nrow(sleepstudy)) expect_equal(sum(is.na(pp4)),0) }) test_that("NAs in fitting data ignored in newdata with random.only=TRUE", { set.seed(101) dd <- data.frame(x=c(rnorm(199),NA),y=rnorm(200), f=factor(rep(1:10,each=20)), g=factor(rep(1:20,each=10))) m1 <- lmer(y~x+(1|f)+(1|g),data=dd,na.action=na.exclude) expect_equal(length(predict(m1,newdata=dd[1:5,],random.only=TRUE)),5) nd.NA <- dd[1:5,] nd.NA$x[5] <- NA ## ?? not *quite* sure what should happen here ... predict(m1,newdata=nd.NA,random.only=TRUE) }) lme4/tests/testthat/test-covariance_nlmer.R0000644000176200001440000000444515127735433020545 0ustar liggesusers## There are lots of problems with nlmer. ## If it eventually gets fixed, comparing the covariance structures between ## lme4::nlmer and the nlme::nlme may be worthwhile. ## The following tests are skipped since (most) of them fail. other_mod <- readRDS( system.file("testdata", "test-covariance_structures_data.rds", package = "lme4") ) ## lme4 nonlinear mixed effects model startvec <- c(Asym = 200, xmid = 725, scal = 350) nm <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ Asym|Tree, Orange, start = startvec) nm.us <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ us(Asym|Tree), Orange, start = startvec) nm.cs <- nlmer(circumference ~ SSlogis(age, Asym, xmid, scal) ~ cs(Asym|Tree), Orange, start = startvec) test_that("nlmer tests", { skip() ## Ensuring unstructured covariance results are the same as default expect_equal(coef(nm), coef(nm.us)) expect_equal(fixef(nm), fixef(nm.us)) ## Ensuring unstructured covariance results are the same as default expect_equal(fixef(nm), fixef(nm.us)) # integration tests for sigma expect_equal(sigma(nm), sigma(nm.us)) expect_equal_nocheck(sigma(nm), other_mod$nm.nlme_sigma, tolerance = 5e-4) expect_equal_nocheck(sigma(nm.cs), other_mod$nm.nlme.cs_sigma) ## Log likelihood tests expect_equal(logLik(nm), logLik(nm.us)) expect_equal_nocheck(logLik(nm.us), other_mod$nm.nlme_logLik) expect_equal_nocheck(logLik(nm.cs), other_mod$nm.nlme.cs_logLik) ## Integration tests for vcov nm_vcov <- suppressWarnings(vcov(nm)) nm.us_vcov <- suppressWarnings(vcov(nm.us)) expect_equal(nm_vcov, nm.us_vcov) expect_equal_nocheck(nm_vcov, other_mod$nm.nlme_vcov) nm.cs_vcov <- suppressWarnings(vcov(nm.cs)) expect_equal_nocheck(nm.cs_vcov, other_mod$nm.nlme.cs_vcov) ## Integration tests for ranef expect_equal(ranef(nm), ranef(nm.us)) expect_equal_nocheck(as.matrix(other_mod$nm.nlme_ranef), as.matrix(ranef(nm)$Tree)) expect_equal_nocheck(as.matrix(other_mod$nm.nlme.cs_ranef), as.matrix(ranef(nm.cs)$Tree)) ## Integration tests for predict expect_equal(predict(nm), predict(nm.us)) expect_equal_nocheck(other_mod$nm.nlme_predict, predict(nm)) expect_equal_nocheck(other_mod$nm.nlme.cs_predict, predict(nm.cs)) })lme4/tests/testthat/test-isSingular.R0000644000176200001440000000731215206621104017335 0ustar liggesuserslibrary("testthat") test_that("checking singular fit for covariance", { set.seed(1) test.us <- new("Covariance.us", nc = 4L, simulate = TRUE) expect_equal(isSingular(test.us), FALSE) test.diag <- new("Covariance.diag", nc = 4L, simulate = TRUE) expect_equal(isSingular(test.diag), FALSE) test.cs <- new("Covariance.cs", nc = 4L, hom = FALSE, simulate = TRUE) test.homcs <- new("Covariance.cs", nc = 4L, hom = TRUE, simulate = TRUE) expect_equal(isSingular(test.cs), FALSE) expect_equal(isSingular(test.homcs), FALSE) test.ar1 <- new("Covariance.ar1", nc = 4L, hom = TRUE, simulate = TRUE) test.hetar1 <- new("Covariance.ar1", nc = 4L, hom = FALSE, simulate = TRUE) expect_equal(isSingular(test.ar1), FALSE) expect_equal(isSingular(test.hetar1), FALSE) test.reCovs <- c(test.us, test.diag, test.cs, test.homcs, test.ar1, test.hetar1) ## tests should fail once one of the diagonal entries is 0 sapply(test.reCovs, function(i){ new_theta <- getTheta(i) new_theta[1] <- 0 test <- setTheta(i, new_theta) expect_equal(isSingular(test), TRUE) }) test.reCovs.lim <- test.reCovs[-c(1:2)] ## tests should fail once rho is equal to -1 or 1 sapply(test.reCovs.lim, function(i){ test <- setVC(i, vcomp = getVC(i)$vcomp, ccomp = 1) expect_equal(isSingular(test), TRUE) test2 <- setVC(i, vcomp = getVC(i)$vcomp, ccomp = -1) expect_equal(isSingular(test2), TRUE) }) }) test_that("checking singular fit for merMod", { set.seed(101) n_groups <- 20 n_per_group <- 20 n <- n_groups * n_per_group dat <- data.frame( group1 = rep(1:n_groups, each = n_per_group), group2 = rep(1:n_groups, each = n_per_group), x1 = rnorm(n), x2 = rnorm(n) ) form <- y ~ 1 + (1 + x1|group1) + (1 + x2|group2) dat$y <- simulate(form[-2], ## one-sided formula newdata = dat, family = gaussian, newparams = list(beta = c(-2), theta = c(2, 3, 4, 2, 3, 4), sigma = 2))[[1]] mod <- lmer(form, data = dat) ## should be no issues here, ensuring isSingular is not broken expect_equal(isSingular(mod), FALSE) form2 <- y2 ~ 1 + (1 + x1|group1) + (1 + x2|group2) dat$y2 <- simulate(form[-2], newdata = dat, family = gaussian, newparams = list(beta = c(-2), theta = c(0, 0, 0, 2.5, 1.5, 0.8), sigma = 2))[[1]] mod2 <- suppressMessages( suppressWarnings(lmer(form2, data = dat)) ) ## second one, should be an issue with group 1 as we set thetas = 0 ## loosen tolerance: failing on linux arm64 on r-universe expect_equal(isSingular(mod2, tol = 5e-3), TRUE) ## also need to consider the glmer case form <- y ~ 1 + (1 + x1 | group1) + (1 + x2 | group2) dat$y <- simulate(form[-2], newdata = dat, family = poisson(link = "log"), newparams = list(theta = c(0, 0, 0, 1.0, 0.5, 0.3), beta = 2))[[1]] form2 <- y2 ~ 1 + (1 + x1 | group1) + (1 + x2 | group2) dat$y2 <- simulate(form2[-2], newdata = dat, family = Gamma(link = "log"), newparams = list(theta = c(0, 0, 0, 1.0, 0.5, 0.3), beta = 2, sigma = 2))[[1]] mod_pois <- suppressWarnings( glmer(form, family = poisson(link = "log"), data = dat)) mod_gam <- suppressWarnings( glmer(form2, family = Gamma(link = "log"), data = dat)) expect_equal(isSingular(mod_pois), TRUE) expect_equal(isSingular(mod_gam), TRUE) }) lme4/tests/testthat/test-predict.R0000644000176200001440000007004415225703727016666 0ustar liggesuserslibrary("lattice") testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } do.plots <- TRUE L <- load(system.file("testdata/lme-tst-fits.rda", package="lme4", mustWork=TRUE)) if (getRversion() > "3.0.0") { ## saved fits are not safe with old R versions gm1 <- fit_cbpp_1 fm1 <- fit_sleepstudy_1 fm2 <- fit_sleepstudy_2 fm3 <- fit_penicillin_1 fm4 <- fit_cake_1 } else { gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), data = cbpp, family = binomial) fm1 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy) fm2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm3 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) fm4 <- lmer(angle ~ temp + recipe + (1 | replicate), data=cake) } if (testLevel>1) { #context("predict") test_that("fitted values", { p0 <- predict(gm1) p0B <- predict(gm1, newdata=cbpp) expect_equal(p0, p0B, tolerance=2e-5) ## ? not sure why high tolerance necessary ? works OK on Linux/R 3.5.0 ## fitted values, unconditional (level-0) p1 <- predict(gm1, re.form=NA) expect_true(length(unique(p1))==length(unique(cbpp$period))) ## fitted values, random-only p1R <- predict(gm1, random.only=TRUE) expect_equal(p1+p1R,p0) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") ## neither fixed nor random -- all zero expect_equal(unique(predict(gm1,re.form=NA,random.only=TRUE)),0) }) test_that("predict with newdata", { newdata <- with(cbpp, expand.grid(period=unique(period),herd=unique(herd))) ## new data, all RE p2 <- predict(gm1,newdata) ## new data, level-0 p3 <- predict(gm1,newdata, re.form=NA) p3R <- predict(gm1,newdata, random.only=TRUE) expect_equal(p3+p3R,p2) if (do.plots) matplot(cbind(p2,p3),col=1:2,type="b") }) test_that("predict on response scale", { p0 <- predict(gm1) p5 <- predict(gm1,type="response") expect_equal(p5, plogis(p0)) }) test_that("predict with newdata and RE", { newdata <- with(cbpp,expand.grid(period=unique(period),herd=unique(herd))) ## explicitly specify RE p2 <- predict(gm1,newdata) p4 <- predict(gm1,newdata, re.form=~(1|herd)) expect_equal(p2, p4) }) test_that("effects of new RE levels", { newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) newdata2 <- rbind(newdata, data.frame(period=as.character(1:4), herd=rep("new",4))) expect_error(predict(gm1, newdata2), "new levels detected in newdata: new") newdata3 <- rbind(newdata, data.frame(period=as.character(1), herd = paste0("new", 1:50))) expect_error(predict(gm1, newdata3), "new levels detected in newdata: new1, new2,") p2 <- predict(gm1, newdata) p6 <- predict(gm1, newdata2, allow.new.levels=TRUE) expect_equal(p2, p6[1:length(p2)]) ## original values should match ## last 4 values should match unconditional values expect_true(all(tail(p6,4) == predict(gm1, newdata=data.frame(period=factor(1:4)), re.form=NA))) }) test_that("multi-group model", { ## fitted values p0 <- predict(fm3) expect_equal(head(round(p0,4)), c(`1` = 25.9638, `2` = 22.7663, `3` = 25.7147, `4` = 23.6799, `5` = 23.7629, `6` = 20.773)) ## fitted values, unconditional (level-0) p1 <- predict(fm3, re.form=NA) expect_equal(unique(p1),22.9722222222251) if (do.plots) matplot(cbind(p0,p1),col=1:2,type="b") }) test_that("multi-group model with new data", { newdata <- with(Penicillin,expand.grid(plate=unique(plate),sample=unique(sample))) ## new data, all RE p2 <- predict(fm3, newdata) ## new data, level-0 p3 <- predict(fm3, newdata, re.form=NA) ## explicitly specify RE p4 <- predict(fm3, newdata, re.form= ~(1|plate)+(~1|sample)) p4B <- predict(fm3, newdata, re.form= ~(1|sample)+(~1|plate)) ## **** expect_equal(p2,p4) expect_equal(p4,p4B) p5 <- predict(fm3,newdata, re.form=~(1|sample)) p6 <- predict(fm3,newdata, re.form=~(1|plate)) if (do.plots) matplot(cbind(p2,p3,p5,p6),type="b",lty=1,pch=16) }) test_that("random-slopes model", { p0 <- predict(fm2) p1 <- predict(fm2, re.form=NA) ## linear model, so results should be identical patterns but smaller -- ## not including intermediate days newdata <- with(sleepstudy,expand.grid(Days=range(Days),Subject=unique(Subject))) newdata$p2 <- predict(fm2,newdata) newdata$p3 <- predict(fm2,newdata, re.form=NA) newdata$p4 <- predict(fm2,newdata, re.form=~(0+Days|Subject)) newdata$p5 <- predict(fm2,newdata, re.form=~(1|Subject)) ## reference values from an apparently-working run refval <- structure( list(Days = c(0, 9, 0, 9, 0, 9), Subject = structure(c(1L, 1L, 2L, 2L, 3L, 3L), levels = c("308", "309", "310", "330", "331", "332", "333", "334", "335", "337", "349", "350", "351", "352", "369", "370", "371", "372"), class = "factor"), p2 = c(253.663652396798, 430.66001930835, 211.006415533628, 227.634788908917, 212.444742696829, 257.61053840953), p3 = c(251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848, 251.405104848485, 345.610678484848), p4 = c(251.405104848485, 428.401471760037, 251.405104848485, 268.033478223774, 251.405104848485, 296.570900561186), p5 = c(253.663652396798, 347.869226033161, 211.006415533628, 305.211989169991, 212.444742696829, 306.650316333193)), out.attrs = list(dim = c(Days = 2L, Subject = 18L), dimnames = list( Days = c("Days=0", "Days=9"), Subject = c("Subject=308", "Subject=309", "Subject=310", "Subject=330", "Subject=331", "Subject=332", "Subject=333", "Subject=334", "Subject=335", "Subject=337", "Subject=349", "Subject=350", "Subject=351", "Subject=352", "Subject=369", "Subject=370", "Subject=371", "Subject=372")) ), row.names = c(NA, 6L), class = "data.frame") expect_equal(head(newdata), refval, tol=5e-7) }) test_that("predict and plot random slopes", { tmpf <- function(data,...) { data$Reaction <- predict(fm2,data,...) if (do.plots) xyplot(Reaction~Days,group=Subject,data=data,type="l") return(unname(head(round(data$Reaction,3)))) } expect_equal(tmpf(sleepstudy),c(253.664, 273.33, 292.996, 312.662, 332.329, 351.995)) expect_equal(tmpf(sleepstudy, re.form=NA), c(251.405, 261.872, 272.34, 282.807, 293.274, 303.742)) expect_equal(tmpf(sleepstudy, re.form= ~(0+Days|Subject)), c(251.405, 271.071, 290.738, 310.404, 330.07, 349.736)) expect_equal(tmpf(sleepstudy, re.form= ~(1|Subject)), c(253.664, 264.131, 274.598, 285.066, 295.533, 306)) }) test_that("fewer random effect levels than original", { ## from 'Colonel Triq' summary(fm4) ## replicate 1 only appears in rows 1:18. ## rownames(cake[cake$replicate==1,]) predict(fm4, newdata=cake[-1:-17,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=NA) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate)) predict(fm4, newdata=cake[-1:-18,], re.form=~ (1 | replicate), allow.new.levels=TRUE) ## p0 <- predict(fm1,newdata=data.frame(Days=6,Subject=c("308","309"))) p1 <- predict(fm1,newdata=data.frame(Days=rep(6,4), Subject=c("308","309"))) expect_equal(rep(unname(p0),2),unname(p1)) p2 <- predict(fm1,newdata=data.frame(Days=6,Subject="308")) nd <- data.frame(Days=6, Subject=factor("308",levels=levels(sleepstudy$Subject))) p3 <- predict(fm1,newdata=nd) expect_equal(p2,p3) expect_equal(p2,p0[1]) }) test_that("only drop columns when using new data", { ## Stack Overflow 34221564: ## should only drop columns from model matrix when using *new* data ## NB: Fit depends on optimizer somewhat: "nloptwrap" is really better than "bobyqa" library(splines) sleep <- sleepstudy #get the sleep data set.seed(1234567) sleep$age <- as.factor(sample(1:3,length(sleep),rep=TRUE)) form1 <- Reaction ~ Days + ns(Days, df=4) + age + Days:age + (Days | Subject) m4 <- lmer(form1, sleep) # fixed-effect model matrix is rank deficient so dropping 1 column / coefficient expect_lte(REMLcrit(m4), 1713.171) # FIXME !? why this regression?? had 1700.6431; "bobyqa" gave 1713.171 expect_equal(unname(head(predict(m4, re.form=NA))), c(255.203, 259.688, 265.71, 282.583, 294.784, 304.933), tolerance = 0.008) }) test_that("only look for columns that exist in re.form", { ## GH 457 set.seed(101) n <- 200 dd <- data.frame(x=1:n, f=factor(rep(1:10,n/10)), g=factor(rep(1:20,each=n/20)), h=factor(rep(1:5,n/5)), y=rnorm(n)) m1 <- lmer(y~1 + f + (1|h/f) + (poly(x,2)|g), data=dd, control=lmerControl(calc.derivs=FALSE)) expect_equal(unname(predict(m1,re.form= ~1 | h/f, newdata=dd[1,])), 0.14786, tolerance=1e-4) expect_equal(unname(predict(m1,re.form= ~poly(x,2) | g, newdata=dd[1,])), 0.1533, tolerance=.001) ## *last* RE not included (off-by-one error) m1B <- lmer(y~1 + f + (1|g) + (1|h), data=dd, control=lmerControl(calc.derivs=FALSE, check.conv.singular = "ignore")) expect_equal(unname(predict(m1B,re.form=~(1|g),newdata=data.frame(f="1",g="2"))),0.1512895,tolerance=1e-5) set.seed(101) n <- 100 xx <- c("r1", "r2", "r3", "r4", "r5") xxx <- c("e1", "e2", "e3") p <- 0.3 School <- factor(sample(xxx, n, replace=TRUE), levels=xxx, ordered=FALSE) Rank <- factor(sample(xx, n, replace=TRUE), levels=xx, ordered=FALSE) df1 <- data.frame( ID = as.integer(runif(n, min = 1, max = n/7)), xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School, Rank, yx = as.factor(rbinom(n, size = 1, prob = p)) ) df1 <- df1[order(df1$ID, decreasing=FALSE),] mm2 <- glmer(yx ~ xx1 + xx2 + xx3 + Rank + (1 | ID) + (1 | School / Rank), data = df1, family = "binomial",control = glmerControl(calc.derivs =FALSE)) n11 <- data.frame(School= factor("e1", levels = levels(df1$School),ordered=FALSE), Rank = factor("r1", levels = levels(df1$Rank), ordered=FALSE), xx1=8.58, xx2=8.75, xx3=7.92) expect_equal(unname(predict(mm2, n11, type="response",re.form= ~(1 | School / Rank))), 0.1174628,tolerance=1e-5) ## bad factor levels mm3 <- update(mm2, . ~ . - (1|ID)) n12 = data.frame(School="e3",Rank="r2",xx1=8.58,xx2=8.75,xx3=7.92) expect_equal(unname(predict(mm3, n12, type="response")),0.1832894,tolerance=1e-5) ## GH #452 ## FIXME: would like to find a smaller/faster example that would test the same warning (10+ seconds) set.seed(101) n <- 300 df2 <- data.frame( xx1 = runif(n, min = 0, max = 10), xx2 = runif(n, min = 0, max = 10), xx3 = runif(n, min = 0, max = 10), School = factor(sample(xxx, n,replace=TRUE)), Rank = factor(sample(xx, n, replace=TRUE)), yx = as.factor(rbinom(n, size = 1, prob = p)) ) mm4 <- suppressWarnings(glmer(yx ~ xx1 + xx2 + xx3 + Rank + (Rank|School), data = df2, family = "binomial",control = glmerControl(calc.derivs =FALSE))) ## set tolerance to 0.1 (!) to pass win-builder on R-devel/i386 (only: ## tolerance = 3e-5 is OK for other combinations of (R-release, R-devel) x (i386,x64) expect_equal(unname(predict(mm4, n11, type="response")), 0.2675081, tolerance=0.1) }) test_that("simulation works with non-factor", { set.seed(12345) dd <- data.frame(a=gl(10,100), b = rnorm(1000)) test2 <- suppressMessages(simulate(~1+(b|a), newdata=dd, family=poisson, newparams= list(beta = c("(Intercept)" = 1), theta = c(1,1,1)))) expect_is(test2,"data.frame") }) set.seed(666) n <- 500 df <- data.frame(y=statmod::rinvgauss(n, mean=1, shape=2), id=factor(1:20)) model_fit <- glmer(y ~ 1 + (1|id), family = inverse.gaussian(link = "inverse"), data = df, control=glmerControl(check.conv.singular="ignore")) test_that("simulation works for inverse gaussian", { expect_equal(mean(simulate(model_fit)[[1]]), 1.02704392575914, tolerance=1e-5) }) test_that("simulation complains appropriately about bad family", { ig <- inverse.gaussian() ig$family <- "junk" model_fit2 <- glmer(y ~ 1 + (1|id), family = ig, data = df, control=glmerControl(check.conv.singular="ignore")) expect_error(simulate(model_fit2),"simulation not implemented for family") }) test_that("prediction from large factors", { set.seed(101) N <- 50000 X <- data.frame(y=rpois(N, 5), obs=as.factor(1:N)) fm <- glmer(y ~ (1|obs), family="poisson", data=X, control=glmerControl(check.conv.singular="ignore")) ## FIXME: weak tests. The main issue here is that these should ## be reasonably speedy and non-memory-hogging, but those are ## hard to test portably ... expect_is(predict(fm, re.form=~(1|obs)), "numeric") expect_is(predict(fm, newdata=X), "numeric") }) test_that("prediction with gamm4", { if (suppressWarnings(requireNamespace("gamm4"))) { ## loading gamm4 warngs "replacing previous import 'Matrix::update' by 'lme4::update' when loading 'gamm4'" ## from ?gamm4 set.seed(0) ## simulate 4 term additive truth dat <- mgcv::gamSim(1,n=400,scale=2,verbose=FALSE) ## Now add 20 level random effect `fac'... dat$fac <- fac <- as.factor(sample(1:20,400,replace=TRUE)) dat$y <- dat$y + model.matrix(~fac-1)%*%rnorm(20)*.5 br <- gamm4::gamm4(y~s(x0)+x1+s(x2),data=dat,random=~(1|fac)) expect_warning(ss <- simulate(br$mer), "modified RE names") expect_equal(dim(ss), c(400,1)) } }) test_that("prediction with spaces in variable names", { cbpp$`silly period` <- cbpp$period m <- glmer(cbind(incidence,size-incidence) ~ `silly period` + (1|herd), family=binomial, data=cbpp) expect_equal(round(head(predict(m)),3), c(`1` = -0.809, `2` = -1.801, `3` = -1.937, `4` = -2.388, `5` = -1.697, `6` = -2.689)) }) if (requireNamespace("statmod")) { test_that("simulate with rinvgauss", { dd <- data.frame(f=factor(rep(1:20,each=10))) dd$y <- simulate(~1+(1|f), seed=101, family=inverse.gaussian, newdata=dd, ## ?? gives NaN (sqrt(eta)) for low beta ? newparams=list(beta=5,theta=1,sigma=1))[[1]] suppressMessages(m <- glmer(y~1+(1|f), family=inverse.gaussian, data=dd)) set.seed(101) expect_equal(head(unlist(simulate(m))), c(sim_11 = 0.451329390087728, sim_12 = 0.629516371309772, sim_13 = 0.481236633500098, sim_14 = 0.170060386109077, sim_15 = 0.258742371516342, sim_16 = 0.949617440586848)) }) } ## GH 631 test_that("sparse contrasts don't mess up predict()", { dd <- expand.grid(f = factor(1:101), rep1 = factor(1:2), rep2 = 1:2) dd$y <- suppressMessages(simulate(~1 + (rep1|f), seed = 101, newdata = dd, newparams = list(beta = 1, theta = rep(1,3), sigma = 1), family = gaussian)[[1]]) m1 <- lmer( y ~ 1 + (1|f), data = dd) p1 <- predict(m1) p2 <- predict(m1, newdata = dd) expect_identical(p1, p2) }) } ## testLevel > 1 test_that("prediction with . in formula + newdata", { set.seed(101) mydata <- data.frame( groups = rep(1:3, each = 100), x = rnorm(300), dv = rnorm(300) ) train_subset <- sample(1:300, 300 * .8) train <- mydata[train_subset,] test <- mydata[-train_subset,] mod <- lmer(dv ~ . - groups + (1 | groups), data = train) p1 <- predict(mod, newdata = test) mod2 <- lmer(dv ~ x + (1 | groups), data = train) p2 <- predict(mod2, newdata = test) expect_identical(p1, p2) }) test_that("simulate with a factor with one level", { set.seed(1241) y <- factor(c(rep(0,1000), 1, rep(0,1000), 1), levels = c("0","1")) x <- rep(c("A","B"),each = 1001) mod <- glmer(y ~ 1 + (1|x),family = binomial, control = glmerControl(check.conv.singular = "ignore")) s <- simulate(mod,newdata = data.frame(x = "A"), nsim = 10) ## very low mean, all simulated values zero expect_true(all(s == 0)) }) test_that("prediction standard error", { # note that predict.lm returns a list with # fit, se.fit, df, residual.scale mod1 <- lmer(Petal.Width ~ Sepal.Length + (1 | Species), iris) p1 <- predict(mod1, se.fit = TRUE) p2 <- predict(mod1, se.fit = TRUE, newdata = iris) p3 <- predict(mod1, se.fit = TRUE, re.form = NA, newdata = iris) p4 <- predict(mod1, se.fit = TRUE, re.form = NA) p5 <- predict(mod1, se.fit = TRUE, re.form = ~(1 | Species)) p6 <- predict(mod1, se.fit = TRUE, re.form = ~(1 | Species), newdata = iris) p7 <- predict(mod1, se.fit = TRUE, newdata = iris, random.only = TRUE) p8 <- predict(mod1, se.fit = TRUE, re.form = ~(1 | Species), random.only = TRUE) p9 <- predict(mod1, se.fit = TRUE, re.form = ~(1 | Species), newdata = iris, random.only = TRUE) expect_equal(unname(head(p1$se.fit)), c(0.0271816400250223, 0.0272298862268211, 0.0286188379907626, 0.0297645467444413, 0.0270330515271627, 0.0295876265523127)) # re.form = NA expect_equal(unname(head(p3$se.fit)), c(0.451147865048879, 0.451497971849052, 0.451930732595154, 0.452178035807842, 0.451312573619068, 0.450778089845166)) # random.only may need checking -- tolerance maybe too high for this? expect_equal(unname(p8$se.fit), rep(0.451569712647126, 150), tolerance = 0.001) expect_equal(p1, p2) expect_equal(p3, p4) expect_equal(p1, p5) expect_equal(p1, p6) expect_equal(p7, p8) expect_equal(p7, p9) }) test_that("NA + re.form = NULL + simulate OK (GH #737)", { d <- lme4::sleepstudy d$Reaction[1] <- NA fm1 <- lmer(Reaction ~ Days + (Days | Subject), d) ss <- simulate(fm1, seed = 101, re.form = NULL)[[1]] expect_equal(c(head(ss)), c(266.139101412856, 308.148180398426, 296.081377893883, 338.367909016478, 360.294339946214, 401.91050930589)) ss0 <- simulate(fm1, seed = 101, re.form = NA)[[1]] expect_equal(length(ss), length(ss0)) ## correct dimensions with na.exclude as well ? fm2 <- update(fm1, na.action = na.exclude) ss2 <- simulate(fm2, seed = 101, re.form = NULL)[[1]] ss3 <- simulate(fm2, seed = 101, re.form = NA)[[1]] expect_equal(length(ss2), nrow(d)) expect_equal(length(ss3), nrow(d)) }) ## GH 691 parts 1 and 2 test_that("predict works with factors in left-out REs", { set.seed(101) df2 <- data.frame(yield = rnorm(100), lc = factor(rep(1:2, 50)), g1 = factor(rep(1:10, 10)), g3 = factor(rep(1:10, each = 10))) m1B <- suppressWarnings(lmer(yield ~ 1 + ( 1 | g1) + (lc |g3), data = df2, control = lmerControl(check.conv.singular = "ignore"))) expect_equal(head(predict(m1B, re.form = ~(1|g1)),1), c(`1` = 0.146787496519465), tolerance = 1e-4) }) test_that("predict works with dummy() in left-out REs", { set.seed(101) df3 <- data.frame(v1 = rnorm(100), v3 = factor(rep(1:10, each = 10)), v4 = factor(rep(1:2, each = 50)), v5 = factor(rep(1:10, 10))) m1C <- lmer(v1~(1|v3) + (0+dummy(v4,"1")|v5), data = df3, control=lmerControl(check.nobs.vs.nlev="ignore", check.nobs.vs.nRE="ignore", check.conv.singular = "ignore")) expect_equal(head(predict(m1C, re.form = ~1|v3), 1), c(`1` = -0.035719520719991)) }) test_that("predict se.fit on response scale", { p1 <- suppressWarnings( predict(fit_cbpp_1, type = "link", se.fit = TRUE)) p2 <- suppressWarnings( predict(fit_cbpp_1, type = "response", se.fit = TRUE)) p3 <- suppressWarnings( predict(fit_cbpp_1, type = "response", newdata = cbpp, se.fit = TRUE)) expect_identical(p2$se.fit, p3$se.fit) expect_equal(p1$se.fit*binomial()$mu.eta(p1$fit), p2$se.fit) }) test_that("predictions work with se.fit and subset of grouping variable levels", { ## Idea: when predicting where the newdata has less groups than what ## the full model accounted for, Cmat needs to be subsetted to match ## the dimensions for cbind(Z, X) ## Code inspired: https://github.com/lme4/lme4/issues/866#issue-3358828496 set.seed(123) dat <- data.frame( outcome = rbinom(n = 100, size = 1, prob = 0.35), var_binom = as.factor(rbinom(n = 100, size = 1, prob = 0.7)), var_cont = rnorm(n = 100, mean = 10, sd = 7), grp = as.factor(sample(letters[1:4], size = 100, replace = TRUE)) ) m1 <- lme4::glmer( outcome ~ var_binom + var_cont + (1 | grp), data = dat, family = binomial(link = "logit") ) ## d <- insight::get_datagrid(m1, "var_binom", include_random = TRUE) d <- data.frame(var_binom = factor(0:1), var_cont = c(9.24717241397544, 9.24717241397544), grp = factor(c("a","b"), levels = letters[1:4])) pp <- suppressWarnings(predict(m1, newdata = d, se.fit = TRUE)) expect_equal(pp, list(fit = c(`1` = -0.4338277, `2` = -0.5993396), se.fit = c(`1` = 0.4255397, `2` = 0.2779372)), tol = 1e-6) d2 <- dat[sample(1:nrow(dat), size = 20),] d2 <- d2[!("c" == d2$grp), ] pp2 <- suppressWarnings(predict(m1, newdata = d2, se.fit = TRUE)) expect_identical(lengths(pp2), c(fit=16L, se.fit=16L)) expect_equal(lapply(pp2, head, 2), list(fit = c(`37` = -0.5109994, `29` = -0.5704263), se.fit = c(`37` = 0.5151070, `29` = 0.3258730)), tol = 1e-7) set.seed(123) dat2 <- expand.grid( grp.1 = factor(c("a.1", "b.1", "c.1", "d.1")), grp.2 = factor(c("a.1", "b.1", "c.1", "d.1")), rep = 1:10) dat2$y <- simulate(~ 1 + (1|grp.1) + (1|grp.2), family = binomial, newdata = dat2, newparams = list(beta = 0, theta = c(1, 1)))[[1]] m2 <- lme4::glmer( y ~ 1 + (1|grp.1) + (1|grp.2), data = dat2, family = binomial(link = "logit") ) dsub <- expand.grid( grp.1 = c("a.1", "b.1"), grp.2 = c("a.1", "b.1")) p1 <- suppressWarnings(predict(m2, newdata = dsub, se.fit = TRUE)) p2 <- suppressWarnings(predict(m2, se.fit = TRUE)) ss <- subset(dat2, grp.1 %in% c("a.1", "b.1") & grp.2 %in% c("a.1", "b.1")) w <- as.numeric(rownames(ss)[1:4]) expect_equal(lapply(p2, function(x) x[w]), p1, check.attributes = FALSE) ## Example: we have grouping variables g1 and g2 which each have levels a, b, c, d. ## This safeguards cases if we ask for levels a, b in g1 and b, c in g2 set.seed(1) dat3 <- expand.grid( g1 = factor(c("a", "b", "c", "d")), g2 = factor(c("a", "b", "c", "d")), rep = 1:10 ) dat3$y <- simulate(~ 1 + (1|g1) + (1|g2), family = binomial, newdata = dat3, newparams = list(beta = 0, theta = c(1, 1)))[[1]] m3 <- lme4::glmer( y ~ 1 + (1|g1) + (1|g2), data = dat3, family = binomial(link = "logit") ) dsub2 <- expand.grid( g1 = c("a", "b"), g2 = c("c", "d")) tp1 <- suppressWarnings(predict(m3, se.fit = TRUE)) tp2 <- suppressWarnings(predict(m3, newdata = dsub2, se.fit = TRUE)) ss2 <- subset(dat3, g1 %in% c("a", "b") & g2 %in% c("c", "d")) w2 <- as.numeric(rownames(ss2)[1:4]) expect_equal(lapply(tp1, function(x) x[w2]), tp2, check.attributes = FALSE) ## Case where there are multiple grouping variables set.seed(1) sleepstudy$Subject2 <- rep(1:5, each = 36) m5 <- lmer(Reaction ~ Days + (1 + Days | Subject) + (1 | Subject2), data = sleepstudy) d <- sleepstudy[sample(1:nrow(sleepstudy), size = 30), ] pms1 <- predict(m5, se.fit = TRUE, re.form = NULL, allow.new.levels = FALSE) pms2 <- predict(m5, newdata = d, se.fit = TRUE, re.form = NULL, allow.new.levels = FALSE) psw <- as.numeric(rownames(d)) expect_equal(lapply(pms1, function(x) x[psw]), pms2, check.attributes = FALSE) ## Case where we are adding new levels lm1 <- lmer(Reaction ~ Days + (1 + Days | Subject), data = sleepstudy) d373 <- data.frame(Days = 0, Subject = "373") pred373 <- predict(lm1, newdata = d373, se.fit = TRUE, re.form = NULL, allow.new.levels = TRUE) expected_373 <- fixef(lm1)["(Intercept)"] + fixef(lm1)["Days"] * d373$Days expect_equal(pred373$fit, expected_373, check.attributes = FALSE, tol = 10e-16) ## Extending previous example: multiple new levels for different groups dsub3 <- expand.grid( g1 = c("k", "m"), g2 = c("k", "m")) tp3 <- suppressWarnings(predict(m3, newdata = dsub3, se.fit = TRUE, allow.new.levels = TRUE)) expected_tp3 <- fixef(m3)["(Intercept)"] expect_true(all(tp3$fit == expected_tp3)) ## Case where user specified allow.new.levels = TRUE but ## but no new levels were actually added tp4 <- suppressWarnings(predict(m3, se.fit = TRUE, allow.new.levels = TRUE)) ## Ideally: predictions should remain the same as before. expect_equal(lapply(tp4, function(x) x[w2]), tp2, check.attributes = FALSE) ## Test that this also works under glmer. gm1 <- glmer(round(Reaction) ~ Days + (1 + Days | Subject), data = sleepstudy, family = poisson) d2 <- data.frame(Days = 0, Subject = "373") gp1 <- suppressWarnings(predict(gm1, newdata = d2, se.fit = TRUE, re.form = NULL, allow.new.levels = TRUE)) expected_gp1 <- fixef(gm1)["(Intercept)"] expect_true(all(gp1$fit == expected_gp1)) }) test_that("simulation works with AR1", { skip_if(testLevel < 2) form <- Reaction ~ Days + ar1(0+factor(Days)|Subject) dd <- expand.grid(Subject = 1:100, Days = 1:20) s2 <- simulate(form[-2], newdata = dd, newparams = list(beta = c(0, 1), par = c(30, 0.5), sigma = 0.1), seed = 101) dd$Reaction <- s2[[1]] m1 <- lmer(form, data = dd) expect_equal(getME(m1, "par"), c(`Subject.*` = 41.51375093795063, Subject.rho = 0.47173954902469345), tolerance = 1e-3) }) test_that("simulation works with 'par'", { form <- Reaction ~ Days + ar1(0+factor(Days)|Subject) m1 <- lmer(form, data = sleepstudy) s1 <- simulate( form[-2], newdata = sleepstudy, newparams = list(beta = c(0, 1), theta = getME(m1, "theta"), sigma = 1), seed = 101)[[1]] s2 <- simulate(form[-2], newdata = sleepstudy, newparams = list(beta = c(0, 1), par = getME(m1, "par"), sigma = 1), seed = 101)[[1]] expect_equal(s1, s2) }) lme4/tests/testthat/test-summary.R0000644000176200001440000001266415150646150016726 0ustar liggesuserstry(detach("package:lmerTest"), silent = TRUE) testLevel <- if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 #context("summarizing/printing models") test_that("lmer", { set.seed(0) J <- 8 n <- 10 N <- J * n beta <- c(5, 2, 4) u <- matrix(rnorm(J * 3), J, 3) x.1 <- rnorm(N) x.2 <- rnorm(N) g <- rep(1:J, rep(n, J)) y <- 1 * (beta[1] + u[g,1]) + x.1 * (beta[2] + u[g,2]) + x.2 * (beta[3] + u[g,3]) + rnorm(N) tmpf <- function(x) capture.output(print(summary(x),digits=1)) tfun <- function(cc) { w <- grep("Fixed effects:", cc) cc[w:length(cc)] } C1 <- lmerControl(optimizer="nloptwrap", optCtrl=list(xtol_abs=1e-6, ftol_abs=1e-6)) m1 <- lmer(y ~ x.1 + x.2 + (1 + x.1 | g), control=C1) m2 <- lmer(y ~ x.1 + x.2 + (1 + x.1 + x.2 | g), control=C1) cc1 <- tmpf(m1) cc2 <- tmpf(m2) ## FIXME: correlation of fixed effects printed inconsistently. ## If (1) LME4_TEST_LEVEL == 100 *and* after running all of prior ## tests, something (package load? options setting?) changes ## so that the fixed-effect correlations are no longer printed ## out, and this test fails ## would like to sort this out but realistically not sure it's worth it? t1 <- tfun(cc1) vv <- vcov(m1) ss <- sessionInfo() save(m1, vv, ss, file = sprintf("test-summary_testlevel_%d.rda", testLevel)) expect_equal(t1, c("Fixed effects:", " Estimate Std. Error t value", "(Intercept) 5.4 0.5 12", "x.1 1.9 0.4 5", "x.2 4.0 0.1 28", "", "Correlation of Fixed Effects:", " (Intr) x.1 ", "x.1 -0.019 ", "x.2 0.029 -0.043" )) expect_equal(tfun(cc2), c("Fixed effects:", " Estimate Std. Error t value", "(Intercept) 5.4 0.4 12", "x.1 2.0 0.4 5", "x.2 4.0 0.3 15", "", "Correlation of Fixed Effects:", " (Intr) x.1 ", "x.1 -0.069 ", "x.2 0.136 -0.103" )) }) ## Tests with regards to auto-scaling; making sure we get expected behaviours. set.seed(1) sleepstudy$var1 = runif(nrow(sleepstudy), 1e6, 1e7) form <- Reaction ~ var1 + Days + (Days | Subject) scf1 <- lmer(form, control = lmerControl(autoscale = TRUE), sleepstudy) scf2 <- suppressWarnings( update(scf1, control = lmerControl(autoscale = FALSE)) ) test_that("lmer(): ensuring we get the internal scale for X with getME", { res1 <- getME(scf1, "X")[180, ] valtest1 <- c(1, 1.456867279040504, 1.562340900990911) expect_equal(res1, valtest1, check.attributes = FALSE, tolerance =1e-10) }) test_that("lmer(): ensuring we get the internal scale for beta with getME", { res2 <- getME(scf1, "beta") valtest2 <- c(298.507891666666751, 1.621716753196637, 30.161580776828778) expect_equal(res2, valtest2, tolerance =1e-10) }) test_that("lmer(): model.matrix should provide unscaled version at default", { res3 <- model.matrix.merMod(scf1)[180, ] valtest3 <- c(1, 9127734.503475949, 9) expect_equal(res3, valtest3, check.attributes = FALSE, tolerance =1e-6) res4 <- model.matrix.merMod(scf1, noScale = TRUE)[180, ] valtest4 <- c(1, 1.45686727904050395, 1.5623409009909106) expect_equal(res4, valtest4, check.attributes = FALSE, tolerance =1e-6) }) test_that("lmer(): fixef.merMod() should provide unscaled version at default", { res5 <- fixef.merMod(scf1) valtest5 <- fixef.merMod(scf2) expect_equal(res5, valtest5, check.attributes = FALSE, tolerance =1e-10) res6 <- fixef.merMod(scf1, noScale = TRUE) valtest6 <- c(298.507891666666751, 1.621716753196637, 30.161580776828778) expect_equal(res6, valtest6, check.attributes = FALSE, tolerance =1e-10) }) test_that("lmer(): vcov.merMod() should provide unscaled version at default", { res7 <- vcov.merMod(scf1) valtest7 <- vcov.merMod(scf2) expect_true(all.equal(res7, valtest7, check.attributes = FALSE, tolerance =1e-6)) res8 <- vcov.merMod(scf1, noScale = TRUE) valtest8 <- as( matrix(c(8.12278783645280e+01, -3.24525171154812e-15, 26.5884231100835215, -3.24525171154812e-15, 4.39230297872591e+00, 0.0344711252408276, 2.65884231100835e+01, 3.44711252408276e-02, 19.7018459306493092), nrow = 3, byrow = TRUE), "dpoMatrix") expect_true(all.equal(res8, valtest8, check.attributes = FALSE, tolerance =1e-10)) }) ## Doing autoscaling tests with glmer instead. set.seed(1) cbpp$var1 = runif(nrow(cbpp), 1e3, 1e5) form <- cbind(incidence, size - incidence) ~ var1 + period + (1 | herd) gfit1 <- glmer(form, control = glmerControl(autoscale = TRUE), data = cbpp, family = binomial) gfit2 <- suppressWarnings( update(gfit1, control = glmerControl(autoscale = FALSE)) ) test_that("glmer(): back transform matches similar model", { gres1 <- fixef.merMod(gfit1) og1 <- fixef.merMod(gfit2) expect_equal(gres1, og1, tolerance = 1e-5) gres2 <- vcov.merMod(gfit1) og2 <- suppressWarnings(vcov.merMod(gfit2)) expect_true(all.equal(gres2, og2, check.attributes = FALSE, tolerance = 0.04)) }) lme4/tests/testthat/setup.R0000644000176200001440000000213715200146513015400 0ustar liggesusers###################################################################### # Below is code frequently used for testing # see: test-covariance_structures.R and test-covariance_nlmer.R all.equal.nocheck <- function(x, y, ..., check.attributes = FALSE, check.class = FALSE) { ## working around mode-matching headaches if (is(x, "Matrix")) x <- matrix(x) if (is(y, "Matrix")) y <- matrix(y) all.equal(x, y, ..., check.attributes = check.attributes, check.class = check.class) } ## set default tolerance to 5e-5 since we mostly use that ## 'tolerance' must be written out in full since it comes after ... expect_equal_nocheck <- function(..., tolerance = 5e-5) { expect_true(isTRUE(all.equal.nocheck(..., tolerance = tolerance))) } ## Getting all equal as a number (in the all.equal examples documentation; ## don't know why they didn't make an argument instead!?) all.eqNum <- function(...) { an <- all.equal.nocheck(...) if (isTRUE(an)) return(0) ## if check is less than tolerance all.equal returns TRUE, so sub() coerces to "TRUE" ## and as.numeric() returns NA ... as.numeric(sub(".*:", '', an)) } lme4/tests/predsim.R0000644000176200001440000000460215036542626014056 0ustar liggesusers## compare range, average, etc. of simulations to ## conditional and unconditional prediction library(lme4) do.plot <- FALSE if (.Platform$OS.type != "windows") { ## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } fm1 <- lmer(Reaction~Days+(1|Subject),sleepstudy) set.seed(101) pp <- predict(fm1) rr <- range(usim2 <- simulate(fm1,1,use.u=TRUE)[[1]]) stopifnot(all.equal(rr,c(159.3896,439.1616),tolerance=1e-6)) if (do.plot) { plot(pp,ylim=rr) lines(sleepstudy$Reaction) points(simulate(fm1,1)[[1]],col=4) points(usim2,col=2) } set.seed(101) ## conditional prediction ss <- simulate(fm1,1000,use.u=TRUE) ss_sum <- t(apply(ss,1,quantile,c(0.025,0.5,0.975))) plot(pp) matlines(ss_sum,col=c(1,2,1),lty=c(2,1,2)) stopifnot(all.equal(ss_sum[,2],pp,tolerance=5e-3)) ## population-level prediction pp2 <- predict(fm1, re.form=NA) ss2 <- simulate(fm1,1000,use.u=FALSE) ss_sum2 <- t(apply(ss2,1,quantile,c(0.025,0.5,0.975))) if (do.plot) { plot(pp2,ylim=c(200,400)) matlines(ss_sum2,col=c(1,2,1),lty=c(2,1,2)) } stopifnot(all.equal(ss_sum2[,2],pp2,tolerance=8e-3)) ## predict(...,newdata=...) on models with derived variables in the random effects ## e.g. (f:g, f/g) set.seed(101) d <- expand.grid(f=factor(letters[1:10]),g=factor(letters[1:10]), rep=1:10) d$y <- rnorm(nrow(d)) m1 <- lmer(y~(1|f:g),d) p1A <- predict(m1) p1B <- predict(m1,newdata=d) stopifnot(all.equal(p1A,p1B)) m2 <- lmer(y~(1|f/g),d) p2A <- predict(m2) p2B <- predict(m2,newdata=d) stopifnot(all.equal(p2A,p2B)) ## with numeric grouping variables dn <- transform(d,f=as.numeric(f),g=as.numeric(g)) m1N <- update(m1,data=dn) p1NA <- predict(m1N) p1NB <- predict(m1N,newdata=dn) stopifnot(all.equal(p1NA,p1NB)) ## simulate with modified parameters set.seed(1) s1 <- simulate(fm1) set.seed(1) s2 <- simulate(fm1,newdata=model.frame(fm1), newparams=getME(fm1,c("theta","beta","sigma"))) all.equal(s1,s2) fm0 <- update(fm1,.~.-Days) ## ## sim() -> simulate() -> refit() -> deviance ## ## predictions and simulations with offsets set.seed(101) d <- data.frame(y=rpois(100,5),x=rlnorm(100,1,1), f=factor(sample(10,size=100,replace=TRUE))) gm1 <- glmer(y~offset(log(x))+(1|f),data=d, family=poisson) s1 <- simulate(gm1) } ## skip on windows (for speed) lme4/tests/nlmer-conv.R0000644000176200001440000000171215036542626014472 0ustar liggesusers### nlmer() convergence testing / monitoring / ... ## ------------------- ### The output of tests here are *not* 'diff'ed (<==> no *.Rout.save file) library(lme4) ## 'Theoph' Data modeling if (lme4:::testLevel() > 1) { Th.start <- c(lKe=-2.5, lKa=0.5, lCl=-3) (nm2 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ lKe + lKa + lCl|Subject, Theoph, start = Th.start)) (nm3 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKe|Subject) + (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) ## dropping lKe from random effects: (nm4 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ lKa + lCl|Subject, Theoph, start = Th.start, control = nlmerControl(tolPwrss=1e-8))) (nm5 <- nlmer(conc ~ SSfol(Dose, Time,lKe, lKa, lCl) ~ (lKa|Subject) + (lCl|Subject), Theoph, start = Th.start)) } lme4/tests/lmer2_ex.R0000644000176200001440000000564314234301437014126 0ustar liggesusersstopifnot(suppressPackageStartupMessages(require(lme4))) ## Using simple generated data -- fully balanced here, unbalanced later set.seed(1) dat <- within(data.frame(lagoon = factor(rep(1:4, each = 25)), habitat = factor(rep(1:20, each = 5))), { ## a simple lagoon effect but no random effect y <- round(10*rnorm(100, m = 10*as.numeric(lagoon))) ## Here, *with* an RE, sigma_a = 100 RE <- rep(round(rnorm(nlevels(habitat), sd = 100)), each = 5) y2 <- y + RE }) ## FIXME: want lmer(* , sparseX = TRUE ) {as in lme4a} if (FALSE) { # need to adapt to new structure ##' ##' ##'
##' @title Comparing the different versions of lmer() for same data & model ##' @param form ##' @param data ##' @param verbose ##' @return chkLmers <- function(form, data, verbose = FALSE, tol = 200e-7) # had tol = 7e-7 working .. { # m <- lmer1(form, data = data) # ok, and more clear # m. <- lmer1(form, data = data, sparseX = TRUE, verbose = verbose) m2 <- lmer (form, data = data, verbose = verbose) # lmem-dense m2. <- lmer (form, data = data, sparseX = TRUE, verbose = verbose) ## Eq <- function(x,y) all.equal(x,y, tolerance = tol) stopifnot(## Compare sparse & dense of the new class results identical(slotNames(m2), slotNames(m2.)) , identical(slotNames(m2@fe), slotNames(m2.@fe)) , Eq(m2@resp, m2.@resp) , Eq(m2@re, m2.@re) , Eq(m2@fe@coef, m2.@fe@coef) , ## and now compare with the "old" (class 'mer') # Eq(unname(fixef(m)), m2@fe@beta) # , # Eq(unname(fixef(m.)), m2.@fe@beta) # , ## to do ## all.equal(ranef(m)), m2@re) ## all.equal(ranef(m.)), m2.@re) TRUE) invisible(list(#m=m, m.=m., m2 = m2, m2. = m2.)) } chk1 <- chkLmers(y ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE) chk2 <- chkLmers(y2 ~ 0+lagoon + (1|habitat), data = dat, verbose = TRUE) chk1$m2 ## show( lmer() ) -- sigma_a == 0 chk2$m2. ## show( lmer( ) ) -- n <- nrow(dat) for(i in 1:20) { iOut <- sort(sample(n, 1+rpois(1, 3), replace=FALSE)) cat(i,": w/o ", paste(iOut, collapse=", ")," ") chkLmers(y ~ 0+lagoon + (1|habitat), data = dat[- iOut,]) chkLmers(y2 ~ lagoon + (1|habitat), data = dat[- iOut,]) cat("\n") } ## One (rare) example where the default tolerance is not sufficient: dat. <- dat[- c(14, 34, 66, 67, 71, 88),] try( chkLmers(y ~ 0+lagoon + (1|habitat), data = dat.) ) ## Error: Eq(unname(fixef(m)), m2@fe@beta) is not TRUE ## ## but higher tolerance works: chkLmers(y ~ 0+lagoon + (1|habitat), data = dat., tol = 2e-4, verbose=TRUE) } proc.time() sessionInfo() lme4/tests/lmer-conv.R0000644000176200001440000000133215036542626014312 0ustar liggesusersif (lme4:::testLevel() > 1 || .Platform$OS.type!="windows") { ### lmer() convergence testing / monitoring / ... ## ------------------ ### The output of tests here are *not* 'diff'ed (<==> no *.Rout.save file) library(lme4) ## convergence on boundary warnings load(system.file("external/test3comp.rda", package = "Matrix")) b3 <- lmer(Y3 ~ (1|Sample) + (1|Operator/Run), test3comp, verb = TRUE) if (isTRUE(try(data(Early, package = 'mlmRev')) == 'Early')) { Early$tos <- Early$age - 0.5 # time on study b1 <- lmer(cog ~ tos + trt:tos + (tos|id), Early, verb = TRUE) } cat('Time elapsed: ', proc.time(),'\n') # for ``statistical reasons'' } ## skip on windows (for speed) lme4/tests/REMLdev.R0000644000176200001440000000315715036542626013655 0ustar liggesuserslibrary(lme4) ## show important current settings {for reference, etc} -- [early, and also on Windows !]: source(system.file("test-tools-1.R", package = "Matrix"), keep.source = FALSE) ## N.B. is.all.equal[34]() and assert.EQ() use 'tol', not 'tolerance' str( lmerControl()) str(glmerControl()) str(nlmerControl()) ls.str(environment(nloptwrap)) ## see Details under ?deviance.merMod: fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) fm1ML <- refitML(fm1) REMLcrit(fm1) ## 1743.628 deviance(fm1ML) ## 1751.939 deviance(fm1,REML=FALSE) ## FIXME: not working yet (NA) deviance(fm1,REML=TRUE) ## from lme4.0 oldvals <- c(REML=1743.6282722424, ML=1751.98581103058) ## leave out ML values for REML fits for now ... stopifnot( is.all.equal3(REMLcrit(fm1), deviance(fm1,REML=TRUE), deviance(fm1ML,REML=TRUE),oldvals["REML"]), all.equal(deviance(fm1ML),deviance(fm1ML,REML=FALSE),oldvals["ML"]), all.equal(REMLcrit(fm1)/-2,c(logLik(fm1)),c(logLik(fm1ML,REML=TRUE)),c(logLik(fm1,REML=TRUE))), all.equal(deviance(fm1ML)/-2,c(logLik(fm1ML,REML=FALSE)), c(logLik(fm1ML,REML=FALSE)))) ## should be: ## stopifnot( ## all.equal(deviance(fm1),deviance(fm1,REML=TRUE),deviance(fm1ML,REML=TRUE),oldvals["REML"]), ## all.equal(deviance(fm1ML),deviance(fm1,REML=FALSE),deviance(fm1ML,REML=FALSE),oldvals["ML"]), ## all.equal(deviance(fm1)/2,c(logLik(fm1)),c(logLik(fm1ML,REML=TRUE)),c(logLik(fm1,REML=TRUE))), ## all.equal(deviance(fm1ML)/2,c(logLik(fm1,REML=FALSE)),c(logLik(fm1ML,REML=FALSE)), ## c(logLik(fm1ML,REML=FALSE)))) lme4/tests/agridat_gotway.R0000644000176200001440000000462015225703727015421 0ustar liggesusers## require(agridat) ## dat <- gotway.hessianfly if (.Platform$OS.type != "windows") { ## don't actually use gotway_hessianfly_fit or gotway_hessianfly_prof, ## so we should be OK even with R< 3.0.1 load(system.file("testdata","gotway_hessianfly.rda",package="lme4")) # Block random. See Glimmix manual, output 1.18. # Note: (Different parameterization) ## require("lme4.0") ## fit2 <- glmer(cbind(y, n-y) ~ gen + (1|block), data=dat, family=binomial) ## params <- list(fixef=fixef(fit2),theta=getME(fit2,"theta")) ## detach("package:lme4.0") lme4.0fit <- structure(list(fixef = structure(c(1.50345713031203, -0.193853259383803, -0.540808391060274, -1.43419379979154, -0.203701042949808, -0.978322555343941, -0.604078624475678, -1.67742449813309, -1.39842466673692, -0.681709344788684, -1.46295367186169, -1.45908310198959, -3.55285756517073, -2.50731975980307, -2.08716296677356, -2.96974270029992), names = c("(Intercept)", "genG02", "genG03", "genG04", "genG05", "genG06", "genG07", "genG08", "genG09", "genG10", "genG11", "genG12", "genG13", "genG14", "genG15", "genG16")), theta = structure(0.0319087494293615, names = "block.(Intercept)")), names = c("fixef", "theta")) ## start doesn't work because we don't get there library(lme4) m1 <- glmer(cbind(y, n-y) ~ gen + (1|block), data=gotway.hessianfly, family=binomial) m1B <- update(m1,control=glmerControl(optimizer="bobyqa")) max(abs(m1@optinfo$derivs$gradient)) ## 0.0012 max(abs(m1B@optinfo$derivs$gradient)) ## 2.03e-5 abs(m1@optinfo$derivs$gradient)/abs(m1B@optinfo$derivs$gradient) ## bobyqa gets gradients *at least* 1.64* lower lme4fit <- list(fixef=fixef(m1),theta=getME(m1,"theta")) ## hack around slight naming differences lme4fit$theta <- unname(lme4fit$theta) lme4.0fit$theta <- unname(lme4.0fit$theta) ## difference in theta on x86_64-w64-mingw32 (64-bit) with r-devel is 0.000469576 stopifnot(all.equal(lme4fit, lme4.0fit, tolerance = 5e-4)) ## Fun stuff: visualize and alternative model ## library(ggplot2) ## dat$prop <- dat$y/dat$n ## theme_set(theme_bw()) ## ggplot(dat,aes(x=gen,y=prop,colour=block))+geom_point(aes(size=n))+ ## geom_line(aes(group=block,colour=block))+ ## geom_smooth(family=binomial,aes(weight=n,colour=block,group=block),method="glm", ## alpha=0.1) ## dat$obs <- factor(seq(nrow(dat))) ## m2 <- glmer(cbind(y, n-y) ~ block+ (1|gen) + (1|obs), data=dat, family=binomial) } ## not on windows/CRAN lme4/tests/modFormula.R0000644000176200001440000000501115036542626014513 0ustar liggesusersif (.Platform$OS.type != "windows") { library(lme4) library(testthat) .get.checkingOpts <- lme4:::.get.checkingOpts stopifnot(identical( .get.checkingOpts( c("CheckMe", "check.foo", "check.conv.1", "check.rankZ", "check.rankX")) , c("check.foo", "check.rankZ"))) lmod <- lFormula(Reaction ~ Days + (Days|Subject), sleepstudy) devfun <- do.call(mkLmerDevfun, lmod) opt <- optimizeLmer(devfun) cc <- lme4:::checkConv(attr(opt,"derivs"), opt$par, ctrl = lmerControl()$checkConv, lbound=environment(devfun)$lower) fm1 <- mkMerMod(environment(devfun), opt, lmod$reTrms, fr = lmod$fr, lme4conv=cc) fm2 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ## basic equivalence fm1C <- fm1 fm1C@call <- fm2@call expect_equal(fm2,fm1C) expect_equal(range(residuals(fm1)), c(-101.18, 132.547), tolerance = 1e-5) # these are "outliers"! expect_is(model.frame(fm1),"data.frame") ## formulae mfm1 <- model.frame(fm1) expect_equal(formula(fm1), Reaction ~ Days + (Days | Subject)) expect_equal(formula(terms(mfm1)), Reaction ~ Days + (Days + Subject)) new_form_modframe <- (getRversion() >= "3.6.0" && as.numeric(version[["svn rev"]]) >= 75891) expect_equal(formula(mfm1), if(new_form_modframe) { Reaction ~ Days + (Days + Subject) } else Reaction ~ Days + Subject ) ## predictions expect_equal(predict(fm1,newdata=sleepstudy[1:10,],re.form=NULL), predict(fm2,newdata=sleepstudy[1:10,],re.form=NULL)) expect_equal(predict(fm1,newdata=sleepstudy), predict(fm1)) lmodOff <- lFormula(Reaction ~ Days + (Days|Subject) + offset(0.5*Days), sleepstudy) devfunOff <- do.call(mkLmerDevfun, lmodOff) opt <- optimizeLmer(devfunOff) fm1Off <- mkMerMod(environment(devfunOff), opt, lmodOff$reTrms, fr = lmodOff$fr) fm2Off <- lmer(Reaction ~ Days + (Days|Subject) + offset(0.5*Days), sleepstudy) expect_equal(predict(fm1Off,newdata=sleepstudy[1:10,],re.form=NULL), predict(fm2Off,newdata=sleepstudy[1:10,],re.form=NULL)) ## FIXME: need more torture tests with offset specified, in different environments ... ## FIXME: drop1(.) doesn't work with modular objects ... hard to see how it ## could, though ... ## drop1(fm1Off) drop1(fm2Off) } ## skip on windows (for speed) lme4/tests/drop1contrasts.R0000644000176200001440000000144415036542626015402 0ustar liggesusers## drop1 may not work right with contrasts: make up an example something like this ... ## options(contrasts=c("contr.sum","contr.poly")) ## drop1(fecpoiss_lm3,test="Chisq",scope=.~.) if (.Platform$OS.type != "windows") withAutoprint({ library(lme4) oldopts <- options(contrasts=c("contr.sum","contr.poly")) fm1 <- lmer(Reaction~Days+(Days|Subject),data=sleepstudy) drop1(fm1,test="Chisq") ## debug(lme4:::drop1.merMod) drop1(fm1,test="Chisq",scope=.~.) fm0 <- lm(Reaction~Days+Subject,data=sleepstudy) drop1(fm0,test="Chisq",scope=.~.) options(oldopts) ## restore original contrasts ff <- function() { lmer(Reaction~Days+(Days|Subject),data=sleepstudy) } drop1(ff()) ## OK because sleepstudy is accessible! }) ## skip on windows (for speed) lme4/tests/priorWeights.R0000644000176200001440000001340715036542626015104 0ustar liggesusers## use old (<=3.5.2) sample() algorithm if necessary if ("sample.kind" %in% names(formals(RNGkind))) { suppressWarnings(RNGkind("Mersenne-Twister", "Inversion", "Rounding")) } compFunc <- function(lmeMod, lmerMod, tol = 1e-2){ lmeVarCorr <- nlme:::VarCorr(lmeMod)[,"StdDev"] lmeCoef <- summary(lmeMod)$tTable[,-c(3,5)] lmeOut <- c(as.numeric(lmeVarCorr), as.numeric(lmeCoef)) keep <- !is.na(lmeOut) lmeOut <- lmeOut[keep] dn <- dimnames(lmeCoef) if(is.null(dn)) dn <- list("", names(lmeCoef)) names(lmeOut) <- c( paste(names(lmeVarCorr), "Var"), as.character(do.call(outer, c(dn, list("paste")))))[keep] ## get nested RE variances in the same order as nlme ## FIXME: not sure if this works generally vcLmer <- VarCorr(lmerMod) vcLmer <- vcLmer[length(vcLmer):1] ## lmerVarCorr <- c(sapply(vcLmer, attr, "stddev"), attr(VarCorr(lmerMod), "sc")) ## differentiate lme4{new} and lme4.0 : lmerCoef <- if(is(lmerMod, "merMod")) summary(lmerMod)$coefficients else summary(lmerMod)@coefs lmerOut <- c(lmerVarCorr, as.numeric(lmerCoef)) names(lmerOut) <- names(lmeOut) return(list(target = lmeOut, current = lmerOut, tolerance = tol)) } if (.Platform$OS.type != "windows") { set.seed(1) nGroups <- 100 nObs <- 1000 # explanatory variable with a fixed effect explVar1 <- rnorm(nObs) explVar2 <- rnorm(nObs) # random intercept among levels of a grouping factor groupFac <- as.factor(rep(1:nGroups,each=nObs/nGroups)) randEff0 <- rep(rnorm(nGroups),each=nObs/nGroups) randEff1 <- rep(rnorm(nGroups),each=nObs/nGroups) randEff2 <- rep(rnorm(nGroups),each=nObs/nGroups) # residuals with heterogeneous variance residSD <- rpois(nObs,1) + 1 residError <- rnorm(nObs,sd=residSD) # response variable respVar <- randEff0 + (1+randEff1)*explVar1 + (1+randEff2)*explVar2 + residError # rename to fit models on one line y <- respVar x <- explVar1 z <- explVar2 g <- groupFac v <- residSD^2 w <- 1/v library("nlme") lmeMods <- list( ML1 = lme(y ~ x, random = ~ 1|g, weights = varFixed(~v), method = "ML"), REML1 = lme(y ~ x, random = ~ 1|g, weights = varFixed(~v), method = "REML"), ML2 = lme(y ~ x, random = ~ x|g, weights = varFixed(~v), method = "ML"), REML2 = lme(y ~ x, random = ~ x|g, weights = varFixed(~v), method = "REML"), ML1 = lme(y ~ x+z, random = ~ x+z|g, weights = varFixed(~v), method = "ML"), REML2 = lme(y ~ x+z, random = ~ x+z|g, weights = varFixed(~v), method = "REML")) library("lme4") lmerMods <- list( ML1 = lmer(y ~ x + (1|g), weights = w, REML = FALSE), REML1 = lmer(y ~ x + (1|g), weights = w, REML = TRUE), ML2 = lmer(y ~ x + (x|g), weights = w, REML = FALSE), REML2 = lmer(y ~ x + (x|g), weights = w, REML = TRUE), ML3 = lmer(y ~ x + z + (x+z|g), weights = w, REML = FALSE), REML3 = lmer(y ~ x + z + (x+z|g), weights = w, REML = TRUE)) comp <- mapply(compFunc, lmeMods, lmerMods, SIMPLIFY=FALSE) stopifnot(all(sapply(comp, do.call, what = all.equal))) ## Look at the relative differences: sapply(mapply(compFunc, lmeMods, lmerMods, SIMPLIFY=FALSE, tol = 0), do.call, what = all.equal) ## add simulated weights to the sleepstudy example n <- nrow(sleepstudy) v <- rpois(n,1) + 1 w <- 1/v sleepLme <- lme(Reaction ~ Days, random = ~ Days|Subject, sleepstudy, weights = varFixed(~v), method = "ML") sleepLmer <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, weights = w, REML = FALSE) sleepComp <- compFunc(sleepLme, sleepLmer) stopifnot(do.call(all.equal, sleepComp)) ## look at relative differences: sleepComp$tolerance <- 0 do.call(all.equal, sleepComp) if (require("mlmRev")) { n <- nrow(Chem97) v <- rpois(n,1) + 1 w <- 1/v Chem97Lme <- lme(score ~ 1, random = ~ 1|lea/school, Chem97) Chem97Lmer <- lmer(score ~ (1|lea/school), Chem97) Chem97Comp <- compFunc(Chem97Lme, Chem97Lmer) stopifnot(do.call(all.equal, Chem97Comp)) ## look at relative differences: Chem97Comp$tolerance <- 0 do.call(all.equal, Chem97Comp) } set.seed(2) n <- 40 w <- runif(n) x <- runif(n) g <- factor(sample(1:10,n,replace=TRUE)) Z <- model.matrix(~g-1); y <- Z%*%rnorm(ncol(Z)) + x + rnorm(n)/w^.5 m <- lmer(y ~ x + (1|g), weights=w, REML = TRUE) ## CRAN-forbidden: ## has4.0 <- require("lme4.0")) has4.0 <- FALSE if(has4.0) { ## m.0 <- lme4.0::lmer(y ~ x + (1|g), weights=w, REML = TRUE) lmer0 <- get("lmer", envir=asNamespace("lme4.0")) m.0 <- lmer0(y ~ x + (1|g), weights=w, REML = TRUE) dput(fixef(m.0)) # c(-0.73065400610675, 2.02895402562926) dput(sigma(m.0)) # 1.73614301673377 dput(VarCorr(m.0)$g[1,1]) # 2.35670451590395 dput(unname(coef(summary(m.0))[,"Std. Error"])) ## c(0.95070076853232, 1.37650858268602) } fixef_lme4.0 <- c(-0.7306540061, 2.0289540256) sigma_lme4.0 <- 1.7361430 Sigma_lme4.0 <- 2.3567045 SE_lme4.0 <- c(0.95070077, 1.37650858) if(has4.0) try(detach("package:lme4.0")) stopifnot(all.equal(unname(fixef(m)), fixef_lme4.0, tolerance = 1e-3)) all.equal(unname(fixef(m)), fixef_lme4.0, tolerance = 0) #-> 1.657e-5 ## but these are not at all equal : (all.equal(sigma(m), sigma_lme4.0, tolerance = 10^-3)) # 0.4276 (all.equal(as.vector(VarCorr(m)$g), Sigma_lme4.0, tolerance = 10^-3)) # 1.038 (all.equal(as.vector(summary(m)$coefficients[,2]), SE_lme4.0, tolerance = 10^-3)) # 0.4276 ## so, lme4.0 was clearly wrong here ##' make sure models that differ only in a constant ##' prior weight have identical deviance: fm <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy,REML=FALSE) fm_wt <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, weights = rep(5, nrow(sleepstudy)),REML=FALSE) all.equal(deviance(fm), deviance(fm_wt)) } ## skip on windows (for speed) lme4/MD50000644000176200001440000004523015226147320011431 0ustar liggesusers2e5b726f280690ac96aa8279ec72c848 *ChangeLog a6264720b43c5a6ac4a4bbd9107583a2 *DESCRIPTION c75721978ea4c8363ac3575f9c73ab5b *LICENSE.note ee687acea4c72ac7223a870a39106910 *NAMESPACE 686568401d4f9e5346479368d7d982d4 *R/AllClass.R c1eda7d4300d934fccc1271aba17f3a1 *R/AllGeneric.R ae4948a0eb8d892036a2de6d485f83ed *R/GHrule.R 2144d8692bd59738a1bddb0022e54a1d *R/VarCorr.R e0efae62e84879eac07c602f735a6bd4 *R/allFit.R 06f236d39161e27b7df2cc171214c9ef *R/bootMer.R f9df62ea4b478231b352c6086cc6912c *R/checkConv.R b4f0b8c8b3038dba296e24e2f6cd2eab *R/covariance.R e6b1c6aa9c84589c6653d7bf08baacad *R/deriv.R 977d9b9359bf2288205f43ce6ec2a4f8 *R/error_factory.R ddcae3fff67be2f3ee0067369af27f5e *R/lmList.R 85d18717ade47770ba940d712aa50d97 *R/lmer.R aa5720e8e88f862e0f46281506d0f04b *R/lmerControl.R 4bde5438bd9ddba5d3cd26e5a43a494b *R/mcmcsamp.R 0873ac9a62829356573a1dd81c2af670 *R/methods.R b8356794af433bcb3775e4730468e050 *R/modular.R fce30fededd71e3c542daf4f1a12f04c *R/nbinom.R e81eeaea1aed45340dc7c174f1d70291 *R/optimizer.R 04ba1a8eb2ca2b3c9ac95ad2a160cd0b *R/plot.R 8d2664f50aa1a47013591cf615bba911 *R/plots.R f464fcc2f9e21964f2241072bad922b0 *R/predict.R aa6766e5018432b2610b0b4f369770a2 *R/profile.R b0c02d0440df7255bfebefc55ecf9881 *R/rePCA.R 24c2830c63f6c21cabf85fcde1cf5fd9 *R/reformulas_imports.R 23f6c8d5a49083960df265fc59418a28 *R/simulate.formula.R 7b20c93bea72e7623e2899de44fb370b *R/sparsegrid.R e057bf248efa620aa2c5c7ad122cd98d *R/sysdata.rda 505a73fb5e2a783b70e772812343dd31 *R/utilities.R b41fc92531834f76a5d17f3f42cc9db0 *R/vcconv.R a35df42350bda919066644ada5aa2bf4 *R/zzz.R 4fd5c7c5dfa9d429f634d0cd50efea43 *build/partial.rdb 289f855fc96ce3b43d7d9ba56b620f70 *build/vignette.rds 7b16a3ab29bb34e105b8edd5333ae95d *data/Arabidopsis.rda 8cf70603a6660d10c170d9e7159c2951 *data/Dyestuff.rda 2f1c751f7de40daa241601f64726c9e0 *data/Dyestuff2.rda 5d257c44f24c98310fbb2e9f85e3e396 *data/InstEval.rda b61a31e7665881741ebd2f88acc98891 *data/Pastes.rda bfd53f3fec03c93b634a4250d03c17a1 *data/Penicillin.rda a545020034749ad9c56e4510fdba6dc1 *data/VerbAgg.rda c80348b333f026d7fe927398894c6f34 *data/cake.rda 09bbd2170531a7256a2cf743f4bec399 *data/cbpp.rda 4c4a08dc8d84fc416de4e8307f1a9aca *data/cbpp2.rda 0e98ab6640deba83977ae969345dc66b *data/culcitalogreg.rda 7e92f3d4a9db18c3be015abe4d5ed940 *data/culcitalvolume.rda b19645e17675ab15d5d678e63291152c *data/gopherdat2.rda 28d1ffd0a450108d274431f7335e859d *data/grouseticks.rda f1b30525638fb87c6dd6d3e372f41370 *data/salamander.rda c69f0363b4e8bbbe1d76db4e6c72dcb8 *data/schizophrenia.rda 3eb17ae1551f7a264c4214460041908c *data/sleepstudy.rda d05d0e603063851a7d795d7dad09a9db *data/toenail.rda 8c81a4cdd4cd634e4102999545422b7e *inst/CITATION 71e19c631d4004eb146cb4d2b61878d6 *inst/NEWS.Rd a856da9c8879aeeccab6f3cb2ddf8766 *inst/REFERENCES.bib 530f977bf3faf4d03466ca5fcd8830bc *inst/doc/PLSvGLS.R f84eeec527edf425f54bb4754e23da61 *inst/doc/PLSvGLS.Rnw bd9da03813e94c584f9d766c2c493218 *inst/doc/PLSvGLS.pdf 8734899d5f18360ec1ea4ea4e5e3d59e *inst/doc/Theory.R 4f0f087495b31139690072d1aca33c00 *inst/doc/Theory.Rnw 806006f0b03732e9d8679509eef9b5a0 *inst/doc/Theory.pdf bdc7f7ab0cf113a0df145922b2749396 *inst/doc/autoscale.R 2cac53cff977b93012764e4a2a5b5e95 *inst/doc/autoscale.Rmd 90c81beb80dd8a6d39136b2871b5a6e7 *inst/doc/autoscale.html df59e455c3560efa4cdc5805336aca57 *inst/doc/covariance_structures.R f42046d4bc012d74771b139a95e0f599 *inst/doc/covariance_structures.Rmd 27d0c047ba8f4c4559eb6a2bd19d5ec8 *inst/doc/covariance_structures.html 683892854b9b79ea31f8dbfea658e9f7 *inst/doc/glmer.R 6eeba85f0ee06ec43a39791e350de73f *inst/doc/glmer.Rnw 72cee66a5ed1c6919bc36f98afb7e776 *inst/doc/glmer.pdf 1b98b0843cae72e274d2077ec70f247c *inst/doc/lmer.R 11644e7acad90a167bf784026040b1b1 *inst/doc/lmer.Rnw 93604d008b627c660639968dee1bbaf0 *inst/doc/lmer.pdf e9ab0fb8b5c0d7d8df0b0be3dda381d0 *inst/doc/lmerperf.R ecde401260019bb51fa974bcda985f37 *inst/doc/lmerperf.Rmd 88ff2257d08bd8a6ac4229dd10321284 *inst/doc/lmerperf.html 6370c9402ab5d10a7cf464e88730e4bc *inst/extra_docs/covariance_structure_comparison.Rmd 26823323ff024e408a9481013eb9f77a *inst/extra_docs/covariance_structure_comparison.html e1ef401074a71e53f5db3b1ff626a043 *inst/testdata/Contraception.rds b63ce45d087ac1ac15e011620990b796 *inst/testdata/Johnson.rda 0ad4852aad9639f10ad13606ecf09908 *inst/testdata/SO_sep25.RData 56173e2cb895c04358bf1bf81bab1495 *inst/testdata/Thailand.rda aedcb80c37b6d01f4db5bd076ebc3298 *inst/testdata/badprof.rds da186eafec8322a55ec78451e19fd01a *inst/testdata/boo01L.RData b4b99dec3880c755f42a8dc9e77a067b *inst/testdata/colonizer_rand.rda 8a445ad28ddc63a87ff828ec55be99cb *inst/testdata/confint_ex.rda 5f381198d17abbc54763cb7afe2608f8 *inst/testdata/crabs_randdata00.Rda 693aae2f30886fa217ca1b82b0ed43bb *inst/testdata/crabs_randdata2.Rda 038cc2f0fce197eb134607eee63fe83c *inst/testdata/culcita_dat.RData ec60161c46be3b6dbb2840490204eb79 *inst/testdata/dat20101314.csv 2c5596646060c432ca9e53cb5b61e307 *inst/testdata/dataEx_Glmer.txt c340d92f256024616f2aaf56b3460c23 *inst/testdata/fakesim.RData c4da30c5d3e1a239b621a04a25df8db9 *inst/testdata/glmmTMB_glmer_ar1_comparison.R d4f1526f97a342356659634b016385a2 *inst/testdata/glmmTMB_glmer_ar1_comparison.rds db58d90a120922be1d62a9252b8f1e2d *inst/testdata/gopherdat2.RData 8fb10b3889a527fbb661415f7cbb8e11 *inst/testdata/gotway_hessianfly.rda d10397932e1069526d47be9e961e609c *inst/testdata/harmel_density.R cb4e78532620e108c5c3af0c77fdb092 *inst/testdata/harmel_profile.rds eeae66bdabc2c1af320e278718105a29 *inst/testdata/hotpower.csv cf78ea240b9aa971169ec4e513b328f7 *inst/testdata/koller-data.R 4635d7c7d32300f4dcd9c5c810cde517 *inst/testdata/lme-tst-fits.R 8e789eec8fededa43e13ebeed8711c54 *inst/testdata/lme-tst-fits.rda 4e4f8105bf0b78e879e2f96fbf87323f *inst/testdata/lme-tst-funs.R f01648354c4d6c08320a551d7bdd3c7a *inst/testdata/lmerperf.rda 3dffc4c30b964f86f938b6d8c656d13d *inst/testdata/mastitis.rda 3313df191ef524ea5b887dcb54b3f153 *inst/testdata/polytom2.RData fd199a7fcece25952b873986d3ac0b1a *inst/testdata/polytom3.RData 10d8d2dab0664031ff18831a9213d1f3 *inst/testdata/polytomous_test.RData 36f44d658986561eee513a4a2789afe7 *inst/testdata/polytomous_vcov_ex.RData c3a152c99372c2097426afb07adea841 *inst/testdata/prLogistic.RData 402feea181e789a9b24bd0df88b73717 *inst/testdata/radinger_dat.RData 0de901759722680f5c73ed77a6f6aae2 *inst/testdata/rankMatrix.rds e7fc63ccb18cc703074586afaa6cb4a6 *inst/testdata/respiratory.RData f3e1a564e23849bf8db38440b543c944 *inst/testdata/sbTobb.Rdata 3a50c8e1daec82e4208e7893cc963e18 *inst/testdata/strip_env.R 7c4e1116306646d99c9ef1a20c98afa7 *inst/testdata/survdat_reduced.Rda 099ea61029083bad8375e2cfbc4735a4 *inst/testdata/test-covariance_structures_data.R 97b5e3ca148a48f6615892f34981d9ca *inst/testdata/test-covariance_structures_data.rds dca0ccff30089606e068a486f5b51d67 *inst/testdata/tprfm1.RData 0eec27a5b9eab6d5b3d190cd37ec6634 *inst/testdata/trees513.R 145eb2c3cf4bac44b217618a0525e0e4 *inst/testdata/trees513.RData eeb7607787b40c58c2db9685e5939eeb *inst/tinytest/test_lme4.R 8f1a9d8dc240dda34a8791eb64d16b4c *inst/vignette_data/Contraception_batch.rda c4bb9b79abd8ab0e3d9dfc3aa6072e23 *inst/vignette_data/bootmer_test.R 461da1874b809f6bd1d83b3947e81271 *inst/vignette_data/cbpp2.csv de8d958edca13356ec82986fa610ef38 *inst/vignette_data/cbpp_batch.rda aeff9b3aa2edf1fea8f75991dd80d779 *inst/vignette_data/glmer_Contraception_batch.R eb2e9ee585b0581fdfa9b542986858eb *inst/vignette_data/glmer_batch_funs.R 33746234179ba774bb01f540aba5ee02 *inst/vignette_data/glmer_cbpp_batch.R 1ee31759538f3cdd154c45c9b2a826ea *man/Arabidopsis.Rd 949a5ac4b37476823b3c8f689cc2217c *man/Covariance-class.Rd b0980448dc54f6b5bacb98a60b0f3599 *man/Dyestuff.Rd 074e24a7f48fad74c46966d938191c8f *man/GHrule.Rd 63bcaefc2718a7d338bf093d44f6ac5b *man/GQdk.Rd 63677bddce89a841f9f69c5f467b1516 *man/InstEval.Rd 1d25a90dcaa8ba7bc62594892d2f5006 *man/NelderMead-class.Rd ad16fef8b8dc2ac1d116bee141e48baa *man/Nelder_Mead.Rd 0b05bd206b85ecf1d063a3e59ae1c6c8 *man/Pastes.Rd 68bbfa336af152b1507633f65a20b1c6 *man/Penicillin.Rd 26978085b7221dc0325cc69f9446bd85 *man/VarCorr.Rd 9c9b75fd0fb50f825dfa75ace2363640 *man/VerbAgg.Rd 12b1f1610fd37bdca9d057ef77fe9b3e *man/allFit.Rd d76adcb41fca37e6ed3fe9364b8a882a *man/bootMer.Rd 76ab479994a53c97d9d606b1fcb33786 *man/cake.Rd 1999f454586dca0aaee5b7e5d8dada8d *man/cbpp.Rd e3c4dbf7e22fe2352878e9427ad3fafd *man/checkConv.Rd 9619446df169c6887927b42844c25ed6 *man/confint.merMod.Rd 1dab3afe2e04f5b9b69519b6b5c0f5fd *man/convergence.Rd 34206be023f56a92b14031218dd9cb67 *man/culcitalogreg.Rd add82d29763137363248ec6661e59b7f *man/culcitalvolume.Rd 3824501b16af01f2424271e95ba7c7ba *man/devcomp.Rd 4e8026f3ee58c929720f23949c561cdc *man/devfun2.Rd 146e7b9919149a3b4fda8b2454bc022c *man/deviance.Rd a934cdd2a196abbc1e9f332281077ede *man/drop1.merMod.Rd 0ffadf84fce25e56463e86ccf165e04b *man/dummy.Rd 20e78573b5222c04c999b4abd03f04a2 *man/factorize.Rd 934c16e84d48545569fdb9528cc9fb23 *man/fixef.Rd 2fa58c5a47024f77c29be94508844328 *man/fortify.Rd 02797721061ab83b6dc80f22c8193768 *man/getDoublevertDefault.Rd beb9aef7883547a4f45bc5c8a9a049a2 *man/getME.Rd 839683431e7d1762dfc16d824d7f48c0 *man/getReCovs.Rd c0c66bc34fc7cd0b242d62901a9d4cb8 *man/glmFamily-class.Rd b595fec321f7ca73ed88b843126baeef *man/glmFamily.Rd c5525f5b5606af17399515c494ea5992 *man/glmer.Rd a2f6e4133eff7b2288bcc20c01ca3c29 *man/glmer.nb.Rd 36383a0393e3f8f285f7c1d3fe04160b *man/glmerLaplaceHandle.Rd dc26eb9f86b5056b90e2e90d531490c1 *man/golden-class.Rd bd73285cac844cd4b17a8eb3a4214d9a *man/gopherdat2.Rd e93d4db92b0710b1ea4123ce0ae126eb *man/grouseticks.Rd c4236aab077a04046402a23b86635a7b *man/hatvalues.merMod.Rd 3fc885f6b91ad7b739f6fddc4c2e86d8 *man/influence.merMod.Rd 1d4ad2ebb44774433ea1c94bc780e109 *man/isNewMerMod.Rd e10407c28ced55696cb726daac2d9c05 *man/isREML.Rd b97157c9a799094bc05c06b7f2fa5839 *man/isSingular.Rd 1f65a3566866ce069714f113adeaf9d8 *man/lmList.Rd e4faeace55fd64773ae425a8d0f72713 *man/lmList4-class.Rd 7d8ebc023d6f58fd43e3a35047240342 *man/lmResp-class.Rd d9e3572637ffe3760c4a531f0a9828c0 *man/lmResp.Rd 5be68d6000e53966c5c7fbb470609929 *man/lme4-package.Rd 36b814d230675b6fedced4d5aeaa8840 *man/lme4_testlevel.Rd d4a03b8ce90b608515d0a51f0b203995 *man/lmer.Rd 51512a2eb2219f8806df082e3b2d7c03 *man/lmerControl.Rd 95c0414fb0aa6dd590243941b300f5de *man/merMod-class.Rd 67daa8376c15b9f3eebf77f83cd5b6c7 *man/merPredD-class.Rd 2c4a82fb8f0e4d1d3a5f754c242ccee5 *man/merPredD.Rd 439f14f756516340826b45c677739178 *man/mkMerMod.Rd bd4ec2cbbfbdeb9a6b862b1f7dc4f82d *man/mkNewReTrms.Rd 01b2b9af87d5a480bd424980f688df20 *man/mkRespMod.Rd 97cd5db2899f0c8587e1205df415cd21 *man/mkSimulationTemplate.Rd fb937d45862f1cfa7296cbddcd160739 *man/mkVarCorr.Rd 6dce25b23cb8dbf75b7cc071f362922c *man/modular.Rd 1afe7f8a3c84ec0759662f5c8718c2ae *man/namedList.Rd b6a57f539f0628c52c83ec28a3a1e1c2 *man/ngrps.Rd 2e75c4db38b56068b22793f2d0a5d56e *man/nlformula.Rd 98a6e0f951393a58ecb999792922bcad *man/nlmer.Rd 9d0550af0e7bca952d48bc8e25535e6e *man/nloptwrap.Rd c0979349ce65d5994dcf4d898230f5c9 *man/plot.merMod.Rd ca94cfa042f96d97bf2639c88f508f63 *man/plots.thpr.Rd 6b6b81db97d494acb567f47f934ce3ce *man/predict.merMod.Rd aa0a9cdfd41ea10a98add6dede52f29f *man/profile-methods.Rd 64d299749bf5c9a8ed4889a14edd0dad *man/pvalues.Rd b88b10a913d43a8c2625b03185c48c09 *man/ranef.Rd d54f71f92db8797776738cb8f3a4706d *man/rePCA.Rd f1619455da67c1fe4ebb48da69d41663 *man/rePos-class.Rd 24efcd0c579045d6aa2b74818a3b3e62 *man/rePos.Rd 5f0d75e8351fd01aea599bf45d233292 *man/refit.Rd fc1dffbf663939a2c12d6a64ab2488a1 *man/refitML.Rd 6b19400d28de99a8f8a265bdb5e7017a *man/reformulas_imports.Rd dbe8547e6c2911509a4310514b506803 *man/residuals.merMod.Rd 5ac50fba5d1a84ea2c2319f92c85efee *man/salamander.Rd 5f07d8f601ac86e964ddaf858fabff27 *man/schizophrenia.Rd 7372ddbda395871db2dc6252240262e6 *man/sigma.Rd ac312d5990e96c04a3bef4613ab693a6 *man/simulate.formula.Rd da7883738740d1b5482454a2fe6dc92d *man/simulate.merMod.Rd 28b90443ea22ac4c7cef2eae06d612de *man/sleepstudy.Rd 02414062c3472f0c473276a615ec1663 *man/summary.merMod.Rd c03c6600e94a62f0902f540dac92610c *man/toenail.Rd a6be665c1a6b719b2ef02a30d1d16068 *man/troubleshooting.Rd 4f22a2151fccc96d7a66d43e50854552 *man/utilities.Rd eeb3cc1e7dda77e29d74b46216ca483a *man/vcconv.Rd b5fee42ee072ae6ddc1d427019d095d3 *man/vcov.merMod.Rd ac607ddbd1be24663cddb063de18ce48 *src/Makevars 9faf9df33ef6101441741d018009a391 *src/Makevars.win 2ad2fef6fff1b12bd60f5cb4c8646aaa *src/external.cpp 29f517a9f513c55cb34ede9d56604895 *src/glmFamily.cpp fd71b2c3113a00e013aa1818b5e316a3 *src/glmFamily.h a56932e09562f68b7c4d00f854159f95 *src/lme4CholmodDecomposition.h 32c841db506eca816f556d7afa42dff6 *src/optimizer.cpp e84ed1741b657d321391c2e98b24083b *src/optimizer.h a690f2ecb3fb10d7aeb2680805f9bb5f *src/predModule.cpp c3694080138b784156b16c3ca6783614 *src/predModule.h cdf2dbfbe86509142c71bc0f240da638 *src/respModule.cpp 9e54026971ddeae1ec36a759e38ec699 *src/respModule.h 8bbacc62f05c91663ae579ddf04f7a35 *tests/AAAtest-all.R 14640f06d83b93755b9394981ba230aa *tests/HSAURtrees.R a810120b26ea54a7c44ec24aa9f441f5 *tests/README 98a404e235e377a972b4bc6684b67231 *tests/REMLdev.R 1d7c93d885154b156d3a387f1735e080 *tests/ST.R 06860efd9f34c2e9c1a25775f9c005de *tests/agridat_gotway.R 72629d152627bee93db4bb3b1065be0e *tests/bootMer.R 215ad3b7fc4bfb8554e8004fca339785 *tests/boundary.R 1e0d5e618c9484fd753d412586c9995a *tests/confint.R e0947bd9ce40080d115a7f35304d623a *tests/devCritFun.R ebc403e112bc9788710262665525e2ba *tests/drop.R d296f685d1731f8eb26cc21c8aa45229 *tests/drop1contrasts.R 6d3709bac2db9daf69e1e29aa3d2d273 *tests/dynload.R 9a9fc948c5fa7f2d9ee556fa89b516ed *tests/elston.R 4a15fbb6260ecf8c0db04bdcb37729c8 *tests/evalCall.R 65c300f2156a21d8492b0a050800057f *tests/extras.R 46e18635f440a030fe3e0e57c902ad81 *tests/falsezero_dorie.R 5e49f8a8d4b7275dfa584ab6b5e1c08c *tests/fewlevels.R 22abbcf0bf53d87a69fb887b6dc29ee6 *tests/getME.R 888cc7e9c057ab9cedab52615b0a39c9 *tests/glmer-1.R 87fbf8bcb9704fe0d95928f441e2c85d *tests/glmerControlPass.R 46de511d77c5e07b8de44c9abcb7b63f *tests/glmerWarn.R b48de01b501b4173e4b103650e11121c *tests/glmmExt.R 1c3dbc408c2995ffd9263f68fc40f944 *tests/glmmWeights.R 214757f88c9e26dc7936ea9ec1594bf9 *tests/hatvalues.R 3693e1cc55ebb3bcf5aaf46ee0bf1eb1 *tests/is.R fd186269bb93bbac5dd07ec81ea3ec2f *tests/lmList-tst.R 1d2d60b8842fae30078e428d29c253d6 *tests/lme4_nlme.R 0e1a2e95602e958f00b0802afd210dee *tests/lmer-0.R 5aadd260b489660b73d41195fd04bd93 *tests/lmer-1.R d01e36cf014c17a45a448da442fec402 *tests/lmer-conv.R 3626933bc63874cc482b23542cfb1325 *tests/lmer2_ex.R b14e84bbdf9344cb4514151d99d513d4 *tests/methods.R ef374523e11228e4f2df65883ac1ba42 *tests/minval.R dc038e000b1d664c0c3fc1afa713dd73 *tests/modFormula.R 59670cafae675128957c07dc8307e4c3 *tests/nbinom.R c44581c823bf500428f485bb6d02ea84 *tests/nlmer-conv.R 4182acd6af58c584c25d745f98d3491f *tests/nlmer.R b7265658c2f03aef75e1ae2fe1617fd2 *tests/offset.R f3f4fe4f43b835de94f56df46940c87e *tests/optimizer.R 243906ce404ce78f0e54487f9f128419 *tests/polytomous.R d43a3e94c09040bc3ea42155f9ac3e11 *tests/prLogistic.R b9add26a39ae6e9b7640010a25ff4ce0 *tests/predict_basis.R bd056d4618a5af1874bbd14e36f99ea9 *tests/predsim.R 962e548f367fac7d7ac6f6a74fd0aac8 *tests/priorWeights.R f66f45c2d7efe66c1a899ac004c6cc7c *tests/priorWeightsModComp.R faf2b2096f6f82784c40cc7f53828b8e *tests/profile-tst.R b2a49dcf6fde0fd4c2f163604fbfa613 *tests/refit.R f41d72b2048efd5d4aee555f78e1292f *tests/resids.R 59b7d77420eed731836649460fabdd3e *tests/respiratory.R 7ff092a47c0f3c2f0d951b907388e520 *tests/simulate.R 14328f790312794d092fe203766763dc *tests/test-glmernbref.R 8375fd1d85d82c024a5a2bbab8b01a14 *tests/testOptControl.R 8c2cb194b2102d830e8ec03a7d90e05c *tests/testcolonizer.R 15941a256e7cc8cf2a6d55c73b032e37 *tests/testcrab.R 595cda104fe3ed158e2840a608bacf91 *tests/testthat/_problems/test-predict-679.R 63cc04a569c94bc9ec515e4b040a3bff *tests/testthat/setup.R c89f52e97268257f7ae4d37361287636 *tests/testthat/test-NAhandling.R a5c25ac320375ecde41c0814210146b2 *tests/testthat/test-allFit.R c443c382fb65bfcdc8b20d0c55a1df1b *tests/testthat/test-catch.R 3831555f88c89bd6390741e87065324c *tests/testthat/test-covariance_glmer.R d7820023739c655446cb1c248120d945 *tests/testthat/test-covariance_nlmer.R 8e9c3ec52b72d28bc1c8e44771437479 *tests/testthat/test-covariance_structures.R 8aa493d80cd6ea40a10086e69378ec68 *tests/testthat/test-debug.R 2a4a1d36f539a7bb1e7523aa4f217ddb *tests/testthat/test-doubleVertNotation.R 16ce5ce01d101a5db4714e91e10f5f06 *tests/testthat/test-eval.R 2f7b02e3ba999923e94609eef3beaaa1 *tests/testthat/test-factors.R 7c4d04bad17435b592404275387713f2 *tests/testthat/test-formulaEval.R 5fe5117be547d2648f041706f6d6aab9 *tests/testthat/test-glmFamily.R 1ed0ba7ddb69edeb182205c725c7aad1 *tests/testthat/test-glmer.R fab93bb234dd1871f5120c47eaec5d7b *tests/testthat/test-glmernb.R 74dd6fd7dbe3b334265d451458d10a3b *tests/testthat/test-glmernbref.R c0891296b9d37be43892867f2257772d *tests/testthat/test-glmmFail.R 98d92e236a8eee763fc67b1009f31672 *tests/testthat/test-isSingular.R 2f9abffbb70e9a9232e04e120b3ac0c9 *tests/testthat/test-lmList.R 8aadd1f6991b5fbe0132e389f221001f *tests/testthat/test-lmer.R 5116f7095cd0ddb87ed4752f5a4993d9 *tests/testthat/test-lmerResp.R bd6bd3b902b7e7d25ced8950f87b69bc *tests/testthat/test-methods.R 71678cf550b8ae33232bf8f04fb8d05c *tests/testthat/test-nbinom.R 60136bd54929dfdf4ed40a07cfa7ccb5 *tests/testthat/test-nlmer.R 0ca42d66dc6ea4226299f05c81d311dc *tests/testthat/test-oldRZXfailure.R 45461e46da306a159ec153a68e69e4a5 *tests/testthat/test-predict.R c04d87ca032c6be8f83a54e22d8b8727 *tests/testthat/test-ranef.R 0909b4a79a002fc184764efd6dc6ec4e *tests/testthat/test-rank.R 70bbc14d50898215a89ef19b13169673 *tests/testthat/test-reformulas-import.R 8f21990cbc8e4ef71be1d356d4ea57be *tests/testthat/test-resids.R ce71f34d536b796718d2f5758a5f0d6c *tests/testthat/test-simulate_formula.R 1860e2d4be2718323537a88584d3f080 *tests/testthat/test-start.R 6e8174813b41061670d252ff1a767d47 *tests/testthat/test-stepHalving.R d4e4ef4fa0f3ee02da87bc4dbf0decb1 *tests/testthat/test-summary.R abeaf259f994048929d6c444b74978eb *tests/testthat/test-utils.R e40e57adf55a75fe5078c5f079758aee *tests/testthat/test-weights.R ce72dd3a6585a6d08e5af85b3ca8c1da *tests/throw.R b8d09265b05a579ab6b218887b59b70b *tests/varcorr.R 888b6d0b47901ba9a40003d6868a65aa *tests/vcov-etc.R f84eeec527edf425f54bb4754e23da61 *vignettes/PLSvGLS.Rnw 4f0f087495b31139690072d1aca33c00 *vignettes/Theory.Rnw 2cac53cff977b93012764e4a2a5b5e95 *vignettes/autoscale.Rmd 6831b97f724b344ded70e58bfb0197df *vignettes/autoscale_ref.bib f42046d4bc012d74771b139a95e0f599 *vignettes/covariance_structures.Rmd 866dfa44b98c450bed6e544731ef7894 *vignettes/cplot.R 6eeba85f0ee06ec43a39791e350de73f *vignettes/glmer.Rnw cdd193b95c3f3ef1765205f2f6c67707 *vignettes/glmer.bib b9564ddd59a06782310989e8f33db55e *vignettes/jsslogo.jpg 9c40378d0fbc0a8a8709908391461f5b *vignettes/lme4.bib 11644e7acad90a167bf784026040b1b1 *vignettes/lmer.Rnw a896bc66e740edc79028dbaadf6852a9 *vignettes/lmer.bib ecde401260019bb51fa974bcda985f37 *vignettes/lmerperf.Rmd lme4/R/0000755000176200001440000000000015225714450011321 5ustar liggesuserslme4/R/nbinom.R0000644000176200001440000001401515036542626012733 0ustar liggesusers##' @importFrom MASS negative.binomial ##' @importFrom MASS theta.ml ## ==> user should use getME(object, "glmer.nb.theta") getNBdisp <- function(object) environment(object@resp$family$aic)[[".Theta"]] ## Hidden, originally used at least once, well tested (!), but if(FALSE) # not needed anymore currently getNBdisp.fam <- function(familyString) as.numeric(sub(".*([-+]?\\d+(\\.\\d*)?([Ee][-+]?\\d+)?){1}.*", "\\1", familyString)) ## Package "constants" {only on depending the glmResp definition in ./AllClass.R}: glmResp.f.nms <- names(glmResp$fields()) glmNB.to.change <- setdiff(glmResp.f.nms, c("Ptr", "family")) ##' setNBdisp(object,theta) := ##' NB-object with changed [DISP]ersion parameter 'theta' (and all that entails) setNBdisp <- function(object,theta) { ## assign(".Theta",theta,envir=environment(object@resp$family$aic)) rr <- object@resp newresp <- do.call(glmResp$new, c(lapply(setNames(nm=glmNB.to.change), rr$field), list(family = MASS::negative.binomial(theta=theta)))) newresp$setOffset(rr$offset) newresp$updateMu(rr$eta - rr$offset) object@resp <- newresp object } refitNB <- function(object, theta, control = NULL) { refit(setNBdisp(object, theta), control = control) } ##' @title Optimize over the Negative Binomial Parameter Theta ##' @param object a "glmerMod" object, updated from poisson to negative.binomial() ##' @param interval and ##' @param tol are both passed to \code{\link{optimize}()}. ##' @param verbose ## show our own progress ##' @param control passed to \code{\link{refit}()} ##' @return the last fit, an object like 'object' optTheta <- function(object, interval = c(-5,5), tol = .Machine$double.eps^0.25, verbose = FALSE, control = NULL) { lastfit <- object it <- 0L NBfun <- function(t) { ## Kluge to retain last value and evaluation count {good enough for ..} f_refitNB <- factory(refitNB,types=c("message","warning")) lastfit <<- f_refitNB(lastfit, theta = exp(t), control = control) dev <- -2*logLik(lastfit) it <<- it+1L if (verbose) cat(sprintf("%2d: th=%#15.10g, dev=%#14.8f, beta[1]=%#14.8f\n", it, exp(t), dev, lastfit@beta[1])) dev } optval <- optimize(NBfun, interval=interval, tol=tol) stopifnot(all.equal(optval$minimum, log(getNBdisp(lastfit)))) ## FIXME: return eval count info somewhere else? MM: new slot there, why not? attr(lastfit,"nevals") <- it ## fix up the 'th' expression, replacing it by the real number, ## so effects:::mer.to.glm() can eval() it: lastfit@call$family[["theta"]] <- exp(optval$minimum) ## output warnings/messages from last fit for (m in c("warning","message")) { if (!is.null(x <- attr(lastfit,paste0("factory-",m)))) { for (i in x) { get(m,pos="package:base")(i) } } } lastfit } ## use MASS machinery to estimate theta from residuals est_theta <- function(object, limit = 20, eps = .Machine$double.eps^0.25, trace = 0) { Y <- model.response(model.frame(object)) ## may have NA values if na.exclude was used ... mu <- na.omit(fitted(object)) theta.ml(Y, mu, weights = object@resp$weights, limit = limit, eps = eps, trace = trace) } ## -------> ../man/glmer.Rd ##' glmer() for Negative Binomial ##' @param ... formula, data, etc: the arguments for ##' \code{\link{glmer}(..)} (apart from \code{family}!). glmer.nb <- function(..., interval = log(th) + c(-3,3), tol = 5e-5, verbose = FALSE, nb.control = NULL, initCtrl = list(limit = 20, eps = 2*tol, trace = verbose, theta = NULL)) { ## ?? E() is a placeholder; [-1] removes it ## left with a 'headless' list of elements in ... dotE <- as.list(substitute(E(...))[-1]) ## nE <- names(dotE <- as.list(substitute(E(...))[-1])) ## i <- match(c("formula",""), nE) ## i.frml <- i[!is.na(i)][[1]] # the index of "formula" in '...' ## dots <- list(...) mc <- match.call() if (is.null(th <- initCtrl$theta)) { mc[[1]] <- quote(lme4::glmer) mc$family <- quote(stats::poisson) mc$verbose <- (verbose>=2) mc$nb.control <- NULL ## ** FIXME: specifically add check.conv.singular="ignore"? ## suppress other warnings unless explicitly specified? g0 <- suppressMessages( eval(mc, parent.frame(1L)) ) th <- est_theta(g0, limit = initCtrl$limit, eps = initCtrl$eps, trace = initCtrl$trace) ## using format() on purpose, influenced by options(digits = *) : if(verbose) cat("th := est_theta(glmer(..)) =", format(th)) } mc$initCtrl <- NULL ## clear to prevent infinite recursion ## in initCtrl$theta reference above ... mc$family <- bquote(MASS::negative.binomial(theta=.(th))) ## ** see FIXME above g1 <- suppressMessages( eval(mc, parent.frame(1L)) ) if(verbose) cat(" --> dev.= -2*logLik(.) =", format(-2*logLik(g1)),"\n") ## fix the 'data' part (only now!) if("data" %in% names(g1@call)) { if (!is.null(dotE[["data"]])) { g1@call[["data"]] <- dotE[["data"]] } } else warning("no 'data = *' in glmer.nb() call ... Not much is guaranteed") other.args <- c("verbose","control") for (a in other.args) { if (a %in% names(g1@call)) { g1@call[[a]] <- dotE[[a]] } } ## FIXME: optTheta should also work by modifying mc directly, ## then re-evaluating, not via refit() ... control <- eval.parent(g1@call$control) res <- optTheta(g1, interval=interval, tol=tol, verbose=verbose, control = c(control, nb.control)) res } ## do we want to facilitate profiling on theta?? ## save evaluations used in optimize() fit? ## ('memoise'?) ## Again, I think that a reference class object would be a better approach. lme4/R/plot.R0000644000176200001440000005243415213637124012431 0ustar liggesusers## copied/modified from nlme ##' split, on the nm call, the rhs of a formula into a list of subformulas splitFormula <- function(form, sep = "/") { if (inherits(form, "formula") || mode(form) == "call" && form[[1]] == as.name("~")) splitFormula(form[[length(form)]], sep = sep) else if (mode(form) == "call" && form[[1]] == as.name(sep)) do.call(c, lapply(as.list(form[-1]), splitFormula, sep = sep)) else if (mode(form) == "(") splitFormula(form[[2]], sep = sep) else if (length(form)) list(asOneSidedFormula(form)) ## else ## NULL } ## Recursive version of all.vars allVarsRec <- function(object) { if (is.list(object)) { unlist(lapply(object, allVarsRec)) } else { all.vars(object) } } ## simple version of getData.gnls from nlme ## but we *should* and *can* work with environment(formula(.)) getData.merMod <- function(object) { mCall <- getCall(object) dataName <- deparse(mCall$data) startEnv <- environment(formula(object)) data <- tryCatch( eval(mCall$data, startEnv), error = function(e) { stop(sprintf( "original data object %s not found; make sure it exists in environment(formula()) of the model or re-load it into the current environment", sQuote(dataName)), call. = FALSE) } ) if (!is.data.frame(data) && !is.matrix(data)) { ## walk the parent chain from startEnv to find where the object lives, ## to diagnose the common case of a name like 'data' masking a built-in e <- startEnv foundIn <- NULL while (!identical(e, emptyenv())) { if (exists(dataName, envir = e, inherits = FALSE)) { nm <- environmentName(e) foundIn <- if (nzchar(nm)) nm else "an anonymous environment" break } e <- parent.env(e) } stop(sprintf( "data object %s is not a data frame or matrix (found a %s%s); it may be masked by a built-in R object with the same name", sQuote(dataName), class(data)[[1L]], if (!is.null(foundIn)) paste0(" in ", sQuote(foundIn)) else ""), call. = FALSE) } ## FIXME: consider applying lapply(data, drop) here to strip 1-col matrix columns ## (e.g. those returned by scale()) before returning; such columns can cause ## downstream failures in functions like poly() that accept matrix input during ## initial model fitting but reject it when re-evaluating with pre-specified coefs return(data) } asOneFormula <- ## Constructs a linear formula with all the variables used in a ## list of formulas, except for the names in omit function(..., omit = c(".", "pi")) { names <- unique(allVarsRec(list(...))) names <- names[is.na(match(names, omit))] if (length(names)) as.formula(paste("~", paste(names, collapse = "+"))) # else NULL } getIDLabels <- function(object, form=formula(object)) { mf <- factorize(form,model.frame(object)) if (length(ff <- reformulas::findbars(form))>0) { grps <- lapply(ff,"[[",3) } else { grps <- form[[2]] } if (identical(grps,quote(.obs))) return(seq(fitted(object))) fList <- lapply(grps,function(x) eval(x,mf)) do.call(interaction,fList) } ## TESTING ## lme4:::getIDLabels(fm1) ## Return the formula(s) for the groups associated with object. ## The result is a one-sided formula unless asList is TRUE in which case ## it is a list of formulas, one for each level. getGroupsFormula <- function(object, asList = FALSE, sep = "+") UseMethod("getGroupsFormula") getGroupsFormula.default <- ## Return the formula(s) for the groups associated with object. ## The result is a one-sided formula unless asList is TRUE in which case ## it is a list of formulas, one for each level. function(object, asList = FALSE, sep = "/") { form <- formula(object) if (!inherits(form, "formula")){ stop("\"Form\" argument must be a formula") } form <- form[[length(form)]] if (!((length(form) == 3) && (form[[1]] == as.name("|")))) { ## no conditioning expression return(NULL) } ## val <- list( asOneSidedFormula( form[[ 3 ]] ) ) val <- splitFormula(asOneSidedFormula(form[[3]]), sep = sep) names(val) <- unlist(lapply(val, function(el) deparse(el[[2]]))) # if (!missing(level)) { # if (length(level) == 1) { # return(val[[level]]) # } else { # val <- val[level] # } # } if (asList) as.list(val) else as.formula(paste("~", paste(names(val), collapse = sep))) } getGroupsFormula.merMod <- function(object,asList=FALSE, sep="+") { if (asList) { lapply(names(object@flist),asOneSidedFormula) } else { asOneSidedFormula(paste(names(object@flist),collapse=sep)) } } getCovariateFormula <- function (object) { form <- formula(object) if (!(inherits(form, "formula"))) { stop("formula(object) must return a formula") } form <- form[[length(form)]] if (length(form) == 3 && form[[1]] == as.name("|")) { form <- form[[2]] } eval(substitute(~form)) } getResponseFormula <- function(object) { ## Return the response formula as a one sided formula form <- formula(object) if (!(inherits(form, "formula") && (length(form) == 3))) { stop("\"Form\" must be a two sided formula") } as.formula(paste("~", deparse(form[[2]]))) } ##' diagnostic plots for merMod fits ##' @param x a fitted [ng]lmer model ##' @param form an optional formula specifying the desired type of plot. Any ##' variable present in the original data frame used to obtain ##' \code{x} can be referenced. In addition, \code{x} itself can be ##' referenced in the formula using the symbol \code{"."}. Conditional ##' expressions on the right of a \code{|} operator can be used to ##' define separate panels in a lattice display. Default is ##' \code{resid(., type = "pearson") ~ fitted(.)}, corresponding to a plot ##' of the standardized residuals versus fitted values. ##' @param abline an optional numeric value, or numeric vector of length ##' two. If given as a single value, a horizontal line will be added to the ##' plot at that coordinate; else, if given as a vector, its values are ##' used as the intercept and slope for a line added to the plot. If ##' missing, no lines are added to the plot. ##' @param id an optional numeric value, or one-sided formula. If given as ##' a value, it is used as a significance level for a two-sided outlier ##' test for the standardized, or normalized residuals. Observations with ##' absolute standardized (normalized) residuals greater than the \eqn{1-value/2} ##' quantile of the standard normal distribution are ##' identified in the plot using \code{idLabels}. If given as a one-sided ##' formula, its right hand side must evaluate to a logical, integer, or ##' character vector which is used to identify observations in the ##' plot. If missing, no observations are identified. ##' @param idLabels an optional vector, or one-sided formula. If given as a ##' vector, it is converted to character and used to label the ##' observations identified according to \code{id}. If given as a ##' vector, it is converted to character and used to label the ##' observations identified according to \code{id}. If given as a ##' one-sided formula, its right hand side must evaluate to a vector ##' which is converted to character and used to label the identified ##' observations. Default is the interaction of all the grouping variables ##' in the data frame. The special formula ##' @param grid an optional logical value indicating whether a grid should ##' be added to plot. Default depends on the type of lattice plot used: ##' if \code{xyplot} defaults to \code{TRUE}, else defaults to ##' \code{FALSE}. ##' @param \dots optional arguments passed to the lattice plot function. ##' @details Diagnostic plots for the linear mixed-effects fit are obtained. The ##' \code{form} argument gives considerable flexibility in the type of ##' plot specification. A conditioning expression (on the right side of a ##' \code{|} operator) always implies that different panels are used for ##' each level of the conditioning factor, according to a lattice ##' display. If \code{form} is a one-sided formula, histograms of the ##' variable on the right hand side of the formula, before a \code{|} ##' operator, are displayed (the lattice function \code{histogram} is ##' used). If \code{form} is two-sided and both its left and ##' right hand side variables are numeric, scatter plots are displayed ##' (the lattice function \code{xyplot} is used). Finally, if \code{form} ##' is two-sided and its left had side variable is a factor, box-plots of ##' the right hand side variable by the levels of the left hand side ##' variable are displayed (the lattice function \code{bwplot} is used). ##' @author original version in \code{nlme} package by Jose Pinheiro and Douglas Bates ##' @examples ##' data(Orthodont,package="nlme") ##' fm1 <- lmer(distance ~ age + (age|Subject), data=Orthodont) ##' ## standardized residuals versus fitted values by gender ##' plot(fm1, resid(., scaled=TRUE) ~ fitted(.) | Sex, abline = 0) ##' ## box-plots of residuals by Subject ##' plot(fm1, Subject ~ resid(., scaled=TRUE)) ##' ## observed versus fitted values by Subject ##' plot(fm1, distance ~ fitted(.) | Subject, abline = c(0,1)) ##' ## residuals by age, separated by Subject ##' plot(fm1, resid(., scaled=TRUE) ~ age | Sex, abline = 0) ##' if (require(ggplot2)) { ##' ## we can create the same plots using ggplot2 and the fortify() function ##' fm1F <- fortify(fm1) ##' ggplot(fm1F, aes(.fitted,.resid)) + geom_point(colour="blue") + ##' facet_grid(.~Sex) + geom_hline(yintercept=0) ##' ## note: Subjects are ordered by mean distance ##' ggplot(fm1F, aes(Subject,.resid)) + geom_boxplot() + coord_flip() ##' ggplot(fm1F, aes(.fitted,distance))+ geom_point(colour="blue") + ##' facet_wrap(~Subject) +geom_abline(intercept=0,slope=1) ##' ggplot(fm1F, aes(age,.resid)) + geom_point(colour="blue") + facet_grid(.~Sex) + ##' geom_hline(yintercept=0)+geom_line(aes(group=Subject),alpha=0.4)+geom_smooth(method="loess") ##' ## (warnings about loess are due to having only 4 unique x values) ##' detach("package:ggplot2") ##' } ##' @S3method plot merMod ##' @method plot merMod ##' @export plot.merMod <- function(x, form = resid(., type = "pearson") ~ fitted(.), abline, id = NULL, idLabels = NULL, grid, ...) ## Diagnostic plots based on residuals and/or fitted values { object <- x if (!inherits(form, "formula")) stop("\"form\" must be a formula") ## constructing data ## can I get away with using object@frame??? allV <- all.vars(asOneFormula(form, id, idLabels)) allV <- allV[is.na(match(allV,c("T","F","TRUE","FALSE",".obs")))] if (length(allV) > 0) { data <- getData(object) if (is.null(data)) { # try to construct data alist <- lapply(as.list(allV), as.name) names(alist) <- allV alist <- c(list(as.name("data.frame")), alist) mode(alist) <- "call" data <- eval(alist, sys.parent(1)) } else if (any(naV <- is.na(match(allV, names(data))))) stop(allV[naV], " not found in data") } else data <- NULL ## this won't do because there may well be variables we want ## that were not in the model call ## data <- object@frame ## argument list dots <- list(...) args <- if (length(dots) > 0) dots else list() ## appending object to data, and adding observation-number variable if (length(data) > 0) { data <- cbind(data, .obs = seq(nrow(data))) } data <- as.list(c(as.list(data), . = list(object))) ## covariate - must always be present covF <- getCovariateFormula(form) .x <- eval(covF[[2]], data) if (!is.numeric(.x)) { stop("Covariate must be numeric") } argForm <- ~ .x argData <- data.frame(.x = .x, check.names = FALSE) if (is.null(args$xlab)) { if (is.null(xlab <- attr(.x, "label"))) xlab <- deparse(covF[[2]]) args$xlab <- xlab } ## response - need not be present respF <- getResponseFormula(form) if (!is.null(respF)) { .y <- eval(respF[[2]], data) if (is.null(args$ylab)) { if (is.null(ylab <- attr(.y, "label"))) ylab <- deparse(respF[[2]]) args$ylab <- ylab } argForm <- .y ~ .x argData[, ".y"] <- .y } ## groups - need not be present grpsF <- getGroupsFormula(form) if (!is.null(grpsF)) { ## ?? FIXME ??? gr <- splitFormula(grpsF, sep = "*") for(i in seq_along(gr)) { auxGr <- all.vars(gr[[i]]) for(j in auxGr) argData[[j]] <- eval(as.name(j), data) } argForm <- as.formula(paste(if (length(argForm) == 2) "~ .x |" else ".y ~ .x |", deparse(grpsF[[2]]))) } ## adding to args list args <- c(list(argForm, data = argData), args) if (is.null(args$strip)) { args$strip <- function(...) strip.default(..., style = 1) } if (is.null(args$cex)) args$cex <- par("cex") if (is.null(args$adj)) args$adj <- par("adj") if (!is.null(id)) { ## identify points in plot idResType <- "pearson" ## diff from plot.lme: 'normalized' not available id <- switch(mode(id), numeric = { if (id <= 0 || id >= 1) stop(shQuote("id")," must be between 0 and 1") abs(resid(object, type = idResType))/sigma(object) > -qnorm(id / 2) }, call = eval(asOneSidedFormula(id)[[2]], data), stop(shQuote("id")," can only be a formula or numeric.") ) if (is.null(idLabels)) { idLabels <- getIDLabels(object) } else { if (inherits(idLabels,"formula")) { idLabels <- getIDLabels(object,idLabels) } else if (is.vector(idLabels)) { if (length(idLabels <- unlist(idLabels)) != length(id)) { stop("\"idLabels\" of incorrect length") } } else stop("\"idLabels\" can only be a formula or a vector") } ## DON'T subscript by id, will be done later idLabels <- as.character(idLabels) } ## defining abline, if needed if (missing(abline)) { abline <- if (missing(form)) # r ~ f c(0, 0) else NULL } #assign("id", id , where = 1) #assign("idLabels", idLabels, where = 1) #assign("abl", abline, where = 1) assign("abl", abline) ## defining the type of plot if (length(argForm) == 3) { if (is.numeric(.y)) { # xyplot plotFun <- "xyplot" if (is.null(args$panel)) { args <- c(args, panel = list(function(x, y, subscripts, ...) { x <- as.numeric(x) y <- as.numeric(y) dots <- list(...) if (grid) panel.grid() panel.xyplot(x, y, ...) if (any(ids <- id[subscripts])){ ltext(x[ids], y[ids], idLabels[subscripts][ids], cex = dots$cex, adj = dots$adj) } if (!is.null(abl)) { if (length(abl) == 2) panel.abline(a = abl, ...) else panel.abline(h = abl, ...) } })) } } else { # assume factor or character plotFun <- "bwplot" if (is.null(args$panel)) { args <- c(args, panel = list(function(x, y, ...) { if (grid) panel.grid() panel.bwplot(x, y, ...) if (!is.null(abl)) { panel.abline(v = abl[1], ...) } })) } } } else { plotFun <- "histogram" if (is.null(args$panel)) { args <- c(args, panel = list(function(x, ...) { if (grid) panel.grid() panel.histogram(x, ...) if (!is.null(abl)) { panel.abline(v = abl[1], ...) } })) } } ## defining grid if (missing(grid)) { grid <- (plotFun == "xyplot") } # assign("grid", grid, where = 1) do.call(plotFun, as.list(args)) } ## no longer defining `fortify` S3 generic ##' @rdname fortify ##' @S3method fortify lmerMod ##' @method fortify lmerMod ##' @export ##' as function, not as S3 method, see ../man/fortify.Rd : fortify.merMod <- function(model, data=getData(model), ...) { ## FIXME: get influence measures via influence.ME? ## (expensive, induces dependency ...) ## FIXME: different kinds of residuals? ## FIXME: deal with na.omit/predict etc. data$.fitted <- predict(model) data$.resid <- resid(model) data$.scresid <- resid(model,type="pearson",scaled=TRUE) data } ## autoplot??? ## plot method for plot.summary.mer ... coefplot-style ## horizontal, vertical? other options??? ## scale? plot.summary.mer <- function(object, type="fixef", ...) { if(any(!type %in% c("fixef","vcov"))) stop("'type' not yet implemented: ", type) stop("FIXME -- not yet implemented") } ## TO DO: allow faceting formula ## TO DO: allow qqline to be optional ## TO DO (harder): steal machinery from qq.gam for better GLMM Q-Q plots qqmath.merMod <- function(x, data = NULL, id=NULL, idLabels=NULL, ...) { ## klugey attempt to detect whether user forgot to specify argument ## names explicitly (after addition of required 'data' argument) ## NOT completely tested! if (!is.null(data)) { idLabels <- id id <- data warning("qqmath.merMod takes ", sQuote("data"), "as its ", "first argument for S3 method compatibility: ", "in the future, please ", "specify the ", sQuote("id"), " and ", sQuote("idLabels"), " arguments explicitly ", "i.e. ", sQuote("qqmath(fitted_model, id = ..., [idLabels = ...], ...)")) } values <- residuals(x, type="pearson", scaled=TRUE) data <- getData(x) ## DRY: copied from plot.merMod, should modularize/refactor if (!is.null(id)) { ## identify points in plot id <- switch(mode(id), numeric = { if (id <= 0 || id >= 1) stop(shQuote("id")," must be between 0 and 1") as.logical(abs(values) > -qnorm(id / 2)) }, call = eval(asOneSidedFormula(id)[[2]], data), stop(shQuote("id")," can only be a formula or numeric.") ) if (is.null(idLabels)) { idLabels <- getIDLabels(x) } else { if (inherits(idLabels,"formula")) { idLabels <- getIDLabels(x,idLabels) } else if (is.vector(idLabels)) { if (length(idLabels <- unlist(idLabels)) != length(id)) { stop("\"idLabels\" of incorrect length") } } else stop("\"idLabels\" can only be a formula or a vector") } idLabels <- as.character(idLabels) } ## DON'T subscript by id, will be done later qqpanel <- function(x, subscripts, ...) { dots <- list(...) panel.qqmathline(x, ...) panel.qqmath(x, ...) if (any(ids <- id[subscripts])) { xs <- x[subscripts] pp <- setNames(ppoints(length(xs)), names(sort(xs))) ## want to plot qnorm(pp) vs sort(x) ## ... but want to pick out the elements that corresponded ## to ids **before** sorting xx <- qnorm(pp)[names(xs)[ids]] yy <- sort(x)[names(xs)][ids] ## quantile(values, pp)[ids] ltext(xx, yy, idLabels[ids], cex = dots$cex, adj = dots$adj) } } qqmath(values, xlab = "Standard normal quantiles", ylab = "Standardized residuals", prepanel = prepanel.qqmathline, panel = qqpanel, ...) } ## qqmath(~residuals(gm1)|cbpp$herd) lme4/R/profile.R0000644000176200001440000015234215225703727013120 0ustar liggesusersprofnames <- function(object, signames=TRUE, useSc=isLMM(object), prefix=c("sd","cor")) { res <- if (signames) { sprintf(".sig%02d", seq_len(getParLength(object))) } else { vv <- getVCNames(object, prf=prefix, old=FALSE) ## result is stored as {vcomp, ccomp}; 'zip' it unlist(Map(c, vv$vcomp, vv$ccomp)) } if (useSc) { sdname <- if (signames) ".sigma" else "sigma" res <- c(res, sdname) } res } ##' @importFrom splines backSpline interpSpline periodicSpline ##' @importFrom stats profile ##' @method profile merMod ##' @export profile.merMod <- function(fitted, which=NULL, alphamax = 0.01, maxpts = 100, delta = NULL, delta.cutoff = 1/8, verbose=0, devtol=1e-9, devmatchtol=1e-5, maxmult = 10, startmethod = "prev", optimizer = NULL, control = NULL, signames = TRUE, parallel = c("no", "multicore", "snow", "future"), ncpus = getOption("profile.ncpus", 1L), cl = NULL, prof.scale = c("sdcor","varcov"), ...) { ## FIXME: allow choice of nextstep/nextstart algorithm? ## FIXME: allow selection of individual variables to profile by name? ## FIXME: allow for failure of bounds (non-pos-definite correlation matrices) when >1 cor parameter prof.scale <- match.arg(prof.scale) parallel <- match.arg(parallel) # (parallel, ncpus, cl) -> (parallel) eval(initialize.parallel) if (is.null(optimizer)) optimizer <- fitted@optinfo$optimizer ## hack: doesn't work to set bobyqa parameters to *ending* values stored ## in @optinfo$control ignore.pars <- c("xst", "xt") ## The control stored in @optinfo$control is specific to the optimizer used ## for the original fit. Reusing it with a *different* optimizer can pass ## arguments the new optimizer rejects (e.g. nloptwrap's 'print_level' handed ## to bobyqa), producing spurious "unused control arguments ignored" warnings ## (GH #913). Only carry it over when the optimizer is unchanged. control.internal <- if (identical(optimizer, fitted@optinfo$optimizer)) fitted@optinfo$control else list() if (length(ign <- which(names(control.internal) %in% ignore.pars)) > 0) control.internal <- control.internal[-ign] if (!is.null(control)) { for (i in names(control)) control.internal[[i]] <- control[[i]] } control <- control.internal useSc <- isLMM(fitted) || isNLMM(fitted) prof.prefix <- switch(prof.scale, "sdcor" = c("sd", "cor"), "varcov" = c("var", "cov"), stop("internal error, prof.scale=", prof.scale)) dd <- devfun2(fitted, useSc=useSc, signames=signames, prefix=prof.prefix, scale = prof.scale, ...) ## FIXME: figure out to what do here ... if (isGLMM(fitted) && fitted@devcomp$dims[["useSc"]]) stop("can't (yet) profile GLMMs with non-fixed scale parameters") stopifnot(devtol >= 0) base <- attr(dd, "basedev") ## protect against accidental tampering by later devfun calls paropt <- forceCopy(attr(dd, "paropt")) stderr <- attr(dd, "stderr") pp <- environment(dd)$pp X.orig <- pp$X n <- environment(dd)$n p <- length(pp$beta0) opt <- attr(dd, "optimum") nptot <- length(opt) nvp <- nptot - p # number of variance-covariance pars wi.vp <- seq_len(nvp) if(nvp > 0) fe.orig <- opt[- wi.vp] which <- get.which(which, nvp, nptot, names(opt), verbose) res <- c(.zeta = 0, opt) res <- matrix(res, nrow = maxpts, ncol = length(res), dimnames = list(NULL, names(res)), byrow = TRUE) ## FIXME: why is cutoff based on nptot ## (i.e. boundary of simultaneous LRT conf region for nptot values) ## when we are computing (at most) 2-parameter profiles here? cutoff <- sqrt(qchisq(1 - alphamax, nptot)) if (is.null(delta)) delta <- cutoff*delta.cutoff ## helper functions ## nextpar calculates the next value of the parameter being ## profiled based on the desired step in the profile zeta ## (absstep) and the values of zeta and column cc for rows ## r-1 and r. The parameter may not be below lower (or above upper) nextpar <- function(mat, cc, r, absstep, lower = -Inf, upper = Inf, minstep=1e-6) { rows <- r - (1:0) # previous two row numbers pvals <- mat[rows, cc] zeta <- mat[rows, ".zeta"] num <- diff(pvals) if (is.na(denom <- diff(zeta)) || denom==0) { warning("Last two rows have identical or NA .zeta values: using minstep") step <- minstep } else { step <- absstep*num/denom if (step<0) { warning("unexpected decrease in profile: using minstep") step <- minstep } else { if (r>1) { if (abs(step) > (maxstep <- abs(maxmult*num))) { maxstep <- sign(step)*maxstep if (verbose) cat(sprintf("capped step at %1.2f (multiplier=%1.2f > %1.2f)\n", maxstep,abs(step/num),maxmult)) step <- maxstep } } } } min(upper, max(lower, pvals[2] + sign(num) * step)) } nextstart <- function(mat, pind, r, method) { ## FIXME: indexing may need to be checked (e.g. for fixed-effect parameters) switch(method, global= opt[seqpar1][-pind], ## address opt, no zeta column prev = mat[r,1+seqpar1][-pind], extrap = stop("not yet implemented"),## do something with mat[r-(1:0),1+seqnvp])[-pind] stop("invalid nextstart method")) } ## mkpar generates the parameter vector of theta and ## sigma from the values being profiled in position w mkpar <- function(np, w, pw, pmw) { par <- numeric(np) par[w] <- pw par[-w] <- pmw par } ## fillmat fills the third and subsequent rows of the matrix ## using nextpar and zeta ## FIXME: add code to evaluate more rows near the minimum if that ## constraint was active. fillmat <- function(mat, lowcut, upcut, zetafun, cc) { nr <- nrow(mat) i <- 2L ## REF: is.na(curzeta) behaviour last modified in commit b1a28914e72be845e while (i < nr && !is.na(mat[i, cc]) && mat[i, cc] > lowcut && mat[i, cc] < upcut && (i > 1 && !is.na(curzeta <- abs(mat[i, ".zeta"]))) && curzeta <= cutoff) { np <- nextpar(mat, cc, i, delta, lowcut, upcut) ns <- nextstart(mat, pind = cc-1, r=i, method=startmethod) mat[i + 1L, ] <- zetafun(np,ns) if (verbose>0) { cat(i,cc,mat[i+1L,],"\n") } i <- i + 1L } if (mat[i-1,cc]==lowcut) { ## fill in more values near the minimum } if (mat[i-1,cc]==upcut) { ## fill in more values near the maximum } mat <- mat[!is.na(mat[,".zeta"]),] mat } ## bounds on Cholesky (== fitted@lower): [0,Inf) for diag, (-Inf,Inf) for off-diag ## bounds on sd-corr: [0,Inf) for diag, (-1.0,1.0) for off-diag ## bounds on var-corr: [0,Inf) for diag, (-Inf,Inf) for off-diag covs <- getReCovs(fitted) lower <- unlist(lapply(covs, getProfLower, prof.scale)) upper <- unlist(lapply(covs, getProfUpper, prof.scale)) if (useSc) { # bounds for sigma lower <- c(lower,0) upper <- c(upper,Inf) } ## bounds on fixed parameters (TODO: allow user-specified bounds, e.g. for NLMMs) lower <- c(lower,rep.int(-Inf, p)) upper <- c(upper, rep.int(Inf, p)) npar1 <- if (isLMM(fitted)) nvp else nptot ## check that devfun2() computation for the base parameters is (approx.) the ## same as the original devfun() computation basecheck <- all.equal(unname(dd(opt[seq(npar1)])), base, tolerance=devmatchtol) if(!isTRUE(basecheck)) { basediff <- abs(dd(opt[seq(npar1)])/base - 1) stop(sprintf(paste0("Profiling over both the residual variance and\n", "fixed effects is not numerically consistent with\n", "profiling over the fixed effects only (relative difference: %1.4g);\n", "consider adjusting devmatchtol"), basediff)) } ## sequence of variance parameters to profile seqnvp <- intersect(seq_len(npar1), which) ## sequence of 'all' parameters seqpar1 <- seq_len(npar1) lowvp <- lower[seqpar1] upvp <- upper[seqpar1] form <- .zeta ~ foo # pattern for interpSpline formula ## as in bootMer.R, define FUN as a ## closure containing the referenced variables ## in its scope to avoid explicit clusterExport statement ## in the PSOCKcluster case FUN <- local({ function(w) { if (verbose) cat(if(isLMM(fitted)) "var-cov " else "", "parameter ",w,":\n",sep="") wp1 <- w + 1L pw <- opt[w] lowcut <- lower[w] upcut <- upper[w] zeta <- function(xx,start) { ores <- tryCatch(optwrap(optimizer, par=start, fn=function(x) dd(mkpar(npar1, w, xx, x)), lower = lowvp[-w], upper = upvp [-w], control = control), error=function(e) NULL) if (is.null(ores)) { devdiff <- NA pars <- NA } else { devdiff <- ores$fval - base pars <- ores$par } if (is.na(devdiff)) { warning("NAs detected in profiling") ## optimizer failed; return an all-NA row so fillmat can skip it return(rep(NA_real_, ncol(res))) } else { if(verbose && devdiff < 0) cat("old deviance ",base,",\n", "new deviance ",ores$fval,",\n", "new params ", paste(mkpar(npar1,w,xx,ores$par), collapse=","),"\n") if (devdiff < (-devtol)) stop("profiling detected new, lower deviance ", sprintf("(deviance diff = %1.3g, tolerance = %1.3g)", abs(devdiff), devtol)) if(devdiff < 0) warning(gettextf("slightly lower deviances (diff=%g) detected", devdiff), domain=NA) if (devdiff <= 0) devdiff <- devtol } zz <- sign(xx - pw) * sqrt(devdiff) r <- c(zz, mkpar(npar1, w, xx, pars)) if (isLMM(fitted)) c(r, pp$beta(1)) else r }## {zeta} ## intermediate storage for pos. and neg. increments pres <- nres <- res ## assign one row, determined by inc. sign, from a small shift ## FIXME:: do something if pw==0 ??? shiftpar <- if (pw==0) 1e-3 else pw*1.01 ## Since both the pos- and neg-increment matrices are already ## filled with the opt. par. results, this sets the first ## two rows of the positive-increment matrix ## to (opt. par, shiftpar) and the first two rows of ## the negative-increment matrix to (shiftpar, opt. par), ## which sets up two points going in the right direction ## for each matrix (since the profiling algorithm uses increments ## between rows to choose the next parameter increment) nres[1, ] <- pres[2, ] <- zeta(shiftpar, start=opt[seqpar1][-w]) ## fill in the rest of the arrays and collapse them upperf <- fillmat(pres, lowcut, upcut, zeta, wp1) lowerf <- if (pw > lowcut) fillmat(nres, lowcut, upcut, zeta, wp1) else ## don't bother to fill in 'nres' matrix nres ## this will throw away the extra 'opt. par' and 'shiftpar' ## rows introduced above: bres <- as.data.frame(unique(rbind2(upperf,lowerf))) pname <- names(opt)[w] bres$.par <- pname bres <- bres[order(bres[, wp1]), ] ## FIXME: test for bad things here?? form[[3]] <- as.name(pname) forspl <- NULL # (in case of error) ## bakspl bakspl <- tryCatch(backSpline( forspl <- interpSpline(form, bres, na.action=na.omit)), error=function(e)e) if (inherits(bakspl, "error")) warning("non-monotonic profile for ",pname) ## return: namedList(bres,bakspl,forspl) # namedList() -> lmerControl.R }}) ## FUN() ## copied from bootMer: DRY! L <- if (parallel == "multicore") { parallel::mclapply(seqnvp, FUN, mc.cores = ncpus) } else if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makeCluster(ncpus) on.exit(parallel::stopCluster(cl)) ## explicit export of the lme4 namespace since most FUNs will probably ## use some of them parallel::clusterExport(cl, varlist=getNamespaceExports("lme4")) if(RNGkind()[1L] == "L'Ecuyer-CMRG") parallel::clusterSetRNGStream(cl) } parallel::parLapply(cl, seqnvp, FUN) } else if(parallel == "future") { future.apply::future_lapply(seqnvp, FUN, future.seed = TRUE, future.packages = "lme4") } else lapply(seqnvp, FUN) nn <- names(opt[seqnvp]) ans <- setNames(lapply(L, `[[`, "bres"), nn) bakspl <- setNames(lapply(L, `[[`,"bakspl"), nn) forspl <- setNames(lapply(L, `[[`,"forspl"), nn) ## profile fixed effects separately (for LMMs) if (isLMM(fitted)) { reCovs <- getReCovs(fitted) mkPar <- mkMkPar(reCovs) mkTheta <- mkMkTheta(reCovs) offset.orig <- fitted@resp$offset fp <- seq_len(p) fp <- fp[(fp+nvp) %in% which] ## FIXME: parallelize this too ... for (j in fp) { if (verbose) cat("fixed-effect parameter ",j,":\n",sep="") pres <- # intermediate results for pos. incr. nres <- res # and negative increments est <- opt[nvp + j] std <- stderr[j] Xw <- X.orig[, j, drop=TRUE] Xdrop <- .modelMatrixDrop(X.orig, j) pp1 <- new(class(pp), X = Xdrop, Zt = pp$Zt, Lambdat = pp$Lambdat, Lind = pp$Lind, theta = pp$theta, n = nrow(Xdrop)) ### FIXME Change this to use the deep copy and setWeights, setOffset, etc. rr <- new(Class=class(fitted@resp), y=fitted@resp$y) rr$setWeights(fitted@resp$weights) fe.zeta <- function(fw, start) { ## (start parameter ignored) rr$setOffset(Xw * fw + offset.orig) rho <- list2env(list(pp=pp1, resp=rr, mkPar=mkPar, mkTheta=mkTheta), parent = parent.frame()) ## optimization on `par` scale (not `theta`) ores <- optwrap(optimizer, par = paropt, fn = mkdevfun(rho, 0L), ## FIXME: do we need to extend this for GLMMs? lower = fitted@lower) ## this optimization is done on the ORIGINAL ## `par` scale (i.e. not the sigma/corr scale) fv <- ores$fval sig <- sqrt((rr$wrss() + pp1$sqrL(1))/n) ## translate from ores$par (`par` scale) back to `profPar` scale ppars <- convParToProfPar(ores$par, fitted, profscale = prof.scale, sc = sig) c(sign(fw - est) * sqrt(fv - base), ppars, mkpar(p, j, fw, pp1$beta(1))) } nres[1, ] <- pres[2, ] <- fe.zeta(est + delta * std) poff <- nvp + 1L + j ## Workaround R bug [rbind2() is S4 generic; cannot catch warnings in its arg] ## see lme4 GH issue #304 upperf <- fillmat(pres, -Inf, Inf, fe.zeta, poff) lowerf <- fillmat(nres, -Inf, Inf, fe.zeta, poff) bres <- as.data.frame(unique(rbind2(upperf, lowerf))) bres$.par <- n.j <- names(fe.orig)[j] ans[[n.j]] <- bres[order(bres[, poff]), ] form[[3]] <- as.name(n.j) bakspl[[n.j]] <- tryCatch(backSpline(forspl[[n.j]] <- interpSpline(form, bres)), error=function(e)e) if (inherits(bakspl[[n.j]], "error")) warning("non-monotonic profile for ", n.j) } ## for(j in 1..p) } ## if isLMM ans <- do.call(rbind, ans) row.names(ans) <- NULL ## TODO: rbind(*, make.row.names=FALSE) ans$.par <- factor(ans$.par) structure(ans, forward = forspl, backward = bakspl, lower = lower[seqnvp], upper = upper[seqnvp], class = c("thpr", "data.frame"))# 'thpr': see ../man/profile-methods.Rd } ## profile.merMod ##' Transform 'which' \in {parnames | integer | "beta_" | "theta_"} ##' into integer indices ##' @param which numeric or character vector ##' @param nvp number of variance-covariance parameters ##' @param nptot total number of parameters ##' @param parnames vector of parameter names ##' @param verbose print messages? ##' @examples ##' fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) ##' tn <- names(getME(fm1,"theta")) ##' nn <- c(tn,names(fixef(fm1))) ##' get.which("theta_",length(tn),length(nn),nn, verbose=TRUE) ##' get.which <- function(which, nvp, nptot, parnames, verbose=FALSE) { if (is.null(which)) seq_len(nptot) else if (is.character(which)) { wi <- integer(); wh <- which if(any(j <- wh == "theta_")) { wi <- seq_len(nvp); wh <- wh[!j] } if(any(j <- wh == "beta_") && nptot > nvp) { wi <- c(wi, seq(nvp+1, nptot)); wh <- wh[!j] } if(any(j <- parnames %in% wh)) { ## which containing param.names wi <- sort(unique(c(wi, seq_len(nptot)[j]))) } if(verbose) message(gettextf("From original which = %s: new which <- %s", deparse(which, nlines=1), deparse(wi, nlines=1)), domain=NA) if(length(wi) == 0) warning(gettextf("Nothing selected by 'which=%s'", deparse(which)), domain=NA) wi } else # stopifnot( .. numeric ..) which } ## This is a hack. The preferred approach is to write a ## subset method for the ddenseModelMatrix and dsparseModelMatrix ## classes .modelMatrixDrop <- function(mm, w) { if (isS4(mm)) { nX <- slotNames(X <- mm[, -w, drop = FALSE]) do.call(new, c(list(Class = class(mm), assign = attr(mm,"assign")[-w], contrasts = NULL ## FIXME: where did the contrasts information go?? ## mm@contrasts ), lapply(setNames(nX, nX), function(nm) slot(X, nm)))) } else { structure(mm[, -w, drop=FALSE], assign = attr(mm, "assign")[-w]) } } ## The deviance is profiled with respect to the fixed-effects ## parameters but not with respect to sigma. The other parameters ## are on the standard deviation scale, not the theta scale. ## ## @title Return a function for evaluation of the deviance. ## @param fm a fitted model of class merMod ## @param useSc (logical) whether a scale parameter is used ## @param \dots arguments passed to profnames (\code{signames=TRUE} ## to use old-style .sigxx names, FALSE uses (sd_cor|xx); ## also \code{prefix=c("sd","cor")}) ## @return a function for evaluating the deviance in the extended ## parameterization. This is profiled with respect to the ## variance-covariance parameters (fixed-effects done separately). devfun2 <- function(fm, useSc = if(isLMM(fm)) TRUE else NA, scale = c("sdcor", "varcov"), ...) { scale <- match.arg(scale) if (scale == "varcov" && anyStructured(fm)) stop("haven't thought about varcov scale for structured cov matrices") ## TODO: change to work with 'par' instead of 'theta' ## FIXME: have to distinguish between ## 'useSc' (GLMM: report profiled scale parameter) and ## 'useSc' (NLMM/LMM: scale theta by sigma) ## hasSc := GLMMuseSc <- fm@devcomp$dims[["useSc"]] stopifnot(is(fm, "merMod")) fm <- refitML(fm) mkTheta <- mkMkTheta(getReCovs(fm)) basedev <- -2*c(logLik(fm)) ## no longer deviance() vlist <- lengths(fm@cnms) ## "has scale" := isLMM or GLMM with scale parameter hasSc <- as.logical(fm@devcomp$dims[["useSc"]]) stdErr <- unname(coef(summary(fm))[,2]) pp <- fm@pp$copy() sig <- if (useSc) sigma(fm) else NULL opt <- getProfPar(fm, profscale = scale, sc = sig) names(opt) <- profnames(fm, useSc=useSc, ...) opt <- c(opt, fixef(fm)) resp <- fm@resp$copy() np <- length(pp$theta) nf <- length(fixef(fm)) if(hasSc) np <- np + 1L # was if(!isGLMM(fm)) np <- np + 1L n <- nrow(pp$V) # use V, not X so it works with nlmer if (isLMM(fm)) { # ==> hasSc ans <- function(pars) { pp <- fm@pp$copy() ## fresh copy of predictor object ## convert 'profPar' -> 'pars' sig <- pars[length(pars)] thpars <- try( convProfParToPar(pars, fm, profscale = scale, sc = sig), silent = TRUE) if (inherits(thpars, "try-error")) return(NA) .Call(lmer_Deviance, pp$ptr(), resp$ptr(), mkTheta(thpars)) sigsq <- if (scale=="varcov") sig else sig^2 pp$ldL2() - ldW + (resp$wrss() + pp$sqrL(1))/sigsq + n * log(2 * pi * sigsq) } ldW <- sum(log(environment(ans)$resp$weights)) assign("ldW", ldW, envir = environment(ans)) } else { # GLMM *and* NLMMs d0 <- getME(fm, "devfun") ## from glmer: ## rho <- new.env(parent=parent.env(environment())) ## rho$pp <- do.call(merPredD$new, c(reTrms[c("Zt","theta","Lambdat","Lind")], n=nrow(X), list(X=X))) ## rho$resp <- mkRespMod(fr, if(REML) p else 0L) ans <- function(pars) { stopifnot(is.numeric(pars), length(pars) == np+nf) thpars <- try( convProfParToPar(pars, fm, profscale = scale, sc = NULL), silent = TRUE) if (inherits(thpars, "try-error")) return(NA) fixpars <- pars[-seq(np)] d0(c(thpars, fixpars)) } } attr(ans, "optimum") <- opt # w/ names() attr(ans, "basedev") <- basedev ## FIXME: should make this GLMM-aware attr(ans, "paropt") <- getPar(fm) attr(ans, "stderr") <- stdErr class(ans) <- "devfun" ans } ## extract only the y component from a prediction predy <- function(sp, vv) { if (inherits(sp, "error") || is.null(sp)) return(rep(NA_real_, length(vv))) predict(sp, vv)$y } stripExpr <- function(ll, nms) { stopifnot(is.list(ll), is.character(nms)) fLevs <- as.expression(nms) # variable names; now replacing log(sigma[.]) etc: fLevs[nms == ".sigma"] <- expression(sigma) fLevs[nms == ".lsigma"] <- expression(log(sigma)) fLevs[nms == ".sigmasq"] <- expression(sigma^2) sigNms <- grep("^\\.sig[0-9]+", nms) lsigNms <- grep("^\\.lsig[0-9]+", nms) sig2Nms <- grep("^\\.sigsq[0-9]+", nms) ## the in ".sig0" and then in ".lsig0": sigsub <- as.integer(substring(nms[ sigNms], 5)) lsigsub <- as.integer(substring(nms[lsigNms], 6)) sig2sub <- as.integer(substring(nms[sig2Nms], 7)) fLevs[ sigNms] <- lapply( sigsub, function(i) bquote( sigma[.(i)])) fLevs[lsigNms] <- lapply(lsigsub, function(i) bquote(log(sigma[.(i)]))) fLevs[sig2Nms] <- lapply(sig2sub, function(i) bquote( {sigma[.(i)]}^2)) ## result of using { .. }^2 is easier to understand == == levsExpr <- substitute(strip.custom(factor.levels=foo), list(foo=fLevs)) snames <- c("strip", "strip.left") if(!any(.in <- snames %in% names(ll))) { ll$strip <- levsExpr } else { for(nm in snames[.in]) if(is.logical(v <- ll[[nm]]) && v) ll[[nm]] <- levsExpr } ll } panel.thpr <- function(x, y, spl, absVal, ...) { panel.grid(h = -1, v = -1) myspl <- spl[[panel.number()]] lsegments(x, y, x, 0, ...) if (absVal) { y[y == 0] <- NA lsegments(x, y, rev(x), y) } else { panel.abline(h = 0, ...) } if (!is(myspl,"spline")) { ## 'difficult' data if (absVal) myspl$y <- abs(myspl$y) panel.lines (myspl$x, myspl$y) panel.points(myspl$x, myspl$y, pch="+") warning(gettextf("bad profile for variable %d: using linear interpolation", panel.number()), domain=NA) } else { lims <- current.panel.limits()$xlim krange <- range(myspl$knots) pr <- predict(myspl, seq(max(lims[1], krange[1]), min(lims[2], krange[2]), len = 101)) if (absVal) pr$y <- abs(pr$y) panel.lines(pr$x, pr$y) } } ## A lattice-based plot method for profile objects ##' @importFrom lattice xyplot ##' @S3method xyplot thpr xyplot.thpr <- function (x, data = NULL, levels = sqrt(qchisq(pmax.int(0, pmin.int(1, conf)), df = 1)), conf = c(50, 80, 90, 95, 99)/100, absVal = FALSE, scales = NULL, which = 1:nptot, ...) { if(any(!is.finite(conf) | conf <= 0 | conf >= 1)) stop("values of 'conf' must be strictly between 0 and 1") stopifnot(1 <= (nptot <- length(nms <- levels(x[[".par"]])))) ## FIXME: is this sufficiently reliable? ## (include "sigma" in 'theta' parameters) nvp <- length(grep("^(\\.sig[0-9]+|.sigma|sd_|cor_)", nms)) which <- get.which(which, nvp, nptot, nms) levels <- sort(levels[is.finite(levels) & levels > 0]) spl <- attr(x, "forward") [which] bspl <- attr(x, "backward")[which] ## for parameters for which spline couldn't be computed, ## replace the 'spl' element with the raw profile data if(any(badSpl <- vapply(spl, is.null, NA))) { spl[badSpl] <- lapply(which(badSpl), function(i) { n <- names(badSpl)[i] r <- x[x[[".par"]] == n, ] data.frame(y = r[[".zeta"]], x = r[[n]]) }) bspl[badSpl] <- lapply(spl[badSpl], function(d) data.frame(x=d$y,y=d$x)) ## FIXME: more efficient, not yet ok ? ## ibad <- which(badSpl) ## spl[ibad] <- lapply(names(ibad), function(n) { ## r <- x[x[[".par"]]==n,] ## data.frame(y = r[[".zeta"]], x = r[[n]]) ## }) ## bspl[ibad] <- lapply(spl[ibad], function(d) data.frame(x=d$y,y=d$x)) } zeta <- c(-rev(levels), 0, levels) mypred <- function(bs, zeta) { ## use linear approximation if backspline doesn't work if (inherits(bs,"spline")) predy(bs, zeta) else if(is.numeric(x <- bs$x) && is.numeric(y <- bs$y) && length(x) == length(y)) approx(x, y, xout = zeta)$y else rep_len(NA_real_, length(zeta)) } fr <- data.frame(zeta = rep.int(zeta, length(spl)), pval = unlist(lapply(bspl, mypred, zeta)), pnm = gl(length(spl), length(zeta), labels = names(spl))) if (length(ind <- which(is.na(fr$pval)))) { fr[ind, "zeta"] <- 0 for (i in ind) ### FIXME: Should check which bound has been violated, although it ### will almost always be the minimum. if (inherits(curspl <- spl[[fr[i, "pnm"] ]], "spline")) { fr[i, "pval"] <- min(curspl$knots) } } ylab <- if (absVal) { fr$zeta <- abs(fr$zeta) expression("|" * zeta * "|") } else expression(zeta) intscales <- list(x = list(relation = 'free')) ## FIXME: is there something less clunky we can do here ## that allows for all possible user inputs ## (may want to (1) override x$relation (2) add elements to $x ## (3) add elements to scales) if (!is.null(scales)) { if (!is.null(scales[["x"]])) { if (!is.null(scales[["x"]]$relation)) { intscales[["x"]]$relation <- scales[["x"]]$relation scales[["x"]]$relation <- NULL } intscales[["x"]] <- c(intscales[["x"]],scales[["x"]]) scales[["x"]] <- NULL } intscales <- c(intscales,scales) } ll <- c(list(...), list(x = zeta ~ pval | pnm, data=fr, scales = intscales, ylab = ylab, xlab = NULL, panel=panel.thpr, spl = spl, absVal = absVal)) do.call(xyplot, stripExpr(ll, names(spl))) } ## copy of stats:::format.perc (not exported, and ":::" being forbidden nowadays): format.perc <- function (x, digits, ...) { paste(format(100 * x, trim = TRUE, scientific = FALSE, digits = digits), "%") } ##' confint() method for our profile() results 'thpr' ##' @importFrom stats confint confint.thpr <- function(object, parm, level = 0.95, zeta, ## tolerance for non-monotonic profiles ## (raw values, not splines) non.mono.tol=1e-2, ...) { bak <- attr(object, "backward") ## fallback strategy for old profiles that don't have a lower/upper ## attribute saved ... if (is.null(lower <- attr(object,"lower"))) lower <- rep(NA_real_,length(parm)) if (is.null(upper <- attr(object,"upper"))) upper <- rep(NA_real_,length(parm)) ## FIXME: work a little harder to add -Inf/Inf for fixed effect ## parameters? (Should only matter for really messed-up profiles) bnms <- names(bak) parm <- if (missing(parm)) bnms else if(is.numeric(parm)) # e.g., when called from confint.merMod() bnms[parm] else if (length(parm <- as.character(parm)) == 1) { if (parm == "theta_") grep("^(sd_|cor_|.sig|sigma$)", bnms, value=TRUE) else if (parm == "beta_") grep("^(sd_|cor_|.sig|sigma$)", bnms, value=TRUE, invert=TRUE) else if(parm %in% bnms) # just that one parm ## else NULL : will return 0-row matrix } else intersect(parm, bnms) cn <- if (missing(zeta)) { a <- (1 - level)/2 a <- c(a, 1 - a) zeta <- qnorm(a) format.perc(a, 3) } ## else NULL ci <- matrix(NA_real_, nrow=length(parm), ncol=2L, dimnames = list(parm,cn)) for (i in seq_along(parm)) { ## would like to build this machinery into predy, but ## predy is used in many places and it's much harder to ## tell in general whether an NA indicates a lower or an ## upper bound ... badprof <- FALSE p <- rep(NA_real_,2) if (!inherits(b <- bak[[parm[i]]], "error")) { p <- predy(b, zeta) } else { obj1 <- object[object$.par==parm[[i]],c(parm[[i]],".zeta")] if (all(is.na(obj1[,2]))) { badprof <- TRUE warning("bad profile for ",parm[i]) } else if (min(diff(obj1[,2])<(-non.mono.tol),na.rm=TRUE)) { badprof <- TRUE warning("non-monotonic profile for ",parm[i]) } else { warning("bad spline fit for ",parm[i],": falling back to linear interpolation") p <- approxfun(obj1[,2],obj1[,1])(zeta) } } if (!badprof) { if (is.na(p[1])) p[1] <- lower[i] if (is.na(p[2])) p[2] <- upper[i] } ci[i,] <- p } ci } ## FIXME: make bootMer more robust; make profiling more robust; ## more warnings; documentation ... ##' Compute confidence intervals on the parameters of an lme4 fit ##' @param object a fitted [ng]lmer model ##' @param parm parameters (specified by integer position) ##' @param level confidence level ##' @param method for computing confidence intervals ##' @param zeta likelihood cutoff ##' (if not specified, computed from \code{level}: "profile" only) ##' @param nsim number of simulations for parametric bootstrap intervals ##' @param boot.type bootstrap confidence interval type ##' @param quiet (logical) suppress messages about computationally intensive profiling? ##' @param signames (logical) use old-style names for \code{method="profile"}? (See \code{signames} argument to \code{\link{profile}} ##' @param oldNames (logical) deprecated; has the same purpose as the \code{signames} argument. ##' @param \dots additional parameters to be passed to \code{\link{profile.merMod}} or \code{\link{bootMer}} ##' @return a numeric table of confidence intervals confint.merMod <- function(object, parm, level = 0.95, method = c("profile", "Wald", "boot"), zeta, nsim=500, boot.type = c("perc", "basic", "norm"), FUN = NULL, quiet=FALSE, oldNames, signames = TRUE, boot.scale = c("sdcor", "vcov"), ...) { method <- tolower(match.arg(method)) boot.type <- match.arg(boot.type) boot.scale <- match.arg(boot.scale) if (!missing(oldNames)) { warning("'oldNames' is deprecated. Please use 'signames' instead.", call. = FALSE) signames <- oldNames } ## 'parm' corresponds to 'which' in other contexts if (method=="boot" && !is.null(FUN)) { ## custom boot function, don't expand parameter names } else { ## "use scale" = GLMM with scale parameter *or* LMM .. useSc <- as.logical(object@devcomp$dims[["useSc"]]) vn <- profnames(object, signames, useSc=useSc) an <- c(vn, names(fixef(object))) parm <- if(missing(parm)) seq_along(an) else get.which(parm, nvp=length(vn), nptot=length(an), parnames=an) if (!quiet && method %in% c("profile","boot")) { mtype <- switch(method, profile="profile", boot="bootstrap") message("Computing ",mtype," confidence intervals ...") flush.console() } } switch(method, "profile" = { pp <- profile(object, which=parm, signames=signames, ...) ## confint.thpr() with missing(parm) using all names: confint(pp, level=level, zeta=zeta) }, "wald" = { a <- (1 - level)/2 a <- c(a, 1 - a) ci.vcov <- array(NA_real_,dim = c(length(vn), 2L), dimnames = list(vn, format.perc(a,3))) ## copied with small changes from confint.default cf <- fixef(object) ## coef() -> fixef() pnames <- names(cf) ## N.B. can't use sqrt(...)[parm] (diag() loses names) ses <- sqrt(diag(vcov(object))) ci.fixed <- array(cf + ses %o% qnorm(a), dim = c(length(pnames), 2L), dimnames = list(pnames, format.perc(a, 3))) ci.all <- rbind(ci.vcov,ci.fixed) ci.all[parm,,drop=FALSE] }, "boot" = { bootFun <- function(x) { ## need to get profile-scale pars from fitted model useSc <- !(isGLMM(x) && hasNoScale(family(x))) sc <- if (useSc) sigma(x) else NULL ss <- convParToProfPar(x@optinfo$val, x, profscale = boot.scale, sc = sc) c(setNames(ss, vn), fixef(x)) } if (is.null(FUN)) FUN <- bootFun bb <- bootMer(object, FUN=FUN, nsim=nsim,...) if (all(is.na(bb$t))) stop("*all* bootstrap runs failed!") print.bootWarnings(bb, verbose=FALSE) citab <- confint(bb,level=level,type=boot.type) if (missing(parm)) { ## only happens if we have custom boot method if (is.null(parm <- rownames(citab))) { parm <- seq(nrow(citab)) } } citab[parm, , drop=FALSE] }, ## should never get here ... stop("unknown confidence interval method")) } ##' Convert x-cosine and y-cosine to average and difference. ##' ##' Convert the x-cosine and the y-cosine to an average and difference ##' ensuring that the difference is positive by flipping signs if ##' necessary ##' @param xc x-cosine ##' @param yc y-cosine ad <- function(xc, yc) { a <- (xc + yc)/2 d <- (xc - yc) cbind(sign(d)* a, abs(d)) } ##' convert d versus a (as an xyVector) and level to a matrix of taui and tauj ##' @param xy an xyVector ##' @param lev the level of the contour tauij <- function(xy, lev) lev * cos(xy$x + outer(xy$y/2, c(-1, 1))) ##' @title safe arc-cosine ##' @param x numeric vector argument ##' @return acos(x) being careful of boundary conditions sacos <- function(x) acos(pmax.int(-0.999, pmin.int(0.999, x))) ##' Generate a contour ##' ##' @title Generate a contour ##' @param sij the arc-cosines of i on j ##' @param sji the arc-cosines of j on i ##' @param levels numeric vector of levels at which to interpolate ##' @param nseg number of segments in the interpolated contour ##' @return a list with components ##' \item{tki}{the tau-scale predictions of i on j at the contour levels} ##' \item{tkj}{the tau-scale predictions of j on i at the contour levels} ##' \item{pts}{an array of dimension (length(levels), nseg, 2) containing the points on the contours} cont <- function(sij, sji, levels, nseg = 101) { ada <- array(0, c(length(levels), 2L, 4L)) ada[, , 1] <- ad(0, sacos(predy(sij, levels)/levels)) ada[, , 2] <- ad( sacos(predy(sji, levels)/levels), 0) ada[, , 3] <- ad(pi, sacos(predy(sij, -levels)/levels)) ada[, , 4] <- ad(sacos(predy(sji, -levels)/levels), pi) pts <- array(0, c(length(levels), nseg + 1, 2)) for (i in seq_along(levels)) pts[i, ,] <- tauij(predict(periodicSpline(ada[i, 1, ], ada[i, 2, ]), nseg = nseg), levels[i]) levs <- c(-rev(levels), 0, levels) list(tki = predict(sij, levs), tkj = predict(sji, levs), pts = pts) } ## copied from lattice:::chooseFace chooseFace <- function (fontface = NULL, font = 1) { if (is.null(fontface)) font else fontface } ##' Draws profile pairs plots. Contours are for the marginal ##' two-dimensional regions (i.e. using df = 2). ##' ##' @title Profile pairs plot ##' @param x the result of \code{\link{profile}} (or very similar structure) ##' @param data unused - only for compatibility with generic ##' @param levels the contour levels to be shown; usually derived from \code{conf} ##' @param conf numeric vector of confidence levels to be shown as contours ##' @param ... further arguments passed to \code{\link{splom}} ##' @importFrom grid gpar viewport ##' @importFrom lattice splom ##' @method splom thpr ##' @export splom.thpr <- function (x, data, levels = sqrt(qchisq(pmax.int(0, pmin.int(1, conf)), 2)), conf = c(50, 80, 90, 95, 99)/100, which = 1:nptot, draw.lower = TRUE, draw.upper = TRUE, ...) { x <- na.omit(x) stopifnot(1 <= (nptot <- length(nms <- names(attr(x, "forward"))))) singfit <- FALSE for (i in grep("^(\\.sig[0-9]+|sd_)", names(x))) singfit <- singfit || any(x[,".zeta"] == 0 & x[,i] == 0) if (singfit) warning("splom is unreliable for singular fits") nvp <- length(grep("^(\\.sig[0-9]+|.sigma|sd_|cor_)", nms)) which <- get.which(which, nvp, nptot, nms) ok_params <- sapply(nms[which], function(nm) { !is.null(attr(x, "forward")[[nm]]) && !is.null(attr(x, "backward")[[nm]]) && !inherits(attr(x, "backward")[[nm]], "error") }) if (!all(ok_params)) { warning("Dropping parameters from splom due to failed spline interpolation: ", paste(nms[which][!ok_params], collapse=", ")) which <- which[ok_params] } if (length(which) == 1) { stop("can't draw a scatterplot matrix for a single variable") } mlev <- max(levels) spl <- attr(x, "forward")[which] frange <- sapply(spl, function(x) range(x$knots)) bsp <- attr(x, "backward")[which] x <- x[x[[".par"]] %in% nms[which],c(".zeta",nms[which],".par")] ## brange <- sapply(bsp, function(x) range(x$knots)) pfr <- do.call(cbind, lapply(bsp, predy, c(-mlev, mlev))) pfr[1, ] <- pmax.int(pfr[1, ], frange[1, ], na.rm = TRUE) pfr[2, ] <- pmin.int(pfr[2, ], frange[2, ], na.rm = TRUE) nms <- names(spl) ## Create data frame fr of par. vals in zeta coordinates fr <- x[, -1] for (nm in nms) fr[[nm]] <- predy(spl[[nm]], na.omit(fr[[nm]])) fr1 <- fr[1, nms] ## create a list of lists with the names of the parameters traces <- lapply(fr1, function(el) lapply(fr1, function(el1) list())) .par <- NULL ## => no R CMD check warning for (j in seq_along(nms)[-1]) { frj <- subset(fr, .par == nms[j]) for (i in seq_len(j - 1L)) { fri <- subset(fr, .par == nms[i]) sij <- interpSpline(fri[ , i], fri[ , j]) sji <- interpSpline(frj[ , j], frj[ , i]) ll <- cont(sij, sji, levels) traces[[j]][[i]] <- list(sij = sij, sji = sji, ll = ll) } } if(draw.lower) ## panel function for lower triangle lp <- function(x, y, groups, subscripts, i, j, ...) { tr <- traces[[j]][[i]] grid::pushViewport(viewport(xscale = c(-1.07, 1.07) * mlev, yscale = c(-1.07, 1.07) * mlev)) dd <- sapply(current.panel.limits(), diff)/50 psij <- predict(tr$sij) ll <- tr$ll ## now do the actual plotting panel.grid(h = -1, v = -1) llines(psij$y, psij$x, ...) llines(predict(tr$sji), ...) with(ll$tki, lsegments(y - dd[1], x, y + dd[1], x, ...)) with(ll$tkj, lsegments(x, y - dd[2], x, y + dd[2], ...)) for (k in seq_along(levels)) llines(ll$pts[k, , ], ...) grid::popViewport(1) } if(draw.upper) ## panel function for upper triangle up <- function(x, y, groups, subscripts, i, j, ...) { ## panels are transposed so reverse i and j jj <- i ii <- j tr <- traces[[jj]][[ii]] ll <- tr$ll pts <- ll$pts ## limits <- current.panel.limits() psij <- predict(tr$sij) psji <- predict(tr$sji) ## do the actual plotting panel.grid(h = -1, v = -1) llines(predy(bsp[[ii]], psij$x), predy(bsp[[jj]], psij$y), ...) llines(predy(bsp[[ii]], psji$y), predy(bsp[[jj]], psji$x), ...) for (k in seq_along(levels)) llines(predy(bsp[[ii]], pts[k, , 2]), predy(bsp[[jj]], pts[k, , 1]), ...) } dp <- function(x = NULL, # diagonal panel varname = NULL, limits, at = NULL, lab = NULL, draw = TRUE, varname.col = add.text$col, varname.cex = add.text$cex, varname.lineheight = add.text$lineheight, varname.font = add.text$font, varname.fontfamily = add.text$fontfamily, varname.fontface = add.text$fontface, axis.text.col = axis.text$col, axis.text.alpha = axis.text$alpha, axis.text.cex = axis.text$cex, axis.text.font = axis.text$font, axis.text.fontfamily = axis.text$fontfamily, axis.text.fontface = axis.text$fontface, axis.line.col = axis.line$col, axis.line.alpha = axis.line$alpha, axis.line.lty = axis.line$lty, axis.line.lwd = axis.line$lwd, i, j, ...) { n.var <- eval.parent(expression(n.var)) add.text <- trellis.par.get("add.text") axis.line <- trellis.par.get("axis.line") axis.text <- trellis.par.get("axis.text") if (!is.null(varname)) grid::grid.text(varname, gp = gpar(col = varname.col, cex = varname.cex, lineheight = varname.lineheight, fontface = chooseFace(varname.fontface, varname.font), fontfamily = varname.fontfamily)) if (draw) { at <- pretty(limits) sides <- c("left", "top") if (j == 1) sides <- "top" if (j == n.var) sides <- "left" for (side in sides) panel.axis(side = side, at = at, labels = format(at, trim = TRUE), ticks = TRUE, check.overlap = TRUE, half = side == "top" && j > 1, tck = 1, rot = 0, text.col = axis.text.col, text.alpha = axis.text.alpha, text.cex = axis.text.cex, text.font = axis.text.font, text.fontfamily = axis.text.fontfamily, text.fontface = axis.text.fontface, line.col = axis.line.col, line.alpha = axis.line.alpha, line.lty = axis.line.lty, line.lwd = axis.line.lwd) lims <- c(-1.07, 1.07) * mlev grid::pushViewport(viewport(xscale = lims, yscale = lims)) side <- if(j == 1) "right" else "bottom" which.half <- if(j == 1) "lower" else "upper" at <- pretty(lims) panel.axis(side = side, at = at, labels = format(at, trim = TRUE), ticks = TRUE, half = TRUE, which.half = which.half, tck = 1, rot = 0, text.col = axis.text.col, text.alpha = axis.text.alpha, text.cex = axis.text.cex, text.font = axis.text.font, text.fontfamily = axis.text.fontfamily, text.fontface = axis.text.fontface, line.col = axis.line.col, line.alpha = axis.line.alpha, line.lty = axis.line.lty, line.lwd = axis.line.lwd) grid::popViewport(1) } } panel.blank <- function(...) {} splom(~ pfr, lower.panel = if(draw.lower) lp else panel.blank, upper.panel = if(draw.upper) up else panel.blank, diag.panel = dp, ...) } ## return an lmer profile like x with all the .sigNN parameters ## replaced by .lsigNN. The forward and backward splines for ## these parameters are recalculated. -> ../man/profile-methods.Rd logProf <- function (x, base = exp(1), ranef=TRUE, sigIni = if(ranef) "sig" else "sigma") { stopifnot(inherits(x, "thpr")) cn <- colnames(x) sigP <- paste0("^\\.", sigIni) if (length(sigs <- grep(sigP, cn))) { repP <- sub("sig", ".lsig", sigIni) colnames(x) <- cn <- sub(sigP, repP, cn) levels(x[[".par"]]) <- sub(sigP, repP, levels(x[[".par"]])) names(attr(x, "backward")) <- names(attr(x, "forward")) <- sub(sigP, repP, names(attr(x, "forward"))) for (nm in cn[sigs]) { x[[nm]] <- log(x[[nm]], base = base) fr <- x[x[[".par"]] == nm & is.finite(x[[nm]]), TRUE, drop=FALSE] form <- eval(substitute(.zeta ~ nm, list(nm = as.name(nm)))) attr(x, "forward")[[nm]] <- isp <- interpSpline(form, fr) attr(x, "backward")[[nm]] <- backSpline(isp) } ## eliminate rows that produced non-finite logs x <- x[apply(is.finite(as.matrix(x[, sigs])), 1, all), , drop=FALSE] } x } ## the log() method must have (x, base); no other arguments log.thpr <- function (x, base = exp(1)) logProf(x, base=base) ##' Create an approximating density from a profile object -- called only from densityplot.thpr() ##' ##' @title Approximate densities from profiles ##' @param pr a profile object ##' @param npts number of points at which to evaluate the density ##' @param upper upper bound on cumulative for a cutoff ##' @return a data frame dens <- function(pr, npts=201, upper=0.999) { npts <- as.integer(npts) spl <- attr(pr, "forward") bspl <- attr(pr, "backward") stopifnot(inherits(pr, "thpr"), npts > 0, is.numeric(upper), 0.5 < upper, upper < 1, identical((vNms <- names(spl)), names(bspl))) bad_vars <- character(0) zeta <- c(-1,1) * qnorm(upper) rng <- vector(mode="list", length=length(bspl)) names(rng) <- vNms dd <- rng # empty named list to be filled for (i in seq_along(bspl)) { if (inherits(bspl[[i]], "error")) { rng[[i]] <- rep(NA_real_,npts) bad_vars <- c(bad_vars, vNms[i]) next } rng0 <- predy(bspl[[i]], zeta) if (is.na(rng0[1])) rng0[1] <- 0 if (is.na(rng0[2])) { ## try harder to pick an upper bound for(upp in 1 - 10^seq(-4,-1, length=21)) { # <<-- TODO: should be related to 'upper' if(!is.na(rng0[2L] <- predy(bspl[[i]], qnorm(upp)))) break } if (is.na(rng0[2])) { warning("can't find an upper bound for the profile") bad_vars <- c(bad_vars, vNms[i]) next } } rng[[i]] <- seq(rng0[1], rng0[2], len=npts) } fr <- data.frame(pval = unlist(rng), pnm = gl(length(rng), npts, labels=vNms)) for (nm in vNms) { dd[[nm]] <- if (!inherits(spl[[nm]], "spline")) { rep(NA_real_, npts) } else { zz <- predy(spl[[nm]], rng[[nm]]) dnorm(zz) * predict(spl[[nm]], rng[[nm]], deriv = 1L)$y } } fr$density <- unlist(dd) if (length(bad_vars)) warning("unreliable profiles for some variables skipped: ", paste(bad_vars, collapse=", ")) fr } ##' Densityplot method for a mixed-effects model profile ## ##' @title densityplot from a mixed-effects profile ##' @param x a mixed-effects profile ##' @param data not used - for compatibility with generic ##' @param ... optional arguments to \code{\link[lattice]{densityplot}()} ##' from package \pkg{lattice}. ##' @return a density plot ##' @examples ## see example("profile.merMod") ##' @importFrom lattice densityplot ##' @method densityplot thpr ##' @export densityplot.thpr <- function(x, data, npts=201, upper=0.999, ...) { dd <- dens(x, npts=npts, upper=upper) ll <- c(list(...), list(x=density ~ pval|pnm, data=dd, type=c("l","g"), scales=list(relation="free"), xlab=NULL)) do.call(xyplot, stripExpr(ll, names(attr(x, "forward")))) } ##' Transform a mixed-effects profile to the variance scale varianceProf <- function(x, ranef=TRUE) { ## "parallel" to logProf() stopifnot(inherits(x, "thpr")) cn <- colnames(x) if(length(sigs <- grep(paste0("^\\.", if(ranef)"sig" else "sigma"), cn))) { ## s/sigma/sigmasq/ ; s/sig01/sig01sq/ etc sigP <- paste0("^(\\.sig", if(ranef) "(ma)?" else "ma", ")") repP <- "\\1sq" colnames(x) <- cn <- sub(sigP, repP, cn) levels(x[[".par"]]) <- sub(sigP, repP, levels(x[[".par"]])) names(attr(x, "backward")) <- names(attr(x, "forward")) <- sub(sigP, repP, names(attr(x, "forward"))) for (nm in cn[sigs]) { x[[nm]] <- x[[nm]]^2 ## select rows (and currently drop extra attributes) fr <- x[x[[".par"]] == nm, TRUE, drop=FALSE] form <- eval(substitute(.zeta ~ nm, list(nm = as.name(nm)))) attr(x, "forward")[[nm]] <- isp <- interpSpline(form, fr) attr(x, "backward")[[nm]] <- backSpline(isp) } } x } ## convert profile to data frame, adding a .focal parameter to simplify lattice/ggplot plotting ##' @method as.data.frame thpr ##' @param x the result of \code{\link{profile}} (or very similar structure) ##' @export ##' @rdname profile-methods as.data.frame.thpr <- function(x,...) { class(x) <- "data.frame" m <- as.matrix(x[,seq(ncol(x))-1]) ## omit .par x.p <- x[[".par"]] x[[".focal"]] <- m[cbind(seq(nrow(x)),match(x.p,names(x)))] x[[".par"]] <- factor(x.p, levels=unique(as.character(x.p))) ## restore order x } lme4/R/reformulas_imports.R0000644000176200001440000000216615221217600015374 0ustar liggesusers## transient patches for moving formula manipulation machinery to lme4 without breaking downstream packages ## tracks which one-time deprecation warnings have already fired this session .reformulas_warned <- new.env(parent = emptyenv()) warn_once <- function(msg, id) { if (!exists(id, envir = .reformulas_warned, inherits = FALSE)) { assign(id, TRUE, envir = .reformulas_warned) warning(msg, call. = FALSE) } } mkWarnFun <- function(FUN) { fn <- function(...) { msg <- sprintf("the %s function has moved to the reformulas package. Please update your imports, or ask an upstream package maintainer to do so.", sQuote(FUN)) warn_once(msg, FUN) reformulas_fun <- getExportedValue("reformulas", FUN) reformulas_fun(...) } assign(FUN, fn, envir = parent.frame()) } for (f in c("findbars","subbars", "nobars", "mkReTrms", "expandDoubleVerts", "isNested")) { mkWarnFun(f) } ## handle reOnly separately, it needs to be wrapped to return a formula properly ## reformulas 0.4.5 will fix this (can then move back to the deprecation block above) reOnly <- function(...) { res <- lme4_reOnly(...) } lme4/R/mcmcsamp.R0000644000176200001440000000654314234301437013250 0ustar liggesusers##' @name pvalues ##' @aliases mcmcsamp ##' @title Getting p-values for fitted models ##' ##' @description One of the most frequently asked questions about \code{lme4} ##' is "how do I calculate p-values for estimated parameters?" ##' Previous versions of \code{lme4} provided the \code{mcmcsamp} ##' function, which efficiently generated a Markov chain Monte Carlo sample ##' from the posterior distribution of the parameters, assuming ##' flat (scaled likelihood) priors. Due to difficulty in ##' constructing a version of \code{mcmcsamp} that was reliable ##' even in cases where the estimated random effect variances were near ##' zero (e.g. \url{https://stat.ethz.ch/pipermail/r-sig-mixed-models/2009q4/003115.html}), \code{mcmcsamp} has been withdrawn (or more precisely, ##' not updated to work with \code{lme4} versions >=1.0.0). ##' ##' Many users, including users of the \code{aovlmer.fnc} function ##' from the \code{languageR} package which relies on \code{mcmcsamp}, ##' will be deeply disappointed by this lacuna. Users who need p-values have ##' a variety of options: ##' \itemize{ ##' \item likelihood ratio tests via \code{anova} (MC,+) ##' \item profile confidence intervals via \code{\link{profile.merMod}} and \code{\link{confint.merMod}} (CI,+) ##' \item parametric bootstrap confidence intervals and model comparisons via \code{\link{bootMer}} (or \code{PBmodcomp} in the \code{pbkrtest} package) (MC/CI,*,+) ##' \item for random effects, simulation tests via the \code{RLRsim} package (MC,*) ##' \item for fixed effects, F tests via Kenward-Roger approximation using \code{KRmodcomp} from the \code{pbkrtest} package (MC) ##' \item \code{car::Anova} and \code{lmerTest::anova} provide wrappers for \code{pbkrtest}. \code{lmerTest::anova} also provides t tests via the Satterthwaite approximation (P,*) ##' } ##' In the list above, the methods marked \code{MC} provide explicit model comparisons; \code{CI} denotes confidence intervals; and \code{P} denotes parameter-level or sequential tests of all effects in a model. The starred (*) suggestions provide finite-size corrections (important when the number of groups is <50); those marked (+) support GLMMs as well as LMMs. ##' ##' When all else fails, don't forget to keep p-values in perspective: \url{http://www.phdcomics.com/comics/archive.php?comicid=905} ##' if(FALSE) ## C++ code in ../src/mcmcsamp.cpp -- is also #ifdef 0 # @S3method mcmcsamp merMod mcmcsamp.merMod <- function(object, n=1L, verbose=FALSE, saveb=FALSE, ...) { n <- max(1L, as.integer(n)[1]) dd <- getME(object, "devcomp")$dims ranef <- matrix(numeric(0), nrow = dd[["q"]], ncol = 0) if (saveb) ranef <- matrix(, nrow = dd[["q"]], ncol = n) sigma <- matrix(unname(sigma(object)), nrow = 1, ncol = (if (dd[["useSc"]]) n else 0)) ff <- fixef(object) fixef <- matrix(ff, nrow=dd[["p"]], ncol=n) rownames(fixef) <- names(ff) ## FIXME create a copy of the resp and pred modules ans <- new("merMCMC", Gp = object@Gp, # ST = matrix(.Call(mer_ST_getPars, object), dd[["np"]], n), call = object@call, dims = object@dims, deviance = rep.int(unname(object@deviance[["ML"]]), n), fixef = fixef, nc = sapply(object@ST, nrow), ranef = ranef, sigma = sigma) .Call(mer_MCMCsamp, ans, object) } lme4/R/optimizer.R0000644000176200001440000000613215036542626013474 0ustar liggesusers## --> ../man/NelderMead.Rd Nelder_Mead <- function(fn, par, lower=rep.int(-Inf, n), upper=rep.int(Inf, n), control=list()) { n <- length(par) if (is.null(xst <- control[["xst"]])) xst <- rep.int(0.02,n) if (is.null(xt <- control[["xt"]])) xt <- xst*5e-4 control[["xst"]] <- control[["xt"]] <- NULL ## mapping between simpler 'verbose' setting (0=no printing, 1=20, 2=10, 3=1) ## and internal 'iprint' control (frequency of printing) if (is.null(verbose <- control[["verbose"]])) verbose <- 0 control[["verbose"]] <- NULL if (is.null(control[["iprint"]])) { control[["iprint"]] <- switch(as.character(min(as.numeric(verbose),3L)), "0"=0, "1"=20,"2"=10,"3"=1) } stopifnot(is.function(fn), length(formals(fn)) == 1L, (n <- length(par <- as.numeric(par))) == length(lower <- as.numeric(lower)), length(upper <- as.numeric(upper)) == n, length(xst <- as.numeric(xst)) == n, all(xst != 0), length(xt <- as.numeric(xt)) == n) ## "NelderMead" reference class and constructor: --> ./AllClass.R : nM <- NelderMead$new(lower=lower, upper=upper, x0=par, xst=xst, xt=xt) cc <- do.call(function(iprint = 0L, maxfun = 10000L, FtolAbs = 1e-5, FtolRel = 1e-15, XtolRel = 1e-7, MinfMax= -.Machine$double.xmax, warnOnly=FALSE, ...) { if(...length() > 0) warning("unused control arguments ignored") list(iprint=iprint, maxfun=maxfun, FtolAbs=FtolAbs, FtolRel=FtolRel, XtolRel=XtolRel, MinfMax=MinfMax, warnOnly=warnOnly) }, control) nM$setFtolAbs(cc$FtolAbs) nM$setFtolRel(cc$FtolRel) nM$setIprint (cc$iprint) nM$setMaxeval(cc$maxfun) nM$setMinfMax(cc$MinfMax) it <- 0 repeat { it <- it + 1 nMres <- nM$newf(fn(nM$xeval())) if (nMres != 0L) break } cmsg <- "reached max evaluations" if (nMres == -4) { ## map max evals from error to warning cmsg <- warning(sprintf("failure to converge in %d evaluations",cc$maxfun)) nMres <- 4 } ## nMres: msgvec <- c("nm_forced", ## -3 "cannot generate a feasible simplex", ## -2 "initial x is not feasible", ## -1 "active", ## 0 (active) "objective function went below allowed minimum", ## 1 (minf_max) "objective function values converged to within tolerance", ## 2 (fcvg) "parameter values converged to within tolerance", ## 3 (xcvg) cmsg) if (nMres < 0) { ## i.e., in {-3, -2, -1} (if(cc$warnOnly) warning else stop)( msgvec[nMres+4] ) } list(fval = nM$value(), par = nM$xpos(), convergence = pmin(0, nMres), # positive nMres is also 'convergence' NM.result = nMres, `message` = msgvec[nMres+4], control = c(cc, xst=xst, xt=xt), feval = it) } lme4/R/AllClass.R0000644000176200001440000013330115222601254013135 0ustar liggesusers### Class definitions for the package ##' Class "lmList4" of 'lm' Objects on Common Model ##' --> ../man/lmList4-class.Rd ##' ~~~~~~~~~~~~~~~~~~~~~~~ ##' @keywords classes ##' @export setClass("lmList4", representation(call = "call", pool = "logical", groups = "ordered", # or "factor"? nlme does use ordered() origOrder = "integer" # a permutation ), contains = "list") ## TODO?: export setClass("lmList4.confint", contains = "array") forceCopy <- function(x) .Call(deepcopy, x) ### FIXME ### shouldn't we have "merPred" with two *sub* classes "merPredD" and "merPredS" ### for the dense and sparse X cases ? ## ## MM: _Or_ have "merPred" with X of class "mMatrix" := classUnion {matrix, Matrix} merPredD <- setRefClass("merPredD", # Predictor class for mixed-effects models with dense X fields = list(Lambdat = "dgCMatrix", # depends: theta and Lind ## = t(Lambda); Lambda := lower triangular relative variance factor LamtUt = "dgCMatrix", # depends: Lambdat and Ut Lind = "integer", # depends: nothing ## integer vector of the same length as 'x' slot in Lambdat. ## Its elements should be in 1: length(theta) Ptr = "externalptr", # depends: RZX = "matrix", # depends: lots Ut = "dgCMatrix", # depends: Zt and weights Utr = "numeric", # depends: lots V = "matrix", # depends: VtV = "matrix", Vtr = "numeric", X = "matrix", # model matrix for the fixed-effects parameters Xwts = "numeric", Zt = "dgCMatrix", # = t(Z); Z = sparse model matrix for the random effects beta0 = "numeric", delb = "numeric", delu = "numeric", theta = "numeric", # numeric vector of variance component parameters u0 = "numeric"), methods = list( initialize = function(X, Zt, Lambdat, Lind, theta, n, # = sample size, usually = nrow(X) ...) { if (!nargs()) return() ll <- list(...) X <<- as(X, "matrix") Zt <<- as(Zt, "dgCMatrix") Lambdat <<- as(Lambdat, "dgCMatrix") Lind <<- as.integer(Lind) theta <<- as.numeric(theta) N <- nrow(X) p <- ncol(X) q <- nrow(Zt) stopifnot(length(theta) > 0L, length(Lind) > 0L, all(sort(unique(Lind)) == seq_along(theta))) RZX <<- if (!is.null(ll$RZX)) array(ll$RZX, c(q, p)) else array(0, c(q, p)) Utr <<- if (!is.null(ll$Utr)) as.numeric(ll$Utr) else numeric(q) V <<- if (!is.null(ll$V)) array(ll$V, c(n, p)) else array(0, c(n, p)) VtV <<- if (!is.null(ll$VtV)) array(ll$VtV, c(p, p)) else array(0, c(p, p)) Vtr <<- if (!is.null(ll$Vtr)) as.numeric(ll$Vtr) else numeric(p) beta0 <<- if (!is.null(ll$beta0)) ll$beta0 else numeric(p) delb <<- if (!is.null(ll$delb)) as.numeric(ll$delb) else numeric(p) delu <<- if (!is.null(ll$delu)) as.numeric(ll$delu) else numeric(q) u0 <<- if (!is.null(ll$u0)) ll$u0 else numeric(q) Ut <<- if (n == N) Zt + 0 else Zt %*% sparseMatrix(i=seq_len(N), j=as.integer(gl(n, 1, N)), x=rep.int(1,N)) ## The following is a kludge to overcome problems when Zt is square ## by making LamtUt rectangular LtUt <- Lambdat %*% Ut ## if (nrow(LtUt) == ncol(LtUt)) ## LtUt <- cbind2(LtUt, ## sparseMatrix(i=integer(0), ## j=integer(0), ## x=numeric(0), ## dims=c(nrow(LtUt),1))) LamtUt <<- LtUt Xw <- ll$Xwts ## list(...)$Xwts Xwts <<- if (is.null(Xw)) rep.int(1, N) else as.numeric(Xw) initializePtr() }, CcNumer = function() { 'returns the numerator of the orthogonality convergence criterion' .Call(merPredDCcNumer, ptr()) }, L = function() { 'returns the current value of the sparse Cholesky factor' .Call(merPredDL, ptr()) }, P = function() { 'returns the permutation vector for the sparse Cholesky factor' .Call(merPredDPvec, ptr()) }, RX = function() { 'returns the dense downdated Cholesky factor for the fixed-effects parameters' .Call(merPredDRX, ptr()) }, RXi = function() { 'returns the inverse of the dense downdated Cholesky factor for the fixed-effects parameters' .Call(merPredDRXi, ptr()) }, RXdiag = function() { 'returns the diagonal of the dense downdated Cholesky factor' .Call(merPredDRXdiag, ptr()) }, b = function(fac) { 'random effects on original scale for step factor fac' .Call(merPredDb, ptr(), as.numeric(fac)) }, beta = function(fac) { 'fixed-effects coefficients for step factor fac' .Call(merPredDbeta, ptr(), as.numeric(fac)) }, copy = function(shallow = FALSE) { def <- .refClassDef selfEnv <- as.environment(.self) vEnv <- new.env(parent=emptyenv()) for (field in setdiff(names(def@fieldClasses), "Ptr")) { if (shallow) assign(field, get(field, envir = selfEnv), envir = vEnv) else { current <- get(field, envir = selfEnv) if (is(current, "envRefClass")) current <- current$copy(FALSE) assign(field, forceCopy(current), envir = vEnv) } } do.call(merPredD$new, c(as.list(vEnv), n=nrow(vEnv$V), Class=def)) }, ldL2 = function() { 'twice the log determinant of the sparse Cholesky factor' .Call(merPredDldL2, ptr()) }, ldRX2 = function() { 'twice the log determinant of the downdated dense Cholesky factor' .Call(merPredDldRX2, ptr()) }, unsc = function() { 'the unscaled variance-covariance matrix of the fixed-effects parameters' .Call(merPredDunsc, ptr()) }, linPred = function(fac) { 'evaluate the linear predictor for step factor fac' .Call(merPredDlinPred, ptr(), as.numeric(fac)) }, installPars = function(fac) { 'update u0 and beta0 to the values for step factor fac' .Call(merPredDinstallPars, ptr(), as.numeric(fac)) }, initializePtr = function() { Ptr <<- .Call(merPredDCreate, X, Lambdat, LamtUt, Lind, RZX, Ut, Utr, V, VtV, Vtr, Xwts, Zt, beta0, delb, delu, theta, u0) .Call(merPredDsetTheta, Ptr, theta) .Call(merPredDupdateXwts, Ptr, Xwts) .Call(merPredDupdateDecomp, Ptr, NULL) }, ptr = function() { 'returns the external pointer, regenerating if necessary' if (length(theta)) { if (.Call(isNullExtPtr, Ptr)) initializePtr() } Ptr }, setBeta0 = function(beta0) { 'install a new value of beta' .Call(merPredDsetBeta0, ptr(), as.numeric(beta0)) }, setTheta = function(theta) { 'install a new value of theta' .Call(merPredDsetTheta, ptr(), as.numeric(theta)) }, setZt = function(ZtNonZero) { 'install new values in Zt' .Call(merPredDsetZt, ptr(), as.numeric(ZtNonZero)) }, solve = function() { 'solve for the coefficient increments delu and delb' .Call(merPredDsolve, ptr()) }, solveU = function() { 'solve for the coefficient increment delu only (beta is fixed)' .Call(merPredDsolveU, ptr()) }, setDelu = function(val) { 'set the coefficient increment delu' .Call(merPredDsetDelu , ptr(), as.numeric(val)) }, setDelb = function(val) { 'set the coefficient increment delb' .Call(merPredDsetDelb , ptr(), as.numeric(val)) }, sqrL = function(fac) { 'squared length of u0 + fac * delu' .Call(merPredDsqrL, ptr(), as.numeric(fac)) }, u = function(fac) { 'orthogonal random effects for step factor fac' .Call(merPredDu, ptr(), as.numeric(fac)) }, updateDecomp = function(XPenalty = NULL) { 'update L, RZX and RX from Ut, Vt and VtV' invisible(.Call(merPredDupdateDecomp, ptr(), XPenalty)) }, updateL = function() { 'update LamtUt and L' .Call(merPredDupdateL, ptr()) }, updateLamtUt = function() { 'update LamtUt and L' .Call(merPredDupdateLamtUt, ptr()) }, updateRes = function(wtres) { 'update Vtr and Utr using the vector of weighted residuals' .Call(merPredDupdateRes, ptr(), as.numeric(wtres)) }, updateXwts = function(wts) { 'update Ut and V from Zt and X using X weights' .Call(merPredDupdateXwts, ptr(), wts) } ) ) merPredD$lock("Lambdat", "LamtUt", "Lind", "RZX", "Ut", "Utr", "V", "VtV", "Vtr", "X", "Xwts", "Zt", "beta0", "delb", "delu", "theta", "u0") ## -> ../man/lmResp-class.Rd ## ~~~~~~~~~~~~~~~~~~~~~~ lmResp <- # base class for response modules setRefClass("lmResp", fields = list(Ptr = "externalptr", mu = "numeric", offset = "numeric", sqrtXwt = "numeric", sqrtrwt = "numeric", weights = "numeric", wtres = "numeric", y = "numeric"), methods = list( allInfo = function() { 'return all the information available on the object' data.frame(y=y, offset=offset, weights=weights, mu=mu, rwt=sqrtrwt, wres=wtres, Xwt=sqrtXwt) }, initialize = function(...) { if (!nargs()) return() ll <- list(...) if (is.null(ll$y)) stop("y must be specified") y <<- as.numeric(ll$y) n <- length(y) mu <<- if (!is.null(ll[["mu"]])) as.numeric(ll[["mu"]]) else numeric(n) offset <<- if (!is.null(ll$offset)) as.numeric(ll$offset) else numeric(n) weights <<- if (!is.null(ll$weights)) as.numeric(ll$weights) else rep.int(1,n) sqrtXwt <<- if (!is.null(ll$sqrtXwt)) as.numeric(ll$sqrtXwt) else sqrt(weights) sqrtrwt <<- if (!is.null(ll$sqrtrwt)) as.numeric(ll$sqrtrwt) else sqrt(weights) wtres <<- sqrtrwt * (y - mu) }, copy = function(shallow = FALSE) { def <- .refClassDef selfEnv <- as.environment(.self) vEnv <- new.env(parent=emptyenv()) for (field in setdiff(names(def@fieldClasses), "Ptr")) { if (shallow) assign(field, get(field, envir = selfEnv), envir = vEnv) else { current <- get(field, envir = selfEnv) if (is(current, "envRefClass")) current <- current$copy(FALSE) ## deep-copy hack +0 assign(field, forceCopy(current), envir = vEnv) } } do.call(new, c(as.list(vEnv), Class=def)) }, initializePtr = function() { Ptr <<- .Call(lm_Create, y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres) .Call(lm_updateMu, Ptr, mu) }, ptr = function() { 'returns the external pointer, regenerating if necessary' if (length(y)) { if (.Call(isNullExtPtr, Ptr)) initializePtr() } Ptr }, setOffset = function(oo) { 'change the offset in the model (used in profiling)' .Call(lm_setOffset, ptr(), as.numeric(oo)) }, setResp = function(rr) { 'change the response in the model, usually after a deep copy' .Call(lm_setResp, ptr(), as.numeric(rr)) }, setWeights = function(ww) { 'change the prior weights in the model' .Call(lm_setWeights, ptr(), as.numeric(ww)) }, updateMu = function(gamma) { 'update mu, wtres and wrss from the linear predictor' .Call(lm_updateMu, ptr(), as.numeric(gamma)) }, wrss = function() { 'returns the weighted residual sum of squares' .Call(lm_wrss, ptr()) }) ) lmResp$lock("mu", "offset", "sqrtXwt", "sqrtrwt", "weights", "wtres")#, "y") lmerResp <- setRefClass("lmerResp", contains = "lmResp", fields = list(REML = "integer"), methods= list(initialize = function(...) { REML <<- as.integer(list(...)$REML) if (length(REML) != 1L) REML <<- 0L callSuper(...) }, initializePtr = function() { Ptr <<- .Call(lmer_Create, y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres) .Call(lm_updateMu, Ptr, mu - offset) .Call(lmer_setREML, Ptr, REML) }, ptr = function() { 'returns the external pointer, regenerating if necessary' if (length(y)) if (.Call(isNullExtPtr, Ptr)) initializePtr() Ptr }, objective = function(ldL2, ldRX2, sqrL, sigma.sq = NULL) { 'returns the profiled deviance or REML criterion' .Call(lmer_Laplace, ptr(), ldL2, ldRX2, sqrL, sigma.sq) }) ) setOldClass("family") ##' @export glmResp <- setRefClass("glmResp", contains = "lmResp", fields = list(eta = "numeric", family = "family", n = "numeric"), methods= list(initialize = function(...) { callSuper(...) ll <- list(...) if (is.null(ll$family)) stop("family must be specified") family <<- ll$family n <<- if (!is.null(ll$n)) as.numeric(ll$n) else rep.int(1,length(y)) eta <<- if (!is.null(e <- ll[["etastart"]])) as.numeric(e) else numeric(length(y)) }, aic = function() { .Call(glm_aic, ptr()) }, allInfo = function() { 'return all the information available on the object' cbind(callSuper(), data.frame(eta=eta, muEta=muEta(), var=variance(), WrkWt=sqrtWrkWt(), wrkRes=wrkResids(), wrkResp=wrkResp(), devRes=devResid())) }, devResid = function() { 'returns the vector of deviance residuals' .Call(glm_devResid, ptr()) }, fam = function() { 'returns the name of the glm family' .Call(glm_family, ptr()) }, Laplace = function(ldL2, ldRX2, sqrL) { 'returns the Laplace approximation to the profiled deviance' .Call(glm_Laplace, ptr(), ldL2, ldRX2, sqrL) }, link = function() { 'returns the name of the glm link' .Call(glm_link, ptr()) }, muEta = function() { 'returns the diagonal of the Jacobian matrix, d mu/d eta' .Call(glm_muEta, ptr()) }, ptr = function() { 'returns the external pointer, regenerating if necessary' if (length(y)) { if (.Call(isNullExtPtr, Ptr)) { Ptr <<- .Call(glm_Create, family, y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres, eta, n) .Call(glm_updateMu, Ptr, eta - offset) } } Ptr }, resDev = function() { 'returns the sum of the deviance residuals' .Call(glm_resDev, ptr()) }, setTheta = function(theta) { 'sets a new value of theta, for negative binomial distribution only' .Call(glm_setTheta, ptr(), as.numeric(theta)) }, sqrtWrkWt = function() { 'returns the square root of the working X weights' .Call(glm_sqrtWrkWt, ptr()) }, theta = function() { 'query the value of theta, for negative binomial distribution only' .Call(glm_theta, ptr()) }, updateMu = function(gamma) { 'update mu, residuals, weights, etc. from the linear predictor' .Call(glm_updateMu, ptr(), as.numeric(gamma)) }, updateWts = function() { 'update the residual and X weights from the current value of eta' .Call(glm_updateWts, ptr()) }, variance = function() { 'returns the vector of variances' .Call(glm_variance, ptr()) }, wtWrkResp = function() { 'returns the vector of weighted working responses' .Call(glm_wtWrkResp, ptr()) }, wrkResids = function() { 'returns the vector of working residuals' .Call(glm_wrkResids, ptr()) }, wrkResp = function() { 'returns the vector of working responses' .Call(glm_wrkResp, ptr()) } ) ) glmResp$lock("family", "n", "eta") ##' @export nlsResp <- setRefClass("nlsResp", contains = "lmResp", fields= list(gam = "numeric", nlmod = "formula", nlenv = "environment", pnames= "character"), methods= list(initialize = function(...) { callSuper(...) ll <- list(...) if (is.null(ll$nlmod)) stop("nlmod must be specified") nlmod <<- ll$nlmod if (is.null(ll$nlenv)) stop("nlenv must be specified") nlenv <<- ll$nlenv if (is.null(ll$pnames)) stop("pnames must be specified") pnames <<- ll$pnames if (is.null(ll$gam)) stop("gam must be specified") stopifnot(length(ll$gam) == length(offset)) gam <<- ll$gam }, Laplace =function(ldL2, ldRX2, sqrL) { 'returns the profiled deviance or REML criterion' .Call(nls_Laplace, ptr(), ldL2, ldRX2, sqrL) }, ptr = function() { 'returns the external pointer, regenerating if necessary' if (length(y)) { if (.Call(isNullExtPtr, Ptr)) { Ptr <<- .Call(nls_Create, y, weights, offset, mu, sqrtXwt, sqrtrwt, wtres, gam, nlmod[[2]], nlenv, pnames) .Call(nls_updateMu, Ptr, gam) } } Ptr }, updateMu=function(gamma) { 'update mu, residuals, gradient, etc. given the linear predictor matrix' .Call(nls_updateMu, ptr(), as.numeric(gamma)) }) ) nlsResp$lock("nlmod", "nlenv", "pnames") ##' Generator object for the \code{\linkS4class{glmFamily}} class ##' ##' The generator object for the \code{\linkS4class{glmFamily}} reference class. ##' Such an object is primarily used through its \code{new} method. ##' ##' ##' @param ... Named argument (see Note below) ##' @note Arguments to the \code{new} method must be named arguments. ##' @section Methods: \describe{ ##' \item{\code{new(family=family)}}{Create a new ##' \code{\linkS4class{glmFamily}} object} ##' } ##' @seealso \code{\linkS4class{glmFamily}} ##' @keywords classes ##' @export glmFamily <- # used in tests of family definitions setRefClass("glmFamily", fields=list(Ptr="externalptr", family="family"), methods= list( aic = function(y, n, mu, wt, dev) { 'returns the value from the aic member function, which is actually the deviance' nn <- length(y <- as.numeric(y)) stopifnot(length(n <- as.numeric(n)) == nn, length(mu <- as.numeric(mu)) == nn, length(wt <- as.numeric(wt)) == nn, all(wt >= 0), length(dev <- as.numeric(dev)) == 1L) .Call(glmFamily_aic, ptr(), y, n, mu, wt, dev) }, devResid = function(y, mu, wt) { 'applies the devResid function to y, mu and wt' mu <- as.numeric(mu) wt <- as.numeric(wt) y <- as.numeric(y) stopifnot(length(mu) == length(wt), length(mu) == length(y), all(wt >= 0)) .Call(glmFamily_devResid, ptr(), y, mu, wt) }, link = function(mu) { 'applies the (forward) link function to mu' .Call(glmFamily_link, ptr(), as.numeric(mu)) }, linkInv = function(eta) { 'applies the inverse link function to eta' .Call(glmFamily_linkInv, ptr(), as.numeric(eta)) }, muEta = function(eta) { 'applies the muEta function to eta' .Call(glmFamily_muEta, ptr(), as.numeric(eta)) }, ptr = function() { if (length(family)) if (.Call(isNullExtPtr, Ptr)) Ptr <<- .Call(glmFamily_Create, family) Ptr }, setTheta = function(theta) { 'sets a new value of theta, for negative binomial distribution only' .Call(glmFamily_setTheta, ptr(), as.numeric(theta)) }, theta = function() { 'query the value of theta, for negative binomial distribution only' .Call(glmFamily_theta, ptr()) }, variance = function(mu) { 'applies the variance function to mu' .Call(glmFamily_variance, ptr(), as.numeric(mu)) }) ) ##' Class \code{"glmFamily"} - a reference class for \code{\link{family}} ##' ##' This class is a wrapper class for \code{\link{family}} objects specifying a ##' distibution family and link function for a generalized linear model ##' (\code{\link{glm}}). The reference class contains an external pointer to a ##' C++ object representing the class. For common families and link functions ##' the functions in the family are implemented in compiled code so they can be ##' accessed from other compiled code and for a speed boost. ##' ##' ##' @name glmFamily-class ##' @docType class ##' @note Objects from this reference class correspond to objects in a C++ ##' class. Methods are invoked on the C++ class using the external pointer in ##' the \code{Ptr} field. When saving such an object the external pointer is ##' converted to a null pointer, which is why there is a redundant field ##' \code{ptr} that is an active-binding function returning the external ##' pointer. If the \code{Ptr} field is a null pointer, the external pointer is ##' regenerated for the stored \code{family} field. ##' @section Extends: All reference classes extend and inherit methods from ##' \code{"\linkS4class{envRefClass}"}. ##' @seealso \code{\link{family}}, \code{\link{glmFamily}} ##' @keywords classes ##' @examples ##' ##' str(glmFamily$new(family=poisson())) NULL ##' Generator object for the golden search optimizer class. ##' ##' The generator objects for the \code{\linkS4class{golden}} class of a scalar ##' optimizer for a parameter within an interval. The optimizer uses reverse ##' communications. ##' ##' @param \dots additional, optional arguments. None are used at present. ##' @note Arguments to the \code{new} methods must be named arguments. ##' \code{lower} and \code{upper} are the bounds for the scalar parameter; they must be finite. ##' @section Methods: ##' \describe{ ##' \item{\code{new(lower=lower, upper=upper)}}{Create a new ##' \code{\linkS4class{golden}} object.} ##' } ##' @seealso \code{\linkS4class{golden}} ##' @keywords classes ##' @export golden <- setRefClass("golden", # Reverse communication implementation of Golden Search fields = list( Ptr = "externalptr", lowerbd = "numeric", upperbd = "numeric" ), methods = list( initialize = function(lower, upper, ...) { stopifnot(length(lower <- as.numeric(lower)) == 1L, length(upper <- as.numeric(upper)) == 1L, lower > -Inf, upper < Inf, lower < upper) lowerbd <<- lower upperbd <<- upper Ptr <<- .Call(golden_Create, lower, upper) }, ptr = function() { if (length(lowerbd)) if (.Call(isNullExtPtr, Ptr)) Ptr <<- .Call(golden_Create, lowerbd, upperbd) Ptr }, newf = function(value) { stopifnot(length(value <- as.numeric(value)) == 1L) .Call(golden_newf, ptr(), value) }, value = function() .Call(golden_value, ptr()), xeval = function() .Call(golden_xeval, ptr()), xpos = function() .Call(golden_xpos, ptr()) ) ) ##' Class \code{"golden"} ##' ##' A reference class for a golden search scalar optimizer using reverse ##' communication. ##' ##' ##' @name golden-class ##' @docType class ##' @section Extends: All reference classes extend and inherit methods from ##' \code{"\linkS4class{envRefClass}"}. ##' @keywords classes ##' @examples ##' ##' showClass("golden") ##' NULL ## Generator object for the Nelder-Mead optimizer class "NelderMead" ## ## A reference class for a Nelder-Mead simplex optimizer allowing box ## constraints on the parameters and using reverse communication. NelderMead <- setRefClass("NelderMead", # Reverse communication implementation of Nelder-Mead simplex optimizer fields = list( Ptr = "externalptr", lowerbd = "numeric", upperbd = "numeric", xstep = "numeric", xtol = "numeric" ), methods = list( initialize = function(lower, upper, xst, x0, xt, ...) { stopifnot((n <- length(lower <- as.numeric(lower))) > 0L, length(upper <- as.numeric(upper)) == n, all(lower < upper), length(xst <- as.numeric(xst)) == n, all(xst != 0), length(x0 <- as.numeric(x0)) == n, all(x0 >= lower), all(x0 <= upper), all(is.finite(x0)), length(xt <- as.numeric(xt)) == n, all(xt > 0)) lowerbd <<- lower upperbd <<- upper xstep <<- xst xtol <<- xt Ptr <<- .Call(NelderMead_Create, lowerbd, upperbd, xstep, x0, xtol) }, ptr = function() { if (length(lowerbd)) if (.Call(isNullExtPtr, Ptr)) Ptr <<- .Call(NelderMead_Create, lowerbd, upperbd, xstep, x0, xtol) Ptr }, newf = function(value) { stopifnot(length(value <- as.numeric(value)) == 1L) .Call(NelderMead_newf, ptr(), value) }, setForceStop = function(stp=TRUE) .Call(NelderMead_setForce_stop, ptr(), stp), setFtolAbs = function(fta) .Call(NelderMead_setFtol_abs, ptr(), fta), setFtolRel = function(ftr) .Call(NelderMead_setFtol_rel, ptr(), ftr), setMaxeval = function(mxev) .Call(NelderMead_setMaxeval, ptr(), mxev), setMinfMax = function(minf) .Call(NelderMead_setMinf_max, ptr(), minf), setIprint = function(iprint) .Call(NelderMead_setIprint, ptr(), iprint), value = function() .Call(NelderMead_value, ptr()), xeval = function() .Call(NelderMead_xeval, ptr()), xpos = function() .Call(NelderMead_xpos, ptr()) ) ) ##' Class "merMod" of Fitted Mixed-Effect Models ##' ##' A mixed-effects model is represented as a \code{\linkS4class{merPredD}} object ##' and a response module of a class that inherits from class ##' \code{\linkS4class{lmResp}}. A model with a \code{\linkS4class{lmerResp}} ##' response has class \code{lmerMod}; a \code{\linkS4class{glmResp}} response ##' has class \code{glmerMod}; and a \code{\linkS4class{nlsResp}} response has ##' class \code{nlmerMod}. ##' ##' @name merMod-class ##' @aliases merMod-class lmerMod-class glmerMod-class nlmerMod-class merMod ##' show,merMod-method ##' anova.merMod coef.merMod deviance.merMod ##' fitted.merMod formula.merMod logLik.merMod ##' model.frame.merMod model.matrix.merMod print.merMod ##' show.merMod summary.merMod ##' terms.merMod update.merMod ##' vcov.merMod print.summary.merMod show.summary.merMod ##' summary.summary.merMod vcov.summary.merMod ##' @docType class ##' @section Objects from the Class: Objects are created by calls to ##' \code{\link{lmer}}, \code{\link{glmer}} or \code{\link{nlmer}}. ##' @seealso \code{\link{lmer}}, \code{\link{glmer}}, \code{\link{nlmer}}, ##' \code{\linkS4class{merPredD}}, \code{\linkS4class{lmerResp}}, ##' \code{\linkS4class{glmResp}}, \code{\linkS4class{nlsResp}} ##' @keywords classes ##' @examples ##' ##' showClass("merMod") ##' methods(class="merMod") ##' @export setClass("merMod", representation(Gp = "integer", call = "call", frame = "data.frame", # "model.frame" is not S4-ized yet flist = "list", cnms = "list", lower = "numeric", theta = "numeric", beta = "numeric", u = "numeric", devcomp = "list", pp = "merPredD", optinfo = "list")) ##' @export setClass("lmerMod", representation(resp="lmerResp"), contains="merMod") ##' @export setClass("glmerMod", representation(resp="glmResp"), contains="merMod") ##' @export setClass("nlmerMod", representation(resp="nlsResp"), contains="merMod") ##' Generator object for the rePos (random-effects positions) class ##' ##' The generator object for the \code{\linkS4class{rePos}} class used ##' to determine the positions and orders of random effects associated ##' with particular random-effects terms in the model. ##' @param \dots Argument list (see Note). ##' @note Arguments to the \code{new} methods must be named arguments. ##' \code{mer}, an object of class \code{"\linkS4class{merMod}"}, is ##' the only required/expected argument. ##' @section Methods: ##' \describe{ ##' \item{\code{new(mer=mer)}}{Create a new ##' \code{\linkS4class{rePos}} object.} ##' } ##' @seealso \code{\linkS4class{rePos}} ##' @keywords classes ##' @export rePos <- setRefClass("rePos", fields = list( cnms = "list", # component names (components are terms within a RE term) flist = "list", # list of grouping factors used in the random-effects terms ncols = "integer", # number of components for each RE term nctot = "integer", # total number of components per factor nlevs = "integer", # number of levels for each unique factor offsets = "integer", # points to where each term starts terms = "list" # list with one element per factor, indicating corresponding term ), methods = list( initialize = function(mer, ...) { ##' asgn indicates unique elements of flist ##' stopifnot((ntrms <- length(Cnms <- mer@cnms)) > 0L, (length(Flist <- mer@flist)) > 0L, length(asgn <- as.integer(attr(Flist, "assign"))) == ntrms) cnms <<- Cnms flist <<- Flist ncols <<- unname(lengths(cnms)) nctot <<- unname(as.vector(tapply(ncols, asgn, sum))) nlevs <<- unname(vapply(flist, function(el) length(levels(el)), 0L)) # why not replace the sapply with ncols*nlevs[asgn] ?? offsets <<- c(0L, cumsum(sapply(seq_along(asgn), function(i) ncols[i] * nlevs[asgn[i]]))) terms <<- lapply(seq_along(flist), function(i) which(asgn == i)) } ) ) ##' Class \code{"rePos"} ##' ##' A reference class for determining the positions in the random-effects vector ##' that correspond to particular random-effects terms in the model formula ##' ##' @name rePos-class ##' @docType class ##' @section Extends: All reference classes extend and inherit methods from ##' \code{"\linkS4class{envRefClass}"}. ##' @keywords classes ##' @examples ##' ##' showClass("rePos") ##' rePos$lock("cnms", "flist", "ncols", "nctot", "nlevs", "terms") vcRep <- setRefClass("vcRep", fields = list( theta = "numeric", lower = "numeric", Lambdat = "dgCMatrix", Lind = "integer", Gp = "integer", flist = "list", cnms = "list", ncols = "integer", nctot = "integer", nlevs = "integer", offsets = "integer", terms = "list", sig = "numeric", nms = "character", covar = "list", useSc = "logical" ), methods = list( initialize = function(mer, ...) { stopifnot((ntrms <- length(Cnms <- mer@cnms)) > 0L, (length(Flist <- mer@flist)) > 0L, length(asgn <- as.integer(attr(Flist, "assign"))) == ntrms) lower <<- getME(mer, "lower") theta <<- getME(mer, "theta") Lambdat <<- getME(mer, "Lambdat") Lind <<- getME(mer, "Lind") Gp <<- getME(mer, "Gp") cnms <<- Cnms flist <<- Flist ncols <<- unname(lengths(cnms)) nctot <<- unname(as.vector(tapply(ncols, asgn, sum))) nlevs <<- unname(vapply(flist, function(el) length(levels(el)), 0L)) offsets <<- c(0L, cumsum(sapply(seq_along(asgn), function(i) ncols[i] * nlevs[asgn[i]]))) terms <<- lapply(seq_along(Flist), function(i) which(asgn == i)) sig <<- sigma(mer) nms <<- names(Flist)[asgn] covar <<- mkVarCorr(sig, cnms, ncols, theta, nms) useSc <<- as.logical(getME(mer, "devcomp")$dims[["useSc"]]) }, asCovar = function() { ans <- lapply(covar, function(x) { attr(x, "correlation") <- attr(x, "stddev") <- NULL x }) attr(ans, "residVar") <- attr(covar, "sc")^2 ans }, asCorr = function() { ans <- lapply(covar, function(x) list(correlation=attr(x, "correlation"), stddev=attr(x, "stddev"))) attr(ans, "residSD") <- attr(covar, "sc") ans }, setTheta = function(ntheta) { stopifnot(length(ntheta <- as.numeric(ntheta)) == length(lower), all(ntheta >= lower)) theta <<- ntheta covar <<- mkVarCorr(sig, cnms, ncols, theta, nms) }, setSc = function(nSc) { stopifnot(useSc, length(nSc <- as.numeric(nSc)) == 1L) sig <<- nSc covar <<- mkVarCorr(sig, cnms, ncols, theta, nms) }, setResidVar = function(nVar) setSc(sqrt(as.numeric(nVar))), setRECovar = function(CV) { if (is.matrix(CV) && length(covar) == 1L) { CV <- list(CV) names(CV) <- names(covar) } covsiz <- sapply(covar, ncol) stopifnot(is.list(CV), all(names(CV) == names(covar)), all(sapply(CV, isSymmetric)), all(sapply(CV, ncol) == covsiz)) if (!all(lengths(cnms) == covsiz)) error("setRECovar currently requires distinct grouping factors") theta <<- sapply(CV, function(mm) { ff <- t(chol(mm))/sig ff[upper.tri(ff, diag=TRUE)] }) }) ) lme4/R/simulate.formula.R0000644000176200001440000001461415224173400014732 0ustar liggesusers## NOTE: Unlike the rest of the package, the functions in this file ## are licensed under the MIT License to encourage incorporation. ## ## Copyright (c) 2020 Pavel N. Krivitsky and Benjamin Bolker ## ## Permission is hereby granted, free of charge, to any person obtaining a copy ## of this software and associated documentation files (the "Software"), to deal ## in the Software without restriction, including without limitation the rights ## to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ## copies of the Software, and to permit persons to whom the Software is ## furnished to do so, subject to the following conditions: ## ## The above copyright notice and this permission notice shall be included in all ## copies or substantial portions of the Software. ## ## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ## IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ## FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ## AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ## LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ## OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. ## #' A `simulate` Method for `formula` objects that dispatches based on the Left-Hand Side #' #' This method evaluates the left-hand side (LHS) of the given formula and #' dispatches it to an appropriate method based on the result by #' setting an nonce class name on the formula. #' #' @param object a one- or two-sided [`formula`]. #' @param nsim,seed number of realisations to simulate and the random #' seed to use; see [simulate()]. #' @param ... additional arguments to methods. #' @param basis if given, overrides the LHS of the formula for the #' purposes of dispatching. #' @param newdata,data if passed, the `object`'s LHS is evaluated in #' this environment; at most one of the two may be passed. #' #' The dispatching works as follows: #' #' 1. If `basis` is not passed, and the formula has an LHS the #' expression on the LHS of the formula in the `object` is #' evaluated in the environment `newdata` or `data` (if given), in #' any case enclosed by the environment of `object`. Otherwise, #' `basis` is used. #' #' 1. The result is set as an attribute `".Basis"` on `object`. If #' there is no `basis` or LHS, it is not set. #' #' 1. The class vector of `object` has `c("formula_lhs_\var{CLASS}", #' "formula_lhs")` prepended to it, where \var{CLASS} is the class #' of the LHS value or `basis`. If LHS or `basis` has multiple #' classes, they are all prepended; if there is no LHS or `basis`, #' `c("formula_lhs_", "formula_lhs")` is. #' #' 1. [simulate()] generic is evaluated on the new `object`, with all #' arguments passed on, excluding `basis`; if `newdata` or `data` #' are missing, they too are not passed on. The evaluation takes #' place in the parent's environment. #' #' A "method" to receive a formula whose LHS evaluates to \var{CLASS} #' can therefore be implemented by a function #' `simulate.formula_lhs_\var{CLASS}()`. This function can expect a #' [`formula`] object, with additional attribute `.Basis` giving the #' evaluated LHS (so that it does not need to be evaluated again). #' #' @export ## See https://github.com/lme4/lme4/issues/566 for further discussion simulate.formula <- function(object, nsim=1, seed=NULL, ..., basis, newdata, data) { ## utility fun for generating new class cfun <- function(cc) { c(paste0("formula_lhs_", cc), "formula_lhs", class(object)) } ## grab the arguments and the call and replace the function to be called with stats::simulate cl <- match.call() cl[[1L]] <- quote(stats::simulate) if (length(object)==3 || !missing(basis)) { ## two-sided formula or basis given if (missing(basis)) { # If basis is not passed, evaluate LHS. if (!missing(data) && !missing(newdata)) stop("At most one of ", sQuote("data"), " or ", sQuote("newdata"), " can be specified.") evaldata <- if (!missing(data)) data else if(!missing(newdata)) newdata else environment(object) lhs <- object[[2L]] .Basis <- try(eval(lhs, envir=evaldata, enclos=environment(object)), silent=TRUE) if (inherits(.Basis,"try-error")) { ## can't evaluate LHS stop(simpleError(paste("Error evaluating the left-hand side of the formula:", .Basis))) } } else { # Otherwise, override LHS. .Basis <- basis } ## Set the basis object and class. attr(object,".Basis") <- .Basis class(object) <- cfun(class(.Basis)) } else { ## one-sided class(object) <- cfun("") } ## Replace the dispatched-on argument (object) with the updated formula. cl[["object"]] <- object ## If data argument was not actually passed, remove it from the call. if(missing(data)) cl <- cl[names(cl)!="data"] ## If newdata argument was not actually passed, remove it from the call. if(missing(newdata)) cl <- cl[names(cl)!="newdata"] ## Always remove basis from the call (since it's an attribute of object now). cl <- cl[names(cl)!="basis"] # Evaluate the modified call as if in the environment from which simulate.formula() was called. (A poor man's NextMethod().) eval(cl, parent.frame()) } #' @describeIn simulate.formula A method for one-sided formulas (no LHS) that #' routes to [.simulateFun()], enabling \code{simulate(~re_formula, #' family=..., newdata=..., newparams=...)} usage. \code{ergm} (and other #' packages using the shared \code{simulate.formula}/\code{simulate.formula_lhs} #' dispatch mechanism from GH#566) only ever supply two-sided formulas, so #' they never reach this method; this method exists only to give one-sided #' formulas a clearer error message than the generic #' \code{simulate.formula_lhs()} fallback would. #' #' @export simulate.formula_lhs_ <- function(object, nsim=1, seed=NULL, ...) { class(object) <- setdiff(class(object), c("formula_lhs_", "formula_lhs")) .simulateFun(formula=object, nsim=nsim, seed=seed, ...) } #' @describeIn simulate.formula A function to catch the situation when there is no method implemented for the class to which the LHS evaluates. #' #' @export simulate.formula_lhs <- function(object, nsim=1, seed=NULL, ...){ stop("No applicable method for LHS of type ", paste0(sQuote(class(attr(object, ".Basis"))), collapse=", "), ".") } lme4/R/lmList.R0000644000176200001440000004412315202440357012711 0ustar liggesusers## List of linear models according to a grouping factor ## Extract the model formula modelFormula <- function(form) { if (!inherits(form, "formula") || length(form) != 3) stop("formula must be a two-sided formula object") rhs <- form[[3]] if (!inherits(rhs, "call") || rhs[[1]] != as.symbol('|')) stop("rhs of formula must be a conditioning expression") form[[3]] <- rhs[[2]] list(model = dropOffset(form), groups = rhs[[3]]) } dropOffset <- function(form) { ## atomic if (is.symbol(form) || is.numeric(form)) return(form) ## binary if (identical(form[[1]],quote(offset))) { NULL } else { ## unary operator if (length(form)==2) { form[[2]] <- dropOffset(form[[2]]) return(form) } nb2 <- dropOffset(form[[2]]) nb3 <- dropOffset(form[[3]]) if (is.null(nb2)) nb3 else if (is.null(nb3)) nb2 else { form[[2]] <- nb2 form[[3]] <- nb3 return(form) } } } ## dropOffset(y~x) ## dropOffset(y~x+offset(stuff)) ## dropOffset(y~-x+offset(stuff)) ## dropOffset(~-x+offset(stuff)) if(getRversion() < "3.5.0") { ##' Utility for lmList(), ...: Collect errors from a list \code{x}, ##' produce a "summary warning" and keep that message as "warningMsg" attribute warnErrList <- function(x, warn = TRUE) { errs <- vapply(x, inherits, NA, what = "error") if (any(errs)) { v.err <- x[errs] e.call <- paste(deparse(conditionCall(v.err[[1]])), collapse = "\n") tt <- table(vapply(v.err, conditionMessage, "")) msg <- if(length(tt) == 1) sprintf(ngettext(tt[[1]], "%d error caught in %s: %s", "%d times caught the same error in %s: %s"), tt[[1]], e.call, names(tt)[[1]]) else ## at least two different errors caught paste(gettextf( "%d errors caught in %s. The error messages and their frequencies are", sum(tt), e.call), paste(capture.output(sort(tt)), collapse="\n"), sep="\n") if(warn) warning(msg, call. = FALSE, domain = NA) x[errs] <- list(NULL) attr(x, "warningMsg") <- msg } x } }# R <= 3.4.x ##' @title List of lm Objects with a Common Model ##' @param formula a linear formula object of the form ##' \code{y ~ x1+...+xn | g}. In the formula object, \code{y} represents ##' the response, \code{x1,...,xn} the covariates, and \code{g} the ##' grouping factor specifying the partitioning of the data according to ##' which different \code{lm} fits should be performed. ##' @inheritParams lmer ##' @param family an optional family specification for a generalized ##' linear model. ##' @param pool logical scalar, should the variance estimate pool the ##' residual sums of squares ##' @param ... additional, optional arguments to be passed to the ##' model function or family evaluation. ##' @export lmList <- function(formula, data, family, subset, weights, na.action, offset, pool = !isGLM || .hasScale(family2char(family)), warn = TRUE, ...) { stopifnot(inherits(formula, "formula")) ## model.frame(groupedData) was problematic ... but not as we ## are currently using it. mCall <- mf <- match.call() ## MM: I had this (instead of below (inherited from nlme?)): ## if(!missing(subset)) ## data <- data[eval(asOneSidedFormula(mf[["subset"]])[[2]], data),, drop = FALSE] ## in contrast to the usual R model-fitting idiom, we do **not** ## want to evaluate the model frame here; it will mess up any derived ## variables we have when we go to fit the sub-models. We were previously ## using model.frame() on the entire data set, but that does not ## exclude unused columns ... and hence screws us up when there are ## NA values in unused columns. All we need the model frame for ## is evaluating the groups. # TODO: import reformulas::get_grpvars once reformulas has updated ff <- get_grpvars(formula) if (length(ff) > 1) stop("lme4::lmList only works with simple grouping formulas (not involving * or /); use interaction(...) to construct an appropriate grouping variable first.") ## keep weights and offsets in case we have NAs there?? m <- match(c("formula", "data", "subset", "na.action", "weights", "offset"), names(mf), 0) mf <- mf[c(1, m)] ## substitute `+' for `|' in the formula mf$formula <- reformulas::subbars(formula) mf$drop.unused.levels <- TRUE ## pass NAs for now -- want *all* groups, weights, offsets recovered mf$na.action <- na.pass mf[[1L]] <- quote(stats::model.frame) frm <- eval.parent(mf) ## <- including "..." data[["(weights)"]] <- model.weights(frm) data[["(offset)"]] <- model.offset(frm) mform <- modelFormula(formula) isGLM <- !missing(family) ## TODO in future, consider isNLM / isNLS groups <- eval(mform$groups, frm) if (!is.factor(groups)) groups <- factor(groups) fit <- if (isGLM) glm else lm mf2 <- if (missing(family)) NULL else list(family=family) fitfun <- function(data, formula) { tryCatch({ do.call(fit, c(list(formula, data, ## don't use model.offset()/model.weights from stats() - warning with tibbles weights = data[["(weights)"]], offset = data[["(offset)"]], ...), mf2)) }, error = function(x) x) } ## split *original data*, not frm (derived model frame), on groups ## we have to do this because we need raw, not derived variables ## when evaluating linear regression. ## need to apply subset first ((or even much earlier ??)) ## (hope there aren't tricky interactions with NAs in subset ... ??) if (!missing(subset)) { data <- eval(substitute(data[subset,]), list2env(data)) } frm.split <- split(data, groups) ## NB: levels() is only OK if grouping variable is a factor nms <- names(frm.split) val <- ## mapply(fitfun, lapply(frm.split, fitfun, formula = as.formula(mform$model)) ## use warnErrList(), but expand msg for back compatibility and user-friendliness: val <- warnErrList(val, warn = FALSE) ## Contrary to nlme, we keep the erronous ones as well (with a warning): if(warn && length(wMsg <- attr(val,"warningMsg"))) { if(grepl("contrasts.* factors? .* 2 ", wMsg)){ # try to match translated msg, too warning("Fitting failed for ", sum(vapply(val, is.null, NA)), " group(s), probably because a factor only had one level", sub(".*:", ":\n ", wMsg), domain=NA) } else warning(wMsg, domain=NA) } val <- new("lmList4", setNames(val, nms), call = mCall, pool = pool, groups = ordered(groups), origOrder = match(unique(as.character(groups)), nms) ) attr(val, "groupsForm") <- reformulate(ff) val } ## (currently hidden) auxiliaries isGLMlist <- function(object, ...) { D <- getDataPart(object) length(D) >= 1 && inherits(D[[1]], "glm") } ## does a glm family have a "scale" [from stats:::logLik.glm() ] : .hasScale <- function(family) family %in% c("gaussian", "Gamma", "inverse.gaussian") family2char <- function(fam) { if(is.function(fam)) fam()$family else if(!is.character(fam)) fam$family else fam } ##' Does a lmList4 object have a "scale" / sigma / useScale ? hasScale <- function(object) !isGLMlist(object) || .hasScale(family(object[[1]])$family) ##' @importFrom stats coef ##' @S3method coef lmList4 ## Extract the coefficients and form a data.frame if possible ## FIXME: commented out nlme stuff (augFrame etc.). Restore, or delete for good ## FIXME: modified so that non-estimated values will be NA rather than set to ## coefs of first non-null estimate. Is that OK?? coef.lmList4 <- function(object, ## augFrame = FALSE, data = NULL, ##which = NULL, FUN = mean, omitGroupingFactor = TRUE, ...) { coefs <- lapply(object, coef) non.null <- !vapply(coefs, is.null, logical(1)) if (any(non.null)) { template <- coefs[non.null][[1]] ## different parameter sets may be estimated for different subsets of data ... allnames <- Reduce(union, lapply(coefs[non.null], names)) if (is.numeric(template)) { co <- matrix(NA_real_, ncol = length(allnames), nrow = length(coefs), dimnames = list(names(object), allnames)) for (i in names(object)) { co[i,names(coefs[[i]])] <- coefs[[i]] } coefs <- as.data.frame(co) effectNames <- names(coefs) ## if(augFrame) { ## if (is.null(data)) { ## data <- getData(object) ## } ## data <- as.data.frame(data) ## if (is.null(which)) { ## which <- 1:ncol(data) ## } ## data <- data[, which, drop = FALSE] ## ## eliminating columns with same names as effects ## data <- data[, is.na(match(names(data), effectNames)), drop = FALSE] ## data <- gsummary(data, FUN = FUN, groups = getGroups(object)) ## if (omitGroupingFactor) { ## data <- data[, is.na(match(names(data), ## names(getGroupsFormula(object, ## asList = TRUE)))), ## drop = FALSE] ## } ## if (length(data) > 0) { ## coefs <- cbind(coefs, data[row.names(coefs),,drop = FALSE]) ## } ## } attr(coefs, "level") <- attr(object, "level") attr(coefs, "label") <- "Coefficients" attr(coefs, "effectNames") <- effectNames attr(coefs, "standardized") <- FALSE } ## is.numeric(template) } coefs } ### FIXME?: nlme *does* export this -- we export sigma() [instead ?] pooledSD <- function(x, allow.0.df = TRUE) { stopifnot(is(x, "lmList4")) if(!hasScale(x)) { if(allow.0.df) return(structure(1, df = NA)) ## scale := 1 if(!useScale) ## else stop("no scale, hence no pooled SD for this object") } sumsqr <- rowSums(sapply(x, function(el) { if (is.null(el)) { c(0,0) } else { res <- resid(el) c(sum(res^2), df.residual(el)) } })) if (sumsqr[2] == 0) { ## FIXME? rather return NA with a warning ?? stop("No degrees of freedom for estimating std. dev.") } val <- sqrt(sumsqr[1]/sumsqr[2]) attr(val, "df") <- sumsqr[2] val } sigma.lmList4 <- function(object, ...) if(hasScale(object)) as.vector(pooledSD(object)) else 1 ## 1 for GLM <==> 1 when useScale is FALSE for [G]LMMs ##' @importFrom methods show ##' @exportMethod show setMethod("show", "lmList4", function(object) { mCall <- object@call cat("Call:", deparse(mCall), "\n") cat("Coefficients:\n") print(coef(object)) if (object@pool) { cat("\n") poolSD <- pooledSD(object) dfRes <- attr(poolSD, "df") RSE <- c(poolSD) cat("Degrees of freedom: ", length(unlist(lapply(object, fitted))), " total; ", dfRes, " residual\n", sep = "") cat("Residual standard error:", format(RSE)) cat("\n") } }) ##' @S3method confint lmList4 confint.lmList4 <- function(object, parm, level = 0.95, ...) { mCall <- match.call() if (length(object) < 1) return(new("lmList4.confint", array(numeric(0), c(0,0,0)))) mCall$object <- object[[1]] ## the old recursive strategy doesn't work with S3 objects -- ## calls "confint.lmList4" again instead of calling "confint" mCall[[1]] <- quote(confint) template <- eval(mCall) if(is.null(d <- dim(template))) ## MASS:::confint.profile.glm() uses drop(), giving vector d <- dim(template <- rbind("(Intercept)" = template)) template[] <- NA_real_ val <- array(template, c(d, length(object)), c(dimnames(template), list(names(object)))) pool <- list(...)$pool if (is.null(pool)) pool <- object$pool if (length(pool) > 0 && pool[1]) { ## do our own sd <- pooledSD(object) a <- (1 - level)/2 fac <- sd * qt(c(a, 1 - a), attr(sd, "df")) parm <- dimnames(template)[[1]] for (i in seq_along(object)) if(!is.null(ob.i <- object[[i]])) val[ , , i] <- coef(ob.i)[parm] + sqrt(diag(summary(object[[i]], corr = FALSE)$cov.unscaled )[parm]) %o% fac } else { ## build on confint() method for "glm" / "lm" : for (i in seq_along(object)) if(!is.null(mCall$object <- object[[i]])) { ci <- eval(mCall) if(is.null(dim(ci))) ## MASS:::confint.profile.glm() ... ci <- rbind("(Intercept)" = ci) if(identical(dim(ci), d)) val[ , , i] <- ci else ## some coefficients were not estimable val[rownames(ci), , i] <- ci } } new("lmList4.confint", aperm(val, 3:1)) } ##' @importFrom graphics plot ##' @importFrom lattice ....... ##' @S3method plot lmList4.confint plot.lmList4.confint <- function(x, y, order, ...) { ## stopifnot(require("lattice")) arr <- as(x, "array") dd <- dim(arr) dn <- dimnames(arr) levs <- dn[[1]] if (!missing(order) && (ord <- round(order[1])) %in% seq(dd[3])) levs <- levs[order(rowSums(arr[ , , ord]))] ll <- length(arr) df <- data.frame(group = ordered(rep(dn[[1]], dd[2] * dd[3]), levels = levs), intervals = as.vector(arr), what = gl(dd[3], dd[1] * dd[2], length = ll, labels = dn[[3]]), end = gl(dd[2], dd[1], length = ll)) panelfun <- function(x, y, pch = dot.symbol$pch, col = dot.symbol$col, cex = dot.symbol$cex, font = dot.symbol$font, ...) { x <- as.numeric(x) y <- as.numeric(y) ok <- !is.na(x) & !is.na(y) yy <- y[ok] xx <- x[ok] dot.symbol <- trellis.par.get("dot.symbol") dot.line <- trellis.par.get("dot.line") panel.abline(h = yy, lwd = dot.line$lwd, lty = dot.line$lty, col = dot.line$col) lpoints(xx, yy, pch = "|", col = col, cex = cex, font = font, ...) lower <- tapply(xx, yy, min) upper <- tapply(xx, yy, max) nams <- as.numeric(names(lower)) lsegments(lower, nams, upper, nams, col = col, lty = 1, lwd = if (dot.line$lwd) { dot.line$lwd } else { 2 }) } dotplot(group ~ intervals | what, data = df, scales = list(x="free"), panel=panelfun, ...) } ##' @importFrom stats update ##' @S3method update lmList4 update.lmList4 <- function(object, formula., ..., evaluate = TRUE) { call <- object@call if (is.null(call)) stop("need an object with call slot") extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) call$formula <- update.formula(formula(object), formula.) if (length(extras) > 0) { 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 } ##' @importFrom stats formula ##' @S3method formula lmList4 ##' @return of class "formula" ==> as.formula() rather than just [["formula"]] formula.lmList4 <- function(x, ...) structure(x@call[["formula"]], class = "formula") ##' Get the grouping factor of an "lmList4" object ##' Important as auxiliary method for many of the nlme-imported methods: getGroups.lmList4 <- function(object, ...) object@groups ### All the other "lmList4" S3 methods are imported from nmle : ## .ns.nlme <- asNamespace("nlme") .ns.lme4 <- environment() ## == asNamespace("lme4") during build/load ## ## To do this, we need to make them use *our* namespace, e.g. to use our pooledSD() ## However, then we get from codetools : ## ## fitted.lmList4: no visible global function definition for 'getGroups' ## pairs.lmList4: no visible global function definition for 'gsummary' ## pairs.lmList4: no visible global function definition for 'getGroups' ## plot.lmList4: no visible global function definition for 'c_deparse' ## plot.lmList4: no visible global function definition for 'getGroups' ## predict.lmList4: no visible global function definition for 'getGroups' ## print.lmList4: no visible global function definition for 'c_deparse' ## qqnorm.lmList4: no visible global function definition for 'getGroups' ## qqnorm.lmList4: no visible global function definition for 'gsummary' ## residuals.lmList4: no visible global function definition for 'getGroups' ## ## which we avoid via for(fn in c("gsummary", "c_deparse")) { if (exists(fn, envir = .ns.nlme)) { assign(fn, get(fn, envir = .ns.nlme, inherits=FALSE)) } } for(fn in c("fitted", "fixef", "logLik", "pairs", "plot", "predict", ## "print", <- have our own show() "qqnorm", "ranef", "residuals", "summary")) { meth <- get(paste(fn, "lmList", sep="."), envir = .ns.nlme, inherits=FALSE) environment(meth) <- .ns.lme4 # e.g. in order to use *our* pooledSD() assign(paste(fn, "lmList4", sep="."), meth) } rm(fn) lme4/R/utilities.R0000644000176200001440000013421715206621104013457 0ustar liggesuserslme4_specials <- c("us", "diag", "cs", "ar1") ## From Matrix package isDiagonal(.) : all0 <- function(x) !anyNA(x) && all(!x) .isDiagonal.sq.matrix <- function(M, n = dim(M)[1L]) all0(M[rep_len(c(FALSE, rep.int(TRUE,n)), n^2)]) ### Utilities for parsing and manipulating mixed-model formulas ## abbreviated parse for long strings: deparse1() pastes w/ collapse instead abbrDeparse <- function(x, width=60) { r <- deparse(x, width) if(length(r) > 1) paste(r[1], "...") else r } ##' @param bars result of findbars barnames <- function(bars) vapply(bars, function(x) deparse1(x[[3]]), "") makeFac <- function(x,char.only=FALSE) { if (!is.factor(x) && (!char.only || is.character(x))) factor(x) else x } factorize <- function(x,frloc,char.only=FALSE) { ## convert grouping variables to factors as necessary ## TODO: variables that are *not* in the data frame are ## not converted -- these could still break, e.g. if someone ## tries to use the : operator ## TODO: some sensible tests for drop.unused.levels ## (not actually used, but could come in handy) for (i in all.vars(RHSForm(x))) { if (!is.null(curf <- frloc[[i]])) frloc[[i]] <- makeFac(curf,char.only) } return(frloc) } colSort <- function(x) { termlev <- vapply(strsplit(x,":"),length,integer(1)) iterms <- split(x,termlev) iterms <- sapply(iterms,sort,simplify=FALSE) ## make sure intercept term is first ilab <- "(Intercept)" if (ilab %in% iterms[[1]]) { iterms[[1]] <- c(ilab,setdiff(iterms[[1]],ilab)) } unlist(iterms) } ## copied from glmmTMB, replace by upstream utility package? ## test formula: does it contain a particular element? ## inForm(z~.,quote(.)) ## inForm(z~y,quote(.)) ## inForm(z~a+b+c,quote(c)) ## inForm(z~a+b+(d+e),quote(c)) ## f <- ~ a + offset(x) ## f2 <- z ~ a ## inForm(f,quote(offset)) ## inForm(f2,quote(offset)) ## @export ## @keywords internal inForm <- function(form,value) { if (any(sapply(form,identical,value))) return(TRUE) if (all(sapply(form,length)==1)) return(FALSE) return(any(vapply(form,inForm,value,FUN.VALUE=logical(1)))) } ## was called "replaceForm" there but replaceTerm is better ## (decide on camelCase vs snake_case!) replaceTerm <- function(term,target,repl) { if (identical(term,target)) return(repl) if (!inForm(term,target)) return(term) if (length(term) == 2) { return(substitute(OP(x),list(OP=replaceTerm(term[[1]],target,repl), x=replaceTerm(term[[2]],target,repl)))) } return(substitute(OP(x,y),list(OP=replaceTerm(term[[1]],target,repl), x=replaceTerm(term[[2]],target,repl), y=replaceTerm(term[[3]],target,repl)))) } `%i%` <- function(f1, f2, fix.order = TRUE) { if (!is.factor(f1) || !is.factor(f2)) stop("both inputs must be factors") f12 <- paste(f1, f2, sep = ":") ## explicitly specifying levels is faster in any case ... u <- which(!duplicated(f12)) if (!fix.order) return(factor(f12, levels = f12[u])) ## deal with order of factor levels levs_rank <- length(levels(f2))*as.numeric(f1[u])+as.numeric(f2[u]) return(factor(f12, levels = (f12[u])[order(levs_rank)])) } ##' @param x a language object of the form effect | groupvar ##' @param frloc model frame ##' @param drop.unused.levels (logical) ##' @return list containing grouping factor, sparse model matrix, number of levels, names mkBlist <- function(x,frloc, drop.unused.levels=TRUE, reorder.vars=FALSE) { frloc <- factorize(x,frloc) ## try to evaluate grouping factor within model frame ... ff0 <- replaceTerm(x[[3]], quote(`:`), quote(`%i%`)) ff <- try(eval(substitute(makeFac(fac), list(fac = ff0)), frloc), silent = TRUE) if (inherits(ff, "try-error")) { stop("couldn't evaluate grouping factor ", deparse1(x[[3]])," within model frame:", "error =", c(ff), " Try adding grouping factor to data ", "frame explicitly if possible",call.=FALSE) } if (all(is.na(ff))) stop("Invalid grouping factor specification, ", deparse1(x[[3]]),call.=FALSE) ## NB: *also* silently drops levels - and mkReTrms() and hence ## predict.merMod() have relied on that property : if (drop.unused.levels) ff <- factor(ff, exclude=NA) nl <- length(levels(ff)) ## this section implements eq. 6 of the JSS lmer paper ## model matrix based on LHS of random effect term (X_i) ## x[[2]] is the LHS (terms) of the a|b formula has.sparse.contrasts <- function(x) { cc <- attr(x, "contrasts") !is.null(cc) && is(cc, "sparseMatrix") } any.sparse.contrasts <- any(vapply(frloc, has.sparse.contrasts, FUN.VALUE = TRUE)) mMatrix <- if (!any.sparse.contrasts) model.matrix else sparse.model.matrix mm <- mMatrix(eval(substitute( ~ foo, list(foo = x[[2]]))), frloc) if (reorder.vars) { mm <- mm[colSort(colnames(mm)),] } ## this is J^T (see p. 9 of JSS lmer paper) ## construct indicator matrix for groups by observations ## use fac2sparse() rather than as() to allow *not* dropping ## unused levels where desired sm <- fac2sparse(ff, to = "d", drop.unused.levels = drop.unused.levels) sm <- KhatriRao(sm, t(mm)) dimnames(sm) <- list( rep(levels(ff),each=ncol(mm)), rownames(mm)) list(ff = ff, sm = sm, nl = nl, cnms = colnames(mm)) } ##' Create an lmerResp, glmResp or nlsResp instance ##' ##' @title Create an lmerResp, glmResp or nlsResp instance ##' @param fr a model frame ##' @param REML logical scalar, value of REML for an lmerResp instance ##' @param family the optional glm family (glmResp only) ##' @param nlenv the nonlinear model evaluation environment (nlsResp only) ##' @param nlmod the nonlinear model function (nlsResp only) ##' @param ... where to look for response information if \code{fr} is missing. ##' Can contain a model response, \code{y}, offset, \code{offset}, and weights, ##' \code{weights}. ##' @return an lmerResp or glmResp or nlsResp instance ##' @family utilities ##' @export mkRespMod <- function(fr, REML=NULL, family = NULL, nlenv = NULL, nlmod = NULL, ...) { if(!missing(fr)) { y <- model.response(fr) offset <- model.offset(fr) weights <- model.weights(fr) N <- n <- nrow(fr) etastart_update <- model.extract(fr, "etastart") mustart_update <- model.extract(fr, "mustart") } else { fr <- list(...) y <- fr$y N <- n <- NROW(y) offset <- fr$offset weights <- fr$weights etastart_update <- fr$etastart mustart_update <- fr$mustart } if(length(dim(y)) == 1L) y <- drop(y) ## avoid problems with 1D arrays and keep names if(isGLMM <- !is.null(family)) stopifnot(inherits(family, "family")) ## FIXME: may need to add X, or pass it somehow, if we want to use glm.fit ## test for non-numeric response here to avoid later ## confusing error messages from deeper machinery if (!is.null(y)) { ## 'y' may be NULL if we're doing simulation if(!(is.numeric(y) || ((is.binom <- isGLMM && family$family == "binomial") && (is.factor(y) || is.logical(y))))) { if (is.binom) stop("response must be numeric or factor") else { if (is.logical(y)) y <- as.integer(y) else stop("response must be numeric") } } if(!all(is.finite(y))) stop("NA/NaN/Inf in 'y'") # same msg as from lm.fit() } rho <- new.env() rho$y <- if (is.null(y)) numeric(0) else y if (!is.null(REML)) rho$REML <- REML rho$etastart <- etastart_update rho$mustart <- mustart_update rho$start <- attr(fr,"start") if (!is.null(nlenv)) { stopifnot(is.language(nlmod), is.environment(nlenv), is.numeric(val <- eval(nlmod, nlenv)), length(val) == n, ## FIXME? Restriction, not present in ole' nlme(): is.matrix(gr <- attr(val, "gradient")), is.numeric(gr), nrow(gr) == n, !is.null(pnames <- colnames(gr))) N <- length(gr) rho$mu <- as.vector(val) rho$sqrtXwt <- as.vector(gr) rho$gam <- ## FIXME more efficient mget(pnames, envir=nlenv) unname(unlist(lapply(pnames, function(nm) get(nm, envir=nlenv)))) } rho$offset <- if (!is.null(offset)) { if (length(offset) == 1L) offset <- rep.int(offset, N) else stopifnot(length(offset) == N) unname(offset) } else rep.int(0, N) rho$weights <- if (!is.null(weights)) { stopifnot(length(weights) == n, all(weights >= 0)) unname(weights) } else rep.int(1, n) if(isGLMM) { ## need weights for initializing evaluation rho$nobs <- n ## allow trivial objects, e.g. for simulation if (length(y)>0) eval(family$initialize, rho) ## ugh. this *is* necessary; ## family$initialize *ignores* mustart in env, overwrites! ## see ll 180-182 of src/library/stats/R/glm.R ## https://github.com/wch/r-source/search?utf8=%E2%9C%93&q=mukeep if (!is.null(mustart_update)) rho$mustart <- mustart_update ## For Gamma family, replace mustart (= y) with mean(y) to improve PIRLS stability. ## Using mustart = y causes PIRLS divergence for small shape parameters (e.g. shape < 0.2) ## because E[log(y)] <= log(E[y]) (Jensen's inequality): the OLS fit of log(y) ~ X gives ## coefficients implying exp(fitted) <= y (optimizes on wrong target) else if (family$family == "Gamma" && is.null(etastart_update) && length(y) > 0) { rho$mustart[] <- mean(rho$mustart) } ## family$initialize <- NULL # remove clutter from str output ll <- as.list(rho) ans <- do.call(new, c(list(Class="glmResp", family=family), ll[setdiff(names(ll), c("m", "nobs", "mustart"))])) if (length(y)>0) ans$updateMu(if (!is.null(es <- etastart_update)) es else family$linkfun(rho$mustart)) ans } else if (is.null(nlenv)) ## lmer do.call(lmerResp$new, as.list(rho)) else ## nlmer do.call(nlsResp$new, c(list(nlenv=nlenv, nlmod=substitute(~foo, list(foo=nlmod)), pnames=pnames), as.list(rho))) } subnms <- function(form, nms) { ## Recursive function applied to individual terms sbnm <- function(term) { if (is.name(term)) { if (any(term == nms)) 0 else term } else switch(length(term), term, ## 1 { ## 2 term[[2]] <- sbnm(term[[2]]) term }, { ## 3 term[[2]] <- sbnm(term[[2]]) term[[3]] <- sbnm(term[[3]]) term }) } sbnm(form) } ##' Check for a constant term (a literal 1) in an expression ## ##' In the mixed-effects part of a nonlinear model formula, a constant ##' term is not meaningful because every term must be relative to a ##' nonlinear model parameter. This function recursively checks the ##' expressions in the formula for a a constant, calling stop() if ##' such a term is encountered. ##' @title Check for constant terms. ##' @param expr an expression ##' @return NULL. The function is executed for its side effect. chck1 <- function(expr) { if ((le <- length(expr)) == 1) { if (is.numeric(expr) && expr == 1) stop("1 is not meaningful in a nonlinear model formula") return() } else for (j in seq_len(le)[-1]) Recall(expr[[j]]) } ## ---> ../man/nlformula.Rd --- Manipulate a nonlinear model formula ##' @param mc matched call from the caller, with arguments 'formula','start',... ##' @return a list with components "respMod", "frame", "X", "reTrms" nlformula <- function(mc) { start <- eval(mc$start, parent.frame(2L)) if (is.numeric(start)) start <- list(nlpars = start) stopifnot(is.numeric(nlpars <- start$nlpars), lengths(nlpars) == 1L, length(pnames <- names(nlpars)) == length(nlpars), length(form <- as.formula(mc$formula)) == 3L, is(nlform <- eval(form[[2]]), "formula"), pnames %in% all.vars(nlmod <- as.call(nlform[[lnl <- length(nlform)]]))) ## MM{FIXME}: fortune(106) even twice in here! nlform[[lnl]] <- parse(text= paste(setdiff(all.vars(form), pnames), collapse=' + '))[[1]] nlform <- eval(nlform) environment(nlform) <- environment(form) m <- match(c("data", "subset", "weights", "na.action", "offset"), names(mc), 0) mc <- mc[c(1, m)] mc$drop.unused.levels <- TRUE mc[[1L]] <- quote(stats::model.frame) mc$formula <- nlform fr <- eval(mc, parent.frame(2L)) n <- nrow(fr) nlenv <- list2env(fr, parent=parent.frame(2L)) lapply(pnames, function(nm) nlenv[[nm]] <- rep.int(nlpars[[nm]], n)) respMod <- mkRespMod(fr, nlenv=nlenv, nlmod=nlmod) chck1(meform <- form[[3L]]) pnameexpr <- parse(text=paste(pnames, collapse='+'))[[1]] formula <- as.formula(substitute(~0 + (pnameexpr) + (meform)), env = environment(form)) ## substitute special(x | f) with (x | f) fr.form. <- noSpecials(formula, specials = lme4_specials, delete = FALSE) ## substitute (x | f) and (x || f) with (x + f) fr.form <- sub_specials(fr.form., specials = c("|", "||"), keep_args = c(2L, 2L)) environment(fr.form.) <- environment(fr.form) <- environment(formula) fixedform <- fr.form. RHSForm(fixedform) <- reformulas::nobars(RHSForm(fixedform)) frE <- do.call(rbind, lapply(seq_along(nlpars), function(i) fr)) # rbind s copies of the frame for (nm in pnames) # convert these variables in fr to indicators frE[[nm]] <- as.numeric(rep(nm == pnames, each = n)) X <- model.matrix(fixedform, frE) rownames(X) <- NULL ## get list of calls whose first argument is a call to '|' ## x | f -> us(x | f) ## nonspecial(x | f) -> us(x | f) ## special(x | f) -> special(x | f) bb1 <- findbars_x(formula, specials = lme4_specials, default.special = "us", target = "|", expand_doublevert_method = getDoublevertDefault()) bb0 <- lapply(bb1, function(call) { call <- call[[2L]] call[[2L]] <- substitute(0 + (foo), list(foo = call[[2L]])) call }) reTrms <- reformulas::mkReTrms(bb0, frE, calc.lambdat = FALSE) bb1 <- bb1[reTrms$ord] # reorder to match mkReTrms internal ordering reTrms <- upReTrms(reTrms, bb1) # local calc.lambdat=TRUE step list(respMod=respMod, frame=fr, X=X, reTrms=reTrms, pnames=pnames) } ## {nlformula} ################################################################################ ## Beginning to think about exposing tools to create devcomp lists. ## Could be useful when extending merMod objects. Commenting them out ## however, because R CMD check is complaining: ## https://github.com/lme4/lme4/commit/8d71e439758999ea8f90eb4752487e189407ef33#commitcomment-8773017 ################################################################################ ## ## .dims <- function(pp, resp, nAGQ, ## reTrms, n, p, rcl, ## compDev = NULL) { ## if(missing(rcl)) rcl <- class(resp) ## if(missing(n)) n <- nrow(pp$V) ## if(missing(p)) p <- ncol(pp$V) ## c(N=nrow(pp$X), n=n, p=p, nmp=n-p, ## nth=length(pp$theta), q=nrow(pp$Zt), ## nAGQ=rho$nAGQ, ## compDev=rho$compDev, ## ## 'use scale' in the sense of whether dispersion parameter should ## ## be reported/used (*not* whether theta should be scaled by sigma) ## useSc=(rcl != "glmResp" || ## !resp$family$family %in% c("poisson","binomial")), ## reTrms=length(reTrms$cnms), ## spFe=0L, ## REML=if (rcl=="lmerResp") resp$REML else 0L, ## GLMM=(rcl=="glmResp"), ## NLMM=(rcl=="nlsResp")) ## } ## ## .cmp <- function(pp, resp, dims, fval, ## wrss, sqrLenU, pwrss, ## sigmaML, rcl, fac, ## tolPwrss = NULL, ## trivial.y = FALSE) { ## if(missing(rcl)) rcl <- class(resp) ## if(missing(fac)) fac <- as.numeric(rcl != "nlsResp") ## if(missing(wrss)) wrss <- resp$wrss() ## if(missing(sqrLenU)) sqrLenU <- pp$sqrL(fac) ## if(missing(pwrss)) pwrss <- wrss + sqrLenU ## if(missing(sigmaML)) sigmaML <- pwrss/dims[["n"]] ## c(ldL2=pp$ldL2(), ldRX2=pp$ldRX2(), wrss=wrss, ## ussq=sqrLenU, pwrss=pwrss, ## drsum=if (rcl=="glmResp" && !trivial.y) resp$resDev() else NA, ## REML=if (rcl=="lmerResp" && resp$REML != 0L && !trivial.y) ## opt$fval else NA, ## ## FIXME: construct 'REML deviance' here? ## dev=if (rcl=="lmerResp" && resp$REML != 0L || trivial.y) NA else opt$fval, ## sigmaML=sqrt(unname(if (!dims[["useSc"]] || trivial.y) NA else sigmaML)), ## sigmaREML=sqrt(unname(if (rcl!="lmerResp" || trivial.y) NA else sigmaML*(dims[["n"]]/dims[["nmp"]]))), ## tolPwrss=rho$tolPwrss) ## } ################################################################################ .minimalOptinfo <- function() list(conv = list(opt = 0L, lme4 = list(messages = character(0)))) getConv <- function(x) { if (!is.null(x[["conv"]])) { x[["conv"]] } else x[["convergence"]] } getMsg <- function(x) { if (!is.null(x[["msg"]])) { x[["msg"]] } else if (!is.null(x[["message"]])) { x[["message"]] } else "" } .optinfo <- function(opt, lme4conv=NULL) list(optimizer = attr(opt, "optimizer"), control = attr(opt, "control"), derivs = attr(opt, "derivs"), conv = list(opt = getConv(opt), lme4 = lme4conv), feval = if (is.null(opt$feval)) NA else opt$feval, message = getMsg(opt), warnings = attr(opt, "warnings"), val = opt$par) ##' Potentially needed in more than one place, be sure to keep consistency! ##' hack (NB families have weird names) from @aosmith16; then corrected isNBfamily <- function(familyString) grepl("^Negative ?Binomial", familyString, ignore.case=TRUE) normalizeFamilyName <- function(family) { # such as object@resp$family if(isNBfamily(family$family)) family$family <- "negative.binomial" family } ##' Is it a family with no scale parameter hasNoScale <- function(family) any(substr(family$family, 1L, 12L) == c("poisson", "binomial", "negative.bin", "Negative Bin")) ##--> ../man/mkMerMod.Rd ---Create a merMod object ##' @param rho the environment of the objective function ##' @param opt the value returned by the optimizer ##' @param reTrms reTrms list from the calling function mkMerMod <- function(rho, opt, reTrms, fr, mc, lme4conv=NULL) { if(missing(mc)) mc <- match.call() stopifnot(is.environment(rho), is(pp <- rho$pp, "merPredD"), is(resp <- rho$resp, "lmResp"), is.list(opt), "par" %in% names(opt), c("conv", "fval") %in% substr(names(opt),1,4), ## "conv[ergence]", "fval[ues]" is.list(reTrms), c("flist", "cnms", "Gp", "lower") %in% names(reTrms), length(rcl <- class(resp)) == 1) n <- nrow(pp$V) p <- ncol(pp$V) isGLMM <- (rcl == "glmResp") dims <- c(N = nrow(pp$X), n=n, p=p, nmp = n-p, q = nrow(pp$Zt), nth = length(pp$theta), nAGQ= rho$nAGQ, compDev=rho$compDev, ## 'use scale' in the sense of whether dispersion parameter should ## be reported/used (*not* whether theta should be scaled by sigma) useSc = !(isGLMM && hasNoScale(resp$family)), reTrms=length(reTrms$cnms), spFe= 0L, REML = if (rcl=="lmerResp") resp$REML else 0L, GLMM= isGLMM, NLMM= (rcl=="nlsResp"), npar= length(reTrms$lower)) storage.mode(dims) <- "integer" fac <- as.numeric(rcl != "nlsResp") if (trivial.y <- (length(resp$y)==0)) { ## trivial model sqrLenU <- wrss <- pwrss <- NA } else { sqrLenU <- pp$sqrL(fac) wrss <- resp$wrss() pwrss <- wrss + sqrLenU } ## weights <- resp$weights beta <- pp$beta(fac) sigmaML <- pwrss/n if (rcl != "lmerResp") { pars <- opt$par ## making the assertion that length(pars) > npar iff nAGQ > 0; ## skip when pars=NA (simulate path uses a placeholder opt) ## expected pars: add # fixed pars to # opt pars if nAGQ>0 expected_par_length <- dims[["npar"]] + as.numeric(dims[["nAGQ"]]>0L)*dims[["p"]] if (!anyNA(pars) && (length(pars) != expected_par_length)) { stop(sprintf("unexpected parameter vector length: length(pars)=%d, npar=%d, nAGQ=%d; ", length(pars), dims[["npar"]], dims[["nAGQ"]]), "(expected length(pars)==npar iff nAGQ==0)") } ## For structured covariance models (e.g., ar1), npar = length(reTrms$lower) ## may be less than length(pp$theta), so we use dims[["npar"]] to index correctly. if (dims[["nAGQ"]] > 0L) beta <- pars[-seq_len(dims[["npar"]])] } cmp <- c(ldL2=pp$ldL2(), ldRX2=pp$ldRX2(), wrss=wrss, ussq=sqrLenU, pwrss=pwrss, drsum=if (rcl=="glmResp" && !trivial.y) resp$resDev() else NA, REML=if (rcl=="lmerResp" && resp$REML != 0L && !trivial.y) opt$fval else NA, ## FIXME: construct 'REML deviance' here? dev=if (rcl=="lmerResp" && resp$REML != 0L || trivial.y) NA else opt$fval, sigmaML=sqrt(unname(if (!dims[["useSc"]] || trivial.y) NA else sigmaML)), sigmaREML=sqrt(unname(if (rcl!="lmerResp" || trivial.y) NA else sigmaML*(dims[["n"]]/dims[["nmp"]]))), tolPwrss=rho$tolPwrss) ## TODO: improve this hack to get something in frame slot (maybe need weights, etc...) if(missing(fr)) fr <- data.frame(resp$y) ans <- new(switch(rcl, lmerResp = "lmerMod", glmResp = "glmerMod", nlsResp = "nlmerMod"), call=mc, frame=fr, flist=reTrms$flist, cnms=reTrms$cnms, Gp=reTrms$Gp, theta=pp$theta, beta=beta, u=if (trivial.y) rep(NA_real_,nrow(pp$Zt)) else pp$u(fac), lower=reTrms$lower, devcomp=list(cmp=cmp, dims=dims), pp=pp, resp=resp, optinfo = .optinfo(opt, lme4conv)) attr(ans, "upper") <- reTrms$upper %||% rep(Inf, length(reTrms$lower)) attr(ans, "reCovs") <- upReCovs(reTrms$reCovs %||% getReCovs(ans), rho$pp$theta) ans }## {mkMerMod} ## generic argument checking ## 'type': name of calling function ("glmer", "lmer", "nlmer") ## ## NB: called from lFormula() and glFormula() checkArgs <- function(type,...) { l... <- list(...) if (isTRUE(l...[["sparseX"]])) warning("sparseX = TRUE has no effect at present",call.=FALSE) ## '...' handling up front, safe-guarding against typos ("familiy") : if(length(l... <- list(...))) { if (!is.null(l...[["family"]])) { # call glmer if family specified ## we will only get here if 'family' is *not* in the arg list warning("calling lmer with family() is deprecated: please use glmer() instead",call.=FALSE) type <- "glmer" } ## Check for method argument which is no longer used ## (different meanings/hints depending on glmer vs lmer) if (!is.null(l...[["method"]])) { msg <- paste("Argument", sQuote("method"), "is deprecated.") if (type == "lmer") msg <- paste(msg, "Use the REML argument to specify ML or REML estimation.") else if (type == "glmer") msg <- paste(msg, "Use the nAGQ argument to specify Laplace (nAGQ=1) or adaptive", "Gauss-Hermite quadrature (nAGQ>1). PQL is no longer available.") warning(msg,call.=FALSE) l... <- l...[names(l...) != "method"] } if(length(l...)) { warning("extra argument(s) ", paste(sQuote(names(l...)), collapse=", "), " disregarded",call.=FALSE) } } } ## check formula and data: return an environment suitable for evaluating ## the formula. ## (1) if data is specified, return it ## (2) otherwise, if formula has an environment, use it ## (3) otherwise [e.g. if formula was passed as a string], try to use parent.frame(2) ## if #3 is true *and* the user is doing something tricky with nested functions, ## this may fail ... ## try to diagnose missing/bad data checkFormulaData <- function(formula, data, checkLHS=TRUE, checkData=TRUE, debug=FALSE, calling_env = parent.frame(2L)) { wd <- tryCatch(force(data), error = identity) if (bad.data <- inherits(wd,"error")) { bad.data.msg <- wd$message } ## data not found (this *should* only happen with garbage input, ## OR when strings used as formulae -> drop1/update/etc.) ## if (bad.data || debug) { varex <- function(v, env) exists(v, envir=env, inherits=FALSE) allvars <- all.vars(as.formula(formula)) allvarex <- function(env, vvec=allvars) all(vapply(vvec, varex, NA, env)) } if (bad.data) { ## Choose helpful error message: if (allvarex(environment(formula))) { stop("bad 'data', but variables found in environment of formula: ", "try specifying 'formula' as a formula rather ", "than a string in the original model",call.=FALSE) } else { stop("bad 'data': ", bad.data.msg, call. = FALSE) } } else { denv <- ## The data as environment if (is.null(data)) { if (!is.null(ee <- environment(formula))) { ee ## use environment of formula } else { ## e.g. no environment, e.g. because formula is a character vector ## calling_env defaults to parent.frame(2L), which works when ## [g]lFormula (our old calling environment) was called within ## [g]lmer with env=parent.frame(1L). When called from inside ## mkFormula, the caller should pass parent_env explicitly so ## that the correct user-level frame is used. calling_env } } else ## data specified list2env(data) } ## ## FIXME: set enclosing environment of denv to environment(formula), or parent.frame(2L) ? if (debug) { cat("Debugging parent frames in checkFormulaData:\n") ## find global environment -- could do this with sys.nframe() ? glEnv <- 1L while (!identical(parent.frame(glEnv),.GlobalEnv)) { glEnv <- glEnv+1L } ## where are vars? for (i in 1:glEnv) { OK <- allvarex(parent.frame(i)) cat("vars exist in parent frame ", i) if (i == glEnv) cat(" (global)") cat(" ",OK, "\n") } cat("vars exist in env of formula ", allvarex(denv), "\n") } ## if (debug) stopifnot(!checkLHS || length(as.formula(formula,env=denv)) == 3) ## check for two-sided formula return(denv) } ## checkFormulaData <- function(formula,data) { ## ee <- environment(formula) ## if (is.null(ee)) { ## ee <- parent.frame(2) ## } ## if (missing(data)) data <- ee ## stopifnot(length(as.formula(formula,env=as.environment(data))) == 3) ## return(data) ## } ##' Not exported; for tests (and examples) that can be slow; ##' Use if(lme4:::testLevel() >= 1.) ..... see ../tests/README.md testLevel <- function() if(nzchar(s <- Sys.getenv("LME4_TEST_LEVEL")) && is.finite(s <- as.numeric(s))) s else 1 ##' General conditional variance-covariance matrix ##' ##' Experimental function for estimating the variance-covariance ##' matrix of the random effects, conditional on the observed data ##' and at the (RE)ML estimate of the fixed effects and covariance ##' parameters. Applicable for any Lambda matrix, but slower than ##' other block-by-block methods. ##' Not exported. ##' ##' TODO: ##' - Write up quick note on theory (e.g. Laplace approximation). ##' - Test. Speed? Correctness? ##' - Do we need to think carefully about the differences ##' between REML and ML, beyond just multiplying by a different ##' sigma^2 estimate? ##' - is it better to do this term-by-term as in C++ code? ##' ##' @param object \code{merMod} object ##' @return Sparse covariance matrix condVar <- function(object, scaled=TRUE) { Lamt <- getME(object, "Lambdat") L <- getME(object, "L") ## never do it this way! fortune("SOOOO") #V <- solve(L, system = "A") #V <- chol2inv(L) #s2*crossprod(Lamt, V) %*% Lamt LL <- solve(L, Lamt, system = "A") ## From ?Matrix::solve, The default, '"A"', is to solve Ax = b for x ## where 'A' is sparse, positive-definite matrix that was ## factored to produce 'a'. cc <- crossprod(Lamt, LL) if (scaled) cc <- sigma(object)^2*cc cc } mkMinimalData <- function(formula) { vars <- all.vars(formula) nVars <- length(vars) matr <- matrix(0, 2, nVars) data <- as.data.frame(matr) setNames(data, vars) } ##' Make template for mixed model parameters mkParsTemplate <- function(formula, data){ if(missing(data)) data <- mkMinimalData(formula) mfRanef <- model.frame( reformulas::subbars(formula), data) mmFixef <- model.matrix( reformulas::nobars(formula) , data) reTrms <- reformulas::mkReTrms( reformulas::findbars(formula), mfRanef) cnms <- reTrms$cnms thetaNamesList <- mapply(mkPfun(), names(cnms), cnms) thetaNames <- unlist(thetaNamesList) betaNames <- colnames(mmFixef) list(beta = setNames(numeric(length( betaNames)), betaNames), theta = setNames(reTrms$theta, thetaNames), sigma = 1) } ##' Make template for mixed model data ##' ##' Useful for simulating balanced designs and for ##' getting started on unbalanced simulations ##' ##' @param formula formula ##' @param data data -- not necessary ##' @param nGrps number of groups per grouping factor ##' @param rfunc function for generating covariate data ##' @param ... additional parameters for rfunc mkDataTemplate <- function(formula, data, nGrps = 2, nPerGrp = 1, rfunc = NULL, ...){ if(missing(data)) data <- mkMinimalData(formula) grpFacNames <- unique(barnames(reformulas::findbars(formula))) varNames <- all.vars(formula) covariateNames <- setdiff(varNames, grpFacNames) nGrpFac <- length(grpFacNames) nCov <- length(covariateNames) grpFac <- gl(nGrps, nPerGrp) grpDat <- expand.grid(replicate(nGrpFac, grpFac, simplify = FALSE)) colnames(grpDat) <- grpFacNames nObs <- nrow(grpDat) if(is.null(rfunc)) rfunc <- function(n, ...) rep(0, n) params <- c(list(nObs), list(...)) covDat <- as.data.frame(replicate(nCov, do.call(rfunc, params), simplify = FALSE)) colnames(covDat) <- covariateNames cbind(grpDat, covDat) } ##' very flexible and convenient wrt formula, ##' very unflexible wrt everything else ##' ##' starting to get a little too sugary? quickSimulate <- function(formula, nGrps, nPerGrp, family = gaussian) { pr <- mkParsTemplate(formula) dt <- mkDataTemplate(formula, nGrps = nGrps, nPerGrp = nPerGrp, rfunc = rnorm) response <- deparse(formula[[2]]) dt[[response]] <- simulate(formula, newdata = dt, newparams = pr, family = family)[[1]] return(dt) } #---------------------------------------------------------------------- # formula parsing sugar #---------------------------------------------------------------------- ##' these functions pick up where findbars leaves off, in terms of sugar ##' @param REtrm an element of the result of findbars ##' @param REtrms the result of findbars ##' @return \code{reexpr} gives a one-sided formula with the linear ##' model formula for the raw model matrix. \code{grpfact} gives an ##' expression with the name of the grouping factor associated with ##' the raw model matrix. \code{termnms} gives a character vector with ##' the names of the random effects terms. reexpr <- function(REtrm) substitute( ~ foo, list(foo = REtrm[[2]])) grpfact <- function(REtrm) substitute(factor(fac), list(fac = REtrm[[3]])) termnms <- function(REtrms) vapply(REtrms, deparse1, "") ##' mmList(): list of model matrices ##' ------ called from getME() & model.matrix(*, "randomListRaw") mmList <- function(object, ...) UseMethod("mmList") mmList.merMod <- function(object, ...) mmList(formula(object), model.frame(object)) mmList.formula <- function(object, frame, ...) { bars <- reformulas::findbars(object) mm <- setNames(lapply(bars, function(b) model.matrix(eval(reexpr(b), frame), frame)), termnms(bars)) grp <- lapply(lapply(bars, grpfact), eval, frame) nl <- vapply(grp, nlevels, 1L) if (any(diff(nl) > 0)) mm[order(nl, decreasing=TRUE)] else mm } ##' examples ---FIXME?--- put in tests // or export + 'real examples' if(FALSE) { library(lme4) m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) gm <- glmer(cbind(incidence, size-incidence) ~ period + (1|herd), cbpp, binomial) simForm <- y ~ x + z + (x | f) + (z | g) ## ::: triggers R CMD check NOTE ## simDat <- lme4:::quickSimulate(simForm, 10, 5) simDat <- simDat[simDat$f != "10", ] # unbalancedish design requiring # a flip in the order of terms sm <- lmer(simForm, simDat) ## ::: triggers R CMD check NOTE ## lme4:::mmList.merMod(m) ## lme4:::mmList.merMod(gm) ## smmm <- lme4:::mmList.merMod(sm) } nloptwrap <- local({ ## define default control values in environment of function ... defaultControl <- list(algorithm="NLOPT_LN_BOBYQA", xtol_abs=1e-8, ftol_abs=1e-8, maxeval=1e5) ## function(par, fn, lower, upper, control=list(),...) { for (n in names(defaultControl)) if (is.null(control[[n]])) control[[n]] <- defaultControl[[n]] res <- nloptr(x0=par, eval_f=fn, lb=lower, ub=upper, opts=control, ...) with(res, list(par = solution, fval = objective, feval = iterations, ## ?nloptr: "integer value with the status of the optimization (0 is success)" ## most status>0 are fine (e.g. 4 "stopped because xtol_rel was reached" ## but status 5 is "ran out of evaluations" conv = if (status<0 || status==5) status else 0, message = message)) } }) nlminbwrap <- function(par, fn, lower, upper, control=list(), ...) { if (!is.null(control$maxfun)) { control$eval.max <- control$maxfun control$maxfun <- NULL } res <- nlminb(start = par, fn, gradient = NULL, hessian = NULL, scale = 1, lower = lower, upper = upper, control = control, ...) list(par = res$par, fval = res$objective, conv = res$convergence, message = res$message) } glmerLaplaceHandle <- function(pp, resp, nAGQ, tol, maxit, verbose) { .Call(glmerLaplace, pp, resp, nAGQ, tol, as.integer(maxit), verbose) } isFlexLambda <- function() FALSE #' convert a list of matrices (n, pxp blocks) to a p x p x n array mlist_to_array <- function(m) { p <- nrow(m[[1]]) n <- length(m) array(unlist(lapply(m,as.matrix)),dim=c(p,p,n)) } #' @inheritParams bdiag_to_array bdiag_to_mlist <- function(m,n) { if (length(n)==1 && n 1) parallel <- match.arg(parallel) if (!is.null(cl)) { stopifnot(inherits(cl, "cluster")) parallel <- "snow" } else if (parallel == "multicore") { stopifnot(is.numeric(ncpus), length(ncpus) == 1L, is.finite(ncpus), ncpus >= 1L) if (.Platform$OS.type == "windows" || ncpus == 1L) parallel <- "no" } else if (parallel == "snow") { if (is.null(cl)) { stopifnot(is.numeric(ncpus), length(ncpus) == 1L, is.finite(ncpus), ncpus >= 1L) if (ncpus == 1L) parallel <- "no" } } else if (parallel == "future") { if (!requireNamespace("future.apply", quietly = TRUE)) { stop("parallel = \"future\" requires the 'future.apply' package - please install it") } } }) getSingTol <- function() getOption("lme4.singular.tolerance", 1e-4) lme4_testlevel <- function() if (nzchar(s <- Sys.getenv("LME4_TEST_LEVEL"))) as.numeric(s) else 1 # stolen from car package # the following unexported function is useful for combining results of parallel computations combineLists <- function(..., fmatrix="list", flist="c", fvector="rbind", fdf="rbind", recurse=FALSE){ # combine lists of the same structure elementwise # ...: a list of lists, or several lists, each of the same structure # fmatrix: name of function to apply to matrix elements # flist: name of function to apply to list elements # fvector: name of function to apply to data frame elements # recurse: process list element recursively frecurse <- function(...){ combineLists(..., fmatrix=fmatrix, fvector=fvector, fdf=fdf, recurse=TRUE) } if (recurse) flist="frecurse" list.of.lists <- list(...) if (length(list.of.lists) == 1){ list.of.lists <- list.of.lists[[1]] list.of.lists[c("fmatrix", "flist", "fvector", "fdf")] <- c(fmatrix, flist, fvector, fdf) return(do.call("combineLists", list.of.lists)) } if (any(!sapply(list.of.lists, is.list))) stop("arguments are not all lists") len <- sapply(list.of.lists, length) if (any(len[1] != len)) stop("lists are not all of the same length") nms <- lapply(list.of.lists, names) if (any(unlist(lapply(nms, "!=", nms[[1]])))) stop("lists do not all have elements of the same names") nms <- nms[[1]] result <- vector(len[1], mode="list") names(result) <- nms for(element in nms){ element.list <- lapply(list.of.lists, "[[", element) # clss <- sapply(element.list, class) clss <- lapply(element.list, class) # if (any(clss[1] != clss)) stop("list elements named '", element, if (!all(vapply(clss, function(e) all(e == clss[[1L]]), NA))) stop("list elements named '", element, "' are not all of the same class") is.df <- is.data.frame(element.list[[1]]) fn <- if (is.matrix(element.list[[1]])) fmatrix else if (is.list(element.list[[1]]) && !is.df) flist else if (is.vector(element.list[[1]])) fvector else if (is.df) fdf else stop("list elements named '", element, "' are not matrices, lists, vectors, or data frames") result[[element]] <- do.call(fn, element.list) } result } ## copied from glmmTMB::check_dots checkDots <- function (..., .ignore = NULL, .action = "stop") { L <- list(...) if (length(.ignore) > 0) { L <- L[!names(L) %in% .ignore] } if (length(L) > 0) { FUN <- get(.action) FUN("unknown arguments: ", paste(names(L), collapse = ",")) } return(NULL) } ## quadratic form from emulator package: ## quad.tform == x %*% M %*% t(x) ## quad.tdiag == diag(quad.tform(M, x) ## rowSums(tcrossprod(Conj(x), M) * x) quad.tdiag <- function(M, x) { ## only real-valued, so drop Conj rowSums(tcrossprod(x, M) * x) } ##' attempt to modularize vcov scaling; more details in the autoscale vignette ##' @param vv represents the variance-covariance matrix before modification ##' @param sc represents the scale vector ##' @param ce represents the center vector scale_vcov <- function(vv, sc, ce) { other_vars <- setdiff(colnames(vv), "(Intercept)") ## 1. Modifying the intercept sig_0sq <- vv["(Intercept)", "(Intercept)"] sig_0isq <- vv["(Intercept)", other_vars] total1 <- -2 *sum((ce/sc) * sig_0isq) small_vv <- as.matrix(vv[other_vars, other_vars]) total2 <- crossprod(ce / sc, small_vv %*% (ce / sc))[[1]] vv["(Intercept)", "(Intercept)"] <- sig_0sq + total1 + total2 ## 2. Modifying without intercept updated_2 <- (sig_0isq)/sc - (small_vv %*% (ce/sc))/sc vv["(Intercept)", other_vars] <- updated_2 vv[other_vars, "(Intercept)"] <- updated_2 vv[other_vars, other_vars] <- vv[other_vars, other_vars] * outer(1/sc, 1/sc) vv <- as(vv, "dpoMatrix") } ##' Used for padding NAs to Cmat accordingly in predict.merMod ##' @param mat represents the matrix that needs to be modified ##' @param mat_names represents the names of the new modified matrix ##' @param insert_after represents the placement before the zeros that need to ##' be added ##' @param n_add represents the number rows/columns that will be padded with zeros zero_padding <- function(mat, mat_names, insert_after, n_add = 1) { mat <- as.matrix(mat) old_dim <- nrow(mat) new_dim <- old_dim + n_add m_pad <- matrix(0, new_dim, new_dim) rownames(m_pad) <- mat_names colnames(m_pad) <- mat_names ## Top right corner m_pad[1:insert_after, 1:insert_after] <- mat[1:insert_after, 1:insert_after] ## Top left corner m_pad[1:insert_after, (insert_after + n_add + 1):new_dim] <- mat[1:insert_after, (insert_after + 1):old_dim] ## Bottom right corner m_pad[(insert_after + n_add + 1):new_dim, 1:insert_after] <- mat[(insert_after + 1):old_dim, 1:insert_after] ## Bottom left corner m_pad[(insert_after + n_add + 1):new_dim, (insert_after + n_add + 1):new_dim] <- mat[(insert_after + 1):old_dim, (insert_after + 1):old_dim] m_pad } ##' if allow.new.levels = TRUE, then adds 0 padding to Cmat for prediction ##' @param Cmat represents Cmat that was computed prior to subsetting ##' @param C_factors represents the factors explicitly shown in Cmat ##' @param Z_factors represents the factors represented in the Z matrix, which ##' includes only levels of groups that need to be predicted ##' @param Cmat_names represents the names of the Cmat matrix ##' @param cnms same as cnms from object pad_Cmat <- function(Cmat, C_factors, Z_factors, Cmat_names, cnms){ n_padded = 0 for (grp in intersect(names(C_factors), names(Z_factors))) { n_lvl <- length(levels(C_factors[[grp]])) added_levels <- setdiff(levels(Z_factors[[grp]]), levels(C_factors[[grp]])) if ((n_add <- length(added_levels)) == 0) next levels(C_factors[[grp]]) <- c(levels(C_factors[[grp]]), added_levels) ## add names for clarity added_nms <- as.vector(sapply(added_levels, function(lv) paste0(grp, ".", lv, ".", cnms[[grp]]) )) ## add padding n_padded <- n_padded + n_lvl * length(cnms[[grp]]) n_new <- n_add * length(cnms[[grp]]) Cmat_names <- c(Cmat_names[1:n_padded], added_nms, Cmat_names[(n_padded+1):length(Cmat_names)]) ## alter Cmat Cmat <- zero_padding(Cmat, Cmat_names, insert_after = n_padded, n_add = n_new) n_padded <- n_padded + n_new } list("Cmat" = Cmat, "C_factors" = C_factors, "Cmat_names" = Cmat_names) } getDoublevertDefault <- function() { getOption("lme4.doublevert.default", "split") } na.action.merMod <- function(object, ...) { na.action(model.frame(object)) } # Temporarily putting this here; should be removed once reformulas is updated. #' get grouping variable symbols/names #' @param formula a formula #' @param return_val return character string or raw symbol? #' @examples #' form <- Reaction ~ Days + (Days | group / Subject) #' get_grpvars(form) #' get_grpvars(form, return_val = "symbol") get_grpvars <- function(formula, return_val = c("char", "symbol")) { return_val <- match.arg(return_val) ff <- reformulas::findbars_x(formula) ff2 <- lapply(ff, "[[", 2) ## strip parens/special names ff3 <- lapply(ff2, "[[", 3) ## get argument after | if (return_val == "symbol") return(ff3) vapply(ff3, deparse1, FUN.VALUE = "") } lme4/R/zzz.R0000644000176200001440000001114515127735433012310 0ustar liggesusers.onLoad <- function(libname, pkgname) { ## don't do this in production; also flags problems in downstream packages ## options(Matrix.warnDeprecatedCoerce = 3) options(lme4.summary.cor.max = 12) Ons <- parent.env(environment()) # our own namespace if((Rv <- getRversion()) < "4.4.0") { assign('%||%', envir = Ons, inherits = FALSE, function(x, y) if(is.null(x)) y else x) if(Rv < "4.1.0") { ## https://stackoverflow.com/questions/49056642/how-to-make-variable-available-to-namespace-at-loading-time/67664852#67664852 ## not quite equivalent; this *forces* ... entries whereas true ...names() doesn't assign('...names', envir = Ons, function() eval(quote(names(list(...))), sys.frame(-1L))) if(Rv < "4.0.0") { ## NB: R >= 4.0.0's deparse1() is a generalization of our previous safeDeparse() assign('deparse1', envir = Ons, function (expr, collapse = " ", width.cutoff = 500L, ...) paste(deparse(expr, width.cutoff, ...), collapse = collapse) ) ## not equivalent ... assign('...length', envir = Ons, function() eval(quote(length(list(...))), sys.frame(-1L)) ) assign("sequence.default", envir = Ons, function(nvec, from = 1L, by = 1L, ...) { if(length(nvec) == 0L) return(integer(0L)) else if(length(from) == 0L || length(by) == 0L) stop(gettextf("'%s' has length 0 but '%s' does not", if(length(from) == 0L) "from" else "by", "nvec"), domain = NA) unlist(.mapply(seq.int, list(from = as.integer(from), by = as.integer(by), length.out = as.integer(nvec)), NULL), recursive = FALSE, use.names = FALSE) }) if (Rv < "3.6.0") { assign('reformulate', envir = Ons, function(..., env = parent.env) { f <- stats::reformulate(...) environment(f) <- env f }) if (Rv < "3.2.1") { assign('lengths', envir = Ons, function (x, use.names = TRUE) vapply(x, length, 1L, USE.NAMES = use.names) ) if(Rv < "3.1.0") { assign('anyNA', envir = Ons, function(x) any(is.na(x)) ) if(Rv < "3.0.0") { assign('rep_len', envir = Ons, function(x, length.out) rep(x, length.out=length.out) ) if(Rv < "2.15") { assign('paste0', envir = Ons, function(...) paste(..., sep = '') ) } ## R < 2.15 } ## R < 3.0.0 } ## R < 3.1.0 } ## R < 3.2.1 } ## R < 3.6.0 } ## R < 4.0.0 } ## R < 4.1.0 } ## R < 4.4.0 rm(Rv, Ons) ## check Matrix ABI version check_dep_version() } ## https://github.com/lme4/lme4/issues/768 ## https://github.com/kaskr/adcomp/issues/387 get_abi_version <- function() { if (utils::packageVersion("Matrix") < "1.6-2") return(numeric_version("0")) Matrix::Matrix.Version()[["abi"]] } .Matrix.abi.build.version <- get_abi_version() ## simplified version of glmmTMB package checking ##' @param this_pkg downstream package being tested ##' @param dep_pkg upstream package on which \code{this_pkg} depends ##' @param dep_type "ABI" or "package" ##' @param built_version a \code{numeric_version} object indicating what version of \code{dep_pkg} was used to build \code{this_pkg} ##' @param warn (logical) warn if condition not met? ##' @noRd check_dep_version <- function(this_pkg = "lme4", dep_pkg = "Matrix", dep_type = "ABI", built_version = .Matrix.abi.build.version, warn = TRUE) { cur_version <- get_abi_version() result_ok <- cur_version == built_version if (!result_ok) { warning( sprintf("%s version mismatch: \n", dep_type), sprintf("%s was built with %s %s version %s\n", this_pkg, dep_pkg, dep_type, built_version), sprintf("Current %s %s version is %s\n", dep_pkg, dep_type, cur_version), sprintf("Please re-install %s from source ", this_pkg), "or restore original ", sQuote(dep_pkg), " package" ) } return(result_ok) } .onUnload <- function(libpath) { gc() if (is.loaded("lmer_Deviance", PACKAGE="lme4")) { library.dynam.unload("lme4", libpath) } } lme4/R/bootMer.R0000644000176200001440000002101115206621104013036 0ustar liggesusers.simpleCap <- function(x) { paste0(toupper(substr(x, 1,1)), substr(x, 2, 1000000L), collapse=" ") } ### bootMer() --- <==> (TODO: semi-*)parametric bootstrap ### ------------------------------------------------------- ## Doc: show how this is equivalent - but faster than ## boot(*, R = nsim, sim = "parametric", ran.gen = simulate(.,1,.), mle = x) ## --> return a "boot" object -- so we could use boot.ci() etc ## TODO: also allow "semi-parametric" model-based bootstrap: ## resampling the (centered!) residuals (for use.u=TRUE) or for use.u=FALSE, ## *both* the centered u's + centered residuals ## instead of using rnorm() ## BUT see: ## @article{morris_blups_2002, ## title = {The {BLUPs} are not "best" when it comes to bootstrapping}, ## volume = {56}, ## issn = {0167-7152}, ## url = {https://www.sciencedirect.com/science/article/pii/S016771520200041X}, ## doi = {10.1016/S0167-7152(02)00041-X}, ## journal = {Statistics \& Probability Letters}, ## author = {Morris, Jeffrey S}, ## year = {2002}, ## } ## for an indication of why this is not necessarily a good idea! ##' Perform model-based (Semi-)parametric bootstrap for mixed models. ##' ##' The semi-parametric variant is not yet implemented, and we only ##' provide a method for \code{\link{lmer}} and \code{\link{glmer}} results. bootMer <- function(x, FUN, nsim = 1, seed = NULL, use.u = FALSE, re.form = NA, type = c("parametric","semiparametric"), verbose = FALSE, .progress = "none", PBargs=list(), parallel = c("no", "multicore", "snow", "future"), ncpus = getOption("boot.ncpus", 1L), cl = NULL) { stopifnot((nsim <- as.integer(nsim[1])) > 0) if (.progress!="none") { ## progress bar pbfun <- get(paste0(.progress,"ProgressBar")) setpbfun <- get(paste0("set",.simpleCap(.progress),"ProgressBar")) pb <- do.call(pbfun,PBargs) } parallel <- match.arg(parallel) # (parallel, ncpus, cl) -> (parallel) eval(initialize.parallel) if (parallel != "no" && .progress != "none") message("progress bar disabled for parallel operations") FUN <- match.fun(FUN) type <- match.arg(type) if(!is.null(seed)) set.seed(seed) else if(!exists(".Random.seed", envir = .GlobalEnv)) runif(1) # initialize the RNG if necessary mc <- match.call() t0 <- FUN(x) if (!is.numeric(t0)) stop("bootMer currently only handles functions that return numeric vectors") ## FIXME: make parameters match profiling output! ## should getME(x, "theta") be getME(x, "par")? Test bootMer with structured cov matrices ... mle <- list(beta = getME(x,"beta"), theta = getME(x,"theta")) if (isLMM(x)) mle <- c(mle,list(sigma = sigma(x))) ## FIXME: what about GLMMs with scale parameters?? ## FIXME: remove prefix when incorporated in package if (type=="parametric") { argList <- list(x, nsim=nsim, na.action=na.exclude) if (!missing(re.form)) { argList <- c(argList,list(re.form=re.form)) } else { argList <- c(argList,list(use.u=use.u)) } ss <- do.call(simulate,argList) } else { if (!missing(re.form)) stop(paste(sQuote("re.form")), "cannot be used with semiparametric bootstrapping") if (use.u) { if (isGLMM(x)) warning("semiparametric bootstrapping is questionable for GLMMs") ss <- replicate(nsim,fitted(x)+sample(residuals(x,"response"), replace=TRUE), simplify=FALSE) } else { stop("semiparametric bootstrapping with use.u=FALSE not yet implemented") } } ## FIXME:: use getCall(x) ? check for existence of slot? ## is control used except for merMod? control <- if (!is(x, "merMod")) NULL else eval.parent(x@call$control) # define ffun as a closure containing the referenced variables # in its scope to avoid explicit clusterExport statement # in the PSOCKcluster case ffun <- local({ FUN refit x ss verbose parallel control length.t0 <- length(t0) f1 <- factory(function(i) FUN(refit(x, ss[[i]], control = control)), errval = rep(NA_real_, length.t0)) function(i) { ret <- f1(i) if (verbose) { cat(sprintf("%5d :",i)); str(ret) } if (parallel == "no" && .progress!="none") { setpbfun(pb,i/nsim) } ret }}) simvec <- seq_len(nsim) res <- if (parallel == "multicore") { parallel::mclapply(simvec, ffun, mc.cores = ncpus) } else if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makeCluster(ncpus) on.exit(parallel::stopCluster(cl)) ## explicit export of the lme4 namespace since most FUNs will probably ## use some of them parallel::clusterExport(cl, varlist=getNamespaceExports("lme4")) if(RNGkind()[1L] == "L'Ecuyer-CMRG") parallel::clusterSetRNGStream(cl) } parallel::parLapply(cl, simvec, ffun) } else if(parallel == "future") { future.apply::future_lapply(simvec, ffun, future.seed = TRUE) } else lapply(simvec, ffun) t.star <- do.call(cbind,res) rownames(t.star) <- names(t0) msgs <- list() for (mtype in paste0("factory-",c("message","warning","error"))) { msgs[[mtype]] <- trimws(unlist(lapply(res, attr, mtype))) msgs[[mtype]] <- table(msgs[[mtype]]) } if ((numFail <- sum(msgs[["factory-error"]])) > 0) { warning("some bootstrap runs failed (",numFail,"/",nsim,")") } fail.msgs <- if (numFail==0) NULL else msgs[["factory-error"]] ## mimic ending of boot() construction s <- structure(list(t0 = t0, t = t(t.star), R = nsim, data = model.frame(x), seed = .Random.seed, statistic = FUN, sim = "parametric", call = mc, ## these two are dummies ran.gen = "simulate(, 1, *)", mle = mle), class = c("bootMer", "boot")) ## leave these for back-compat attr(s,"bootFail") <- numFail attr(s,"boot.fail.msgs") <- fail.msgs attr(s,"boot.all.msgs") <- msgs ## store all messages (tabulated) attr(s,"boot_type") <- "boot" s } ## {bootMer} ##' @S3method as.data.frame boot as.data.frame.bootMer <- function(x,...) { as.data.frame(x$t) } ## FIXME: collapse convergence warnings (ignore numeric values ## when tabulating) ? print.bootWarnings <- function(x, verbose=FALSE, ...) { checkDots(..., .action = "warning") msgs <- attr(x, "boot.all.msgs") if (is.null(msgs) || all(lengths(msgs)==0)) { return(invisible(NULL)) } wstr <- "\n" for (i in c("message","warning","error")) { f <- paste0("factory-",i) m <- sort(msgs[[f]]) if (length(m)>0) { if (!verbose) { wstr <- c(wstr, paste0(sum(m)," ",i,"(s): ",names(m)[1])) if (length(m)>1) { wstr <- c(wstr," (and others)") } wstr <- c(wstr,"\n") } else { wstr <- paste0(i,"(s):\n") wstr <- c(wstr,capture.output(cat(cbind(" ",m,names(m)),sep="\n"))) wstr <- c(wstr,"\n") } } } message(wstr) return(invisible(NULL)) } print.bootMer <- function(x,...) { NextMethod(x,...) print.bootWarnings(x, verbose=FALSE) return(invisible(x)) } confint.bootMer <- function(object, parm=seq(length(object$t0)), level=0.95, type=c("perc","norm","basic"), ...) { type <- match.arg(type) bnms <- c(norm="normal",basic="basic",perc="percent") blens <- c(norm=3, basic=5, perc=5) bnm <- bnms[[type]] blen <- blens[[type]] safe_bootci <- function(i) { capture.output(val <- boot::boot.ci(object, index=i, conf=level, type=type)[[bnm]]) if (is.null(val)) return(matrix(rep(NA_real_, blen), nrow = 1)) val } btab0 <- t(vapply(parm, FUN=safe_bootci, FUN.VALUE=numeric(blen))) btab <- btab0[, (blen-1):blen, drop=FALSE] rownames(btab) <- names(object$t0) a <- (1 - level)/2 a <- c(a, 1 - a) ## replicate stats::format.perc pct <- paste(format(100 * a, trim = TRUE, scientific = FALSE, digits = 3), "%") colnames(btab) <- pct return(btab) } lme4/R/allFit.R0000644000176200001440000003216415221572036012663 0ustar liggesusersmeth.tab.0 <- cbind(optimizer= rep(c("bobyqa", "Nelder_Mead", "nlminbwrap", "nmkbw", "optimx", "nloptwrap" ), c(rep(1,5),2)), method= c(rep("",4), "L-BFGS-B", "NLOPT_LN_NELDERMEAD", "NLOPT_LN_BOBYQA")) ## ugh: hardcoded list (incomplete?) of allowable *control* options by optimizer ## could make more of an effort to match max-iterations/evals, ## (x|f)*(abs|rel) tolerance, ... opt.ctrls <- list(bobyqa=c("npt","rhobeg","rhoend","iprint","maxfun"), Nelder_Mead=c("iprint","maxfun","FtolAbs", "FtolRel","XtolRel","MinfMax", "xst","xt","verbose","warnOnly"), nlminbwrap=c("eval.max","iter.max","trace","abs.tol", "rel.tol","x.tol","xf.tol","step.min", "step.max","sing.tol","scale.init", "diff.g"), optimx=c("trace","fnscale","parscale","ndeps", "maxit","abstol","reltol","method"), nloptwrap=c("minf_max","ftol_rel","ftol_abs", "xtol_rel", "xtol_abs", "maxeval", "maxtime", "algorithm"), nmkbw=c("tol","maxfeval","regsimp","maximize", "restarts.max","trace")) ## name of 'max function evaluations' for each optimizer maxfun_arg <- c(bobyqa = "maxfun", Nelder_Mead = "maxfun", nlminbwrap = "eval.max", optimx = "maxit", nloptwrap = "maxeval", nmkbw = "maxfeval") nmkbw <- function(fn, par, lower, upper, control) { if (length(par)==1) { res <- optim(fn=fn,par=par,lower=lower,upper=100*par, method="Brent") } else { res <- dfoptim::nmkb(fn=fn,par=par, lower=lower,upper=upper,control=control) } res$fval <- res$value res } ##' Attempt to re-fit a [g]lmer model with a range of optimizers. ##' The default is to use all known optimizers for R that satisfy the ##' requirements (do not require explicit gradients, allow ##' box constraints), in three categories; (i) built-in ##' (minqa::bobyqa, lme4::Nelder_Mead, nlminbwrap), (ii) wrapped via optimx ##' (most of optimx's optimizers that allow box constraints require ##' an explicit gradient function to be specified; the two provided ##' here are really base R functions that can be accessed via optimx, ##' (iii) wrapped via nloptr; (iv) ##' ##' @param object a fitted model ##' @param meth.tab a matrix (or data.frame) with columns ##' - method the name of a specific optimization method to pass to the optimizer ##' (leave blank for built-in optimizers) ##' - optimizer the \code{optimizer} function to use ##' @param verbose print progress messages? ##' @param catch.err catch errors? ##' @param start_from_mle (logical) initialize the refitting process with starting values from the fitted model? ##' @return a list of fitted \code{merMod} objects ##' @seealso slice, slice2D in the bbmle package ##' @examples ##' library(lme4) ##' gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd), ##' data = cbpp, family = binomial) ##' gm_all <- allFit(gm1, parallel=TRUE) ##' ss <- summary(gm_all) ##' ss$fixef ## extract fixed effects ##' ss$llik ## log-likelihoods ##' ss$sdcor ## SDs and correlations ##' ss$theta ## Cholesky factors ##' ss$which.OK ## which fits worked allFit <- function(object, meth.tab = NULL, data=NULL, verbose=TRUE, show.meth.tab = FALSE, maxfun = 1e5, parallel = c("no", "multicore", "snow", "future"), ncpus = getOption("allFit.ncpus", 1L), cl = NULL, catch.errs = TRUE, start_from_mle = TRUE) { if (is.null(meth.tab)) { meth.tab <- meth.tab.0 } optvec <- meth.tab.0[,"optimizer"] if (!requireNamespace("dfoptim", quietly = TRUE)) { optvec <- setdiff(optvec, "nmkbw") meth.tab <- meth.tab[meth.tab[,"optimizer"] %in% optvec, ] } if (!requireNamespace("optimx", quietly = TRUE)) { optvec <- setdiff(optvec, "optimx") meth.tab <- meth.tab[meth.tab[,"optimizer"] %in% optvec,] } if (show.meth.tab) { return(meth.tab) } stopifnot(length(dm <- dim(meth.tab)) == 2, dm[1] >= 1, dm[2] >= 2, is.character(optimizer <- meth.tab[,"optimizer"]), is.character(method <- meth.tab[,"method"])) parallel <- match.arg(parallel) # (parallel, ncpus, cl) -> (parallel) eval(initialize.parallel) fit.names <- gsub("\\.$", "", paste(optimizer, method, sep=".")) ffun <- local({ ## required local vars object verbose fit.names optimizer method maxfun function(..i) { if (verbose) cat(fit.names[..i],": ") ctrl <- getCall(object)$control ## NB: 'ctrl' must become a correct *argument* list for g?lmerControl() ## 'ctrl' as extracted above is an unevaluated language object: ## NULL, a call (typically to g?lmerControl()), or a symbol ## referring to a previously constructed control object (e.g. ## control=cc where cc <- lmerControl(...) was assigned earlier). ## eval() resolves either case to the actual, fully resolved ## (and nested) control object, which we then unpack back into a ## flat argument list (mirrors the lmerControl->glmerControl ## backward-compatibility unpacking kludge in glmer(), lmer.R) if(is.null(ctrl)) { ctrl <- list(optimizer=optimizer[..i]) } else { ctrl <- eval(ctrl, envir = environment(formula(object))) ctrl <- c(ctrl[!names(ctrl) %in% c("checkControl","checkConv")], ctrl$checkControl, ctrl$checkConv) ctrl$optimizer <- optimizer[..i] } ## add method/algorithm to optCtrl as necessary mkOptCtrl <- function(...) { x <- list(...) cc <- ctrl$optCtrl if (is.null(cc)) cc <- list() cc[[maxfun_arg[[optimizer[[..i]]]]]] <- maxfun for (n in names(x)) { ## replace existing values cc[[n]] <- x[[n]] } cc } sanitize <- function(x,okvals) { if (is.null(x)) return(NULL) if (is.null(okvals)) return(x) x <- x[intersect(names(x),okvals)] ## ?? having names(control) be character(0) ## screws up nmkbw ... ?? if (length(names(x))==0) names(x) <- NULL x } ctrl$optCtrl <- switch(optimizer[..i], optimx = mkOptCtrl(method = method[..i]), nloptwrap = mkOptCtrl(algorithm= method[..i]), mkOptCtrl()) ctrl$optCtrl <- sanitize(ctrl$optCtrl, opt.ctrls[[optimizer[..i]]]) ctrl <- do.call(if(isGLMM(object)) glmerControl else lmerControl, ctrl) ## need to stick ctrl in formula env so it can be found ... form <- formula(object) env <- environment(form) tmp_env <- new.env(parent = env) # temporarily changing the environment environment(form) <- tmp_env assign("ctrl", ctrl, envir = tmp_env, inherits = FALSE) # Using the MLE as a starting point if (start_from_mle) { if (isGLMM(object)) { pars <- getME(object, c("theta", "fixef")) } else { pars <- getME(object, "theta") if(isNLMM(object)){ warning("results are not guaranteed when using nlmer") } } assign("pars", pars, envir = tmp_env, inherits = FALSE) } fit_call <- if (start_from_mle) { quote(update(object, start = pars, control = ctrl)) } else { quote(update(object, control = ctrl)) } tt <- system.time( rr <- if (catch.errs) { tryCatch(eval(fit_call), error = function(e) e) } else { eval(fit_call) } ) attr(rr, "optCtrl") <- ctrl$optCtrl # contains crucial info here attr(rr, "time") <- tt # store timing info ## restore original values to environment of the object on.exit({ environment(form) <- env }, add = TRUE) if (verbose) { if (inherits(rr,"error")) { cat("[failed]\n") } else { cat("[OK]\n") } } return(rr) } }) seq_fit <- seq_along(fit.names) res <- if (parallel == "multicore") { parallel::mclapply(seq_fit, ffun, mc.cores = ncpus) } else if(parallel == "snow") { if (is.null(cl)) { cl <- parallel::makeCluster(ncpus) on.exit(parallel::stopCluster(cl)) ## consider exporting data/package ? ## parallel::clusterEvalQ(cl,library("lme4")) ## try to get data and export it? ## parallel::clusterExport(cl,??) } parallel::parLapply(cl, seq_fit, ffun) } else if(parallel == "future") { future.apply::future_lapply(seq_fit, ffun) } else lapply(seq_fit, ffun) names(res) <- fit.names structure(res, class = "allFit", fit = object, sessionInfo = sessionInfo(), data = data # is dropped if NULL ) } print.allFit <- function(x, width=80, ...) { cat("original model:\n") f <- attr(x,"fit") ss <- function(x) { if (nchar(x)>width) { strwrap(paste0(substr(x,1,width-3),"...")) } else x } ff <- ss(deparse1(formula(f))) cat(ff,"\n") cat("data: ",deparse(getCall(f)$data),"\n") cat("optimizers (",length(x),"): ", ss(paste(names(x),collapse=", ")),"\n", sep="") which.bad <- vapply(x,FUN=is,"error",FUN.VALUE=logical(1)) if ((nbad <- sum(which.bad))>0) { cat(nbad,"optimizer(s) failed\n") } cat("differences in negative log-likelihoods:\n") nllvec <- -vapply(x[!which.bad],logLik,numeric(1)) cat("max=",signif(max(nllvec-min(nllvec)),3), "; std dev=",signif(sd(nllvec),3), "\n") ## FIXME: print magnitudes of parameter diffs ## cat("differences in parameters:\n") ## ss <- summary(x) ## allpars <- cbind(ss$fixef, ss$sdcor) ## par_max <- invisible(x) } summary.allFit <- function(object, ...) { afun <- function(x, FUN, ...) { f1 <- FUN(x[[1]], ...) nm <- names(f1) n <- length(f1) res <- vapply(x, FUN, numeric(n), ...) if (!is.null(dim(res))) { res <- t(res) } else { res <- as.matrix(res) colnames(res) <- nm } res } which.OK <- !vapply(object, is, "error", FUN.VALUE=logical(1)) objOK <- object[which.OK] msgs <- lapply(objOK, function(x) x@optinfo$conv$lme4$messages) fixef <- afun(objOK, fixef) llik <- vapply(objOK, logLik, numeric(1)) times <- afun(objOK, attr, "time") feval <- vapply(objOK, function(x) x@optinfo$feval, numeric(1)) vfun <- function(x) as.data.frame(VarCorr(x))[["sdcor"]] sdcor <- afun(objOK, vfun) theta <- afun(objOK, getME, name="theta") vcnms <- getVCNames(objOK[[1]]) cnm <- unlist(rbind(vcnms$vcomp, vcnms$ccomp), FALSE, FALSE) if (sigma(objOK[[1]])!=1) cnm <- c(cnm,"sigma") colnames(sdcor) <- unname(cnm) sdcor <- as.data.frame(sdcor) res <- namedList(which.OK, msgs, fixef, llik, sdcor, theta, times, feval) class(res) <- "summary.allFit" res } ## should add a print method for summary: ## * fixed effects, random effects: summary of differences? ## not yet ... plot.allFit <- function(x, abbr=16, ...) { values <- opt <- NULL ## R code check/non-standard evaluation if (! (requireNamespace("ggplot2"))) { stop("ggplot2 package must be installed to plot allFit objects") } aes <- NULL ## code check ss <- summary(x) ff <- stack(as.data.frame(ss$fixef)) ff$opt <- rep(rownames(ss$fixef),length.out=nrow(ff)) if (!is.null(abbr)) ff$opt <- abbreviate(ff$opt, minlength=abbr) (ggplot2::ggplot(ff, aes(values, opt, colour=opt)) + ggplot2::geom_point() + ggplot2::facet_wrap(~ind,scale="free") + ggplot2::theme(legend.position="none") ) } lme4/R/methods.R0000644000176200001440000002542715155634017013123 0ustar liggesusersinfluence.merMod <- function(model, groups, data, maxfun=1000, do.coef = TRUE, start=NULL, parallel = c("no", "multicore", "snow", "future"), ncpus = getOption("influence.ncpus", 1L), cl = NULL, ncores, ...) { if (!missing(ncores)) { .Deprecated(msg = "argument 'ncores' is deprecated; please use 'parallel', 'ncpus', and 'cl' instead") ncpus <- ncores parallel <- "snow" } parallel <- match.arg(parallel) # (parallel, ncpus, cl) -> (parallel) eval(initialize.parallel) .groups <- NULL ## avoid false-positive code checks .vcov <- function(x) Matrix::as.matrix(vcov(x)) if (...length()>0) warning("disregarded additional arguments") if (!do.coef) { ## simple/quick/trivial results result <- list(hat=hatvalues(model)) class(result) <- "influence.merMod" return(result) } if (missing(data)) { data <- getCall(model)$data data <- if (!is.null(data)) eval(data, parent.frame()) else stop("model did not use the data argument") } data <- as.data.frame(data) ## prevent tibble trouble if (missing(groups)) { groups <- ".case" data$.case <- rownames(data) } else if (length(groups) > 1){ del.var <- paste0(groups, collapse=".") data[, del.var] <- apply(data, 1, paste0, collapse=".") groups <- del.var } unique.del <- unique(data[, groups]) data[[".groups"]] <- data[, groups] if (!is.null(start)) { par <- start } else { par <- list(theta=getME(model, "theta")) if (inherits(model, "glmerMod") && getME(model, "devcomp")$dims[["nAGQ"]]>0) { par$fixef <- fixef(model) } } fixed <- fixef(model) fixed.1 <- matrix(0, length(unique.del), length(fixed)) rownames(fixed.1) <- unique.del colnames(fixed.1) <- names(fixed) Vs <- VarCorr(model) nms <- names(Vs) sep <- ":" if (length(nms) == 1) { nms <- "" sep <- "" } vc <- getME(model, "sigma")^2 names(vc) <- "sigma^2" for (i in 1:length(Vs)){ V <- Vs[[i]] c.names <- colnames(V) e.names <- outer(c.names, c.names, function(a, b) paste0("C[", a, ",", b, "]")) diag(e.names) <- paste0("v[", c.names, "]") v <- V[lower.tri(V, diag=TRUE)] names(v) <- paste0(nms[i], sep, e.names[lower.tri(e.names, diag=TRUE)]) vc <- c(vc, v) } vc.1 <- matrix(0, length(unique.del), length(vc)) rownames(vc.1) <- unique.del colnames(vc.1) <- names(vc) feval <- numeric(length(unique.del)) converged <- logical(length(unique.del)) vcov.1 <- vector(length(unique.del), mode="list") names(vcov.1) <- names(feval) <- names(converged) <- unique.del # control <- if (one.step){ # if (inherits(model, "lmerMod")) lmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B", maxit=1)) # else if (inherits(model, "glmerMod")) glmerControl(optimizer="optimx", optCtrl=list(method="L-BFGS-B", maxit=1)) # } else { control <- if (inherits(model, "lmerMod")) lmerControl(optCtrl=list(maxfun=maxfun)) else if (inherits(model, "glmerMod")) glmerControl(optCtrl=list(maxfun=maxfun)) # } deleteGroup <- function(del) { data$del <- del mod.1 <- suppressWarnings(update(model, data=data, subset=(.groups != del), start=par, control=control)) opt <- mod.1@optinfo feval <- opt$feval converged <- opt$conv$opt == 0 && length(opt$warnings) == 0 fixed.1 <- fixef(mod.1) Vs.1 <- VarCorr(mod.1) vc.0 <- getME(mod.1, "sigma")^2 for (V in Vs.1){ vc.0 <- c(vc.0, V[lower.tri(V, diag=TRUE)]) } vc.1 <- vc.0 vcov.1 <<- .vcov(mod.1) namedList(fixed.1, vc.1, vcov.1, converged, feval) } result <- if (parallel == "multicore") { parallel::mclapply(unique.del, deleteGroup, mc.cores = ncpus) } else if (parallel == "snow") { if (is.null(cl)) { cl <- parallel::makeCluster(ncpus) on.exit(parallel::stopCluster(cl)) parallel::clusterEvalQ(cl, require("lme4")) } parallel::parLapply(cl, unique.del, deleteGroup) } else if(parallel == "future") { future.apply::future_lapply(unique.del, deleteGroup, future.packages = "lme4") } else { lapply(unique.del, deleteGroup) } result <- combineLists(result) fixed.1 <- result$fixed.1 rownames(fixed.1) <- unique.del colnames(fixed.1) <- names(fixed) vc.1 <- result$vc.1 rownames(vc.1) <- unique.del colnames(vc.1) <- names(vc) feval <- as.vector(result$feval) converged <- as.vector(result$converged) vcov.1 <- result$vcov.1 names(vcov.1) <- names(feval) <- names(converged) <- unique.del left <- "[-" right <- "]" if (groups == ".case") { groups <- "case" } nms <- c("fixed.effects", paste0("fixed.effects", left, groups, right), "var.cov.comps", paste0("var.cov.comps", left, groups, right), "vcov", paste0("vcov", left, groups, right), "groups", "deleted", "converged", "function.evals") result <- list(fixed, fixed.1, vc, vc.1, .vcov(model), vcov.1, groups, unique.del, converged, feval) names(result) <- nms class(result) <- "influence.merMod" result } ## lookup table for influence.merMod elements ipos <- c("fixed"=1, "fixed.sub"=2, "var.cov"=3, "var.cov.sub"=4, "vcov"=5, "vcov.sub"=6) dfbeta.influence.merMod <- function(model, which=c("fixed", "var.cov"), ...){ which <- match.arg(which) b <- model[[ipos[sprintf("%s.sub",which)]]] b0 <- model[[ipos[which]]] b - matrix(b0, nrow=nrow(b), ncol=ncol(b), byrow=TRUE) } dfbetas.influence.merMod <- function(model, ...){ vList <- model[[ipos["vcov.sub"]]] n <- nrow(vList[[1]]) vmat <- t(vapply(vList, function(x) sqrt(diag(x)), numeric(n))) dfbeta(model)/vmat } cooks.distance.merMod <- function(model, ...) { p <- Matrix::rankMatrix(getME(model,"X")) hat <- hatvalues(model) dispersion <- sigma(model)^2 res <- residuals(model,type="pearson") res <- (res/(1 - hat))^2 * hat/(dispersion * p) res[is.infinite(res)] <- NaN res } cooks.distance.influence.merMod <- function(model, ...) { db <- dfbeta(model) n <- nrow(db) p <- ncol(db) d <- numeric(n) names(d) <- names(model[["vcov[-case]"]]) vcov.inv <- (n - p)/(n*p)*solve(model$vcov) for (i in 1:n) { d[i] <- db[i, ] %*% vcov.inv %*% db[i, ] } d } ## from ?lm.influence: ## wt.res: a vector of _weighted_ (or for class 'glm' rather _deviance_) ## residuals. ## ## residuals.lm gives r*sqrt(object$weights) (if non-NULL weights) ## for type %in% c("deviance","pearson") ## ## residuals.glm gives (y - mu) * sqrt(wts)/sqrt(object$family$variance(mu)) ## rstudent.merMod <- function (model, ...) { r <- residuals(model, type="deviance") hat <- hatvalues(model) pr <- residuals(model, type="pearson") r <- sign(r) * sqrt(r^2 + (hat * pr^2)/(1 - hat)) r[is.infinite(r)] <- NaN r/sigma(model) } rstandard.glmerMod <- function (model, infl = influence(model, do.coef = FALSE), type = c("pearson", "deviance"), ...) { type <- match.arg(type) res <- residuals(model, type = type) res <- res/(sigma(model) * sqrt(1 - hatvalues(model))) res[is.infinite(res)] <- NaN res } rstudent.glmerMod <- function(model, infl = influence(model, do.coef=FALSE), ...) { useSc <- model@devcomp$dims[["useSc"]] if (useSc) return(rstandard(model, infl, type="pearson")) residuals(model, type = "pearson")/ (sigma(model)*sqrt(1 - hatvalues(model))) } ##' @S3method sigma merMod sigma.merMod <- function(object, ...) { dc <- object@devcomp dd <- dc$dims if(dd[["useSc"]]) dc$cmp[[if(dd[["REML"]]) "sigmaREML" else "sigmaML"]] else 1. } ##' @importFrom stats terms ##' @S3method terms merMod terms.merMod <- function(x, fixed.only=TRUE, random.only=FALSE, ...) { if (missing(fixed.only) && random.only) fixed.only <- FALSE if (fixed.only && random.only) stop("can't specify 'only fixed' and 'only random' terms") tt <- attr(x@frame,"terms") if (fixed.only) { ## ... may contain 'data' (needed when formula contains .) tt <- terms.formula(formula(x,fixed.only=TRUE), ...) attr(tt,"predvars") <- attr(terms(x@frame),"predvars.fixed") } if (random.only) { ff <- reformulas::subbars(formula(x, random.only=TRUE)) ff <- noSpecials(ff, specials = lme4_specials, delete = FALSE) tt <- terms.formula(ff) attr(tt,"predvars") <- attr(terms(x@frame),"predvars.random") } tt } ##' @importFrom stats update ##' @S3method update merMod update.merMod <- function(object, formula., ..., evaluate = TRUE) { if (is.null(call <- getCall(object))) stop("object should contain a 'call' component") extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) call$formula <- update.formula(formula(object), formula.) if (length(extras) > 0) { 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) return(call) ## should be able to find model components somewhere in (1) formula env; (2) calling env; ## (3) parent frame [plus its parent frames] ## see discusion at https://stackoverflow.com/questions/64268994/evaluate-call-when-components-may-be-scattered-among-environments ## FIXME: suppressWarnings(update(model)) will give ## Error in as.list.environment(X[[i]], ...) : ## promise already under evaluation: recursive default argument reference or earlier problems? ff <- environment(formula(object)) pf <- parent.frame() sf <- sys.frames()[[1]] tryCatch(eval(call, envir = ff), ## try formula environment error = function(e) { tryCatch(eval(call, envir = sf), ## try stack frame error = function(e) { eval(call, envir=pf) ## try parent frame }) }) ## ## combf <- tryCatch( ## do.call("c", lapply(list(ff, sf), as.list)), ## error=function(e) as.list(ff) ## ) ## eval(call,combf, enclos=pf) } lme4/R/lmerControl.R0000644000176200001440000002063715127735433013761 0ustar liggesusersnamedList <- function(...) { L <- list(...) snm <- sapply(substitute(list(...)), deparse)[-1] if (is.null(nm <- names(L))) nm <- snm if (any(nonames <- nm == "")) nm[nonames] <- snm[nonames] setNames(L,nm) } ##' By extracting "checking options" from \code{nms}, this function ##' implicitly defines what "checking options" are. ##' ##' @title Extract "checking options" or "checking arguments" (-> ../man/lmerControl.Rd) ##' those starting with "check." but *not* the "check.conv.." nor "check.rankX.." ones: ##' @param nms character vector ##' @return those elements of \code{nms} which are "checking options" ##' @author Martin Maechler .get.checkingOpts <- function(nms) nms[grepl("^check\\.(?!conv|rankX|scaleX)", nms, perl=TRUE)] ##' Check check.conv.*() options and produce good error message chk.convOpt <- function(opt) { cnm <- deparse(nm <- substitute(opt))[[1]] if(!is.list(opt)) stop("check.conv* option ", cnm, " must be a list") if(!is.character(opt$action)) stop("check.conv* option ", cnm, " has no 'action' string") if(!is.numeric(tol <- opt$tol)) stop("check.conv* option ", cnm, " must have a numeric 'tol' component") if(length(tol) != 1 || tol < 0) stop("check.conv* option ", cnm, "$tol must be number >= 0") if(!is.null(relTol <- opt$relTol)) stopifnot(is.numeric(relTol), length(relTol) == 1, relTol >= 0) invisible() } ##' Exported constructor for the user calling *lmerControl(): .makeCC <- function(action, tol, relTol, ...) { stopifnot(is.character(action), length(action) == 1) if(!is.numeric(tol)) stop("must have a numeric 'tol' component") if(length(tol) != 1 || tol < 0) stop("'tol' must be number >= 0") mis.rt <- missing(relTol) if(!mis.rt && !is.null(relTol)) stopifnot(is.numeric(relTol), length(relTol) == 1, relTol >= 0) ## and return the list, the "..." just being appended unchecked c(list(action = action, tol = tol), if(!mis.rt) list(relTol = relTol), list(...)) } ##' Internal utility : Allow check.conv.* to be a string chk.cconv <- function(copt, callingFn) { cnm <- deparse(substitute(copt)) if(is.character(copt)) { def <- eval(formals(callingFn)[[cnm]]) def$action <- copt assign(cnm, def, envir=sys.frame(sys.parent())) } else chk.convOpt(copt) } ## work around code check since we adjust formals() later check.response.not.const <- compDev <- nAGQ0initStep <- tolPwrss <- NULL merControl <- function(optimizer="nloptwrap", # originally Nelder_Mead, then bobyqa ... ## glmer: c("bobyqa","Nelder_Mead") restart_edge=TRUE, ## glmer: FALSE ## don't call any of these arguments "check.*" -- will fail ## automatic check-option-checking in ## inst/tests/test-lmer.R boundary.tol=1e-5, calc.derivs=NULL, use.last.params=FALSE, sparseX=FALSE, standardize.X=FALSE, autoscale=NULL, ## input checking options: check.nobs.vs.rankZ="ignore", ## "warningSmall", check.nobs.vs.nlev="stop", check.nlev.gtreq.5="ignore", check.nlev.gtr.1="stop", check.nobs.vs.nRE="stop", check.rankX = c("message+drop.cols", "silent.drop.cols", "warn+drop.cols", "stop.deficient", "ignore"), check.scaleX = c("warning","stop","silent.rescale", "message+rescale","warn+rescale","ignore"), check.formula.LHS = "stop", ## convergence options check.conv.nobsmax = 1e4, check.conv.nparmax = 10, check.conv.grad = .makeCC("warning", tol = 2e-3, relTol = NULL), check.conv.singular = .makeCC(action = "message", tol = getSingTol()), check.conv.hess = .makeCC(action = "warning", tol = 1e-6), optCtrl = list(), mod.type="lmer" ## glmer: "glmer" ## glmer: tolPwrss=1e-7 ## compDev = TRUE ## nAGQ0initStep = TRUE ## check.response.not.const="stop" ) { ## FIXME: is there a better idiom? match.call() ? ## fill in values from options, but **only if not specified explicitly in arguments** ## (ugh ... is there a better way to do this? mapply() is clunky: ## http://stackoverflow.com/questions/16276667/using-apply-with-assign-in-r stopifnot(is.list(optCtrl)) if (mod.type=="glmer" && length(optimizer)==1) { ## replicate() works whether 'optimizer' is a function or a string optimizer <- replicate(2,optimizer) } c.opts <- paste0(mod.type,"Control") merOpts <- getOption(c.opts) if (!is.null(merOpts)) { nn <- names(merOpts) nn.ok <- .get.checkingOpts(names(merOpts)) if (length(nn.ignored <- setdiff(nn,nn.ok))>0) { warning("some options in ",shQuote(sprintf("getOption('%s')",c.opts)), " ignored : ",paste(nn.ignored,collapse=", ")) } for (arg in nn.ok) { if (do.call(missing,list(arg))) ## only if missing from explicit arguments assign(arg,merOpts[[arg]]) } } check.rankX <- match.arg(check.rankX) check.scaleX <- match.arg(check.scaleX) ## compatibility and convenience, caller can specify action string only: me <- sys.function() chk.cconv(check.conv.grad, me) chk.cconv(check.conv.singular, me) chk.cconv(check.conv.hess , me) if (mod.type=="glmer" && use.last.params && calc.derivs) { warning("using ",shQuote("use.last.params"),"=TRUE and ", shQuote("calc.derivs"),"=TRUE with ",shQuote("glmer"), " will not give backward-compatible results") } ret <- namedList(optimizer, restart_edge, boundary.tol, calc.derivs, use.last.params, checkControl = namedList(autoscale, check.nobs.vs.rankZ, check.nobs.vs.nlev, check.nlev.gtreq.5, check.nlev.gtr.1, check.nobs.vs.nRE, check.rankX, check.scaleX, check.formula.LHS), checkConv= namedList(check.conv.nobsmax, check.conv.nparmax, check.conv.grad, check.conv.singular, check.conv.hess), optCtrl=optCtrl) if (mod.type=="glmer") { ret <- c(ret, namedList(tolPwrss, compDev, nAGQ0initStep)) ret$checkControl <- c(ret$checkControl, namedList(check.response.not.const)) } class(ret) <- c(c.opts, "merControl") ret } lmerControl <- merControl glmerControl <- merControl formals(glmerControl)[["check.conv.nparmax"]] <- 20 formals(glmerControl)[["optimizer"]] <- c("bobyqa","Nelder_Mead") formals(glmerControl)[["mod.type"]] <- "glmer" formals(glmerControl)[["restart_edge"]] <- FALSE formals(glmerControl) <- c(formals(glmerControl), list(tolPwrss=1e-7, compDev = TRUE, nAGQ0initStep = TRUE, check.response.not.const="stop") ) ##' @rdname lmerControl ##' @export nlmerControl <- function(optimizer="Nelder_Mead", tolPwrss = 1e-10, optCtrl = list()) { stopifnot(is.list(optCtrl)) if (length(optimizer)==1) { optimizer <- replicate(2,optimizer) } structure(namedList(optimizer, tolPwrss, optCtrl=optCtrl), class = c("nlmerControl", "merControl")) } lme4/R/deriv.R0000644000176200001440000000675715202440357012571 0ustar liggesusers ##' This function computes the 1st and 2nd derivative (gradient and ##' Hessian) of a function ##' with vector-valued input and scalar output using a central finite ##' difference method. ##' ##' The function has to return a single scalar numerical value and take ##' as argument a numeric vector of the same length as \code{x}. The function also ##' has to be evaluable in a neighborhood around \code{x}, i.e. at ##' \code{x - delta} and at \code{x + delta} for all elements in \code{x}. ##' ##' @title Compute 1st and 2nd derivative ##' @param fun function for which to compute the gradient. ##' @param x numeric vector of values at which to compute the ##' gradient. ##' @param delta the amount to subtract and add to \code{x} when computing the ##' central difference. ##' @param fx optional value of \code{fun(x, ...)}. ##' @param ... additional arguments to \code{fun}. ##' ##' @keywords utilities ##' @export ##' @family derivatives ##' ##' @return a list with components ##' \item{gradient}{the first derivative vector} ##' \item{Hessian}{the second derivative matrix} ##' @author Rune Haubo Bojesen Christensen ##' deriv12 <- function(fun, x, delta=1e-4, fx=NULL, lower=rep(NA_real_,length(x)), upper=rep(NA_real_,length(x)), ...) { ### Compute gradient and Hessian simultaneously (to save computing time) nx <- length(x) if(is.null(fx)) fx <- fun(x, ...) stopifnot(length(fx) == 1, nx >= 1) H <- array(NA_real_, dim=c(nx, nx)) g <- numeric(nx) xadd <- x + delta hasUB <- !missing(upper) && any(active <- !is.na(upper)) if(hasUB) { # only then may have non-NA if((hasUB <- any(active <- active & xadd > upper))) { udelta <- ifelse(active, upper-x, delta) xadd[active] <- upper[active] } } xsub <- x - delta hasLB <- !missing(lower) && any(active <- !is.na(lower)) if(hasLB) { # only then may have non-NA if((hasLB <- any(active <- active & xsub < lower))) { ldelta <- ifelse(active, x-lower, delta) xsub[active] <- lower[active] } } ## substitute elements of 'mod' vectors into position(s) 'pos' ## in base spos <- function(base,mod,pos) { if (is.list(mod)) { for (i in seq_along(mod)) { base <- spos(base,mod[[i]],pos[i]) } base } else { base[pos] <- mod[pos] base } } for(j in 1:nx) { ## Diagonal elements: fadd <- fun(spos(x,xadd,j), ...) fsub <- fun(spos(x,xsub,j), ...) udj <- if(hasUB) udelta[j] else delta ldj <- if(hasLB) ldelta[j] else delta H[j, j] <- fadd/udj^2 - 2 * fx/(udj*ldj) + fsub/ldj^2 g[j] <- (fadd - fsub) / (udj+ldj) # "total delta" (udelta+ldelta)[j] ## Off diagonal elements: for(i in seq_len(j - 1L)) { # 1 <= i < j ## Compute upper triangular elements (and mirror to lower tri.): ud.i <- if(hasUB) udelta[i] else delta ld.i <- if(hasLB) ldelta[i] else delta xaa <- spos(x,list(xadd,xadd),c(i,j)) xas <- spos(x,list(xadd,xsub),c(i,j)) xsa <- spos(x,list(xsub,xadd),c(i,j)) xss <- spos(x,list(xsub,xsub),c(i,j)) H[i, j] <- H[j, i] <- fun(xaa, ...)/(ud.i+udj)^2 - fun(xas, ...)/(ud.i+ldj)^2 - fun(xsa, ...)/(ld.i+udj)^2 + fun(xss, ...)/(ld.i+ldj)^2 } } list(gradient = g, Hessian = H) } lme4/R/VarCorr.R0000644000176200001440000001312615155630632013026 0ustar liggesusersmkVarCorr <- function(sc, cnms, nc = lengths(cnms, use.names = FALSE), theta, nms = names(cnms), reCovs = NULL, relReCovs = TRUE) { if (!missing(nc)) { nc <- as.integer(nc) if (!missing(cnms) && !identical(nc, lengths(cnms, use.names = FALSE))) stop("'nc' and lengths(cnms) are inconsistent") } if (!missing(nms)) { if (!missing(cnms) && !identical(nms, names(cnms))) stop("'nms' and names(cnms) are inconsistent") } if (is.null(reCovs)) reCovs <- .mapply(new, list(nc = nc, par = split(theta, rep(seq_along(nc), (nc * (nc + 1L)) %/% 2L))), list(Class = "Covariance.us")) ans <- lapply(seq_along(reCovs), function(i) { ## Li := \Lambda_i, the i-th diagonal block of \Lambda(\theta) ## Si := \sigma^2 \Lambda_i \Lambda_i' object <- reCovs[[i]] nci <- nc[i] cnmsi <- cnms[[i]] Li <- getLambda(object) jj <- seq.int(from = 1L, by = nci + 1L, length.out = nci) Si <- if (relReCovs) sc * sc * tcrossprod(Li) else tcrossprod(Li) Si.sd <- sqrt(Si[jj]) Si.cor <- Si/Si.sd/rep(Si.sd, each = nci) Si.cor[jj] <- 1 typ0 <- typ1 <- sub("^Covariance[.]", "", class(object)) switch(typ0, # respecting the conventions of, e.g., glmmTMB: "cs" = if ( object@hom) typ1 <- "homcs", "ar1" = if (!object@hom) typ1 <- "hetar1") class(Si) <- c(paste0("vcmat_", typ1), "matrix", "array") dimnames(Si) <- dimnames(Si.cor) <- list(cnmsi, cnmsi) names(Si.sd) <- cnmsi attr(Si, "stddev") <- Si.sd attr(Si, "correlation") <- Si.cor Si }) if (!is.null(nms)) { ## FIXME: ## Do we want this? Maybe not. 'nms' are not necessarily ## unique, e.g., 'fm2' from example("lmer") has *two* Subject ## terms, so the names are "Subject", "Subject". The 'print' ## method for 'VarCorr.merMod' handles this just fine, but ## it's a little awkward if we want to dig out components of ## the list ... if (anyDuplicated(nms)) nms <- make.names(nms, unique = TRUE) names(ans) <- nms } ## if (relReCovs) # rev. dep. (e.g., 'gamm4') use it unconditionally attr(ans, "sc") <- sc ans } ## MJ: ## Maintain this list manually as prefixing convention is inconsistent. for (.nm in c("us", "diag", "cs", "homcs", "ar1", "hetar1")) setOldClass(c(paste0("vcmat_", .nm), "matrix", "array")) rm(.nm) VarCorr.merMod <- function(x, sigma = 1, ...) { ## TODO? add argument type=c("varcov", "sdcor", "logs") useSc <- !isGLMM(x) sc <- if (missing(sigma)) sigma(x) else sigma cnms <- x@cnms nc <- lengths(cnms, use.names = FALSE) theta <- x@theta nms <- names(x@flist)[attr(x@flist, "assign")] reCovs <- getReCovs(x) ans <- mkVarCorr(sc = sc, cnms = cnms, nc = nc, theta = theta, nms = nms, reCovs = reCovs, relReCovs = useSc) class(ans) <- "VarCorr.merMod" ## FIXME: ## Here we have ## 'useSc' is TRUE <=> 'sc' is a residual standard deviation ## but that does *not* match the interpretation of ## as.logical(x@devcomp$dims[["useSc"]]) ## ... attr(ans, "useSc") <- useSc # used by reformulas::formatVC ans } as.data.frame.VarCorr.merMod <- function(x, row.names = NULL, optional = FALSE, order = c("cov.last", "lower.tri"), ...) { order <- match.arg(order) dlist <- lapply(seq_along(x), function(i) { Si <- x[[i]] Si.sd <- attr(Si, "stddev") Si.cor <- attr(Si, "correlation") nci <- ncol(Si) cnmsi <- colnames(Si) jj <- seq.int(from = 1L, by = nci + 1L, length.out = nci) ij1 <- sequence.default(from = jj, nvec = nci:1L) ij0 <- sequence.default(from = jj + 1L, nvec = (nci - 1L):0L) if (order == "cov.last") data.frame(grp = names(x)[i], var1 = cnmsi[c(1L:nci, 1L + (ij0 - 1L) %/% nci)], var2 = cnmsi[c(rep(NA_integer_, nci), 1L + (ij0 - 1L) %% nci)], vcov = Si[c(jj, ij0)], sdcor = c(Si.sd, Si.cor[ij0]), row.names = NULL, stringsAsFactors = FALSE) else { jj. <- cumsum(c(1L, if (nci > 1L) nci:2L)) data.frame(grp = names(x)[i], var1 = cnmsi[1L + (ij1 - 1L) %/% nci], var2 = `[<-`(cnmsi[1L + (ij1 - 1L) %% nci], jj., NA_character_), vcov = Si[ij1], sdcor = `[<-`(Si.cor[ij1], jj., Si.sd), row.names = NULL, stringsAsFactors = FALSE) } }) if (attr(x, "useSc")) { sc <- attr(x, "sc") r <- data.frame(grp = "Residual", var1 = NA_character_, var2 = NA_character_, vcov = sc * sc, sdcor = sc, row.names = NULL, stringsAsFactors = FALSE) dlist <- c(dlist, list(r)) } do.call(rbind, dlist) } print.VarCorr.merMod <- function(x, digits = max(3L, getOption("digits") - 2L), comp = "Std.Dev.", formatter = format, ...) { y <- formatVC(x, digits = digits, comp = comp, formatter = formatter) print(y, quote = FALSE) invisible(x) } lme4/R/rePCA.R0000644000176200001440000000167415036542626012412 0ustar liggesusers##' PCA of random-effects variance-covariance estimates ##' ##' Perform a Principal Components Analysis (PCA) of the random-effects ##' variance-covariance estimates from a fitted mixed-effects model ##' @title PCA of random-effects ##' @param x a merMod object ##' @return a \code{prcomplist} object ##' @author Douglas Bates ##' @export rePCA <- function(x) UseMethod('rePCA') #' @export rePCA.merMod <- function(x) { chfs <- getME(x,"Tlist") # list of lower Cholesky factors nms <- names(chfs) unms <- unique(nms) names(unms) <- unms svals <- function(m) { vv <- svd(m,nv=0L) names(vv) <- c("sdev","rotation") vv$center <- FALSE vv$scale <- FALSE class(vv) <- "prcomp" vv } structure(lapply(unms,function(m) svals(Matrix::bdiag(chfs[which(nms == m)]))), class="prcomplist") } #' @export summary.prcomplist <- function(object,...) { lapply(object,summary) } lme4/R/GHrule.R0000644000176200001440000000301115206606050012620 0ustar liggesusers##' Create a univariate Gauss-Hermite quadrature rule ##' ##' This version of Gauss-Hermite quadrature provides the node ##' positions and weights for a scalar integral of a function ##' multiplied by the standard normal density. GHrule <- function (ord, asMatrix=TRUE) { stopifnot(length(ord) == 1, (ord <- as.integer(ord)) >= 0L, ord < 101L) if (ord == 0L) { if (asMatrix) return(matrix(0, nrow=0L, ncol=3L)) stop ("combination of ord==0 and asMatrix==TRUE not implemented") } ## fgq_rules comes from sysdata.rda: ## result of ## library("fastGHQuad") ## rescale <- function(x, scale.weights=TRUE, scale.roots=TRUE) { ## within(x, { ## if (scale.weights) w <- w/sum(w) ## if (scale.roots) x <- x*sqrt(2) ## }) ## } ## fgqRules <- lapply(1:100, function(n) setNames(rescale(gaussHermiteData(n)), c("z", "w"))) ## ## However, this shows small differences !! ## all.equal(lme4:::fgq_rules, fgqRules, tol=0) fr <- as.data.frame(fgq_rules[[ord]]) rownames(fr) <- NULL ## Repositioning them similar to how it's done in MixedModels.jl, ## by averaging the weights in forward and reverse order and the locations ## in forward order and negative locations in reverse order. ## See: https://github.com/lme4/lme4/issues/968#issuecomment-4467149014 fr$z <- (fr$z - rev(fr$z)) / 2 fr$w <- (fr$w + rev(fr$w)) / 2 fr$ldnorm <- dnorm(fr$z, log=TRUE) if (asMatrix) as.matrix(fr) else fr } lme4/R/sparsegrid.R0000644000176200001440000000263715036542626013623 0ustar liggesusers## Generate sparse multidimensional Gaussian quadrature grids ---> ../man/GQdk.Rd ## Unused currently; rather GHrule() --> ./GHrule.R GQdk <- function(d=1L, k=1L) { stopifnot(0L < (d <- as.integer(d)[1]), d <= 20L, 0L < (k <- as.integer(k)[1]), k <= length(GQNd <- GQN[[d]]))## -> GQN, stored in ./sysdata.rda tmat <- t(GQNd[[k]]) ##rperms<- combinat::permn(seq_len(d) + 1L, function(v) c(1L,v)) ## rperms <- lapply(.Call(allPerm_int, seq_len(d) + 1L), function(v) c(1L, v)) perms <- tryCatch ( .Call(allPerm_int, seq_len(d) + 1L, as.integer(factorial(d))), warning = function (w) w, error = function (e) e) if (methods::is(perms, "error") | methods::is(perms, "warning")) stop("Can not allocate a vector that large") rperms <- lapply(perms, function(v) c(1L, v)) dd <- unname(as.matrix(do.call(expand.grid, c(rep.int(list(c(-1,1)), d), KEEP.OUT.ATTRS=FALSE)))) #unname(unique(t(do.call(cbind, # lapply(as.data.frame(t(cbind(1, dd))), # "*", e2=do.call(cbind, lapply(rperms, function(ind) tmat[ind,]))))))) e2 <- do.call(cbind, lapply(rperms, function(ind) tmat[ind,])) ddf <- as.data.frame(t(cbind(1,dd))) res <- NULL for (i in 1:ncol(ddf)) res <- unique(rbind(res, t(ddf[, i] * e2))) return(res) } lme4/R/covariance.R0000644000176200001440000015553115200173413013557 0ustar liggesusers## .... CLASSES ........................................................ ## ## Objects inheriting from virtual class "Covariance" represent ## 'nc'-by-'nc' covariance matrices 'S' using 'par', a vector storing ## nc*(nc+1)/2 or fewer parameters. ## ## Subclasses must define a mapping ## ## par [double] ----> ( theta [double] , thetaIndex [integer] ) ## ## such that theta[thetaIndex] stores in column-major order the ## structurally nonzero entries of Lambdat := chol(S). By convention, ## subclasses will define 'theta' as storing in *row-major* order only ## the *independent* structurally nonzero entries of 'Lambdat', keeping ## the length of 'theta' to a minimum. ## ## MJ: ## Why do we change the storage order, when doing so greatly complicates ## determination of 'thetaIndex'? ## setClass("Covariance", contains = "VIRTUAL", slots = c(nc = "integer", par = "numeric"), prototype = list(nc = 0L), validity = function (object) { if (length(nc <- object@nc) != 1L || is.na(nc) || nc < 0L) gettextf("'%s' is not a non-negative integer", "nc") else if (!is.double(object@par)) gettextf("type of '%s' is not \"%s\"", "par", "double") else TRUE }) setClass("Covariance.us", contains = "Covariance", validity = function (object) { nc <- object@nc if (length(object@par) != (nc * (nc - 1L)) %/% 2L + nc) gettextf("length of '%s' is not %s", "par", "nc*(nc+1)/2") else TRUE }) setClass("Covariance.diag", contains = "Covariance", slots = c(hom = "logical"), prototype = list(hom = FALSE), validity = function (object) { nc <- object@nc if (length(hom <- object@hom) != 1L || is.na(hom)) gettextf("'%s' is not %s or %s", "hom", "TRUE", "FALSE") else if (length(par <- object@par) != if (hom) nc > 0L else nc) { if (hom) gettextf("length of '%s' is not %d", "par", nc > 0L) else gettextf("length of '%s' is not '%s'", "par", "nc") } else TRUE }) setClass("Covariance.cs", contains = "Covariance", slots = c(hom = "logical"), prototype = list(hom = FALSE), validity = .fn <- function (object) { nc <- object@nc if (length(hom <- object@hom) != 1L || is.na(hom)) gettextf("'%s' is not %s or %s", "hom", "TRUE", "FALSE") else if (length(par <- object@par) != (if (hom) nc > 0L else nc) + (nc > 1L)) gettextf("length of '%s' is not %s", "par", if (hom) "(nc>0)+(nc>1)" else "nc+(nc>1)") else TRUE }) setClass("Covariance.ar1", contains = "Covariance", slots = c(hom = "logical"), prototype = list(hom = TRUE), validity = .fn) rm(.fn) ## .... GENERIC FUNCTIONS .............................................. setGeneric("getPar", function (object) standardGeneric("getPar")) setGeneric("getParLength", function (object) standardGeneric("getParLength")) setGeneric("getParNames", function (object, cnm, gnm, prf = NULL, old = TRUE) standardGeneric("getParNames"), signature = c("object", "cnm", "gnm")) setGeneric("setPar", function (object, value, pos = 0L) standardGeneric("setPar")) setGeneric("getTheta", function (object) standardGeneric("getTheta")) setGeneric("getThetaLength", function (object) standardGeneric("getThetaLength")) setGeneric("getThetaNames", function (object, cnm, gnm, prf = NULL, old = TRUE) standardGeneric("getThetaNames"), signature = c("object", "cnm", "gnm")) setGeneric("getThetaIndex", function (object) standardGeneric("getThetaIndex")) setGeneric("getThetaIndexLength", function (object) standardGeneric("getThetaIndexLength")) setGeneric("setTheta", function (object, value, pos = 0L) standardGeneric("setTheta"), signature = c("object", "value")) setGeneric("getLower", function (object) standardGeneric("getLower")) setGeneric("getUpper", function (object) standardGeneric("getUpper")) setGeneric("getLambda", function (object) standardGeneric("getLambda")) setGeneric("getLambdat.dp", function (object) standardGeneric("getLambdat.dp")) setGeneric("getLambdat.i", function (object) standardGeneric("getLambdat.i")) setGeneric("getVC", function (object) standardGeneric("getVC")) setGeneric("getVCNames", function (object, cnm, gnm, prf = NULL, old = TRUE) standardGeneric("getVCNames"), signature = c("object", "cnm", "gnm")) setGeneric("setVC", function (object, vcomp, ccomp) standardGeneric("setVC")) setGeneric("getProfPar", function (object, profscale, sc = NULL) { profscale <- validProfScale(profscale) standardGeneric("getProfPar") }, signature = "object") setGeneric("setProfPar", function (object, profscale, sc = NULL, value, pos = 0L) { profscale <- validProfScale(profscale) standardGeneric("setProfPar") }, signature = c("object", "value")) setGeneric("getProfLower", function (object, profscale, sc = NULL) { profscale <- validProfScale(profscale) standardGeneric("getProfLower") }, signature = "object") setGeneric("getProfUpper", function (object, profscale, sc = NULL) { profscale <- validProfScale(profscale) standardGeneric("getProfUpper") }, signature = "object") setGeneric("isSingular", ## S4 default method dispatching S3 methods: function (object, tol = getSingTol()) UseMethod("isSingular"), signature = "object") ## .... METHODS ........................................................ setMethod("initialize", c(.Object = "Covariance.us"), function (.Object, nc = .Object@nc, par, simulate = FALSE, ...) { if (missing(par) && is.integer(nc) && length(nc) == 1L && !is.na(nc) && nc >= 0L) { .Object@nc <- nc .Object@par <- `[<-`((if (simulate) rnorm else double)( (nc * (nc - 1L)) %/% 2L + nc), cumsum(c(if (nc > 0L) 1L, if (nc > 1L) nc:2L)), if (simulate) rlnorm(nc) else 1) .Object } else callNextMethod() }) setMethod("initialize", c(.Object = "Covariance.diag"), function (.Object, nc = .Object@nc, hom = .Object@hom, par, simulate = FALSE, ...) { if (missing(par) && is.integer(nc) && length(nc) == 1L && !is.na(nc) && nc >= 0L && is.logical(hom) && length(hom) == 1L && !is.na(hom)) { .Object@nc <- nc .Object@hom <- hom .Object@par <- (if (simulate) rlnorm else function (n) rep(1, n))( if (hom) 1L * (nc > 0L) else nc) .Object } else callNextMethod() }) setMethod("initialize", c(.Object = "Covariance.cs"), function (.Object, nc = .Object@nc, hom = .Object@hom, par, simulate = FALSE, ...) { if (missing(par) && is.integer(nc) && length(nc) == 1L && !is.na(nc) && nc >= 0L && is.logical(hom) && length(hom) == 1L && !is.na(hom)) { .Object@nc <- nc .Object@hom <- hom .Object@par <- c((if (simulate) rlnorm else function (n) rep(1, n))( if (hom) 1L * (nc > 0L) else nc), if (nc > 1L) { if (simulate) runif(1L, -1/(nc - 1), 1) else 0 }) .Object } else callNextMethod() }) setMethod("initialize", c(.Object = "Covariance.ar1"), function (.Object, nc = .Object@nc, hom = .Object@hom, par, simulate = FALSE, ...) { if (missing(par) && is.integer(nc) && length(nc) == 1L && !is.na(nc) && nc >= 0L && is.logical(hom) && length(hom) == 1L && !is.na(hom)) { .Object@nc <- nc .Object@hom <- hom .Object@par <- c((if (simulate) rlnorm else function (n) rep(1, n))( if (hom) 1L * (nc > 0L) else nc), if (nc > 1L) { if (simulate) runif(1L, -1, 1) else 0 }) .Object } else callNextMethod() }) setMethod("getPar", c(object = "Covariance"), function (object) object@par) setMethod("getParLength", c(object = "Covariance"), function (object) length(object@par)) ## cnm: column names (i.e., effect names) ## gnm: group name ## prf: prefix setMethod("getParNames", c(object = "Covariance.us", cnm = "character", gnm = "character"), getParNames.us <- function (object, cnm, gnm, prf = NULL, old = TRUE) { nc <- object@nc stopifnot(length(cnm) == nc, length(gnm) == 1L) inc <- seq_len(nc) dec <- seq.int(from = nc, by = -1L, length.out = nc) i <- sequence.default(from = inc, nvec = dec) j <- rep(inc, dec) ans <- if (old) paste0(gnm, ".", cnm[i], ".", cnm[j]) else if (is.null(prf)) paste0(cnm[i], ".", cnm[j], "|", gnm) else paste0(prf[[2L]], "_", cnm[i], ".", cnm[j], "|", gnm) ans[cumsum(c(if (nc > 0L) 1L, if (nc > 1L) nc:2L))] <- if (old) paste0(gnm, ".", cnm) else if (is.null(prf)) paste0(cnm, "|", gnm) else paste0(prf[[1L]], "_", cnm, "|", gnm) ans }) setMethod("getParNames", c(object = "Covariance.diag", cnm = "character", gnm = "character"), getParNames.diag <- function (object, cnm, gnm, prf = NULL, old = TRUE) { nc <- object@nc stopifnot(length(cnm) == nc, length(gnm) == 1L) if (object@hom && nc > 0L) cnm <- "*" if (old) paste0(gnm, ".", cnm) else if (is.null(prf)) paste0(cnm, "|", gnm) else paste0(prf[[1L]], "_", cnm, "|", gnm) }) setMethod("getParNames", c(object = "Covariance.cs", cnm = "character", gnm = "character"), .fn <- function (object, cnm, gnm, prf = NULL, old = TRUE) { nc <- object@nc stopifnot(length(cnm) == nc, length(gnm) == 1L) if (object@hom && nc > 0L) cnm <- "*" if (old) paste0(gnm, ".", c(cnm, if (nc > 1L) "rho")) else if (is.null(prf)) paste0(c(cnm, if (nc > 1L) "rho"), "|", gnm) else c(paste0(prf[[1L]], "_", cnm, "|", gnm), paste0(prf[[2L]], "_", "rho", "|", gnm)) }) setMethod("getParNames", c(object = "Covariance.ar1", cnm = "character", gnm = "character"), .fn) rm(.fn) setMethod("setPar", c(object = "Covariance", value = "numeric"), function (object, value, pos = 0L) { np <- length(object@par) validValuePos(np, value, pos) object@par <- if (np == length(value)) value else value[seq.int(from = pos + 1L, length.out = np)] object }) setMethod("getTheta", c(object = "Covariance.us"), .fn <- function (object) object@par) ## L[i, j]/sigma[i] = ## if (i == j) ## 1 ## else 0 setMethod("getTheta", c(object = "Covariance.diag"), .fn) rm(.fn) ## L[i, j]/sigma[i] = ## if (i == j) ## sqrt(1 - rho^2 * a[j]) ## else (rho - rho^2 * a[j])/sqrt(1 - rho^2 * a[j]) ## where ## a[ 1] := 0 ## a[j + 1] := a[j] + (1 - rho * a[j])^2/(1 - rho^2 * a[j]) setMethod("getTheta", c(object = "Covariance.cs"), function (object) { nc <- object@nc par <- object@par if (nc <= 1L) return(par) rho2 <- (rho <- par[length(par)])^2 a <- double(nc); a. <- 0 for (j in 1L:nc) { a[j] <- a. a. <- a. + (1 - rho * a.)^2/(1 - rho2 * a.) } ## some optimizers (bobyqa?) will violate bounds, try abs(rho)>1 ## suppress warnings (NaN values will be handled downstream) v. <- suppressWarnings(sqrt(1 - rho2 * a)) v <- rbind(v., (rho - rho2 * a)/v.) if (object@hom) par[1L] * v[1L:(2L * nc - 1L)] else par[sequence.default(from = 1L:nc, nvec = nc:1L)] * rep(v, rbind(1L, (nc - 1L):0L)) }) ## L[i, j]/sigma[i] = ## if (j == 1) ## rho^(i - 1) ## else rho^(i - j) * sqrt(1 - rho^2) setMethod("getTheta", c(object = "Covariance.ar1"), function (object) { nc <- object@nc par <- object@par if (nc <= 1L) return(par) rho2 <- (rho <- par[length(par)])^2 v1 <- rho^(0L:(nc - 1L)) v2 <- rho^(0L:(nc - 2L)) * sqrt(1 - rho2) if (object@hom) par[1L] * c(v1, v2) else par[sequence.default(from = 1L:nc, nvec = nc:1L)] * c(v1, v2[sequence.default(from = 1L, nvec = (nc - 1L):1L)]) }) setMethod("getThetaLength", c(object = "Covariance.us"), .fn <- function (object) length(object@par)) setMethod("getThetaLength", c(object = "Covariance.diag"), .fn) rm(.fn) setMethod("getThetaLength", c(object = "Covariance.cs"), .fn <- function (object) { nc <- object@nc if (object@hom) 2L * nc - (nc > 0L) else (nc * (nc - 1L)) %/% 2L + nc }) setMethod("getThetaLength", c(object = "Covariance.ar1"), .fn) rm(.fn) setMethod("getThetaNames", c(object = "Covariance.us", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) getParNames.us(object, cnm, gnm, prf, old)) setMethod("getThetaNames", c(object = "Covariance.diag", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) getParNames.diag(object, cnm, gnm, prf, old)) setMethod("getThetaNames", c(object = "Covariance.cs", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) { if (object@hom) { nc <- object@nc rbind(if (old) paste0(gnm, ".", cnm) else if (is.null(prf)) paste0(cnm, "|", gnm) else paste0(prf[[1L]], "_", cnm, "|", gnm), if (old) paste0(gnm, ".", "*", ".", cnm) else if (is.null(prf)) paste0("*", ".", cnm, "|", gnm) else paste0(prf[[2L]], "_", "*", ".", cnm, "|", gnm))[seq_len(2L * nc - 1L)] } else getParNames.us(object, cnm, gnm, prf, old) }) setMethod("getThetaNames", c(object = "Covariance.ar1", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) { if (object@hom) { nc <- object@nc i <- if (nc > 1L) c(1L:nc, 2L:nc) else nc j <- if (nc > 1L) rep(1L:2L, nc:(nc - 1L)) else nc k <- seq_len(min(2L, nc)) ans <- if (old) paste0(gnm, ".", cnm[i], ".", cnm[j]) else if (is.null(prf)) paste0(cnm[i], ".", cnm[j], "|", gnm) else paste0(prf[[2L]], "_", cnm[i], ".", cnm[j], "|", gnm) ans[c(1L, nc + 1L)[k]] <- if (old) paste0(gnm, ".", cnm[k]) else if (is.null(prf)) paste0(cnm[k], "|", gnm) else paste0(prf[[2L]], "_", cnm[k], "|", gnm) ans } else getParNames.us(object, cnm, gnm, prf, old) }) setMethod("getThetaIndex", c(object = "Covariance.us"), getThetaIndex.us <- function (object) { snc <- seq_len(nc <- object@nc) rep(seq.int(from = 1L - nc, length.out = nc), snc) + cumsum(seq.int(from = nc, by = -1L, length.out = nc))[ sequence.default(from = 1L, nvec = snc)] }) setMethod("getThetaIndex", c(object = "Covariance.diag"), function (object) { nc <- object@nc if (object@hom) rep(1L, nc) else seq_len(nc) }) setMethod("getThetaIndex", c(object = "Covariance.cs"), function (object) { if (object@hom) { snc <- seq_len(nc <- object@nc) `[<-`(sequence.default(from = 2L, by = 2L, nvec = snc), cumsum(snc), seq.int(from = 1L, by = 2L, length.out = nc)) } else getThetaIndex.us(object) }) setMethod("getThetaIndex", c(object = "Covariance.ar1"), function (object) { if (object@hom) { snc <- seq_len(nc <- object@nc) `[<-`(sequence.default(from = seq.int(from = nc + 1L, length.out = nc), by = -1L, nvec = snc), 1L + cumsum(seq.int(from = 0L, length.out = nc)), snc) } else getThetaIndex.us(object) }) setMethod("getThetaIndexLength", c(object = "Covariance.us"), function (object) { nc <- object@nc (nc * (nc - 1L)) %/% 2L + nc }) setMethod("getThetaIndexLength", c(object = "Covariance.diag"), function (object) object@nc) setMethod("getThetaIndexLength", c(object = "Covariance.cs"), function (object) { nc <- object@nc (nc * (nc - 1L)) %/% 2L + nc }) setMethod("getThetaIndexLength", c(object = "Covariance.ar1"), function (object) { nc <- object@nc (nc * (nc - 1L)) %/% 2L + nc }) setMethod("setTheta", c(object = "Covariance.us", value = "numeric"), .fn <- function (object, value, pos = 0L) { nt <- length(object@par) validValuePos(nt, value, pos) object@par <- if (nt == length(value)) value else value[seq.int(from = pos + 1L, length.out = nt)] object }) setMethod("setTheta", c(object = "Covariance.diag", value = "numeric"), .fn) rm(.fn) setMethod("setTheta", c(object = "Covariance.cs", value = "numeric"), function (object, value, pos = 0L) { nc <- object@nc hom <- object@hom nt <- if (hom) 2L * nc - (nc > 0L) else (nc * (nc - 1L)) %/% 2L + nc validValuePos(nt, value, pos) object@par <- if (nc <= 1L) value[if (nc > 0L) 1L] else { ## L[2, 1] = sigma[2] * rho l21 <- value[pos + 1L + 1L] ## L[2, 2] = sigma[2] * sqrt(1 - rho^2) l22 <- value[pos + 1L + if (hom) 2L else nc] rho <- if (l21 != 0 || l22 != 0) sign(l21) * 1/sqrt(1 + (l22/l21)^2) else { ## Fall back to constructing the Cholesky factor i <- sequence.default(from = seq.int(from = 1L, by = nc + 1L, length.out = nc), nvec = nc:1L) j <- if (hom) rep((pos + 1L):(pos + 2L * nc - 1L), rbind(1L, (nc - 1L):0L)) else (pos + 1L):(pos + (nc * (nc - 1L)) %/% 2L + nc) L <- matrix(0, nc, nc) L[i] <- value[j] d <- sqrt(rowSums(L * L)) h <- order(d, decreasing = TRUE)[1L:2L] d12 <- prod(d[h]) if (d12 == 0) stop(gettextf("'%s' is not identifiable as there is no pair of nonzero standard deviations", "rho"), domain = NA) sum(L[h[1L], ] * L[h[2L], ])/d12 } sigma <- if (hom) value[pos + 1L] else if (rho == 0) value[cumsum(c(pos + 1L, nc:2L))] else value[seq.int(from = pos + 1L, length.out = nc)]/ rep(c(1, rho), c(1L, nc - 1L)) c(sigma, rho) } object }) setMethod("setTheta", c(object = "Covariance.ar1", value = "numeric"), function (object, value, pos = 0L) { nc <- object@nc hom <- object@hom nt <- if (hom) 2L * nc - (nc > 0L) else (nc * (nc - 1L)) %/% 2L + nc validValuePos(nt, value, pos) object@par <- if (nc <= 1L) value[if (nc > 0L) 1L] else { ## L[2, 1] = sigma[2] * rho l21 <- value[pos + 1L + 1L] ## L[2, 2] = sigma[2] * sqrt(1 - rho^2) l22 <- value[pos + 1L + nc] rho <- if (l21 != 0 || l22 != 0) sign(l21) * 1/sqrt(1 + (l22/l21)^2) else { ## Fall back to constructing the Cholesky factor i <- sequence.default(from = seq.int(from = 1L, by = nc + 1L, length.out = nc), nvec = nc:1L) j <- if (hom) sequence.default(from = rep(pos + 1L + c(0L, nc), c(1L, nc - 1L)), nvec = nc:1L) else (pos + 1L):(pos + (nc * (nc - 1L)) %/% 2L + nc) L <- matrix(0, nc, nc) L[i] <- value[j] d <- sqrt(rowSums(L * L)) h <- order(d, decreasing = TRUE)[1L:2L] d12 <- prod(d[h]) if (d12 == 0) stop(gettextf("'%s' is not identifiable as there is no pair of nonzero standard deviations", "rho"), domain = NA) (sum(L[h[1L], ] * L[h[2L], ])/d12)^(1/abs(h[1L] - h[2L])) } sigma <- if (hom) value[pos + 1L] else if (rho == 0) value[cumsum(c(pos + 1L, nc:2L))] else # avoid underflow of powers of abs(rho) exp(log(abs(value[seq.int(from = pos + 1L, length.out = nc)])) - (0L:(nc - 1L)) * log(abs(rho))) c(sigma, rho) } object }) setMethod("getLower", c(object = "Covariance.us"), function (object) { nc <- object@nc ## FIXME: make more scrutable! `[<-`(rep(-Inf, length(object@par)), cumsum(c(if (nc > 0L) 1L, if (nc > 1L) nc:2L)), 0) }) setMethod("getLower", c(object = "Covariance.diag"), function (object) double(length(object@par))) setMethod("getLower", c(object = "Covariance.cs"), function (object) { nc <- object@nc c(double(if (object@hom) 1L * (nc > 0L) else nc), if (nc > 1L) -1/(nc - 1L)) }) setMethod("getLower", c(object = "Covariance.ar1"), function (object) { nc <- object@nc c(double(if (object@hom) 1L * (nc > 0L) else nc), if (nc > 1L) -1) }) setMethod("getUpper", c(object = "Covariance.us"), function (object) rep(Inf, length(object@par))) setMethod("getUpper", c(object = "Covariance.diag"), function (object) rep(Inf, length(object@par))) setMethod("getUpper", c(object = "Covariance.cs"), function (object) { nc <- object@nc c(rep(Inf, if (object@hom) 1L * (nc > 0L) else nc), if (nc > 1L) 1) }) setMethod("getUpper", c(object = "Covariance.ar1"), function (object) { nc <- object@nc c(rep(Inf, if (object@hom) 1L * (nc > 0L) else nc), if (nc > 1L) 1) }) setMethod("getLambda", c(object = "Covariance.us"), function (object) { nc <- object@nc ans <- matrix(0, nc, nc) if (nc > 0L) ans[lower.tri(ans, diag = TRUE)] <- object@par ans }) setMethod("getLambda", c(object = "Covariance.diag"), function (object) { nc <- object@nc diag(object@par, nc, nc) }) setMethod("getLambda", c(object = "Covariance.cs"), function (object) { nc <- object@nc ans <- matrix(0, nc, nc) if (nc > 0L) ans[lower.tri(ans, diag = TRUE)] <- if (object@hom) rep(getTheta(object), rbind(1L, (nc - 1L):0L)[seq_len(2L * nc - 1L)]) else getTheta(object) ans }) setMethod("getLambda", c(object = "Covariance.ar1"), function (object) { nc <- object@nc ans <- matrix(0, nc, nc) if (nc > 0L) ans[lower.tri(ans, diag = TRUE)] <- if (object@hom) getTheta(object)[sequence.default(from = rep(c(1L, nc + 1L), c(1L, nc - 1L)), nvec = nc:1L)] else getTheta(object) ans }) setMethod("getLambdat.dp", c(object = "Covariance.us"), function (object) seq_len(object@nc)) setMethod("getLambdat.dp", c(object = "Covariance.diag"), function (object) rep(1L, object@nc)) setMethod("getLambdat.dp", c(object = "Covariance.cs"), function (object) seq_len(object@nc)) setMethod("getLambdat.dp", c(object = "Covariance.ar1"), function (object) seq_len(object@nc)) setMethod("getLambdat.i", c(object = "Covariance.us"), function (object) sequence.default(from = 0L, nvec = seq_len(object@nc))) setMethod("getLambdat.i", c(object = "Covariance.diag"), function (object) seq.int(from = 0L, length.out = object@nc)) setMethod("getLambdat.i", c(object = "Covariance.cs"), function (object) sequence.default(from = 0L, nvec = seq_len(object@nc))) setMethod("getLambdat.i", c(object = "Covariance.ar1"), function (object) sequence.default(from = 0L, nvec = seq_len(object@nc))) setMethod("getVC", c(object = "Covariance.us"), function (object) { nc <- object@nc if (nc <= 1L) { vcomp <- object@par ccomp <- double(0L) } else { ii <- seq.int(from = 1L, by = nc + 1L, length.out = nc) i0 <- sequence.default(from = seq.int(from = 2L, by = nc + 1L, length.out = nc - 1L), nvec = (nc - 1L):1L) i1 <- sequence.default(from = ii, nvec = nc:1L) L <- matrix(0, nc, nc) L[i1] <- object@par S <- tcrossprod(L) vcomp <- sqrt(S[ii]) ccomp <- (S/vcomp/rep(vcomp, each = nc))[i0] } list(vcomp = vcomp, ccomp = ccomp) }) setMethod("getVC", c(object = "Covariance.diag"), function (object) list(vcomp = object@par, ccomp = double(0L))) setMethod("getVC", c(object = "Covariance.cs"), .fn <- function (object) { nc <- object@nc par <- object@par if (nc <= 1L) list(vcomp = par, ccomp = double(0L)) else list(vcomp = par[seq_len(length(par) - 1L)], ccomp = par[length(par)]) }) setMethod("getVC", c(object = "Covariance.ar1"), .fn) rm(.fn) setMethod("getVCNames", c(object = "Covariance.us", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) { nms <- getParNames(object, cnm, gnm, prf, old) nc <- object@nc ii <- cumsum(c(if (nc > 0L) 1L, if (nc > 1L) nc:2L)) list(vcomp = nms[ii], ccomp = nms[-ii]) }) setMethod("getVCNames", c(object = "Covariance.diag", cnm = "character", gnm = "character"), function (object, cnm, gnm, prf = NULL, old = TRUE) { nms <- getParNames(object, cnm, gnm, prf, old) list(vcomp = nms, ccomp = character(0L)) }) setMethod("getVCNames", c(object = "Covariance.cs", cnm = "character", gnm = "character"), .fn <- function (object, cnm, gnm, prf = NULL, old = TRUE) { nms <- getParNames(object, cnm, gnm, prf, old) nc <- object@nc if (nc <= 1L) list(vcomp = nms, ccomp = character(0L)) else list(vcomp = nms[seq_len(nc)], ccomp = nms[nc + 1L]) }) setMethod("getVCNames", c(object = "Covariance.ar1", cnm = "character", gnm = "character"), .fn) rm(.fn) setMethod("setVC", c(object = "Covariance.us", vcomp = "numeric", ccomp = "numeric"), function (object, vcomp, ccomp) { nc <- object@nc stopifnot(is.double(vcomp), length(vcomp) == nc, is.double(ccomp), length(ccomp) == length(object@par) - nc) object@par <- if (nc <= 1L) vcomp else { i0 <- sequence.default(from = seq.int(from = nc + 1L, by = nc + 1L, length.out = nc - 1L), by = nc, nvec = (nc - 1L):1L) i1 <- sequence.default(from = seq.int(from = 1L, by = nc + 1L, length.out = nc), by = nc, nvec = nc:1L) S <- diag(1, nc, nc) S[i0] <- ccomp (semichol(S) * rep(vcomp, each = nc))[i1] } object }) setMethod("setVC", c(object = "Covariance.diag", vcomp = "numeric", ccomp = "numeric"), function (object, vcomp, ccomp) { stopifnot(is.double(vcomp), length(vcomp) == length(object@par), is.double(ccomp), length(ccomp) == 0L) object@par <- vcomp object }) setMethod("setVC", c(object = "Covariance.cs", vcomp = "numeric", ccomp = "numeric"), .fn <- function (object, vcomp, ccomp) { nc <- object@nc stopifnot(is.double(vcomp), length(vcomp) == length(object@par) - (nc > 1L), is.double(ccomp), length(ccomp) == (nc > 1L)) object@par <- c(vcomp, ccomp) object }) setMethod("setVC", c(object = "Covariance.ar1", vcomp = "numeric", ccomp = "numeric"), .fn) rm(.fn) setMethod("getProfPar", c(object = "Covariance.us"), function (object, profscale, sc = NULL) { vc <- getVC(object) vcomp <- vc$vcomp ccomp <- vc$ccomp if (!is.null(sc)) vcomp <- vcomp * sc if (profscale == "varcov") { nc <- object@nc if (nc > 1L) ccomp <- ccomp * vcomp[sequence.default(from = 2L:nc, nvec = (nc - 1L):1L)] * vcomp[rep(1L:(nc - 1L), (nc - 1L):1L)] vcomp <- vcomp * vcomp } c(vcomp, ccomp) }) setMethod("getProfPar", c(object = "Covariance.diag"), function (object, profscale, sc = NULL) { vcomp <- object@par if (!is.null(sc)) vcomp <- vcomp * sc if (profscale == "varcov") vcomp <- vcomp * vcomp vcomp }) setMethod("getProfPar", c(object = "Covariance.cs"), .fn <- function (object, profscale, sc = NULL) { if (profscale == "varcov") stop(gettextf("%s=\"%s\" not implemented for class \"%s\"", "profscale", "varcov", class(object)), domain = NA) vc <- getVC(object) vcomp <- vc$vcomp ccomp <- vc$ccomp if (!is.null(sc)) vcomp <- vcomp * sc c(vcomp, ccomp) }) setMethod("getProfPar", c(object = "Covariance.ar1"), .fn) rm(.fn) setMethod("setProfPar", c(object = "Covariance.us", value = "numeric"), function (object, profscale, sc = NULL, value, pos = 0L) { np <- length(object@par) validValuePos(np, value, pos) nc <- object@nc vcomp <- value[seq.int(from = pos + 1L , length.out = nc)] ccomp <- value[seq.int(from = pos + 1L + nc, length.out = np - nc)] if (profscale == "varcov") { vcomp <- sqrt(vcomp) if (nc > 1L) ccomp <- ccomp/ vcomp[sequence.default(from = 2L:nc, nvec = (nc - 1L):1L)]/ vcomp[rep(1L:(nc - 1L), (nc - 1L):1L)] } if (!is.null(sc)) vcomp <- vcomp/ (if (profscale == "varcov") sqrt(sc) else sc) setVC(object, vcomp, ccomp) }) setMethod("setProfPar", c(object = "Covariance.diag", value = "numeric"), function (object, profscale, sc = NULL, value, pos = 0L) { np <- length(object@par) validValuePos(np, value, pos) vcomp <- if (np == length(value)) value else value[seq.int(from = pos + 1L, length.out = np)] if (profscale == "varcov") vcomp <- sqrt(vcomp) if (!is.null(sc)) vcomp <- vcomp/ (if (profscale == "varcov") sqrt(sc) else sc) setPar(object, vcomp) }) setMethod("setProfPar", c(object = "Covariance.cs", value = "numeric"), .fn <- function (object, profscale, sc = NULL, value, pos = 0L) { if (profscale == "varcov") stop(gettextf("%s=\"%s\" not implemented for class \"%s\"", "profscale", "varcov", class(object)), domain = NA) np <- length(object@par) validValuePos(np, value, pos) nc <- object@nc nc. <- if (object@hom) 1L * (nc > 0L) else nc vcomp <- value[seq.int(from = pos + 1L , length.out = nc.)] ccomp <- value[seq.int(from = pos + 1L + nc., length.out = np - nc.)] if (!is.null(sc)) vcomp <- vcomp/sc setVC(object, vcomp, ccomp) }) setMethod("setProfPar", c(object = "Covariance.ar1", value = "numeric"), .fn) rm(.fn) setMethod("getProfLower", c(object = "Covariance.us"), function (object, profscale, sc = NULL) { nc <- object@nc rep(c(0, if (profscale == "varcov") -Inf else -1), c(nc, (nc * (nc - 1L)) %/% 2L)) }) setMethod("getProfLower", c(object = "Covariance.diag"), function (object, profscale, sc = NULL) getLower(object)) setMethod("getProfLower", c(object = "Covariance.cs"), .fn <- function (object, profscale, sc = NULL) { if (profscale == "varcov") stop(gettextf("%s=\"%s\" not implemented for class \"%s\"", "profscale", "varcov", class(object)), domain = NA) getLower(object) }) setMethod("getProfLower", c(object = "Covariance.ar1"), .fn) rm(.fn) setMethod("getProfUpper", c(object = "Covariance.us"), function (object, profscale, sc = NULL) { nc <- object@nc rep(c(Inf, if (profscale == "varcov") Inf else 1), c(nc, (nc * (nc - 1L)) %/% 2L)) }) setMethod("getProfUpper", c(object = "Covariance.diag"), function (object, profscale, sc = NULL) getUpper(object)) setMethod("getProfUpper", c(object = "Covariance.cs"), .fn <- function (object, profscale, sc = NULL) { if (profscale == "varcov") stop(gettextf("%s=\"%s\" not implemented for class \"%s\"", "profscale", "varcov", class(object)), domain = NA) getUpper(object) }) setMethod("getProfUpper", c(object = "Covariance.ar1"), .fn) rm(.fn) setMethod("isSingular", c(object = "Covariance.us"), function (object, tol = getSingTol()) { nc <- object@nc if (nc > 0L) { ii <- cumsum(c(1L, if (nc > 1L) nc:2L)) min(object@par[ii]) < tol } else FALSE }) setMethod("isSingular", c(object = "Covariance.diag"), function (object, tol = getSingTol()) { nc <- object@nc if (nc > 0L) min(object@par) < tol else FALSE }) setMethod("isSingular", c(object = "Covariance.cs"), function (object, tol = getSingTol()) { nc <- object@nc if (nc > 0L) { vc <- getVC(object) vcomp <- vc$vcomp ccomp <- vc$ccomp # rho min(vcomp) < tol || (nc > 1L && min(ccomp - -1/(nc - 1L), 1 - ccomp) < tol) } else FALSE }) setMethod("isSingular", c(object = "Covariance.ar1"), function (object, tol = getSingTol()) { nc <- object@nc if (nc > 0L) { vc <- getVC(object) vcomp <- vc$vcomp ccomp <- vc$ccomp # rho min(vcomp) < tol || (nc > 1L && 1 - abs(ccomp) < tol) } else FALSE }) ## .... HELPERS ........................................................ ## used in methods for set* which have formal arguments 'value', 'pos' validValuePos <- function (n, value, pos) { if (!is.double(value)) stop(gettextf("type of '%s' is not \"%s\"", "value", "double"), domain = NA) if (n > length(value) - pos) stop(gettextf("attempt to read past end of '%s'", "value"), domain = NA) NULL } ## used in functions with formal argument 'profscale' validProfScale <- function (profscale) { if (missing(profscale)) "sdcor" else match.arg(profscale, c("sdcor", "varcov")) } if (FALSE) { ## This version is not equivalent due to lazy evaluation. It assumes ## that 'profscale' can be evaluated in the calling frame when nargs() ## is 1, but that assumption can be false in current usage. validProfScale <- function (profscale = c("sdcor", "varcov")) match.arg(profscale) } ## return a function that maps ## c(theta_1, ..., theta_k) -> c(par_1, ..., par_k) mkMkPar <- function (reCovs) { if (all(vapply(reCovs, is, FALSE, "Covariance.us"))) return(function (theta) theta) nt <- vapply(reCovs, getThetaLength, 0L, USE.NAMES = FALSE) np <- vapply(reCovs, getParLength, 0L, USE.NAMES = FALSE) snt <- sum(nt) snp <- sum(np) jt <- split(seq_len(snt), rep(seq_along(nt), nt)) jp <- split(seq_len(snp), rep(seq_along(np), np)) par <- double(snp) ii <- seq_along(reCovs) function (theta) { for (i in ii) par[jp[[i]]] <<- getPar(setTheta(reCovs[[i]], theta[jt[[i]]])) par } } ## return a function that maps ## c(par_1, ..., par_k) -> c(theta_1, ..., theta_k) mkMkTheta <- function (reCovs) { if (all(vapply(reCovs, is, FALSE, "Covariance.us"))) return(function (par) par) nt <- vapply(reCovs, getThetaLength, 0L, USE.NAMES = FALSE) np <- vapply(reCovs, getParLength, 0L, USE.NAMES = FALSE) snt <- sum(nt) snp <- sum(np) jt <- split(seq_len(snt), rep(seq_along(nt), nt)) jp <- split(seq_len(snp), rep(seq_along(np), np)) theta <- double(snt) ii <- seq_along(reCovs) function (par) { for (i in ii) theta[jt[[i]]] <<- getTheta(setPar(reCovs[[i]], par[jp[[i]]])) theta } } ## update mkReTrms(..., calc.lambdat = FALSE) so that it has components ## 'Lambdat', 'Lind', 'theta', 'par', 'lower', 'upper', 'reCovs' where ## ## length(theta) >= length(par) == length(lower) == length(upper) ## ## note that previously there were no 'par', 'upper', and 'reCovs' as ## previously 'par' and 'theta' were identical by construction upReTrms <- function (reTrms, spCalls) { getHom <- function (spCall) { ## FIXME? not evaluating 'hom' in environment of formula hom <- spCall$hom if (is.null(hom) || (is.logical(hom) && length(hom) == 1L && !is.na(hom))) hom else stop(gettextf("'%s' is not %s or %s in special call", "hom", "TRUE", "FALSE"), domain = NA) } spNames <- as.character(lapply(spCalls, `[[`, 1L)) nc <- lengths(reTrms$cnms, use.names = FALSE) hom <- lapply(spCalls, getHom) reCovs <- .mapply(function (Class, nc, hom) { if (is.null(hom)) new(Class, nc = nc) else new(Class, nc = nc, hom = hom) }, list(Class = paste0("Covariance.", spNames), nc = nc, hom = hom), NULL) theta <- lapply(reCovs, getTheta) thetaIndex <- lapply(reCovs, getThetaIndex) nt <- lengths(theta) nti <- lengths(thetaIndex) nl <- reTrms$nl nc.nl <- rep(nc, nl) nti.nl <- rep(nti, nl) R.dp <- unlist(rep(lapply(reCovs, getLambdat.dp), nl), FALSE, FALSE) R.p <- cumsum(c(0L, R.dp)) R.i <- rep(cumsum(c(0L, nc.nl)[seq_along(nc.nl)]), nti.nl) + unlist(rep(lapply(reCovs, getLambdat.i), nl), FALSE, FALSE) R.x <- rep(cumsum(c(0L, nt)[seq_along(nt)]), nti * nl) + unlist(rep(thetaIndex, nl), FALSE, FALSE) reTrms$Lambdat <- new("dgCMatrix", Dim = rep(length(R.dp), 2L), p = R.p, i = R.i, x = as.double(R.x)) reTrms$Lind <- R.x reTrms$theta <- unlist( theta, FALSE, FALSE) reTrms$par <- unlist(lapply(reCovs, getPar ), FALSE, FALSE) reTrms$lower <- unlist(lapply(reCovs, getLower), FALSE, FALSE) reTrms$upper <- unlist(lapply(reCovs, getUpper), FALSE, FALSE) reTrms$reCovs <- reCovs reTrms } ## use c(theta_1, ..., theta_k) to update par_1, ..., par_k upReCovs <- function (reCovs, theta) { ## FIXME? function (reCovs, par) instead? pos <- 0L for (i in seq_along(reCovs)) { elt <- reCovs[[i]] reCovs[[i]] <- setTheta(elt, theta, pos) pos <- pos + getThetaLength(elt) } reCovs } ## return 'reCovs' given 'object' of class "merMod", w/ or w/o attribute getReCovs <- function (object) { ## stopifnot(is(object, "merMod")) if (!is.null(ans <- attr(object, "reCovs"))) return(ans) ## 'object' was obtained using older 'lme4' => all 'us' or 'diag'. ## It seems that distinguishing these two cases requires some ## gymnastics. We nonetheless try to be fast in the all-'us' case. nc <- lengths(object@cnms, use.names = FALSE) form <- formula(object) doublebars <- reformulas::findbars_x(form, target = "||", default.special = NULL) reCovs <- if (length(doublebars) > 0L) { nc.. <- vapply(mmList(form, model.frame(object)), ncol, 0L, USE.NAMES = FALSE) dptr <- diff(ptr <- c(0L, match(cumsum(nc), cumsum(nc..)))) Class <- rep("Covariance.us", length(nc)) Class[dptr > 1L] <- "Covariance.diag" .mapply(new, list(Class = Class, nc = nc), NULL) } else .mapply(new, list(nc = nc), list(Class = "Covariance.us")) upReCovs(reCovs, object@theta) } convParToProfPar <- function (value, object, profscale, sc = NULL) { profscale <- validProfScale(profscale) reCovs <- getReCovs(object) np <- vapply(reCovs, getParLength, 0L, USE.NAMES = FALSE) pos <- cumsum(c(0L, np))[seq_along(np)] L <- .mapply(function (object, pos) getProfPar(setPar(object, value, pos), profscale, sc), list(object = reCovs, pos = pos), NULL) c(L, if (!is.null(sc) && profscale == "varcov") sc^2 else sc, recursive = TRUE, use.names = FALSE) } convProfParToPar <- function (value, object, profscale, sc = NULL) { profscale <- validProfScale(profscale) reCovs <- getReCovs(object) np <- vapply(reCovs, getParLength, 0L, USE.NAMES = FALSE) pos <- cumsum(c(0L, np))[seq_along(np)] ## FIXME? it could make sense to here do something like: ## if (is.null(sc) && length(value) > (snp <- sum(np))) ## sc <- value[snp + 1L] L <- .mapply(function (object, pos) getPar(setProfPar(object, profscale, sc, value, pos)), list(object = reCovs, pos = pos), NULL) c(L, recursive = TRUE, use.names = FALSE) } isNewMerMod <- function (object) !is.null(attr(object, "upper")) && !is.null(attr(object, "reCovs")) forceNewMerMod <- function (object, reference = object) { if (is.null(attr(object, "upper"))) attr(object, "upper") <- getUpper(reference) if (is.null(attr(object, "reCovs"))) attr(object, "reCovs") <- getReCovs(reference) object } .anyStructured <- function (reCovs) !all(vapply(reCovs, is, FALSE, "Covariance.us")) anyStructured <- function (object) !is.null(reCovs <- attr(object, "reCovs")) && .anyStructured(reCovs) semichol <- if (FALSE) { function (x, tol = -1, etol = 256 * .Machine$double.neg.eps, type = "O") { R <- tryCatch(chol(x), error = function (e) NULL) if (!is.null(R)) return(R) R <- suppressWarnings(chol(x, pivot = TRUE, tol = tol)) r <- attr(R, "rank") p <- order(attr(R, "pivot")) n <- ncol(x) if (r < n) { j <- (r + 1L):n R[j, j] <- 0 } RP <- R[, p, drop = FALSE] if (n > 1L) { # symmetrize 'x' (put upper part into lower part) j <- 1L:(n - 1L) x[sequence.default(from = 2L:n, by = n, nvec = j)] <- x[sequence.default(from = j * n + 1L, nvec = j)] } e <- norm(x - crossprod(RP), type = type) if (is.na(e) || e > etol * norm(x, type = type)) stop(gettextf("'%s' is not positive semidefinite", "x"), domain = NA) RP # upper triangular if is.unsorted(p) is FALSE } } else { function (x, tol = 256 * .Machine$double.neg.eps) { R <- tryCatch(chol(x), error = function (e) NULL) if (!is.null(R)) return(R) e <- eigen(t(x), symmetric = TRUE) r <- range(e$values) if (r[2L] < 0 || r[1L] < -tol * r[2L]) stop(gettextf("'%s' is not positive semidefinite", "x"), domain = NA) if (r[1L] < 0) e$values[e$values < 0] <- 0 qr.R(qr(sqrt(e$values) * t(e$vectors))) # upper triangular } } ## .... METHODS [for class "merMod"] ................................... setMethod("getPar", c(object = "merMod"), function (object) `length<-`(object@optinfo[["val"]], length(object@lower))) setMethod("getParLength", c(object = "merMod"), function (object) length(object@lower)) setMethod("getParNames", c(object = "merMod", cnm = "missing", gnm = "missing"), function (object, cnm, gnm, prf = NULL, old = TRUE) { reCovs <- getReCovs(object) gnm <- names(cnm <- object@cnms) unlist(.mapply(getParNames, list(object = reCovs, cnm = cnm, gnm = gnm), list(prf = prf, old = old)), FALSE, FALSE) }) setMethod("getTheta", c(object = "merMod"), function (object) object@theta) setMethod("getThetaLength", c(object = "merMod"), function (object) length(object@theta)) setMethod("getThetaNames", c(object = "merMod", cnm = "missing", gnm = "missing"), function (object, cnm, gnm, prf = NULL, old = TRUE) { reCovs <- getReCovs(object) gnm <- names(cnm <- object@cnms) unlist(.mapply(getThetaNames, list(object = reCovs, cnm = cnm, gnm = gnm), list(prf = prf, old = old)), FALSE, FALSE) }) setMethod("getLower", c(object = "merMod"), function (object) object@lower) setMethod("getUpper", c(object = "merMod"), function (object) attr(object, "upper") %||% rep(Inf, length(object@lower))) setMethod("getLambda", c(object = "merMod"), function (object) { reCovs <- getReCovs(object) nc <- vapply(reCovs, slot, 0L, "nc") ## theta <- lapply(reCovs, getTheta) ## nt <- lengths(theta) nt <- vapply(reCovs, getThetaLength, 0L) thetaIndex <- lapply(reCovs, getThetaIndex) nti <- lengths(thetaIndex) ## nti <- vapply(reCovs, getThetaIndexLength, 0L) nl <- vapply(object@flist[names(object@cnms)], nlevels, 0L) ## nc.nl <- rep(nc, nl) nti.nl <- rep(nti, nl) R.dp <- unlist(rep(lapply(reCovs, getLambdat.dp), nl), FALSE, FALSE) R.p <- cumsum(c(0L, R.dp)) R.i <- rep(cumsum(c(0L, nc.nl)[seq_along(nc.nl)]), nti.nl) + unlist(rep(lapply(reCovs, getLambdat.i), nl), FALSE, FALSE) R.x <- rep(cumsum(c(0L, nt)[seq_along(nt)]), nti * nl) + unlist(rep(thetaIndex, nl), FALSE, FALSE) ## t(new("dgCMatrix", Dim = rep(length(R.dp), 2L), p = R.p, i = R.i, x = object@theta[R.x])) }) setMethod("getVCNames", c(object = "merMod", cnm = "missing", gnm = "missing"), function (object, cnm, gnm, prf = NULL, old = TRUE) { reCovs <- getReCovs(object) gnm <- names(cnm <- object@cnms) L <- .mapply(getVCNames, list(object = reCovs, cnm = cnm, gnm = gnm), list(prf = prf, old = old)) list(vcomp = lapply(L, `[[`, 1L), ccomp = lapply(L, `[[`, 2L)) }) setMethod("getProfPar", c(object = "merMod"), function (object, profscale, sc = NULL) { reCovs <- getReCovs(object) L <- lapply(reCovs, getProfPar, profscale = profscale, sc = sc) c(L, if (!is.null(sc) && profscale == "varcov") sc^2 else sc, recursive = TRUE, use.names = FALSE) }) setMethod("getProfLower", c(object = "merMod"), function (object, profscale, sc = NULL) { reCovs <- getReCovs(object) L <- lapply(reCovs, getProfLower, profscale = profscale) c(L, if (!is.null(sc)) 0, recursive = TRUE, use.names = FALSE) }) setMethod("getProfUpper", c(object = "merMod"), function (object, profscale, sc = NULL) { reCovs <- getReCovs(object) L <- lapply(reCovs, getProfUpper, profscale = profscale) c(L, if (!is.null(sc)) Inf, recursive = TRUE, use.names = FALSE) }) setMethod("isSingular", c(object = "merMod"), function (object, tol = getSingTol()) { reCovs <- getReCovs(object) for (object in reCovs) if (isSingular(object, tol = tol)) return(TRUE) FALSE }) lme4/R/sysdata.rda0000644000176200001440000162111015036542626013467 0ustar liggesusersý7zXZi"Ţ6!ĎXĚâlďţ])TW"änRĘź’Řâ •ˇá°,ľďÁŐćboż*m§ŕ =îFáżžŢqۡWJ/€«€Ťm˙[ţ>]XIRHśm…#ş´4‚Ce 3ö«ýцݺ#64K‹źAˇ™˘ RtUŐƨ´%YT°˝HĽą4-çPěs‘_Ű4?ŤgŇŇ'×5µ`ĆđwĽ˝¦ôŻJk›8v«ąÉÜpąčČäfôönŔbYť€Ô–-!®,äđĂ©!`Â=ŕĺmŘÄĘ·=$űG‹(#:ĘpťĎ?ř]üöXđ5­3ĆŹ¬Ť1ŻAĽµ4,ź4C¦˙Ç›ÜíŮ®”žłAP‡Ýl+ą-¶®‘űJ‘ă:Öćq«Ëk¸L)>âN t:PË‘ŕNZřńǵ>8řÄÇî´ň (éODţčßh=xNSqđ†­k.RV˙­qPgĽŔćru`h}źŠŻ`l¦g„*t/đ¨ź6šÄąĘ&őŕńJ^DTżąłD™ řę2a€ź# íĄt†ťđ«čÇ4něe'ŹNc[ľF† }żó5L"=Ă*Ë˝ě¦ŰrŇcśť”ádîú@6C”‘>Fč‘ŮZFd]Nć:BÖ O©ÜUĄü€Îl 9Ľ:™TťňŢýr ¬ëµţvŞßMĽ˙h*T|wĽÁĺ÷ŤŮ»”Ę ) xÓ‘*IVB>RŢB×—šżÁŹ ŐçźP™,Ë”±-ŻĂÝ+o=ţr ·K)ÓŽ+ű‡}f2Ř"iRYhy% ć(ŃRórŰü´Đ!őţ&NˇS¸ŠÇ„ënŻi´>öÓýC6 ¦¶u¸@mż‰P¶o=ÔîÖÉM|•.ü‰S !ŕúDßó¬˘ű§ánc=ÉIűş›cÁp8¬Ž"_¤8p’čמÂUŤäĐQĹ©fŇ·§rN“€gw´"vŤQzŮOŰĐe™+.łűaě—ÂÚ­@©ńäŠßĄĹ{´4ÇjĘ#·.Ź ŁzüŠ>•śÎÎŽÜĐÔ<®Ż¬˘HČĺ=h@ßwĎÚJK}›éE|§AËóMŕTĘŻP(m;߉”őír3Ś ?đE%éťT%]:'ę·ĄĄGťúPnD`ÄΉ3ÖímőĎ:Y›ďĹFUEż\“Mihb‡ĐŰŐŇŁŢĎöl‚iQtĐ@m“ %…ăáńläă<'CTć‡Ĺ&’¸J…Ţ,ŻBú<óâ •©™V_%‰wăÁOş\cĐ€ĐĂéLŐŰ@*FcřýD^pwH§˝ú݆ř\ąĚĆc¨Ľ(VzÍEÝZ+Ńu‘óŃ&¤zZE6y§vŰl<ľ+ă›EłDNě;—Ąü"!ě~ś“>?yßsŁöńx2eŃ$)¨ÄOr㼠a•‹HýĄĎëšÁ´ÁŽ2ł¬d®lŁ~(„Öb!­ÎcÝ଎'+WE°5Łˇä¸Y×Înn@DnŇ•h (Ň?Şâ¤Ź“ŚđL k šRďĐÄŰůo2˝ł~n»P4"Ň–çž «6[L13&”^<łSĹîFktG´3ݡ€®¬3 ×řܢĽ ż˘Mť=Ř‹úš6qቦpŽą_hć:/CÂÎŮ©Ďp&Ŕ.¦‚Jčs~ŁM”’\r˙Ô$ěč0őU™68‰9Ýnó DÉTŮľâ® ÎľŁ ŤŰ ýÖrUPçÓź‘¤®]üôEJ©HÁĐŻTX‘Łĺ1ŐÚy@Sí +ő™¨©ëňvźë=\ýäö`¬ÚŔtĄśl±ÖűĎľ.DŻ=DĎ´Âip¤ľ=ŽeoĽö ¨í3CÍŔX~łLŹ›F‰Hř.oÖO›—Ś„÷3Ń‹f)ž– <żüą5×rŔ5Q÷ űzŃW‰ň(Őžâ¤=da•éiJ­É6°NÝÂAIĄ®÷xúÓ(źZ)ěm˛Š Ě­TÔŐĂ´ĺngÁfĂ%‰N˘7}Ui|t/ť„ *‹ďŘ,†ĐźhwÎxŇ“ď'.ŞťśŔ¤ ‰–ľ&dĺű>žB$eż€8)0T[7g~ĆůĎ]Y C„µ@Ľß´ ´ÖlDWłjÇY L!·KŇG3.6ż}4ř7•p`Í€nËË•.z=˙dĄë D(@ ![őÚŘ~ťĚÔ¸bD¦¬×Ř44´fżŽáL…łŰíř2ź­Z›Ć)l+_‰~°–EĆËšbr‰ ÖĚ’ÚĺŐŐ{$`'ŐŤ¸ T§›•‘îýęŹ4Ę)éRĺúg˙"Îä'ÍCďŤĎ h+Á¦·!‚Ú´…Abů˙ŔnŹV"Řt¬5ÜT_>¤†Ş,J2†<Ť;K&(§3őŹÁMF$Řźw›µp BČă,čĐ:·tş!/íŢ;ů WrĎX°IΊB’çďdg+z‚1=gÔ<Ěëd·@5ŰBZˇ8i;t5Űö1AäîbĹď)8ąO&C‰Ŕ6–LĽŚ˝T …äuh®#ř z¤ÉOsT5PăI9C«ÚĎÂ4´ĺJÔPÎƱ wjNöÁUľŔIuůĚźż @Ĺ~×äŐoĽÍÝA÷{!Í5&ŘÓËĆËý!âSŤp5oפ‚t»ÚĚ´µŤX)ĺ$âş­Ű)ĺÖČîźŰÚn§BĘôzŹ˘YĚýI˘ĆČĘ´vŹwöÂ0dń8rÜb{˘Ć"sř™4OŠ>öĽF‰ťHGćJYVń‚C˘·ń§loŮ×˝˛d­·ě8śűiŮN©W$ŕČǧ`ż|ó’pRrŁl0(7wDűkE$}×;2>0ŔĹ ś} úZ:ŠůâąőÂÇT+ŃoŚ(P&Ź«í¤é°µXn§ů™1‘ÚŠíŇ|8Ě'/p%e$¦®Ć'…qż Ú\©őf…ä‘b˛|L$F^Ţ'Iíďz6j˛Fć„čR>źc!X]uŠcŘ<Ůö-F;ş'čáô€¬˘vw•$˝—_ú"Čj!su>J50É©J„ą:u•ËÇd‰lŔhmo‹¸C`ąsm˛*ľŕHj©«ÉÁ?#ËRe=đ“Á+ßzř{?mŰ?¬ěź-ŔÎ9¬ľäµx…î‰ęSɴ䯭tf‚’¤‹ŮĚâ6JŃ|¦${•Sޡţf°ě"‘©n™?plYSfŚÚűgä¨1ĽnHbć?DŁ">ď#©˘ŔÜ­6]s§6ňsň3Ő»ć©0¸‘Śü€<ÖJůT-ü—FS’y·ÁTŹT}©Ď†»Ť’^ěěš…ä¤Ĺ•ŇL.Č–Wű)8Cś$—Ţw?V‚ˇë‚Ďi7ÍN$ ™pÄót^+<™›¬g ’—‹ixÚ¦ż{Mšg•.Ë*^„i% ~/w¡ăEŤ&8ů•ÉÓĄëÄ-W‘Ě#áÇń§^˛8aŔ”u^>Ň…Ą‘~¨ÉÓÔ֤ɼ§âsš 8oąáYĄQmEOĹÄđĺ&ţ.ż$^sôR]ŔwÉ‚‘1ôĆ;{Í$aäŰ0ˇE©5„ňFaF›FáAúSµaőW&ćeÚ‚5…´ŃŻMčńĐÝ w@0ŰĆĘ)˝R/ġ¤Q;ßîđ×g¶-kíń;;?¨_fá_’T&0Śî$řŰŘŐ`Ď˝ 5ţű·Zč _Ëú¶Ć(ĘăűgóDĚ&_ü‡‰ű9–€ŤGŮFHu$Qd»’ăh‹¤Ąwp$&9+´Ýá١Ż@ě/O ŤJ^śŠO#k.#EőÁQJ:©ĘČŁ¦8©ş×D™Łĺ>”}*eű…Ěé#DKŃÎ}Ü•‡Ú´óC4z0ýî,áţ(…•`PoŁâő µŁ,rĐűL(ˇ|ͧ$$F#÷ËtĄ—cDŻśúŘYqŠ¶?Cn-c/$FŰÁw2Ü–]˙{« ŇY7†”R3Ě_†đÜE°žÇĆŁüááÚřNLĂ*Ŕ˘„űČÖĆ°ÁmţüË&Sů­ťGě-ďĎ×)b{˘D¶ë-EBZh©Şe&Łµ¶iO€q…Ľh…Xšb*]ž¤(m ş"˛Ě] uăź<¦U¬N@gÉ ŇŘ„š0A„5Ľ9Ţ®¨ÔŹTťĂ‘TŽá¦‡>űZ‘SCú6ęšÓĺ(émą:6 5¶"€°™ x”Hák/ÔĆ čZ”!Z’čCv•ý®>§Â2S˘OĘ<+˛ŇOůąwgöÝ’ö'n>ôÂŐ‚z*‹v16©\ěĺló­ČůDý@ ťĽ,RąŮ–bçj±#ĽlFh•TâávAŰNłŠf^ ű<Ł…+˛účżr”+·îL…śrŕŰĽőź×ő#™Cxn##1Ĺ?k8 úú„?˘HĚfúiÝ"0˙ąÄJ5Pö’ɡfľůĹđŠň."uHVó_?@ő7żc¤»nAä—ç/ÖTÚěp·ŮąaWć#Ŕi§W6 :žSľę)žYš-Ő8K$ÁÍŐQPŃ“dÁŻPkí.ŢR–nhÄťšyűVŁ.R.)Ée#¨"4Ey˛mŞ(TjĽäúQ”B¨*Łś.=ř™?B°¤?Ňö\t©']¦né[™.ËĆHň@+A5z”1 (Vđţ›Ó.*Ě.ŞŽ”ĐbÔz•é"[Ź7BšXźÇ!ĄĎ‹SÁuŃ>hýx´ľµo'ľx\ç9ąÁđŢjt±âÍŠŇšq¬5ŃňgŽ8Űą{V~·’É“¸n¶¸ŢýŰfVÖť›×ŹËăÇ–â N1Eiý'‡C‚ăżó„LÍU ĎýµĹË2"Ň)öRF”Žđ¦P— dý}ä*v(Ú3îäďýF1ÝĚ+5˙?$OÉŮ…¦ó—3Aç!(Üě˙Ŕ3dßćŃî'î4¤ş‡f‘ăËÍ@ő2wČĺŹ)Um—HKł„{aŚ,ł˘ů|uŁj IřVD+MÁi(ö±jXkD×ôÁ›-MŽ8‹ gÎbÖšŁ _ĚŐThćC 0…ś‡ŇX't®lÍ8ž­$Á(€CµmB?Ic×âţż 0;óM@öz„YZgMÂLUvs˧śiő)qU}bŤ}» Îjć!ýY#MŃîSuŚó`5óâŢf7ŽÂďVŔlŮ‘:3Ŕ„wźni$•¬ľścś&í«J íYŚbµęąŠŠQÚÄH×îDń E×"ţSo#HîL„ßIn÷ D+ü"-Ś%§O…M¦˙T欯2SwP‹×/3íľ–Ů,* ‡Ęr„T+űŠÎ$zŠTĂŽéWkMü$¤Ş´˛8¸yęG{KZţQIž0jOFĂÖ#^·ďŰ˝ëú´Qü9L#ťw¨¬˙| Ű‚vÓL"»9Ž\‘+L Ý˙­K ă ç&·i=CĽŘDfëC˝×|íj®"eŹöĽ,ř 5=´—óőNkX‡féDTç°XýŐ†±DíČXÍ™•®ťQµ›Ç”ÁĺtŤKp[Vzń‰ýä¸ň8•=QŢéH Ż«ş˛đ9/\\–ĎJŇŞ;Ř›Çy3U– \âćühŰ Qľ&‹©’ZÝjśJŕžl^¤>cłŃ¶äŢ›Ó o‰âĐqłđöp2>ČÜ:XH»’WF9l°lWv†ÖazC‹XŘ­Mí/ĘU8ťióxZÁň–‘ř/č9+aßÝYÁ'Q°ďŔ Ś–Ĺ)U¨ Ö0Xćş%4Ą•ÎőűöŞC§#‚~h>z÷:¨µRňÄ šĂXö56ä¶*K[ˇĐˇ8öŔ„ĽNqáĐ:¸yÚ˙'#_zD-™V qŔXŞHľ.›u¨ô5›˛8’Ä]ářő»dlg­ŚVVÎĺs $Ü…”őËÎďT-ăF´+ÚLçmü¦Ú|B€ŽŘ°pÇ×f=$"_řŐ/Ń' ďAÂiZç®7‘ćk’ť"î+vĽĆ^ŕ_ÝŁ¦>săjúÍQö®Ä{%čŐÚß®ťDmSŹŕž¦Ô[Aţ %8}GĚÍ#®TčVĐă7÷Ź“źÍ¨Ź|Ţ4ŠáNí3/đ§I˝ ř ŇS@ qéµcŠŇbŇáôŔljRŇżFá•sč›S Đ…¨éż–Ě›­(IľűŚcz,©Äą9&D™:fd”; =^ă‘<×ÚČŔġ¤řw…+FŃkčUážn\§eÍeŔ5˝BŻâĄ—'´ĚGżÚu–»qꮆđ© Ŧň eéúŔ˝ %Ź†+öŘąOä}lŚ2éŘÎ7?§"]zwgŤ´Mé}ĘL6W`´ovřiFń'6Ë´…KťDçv_ňúMkŁBšE\”Đ­‰jÓ†™ÝŰÇĆň•˛oŔ#Xđ(G¨1= [ ˝ąö];Ú#°L 7r7+vń)śŰ¸ pFŽßѸŠîź1QĘ"ˇGÄiŮ]­<~ŔqD®¦;ůëe!¶Î3Ňş« ń‡črdµiq(&e@´ä ÄĹŽ›é”Kâ4Ň…ą/ňX ›}]”CMŚĎË !XÄţP«$ľĎ€ĽśnłĄőfľ†őĆ3ř§2>)˙á•ť WƇm‚ .@ÎđŠpîđćĆłŢ9§&\ţ”^ S—č导Äj{ßŘ4ťÚÂE„Ó¸_˛D{=¶ŕ[iŞĽ€G Ú¬N_`ěF¤˛(ŐQĄˇÇFŰ(ĘËŮN+Ô2¦,Ř{ `mcůP_`iŰ!E˝ Ä6ęě^ňŹ ŠÔŚľ°ú'ż‰w$|a.Üťëę˝}3yÇy‹âUP˔Ͷ֖·Îý^ţ+ćýš¦ĆżŻţ«ń.™HęM-df€…QqŤ[Ý_ňĄ×ĄbKxÜJţ—ú ­ ‡f*‚ą†š®^|hîČ3ËĹ®ľA4Y‰j›ótŘźnŮ|ě®5ĂjußĎ–28µ'¸‚ĺ”řx| pzź–ăeß:לŚŽ°%™,d׌EĐë Ůű)Ă÷ŞÄ@/_űĄ› [ËŽŰŇ˝ŁCJ¤Ż ą‚ś ą”P˝Śź]ÄŠfűsvŹ(~"tE 927aÉZ?ő'đđAmO’(빀\Ż$®,gĎ”xČ(–ŤH¶Up™=t¸Ťô„„‘ Óúir7!un.}Ś â-ŕ!Č~¬·ę5`?ÎýÖ‰(í®c„MD±ÁČş»Đ~T)qšĄťcvü8EßD-¤&kYµ`űR ]ĹÚŔmŠčKţ÷5ި$Z;Ő)ł‡Úgţç}RWÔHAČk÷]r—°L§¬{H~JiżĽŞjéîÝťÉęźÚî35zt˙TŐ•PnÔzJy_5ş+ ę3ŕű-¶,z¤Ż{§âę`Śş-_¬LLXËÇĺĆK÷tČ):oŘh@ÖĐ'Kn1ľ<$ČR°›Â4ąT!t‰ľ"¸őóÖOÔŚ ĚCĆ©Ĺ9Éeż[ł¨*şÜ‚XBĽx]¶tę]Ş6Ł°w„u¤]1ăÝO}5Łq*ÓXhZ#+k.=¤§ šŇßäÜ5Ôű#ş Ô#ÜiT^^{–S§â­7»›á‡Ď|0}CGEÄÚ" µÇ=ÄZ…ľIjŔ›tőŤŽÍŔ›íÁ h‹ătcŻťťÎ¬‹hK*f½U8błÂYAdĂěŇ r˘ŕäčŕżkÓšR›ľiĂQźHěÖz†n0ú¬Ž‘»ÁFTj˘ĎşC® Oú+¨â3Č‘Áţ2– łY_´|wg·ń*†$î/śč<,´Đ›[}ŕ‡qC‡::Îř¶Ôô˛Éąd0~Ś–ÉŔű–ŁičÍѶż/+8ű¶Ź¦ÓďłFŤłPť śÇĘůÇ ˛GĚrmř6ŕWOŹů™˝?š1ĎfýĹĎä ß]T·W;F{X0›Aó„8\ötp—ˇk7ÖÇ ‘ôf€gËą $Xĺ-ŽVą ŇĐ…Çv‰ŚrčľUâČCňsTZ¬LQ˝ÇŠsZQ Wş_¶§ŹŻÔŐüž‡%ërýŃśľe®Y ÷[‘Lň’a2j ­ sT;±F±Ź;Źţ¨× <.hŁĺ^őÉź^&ťţ¤;M·wcGŢy&UŁč#UŤ§a/,4ÖĽĺfë)„Š+•!ř˙egQJůŔv6UFg»Z8†ů™‚,¤~ż ő˛ŔH=S¦ŽÉkĆß z…Ö„‘:QĎ&·ůňÖYđźO3$ŢF‰a"ąz\w·őĆ4D§” KżŇRäGm ˇ.$[n–N?Çö’EőES°x}¦çÉ TŠě.>,ţ˝owdşÇ&”GůX·ŮBzČ=D!.őuo“ ˛ůŁµ óm1ËĂ’—ĄîxůłmCQ6hE,˝j śĚ­źË§ęÎP pB5áçrČ@áHrÉQô’ý¶ÉަîËâ˛%*”®ÖItCŇŰW3©®×É_óbŹcY”@0¬EÄĂnťP,ę• ő9ť™Ă-Ů·D\ÖĘ::Ćw¨ÜăäüۤÍ“ÎoWćűÂ( =í”–™żp"Ů`‡~ şÇąí»0űÚ^\ő}b úó]oç|äUď$ČÂÄ˙KxiÔ€0çtϸľ´ug®u÷a6Ňc Ů#ż*[TnV‚P~Ϋew¬sÁ|pă|„75NÄ~áŠGZ’bbSÉ&ÍÖâhXŞlDĽĆçŮ6}¨q?ýp„Ç W©Ş˙đ˝éšésÓ±{Űt ±ĘÓł`‡Y"„z1Ď>· cSwrC%fX*Ëۉ•sÜ‹jĚ “k%ä,c0×ČN9¶šŽu8ŁŘ±[ĺb=ťűSÍ[•!îĆî&ŁÉ1RĄąŃóPÝđ>W´îv\¶d5ĺTš}$‡?)б-”gŘęr"8Ô }ÄND®Îf\‚ÖéüŃŃťhmĹ*üűšĘ¶ji2¬î1śó×™”7ę}ŔY ¬”ý‚TNtËcĚđĺă\Ę.#B2D¶wâŰ6…uĐĐ ĹV0-šôŞ{a±~ĐqÝjB*4$€ĹjÇŤ>†ć:†ëŃ Ťef•o%°—T˙E¸$=Ä=ył°č…Ag|mN7df–ŐJ óń¬fČ5w€Ń4I@/¶*Ě‘G®~_Čľ. }XB9“ěŕ.uĆď ÖĄL ËĘŠ!pOĚIŤXrĺ¤üećpSM˘“¸%ú¤&6~`Ăą÷ÖL˝Ŕɨ»Ĺ Ľlő×Jâä˛*O)ËúˇO1`Ŕýo~¶RÔ7`ŕ–íú’a¸Ěä•-¬C‡3Ýââa{4h)íăŚJďqĽďńđR®–v;˛gvYčm„ ¨ýłĐSĐĽ|·ŰĂnůř*.$ŹÔ qgeđ™· ÜŕsŔÔŘ4; §ä"€Tş`ůU˙1©q MĘÉĺ:*­űç(97y?űi!Tr?j5é?(Ę „ŔŻšń}V`Ô-¦S+Óâ&‚Ťk~XŮ'^D ™XđŇeĘsYú»zů :ĎËş6´5+<^9ŇěóA"m(ß?먙Ď»‡,¨ŘnÓěG!iÝ/ÎëXȩKsŞű÷˙@;ß%č2'´:ÍÚŘ;#]¶| ÓA‹Âk´őÍ Äź]1ĆWáO„–Ń©ĎëX®É­Aá—=ótÍtSTä0lŞl|©X¦±·:# (L3üAaˇQĢ⇠ôElPýh–ĘóŹ,E´n‹úTJćĆE!ôľÝ‡@i¦ţ$śr¸­k88ľ®5ľ¬$VóáŚ~\2ôÓSĎ=ďżđ‰ó']?(gkMĺ­°WŇŐü{’—Q™iđĚŽµ0Ě’5Ůh®?ň‚ÍůťE†şK)‹™€ZŘ)PÍN)¦"Íč‚Ýö™8ŐLŔóĂĹ2ľD˙ß–oÖjN!1žN…XĐZęÉL$LöJ‘űŻXë‘-é®Üq)iä€Hŕ?»ěÂff *xSĄjRq•Ź–(AG¸4.ő¬7MôË“ń FˇŚ÷—OýJ±Í3“©tMhęÖSt›ŕČsYźÁäK7k±<{ć O%˘»ňO/QJ˛1 rfŕ^2Żäž„ĐY˘§oŐŘŻÇaVé¬ëa~˝°›Aą&őeoĽ¤ 4ÂlöK㋢Í÷Cĺ¤?ň‘Ý̨9ŞMÚ…›]×ŇôÔ§aŐ´áa8@€hČŇŮ…¶Óű[BŘ=Đđ 3čyŃ-ńÄÓNďÝŐ˙”´C6š€NŚ×ş˛oÎëö‰áÄAVn“ŕ č°)Ëëťu,Պߪ”#]üHČ™z>âc9›LăŔzĄź†hg)ÔóV¦·±v›ó ĺr€Ë’š­W®-ŠU'Ł:x_ţeË’đÜÁ̤¸"U+Ä0hEý.@÷5ź”˙@ßăÖ9ŢËŤŠ~RŚ*­ČŁP@°„ť`c6„ąŢŤuŠő źwŘA"ő ß]ᢞŽ /âÖgffß;€ó1„Ć©úćuăy„VsĂčéÖ>ŚóZJ€ůµŤVËl°‹Q¶2› žaÄŁŚE­î*«©3UŘĎ}ž`JRŹ‡ČŹcşhSÖfj6,b{CéďíŃŘŞĹ’Ś¦¦(u’ŕEvX)ČÚüLJňkě‘ŃpZ—<˝üŤš‡_ ŕ"–MŮ·¨?ĆkčvŕOTÎ… Á«0{̧}+îˇ;Ž3×QŚß¨§?mrťü©Gź6 ŇÝékUY‹đ[č.ŕ‡śü$PíźtAW?ů€A ^¸°Aw‰ná[5Đşš‚÷ŠÜs|9V«EöرLŢŠ5łkĆ—Ťě¸Ď"o^lúłđ) ąú Źî{‘ý|µýJäoČÜÝw E9¤ü¶ĚÝbćrťK­$˙»ő7Ën„ó3ČLkßvj’‚÷´Ň@ľ‡~ Ó®K!zçáťř$Ú*Ý2ŠîÚó§ÉdvpĚ‘I„ŢRź~#R®O†D&Ä=AxOFÝÜ@ČBmŕv8ä`Y ëM·˛Fm/ç|0™wÔ/,ĐPdłz0oň~#“$ÁEÔĎ®/ű™wÍĄ>—"ţű+ŤŤ ö(ąqwůţ2ďĆQŮ6 ]µ2ˇ–D]cäPĐÓ=DmÝzúÓÜľd˝Í—:€k˝ľwG++BŐ-ozĄĹö\zď ýŠ;źTĐń(ŕBűXÎÝxt5‰ÁĚPY÷}%Rę9Źq«®ĄˇÝ.xí±öâÁĆT­l+LőüńGű›Y&Ä`z2¨ň° ö¶vÄky¨˛vvň+%ńN46z'žfKţ~«eąyˇ×Iń€©€IÓ/=QŕśxĺŇ\iěׄZĄ—ç[ŕoŁŃ(CÍýÎlĽ ŕYŁ}¸Üµ_Fq±Âe‰ń@{ČSĎ'–Ö‚‚ ŤcGw(na(»pÓdýš˙M-IŠŃyčÉ6 ÁW’dtřÍîłŕvđ*]Ç”)jLq¤¸Ç€6ÉÂÓ5ą«IG9>adcO»Ť›VÉď&ÔB>ŐŤťäyóf,ä‚y(|Í ‡bćş%9K4Ü®¸«}ěJŇáĐžîČ÷íjS%2ĺ©Íu"©ĘÄYÍĚ»:źY’öĹ“ôě‡-(Ţn÷¬ Ž†Ú÷ŃŔŔ,†McWI[x¨6J¦ó Ç“7«‰c«#ÖĽËôŻ y ť }9ŔpţC߬7u+Ü5€§ö…8~ŞŠ>ůžîiU_vˇy+Ńâ"o3}˙îă7ĐţďnćŽ*°„’gL–&čI%¸ŐţE‹jŽÇŹ8<‰ôO@daír…Jlýpb\ť‹d°Î×îh†&u ††N!÷%ł.ąyc»7=1»ú^ă˙Éyx}H9?ë/ńVě¦Ç›Í [.&M H:˝Häv˙â8•>ŢyC^Á]dŰ˝¸逅,…Ţńíy°/°´ŘiË2 aűŕ„N9 ˝Ą>2‘ĘN[©ßVĄFaY™ĹěÖˇŤ“]5'B˙ÎŐŐ·–S»Z‹(ÜČo^ž_±@t°)čźËŚ+y_ÔI '«”)t Ą ýźÓ‰Éľ1ěQÝŃaB0ýPf»vÝł[(ŔN+ü~ě­7¨×žH ‰óşg_7~t+$•ë&uČUn{LO5ű¨ĆI¸äVŮ]ëřžrłCXD´Ü׆­«VCÓ4śŰ>'ˇżĐ,¨Mg±žDŞ^Ž‘ˇ4Âşçig‘’Ä‚ćhČ )ÂŰ?ŻkÝ2¶•™ůV<5wďš­‡xßŐ áí}ŘŕůŮR?LiS·QÚ íă6†Ôń°;üdÔů™FźA Đkë›íFÜłŕWÓeĘ#y®€ygµŠ\ř­AM&Ř ó%‰Ć)­gÉ!‹sÉž‰µżkt{çFËv„ࡷĚíĹҨ! ĎÓĂË…2pśe1ň¸Íň“—íf7{$´Éd+ű„w.Źm×SÍW'5÷;ś* cÓ쬮—RËÝ’9 žˇ‚W÷ş ‹ůvŔÉ:áăMH„ăßČ<Ëm-ś}ĹjŻţ`-)%˘'qý\;ýŠcÁ«…ôW—TćKęł‚Ő)XčüQ†…)ŤyÄ :Ź°şRHYľz]×Hźč;­ÄĂ‹ŤQĐ˝†o§k%ą)ö2M&ľfÂŕNź†ĆFŕQ‰V˝dĹLk5=âv­wđŹÓrnü&Ă)Ô@í) "ăßŰőá)hźëlŻ\˛<«Îťd— äS»oĹUÂa® +ůý˛EMa%o†VGܲ;łáşAŰĹ’Č„r7Î ďkpŘGÓVóK‚ŕ-Ëý1EŔÎ…cX%Ts˘îÄ˙ól·:qŔĎţ¤r|CËYüđ 2@L<:żŕŠŢCěÉ‘Ýń·DKLKŞ"<ńß‹—žVvŮMzÓľ†Ţ4§śŬ%ó>îSş›Ô·'­xĂŻ3üƤÓĆÖ‡.éÁéťE® ČŰ;űQd­Ź*™ěů{ď‘ö:x1>AĹ0VĚćw:¶8b—đěĘŘվךěÔ·Ć3Ą¸(ÖÚGÓÓdxC[»¤Ó ú˛‰˛őď¦ę€ÔŘĺĚaEO7Ř÷jĚ35(çŹňÄÄź÷˝ÖŇB^Ç•oűFÖeF®#“´?;µĚG¨PőŠÉYE‹öňĎ,3ĘŢ&ľÔGuVßÄ\ě·!ŔĘW] ZďIĚ.pZLqš/ź‰sčôGpŮnĎ-»1`Ř4k™….ß.«×%eéÜlî,źBegă9ú,Cç­ Uz/Ó×<Ŕ¬´–ŔĽ¶ÉyQ{ć¸7@*ŠçŔ“1môu¶H3'?ˇ;O+‹›:ŤÍ¦ű`÷ßÓ2{ŁŤşR-¶=٨Ýpj»Žé,ä;[úŠtŘW˘Şá IűZ2ㆱĄďŐdi ¶6qݱ.ĂÎU´á›®äţ^ ę+†i<¸ÄÄşý|cÄŔý>â׶$îÚ…Tąoy{ŁŤQYTÜô—/‘çßhąMVx]2ôÖpk;řß™zÄ*ŞFY¸šYvuÔ,p^»WÜÍ ňĂ<ĘŹÖŞdW=39žh¬\<3EFů›°Z“Řră}·‰…'`wHJ@7đIÖá śIë˝n`·–«6,çÝ 'B¶§2ţá̽Ѝý’rµŐĄj»><3ZŃ-`2Vď÷ĺb4Ů;V»ŞŘrűúüŹđXŮ›}“î*r8Ĺą×]TfY“gż6ľřäG îć•Ôái.Őă÷!şÁfŘś§ Ŕ[ŐíŕĐ ×)6éw’7Ś]Ç  jGş·Ýljĺ&9&©ŤBG~iŃŇ6.ę©éFČ]Żíg-9/Ů^ŠÁ€á7ôŤŚKüUĂ€y%Ôgm[8Ń? ö14!JBĄbÇĆË‚Aą7b…ŔO aަčř*Š[^“Ż.Ćë­¬óť[v1Św\ř{<ç˙{’ĘIů·®ŕ#bSçÝb@3´ČE1ˇ7ÝÍľnMĹItĆ(xiiŞâчb’…îÎżpí˶‘6nA2”w ‘kjQÝ.-Ň-Áž­ůo›őZC@<«‘ň.Ď\ ©"5¸ˇwlĹ©_–Írf˛g„×ĚMéYSn&»Ć‡Nm>;JH3č-˛(`@Š3>έ˛HK^EüogPŕĚVj‡s†!óˇeîgDÉ*.¬‘wÜČżu:Ł…(AÓ´ÖĄĹ`´Ň—kÝŽ ĹÂQâAż‚â’4±w®DPŽťş¬Dž¸3ą®r“>%Soéns}ËEc´Dň(&~Ćši+Üi ¦űäyžîäű Ś9>!`‹hNçpM­Yű`ÓŔ^Qú¨ˇ¤‰–—€Wť˙ćí‘’ő¬VĂQ}˝ďކźîMNˇörś6óŘ”ßý cď˝;ȢßÄ„B%k~6{Čßł/Âś®üž¤şeëž‚ ę ^B±Ž˛1¦]N™lhńϵ,ž†Éś+>Ą%=L4ÇÎęω˝w0=08÷Đ:3Ď3ﶶ¬Ű^˘ xż‚9ý†KŠBsđG 4+×ŇP"rün@‚q9*fS ÂfË^ ĹgÇěŇUD«¦v¨©ÍJÉăqśü]“ާU™uŮZ"†·b ÔWBŁÜŻšŰEó“ŁE"µ7íg ě=SŁŽHY_ëňhŻTťđ$‹LÔ^pvrS;‚Ť{x~Há ?ĂË0ę<ůVUŽ˝¬rŔ-1,fieęă†ϠJ~+ĺú•ä_bě‡ô¦ŞÄ5¸VĹ@žU3F 7XÎÁ¬€Ě›®Ä`ú%fL›ůß±H'k4+LÔŃ"»ý)Ä:f Š˝‰ď&¸xz¸Ó›Š×R˝sV}qµÂ0Aó\Y+PCŢMÓ<ȇYqF3Đ„)zRQťłÁ ’&ß#éóqŚâěŔv0!«X'Ň=Ś‹yCŞÚy˝@ö“Ţ|Żu˝FËg5v++Ht˝Žc©lô ›=P>,Ópr‚Äí°adÉÂ'!V<ńNMŚl9AV¶/j'äcŁeŠ1 „çCmáĽ7ĚjY%îĚř×M8va?/˙›bť1yëÍm°ËwCóÓâ€@|eľhÇKĘELé6Ô˙¶5ÜxÍ»)×Aö4öaí<xGŐÄ"ÔMHČ{€Ňę‘C*Öţ–&]˙bë‘%4¦ŹAB’÷řĺçŞ0úIĘEťĎÓź60ˇčؤbÄ9®¸Ť.Ëx¤Bw€JćxŃ8˛«<¸ň-Š&˝¬śS9úY=ĽŔ§éÁoŔ†nČŃiiWU˙w XŇÁăÂDµ1 '_ Ĺ)ÇW)iŤŹťÚôŽď8aQ-aLĽçúČ‹ęő¸_bFăÖ% tĺĐ Ç:ĺ`Ě‘M?ňőÇ>ťáR€U…öşRÜ×[%J+„"Űhä—śm°rwĽSm iĚRô»­$řK/%QmúdÚ=,[ËĆĎCá'ŘČÖGÍă. ‡Ž#cĘŃáfŤwXČš‰ŮÚŰ6[ĺůŕĆLKźBřKc×xę3Ëb‡ŁňG><ÜolP¬qK :É·ţqĽîfm,Ď‚÷'ăC”uŽ´öBľý¶ŹąŞ A´ŞQľTěĘĂx¶c5kđSr)ÇŢĽńŰÂkOŚ>±ÁSd±FľmšĘżŽÄąá %ťöZžđ5Č™É[†vĄ-)miAŮďHó\},Ö⥎ŢsÍLÚZ* ÓÄŃ­CT›ěreE:Ŕ$l€0+„¨F*ňŠő¤Ľňqü ô2ďsgwüŁ§Ź€:Ţx+¨,x5<=MG^â1Ĺ;Ł”óą6ui8ňxŚ=ßľ ţYCË×é€x¶śIŃX.Ä×8–e úüÁŹr’¬E2Šáń#3kžťďWŚO?gDĐÄÇMDI®ľnÓü(«l·%¤˛Ůi#ll&şďé=źß˘jšInŤç­qËVčŐo˘±*5Ý:÷hękóEb ˘¤ SŃ T.ŰB­u\ „O CeD®1]ôńxw‚\*Ç`RÔgHęÚńočëűăuqŔĄr6'ľ~lÁú”`î!•P“đ'˝l #ĄűNWţäÉń—ĺ 5­ĽŔ¦Ôl–˙¨ŁNHB‚vSë¸91ÉÓŘÓ|ó˝ j…sŔIUŢocc‘CÁŻĘxĎŤůR˛GHfw¬Lp¨±4Ăř0? Ů^X\3@AĐ `5vŞkWć5x n€t¤ŘŔŻćiĐ>ć®3ů‡g%1aO,¬¨é/ ye¬ŤŠšŢ_rNr:iRóἩďd¦ú ÷ĎŁDuaRNŤnÉŇVŐâ‚x°«J2*šł÷ń eרҪsÄ ˇ…ě ňdŃ1%ń É-µcÁT¶ŠfFMŕZÜ e{ě‘ËÎĄ*:ö׿Ł„j6–?ę)ďŕ5uĎh¬Ą2Aî |o<äŞrŔ`!¬E™&?ţiîâIŔ*`řî7ă`Ďo@—fHAÓ(zţÓăƬ±]¨°p˘ŽµäM/@@8u&T…ôęKvaŻ…aăŔ&UÄLÇy%TĂCzĆW‹ ‚TVň`ęÉqR[ů[pD·…·V@noŘ™‡Ď]Č%–ýĎzŤŘ/[I·‹Ôż¬‹-$!«xÎ’ 串ţťĎâ(Ź. †ŐĎęÉ@řëKPŹŮpÜ,ţ†¶{VA_‹Pˇ5¬­FŇ‹üge™Ş®@ˇ§“$|żĆ‹pÉO łMý9§7xA7·=ÍÂu»Ążiű§ćx™ˇ'¬×.”¬ŢĎŔ&Đ~Â%z|Ňka–‘⧷ŠśŮ–iĘĺ"ľIď ×X~‡˙tĚĂĚJŁş­‘…ŹSşa©!Şż@¸1-V1Nš Oą±˙‚űPYk–âqîĺš˙ĂpÔśÔ˛’ýĽ+iĄ-$_ĆÝ,”°zZᦰ˝Á:JXńžô€Ë™p0ˇÚ«ĹĺRřą•?Š 1äxŤ/ě2ýNg2r_{q íŢŮË«N8nKcĎI…Nút§ĽŚ1+RŕľĺÍ~M}ô ‡›Jľ‹GĎéĐ`ş­ŘB  %©ÖA“G MIíźä•Vôđ´VͰᥨĘÔ1á›˝ĐÉ°qôŁ®†­Q­ŹłŃqżâĺqô6Ó°Bt0bY×+0ö=ßďWGŮp}@†•ˇ`(Č<ÝVl)ő_˛y-h΄‘Dźçú­ŚKĘLâ%˝g‚řקôöĄ®˝¬Ă'P€^é›v…Ëľ®© ľÎWď˛řÇ$µ¤ĚŻYÝ.LVâaˇd9w´„ó#O§vD4G"˙hĎN"C¸’ű·ü`¤·řÉ!h,8â@o;ň©ÍBh€vmů÷$]¤cPĚe­I]ěĐŮľZ)αA†ŤŤívLo÷j]ĘbůyŮ«ůT·eúŤFsŇ®‰ă¸ö.Uk‰[ÎÄťÓ°^!H[ŮŰĄAa„á¬nłçí !ĄóDž"áËÔb"úoleśŞu‚ ŹtArˇÁB°˘uŔ úŚí ˛OK4‹•ęy™â3iĹu®xô1«´IŇÍ9«Q3p$ó7%_*¤Ájď•íĘ  ¬—ţ-6ůčxě÷ŐWgÉş"% rˇp+«†ŚˇkIŔţ™|`Ľ= €Vřř(4¸ c”ŚÇµěA9 *Ü•ă´}J`‡b/®´oNRwA”ëúŁ!éŁmÄü§|Đ  TGá(jTźłGZÎB\5+’ů•çÎTu?^-8ľY uAüÉ ,řÔżŐźËö Ც×íµč8˝W:ó\•“ň¬«şC¨¦+ §(qJ› cŤŠ«ô'Ř­¬–8şaĄŢGĎRKb»=„Ҹ:őgţç đ©w§‡ y†Ô©ŔĂV}¨ŕ‚5ţßŘ‘CNú$+Ä]âG"Î?^ô$ô±*Ëšv…)ŻŁęŻňďÜ-Ľv¤ µ{–††'ţ©Q>ő-Â5Ž&µwß2@­ „ٲ±-?©n±ôř&*Ëâ˛ÂD‡U•ĂPóű“mç°F(ŇÝÉĹźŐ5RTa0śÔť77`ů|¨:ĄR§––öőĹ\ymëĂűtýÔ¦v¨“­,ą•ë*!f&OĂPŚŕ-.ĹbŹÎţÝx'ĺáúź˙ĺ^ěÔkOó |ň~|WOżCŕ×D{ůŽŰUÜ°{é3$âÂ5s:;2łPˇt”ľď ­8E>éU‰˝ą3j⌗ŚÓ ž"I:…'7¨Ľ>ű[ YđĂąúIęŞQý™°®ć‘€¨yř,CźH‡ĺť°]„˛aSŐť6]o1© “T€EĆh䕵 m´®q¬}»F\Ň'äGąn;jĚš‘D;€tf«˙ŇŞ•S”Ďąü"ďŕľtČe–Ěő7Ž#XnC ]ć¶0×·*µÄ’ÜÖ\*TqŞ!-ŁĎŰó/"?ţ†Öîq>B‚0÷ şŁv#’Ůśf\{…:Ô‹¸Ń.KMvČHżýőŽ~şLęR‚!JaÎo3NެPŹę×e€-=…dMßÁ-?ȉ[¨#»s€˝Î'‹j¬Ž›Š ×6 {ŢÜ<ĐŘűO]ę·á´U¸†Á­ËŁ É,Î|ă›90t±ę^qä×éóek°Íł8#ČąĹĆ›˝HŐ˝ŢučĚü&›źrőĹ=żë‘€Ą[' ß8_ĺęG$¦sX‹Ó­ĽPŇĚÁc"ł§ďöµdq•UÇ żhţj¬q§}xr0óśŤv뼑ŃřSí1 gŕS«Ż°‰%řJ‡|Ë=§8÷m:¨YŽË ’Ôf˘Á<Ě ô4”, Ž:‰~Đ ś"J‡P ű^V‘Ä `ˇ”)‹żŮÄ?)ůKď™;_/#‹2Žž¦ýš€=._„G_˙žßúO,)rE#šO’Č&Kqŕ¸Ü‡ĽtČ1űó÷ďűŮöiΦʿÜĚ€şÂ}ö9šó8.Ąä‘Łm>ş őŞÁ‰+LJĐĘ·)sl˘ ’JĂôÂŶÝb Řî)1_veiŇL€ŽěĽÂŢ;vëU»˝@6ä‰Č0…,ľI»Ł„Ř_’Ś§iǬRżţĽ™p»RIĚtü0PÉ*ÇT؏ިJxkCXIá–ş„–űďqĚ”o®"Şuuő>ă_´}n.ÖţăčdRŰ55üg¶MWç*ád>°o—‚ÇmPžµňťV˙át«™ývËŽ)PĎÂ+eRđŰ#Gu–MÖ~\BQŁŤ„vhOůF`şéëŕŮZěć®8Ý_Öçˇshi‰:Ň˝S_2\şźëěíó„s“§ŃsKą:%8kîҦb7™S¬­ą@8lč µÔ›Ěđá˛Ň%§ÔÝxÉi8vWřô2€fřľIyGÉÚ§,Ć« ´QŐ–ş;(ś8ÉĂ9čZ¬Z…ź`ĐŹ>·~Äř ý~Xú#qű‚ Śů™4}~7z‹í5™:IÉelLúRnZ^6Ń÷ő7ă)(ťŔČüvx qQ§$‡É |˙Ë`‰Ľ÷gY'¤+«ěćeÜY‹1DoUש€MçExĺKš*»Ţd•ŰuL”Jöá:¸•6 Ćţż' ¶ÖZlŇQŔgTnaáŕŐźu@C¨~űŞ”úwHăo¦ß !]ňW'Pëuđ.ěţ™B;Î÷¤GV÷F|Cꊒc¬żÇ !}’ o__s7Ő+OŐ [HĐţ«ß[Ú[k¶Ë śf€˙0•ţS¦(AxĚ]sŞFŽĎgG~ßuÎŘŹ„.ÎFöm)鞆lŕH'“‘ŤCĐŠ|‚ěźS'™{@yÓµ‹©(ޱ•ťĽýµÖˇě]”Y;Ř°•«¬sËÇČ_壸KÝ͉ZÖ˝Ő«f·čÂ<‰×‹ĘA‡˘nS#”ča˝>‹s—Ęľ—§+ŻłŔ•¬u€Äë<đ8ŰŁgg/ť’aţ[iěÝŮžkiţ4§?ÉÄHĎŢ źmk–uÚ / ńëǦ«.RkŞč™Qp(r›Ç\‚jŻř/ž“(f-ř/Řľ{Ç»wEdŘDkýo p Ąf,P˘ß¬fJô1Ʃ݆ű2¦ ,BOý5ĘëjcÂşÚĽĽ„öHÁžŞdVßM3'x}M‚—]nxč„ńíc¤+4ţ}YřŹą@»ł@bńÎsš«€E¸ÓćMĽÁ†¬Âţ#”~*íöDš8˙:ŽřBއĐWµMň$fĺícG¦ţ»J#UkďĄ%~Ü卟<d–sţ#°ť˘·Ď3î¨Ýq)yäJZŇŐK’eü–ϿټNŕő]sŢÇzŻŮD»Ž¬u? Iuţ:d7{[¦Ű+íŇÖą+’Ň൧yČjXÎĽ4µź÷“ń&ţ9,đľ[¨ ^ âwÂíżjŔáłĹOeÓĽ)q*DŹ3 VľžBZĐý=©şGłT3(0†‡D[ ő!‹É§·ÓĄż7QřPuŢPTŇĚëŕ€‰ .§Ü8¦ËN”6ďó4űÖA–¬!|Ň3‰q›ąĂz@eß:ÂK¨Jgeŕ<Ž§Ţ…őĚę ˝ţĆI@Á¤>T;‹wŁ·y7 x±´5:çĆZíń­:䎣&°jMŞW-Ł9(ÜJťú/>ë¤xžŰ)ËŃ{¸ü‚[8„µ¬Źľ‹ß‘V3¤ěű§m“`ÇňŠ]2ůg˛;Z:ǵ3uŻňď7\JÖĚ~`^jČ8?•m[|Ó7\Đ5ewĚ—ÄŹHŰú˘ ›€^ŞŐřcëő|?…ďńXtRŞ®ż.{cźŁ˘®˛,+Ő-J›©ňç6:Wűwý ˙#áZ±ĘeöOŔę@LĆ} Eq|`p =ŞyggŇ)q’7ň6$ ęL<¬‰J÷VŔÖţLfd»_IŃ9|YÉá1éŮÉvül Ţ 2$sĹš$Ű˙h#ľíš…ć)>…1{ç,´YOĄB[đŇęf ±q†Ř۱ĺWąlňP[[Ćr6ĚýSÝd©éâw·ůsN_ä{ÖŘ涢†™v^myňÁQ« Y;‘kÎŢ‘ó§¦&ĆžyÖ=Ăb‰=ąc­!Ş=”ěÉSě[ďĘV>Ô<@‰¬žeü[]ŞíĄĎ"cć@ŁŠJÇÔ,Ó^Ű©HĚe4uŮ" «¦ő–úßĐý™ěÎAc&čS‰“E=Ă‹ë×oPjp-ę÷uśÖMÝđĚŞ-˝v“Ćň$h # y"Őh•~WJGňôć€ÖP'Çgd‹=÷ŤËĽ°buÜJ{3r´.–‚ăĹ÷¶ Î_î°ÖG·Ŕmduű«ă×sh‡>.ĐjXĐ2 ¸ăú<^ůS ÎN+Śž–rőÖŚö*e%Ô-ľŻśĚ|řÍ˝qrąŹQp¤3ĄŮţYÓă]ĽÂ„ ¤d†xoÔjş|ˇ}§ZďĎNLřîŰbÖamb—Źľ´·äČGS1A@»ßÍ ŁĂ˝@…<1zcbdB!×+?*…b8b7DŃw]×ßp(T dâ ąÖ1~K; [¸ŽP&Şô®śL×ě$é!ůăĺ’·§˛H DĘŐ‚ŹŤ§é†ókśůYĐ’µ@›NŔ~Ş]/ĹhĄŰ±·ÎÁ¸3ďŘr"é9©ţ˛ Đ$ ů±lĚ+)—¨doô»¨ ^lѶJäµáý"-Lk«[î*ĺí±2ćéłńjpÚ&ăv?Om`ŔÚ,÷LĘÝ<…H稖~<.Î…÷:˘Ť$Žë×ýg6~důfŃŰA/ÔüČĂőO6s ’ŞyĽkČq3ĐŇţ)J¨şšiżhÂVMaę˛ Ě9T9)w‚ ËnÂĹ×°ć~(/ň)€-˝Ś·ółImVńRÎöŐőZżĘS¤}:?>żŢ Ń×?/ĂI Î^ŕ‘›ăŢŻ­°~¬>h/'F'i?GÚ°Ä ?=¨s°°ŽŔđ Ŕiź¸úă ›ŹŃč.Űś4´Ěöš#ssb“á„ygŢÇĆ®ßĹĘA [6őţJßşżF‹©OAC3É Śxzo Í!@‰[ĺţybć'Ëş#ő{át4ť&‰ą%_gpČ0“§€3›şTÉĨ ±ô‹'XÝĐc'·1ďłÜąuM« “pÄ.Ľ|iXp&ĎqKž¤şź˙ŞD™Ń‘†»đ’ˇsÓąVgŮ9…[=Sr+î"QŽ‹ †ŻEňőÖ«ĺ÷ ¶”ůĵŚmmńÓŠJ`v‘px|a–ď-Ľěa Ő@µŔ-IćhiŻ$sź(7c‚”őëŰŰ(µÇř$yó(‚ódP~ŐĽ§˘çůÝŞÍ44&-{ĺ?CČ>µ”âłČ@Ůř°ĺTh–ú‰Á)ŤguöŽ-Ý„Ëf¬`ŽxłPsR¸CäUěźÚ„×íášIĘ©üřý“ÂAŤĺc#:µĽ¬Č:ţ@Ń€eŔŻ#§Ŕ˘ĚJBżŠ~'HyUŮíżÎ(CýĐ8ó(C„†<`Á,1tÔČîK1ý›|w4kuf‰ÖLÔ˙5†äžteUŐ’ŻÓ Ě·,Ş‘<ď ť*·ÜmSVyň JŚîź0ťëřşSľK]U¸ěĘ,#Ť ŰGßcĽűŻűZ‘B^Jˇě’zC8źŘźŘw­Bď¶Y“#I lP|[”®©XZĂ N°HMźÚ]îd;Ć8Äs<ˇ·17bĚ­śÎEؑȤ¬“C»Věç6ž”ć ‘rĺ «Ü5îC™ĘÂŽ/a¦‚Ňľ(éébç±;KTŁ¤á—Ľ'TôßQľ…cŹD¸…ç?2uAÓü_ZpţĹ}a—%~X=˙íÉÁ}3Ź~ŕ(;Ďm]đ1¤ô˵C Qˇ‹/1 ĽjE38ʶ˙ą9Ű]vzAX÷Ź©›M\O>ą–g.ůŹŮk?kFë'Ů•®ÜĽÝĘ!¤wěmŤ^t)„![˘&ŘáťâúCŽ¬” =đő*LˇPš‡8) „ ”ÝQ*vH⽲y‰˝ščŁäŇ1eý0.ž3Ö«„N,®ÂÄG,17úVCOCg†šŻ—<(“­Ň^˝IĽž'‹ü–(×ě!ML˛Â‚ @!ĺk?—Ä솔)ľ ¨·řg7IvÝůgáËP4ă[Y!2€ţűŃ%ś–şđĚ>űşś°A*~m_ &`gńx_,Ő=­FµŠ€u2ÄŘBCśŢţĺ Ţ.!0í¦Ó;6ĎĂmâËőv |??íŮrIhv¬Ł6ω9áĆ„®vt‰éž‰˝|ö×"Ă}xq˝+Ź1ŰĚWÝź?®éRjßłĐ2”Ö‹î•6™ţHéz¤děŞójmÂŕd2Çö ł˝®yźlÚL2–6Ŕ5Ś“×›÷Ďdô¨ŢäH·­.Í UmÎ ęAťb×Űó8Ń-Ľú’ôÂ:–űÜ˝J@\A©„LŕĐWňKŻ¦~Ćxa9¶‡¤Ĺw{¶2ţ„ę¶ăÓŇ ź¬ÔĐ@˘hFd;>ăOµŚ/‘°T‚îĚÚפ!W#RXUZ^őAąnáZöwřO‹a /^ćD‰©qśËnYjű·0}a#şµ Wşpň^o¦G7"gYJ=ÚqT_Tö#‰=G0lSÖ€öúu·_ëB§ŻúľÂŰ0öęz¦Y4ů€Ő>Ňó˛’wN X$×륎5Ď·ĚŠÄ •ĺô: nś|„k¸…ëJ¤ŮµD@›’oÍŚląŇŘvĽëłÁđëÖ¸$óđUĐH™ëĄľ«Ď®´ ŇŰ®jű1e.XN’öv 1Aô„ŹËޤŋ¸o]:.˝˙jÝsŇHߌRĘěqŞxťÇćiľÂoC1»Üő‹KR*…żpY𙯑ۯq üwGů35őjNż_ŐˇI;Đ‹¸ĽÄ:ꏙ’÷ŤWL"ĺľźüÖÓ”Qńń%˛ký Ĺ-!& Š•z@ÂqÄőłÓˇGJg?LĄFrPűÖCGăN•™ă¶S‰ńň=ËwHÜPŠü_YŃn˙Ű\žŤé_ĹGb¬™áb„/źĹP`đŁ_Z#›Ř5¶Ó^¦NîG,!KV5Şß/5”PGL(d$iŃ[jú¬Nz†)ĽćË"ŃKÖn´¸HZö¶č´Í¸[ă+ÇňťÎL®ÚY_Pđt;Ř>—˘Çě¨ólÉ»ôµŁťŹÎÜFĺä+ßG0«{–Sďć¨tRE“Ľ0vÍL÷«SŁáänMHzžă‡\ÉXŻWMő{Ô.ő% _\|iVţţŃl š®[iÜ‘-ˇ«bĆŻ÷ 2v•µÓŮéÔ˛óNű˙ÉÚüóc*–nkZôµÖčÁđŇ<}ł?‡Űü´ö3LřF“SíĎÁŤ­ÂÝĎBăB~GÖ EŹc±gç˙•†Í fAL‹­qŠ%+ăF×mŠ÷|îhGĎňöX-˙©ÇńމIö«8¸^’O’ĹŠ(úki^˙×OŰ^±vi·ß5<Ťě¤ěF"&(Đxđ!ô–őŚşľPüÓ”—î€9EŇh5ŕÉ˙€iPjMŃJôZćÜ|%x%Ďśdm]OMjT1éO­ŐĹ&†<uŽç şá7]˘ĆxdD’ÉĘ{KłŹ;q±m‘`đEࡉVűřauîÍ2»…ö–4F"ě8«Ż{ÓI$ýsX‰nö 0Ţ4ü¤hŤą*Źp©sŃ‘ęe⍝ŮÇdÜé)PąÝ%îúéŐY×džň<KŤÜŠŁ śŁ_`‘ŻđăËHśŚľa—Óö8˙/•cLÜş:HĆv5Ć·îHő‹‚-ŕ´Óě'łˇí„QĐ ŕ Î ŐsĚ×{}«ź€”´®“ôJ/é}Ůů”jαZ[Rěbuńd¦ő™çť­xôŚ™Ţý ›RäśÚë·lÉj’ ĹQľÁë4ö"ŃҲčhş­ö–ĚüŃ\‘##×uĽnŽĚđó溏´ó{P(Ú-ýmĚÇ9úÓN®zäÄ#®é¸™YťŢ3ŕ-o‡ !¦¨[bgňٲՖN(śOŁa¬ň|Ąy_Ö‹ă›f-|Ń«ŇBŇOëuFŞżvĹqŠŮdBEšÖ&Ls?˝Hę”ŢěčĺŤ#9B°Ęťš?ĐAČ$´î;?upŻřzjFÚ g˛ŚhYőQKĽÍAVÓÖčLĹ‹\Ň2áćjĐDś¸Ë«Ëp´HŤ9×öôžO2˙&Růě<Ă×sŐnYÚß#ŃéŔ­r…Šü:\Ľ†ęä±Îó…Ďţ©vzxR™˝˛žŠř&E‰¦şgnVě&ĐîÚ´ý€˘Ć±µtňNMwöđ ojÇ%‰â|kî(ŕRF•­¸ľhűţĽ´02ôĆn,Ţß„Ř-ŕ輡\WúÖ]cÖqűÔ_™FĐźűçŔĂQŮ;Î#iěS&Á1YM_ÓOU„oT`¤ ±xrŔx×€aÖ¨îá>XPôłŤÓ•7lpc’V\+RłHäöŹ•’ĺąý“씟içĺrnÄaJ”c™űŠś%Čw·ó-·ż=µ}¸űçŔ2÷PMň±B—óŔ‹tŻĺwAXťŹ˘ł×E_- 7ÍÉ­Ő†KĐ;ů}íˇŚ$ŤepęŞÁxľĺ†TeGk8ín§ĆH6ßü˙~ŢÁŁĽ5ġĎ8?˛ŞňŠô¶ŽGóO® —¨‡=±IîFË>Ďš'#łb7é…‹hĐçőíúÁ"{tëV}ˇE‡xdĺX†•őz‹'şo_m”„Zo€ ěɲ6|&hc}Fܤ{6,l‘ňa_d0¬=bđXŽ—7.švž‘äI zÝAËŮŹ§:^°AŐ† Ăć,OEű^®Řšh—!+P_+ŠHü÷°řĐů«:ČĽ‘hAŃ\ĂG22Ń$ě%˘ă­Ř]ˇZĽ4žd,ś1ĘŁ„|-Š~cÉ7P¦ŮŤ•Eŕ#Ř[Č›WiÇi…ˇxĐny°žşjË-S°ô­©8'5°Cń1)ă ý»Ťtrß–Šl†Ý¤šx( UĆ›OE~­<Éß üÖé8Ż´…ĐüÜę˙`›WŰŕ ĽH¨V;úÁ[^§óTݶ4—˝¬úĂ>ý"‘k',eÖÍ% ”Úą´†Jq=˝ ٦ÎAç˝Â;\suôdD Hq˙jVĂH|ËČČDćđ|í;5ŮGEMEdMĎ!Ѭ®ëżŃmůśláÄ~Rj„KÔdIďNŮxőCT]QĎ=©ëŠIVyK^-Lź\!2-můşŇ¤Nl|…Ľ*|oÜ †»?ä©bkä×N© ó×3ź=9şŐůÔ·DÄWPÁoÍ›y; Ôz-žÓűÖ ľ9&ÚŻë"‘ÓŤRĎ/ŕ–TžpţßJ4TĚŕ‘2QžçŻmĘŤ úţŞâŹĎ<×x4ŁkaľCŽŤŕ౿^ד˘˙Fş!c3:ŇŰn'„TZjÚ@Ůd¸¶#G˝Ů*čRQn‡'S绎Ęrp$Ń=JÚ†XÜ·ˇ /&®R›řŚVâD­|L`qACř €Ě§fŹ±KńůHtśMöZĚďÓŘ"Ž &»Ł‚ f¸ŠŹłFĐ>‘,ŰkŐňPÂŃo€ls9/Aű #žQ*›M€§X ˘»ZŢç‘© 5­CĎéú„IJJ„„0Ň­ÎůńĂńz&ÉąńXß“q;…ô±Śźş‚´Ýŕń•CŻjDnřśOL§ľCM°0@Łż˘$+Ť_ě»F’5Ó…„}J\hJ9r>H šu›ÉÖĐcoŻĆúk|đ&ËÚ×f?,%˙řŮřşÝ1©™r·şZ¤íł„şš‹%ÚNś8Ő)˝)“¬Ă­ÔÍ:pUŘ@“jRó p§kjÝ:‘×,µż–§ż˛źĎ ^°“¤Çó)IA>çUć=¦ž–M×J”Żx)rîmő™r0nŃP’ńfç|'K-Aći…ě4ę]¬ Í^éÎĆńK.Ď@‹ÓWqöéŢŤq~j)-Ŕ¨6zm–J‚ `TĽżź¸±§‰·)nIů…SÄ ŻńĘ1îKW”Ô5iŔýÜAëŠČ1“OžÎµ˝’{)M p«/ż¬~ő=V4ŔP·Řă”ôí¶ăłm‰ýś:0°Ď»Ăűéńpŕŕť"`Č Ľ1m‰©ä©´#z˘>—Äëdé35ČZXaĚežÉ‚šPK‰Ľ‚•GEtSŽ?6ţ®á?ŚĎłsP­¦ŘĽĎ‹9·†'/¤VŃ`X˘ęŐfa“&ŠIŻ#ĘąÂLł)lü‘¶ŤŞĺ"©ăÂč-˝Żľ‡I]%Ć""Ę6ŐHŠ}X,SZ –Ee´Vň\˝  \Ll*‚ľF(’˝÷b4Z™"Q–Dm°t˛i‰‘÷%riŕŃ ŻůŞÄĹ«Z§·tC“CMĚhÔĹvGťŔk¬+FŹÉW/®Z„nFć÷;znyËŽ¬8ů'Óש«o3äMmEjŹÄr «FĹ˝µ‚2Śş2Ć€qŁN(  {‘>÷–iÄ ­‚"Ĺĺüŕwp ł°p$ú©»â¤OĐ”×Öô2$ľAós‹Ú®A’·lś%¢ńíóô§nß)B=ű$ĆMňF8őamđ&ëľď÷ʧcüŔa9`ś'ß<ţłöâUj’*ŮÉéÇˡ6ú¸y‘ŔËnĐLiPŃ´ĺ9Ř^_J2m»©Řäo×Sźľó’Ą"HoŠsóR„ű)AËMĘf˛ßtnĆtŢk‡‘Ăa8mDâtÍ+đ8·đ˛’3ˇóŇ3€ţҸW¸‚Yš‹\DĘđ}Ĺ‹jĘá Lxľ~hł1´®!ľ}ŁÍ*2MÁ}ŕU.UĚ‘ţ: TÍÄę¤ęësKďďf@NbWDŹÖŰ`Áú{ůIů!sÍ„\ ×|n‡ŘŮC«ŻÝůĹť4¸c§ę}‹7ń<)ďGąŤ:§ űMb(ćóšŁo»ÉĎ3Šô<ó﬎E}«°«‡‰|·M˘şJgF2ĆrΊšD xäĹ0±oÔ—6ć“t'ź·FmSŐÇę=€bŚ‰lúČ\ŽűoU6hŚH^ń>jĂÎâME3GĘ=€ŔL#”bzgĹUË—ě]bL ŻňÍë[ëÝl•Vö3Eľ§ä¬Ŕ,’¨…%}qˇ:,ĽĹfĘą˙![XüC Î&jaŐ<őf‡'p‡eÉxú˙Há•y¤Ţ˘¸ńü@ă|&š"ÓŔ'0ťVĺo|ô¤šđDČ(řá4Më_|ÄďY(¦««ńÓ3f¨e6.ľ™˛söu–]ArÁß˝Ţ:tó.…pă+UBŞÜÜo3“ym#·şyÓv ;TŕíßöWÉnř2Â@íZx…ôyTaMăąo=éu*"w’wżŇ8ľľysý–Ďp “Ý2h?ć/eŤQGn;i\‡ ŚŠ‚Ó+Ž&Oí Ëa#­X4Nu·MÜ<,u ťő+É10nŔżxĐB†}žé-ÁV»3ĺt ł±ĘĘ/˨<=¤ÍŐ×ć§ůˇÖN$¦ěÎ66ˇ‹ţ1˛<Đ7˙؆‹ÜçCĽ:8šßŔzĺÖąŚÇ›Ň2ˇÁ±?JoÉ éMłÄuýęC'_E1¬ŇLL ¸)xýFüşfGntŃcj<Ŕ˘‘MÜüą2#"K$;¦Č9q¸C$⤪ą Ťáѡă˘čÍZ!nC©u'3–§ĆŞĚ˛çř\ߎ(đ’7FĚŕĽřöL$ÎŤÖbj˘ >ežQxwşE DŐľ?Üm~łŤ`¬”VŔ¶ó"ž‡Q걿vÂ4OE|đ2§*#ęKdZKCú´öŤž˘ŔÂűNóĆ“GĎ?–ŤÉ¬/ =űź \KçFF Ł´©¨i/|Ęđ<ŕ1\Ę÷C«żąJaŕ6jY5”ÉCX(ěëŤAŤrĘëî·Vß 4ä‚â™eeubyÜ:Â\–ňäx64'Ť1otWúăCtEčˇĘžîą@žsĆSüôÍËŤo"."§h ¬\}Í;"¦jüuĚxŃ-ŘÚĎoš8<+%Rá*F@gZ%Ë?W­şlů’éS U$V‘E9ČZĎíEL(ń×á „QýdwŞ'< 9Ł­Rb‡rcĽě Ţe#–˘ĘVŰäŤAŃ/žŐąÜĘ`WŮ* ¦şr"üă@­ —í/‚KsfWÚëN˙á‰)čRŚăȤŰ1É©€Zđ\řÄřUw'÷óďş’{Läç°â%ť_fPtřŁęXî­8 7í|ĐRě2ňđňřtr2Iş{OÎŤ§+ŕÖzŘ'#wjŃ­‘´$ől!ÄB¶ą?ŢĎŤ…Vřłz"$HĂŰâhű™™ŤË,:ĆyÓÇ%VËZVR j[Ô¨˙şđ’Śf…áňłmí(ç$Ă*hť¦tŃ»Są„˛^ŠúyO¶} â‹ÇCŃ–ŰţFt čkś´wC ů#<ŕŮJů.őçϨ §6YBĎRŚL~Ăü&ŢşÂ.x÷w.đ»!‘wđ-=ú%+@"0ç#ÁńˇĹ‚w"ű«­G{Ćďŕ·vŔ3ç´IŇţ»ÄmÂąě=qđ<C?ü¸w1¸ žäÎ Ĺi‡ ¦^‡âw´@v/VeµŮwÖ°ŢĘŰăĐT(—lëŇmN ¸T®1ÁŢ˙úý'Ňž´ób ¶Y‚öSy‚Wä*, Ł‘›Rsö|ËcWődÜX—.Ĺá“ XęҦĹMéú¦mZ€;Ĺp±Gřë®Y1—ĆÔöL8~¦ĺ’U)qZ3^ý ¶˛E˛†÷±®˝X@Ig«äÝÖ¬ Â34 ˝›ôč˘däďBÉ'mÍ^íOhťŻ‰s+¤ćSŘ>Ä|Ô‰äëQ›Ľ§–—Â_Jý»˙D¸‘˛JĎ?^·sż˘ůöĚuÓß_¨Şřh€÷úŘřÖ_F4qFJëčD€)0‹ ë˘ůpJހʯ€ťWč9#ÎĺxśéťwĆ~”şÔ¸:@îčď ¶ŞK‘h(ěJ9ú(hę5Ŕ«ŰópőË2«†ňĚP~Vˇ_yĆjŐŤ|8Ĺ•:jŹˇÓ¬‰‰/J´7’ d‚˛ŢĆ%•˛4g’q54sŕŠaŞgL5«Í›U‘žćA|YQ´ +!`§ń»ň°)0ŔüHŕ’ąäçdx°ď¨Řť˝¨I$O@EÜfşŤűŃŁĂ…ň¦73[;*ň%Yjpá, ¶:°ä°÷ÚNVÖÓĚTťćAĐ Č.î@fp€$!bPŕ1_yîBľ¬nĘ'( ˇÉŽL ŕńŢÜćÖ&}ú.jĐ…5đĺłéÎ1(c­3€Â˙§ąGřŔ\"óK(ź8m ×îršęÇ{f'Ž7wzs¤Z¨ üp š¸rx´°ţ/v;ZŻćÍşŤr>‚ą†¦Ď74ŕ—Ć˙-[Žs›eRźĽ'ă9t;›Iů”Ҳ@[Żö›ăö#·˛[ń`«ąőrŹ#7»ĄV/Ç3 ádÍĚóşˇĘ‚Ś÷7ă—űĎçkž÷ €Ĺ5ąĆNďš7+şĘ4}I…'€­'‘Ł"kspzÍ#üŹťgŤWÖśş? ,¶Ť†H|Ń'^Ě}¸ë$LBb/)KË·é8łöθfŁSŠ]wDíëÎ8=«)Ďx+ĺëďx"ž+űZxm§(Ăp´—®Ň|Š»žď-f"ˇo]¸†ĘńÝáŐÍQÖĽ§DÇě1oŘx미đ)Üď©´í0<Î+éľs+řuéĐoT=Ą}L’{Ó•óč×éśđç`ő,b!AŰĽWľv#2˘"‡‡zÔRúł˛:E‰%_}MŐő%Ź4ëŰőLŔxá•+¤QůŇşÚ~ĺĂjҧ¶ŃďeÉmžî’îđP1źasü»Ń¬ö{VVsĹňňéěa'a3âZ‹łm üŕ'ršř$ěeĺĐFP5ţ¸©5¦ ‘o±~Xń.Á‹´ąđ[ÄJ(–{w§@Ív÷p%ęa¨©6Şa{ŇEWô„ůÚµ5˙{bůŤŔ»Ni„ ‹'1%©ş[ śQý‰Řš‚UxC‡ĂpĆZ8BôL$Z—9 ŮOâÜ4=,ëFÂĽ–÷ËíËSK‘ťě;¦\,gýÇ©›–Ň­Ó-”f{A#vTĆ7Ü ąö×±2:–Â([‹†E–Żš~Lhěžkąí ”Fbí0T'Ŕ4ľ8·Ď5_ hŰŕ_W–^Ě×Ę6L‚ÓâI™,Ýę nŰBÜŔń­7şaŐnZT˙‰ťWĘA !~˛:áçíF’mŃ}xrŮŠQĎ›Ĺ~†ĘŤ@“V’ş亥‚zX]!kŔ)ĹŔ_y­±źľGB´ÓI…Ä»‚Ѷ±ă=§ČÄŇ4”eŢ*Ňľ‡˛Ë—Ćfň1tťŕk›Ő˘Gyß–łÍbqf6Ç•“ ÓHÁ4|ÍOe3±«Ö;:Ňź‹"2t4°´;+%VÉ˝:Ľ&{UJ@v¬PĆĘ_\Š€ů-Î@.ë6Ćš3ˇáîp$Ô„üF)é^Ăő±Č Ü !,ŚĎ3Âcş„Ž´_2®D°DµŘĽťx©P\÷–´h4¤Âă1žŽ—¦Á„ěËĚJĂvTWÜFÝż“np%ýç•X=p=ę˙ć?±Ś+)ůΫ]Ş…ŁRňÁL= yÍđ_T‘‹8G8WĆřŞř~ćL/i”š^J…zr˛„éŃĄŚEł^©°é¨Q—Ś2Ţ ¬¦ť–ŁW¬÷OÖgÜvçrŘz«b6]ţI}Ł·5¸ŮÇ?§;¶Ż&‹ =Ü#Í:,ňŮA&ĄŠç †Ěř±¦—N§?/Uc×}Töˇ÷_”É] ˇ§µ]qHÍ4‚'LŤşň=űK" Ř»=ŇŰf°Qb™Ë:ÇE ýÝ7·µGŁů˙¸xřqbhdÁnÉxu+z‚ÓTź¶†z? ¨r­šÂ µ„aęjý,Á@ÍďÉň3ĂôäçÖr S‡°ną+ßoÇWXuű-#aŇ•¸N8DĚ>xé@żj-Ę7ř”bÚkRČŕÉ­K0ÜUL=2=‘S?rCÁÇgűżČŐË—ýí[Óš| ÂÖůrm@#r_ňjľ°vśÁw{ňĘőBM}ä.7k¨ąŻLĄţ%*{82dZ]ÝjTRi(6 ˘‰zúyű›öŻY@cÎ_g¤RW.ú/Ó§}ŰgU/ŚgnK…ČU™Á“+0uęČbi˝,čĽWÓ4ÚŃ8_׮ٖđ{L|řńßusćöÝúź†ŕ¦ďcč!›ę±O1h0r˛ëŐçNĆSśĆ#/®T zú{ÚĘm“7Őžá.}ć)3žĂŚ+Mö="§¬a ť<őQ&8ň^Ônëywµ/ÚHÔÓ0ćVŃ÷äuYZW‹:Ô•ý_Š5×ƨ¤Ľ c"1Ë [ÝÜím€Í®¤nÍm!uÂO8¬@ú”Q´á‰^Yélj˛#qă{íÇ8ßßČż˛·şŠ’˙®Ą7“Ť…Sáq‰Î_áwkią7ŢňöOáE±űÜXd}¦¶¬Ô,WÓÄK‰s€r¶r,Č»<\OŐ§S¤ j%AÂÉ*T¦ęáÖyŻâá~…wa=ďTŮFTŻÖäŮ4‚–‡şe–Š ćřô¶Ŕxď%+Úß°.imÜßăWĹI4üç!ŚHŞS­ir”ĘOlt6-!pt]'OCÍŢ(Âd’T46­ue–đUŰ7śLŢB7|f¸dp÷T®›0ŁŘú˙É•hLĺZďt‰t…­źÔXűG™D·ä‡ĐńΉ˛ń{)>صà ÷ hĎrĂ›ˇÁC‘ťČ°ęFMÚ‘¦±­Jăý-Ťĺ˝]Ó$U¸aäáąŇşQĆťĎó=Ó GäČ~ńâRQ /č™Cx玓¨z5ŠőjÂë^“%E*ő–ƢšÉ“ľ+ž“nQť°4Ţ̱/˛Y±Ýľj0„» ¶eh .ŤÖ0‘ť8«0®@ý^BgÜë™B„Ž}V·|â0śŘ•Eřë@Ăz.ĚFçĂěŻRw^ž˘MňVśĺ3·aRĐ@ˇ‡~żúĺM '•]‘}ż÷}%]@•,ÓÔ÷R)˘Fu@Ăâ}ĂJZösŕy€—őČṙŇ-±5Td—ź†ü@ű¶÷í­20ŁJ`ËT—_ă @Ş a čň«ÚF[|aĎţa)áľłăß@ Yżń®Ź333@ĐŮ­î Ř®Đ`ޱv€'Ďś°ęŰ$T:ŁÚ*8WŮFÎR´ˇmЪѵ”;; ·/ „´é¨…”ŘŤµĎT#. Ŕm± ^žźh :¸ě)C’ŽŚŃë6Gť·ş "C]h€ţŞŚÍE „qĚ uŞćŘç$…B»‚/ĺďč~LźÉ«‹†L¶ Y;;ý‚%–’–+şş„ź’Nâž°Be8)Žş*ĄYr>ß1ÖÚCŻSKögߦŘŇ˝ĺ7 ‹â›‚ę—¶Ľć˛,Ě=őT‡€YľŇ$–?:”›ŔŐ—rŃ{=ýó¬F]0‹ P‘›Š®¤WUĚO®GśÍ€oZv[o¦ř·ó|¦9éŞcŚŤ7ź 8>Ş$ ÉŹbw톤 €{ÜüĽšĎ„2yD@[{Ŕ6ƆG ¦yŞë6MR~Eݦ“8wŐZ“-ĚřĘy+u®ĆČđV?LŢý۲JŢĚúŻŇ><óĺ,‘ĺ@ÎúŻá‡š¸<Ş>|ÔňÔś;žŚůN°‘SˇqTůÉÇEÇ˝w‹Ş}|ów+s•:y´Ů„¦Ž"pרĐČĄ·F/FâŚ:Ů/¬µ`Ŕ­úÎTŠ)΀ť¦[|ĽőĄäqpNfčéFs03ŹĄj‘s5ÚŠ—B˝®ş©+ť—Łź±ŇűBŤśŇŘš ÎrĄK˛ů˝ Oö—qâô?ŚËǫ™ @ŽŚD$Ź“?kîDnڶܨS6 >ĘžÓwŞÜWNŁ<Řq%÷ŹĚöŻ4Ŕ/śž¬Ş~(ëgŢV^sŢ@;řQ7Ťśxf3yë4~©´3°ßᔕµ%JܦňycKR±÷/¨˛"\mk‹­Đô¤Î…ŁŔhÁÉ“S©ĂP b°u”^ůq]Ľ±˘äźçb$"ĘSÜÁö? č27§3ř˙źĂ¤†•ÇÓś//L­„>¬÷ňĺ‘“ÉU®°{Ŕ‹ZdŻÔUNÝĂ™U *Ćŕ^źýHCn,éÄ76%gOBţy˘ę}Tx đéaČ Ů|˛Ýł¦ ňL\•­˛ÄT`ói_”ąÔfŕ¨Ë2ˇµ úŰ=Ľ˙Ų6đŠ@…#óŮ=)ueÁ2]•*ÖŘNŕ w:~ Ĺő b’|Ľ×¤éč lS=Ró:«ř:<ű>DđA‰Ćçť[')”F‹ÓÁ25śyDá‘`%7îC+쀉\Ćóí:'ÖZVbo;ĆĆň^ÂlH1`Ň~tťî|t^ŠqIń8…•p É ¤gďQy9^¤a ˝ěuŁÁ@#Ś%Éú4¨5oůŔ™ä¤ÄçV*UŰîŞËd‘‘~Ů™>šŚAš1kTŔ–Qxâňd‡TňČ­{…@ţýB×ÇĹ€bÍŤÝ»dT‹…ę–‹˙ÍąŢi¬‚şŕÔaM ŤÎ2'ÍÁ µąw!ŞŻçLŦ âôÉľ=P”Še~Ö8Éů™3Ü˝˛‚ü__ç[_ë  c đuŐţŞŚf9‰PlĐź&ŕľU>Ű I îsôŐ"Á˛ĄZ%–ŮŰ4űĆzp‹tč÷ŕ,"ô ϲľÇLnô­Ť:Ýhcíą×ňť;j4¬íÍÉĎpśŐZ(Ď!űRP×iIϤqsĄ/Ă:Ĺ‘k"ĂęşWÇdJ˛DÂÖŤż $—đw”Č BŹóťÍʆJˇźz¦T˙‚T´¸"]Ů`4‰YK0Ó™5<ÎŇ´ĂHCo—a˘ ěatá´ĺđ­2˛[ą&w¬lçÔ ‡đAG{ ^úŮŃÂMŕi$ÔM4kű¤UŚ‰?h‘j§đ2t<Ý × ł5Ń™&.-Ü$î˝·Éö“ô“A·¤ó x…)náOx˙Ë?#‘ä™o9>î?‰Íël][n.5;…‹ţ‰¦Y,ŢX®ML bJŢç6~†č2Îů+˘—ŐEýL4ţ Mc:öG÷<ÄM| azp÷ݬcH¶i;Dľ‹Sd€đäŔmyŃ׸şM˝˘UąaŹCĽ†ÎČ#ĘÍŠ KŚ†q$ĘŁÖŔÍT6¶­č›‡ć†łcL# `|Ůב/TčLµĘ–KŠ·ĂÖú   @ŔBňŤo N‡í áŃéůdŠäJź…oöŮx‡±ő~3ŤÔMŚŁÝLyŕIµKśŰ˘b/ÖĆ®&^hČ{ť12ńk-WŔ TňoV.h—–ŇKGňó‹ýS^§ú´ůóŁßŚé yG’+čßđ9DÍíé5Ax1©ęé1T°¤ś†ĺSń4eË‹vOe‘ÖŞnď–i9ĺ±=&#Q;nëĐ× x Nf9°_ŕź$÷ŹěĄ™EĘ*:Ăč+¬ë¨6‚çÝŢĐ÷ě©đSuµŘňŃŁuŔŧna-ńqĺ,™ey5|n$Ŕo&Ü?dż2X¸ŹPĹę{ńćíďîn˙'$IŐ;ďĂ\q©šb­­Q˝'M)~Ď1í´çlě'ŃË”†ßń¬mě;Ś›«őL/üDk*vu1‹/2ÝĹżd¶ůG¤XłAEąg „ž;9=$Ĺľf 0 -5)¬(śAh…żDžZ\ĽYîu*4FĎŃ€†™Ĺô3“ –DáEłń·čŁT/lV.„Ő.J•čđÝ$}dĆí L4Ó)o Â,zb>WÄGâúv”"qŞ÷Š®xkd5ŤČS»©<čbăľH+€ĚČůřleXLď üíűá‡ŔríŽŢ˝üAŞŰcańŃɶŔ駮}ýlwÝĄłJźŐôÔŔ@\•Â  čó®w¤¨ĂW Í©ˇĆq´BŰU“~ĆěTpKżüłůn¸î«ŕ|Ł şGM:4l…ę:çިÓŔiKĽő %RXPtG77MWŔ‚Éw+Y§\ú8ĹŕĚÂ069žÜď˝ęŐăKöÔbŚaŔÎ[°:ĆĎM¦ll˛M-XĺíŁ€Agŕf¨î©ý¨)bD+Dcô!ۤ3\‹męBÖŞ%;N˛LƧý ĎŘż±/'ůˇhQŰi iĽôúä±ĎżxĆHÓoŢĄÇ>v()||p~o|‡ý “s&łőQĚézďWř‡Ot˝;ĎŁČŻé"«çŐĽÚzézÇśő­ )öµ`ŃJ™“•<óˇý …Ś&Đžu)Ń–śĽĺÄAW–qKRTĂ«V.ŁlŮ.ŕA‰dTtĆ„›YH@ô?äšÍ{úŚBĘRľ4ńŁźP/."÷k eJô\žŁ4`9b§ÔËŚW6L“ĽÓy`Ŕź‡” T;Ć÷ţö¶}ŮýLe>Ň${€ă—3ł» §ź ¶‚â;ĎH+]K2Ü~Úśĺ%,g,…(”˘*i¨ŕNrö.ż¦eĽ˙ĎĘA`î:mđ4ü[g('ÍŐťŹAÔßč4yź ô ´"y,PH rFýĺÂ}A¨źlﱨIźŤ˘8h€ŞćŔăUśFť—Q KńĆ 2Ζ¶|X­Tăµ{ źm”JCaA ÉĽ12âŻÖźąIĺŠZňü ŤÂgl,˝€×«ř_Ź [`ssfiú2V)Ń8ŞWľ»®ĐÍÚäS°kúŽź%ÖÁ“Čt°PÉsYł+[ovŮvř€ë˝ĺÎÔěCĐ“Ľ ÄLOD&i® ˛sX.tíź»WÁz-Ěë#â:»×DßÂÁƬ-ÎçZOĐP~˝ëłY@; dČÜmSÇIýÎö|V˛Í/Ař·›'Ů­˙cďĆ ŻĐě&7ÄU4ĂGH^¬Gťn‰ ÷lí)Žßéś*qˇ•ŮŽ]°F-ţne ¨±“"—ćőTCiŠVR˘ďKĘĎ·-­ţ1x~Îéťś÷š÷¸& Ír“=LŮłNšŠ_ţ©F ;zN?Ź|ńŰ‘đyXk,Ă˝śWľ@1Ľó#éěAŚP÷€»#ÖµŤş"Č&7ýĄ,Nő"ć@¬3ȦâáĄř¶}‹őšÖŕMf~rcěE6S÷$™Ô$XĽŚŹ’ĄcŮăżć j±dµ˝sśE'Ć%ĺA óÖ/Ť ·é¬b–˝K8¬Ç潵yj Óqbý6ňQűކś éşŰ‚dťíěť˝ó©>hőŐîě Sل̱y ÉŚÜ,Ç7eB¸ ćőż5m˝™% E}$–ýÍ(ÎÍqy›N,‰ŰB%ĆÜĚ@¨_Şu’Ţä”Ý4yňńĄÍHŃ;ďa…€obôUqI˛»M׌€ŮGé@?sO2Ü:Ů|e"Ń*Ç'„N¶rˇ%ýŚ`f/$CŻ€9Ń,öľ¸Ĺ‚… ëPá€éEŠ¤Ä姱¤µ8i\vÇ7ÁŁJQxŽź¬ŽRŻŠ)ľ{Őcž(%>ţřE)ófĐ…Żo˝VđßK´.B LÚ|¦÷/ *ŐűMÁĹózĄÜăR,-r˛żnBŚű&ţgeŰ­_4•ZG´ďőľ‰ťGý%ę0­ő¤ă"úBç"źŰ«˙ áŘÜo…˛ŹVx˘ßÚwˇÄČő°ń$ţ…3F<eHâĚHš+ Ű$}uĹnÓT_¤EëéÎëĄöÚÎgµWŢ|­Ę5;~€źěͱ>†4ÔŽŇRk şnöPKa ÝcťŢ¦ F`ťéGQ]–´Kwkăęë.•»˘ÚőuŘ4]8kŔáş»o™e.‚ V[!éŔ·JśŘd‹ßÖ#fé›Ë"]—Ä0 ŽžÇy~ⳎjXĽ@;s$‚÷Á—÷~O˙ÎL0NÎź)˙ͮق…±?»|ř™ô gĘÖÎ…o‰Ŕ3i7)Ô‘éľ<}¸+}TŢšÖ“ćK”{ŠCë÷w˛¶ĎĚôXßľcŹĆŁ1ŕöę˘>.$Ç…¤]PŐ6‚ůtŠÖÇ/îşcµą {¬^?Ŕ ˙nVĺŠINę HÁć°l#°­‘q~˝HDz-ź ¬^QS™E ‘°`ը捺=“Ý0F°đ©9čé!}ť|żivźŇŹ[§¤$öůLő2tŔ5T%†ţ%đ¬…N×ÝůĚ˙´ü<—+‘˝˙ąó¬f2µ„‹Ž.D@µ‰zâ|ëăÓ.˙ nô­'p1ÁĽkËhÄľtŇ—kŻ3-ües`.–rü‡_ĽÍĐ•‚›ŮÉÇZ:/> “0ś˘­Ç¶!Â5HŤŤ4 ’Ńg X #_+¸¬“ž>,q:H×߀Í4OűQ¸·ĎzŹ˛)n(;^ Wu%žx$ѶxđčPfÁzÁˇń¶Ţb_?śAĺóĘĄĺPC‚ćf7ŤazĐĽÔĹ…€ÁĄŃ°fÖl88y¤™äm@˛&LĄ÷¸É–‹Ls­»ČX3ću»]gůh&®ţö”ÍĂCâ çĹ"$Ž/}„ 3—ě{ďśbPśSžŕíES2čŐŻ¶Đ’ůO®A×Ăd:ŻVÇ€Fń)2 Ńöň†LĐCö<Ď›¶†śľ—ynfE“¶ĺ”ÉlÉ­¤m±S#e°ąJŰ ż¬sLJůžł4­¸ h&ż*;Ź>IÓ÷ď„ŽÄŠ3SŻŚ›Ł]úÁ@ň«]¸AxÁ·mzv—3 ňÚ4°~î¶ňíě woŽ÷ Ý­8e`Ń;úh á04´jFLßU[7IE\2(zbÓčh[ÂO4eçŹ žAÓiG űjTř S-Ă9÷UqjWC<ŕ­~NÎçAąú~4éŠńru;ĆŁc=/1bŇđ•GÍş‰ş_˛ĆĘ ČĎŔB"$YBćŮocŠ7wmçÜňľŤJÜ ] tÉ·źČGć*:¶˘ęďßüXĚëńő ÁŁÄZŇ0{whÉŔŮ<{“ôŻoŠF˘°m˘wŞ«ÄüW==ö÷ů3˝4Tć߼AęńńĺVLóäŠűÍ×řâ`( €ŰŐu˝ #äŢęeCN14Qcç@˝a+P1%ŚÉĎOşsĹVô·=Á!+¬$6uŔ‹ŠdĆţ$Ô—Čö÷ŤŠm{„nV]8xź[)#˝VXčęZáHD R´ĎHcq .ß‚üI/­Ąę’?ÝɲBgŞS»>ÚB ˘ő|l»ô.˙€x ź¨I=ňuĘsQE‡B„4Pźč‘C¸˛7f aX'Í•&ĺş*-~`<ęăC~kéÓŢ šśâ®_9ÖĄźi"'Żď őPÉĆ‘ ©é öođ–Öżń^†:ÓkË[űŘĂÝ–M[ éd˛VlűýV2gm’,媪Ž{ܨ¶–Ôĺ^ÂĐůúÖ–őŐ*Ö6ßÚĽđ¦FĆRx±=ľâžaš:ţ×\őŠl™>PCÇťµ!]ÓŁť3¶rŠu“=7pľP:ąž\?f8ťK±ĄÔLâďOĽ~:U·}3 qʡźżŔ`$¨ü¶ ҉uń$÷ë1öâ¦DuiÜ)đ•ŇŤ4ń&xĆÝ|2ßőłŕ®ţxä1ěż·WĆÔ€Ççś3iŽ÷\÷2~qĂ\|7tE›ąęŹ®ô™=G=·ôX&Sb€9%ŇIDŽ Âş?'{šG¸@„€Á‰]ŁĎGŁ7[ #9딇 ËťŐş9‰Ú+¨«’ŤŤu“H耒˝]2¨|°3u_.§čŔ›˘\+GˇPł™ýOEĘLëÝ!D%ŰąčŔ}ĽŹnjKâ§M7˝÷sőWrQÖĹIz{#¨Ú†CŃĂV°CŐ—ź9ę,†Arü4˙—.˛&Ýl˙8IJáNM~ĘOŮÜmď\¤Óć÷±řśľz§%ż4Đ(fÝşţFĄ ˇ(®}«suµɢc›LŇáâĄ%aŤ*ÍU˛‘2Z ýÍg!ÝBeŞśmé]:VâęB¸…SâzćÄŹ;hŃ Ąă’o8 ý!#(Çy)‘ľ†î:D7Žßô^I¤z˝yWVl5…ňzôĘe°‚ĎÍůzč­69ŰrL~Bm–=±˝Łr®mźĺ 0¤SfOźđ [šýźěO&tWH‹*Â4L˛]ěä3~˘Sů%\3ŕĺ¬ ëág©ďi]?ŕ-8”.eůdľőě.¨g"ÉľŢÉ%•Ě_H“ Ľ“(ÉłëŮîk]Fß–TŁ´ÂRYđśÄO˛…Ĺć±sg!ąt8’§čłś»Âüs—/Y>´h`6~h”vË Jşx?5ěćÄ0Y‚ i—˝š@SOö'¤ů‘ź–L;\÷†DÖî49¶h â"*5¦‚t7çĐŞüą;¸1=:č(v·3›Âjż3íÔ%Ŕf˘iL1T{đ˙‘€† ŤĄ‡™bI0đĆčĽuČđŕ· oďäÖb—ŻđŤ§”P@l˘WQę;Żz,–*šÂ€üŔžŁÄhmÔüąüđ‚Ń)—éą|RZKÄ“]ó)6Ťżd.Ś)fôŘ_^ÜúĂĹŽM!“¶Ň Ë«Äăc4˝—¬H!Ă“yŔ!µńĽ5746 ł űŞ>ć2‡QZŹłôÔŮ)0ÇĐ1d%Ô…fĹGöaŤS$Źî9ŻĎ6I˛NQűl' ľ!!6 çîďůz¸ť@Şgż|¨ŻnI‡ć;ÍšzbáÚ‚6¸üžĄDŰÍWqáxĺŕŽęsl*J–<`ąĄ#DMĎ´ç#JŻSßaµ29P^ uĂEßeE™–řëÔ‘âHxzËH řK%KÉşeĄË +Ç-:ŤčÍő-őť¦,_‚=·Yŕ6éqNöxř–ÍjŁÁŹ.;ÁČHŕ»"éŢŔMÎ)ëJ÷ry™l.Í öCŇ‘%1 1 }'“졧€8śş_&ˇčĎ>6/\‹D2Źĺ˙©q‰:¶Aú^]Ňç- 3Őł8}Đ”e®` řÎ{eî>VE5ü˙%b¨é)'rGn$YyŰo2˘J–>3’rűűÂSÎ ^ ŰĆ]¤" ěăTŘÝ{ŇC; ăĎÍ ĺ‚vÂS…Ţţb€Ôvš/zfPˬKL»Mě<9íĹöCßşsM”\65Âi &{“˘ÁŹňWŮ´ľˇ3ÝżďN·6U†T‘o“b˙°RAsV’ć˘ß’ >jüYĚY·G…AŇs¶Ţ©}K ťĐęßĺ~[=yŚłŢ€ŕYŔ°‘[Ż˘Ő´ëŠő©ĂĹ‚ĂÉ_,*(A9źŰľ›8 ‡ő»Ówş&Úi÷}Ý˝u_ęľruýóĽ˘Ýâ w*x+Ŕ“ű&­c>ŇúE~+ă M­T‹Ë…äwQů×bîáW(«í:ú°v—Ňł¦áSŽ(L:\µÄž]=EĎ zs6úŔ˝Î h'ZŻ¬<+ť”ȬUZ‚ŚGHB‘Ľ-)Ň?č}ŐäŢŹ&íÄ‹°d'BG˝ß|°”hX¶RŮĎ Ôět€&«Ć"_5’ýŞvt®ŰŘGYŤŞY\ŹĺjŇËćĘĄ©oz¸}ńg˘ěŹĹ ˘_iµPżëNG59édłß7óÚŹAŽÎĽ ›Á]§Pć"`FlFď™Cü6ÖťiSń5¤$uQvÁ‰‚`†ČçŔŃnâôđ` Â$ů›{&qfŁoţU¨Vá~-lč-O-žŮýŮ~ĎOáŠűXůÄ'†%}ľÍŔŠÜEIő [@qÂbmăŕłhö†»ă¤ű N_†ĆŚÓĆ\ď%ťl¸¸R_e—Z±h…J ק¬ž¨ń ‹L‚)05FµŹâĆ+DA—ÍyE턇»ŇŞĺ;{‘CÄ©M 9`®ŁÍŃ—kqu¸v–äLD‘§–řwEeR.3M?ě‚Šżđ-ăAçpŁ sˇgĘ*€ĹWÎ…§ćoT’[füŔ4i6(PÉÂ#óDŤ ixőšnW±ţŹYtšÜ‰e :&Aöďěí dvÝţOjX(NcA˙Ś¨] J &v«™Ůyťŕ´íJ.‘uŘ ixs*hZŹ„RĄĂ´<Ç•“1Ťß§śN·Jäí <ÜČs\KxO"Ä€đťł:t𙊸©A«G‰vâplĎđéŤńB’O¬­÷b ů‚ë ‰ä•MËÄlŕĺ8l´4X†0Đ•b<şj?źĘł1§$Ă_›-µ,H?ĺĂÄŽţäŽbáî%ŔäŇ<۲ă Ů˝¨›Ľ ehŢ34>Ú¶î™éc 'ÁÜČźw‰Tĺ⥛‚ćOĂĆe2óóůžěçźoś$ÄĘC0‚|!L ®Pôű‹Y%„3¬yU2íńM\ ý]‹ ťLÖ ¬‰3Ňŕë™ň$mt×Ţđy›Ń…ľPą*Á,ł 0†Ň;čI©¦>őúܬ…¤. ŇbcYĘq»M…BFBvtťÄĆ ď…şQË$>p¬ŽBÎh3ĺxÁő.qNRż‘wźĽ#˘~í—ßǵ?y¸ş\ŔˇďŚ{¨¸ś%őÝ é|Al!'˝Z%ßđ’ëŕ´Žhcyű{ĽeěN 5l×Onţâ/žKŐ:Őev—«ßĆlXđ¸‹˙÷Śîŕ)A]ăFШ5ŤTłSqąF P®Žćý čňÇîZčţî}z[ăą[p˝H5Ă‹{X°Äş°±JQĎvöyˇOôÔbh6v& ?Ŕ +o…ŇĚ7‘`¦·j*»7Ľ¦–ęřőI¤˛z­Ł¸‘ţĐ Ëą$.ó%ˇ”<Ł>ŞGQňď4ćSEĘhÔ˛?Ńf)Űáľ:Mén×"Ľ&JK-ˇçl{r Úý^Â%0 ç›ű •c¬4ÚR)4v•$jŔ4’Ëş(ßű|OˇŤťKEN¬­ď,ľ Źś•¤'C|çŚ óY@‚Y–ř)jĹ…uáIţÝl‚Ůěž6xă"4^ŞoúŢ5š¸¦:’ 39đăoĐ«qĚlrRO5ö(Ę3ë*ŤC˛ŇÄňÜKÁVCWł,ů‹çőNÄI4Mcu+ă¨N’Š\EuÚ§Ě÷\gŃHQŤÉRşIˇętˇĹpBäĹëĹÓ.˙px7źÚHtnźż¸p‰U8ż­Y°ôţ'ůq‰w•©b*'Ź€óU:6äâĘl÷LŘRhČÂĂbŰ=8ˇż'Hí’–&F?ÜO×0_‡$F|G‘Šë\ô;.ś;'şqA–ĹŮU?;˘ŰU˘`\ĺőŐ1RÇî'qi ĂůuŽE x¶ó “H.˙oÄçšSYKÂrá ş”MÇ7h˛!o{°•=şŹáÖlmyHoĹ ąÎ…č¸gÖ˙7Y lęěÍńŤ‘ÔŚ´…łÂfĆľp(ĽyŽEoH·IÄŠAAÉ/Úĺ‹›nŢ"¦Şť›†5o™ŚÇ˝ ŤűŔ˛Ă©#’˙ ¬’řÄše»ccRö §/ŞÚé^HA&dj )qRîTč˙HdŽyÚÂŞÎC1ě2[U+\3şá#wcOɉť>Ë48ö$ćeV¸ô|ç®ĚÜ'6z2•ŤÚî˘#Ĺö°ö%µ‡’D\c*&«µ\±1`;i'ŮťKnÍĄ·Ľ-a˙tă@QVĐ>ŚŞÜ¨g1ęĽS'­ň÷Ň[©ł1©X(`/Vş#â|hH&ĚEčwmş_עÝŔâ^ÖÓ±öVS{ ëěÂ6Îa˙f‚˝R'&RmíÍŚpE|+čÖë* â}ŻŁłłLÇÇ%ÁIFŻŞĽâÜĘâŚ×© €ŕ˝uQ×ţÁëć\ÚÝ^)dM1ÖËăXfqz‡5•v÷A¤`–ŐĆôadbÔ:Ś;üą(cüLV'zÚµżw÷;”żŞY9ĘJ=i%żďçŮDSIŁá´´ăyĚI٬MżFQG"˙qĂ`ů¦]·vGuÖT¸µŹ÷cäÁbÚ6fłŕ¶gGŠÔ/ RCŠÂ(JňEéŇ)÷ťęžÇĄ…„vJ]!ýüŚhę'‰ Óębęţ˝šcęgl‡]ĄŐľ Kč:ś^gzf‡ämÚ4śžä˛ÍS·ÝÁIx|}ůbSúcŃoŻäD´ďrňˇ&±ĺE^$4ëΠŻp)®.—=p˛şý‰ ?/Ş—…\ô7Ł×iµęÜ#ĺs6ื3ĘéÍăN\‘`9ŢV Ů€&Çďx%”§»•OµYś‰«*TĆB;ź‹‘ý5?·¨á<—°ÝGż)f˛ćţĘ"›ŽYŃáâ'ŮjÔŚü–NűUϸăĹ[ >@·y‹ŻÍ—Ý`ÇőŰ™sl:Iíµ+Śşd˘ćÇFÝ f"…Ó`Ťu tž%řŁĐłÝM"đĐ~µ-&ăfý]N˘¦ć>ž{xŚÚČßJĂ! §Ů‡ć«4Ń4}ýżiPX]¤÷\Ďąě`97e/ ßĐn÷ť0"»Ľ„=îµ\)D(’}[ĺČxŐ†®)ńÉ#Çčś”ě5ĆY) )ë6Së“ĆßĂĐö´`úżTlś.ň„ŁíPÍÍ‚Gý˙KçkŹ d`˛áŐ+,ÄGőKC:k-ŕh5¨Í-Ç*oLÇŃťHĎłÔĂ­°ňľÁv±)đ—`Ą°4ôďYľ˙ĆůË)®Í07íɶĐ`/ôf{°_K«lkCΫôä8‡HcŘ^żTőă o OVö"b ‡đŘ@ż‘zé,hî^ßTłŰ´&Zľ¬'řŐPßL.Ďl'fMo=óÁK9|ŹY„Ţ0Řcő$wĚ 1čîPÜ‹ŘmĹľ©Óö6ŢŮđ<*g ΄Űw……|J8 ~DĄŻvŻ­°k[đ7"”Čýąľď™1 ¤ńđâż QI3“6zá©›Qý Šąß«1Ú3 6OÖăÍčCüP±Ť¬fčeł°oŮ mĐD>Ľß[x€.“fĽIuÉ0$ęĆFüÄfY ›m!UŞ•Ł”fŞd§Ł8ŇĄmüܨ”›LÖć—­sÜ&>ÇzĽó8/37ó(:Ú4 ŚMČ91‚ÄCšl‡Y“Kµţ„J0Ż=©÷†^Íů¦5‚5Er™3Đ0ëLÚ ćmó×ŃÁľć…Ř?ë’ >ô,č€ëó˘ón°ů7mšbŤ§K@ç]Ăm"Ě6wŮ‹®Çvv1± ’(/……D7N†@czę6+¦ň1éB1¨,¦{L=źd¶.äÉ°Ş„sÖô>öŐ,?Pk0<~xçVÉxŤwŰ,č[ËĆ•év˝čBAY`Žź3ą/ÔěH‹.%趥í}›ňÁÔ’bŚ@±nb^Ş°ŁCMNÖĚěsPńTÇ…#ČpIü&¨s=í2·üÔ†Ôžzšł™Ç‚.úËĎăű×â‚»ÎÓhŤ&«âVx ŽęŇ_u‡íN ěßą<Ü(™ńHą¶kĐ`q\‰ q»Ą <4¤,Ă}ŽÁbĵĘd?6ćÜ9‚¶úí 5 ßYvsĎbﵲ—0ĺ”Eňp x‹‘]»řŤÓçÔžČ)gę÷kőčáöű=`ík _Iśč@6óm»Çşŕ;ĎI§^—M€ě}›ÜIÉ„w†CŢ]äÚĺK^[r 'şŻŮÖç#ľŢąBQžt›VáuŠÔ¦Íĺ!ăő©Ĺ?ٱ‹ ĄfŞ`ż]Ŕ+«RWŞđׇĺXî4ľĽÇÝ~čjoŔZ„Ý>M<(-g®®žš@ĂŚáÎŽ7ţ©ťáDjÄ…Đ«QsŐ íü F’(˛™Ż˛…>G<ď˘^3ă‘1úfŽ1.Ô´ă§a|ó+ţ{¸\˘0XÖ Q鬢ÉšF§H_fďn4Ů5{Ffeô*PvĎĚ{ŕÓŁÉq0,Űö'Sá=«–u(ŤÂš\*ă-¤É8+°ît¶XB…?âŕŕ 0ý8†ćĂWś– kqşýüeöµAŞ-Q$GŞĎmeĆŘY ‚îa×—}ć”H5 ”žkÜyKµMŹ‹śá6Ł„qö<81€Ĺ–îĄŔîůÔ·")LŚN(-„#zF×<'ězů?YŔ:ťeptÖ™RvqsF*°G›Č ;ň;Ě/âďÄČŃßÁ™ÖMcSm”~H( ”äi5§PDZy‰H­Čm&N˝÷ıIö2ťÄ ŤÎ!˙žâŹ$Ƨvŕ^§GĽK\µŇC±‰ŕë:{PHn« ´SFŃŕçËŚŁ!Óů ÚËüô‡T8öŃpÚdjĹydÎáĄ][†$î±\ŚŇßPš)mV%™éaÁ7ă†lëĺžq“µy'Ś{×>šŞŞ"†ß ĐĂ{d‡ą‚+ńz.mVĐb&mZ´H5‹1ÉŹ.ďĄĐŚá ť›Ă_â€&U_‰#cŮ_FŮ ´}‹&X|µAĂS¨źČâz3?ŻŰcŤ–´¨…šŻěB‘} ˙zUOŐş`ĹŚ2!QHISEĹžłýéöAÎ3á‚Ĺ¤ä´śŞ J˛Á¨ëÄ>ú° qZÎÍÝôśtůŰ‚…Xľâ˙¬‡[KSZEC e5¤©ř1=źFä Ĺĺ úhs6ÄÖč“Mř:ćqé™˝‚¶»:jtîFĐ>Đ=â®…Ř%®śój[üĚŕfÁÉ:ˇYőuő”°{ĂQ1‰Ŕ­/ůťy›­OŚúĂď¸â”áµę&ĆW‹ŰŕąnDÇc@ĺř˝ă:ˇ¦ž!—­šT8äB¤vŠa÷Ň"Ó´3­ŘřJ”ŞxbѵÉďXŃܞΙ|Ą€<°$jôšŢü9˛†Có†G‹îźuˇAµ¶‚~w<ŰBß° §ćr—îáóßţďů3.~­óýcűĆĐ®Ó{2h,ţîaÖ) íţNK·ôö§?|źšl3Šb1Ü1ü¨)˙9h7ę5Á˘C‡°ž*!ççŢŰńЦb",Wnüc5/ÜRHMŻ.vYŕ%ŚĂn— JJw]ľZ›^€š>˙‡˛ő TŰö4F¸ÎfýîóćôžW%-›Đó=} >Ótś–ć Ń˘Ş*¤ŕb•5Zz[kvçŃ‘›\¬wb9?ČäQĄż2}ű*6O|ˡçI¸â-÷_žđą[ýlĺ·=fPE;VĘxŽť†c=Z¶˝HÂ;š¶ş«žpßA•ŁhĹŠ‡…Y'Ŕ’Ϋ-ľFˇIS‰”¦5‹·Ă ‘ n)G%ŕĂĆm}TŹGuÇŇ[Ó<¨U.ľ–^0–‚„3‚‘]AǶÂÍZĚN¬˝~Ř;,SŤ‚ž]!Ľ!­żš&b´ÓhýW‚ÓÝëĆrżíŚ•€EńŤ~Ňdę ćnrjJ;±`­mP…Šsf.j¬˘NbłíîšÄ=Ž`yŔS€aŘĐźiöŁf¤ĺ,ť­%ü3rĎxŁo ÖŻ˙R%Ť!ÄÇD´dÔdť’aŁđPs4}K”Ú$ä“ÜčęŰ0łÚt‚ĺH]Â(0<Ů,iXveu@ 5ůsđ(ęI{©G5X­Ďg q=1É =p‰b9ĎKHŃETő‡R­&‹ß?ě8^ăů‰#,†E`č`žeđƵ(çaMh~Ş_Íą»A¸E%ŹY|ßw9? ŕń;~k1F3xĚJ°$ŚÔł„jšŽ%ç‰tÓC4)-Ľ _µ 4:€˘ečfNŮ5WŐźë8Á’kXéY ‡˛ˇîť›Ľ°u+ -—¦dą1ńÉÜlwţ]°ę‰CpM:dećZ<©=ŮónŰcA  ‰ŐG!6©‡íÝŽ§«ŚŤ†EFČ#vrt7·™řZ~.PĂÚÚ~‡Đ7š ˛ů—sďFFVúÔ‚Ý•E´ŁÁÖsŕ!GőßUąűHxŞŃöóRßÚî\ďj łdç'ą˝•Y㯀đĹđÖżj)xe•]c32j9s‚M•‰»Ż¨\ÝC­ć+?ŚVCŃÂnjv5ęŢz{B®[böXň)ĚŽ6ĐÍ‚gÂXŔúőĹjýÄ=¤ęÁÎ\ćÂx–ä:éöCX…öëžŮPŤLvXô‡âí¨ĺ<¬%Ô–äŁîŢA“Ĺălq0… ӟݏM{Đţ÷C±Ýľ>RZB~źĽM‰e-Ö%uYOŔ>úČÜ“É«X ĺ(’°h|[DAn4îU0_&W„Eh0én´k‰»ü/ýĚs‡đµ¶ôpŻú¸ KéL”‡ó–9GĎ˙^!ęNž]‚đ{jNX@X$?BŘSë0ŻÍ}eŘ8%Ţé6ü?•âćn>ä;ôn’±}60Ť NúţąH”˛ 4Ź'e8–ú?i8Ĺ'ÁĐv~EN¦^ŃŰÚ*UCç‘HQ@ŕ Uä&óń2ş‚ćŇ Ć$ŚŢľ>j×@ţ„Cîćz:ş%>óor3đÔäęĆk¦W&ŃŽş#xÍÔúŚJ‡Ń€Đ0ŇJZđ´˛u)éźSY‚{Şş$¬’$j¨2ďÂRňšL´?ŐxŢwÜ?¨Ŕ€Íľ,gw/u™”€Uäćw§Q‹Î:Dalh=˛X˛Ś°¨šk°±źÎř-V{ŕ9—ìX\˝É 6);ųɥw!+HKŤ& Ľ$‰&°Đé›<^ŔP…©ľ[f·’-¤Ł‰gÍëcĺ]_ůâŃ3l‡7\##4xúXs‚Ś´QÓĆŽţěöđyUĽľ›ŁgNJąVÔN(ŞąőDĘě˙e¸^Ź*gOĚé¦E1U\#>B˘Mčkm=ÖĂ•ŻŇĎĐĄÝ`}»lěżx/–ŞăŚć_˝hiôˇN‘çţ ăŰ5č?ĆĚđ»*OĂłÝ!†ńßѲşćşf¬ßuö¸AôęC7eÝN!yPń©no™tôŚ\z«H©,2€_cÜMŐG(lÜńc±L6Ńě.PČ:ęOű(Î}…ďX`C.\,ÓđNiřúŮ21$;1Bl`FŇb'Ä…žö R­éŃőkäkŇFlJ’!Ę˝áíŽYB KđTú&{Ő}Ayô %c·`~ŃT÷&ž2mi´% ©ó…¬ßŤPëU‰óöľ­ŚőÝ•=N3čS¶”¸˘m‡éô9{¸‚ PN-âţT„ëA¸¦÷ľŕMśA©©<7sGę—„WĹ?9pňG$ŤzZ‰rĹy/#bFťóÉ«…\ËEe~ţŘ•Ě^řĘ›'±˝Ć…(KW6Z ŮyG_'wŇâý«f?!Ä„P±ü0cV“~b3˛î(\9hÍiJ0o§Gáçh2[\ÉdĄůkr^a—óśĆä"çDÖó^żkđYßVT–s9ß †TJç¶ůu´§A©YůčDÚŐ¸L©ĹOÁ˙Q@*ą%4”ŐET‘ _˘4ióˇÁćZµÁ~‚Ë‚ÚąŔ‡ Žn<×PÔŁ"‹óLÚ8š3aýLţW*›~㹏NMh¨śTá đů[íPĄťş8ă‹NĨZ?Ţp’´óîŘ´]1‰ĽP%›ę·˙şäęémÖým0'ô"˙¬í0bý I,EŁîˇ©€šr*€««‚řS€]ş*ëčçk×·z+Az{;¤jđR€ho]‰[ çrgÎůźzHo9®Ńî™ĎížX'ˇ G¶Ź)qĚv¬3üşŁÜ}›zŁ•¨\”`y¦Ňß”†ÁO°őí˙ĹĂŞYŕď*ďy¨Â©$*ĘCáŘŚbM·”ŻC·˛ÁÚĆ*ze‰J^ ÷F»‡nĎŕM¶á2űéçmŠ•é.W®d(úoÔ1Ý̛ޔ«y÷ŽłÝ¤!j®óŃIôXxQ>'`—+ęç?šç@ëţĐż,6D7žîEzSo(`íÜšrő=Ě6™¦`š+VV"ĺ Qä5űsřâyŮj…~j¦SóubÚÓkń€a… ł·ÖVřéböłô1ˇ$‘Ó±(Î/~÷wšnţynĐgr3Q 7ť†ě‹Ťů]Ž[Ě×ű‘ ü—Nľ;źĂ‹ZD»e&"4š‘¸tB? ĺśY“ľ".€#¬$ô-n°pĽ8t,Č(*óבÖ#cD­Ú‚őkQôżÎňč:’ýŚö#SčYÖĎěçˇ]%6 „Y{ö›Î˛îďyž4qëŤGçbTS_ĆŞŃ`Ýá÷&ëř ¨JO–i?ăw٢rlŹśý2Á H“”Jůid ‰„aL„3P3á—ö˛ű{ VšŚŢš …l0}9ĹLHľ÷nVéää_GĹęýĐ2ÂaS,íżŢIŞ ąůF–ŘvĎ+}66D4€tŁťpAL=§“(ú1uJfFq™ŞĄę€5{űž_4BÉÓBhAąttů"ÖzÖHĺ¬20éŤóŻž/=ۆhኽ+Ů‹‰îńN-Nś<@ť*:~‰Ą©˙@l,öRôâß™ăHłźŤ´ž6-6|:Ë…+;&ý “Sśeů˛äwľŐQ‡8"QűDť?/b\$Á3CÚ´ÄLŰ‘–öş&Űĺ@S/* ÇcâäŹŮŔŐí8÷¶ [Îţ€~îýFŔŘÉ”NLŠŚŻňhµ’ŃFĆă’089ŰV#oťří‚kâ%»sHsťÇa˛Ň@”ž«ÄŔ0¶íźT&ľô›ó?ÇK±ć“ÓŁśŹÓ÷(żBAxSS=sžłŮĂĺ·Ľa]HĂâ-‘‡Ýćcí§Ćzňh1š6ýŃ2üQ˙éĺBEo©RťWËüéÝĄbý¸‡‹ÂÚQÇ‹AIЬ§’č§O0ßf•öËŃ,ܢ6副1ŕůýb˙řútťH1ɦRňâéAŽ‘lVß_äpjµ—B{˘W㍞:ž+ú­˘’Ăş6źt)śa4’A[ÚĽ§i‡…ţĂłË6Mňř¶Ť…ěŚXŮ/I#ó©üÍ'k˙čŃ ×•ŕË\& i8Ö1řžh4Ď°”wđ<«2´ŘmĐRIEŕĎŤCňŰŽ3˛KňHţŽh±&Ć%ň–ÚpµI'Ih@ĹE9Q eĹÂ!:î>zjÍ>Ý„JśŢ÷4z+Żxň;­&łŞč~D˘_Ĺ<‹ÍR°ł^ţtÔ$fž§¨’ćŕ´WâÔĎß/ŚĹQÚb_čJŮĆ/Ź¬Ä r䤓LĘ UĐ •y~;Ř sU~r­»ŚNl˝• c*wđ„Çsđ‘(ëŇ#ĘQ‚WŞh®«ăć† ¦óő*‚ŠOŢőQHmčBMĺu‰s˘ű0‚öuSâ;J~e8ąô¨Ĺ‡†Ň#D#bä¬0r#·RCw‡E™Oż”‰J—voŐR[ýŞś[Qóo8$©*(ay·Ź!" ŹÚ®D¤˛…ĺíšJ}óŤÄÎżmEÂTŠDŔ‰Ohă~ŞDTć cQGb%#JzĐfÚ!ŹËzśŇ*ę•„ŃAjĐwCĂfO”üôzŘH¶Ź†WŚ7ˇŘU¦áě*×!ť4Á}ç4ÄEgR‘}DęCáçÁyľrcFsüOŕŹ„Ě÷đńŽ™Ă‘`HĐIz_.đ‰Tľ˛`,Pá˶U]>8ŤÚÇ‚oŮČâ˛9˝„qŠ”† %YoĹWç/6o‰’X>©ÇpĐű0Ç.şÁáv~^ŞĽţ»RN¨ĆÜCe¦<ă*µSą©,Ŕtö¬ÇŠ™WĹŤą+ÂÚ«K4¶”­ĺ?ß˝źŔV‹‰±Ę‹E"ÂIÚ3áÄ%&iCwš>G͆hŐ-^˘ś”,:kyÎjiZH‰CMý.çP%"HBăźiRHúmÂö{`ź>sôvB·QraQpYč”FĚ#ŠĹ-nTUUŚĚô6,m>|aĄćŹçżáq&Nołµ;ůőFDq†‘O9™‡1ź‹IďŇ»ĹĎ«EĆ;k{-Ń†Ô íő}}şşĄˇď™€§:ą/ŻZŔÁOoZ…îgżĎ­'B„˛ Ź|˘ő÷MŠ— JÖ´nj.ŻĽZ~ěú›7›€Öá‘-›J+>RÝX\;Ř;:ž‚űRYŇfŤ’˝¸Ş˛·ô;^ü—•fL@â6Üo+óĘ’©gXź»ěŘŕŇ9¶ŮQŹFFTdw1űMeţ´ŔlůÇÇđôࣛŇÜQ…žË\t_ 3vž '¶©Eš[PŰ÷§~QáL˘y h^žł^™ >‚xĘ aú°´2bq–Ţ"Ť§ym˙YR·Š©1Ţ~YlAYč¦GS鿌tŃjŕf`źĘdReŔŚ&V•«9Öˇ3”8vîgcDú’ŮłŚCëىv̬<ŻŘm¬yUƵş ˙ż‡f˘ŞµŞ<×őřŘüp€)‰®˝9â+ůR0ox~°k¸”±\Ä´Ď@ŔKY€»*˘I•kß•MśďżPż=©:Uô´ô¶_^~š7»šť!üj8\\Dmj‚Ĺq9ĐľĽLů1, î`U»ŃçlP˘3T©ô˝d~y–ń Ńëď?™î `ZľNéťáśđł¶Ao¬BNoyC i™-.Âťňa±ˇ×ů6­HhĄżµŘé'·|·Đ*ÜM—ßpş/~Bďß(a6î°ŹUŤ…¨9šó]j†ŢuĎâF'ńM`ďě‘Ňň`d¨F`oGQ~:já±#®łĘć×:â-|™jńDj=5¬7śXE„ëţÚ&)T>#â¨Ją[ć±ő'—ŻSjô°Vj)ł ˇŞ'˘”Ö§ý»uS[Ë_ľŢNÄ.fë†ţHÝBüČ7é'&]¬rěŁä®˙/IÜĽ! ÂôÓö Ô ŕ‹<ĚI¬ĆĽ5`j7çŻzK‡´©Eś&t±–ÄŁÄć­ĄĄz ô­kD”ĺ„ČĆ&¦Ü™RŃŔ:Ç?ů ­ ¬%R6‹·óüµ<3U¬gă&6ť»óR>‘_ €´Ć –=‹ř´w×ëm>Ňb‹Ż;ó™‹Ť$«é_WęŤIKGܲ»´>'R Ĺśzć·J_ef\8őÔZd+=‘†čł‡łżŽ„řĂ,jw74ó‹€|ŐăuN°ŰKúŽT%VŇŕaÚŠ›¦ ÜrרŷBëZͤ„,Ł<Ž×JDsÁ’ÓrK&í$'Łt U{?kĐ g jń9™y&JĆ;(Ęxťvˇ|˛`”·=°«l4Q·VŐ¨b& GVĆĆMÚ÷÷—4účĆáäÇÍINIL÷á.©8űkuŰŞëűhF˝ňúôóŢi‹+Ôw"sßPŽlP!ŽDE‘·ÝĽ8‹ęLlĄ”I_¸°Ś »•/0±Q1ŕÁ¨đdŞ©ÂÁ^MÖmRśóĄ_DxĆ_|ś÷mëѢ‹@ #,ü˝µdńzŠwŹ‹ ˛Hŕ˛.BRäĐY8 ăń"F†ŹČjm?9ĘŠŮ@_đ÷ÂďŮ!ĂwĹWIż=ŕÚ»k0,y˙5‘‰M3–Ŕ…”CÄtŃĂjčb„pPGcM?Ţçř”M»ą`Ăî÷­łw†Ű&ÇO”BůeyJú€™ç±,}p—PŮÓáîťhć˝N#ž9 ÄIc{mfÇ|ĘTßÝ×yéĆ—ŁJz+gľĐşź .;ÇĆEx) „ăqî)-SżěH{¶K‡m Ř€ŤąČ9×DäŐĆ4¦”¨MĄö[>ŢÝRVíôľřwn9bL‚Š‘ěnUZSďĆ<~.ÔÁWŢ’Ć& ŁÍ˛ rë-ţőĽ1šłX†0Źç>ř˝÷,ýÍŮŞčO ďEyőí—jüţ®—Q‘UŰę˙úH§.°ö)6żU¬ üÝktśýĎ»&&©Ľ-;†ălů-Ú| p˘;âŕĽÁcÂĹ7¤ürÁÇXIé˝éÍľ»2Ř–—Âfu.Ęk7FŘš·ŚíZ…żŮNtvçůéhěřp1ů`Có$ŤŰI8—hEëÄą§:ÚSŽ9zťÚś0gá•“qíąÔÁuۤosR:Ö€c‡˙ÓŰčP;pCnÁ“ OW–-]çś~żĐTÁá{¨ýçň”˘Ű®e˝|~W°ź,±_][zNß×4+;/8ˇśĚüşVśgEÜu"Řĺ6•Ók_"¦nlY ˛WvżýĘŃ„» ¨ŹWJ9Ü>ÚyŐp„“Wň|čl*¶wôe°^±ĘÍÓăűw>‹ę5Če›‰*“zŘ'\AČÖFńŽŠ źj-­}úýśżŻ:“D-+r{uŠl°;Ôł˙čöi–Ía­D¶d Áas*ú vtÝaď đńóxvjöJ ^ż¨yé[ÜPY÷ŐÄ3‡ésĹ=Â3ĎîĺpÍű‰ ĎÎ1‹0ĚHöŰq8G«6§nWš@Ňń4żďLp aUŽd—Üň(CŰÎŹćU]t((ó˶Q¤Aţňb$čY9Ň=G8›Ü^‡Ź&ü~OT÷±“×gü¸gfĆ’ éęO¸Ô sc.‰ÜÂ'{7`ĺFt< âBl˙NňŔťpÎjĽ˝ÂŢç]‡bȤrÓá3©źjŕ* ˝[—FĚL҆oX%ĆŢ‘łU7€g–©—.N¸Ç“gĘ”h‹}Úĺ\Ă5Iĺa¶i<.„Í˙ýMŕŐĄ®ÜaEۇ†wŘÇĘá­ÖĐ•m2pß!:‹.čsŢ9Ë‘ĺ©Řâ°Ül,\|)”ęů Ëú:cŕ››úäŇť®EČ°7jż9k[eű:1±žšő#ťÇŽĹęGßľ0ŕSçPr$YlK·«!K°U«ÍwnćŘşió[jŰ(wořúđ ‚=ć<.A/ď´ţMąâáłX{¶ąë«\y1ăő·PĂD¦«ŞęÄ4”*ýF-…4Ŕ9Ő˝0ăE×ďQâęO̧ž¸%[ďqWžNSĘŞŕ¨HbÂřźYjă˝Ţ>Zşb=Żä–Ăéčg5{o[1f±Q0É> -ş¶ľ&ĺ7<ŕD¨đ:F$“ˇUŇ6©§°ýÂÜVΓŁÚîS•3µÚCŚÄr(†Őíľ†$mĆ»+Ŕa(ů-ŢÔ­xá6oŢ5°çéëQ8oô°y:iCţZ›tOr{<đ\śÉĽ°źXV©Z’QĺŇr¨w·D°¶Ţc@TxF†p2;§ëdŚ ˛âE‹Ć¦|źŃsKDÂĐ g†“šK*gŻŔÎŞQDPőä[Ě~É 'x*ŔšJ0ěˇ 0!(‹äň“ ™b­ţ¸ćh^…®uřJKÄ{J*j3”žááHśÝÝ(ŘŢ đ}ġ3­SĂŚe7śtLĎ 5‹®vŹ6\ň «ß±o«ŹJI¦ßz?!Ň3Ő"w7‰nW‚w'ŮX`“iĚťpÚÄwî4r” zŻTŇ­XiHxuBaÎ'_ ă§¦śűwŮŘ,EŻćÍQ×nîP'­&X‚°?a™üg©n¸ÝĆ7 €lGČą*ザX<ą02Ř«Ľĺ븶÷HA+w_đ9\”=OâMö‚= &ÁĂx3É´ŕEqÍěv—†ómކ2¨˙Ża‹ú€ş)†ŕĚčsX0k’ř‡î˝¬Ě §‰®˘MŞŔǶgĘç˝ĹEâ9ÍúMDwŃlľO¸™’´Ć+Zv™¬–t\ #ťb<˙Ž`˝±ÖĚ÷[ +‚ٸ"Ω¦9}–üi(”Ę7Ä—´ ŃÔ^ZĂ%3= k'ŮBü΋ńlw˙{Łîx‰c|”*ťČÝŹŐ ű{‰jŚ ËOČŞî`逕=ÔöĄÍşHż˝0*î¤,w›ňůJ‰™‚Ô[DşŔŐłşm)ăgíÍÂć›q´cn!cx‘B1Ă#ÂB]¨Ŕ9žPşŰ„¬˙]ĎS˛5űfçc0JwÁ§™^MkÚÖíĽ˛^‹ř“uAnŇy CÓsĚÚü¨ąÁRrą9bŞLN©ř,:ź„OŁvcűĂíz$RéLř˘×2dC …ş3`ë謣ç¶4ďVz¶ĚZ ÷Ľ7D  oÉ]E曊dĽÓ ëőŃaĎ{}ŽĂü§Č~÷€qÓ[Ôzmjr8đZa—¤¸e„h¨·/¶N|_­łä1ĺ"őif—pć)®e}ŹŇ˙čŐTäŕ(c CLă(˝Żîô@Jž%EĘ4‹]—FPçĚo§řĽ•6Ăřv :Ď•ă ´Ő'kŠ+\ÖVűYú ­°„H«żÝWQ›čš9xǵŁü^Q§‘§önq| t¶9Yć@·Ó®ŢŮŁÂ 98źłąaÝë?S)C˛Z`ĺÓ9j"9T›Âúë ł!´©V—7ť´‘•—GrčLpŕM’•©BĂsÔrËůŁS†”Úńbs ŻB_şŰ#u%ÓŁ˛Ť}NµWŹ'gĄuě˝D:JeiŔ‰“{ţ¸8žçµeâËq1s[›xBߌđ í‘öeKoéäb×ţŠí­+|7lü>Ň3uWť¦Ú%ťß¨IQ«Y˙LI›'»dţ¬ Š­aĄAçďĎŠ% xÓR…{]Ž‰*…9kżômP%_[‘€!ł¶‚o%ě‚z D)e~ă0ü(h!ô8ůAź%—‹Çj†0Š#ĹüńFţŐµDcŞ‘Č™d‰ĂGł%ŠĹŽZ1|Ç[#ŇCĎTNhylČ˙k›ä¨çHßß)ú×ŕŘÂT 4^µŃ_HOÂδé)sdJ‹­G±ضőÔySŻě'‚×SŻ(+°˝ď‹´.J‡$Ňş­ «ţ€f[źÚ¦Ń†ŽQÉűŞ`—XŃËcŽ×:±Ă‹äSđ8w;Ľ]i‰`§gľ Ó‚:5IĽż‡ÝćÁ©Ď÷®] :Ô»úámÍë|Íwßő <Î5˝e##ŔOb‚"V şÇ´­–eĹěP¤f»a1ĄŁĎŘ*1쵕 źu1رŤĂcŤ­Úç˙‘G#O‹ĽĚřĂđłb[ ď«u.ęéëĹ8á‚ĚĐI3€Ç#^ß!„ĽŽýÂđ(>ÄZćPŢP Ó?ü8µ!Â:Ő4݇ăéů_Ň<ŞOůŰŰmkgÜţŕ|"‚v(™8--~B…»żé^Ví.‰xČ®Ŕߌň19Q^ÜdŤŇ·>Â3˛s+őř1L˝A©$iťˇ}b‘€~=‘e›ťËŕyµýßMKüg1•JIđY s~ÍĄa'?2ĎIÄx ß:Ç5Z¶Y/fŻŚ@Ţż:3E$sŐ¸ łŻ C ň$1'=9GWč@\7¶^‡Aş¸Ë2ëyĆş˘_"pý›sŕîo«("rvM6&0<]\üďAűąQ•č˝AtPƨĆ=š±ĄŠŚF–ű3QWŚ!pűí Ĺ8h§R°”Ľ±rz1BiÉŃ”Ě˙ęŚý#AĹăß®¸Ă¶ôjk‘:¨ę{4íT'kJ‰ť?X8YŻłŇ{rPSj¨,±ż„4ňfú aŮ»Q‚^_@ľo:)ifY{ÖÇŕ8üéýÜJ&2”yč¬cČ7Éë2wŔ`bÎĺ­4ľvéR™F­}Î1y¤VŘŢP_4ßĆ{Z‹TfŚľNu~%H6ď·°1;UČÖľŕŕjyŔŔµňů¦ü(-ňë÷1Wň‚Ć ňNě ?üÔ ô¨ćˇ  .OŇ<ŢX^ęËŕRTh±űďµ aPăŢĘŠ7‹[ńÇ/ö«˝žŞZR[đŔŞîµÔÖfFgÂŕ?·RľĆ)Bzň€çöŇ…Ł(đG„‰Ű6täá¨đš˛¨!ý’•°Ĺ2ň!FŃt5ďÄNN¶ŠdT˙+Ýđ¶.Ónŕ‹¨ô®ĐŹĚÉ.“”Ććěn™ĹéÂD}‚딼˙jĚ×0cŽ™¦ß“b¦ę˙ŁÚ®‡hToMá:Ř’5réáöÔ5|íĺĆϻյuc±©™ĂęÎE4ô ă±2ţądŁ–4eýÁLÖSny3ľ°“˝ËÂŞ˘&÷üä{ćé†#şÜó^w¦v˛ÔÜůä+§ž˙ľp&ůÇÔř§× Öpf`˘÷őě˘ůLů—Kťř'I»á›.Yłońëú9%î® ů·<Ó}Š TăŰ®˛Ë _–v-Uöż ŐberAßŃ膧żą¤cy ŽěH‘Ő›ËĘŽ·TÓŔ!9:gú˘Ďeˇ˘öó˙ă%„Z™:A’Ć!®â^„dŇ…?`᎔ąK=eĐ€ŮeěÜ=\`ĄqËŮ…„Ö ÔmńRÚÝJâ´@ńěwEţŃbLLéH@’s âIśj˛UătOw9ĆřŽ<»âŃě˛F–Â-Ůąń‘WJ‘E™SâßťšsťŹů0ŽT}ęSŔVÉwj®%Ô02˛RÜ ° ł¨ÓŽć !Č;S§‚ZŇŠ€'ťŔâI“5^oÚŹz—°rŞŢśw[—ĘZéZ˘{ĆĐżăĂÍřR Š ňSĎЬ»…´ĎĹÔĆNCółÖZS"2Sźí}‰śşŃłŕÍ…łž˘çSd{€^VźÄ»S]Ŕ$ţ™đćü”ŃfĚ8.O-jd†Äg4e´’ép–ś"”.ÁbsdĂ[rŞ·v’&Śl‰I(ó<îúÂ75E Dč±´˘ĚuÉ9u%żďÇíQ  ¦^ü&;0ĺܬˇzµz/J·ňŻěX$w:;ipÔĘšĽŕŰvŽ=6hąŃ(f %$T#÷BŠm˛tNé°'‰hţÁK“¦¬DFĐś'])<đ_ÝŇ4|tŇh†~0ý9ůÜ RAä=¶€ľ¤¦™ĺuĄ~˝\Č•đŚ'R—ŞP@J‚ş…+9H]CSÁzMŚşÁ_Ź‹ľO\Íăuˇ{éIúű=@†7°R1t\ĂÖaţőó.N«ÄjÁĎW<ţF:Ě©áaămʢŚŮJ„®…ÂĘ7ăڛ۰hJľHó;*ţˇ}m41CÓ}ý/żÂWŚO¦$jč®1:ń@G.P?Ż[j¬wWh®tÜ—.\¶u¬wŕr®* |Ň-Ô^Ł@·#ŘţçĐkˇ Č|ŕ¦q21¶Ŕźólž uŁŽęSĹńnđÔ»ó ~Ëos›ôpĚç„üČí˘żĽâUR’áĺF!1ú±€ăĽWr%ů€Ršt,&łI‹Üwń†ŠŔ({‚ś‹ngᓉC¶D…sşmâŚUWU4tś:wq5‡ąî4Dě{((3L{’ő¸Ő;ĎŃ(±ËH 6sÍÝp;ô l ˝¦+ŤU4PČŃý8đŇ+f…Vŕ”–UE(ő?O˝[DŢ>a„ž¨WĚüÎ9(šč—EôťrV“'¦l»4٤jć#CI¤Ščhą°’Ę™ë-ß3(ŁŻD†ź)ó5bl"¸ˇďmqZš}]śľ ĺÂĂš!¸jQ?¤ĽžÓcµˇh9¤bÇŹ+ÚYsGűIęgŚéýűwËZ¬Á Ř jĆ \N˛b'yžvô2%‹ö Ŕpź KĄűČ•E•žÂ¦l’ť1Ę0le-rtWš ˘?#˝ŽßĆ•Ä<ظÜđ,@ŽIb‰Ł©¶đţÖoş˙ŐćxÄťÖ:ţőĂÜ˝x9`C„9#“brl€ü“EË>äXÎfâ(E¶B3uPwÖ¸ŕcă#˘ddCÁ]ÜÍu€nBT1×:¶žs“ť‡Ľ¸KÖ‚‹í…˛5ď-AQşŞ$¸)BlI-|:oIŰ;29ŻCňVäĹŚëoHá8nEů+¨şíQ ý.ˇN›0ĚĘ……"Í9JT%=ćse‡ÉűF$ĺ‘üŠ©.Ň.9ąÖÖ7‡7¦žÝ˛w7ëçőE×ęJ5âHŃ…ąšą¸ÁŁreôٶKÚ„76ąNú¸3!ĚRyüQăňZâĂkóžÝ-©Ł¶b(%}Z~q;™}\rő!ceeÄřoĄfŰhëŽněü;RTËÄĹ,T?®8øýĂč/˙´ŻD&ěJKÂVoÄřŹM«ä¤Ň0ďź­gť›0SÇ3wZ‚č‰ŕ6ĂS2ŇtâBäŕJćő‚€*”}q:Vö˙#6Y‡*ß{˝·˘4¸Ěx×ÓÄ5×á÷Ź‡·.(kbęféČaź§˙‘îý3°Aö3ńÜ\ Dŕ+gÓă śűmüą’oĆÔ`]ÍäT¸ ˛¬ź˘ŹŁ3Á_ XĘpn?Ł”;ł&ńů]7JŁv"ě·„˛ŕV&ÉZţşŚŔ‹:uĎóeď–¨2™ÜMŢŮőq˘DE;+öΆ=˘Ľ†Źűgqł®őö5TŠ©Ś·šľdéŮ$5~»R[ Áf˛2€yz…±ÍW†Ś{ťgÚÄ7Őxž“ŽÁ×Çą"SubËŃץŰB´j#÷Q’ÁICD6ą:o±!bŃ'‘÷Jn 4Ă;h?˛ľÓyůrúíXwtaöďH ™tŤ+ q•i÷E•|‡+©=cž’l:iŽĐëT6äÎŮHĆÝÍ›oZL™/:n¤dkB@ᎱŽuČ‹‡ĽJË÷`ľíý5şbîśő[űŹóf˘dNm"źžň^GŔWÝÝ1ŹŔľwŢn‹łÚ«.Ş_ćRüŰ…ÔŇ–Ąí÷ !Îs°Ĺ7ŐuPžBą5 \°dgŁ ‘ŕëׄάa·KY:F–l÷qÓ¬`á˝î{ÇDYR·›âId%ń;·¶@"Ś±`z©vĂjŰ ¬Ü‹$D­\qapKç´ç ;-c7ÚCq5ű·¤łĺ0˝µ˘•NňŢěp©÷Ž~*eůĆŹK*YŔäG×n`ĺp]¨đ˛(ňˇđüĘ ŔšT€ĽÇúË FWčK%ĺżążą®­O&¦FtéČ’ŐŠž˛÷|[{Rű¤°1„ß#ŐvߣěcZŰ(Ž=ÎxRŽ)'~:J{9Đ˙+‚ýU‚'RPŰ)T‚¶‘†ĐÁ…é@„‚YOVšuŰRżaĘÔ­#ţxâşŮŚ*Đ«X‹źPśvă*žâv0I ?,iMŹđm•ăógbî·i ĽgĎÉű¸-t=›Ó:´ŚZE˙1%"×#†®±(_˘YÜĺŮ÷±ëô|<™-)řh†sŽHťłď3łÖť‹@ŕ 3¬®ëÓřž•‚qa.KµrčµTu!)!śżGmáKÉħ䑄ëüR·ŰăKTv; ±w2‹ĺy˙J3ň× GäĎ\G–‰ď1iN0Â`]7us¬/«¤ůK1‡±@“ľ© =LCV+őŰiI€‘ţB­n|˙™ďČŞ)Ć|2˛{Î\>,3ĽŚwůýµ˛86sQ%ú›Áđ5™X·(näń;[f¨:¨=ŔC’{ezíBFŽŞW×WĄ"Mj ~uW›©Ňü¸ŻŤáŹBÔ7#yµâîâó˘LČ‘ ×:$iČĐ+†ůŔĄ_rWZSL`lĹ3pi Ý–śgGaĆś0YPéóÂ&ׂr©fĺojŞGáPhŁŐ˘K«ńâf-e@;Yj¤Oý͇%îăp45ÁňŽyB6Aş¶›Ą«€†ł<#čždA#yyŚ3„˛ä"ľ+KĐů»Gcäóp±ĐÁmv’Ŕ..RrWŔČ?(ˇá^´nyŠ0ýŞcÝÁeÎŕŃYôŹlqró9%NZ…zVîńrŁx× {Oekżžĺ&čĹŢEvSţz>RţŐôyŔs8~)ěĂY^v+‡H,ˇ-žfŘaoa6<^]¦c9]2iĎłé|rÎ×+Vç°Ř5ÉîŘŹn­Ź ÓDGlä©< ¦»Ť ­y*ţaĽ~©JlĐAó/ܬĆ1äűąî»BI_ĄĹQlj€mdććżA8ŚžLČYő¶Ľy‡[`W`•CˇŹďQŐĺ,Ú1źY`aDiŔ·GTxČĚś4¸ŞĐSűW¤ §˘QŇĎŠŐ70„€ W—¦Ús@ Îă›8Ş1(ćáCëOúŘ|_™Mą Ct0x]±Ŕ’MŐ:ףokíş/Awg'qŻÔóÉŁŚńč iřş$ i|Ę]©dĚ)Y!·-âČś“¬ă Äî:şEÔŇpµf*ía=ç µÚÂl:VúćvµŚtýŢŃ.užđýΫ§)@LÓ}ÖŞ.Á«L7őăňĹĽ¸–ę~Ďd‚oĚMdĂŞEi¸+łZP¸l™ů ޢ¦˛ďěř„aÜtn0ŕsĆŠWÁĽřÜ•yoű«˙˙cÁŔĺYs×is˙ââ1ţ—1íŘŁ8= Ľô ¨˝ě¶›5«Č—m ž`ŻÉuç‹A“ĺEi©1â`qÉdaцöűOłĂk€Ľ đ.`é5eé&©ě+–v,JCŕáE0SůäŕŃ“O&«_ŠźŠYŕ+¶`­&ťXŇ)Ńue{lˇ»Ä÷´q|ęîň ű ”aTĹU<Ôś%ąxĐ„÷´˘€/ň-$ů»›5Ćá2Tů §Y.sô{BĽĄ/–Dô׬·{É• { 0čÎIŻ)Ŕm»çŢŘýTš)Ž•\Ub“ŰěÖ++ť±éuGŤd‡Ů€>Ą°ď0® ţŠ#¤×µ9ŕ:Şý@Ć6Me řJĄł™<ŐŇň°ŕj¸ťa·ď$vë.ˇRökÍ d…® &¸ ;× @ü 0ő±PL<­® Lë_™aÇÔaľa»~ÉK¸Ń„GÔíä—¦č gJGżI}ŃoX¤˙GHí6•düĐ;tő™0:-ÝćW:Žźź‚UĺM“®H+éq©„«‰Z†’5öW»Ń…ZI‘ĽěŮr[JŐŔŚŮZĚ×üŠ×˘§Î†Ňő »‰ZNů„Ý.Ój¨‚^·Ż"‚xąÇ·zÁ\««PÓX±Y~«űň˛i¤čjO—Ąýä— “ JmÉ%.CĘż4śČ'ćYfŔcn+WB|sîüýĹIĄ÷]˛ŘĂĽ‚ú*ąOťÍ)Ů!űŚ6ţ3Óiůů¦Cy˘J ‹“ep$Ĺ9şqި~ęDĆę°Íh»jüĆŤ2Ěš:őĎĂ•2S¨Gé2KN•V ¦ŃľŐtĂęlç„0Ú°@ÍŮ +šf§­Á‚G‘‰Ö©ZrVÂ,f€{ů%íqÂX—{RŃß™ä<Ň ý”–wůZÇĚünôľ;˛:ŮTî°¨·n%ߊę5Dnm 9Żď9áf„ ž˙5 ţa‘(†}ćX ş7¤4µőĐÚ¸oúq1_şq•íëżtžă,N¶–ÔjLÚ$đ‚†4ß»O™™·ÄC !±ÇíÁ/đ[Ľ›á÷N’é™üüΤ áY¸AĺĘ.:·2{©°ę›G¤uŠg8ŰOä‚őë»{$Ç–·±(ßBî<;tX-‘…ŐŚ’%媰KÉ2FČř—eľ›9•w=¤"śí_7Yž<ť -Ý_´Aż2=łÁÁjjt‡VÖńj&yDŹâmjŔ‰LcI*ŠąJ©—DꧼőŻ÷.'ü C‰čÉFé؇MŠxT(ę Áă+ ś µ­»T± ţ‡‰ő7ľ|jשŃVĚŻGÂűO ®­lŠßľÝ7!H0ŰPłý)ˇP?˛ť%NtĘ"ňe°Cďóńˇ Ýčđ>ůńm ¬ł1Őř´ü^ e# =ű+gzGp%WRwŇ~O7Ô1U¶ËżyŰťµş9­¦CÓ’ó©†= űľ«°FnO/ʧ‘—MŃ[%gŢŔš×Ó .izć{0ĄiµŃĎíz r•‡÷ş§]*: Ę ÚŹRőÖÓ-Ů,KÚŞÇĎ… …7gŤ[ą<­ś_3aÁíş“Zďău-¤¸ę;E¤’hý/~=qî$Ď 2Ô»E ]ß<Ů[÷FČP?zÝ~rýĘAŮ‘őĂV:Ę|x_„Éěţ„'ŃŕoPauجbéjóg¤· ˙ŽÇ•J‘VŃD0yĚ˙c™_ęŻp3‘x­pM@—i(ň<0¸%§­O°Ž(2.)tÇş…ŤöŔ±ČCUÓ|˝Ě˘Rlăb',ĚzAÂi•ŃôÖcřC'kÔ”Ͳ9)Żč˘éű=O{§ÇŮŤxblŕĽO 15¬A9ýó ‰«*žőő€Ů,ňZbçahÎc†X˘č¶ťNńEťX€/«RF°h1P„ú8ëWS©ł´Ú‚=˙f˙r]Q¶ÍÄ6]ĹU†Ř4á·K;hBxĎUĘż*m%°ÉŃFô˝eúÓ)Niú˛üá«Âó‡*\•™ö8oŠ<ÖťńŐÜ<  ˇLÓ#§0v˘ńw­‡Í ‚WÚl‡Ą8`EXI |E]QwTźUg*¤ÂŇÉ^N&üŢÇvZ ‰ 9—gĹË.ŕń@`BвDş‘5¶ĎÚ+hС…XóěXgů€’<â! *rmőŻłS°™= oN™Ľ‰vűŹxČŕ˘Zo˝őŔÂ]{¨$NçyJuř¶ç—ç'­o»ő|c4Bv Io!”ćěźeLĄIQWć1?­m(żźŠt·lEŠ*XmbűĺpÂéëŻxçěf[Z[ěě žď¸=‚MŔ}¶/D_$Ř÷(濉ŰÚ.ĎIĂΑµ¦cxĂA>SX.ÍČmĚ*3Ę{IŔ[”ÜE ěÜçl<ą|2ţ'ŘqZŢŘ“¬Ä\IhÁ×2ˇgýKFß±í^gdŐMľóË´ŢQé#kŃ@HáiI›+nDNş˛–š#ÄT„ŁGp •×wă™DY­śµg*˘§ťŠͦ+lť0ťśÝčg‹,ÇÍę˘Ň‹™U€ÔŃ”R-]5ä?~¤«3ÍĺÖg>?ďĂb6řŇ1ţçjŁ»˛ŢϤőyQJš ŞägčŁęuž˛śč„ŔZŮĆI§CbWâŔYež2Éu$¸ÉMFšŽx‘ô°PţĂ@Y0%@CZ6?ŔM(9gž»ZA!7šĎÔ:Ú%[Ĺä1EĂNžt2këa/ť>kE_Đ ZĂMýwřFS]Ŕî÷áT—Ř’xś2—k§ Mm~Č=őśyw:os”ŕß–X+%&ŢŕŃrů|ą“‹˝4fí'YýÔ uŻ“q™'‘ÉLwµ„Ű“‰ĘŐ6“_đFň9Ćé;´‚†¦‚ZÓ«€A—·0U]jć4L+7ęć8ŻČ็j‰=°±K°=–hhČkŰŔgNĆlk°7X/ËxKfcÖ›˘šÇRˇ‘ąAV¶řÍbüBItůĆpyĆľľtÍiČď(/§ÓĘ%' Î <ÝÓôy—&M¶#:´×¸ ŚŮÜŞÄgümo©ßhá]a ¸cŔd‘@›ćy¸T•`Ë6Ľ.±‚3FNk˝ Ĺ]˛b\Íş1żÉůî/Š]†ťŕn.Zäřě¸Äö0cÝc}EuƸ›i=Ż×2X&CúßUÂŤ·\0+Á¸äphŃ*˝¬j•‰š?w·HŃ Bmčř ĄôŹ%SŽÍĹ5>~¨;í~zŮMřH˝#/Ó6čZş‡śĂÁńˇń‘Ż »Ěp@-  ëodŕşs)Hś†·§® /‡čyŁťJťŻ•Ú÷ożľEźüV_Í‘ŇŢHsh~fô5ç|Đý”“˝Š_ĆËĂËFxŘŹ¬ő( ­K çKŐ*‡×N.ůÉŕ÷c¸ ± ”…}b)wß4|CGM8v5č~ơÚkËq`–Ňř2L}~_ŮR¬(Űe’U蚣—Çžvđj– G†­33Ý-g†ćgËE2÷6‹¶ö ś{M¦â¶¦ü# Ńž’Ƶp÷Uv”ĎĐÖÖ?źüŻÔŔ&] ZSů‰Ű2ßł®€‰rř%}ZÔ ź‰-tšÍ˘8=Hý3L™ćµś˘©ŃáůÔ1‘ěŕd8ä“Ťć*ÄS‹Yw˛‰°űŞ”â—(U4ä}-ô2É^C˛¦ć·š6†šř,Óĺ\Wt?Jeö˛ |@{řAÔçGHI’č IÇí“!^ÖťĹbúŽCńúJĆ˝°ŔÇJ5°•ćg˛aĽ…í/µ_®ţśĆŠJň<Ć\4űťľ{_ljä}Ň,=75HötÝ!ÉŻ.ůH˛öđµüN]W.?ĺ ŹR°Ě¦ŕ,i|›CëE‹véŰë¬ćńśfü®#vSőÉ % 0ÝŘŚ‹®˘ťwÓ°gĆPŃčű¶mo&Dt•Ëd)ħQÉIôj^ú8¸ÚNČSaědú ˇbÓ,¸rőß…Y¦±ż%~`ĺ@yČZŠÍ;?;“Ýň'ÓĹó}[´¶ËN)¤%żqł¬*ŇŹÔ¶î÷­žZ°řöřěÓ<š~)fôZy`X¬f±űĚN{kCŐ$o˙T¨PÚ¤\?!˝ĺUľ[pyŁ§·ťx[mŤ´ď-b#´ŘpTXĆxf[ŞÁß9ąË‹ŮzĂún„źkďţůN?ë˘ÓTĂŠ2ś?÷/ÍQ4úýĚ2€:Eź´ĺčF;§™î»r=Ëĺn&!ÎüĄ|Ř{>8‰źó¨=Ë·fëR袻Čĺﶳ‚9P˛ŢÖĹ ±ďAĺĆ­—mý^YP†§ k¤ń'.BŘ@ź[#>yéčŃkä7Ł]îÖw¨p†O¦fÖ"}&b$N"tb†ő•±·×–Ŕ˙á¦ęMyŰ[’ŞĆ6*fďQ9 ‘@t4ä[ŃźŕU2Ľ÷ľ…±ĄÁŹý Ţ‹D9úCPrĺťą¸n];©Ç4P4üBYMčHł?¤u)JOlaČšŚ©˘ jFE`ä#ż—ćŠÁXĘł=ŕ٨q L† ”e-S(˛ďnÝ*Ë&w--p~´ÂÍyŠú*ߣöúvä5 ˘së4Vkô˝ýÝô§€eŞ~u80uO!łú‰Î%Ę‘őŔË<ľcJ"~(‹> ×ĘÖ.'¬´uĚě@±·82”w¤ZL! k&ŹčOĹE©=Ű +Â/¤Ĺ*d'çčFď+ż?¨Ňšť|]µĽA5}vż÷;Mßâ©äSk1MŚ˘ ´xd§§&µr§K¦VŐŹtŢš5K7aáľ*öÜvźOÓĶyŚM˝ť®ţ®ÉŢ“˙-_,_÷7 6N?:(ąA52^¬t˙c#߳Р^l}Ö%ôgűžDš¸ŰsäĽ=%x`ÁDl–”ˡLĹ(ţýÎŤˇP_”Z[ ý„ŐźwâV2‡ňRqo„ů©dÇ«ŐĽ˛§%9Ë|ˇ¤ö¸Bzwm¶˘˘wőů ÖĆ™C–Ź˙íăú®WѤh ů“,"–Úv‚€ÂsĂ­}M̢Ŕ)„ Ľu| n6–I‘°öü”‡RőľHD2*ŤeĆ•ä:ćrU_7ďČҔӬőçjk]|,§ÍÝGű:Ž>XM»»Gć‚Qšęęe[łDÉkŐ;„¨ma™ťţÄWc?Â%P3ë E0«ý]ť@[ &~PŮ< ał;ls8ŇV›ŔÂî:ŢČ@ĆđĄłd‰µţ·Â«BJ¸ćXí_˛Ç(S%Í*9®qKŹÝëäd¸ ×—f¶lů^ÇÍ­ĂŰĂô:˝"ťěM¶‰]Ä;ČrŚu?.;X5í$Ŕ‰ ”ńťŻĆ´TBe…aײă‰ä­ ź†Ű=»řřL‰rinnC@Áq^Ç€bž[KrŘ…¸¶Kű->$ĚUúůĆ&ŮĽéyćGq{Xio‹)Íř­[őm*w”·ô8SŠţ|}7´Vľ…(‰3n‚9±DŰę >ąEšý˙[„«q˙Ĺ:Nr9lKŕÍ3ňŔ¤t ńc82}Gôؤ¨ŞÜpSŁ”bS†ťÇYšpö"Ä(©™xqzĂznšSLÇŔć‚i× ďFŮtJ9ë°w2:–=ąé’RŠŹ6H ¦Ń+ć…Q¤MMů;É‹ąI(ófp!P˝× 5@á’Ř |¸B{1.‚pđpTř×Č{„wAĄMrµ‡V…h%ńŔ Ęć0uE­^Ťy €¤¶ńvIˇGU‡=ű÷KŃjGâoé4,»¤‘H*‰_nŐ™¶Č‰6kA›s‹áľm×Ig\"ř±!Ç)‰>fŽ]»Ç©/§9§‚ءL <«$~»GŠzDű‹wťíŠ €;ý˘ĎťL(%ĎŕżMV±ů~éö­ů)uŞpéILkbă㡒đnO"ŁzŃRÉłşA9iÉU‡Łpmżfy‘×’Oß‹§éÎkĚcŞEŮ_°@ŢaGÍpI3YU¬ůĄ`{ í”ýs©?…QN«^äÜŢż~„ýť:˛KŁ;Ů,J“—%Ř ˙Ěת¸ýQäoô‡ńˇŕĺ >oô]á‰ÎŮCC¨L㺼Ś®!\~ľę .<Č—OĘĘšË}ÜACşŢ4qJ’OŕOdź˝źĂÚ{1Ďč3m*š·ŞŃÄŢšĺd„—/´•*ë)FĘÍ_hŃZíě$š—ßG°ĆŮ{˛éŤ=fń{ Ť«Ž™GöP…ŰT`­Ž¶ý €˝l—:Ű©…őĂEźwŻNĐ ąCÇn¤ˇęLŞZŞđy›ü[ô¨×šăĹx,oŕXU7~šĂý–+E+ K‰vW Gp ű"äŇѻșó–±?"‹v÷ Ď>eĹK.O(~‹ˇâU]Äůć¶1Uĺö•áí¬śË›Řó¶ú—ý5¨Íu‘YÜč×ÂĄTłĘ˝Ăr{Ró=d.1¬r=XÖĐ`*ť‰+弣QTűŤfWw‹÷ŘkGwü¦]—¬¦¤í‹eŢ·{ů o…XeÄŹµˇUÂEę,_ź "(w{ťĚ‚)„W˛&™±ŤNí€+ű¸ I !;[x7żĚLç ÜĄí7řHp7S˙>h@R˛©séC¦‡ťSÂqÖiÓ{˝őâpĄgˇ–o^"|@·÷\<Ď©ôîŔŔXŠnÔ#ăďrâ¦Ţd´Ó•ô§Çg,o¸8ů„žť@†’jâť’EZ Ůăľ”v ŮWp,…Žµî5urˇj̉›áĹŃmíö"LŤĚőÖ"Bo;6˝_vmşő˙óWmôJ¤qÜą;Ňﱿ^ö„j–é‚…Ť…NQĐßđg^–6~ ř†>lióßcTV 37Âůă¬ŕżR “řÉA–Fđ¬9Ä©ś=»´ě„˛Â2íŤÔ H§¤"¶ů˙„nźűĘŹČđ%^—ŇěK|Źz7ęĽýÁ.%KĚ[ÔĆÚmC„Ső2?xÚJç;N#Ë^7šĺÍü:«â¬)ľĄˇ†”‚#¬§JŽžźwö·—Şuśµ9.EúY¨‹úm˘Ś –”PĽĎ芙ęĎfRź8;˙S €ŹKéąňdĽpqĆçÇN]‘áŕN…÷`Ž{źé«ˇD‹mz‚Éré[î8Ýĺ™mŤ]“żFH2·g(6†Y=ŹíČő÷WÚĐ°Cxš Á«,>üŻíhˇë2ůůŃŕb­łľő8ÝőĽ‹ Á(]á‹—-sę…¶µ±TbŮ*(PV¨ý#÷ĺ<÷s,o2Uź’=fn»pŇ©6¤1€\ŹË/ËśĽĹŃ×7űu', 3¶SódJI‘lŚ Ş/˝_ŮźÔżE€MtâT~‚"- †6Â[źjJĘ€,ů‹¤Çr˙<ő ×U,7‰9mˇ=ž§ ÷ş@n‡J¶>|*™_%•żÍ$.gNÉÍŻÓ~ďcÄiJŰYlq‹—ĺ>^#»ćSP LůÄęŃS§ď/ę­K¦˙ťeę0!?(0ą́TU‘]ƶĽ– ţ1ÚŠi§¤1ʨň{Żđ¤(š9ňn^˝÷€6Cŕ{—w A«»´$ÖUL<É=ÝÉO¤™Ź©tţÇŚQ}p6>SLmâç pÁMuó´TǬ)»ţ»ĆŔĚň`ŁFOj  Ĭ2 ^u,0u-ĽOv@ÚJ콎1D‡©N2©8}Ż˝ĺʇ§„śUŐŘO(˙Z•[ź@8†|Şö•stąń,Ňpf$pT¸á iEKÁ=Źaż$W6'ă“q˛ žçÚ˙)] /×Äż—ˇź~B[ą–oJD;{ożLą@@±ÉčˇĺÄ=›MIjpĽâ™Á»3Îł7™ß±«ÖR˛˝‚®ö"lôÁ9«óëÄEŔ‚l®oŞv› &˛^Í(Ö«ÁŁů‡)Ť’ÄěÖ?řßôzg(ą„ Ň/ŕSb?»˙tŕîmôŞ™ô†#¦ţ¬Y}'ä:”P‘’U^WsĹ"ĆăüMJíśů¶˛şü®VúćsÎrpS<ź#TúˇB’5އ@ëfŰC°|Ż×Y°I礹Q¨Gę6ĺbŻJ+^ń•†$çWfěąS¨Ćź?ŮbšľˇŕţIÉ&»VďÄÁĐyĘ‚ŹĄź…&Ƶvţ‘™Cä §Ż{hGź;˛Ö[ęóŠŕS u70Ă16šK§°ĚXN×Ă×ůK«*^°Á‹dbÜ^Il¦>HüM'ĆÖ߯C<Ţţ,ůíÔĂîÍóĐ î’űĆ}ç*¶9!J'N6J~uăł–vJ•m°ŞyÂîP#© Bęm?ma©’ÍűľMę]#WW˙Půz8Ż¸‘ß1âź÷U’~µ‰g(38ŐË˝ň°"ë^ BIłl%=3NŽűWł Ž$4±p ×*»VćşęvjçOv^Ŕ‡´ďč h¨`úI¤CŃͱ~r~wKͶÍs{s™ßűĘkˇ/6rb–™C ö’®ť_cNůÎő4ÎÔ< YÜPѤ[Ű?-bÁÔ™„ˇů§ěžlçÉŹgčƙǖpP*9ęR‘ –đŹMź±pĚťuĂ/`Ý»źá[ę3W*üń™Q`ŚDŃ4őż°Ç&ě˝ţ^cPŹ˛°üčŠTäače䡝şîK…ckříö¸™ěűľ…M˙ŁF˙ŠjöČs¶5 y>@‚ ŠúeVŤ*yóˇAŮFÇ)ŚĆ=q-?\ŐE€ńy@Y]|\Ó˝tO%Ż“ĂLJîË0?·_ÔęhŞ($J.¸îŚ˛ľé‘Cv ÚľÉ|›‘Á—ĹÎÚí®„$Ô._ç>ĄAIɱ­E$*vřyß–ŠńF¤˙Ö¤« Őť&Ź›1é\”§KŮaűÁVĹ‚ó'ŚŰßłĚďĆ·ş„@bŃ"6‘Ť”–,ť˙U^7[ă`mL­Ą_ ňoúE%~Ö_‰îU]Ź&Ş+­QîÔ®ß*IúŇ[?^Ő'«ôLC›1H€ťÇܵ±YÎkÝ@é뢴˝%rMRTȨ–®+`ZŤĆâŃ čA`|SnWŻwţ›őÜĂÄ÷óLŕZTg—ö(ČŽŘbhw26&4׼ü©7·™†)PU2D‹íMîéÔ¦Ýó¬Śi–úVŚfm§Ž¬čigĽBĺJĹ]XÄţŮ9…tK™7K•ĺĽIß‘iA¨í €›cŕZx¦KS5™­úŮó>0ať:~ÁDŁWŽLÔń÷ĂOŽIˇANÖNHG™ě¦Ógť¨‹Ž˝±n-( ďą˝Áp0ŠĚ¨ý]yá?ÓŮuzBb'€-5·t¤Ŕţ‹¶ «‘‰q .çQ 06óĚáP5.X™ŇŔ‰‡(‚6@<ś`Ľ‡Ž˘­:­źĎi˛gÖŰ<÷S«ŤĹ"β¶nŃgţPłl@¸ ş|˝ô ĽŻ`(‰$f Ťřż{‚,ťD†`B…Ę _Ŕx°Óáq,Ňi,nćŹzśJ°“ş„Ŕ‰S9]´â€JĐź(˘42Ô°Ľ9ÉfJc×µ~Ó^H€ŃCäŇč©©ŕBÔzüéCá-ś^]D–d(иc|xŮ×C#ÝľZ#‡UHS=ÍÚČEÜ\oŠC°9FđĽĚ në9ŇöL…PŔß(Ę‚đŻŔV`ÖŤbał ”ő źÖk´ń€çq¶¸ňë6vďŮbYŇŐeçKŢŕ®4.NHSŚQk_Ť6`0}ČŁWČ?Łę8O_ÓPÇ_}ČäţoÖŔ¸8FF’e={6)rŮ7ńU÷î/;XN*Č÷q¨©*˝6Ő…`}ëźţ÷2޶ۦúú d~ťhŤÚ+â>l›ĘűŻâĘ}†˛34'\ŽĚćtR®ă´Ö"ÉŻŞ†Dď=¶s x» ŃƜ뿯EęmhńöWÁŚCD9Ő3ńL}ţOł{gsh%éN_Ťś&†cŁ‡®7žJS9Ŕ¬ šőY\»úş”9,}‡Ć ľE“…5Ç-o«ś®v}o§O…Ý×,ѬBP}/1G*?ŮŃ’ˇCa©C̸š$±_z¸VĐ0g‚j˝LŐň1q ët?şb@ó¬ö,(V}™Čş'T܆ôď ż/ óPpŤYß\J `‰l˝Âl'¦ŇőŔM–%=ď:nŽżWJlß`8¤‚¶ů—ľâ‹P7KŮ^±OŔP°?cčZß xeWÝ…Ú?LM(.ĄĄJjĺţ‡whČŽ©î)Ý9ŢJźÜ.–I".vg±%]mĺĽŔ{!ŘčqęŰů]&DĐ"'Zöů`Ţ…ëÄXíżőmGLh„;ņřîoµµúśqÖQ¶ĚUxB°†Ę0¤NiBËmĆPóßNÔŔ7Mť_˘ń÷úđ'ˇ]7ÎőąĐĽnÝ\nîFFh*;ÂŢ«ý8s›°T(]q®8R MŤĺnüýYń|ŹęňB(čÉRŞŰýŢ2ŹČȬĄÍ«9x˛šhZŕK˘ÝÄ3¤†ŤŠo±rfKĚĚ·Ęáą;RL…EŘvO äą!b6⩶ŕ ěů[Žá|Ę骅u’>ńÇúMŚt„ĂL¸—-úCzí,ţ­VŽ}éś[mŃő˝Ç¤Ž,‘H÷oňűŁá^üH¤­]Éîb‹wz‚Źâfi]*˘ť†ňÖ _Ε…6ęÓ‚iN]ŞÉI1©ĺzBHéŢĺpÉjÂoŔ; }©¨3ĂąÜz©~ĐóŮzWpą&¬iŔ'­pĹ™ggý_zŃÖw‡6…h TN×™ tÎ&Ôőńv°ľ‰zäŻÖ×U v˘Ďţç~'łfŻČ¦@qYÂĚ7’¦°śôsǧ[HÇgOŤĄŇ;žŃO˛âGę. Bă–^lyj˙%ňO|ďŁŮä,*lę·KpŚđ0x’ODBj‘Â9Ű«Vîl˛‹¦2éŔ?+â Ć=ŕ2f7űUĄ;d˛·öŢÚT0ĐoQŽEóP¨ęKŘ­Ů=M«I˛Ň‡şâ©ś’ĚîµŃÝ~éNÍ·ËjN*§›5Q(-Ů4î‡_îC_ßDť™2ű˝‚P2Á)PiŘnĚ[pÝŢĆŤ;*–öďŕG_ţ CfttÚ¦|Â3"×ĘG'ÁpÚ]óWć[)1:óËž©dK¶!ç\ €‰'”6”1ÚO·ťŰj´§˙9ŇŠ[wgÄŁJě$ă× ¦_ŠŚ…°Ł={XFsü왼ԉ˝ß‹ Í5Ž§ľŃqöKĹPsÚ2ň:GEa«ăóď RyQÂ.đPą2ütŚ%ěK0GʤŞ6w đ#řő—…đ€ŠeíQĽ/p©},ő1±Öşžˇ)s 9Ü=j‰Ţä=ps†ús¶x@pđ2˙4ÝýĹÎnËč®nެ)Čĺčm}ő<¨˘ĚrצncŰ˝ů¬WpU–źoüřcb;čJ #ˇöAľUäĂc(yËE1÷‰úŚo©°Ŕş€{ĆŠąc˛oLQ’"ěţˇđ°ŃřŽÝýMćż)†T:m\ÖúYK–r=5V-vłňÍÁ„©©{.âłëçgJđUĆ˙R]jCĚZóőAĆ”aZWe„«ź@î#É•ćUk1üŻßš©ľ3ÂÍSd{2$B€±mÔó Ě槍^ÎkżA€ť>’fŤ¸ie$ŃVZ‡©Ýq¨“ôąě?ˇM;!ŞHmĂrĆřCxeĆ%Mo›)Ś1U,Ś»0±Ü)Ý‘—ŞPbÚ#Ýň›ţ˝FJĘ켨 n…|PĐW›x†kiźZRĽĽj.‰Šm0:˙mR)ŕ:$ Ţő˛C_o^ĹŚŽÝŕQF•¤űé‰y¨Á-·–‡®™´Ăą|"·l…ÓÎŇ‚UP_ ˙ĆÝ g’ĺi-‰ą2äw´Ątţk…ßFFoŇ®ćÄááźŢ™—]$ ĄtŤ>Ď–ľO.…ZUÝßHŰo]Ů;8ZŃç›™ż@:>%őËXs@ę.oµY“ëd-xŃ4kÍLćČ?ňęă`Ź#$»pŮ-P-`‚Ĺ˝ź$ŹE¦ÚĎ5Â9—ŤŘsţ:•J‚H‹ĚžčęŔiDÚŻńF—úťP„9ŕţŻ˘áőňŞ˘DďŻKY×›}‰a‹fEm…ä†4:;ţI.ů‹ÄPČNák›SŔ$üu4¸g‚ÝŚĆćPŢb’ć µ­Ţ”=ĺŞÄ‡Ű6äku#‹Ť„MWńž˝<÷hΦr˛źůÜGÚí¶L¦hu$Ĺ™&ŃŐG´ŠŁA ś áŻ4$Ąf‹l3Ŕůe;!úaű.µ“\á"]+ŮłŔ: (suNľŮ5‰–ÍEŽ—H‚u[ňö čî~ßmO+L ˝đsčÄQ0|żc<¤sđƬţëŇîúüRĺŰíÖ?óÎWéŮU¶öÝ\îP “He†Ţ8żWÁő’×ýrţşŚ_î ·&Ňë««%,Ú&8Ó$¬Cžółň(CË:Ö1ޤ’ř°Ü´Ŕűş·„bRÂňŘKČś,´VŇχ;<Ź>ĺÔTš —Č(Ć ·˙dŐv`¶F¦Ľ eŢWdµLíĺE]sü6ZÄ Ł#5CÄ­-¨líĐ÷·ś<€¤QńusEeQÔ!L×€é9˙‹7™ŐoSĐËçBŮç_úGL^7Ó”.† <:Nî‚„˝ľÉGˇĽXT9“Đ݇ТIŕş6ŐíUęv?áţëĚsuwlpPMŕ;›[Y€BŔ`^R‘­ńĆ Ë 懸QÍÎiţ”Ň…b­´bS’E‹H™˘Ţď|iR=Ń~âĺ7/W¦ :{ÍŁÁ/őľ’:ť· Ř=™mąŞĂD-cnXŤÝ Ŕ¨ěx=ß|•zŇaŕk>ŘŠ8-§¨‘@ÚÔ0Ç&ײX»&ĆŢß»1Ť—}›áeO*9ÇËkŢí…ě0űŠ˝ Ěó §ĚHz™=ůŁĎĐ'Jă~1©oâ«R·É24©_çx–)Pđ}OĘÍCvQ ‘ď.Ó`ű čm•ť‘„·ëäâo¦ŮŹ”őÓ+RÍüŻä+_PŰýqimzJ_üc ůrQÁ˛E6ç´Ę¨sÝdQH ×\*)CSĆű*Kń+O#)2T©ÉłńşŤß>ź·RŇŤRDý¤„Ů—‰ą& 2j~€ˇ;öfîŘLdĚĹe#!(‡W¬ńĹÖŻh[tEbň—·L4j ±b?¨ţ¨~Ö ŐŮ_,‡q8á!µůPÖwŃý,Čž/'yő}?ŘźXĚÄÜHÚb#¶6ĘŕĘá(ĆëŐŚ´BSµCĹçŕü¨V ¸RÝĄÓQĐ`ň ÷‹=2®ś+™—ĐúŮ ¦:őŘ\T>»µ2ďšz­1Đűí¨#HUďýűňęĄSŰşUüÓ~ł¨ť ¬Ď*Vµ3/©Oú^•T±üB7ĘřżŽ«iúGL‘Sć R]&G ö(ŽŔ8ËJ.ÇäU(Hîľé«É{Ĺ HřáV‚Ô0*Nľ^ţĹźřßpŇ źÓK“{qÍžca˛đ”~8ŕřÚŻ•(*:ŤĐż‡P ŕ€Hű°ĎGO5N­ŽÓŢĚó&i.ä@~ … źĽľŁ<·Ąe¬*¨Ď(ř ­$Ń´‰|Có&Ęó9é„t.5ŁŇ©7€ŤňĎßySËđ%=Áž‚Ďq°€Ŕ‹żN޵4éKŤ÷‰ŁŘÎ>ĎS+MLHµĎŻ™Éß’vŃ{š6ůBfç!üëĄe@“¤ňű3Á)ĽáL+TsľĐă›~ň}śl[ hç#ŃD¨0{řąË}Ő‘—G@†‚Ł)ěř‚3+b…Ĺ6h&ťî=Ţ(ďŕgšÁž™p~wŢ.ňµçM©»;Cm–­‘ŻÝ)^÷<čoŰ.C$ŕ(Ęmúö Ţ0ţg]fwĐ訋Páăŕw—^h4H©Ew#Cyć»5MÔ ÚüqČŤAşÄĆ,¨µ§ĺÍž{Ž€Ů©rVsß]1 Ă›‹4†—;Š#‡§t¸FĎÜŮ”Sß Q«gÝî¨kř8<ĺD–3A5(žaHŁD$›âÓźyŐ+­ď;ťf}›ô(˛AsiąÍŤöYźs¶×Ń‚uĹUV K4ĚÂôĂŃ°nN^\Kí‹Ę1=|'jVÂj@#ë·¶u˝?©tNéĺ±™Ő)á˛VPź3ňJw?ę‡Đíł;C_“°Í4>éAűąaşČOĽ…÷“Ř9&VÔu®Ö¦{ôŃí™ä{0Đýľ=9Wu;Ücn§Ő‚ˇŐ„_ia{<™UąHŞO‘ţOQ EsÄ—cmP¸šT ěOÖ1Âźn×ĂŮ<ťtIŠeŻÓMą ŻĹeWĘ’äčŇ&aŞ$}ÝÝ‹˙ZĎŚte'! Łťe0Ż‚S&°ŐM1/:(łI ·µř[—)2_ ç\Săr÷F©Č{W©1–•áŹă';oj>Š×ľCń,x[Ă2˝A ­}–…mŻLMĚ݆*Ő]Q˙O'ŹúďÍ}ŽÉ1vÀׯŕűŽ}Ŕ/ü °ÂáU­lWĂŽ(¦N}”W"~¬Â樅ý„z®/$TűÎÄΔ#ŻDđD’CĽ§ŕ^r}ŽŃËŰjw~X*߆Jößzr“FšQH3˙(Ůö%çö9ąm—oZ´>\°Xđ*ź1křz”m)Ş•‹ĆŢ Ć8ĘÔŤĆ2ź>ó%ŇV¨źX9š¬^v§ř1±ö0šDĘŚ—óÚ/¬ëX˛ŇśÁŤ˛ÝĂTcX‡!IËߎ¬µ´ SDyXK淋x …mI_4µ9$ €ˇ“L,Şš± ĺ7xsż‡TN áĂ3HW2uł”;µ˘}ޡbFŮĺ}a smFZěPÝt§”¸#nu$öť@]śfĐŽ Řä…ÔDÖMä3 ĺ»x¦ďât~[,¦ÜeLä-Ň˝Ś=-?ĎôlŔôÂ~śđUŻŹ–Ţ x±ÚÚPčóAÔađ׏đCé]‘çK8ż%~Q4ńzß5Ö{íçvnť’)“OáE\ŐiaLS—7˘ŇAP3M üĂZgŢž´ÝAßôÎ:‹]ľ):űĄäPI7˘{—šĆŃíC’™mPŠ$Ńí4’×ôŽmN@Q2NĘ'(ňIËTiŻřÖľ:ň…š˝îm)CxµÁ÷#¬¬] ‹`±‚‰éßQᎎ«JÂ÷U¶ QeĄÇ¸3}ń—ŕŞÓ¶î ůvÝů–÷ĂźÁpĄĎqŹĂçŤbĂ°j W—¤Ěőß=Źm_j©ÁhQ±V†"Ő´Ĺ>“A„×b©A9ĚĐLů Ő=!áÜ’Kł¸ă">u‹¦ Úsěá÷! j·uÂţWÍ…4ôkrĆ {#v¬ř#·Ě%ĚÔÜe.qůÍ €!Ç´‰r§¨äsŁío6A^ ŻO%9á*Źl!/ĹxAk¤Ş4°şäî°$$ŢIa‰Jn?ł^TĚĆHűçÚ ^©Z!“Úý×î]%qć¨k•şCíŽČŻ°u6î-˛Ic3$^›w žđ'Ďi*hݦř›- €ŔB™súâLĘŃFŮG¨0ŁĂć)ŕk6(ŽčSPěA dîçăšZ? Ż_±r^6ókwc˝מ–é¬ęŞNO|-/…µW74›Ú1x¨†ÉńT˘§¦l4UX‰í(K˛|ŢyJŰj5ůî#&Ď­˙ďĘnwčb$ĐqŢřµ7ý×Ć|Äcó*řPY”+Ś¬Đ¸Ť9e62=|3ăYƬ÷D_UĂ’˙rť)Ä2®ŇńřDir¨ęĺ†wä=‰żĂuŔ !éKFuM2—ż“‰ŽŇë —;„ľçţU…ľĆ·˛EúS›ÇéKtm8]ˇ÷ďŰłú/rŐ42Şż8°?$»§ÁôżĹż´|UkŞÇřHÖíŠ8ţł±3?ĂçnÉőL}3*«™íaŞÄÂđÜö®µô-Ebđú1}J2©M®¤ c¶ÄâđŚnżKOöíPţł. ×( Qą»iäd°%oóÔŕ#n…Đ-Ł¸‹˛°Ç-#Ë]ţüáąj6##úeÍFy[Ĺ?Żţyődô^"…ŇďjĘNŐ¸uńś ghR †óLŁ1T îŘŻĐ2]‚č ÁłŰÁIŻŢŞ°Ľ9ň$ă¬P_ę˙=Ą€ż†n§D9Yjd%hş{Ţx‚IţLńĹřbâ8j5`0CtćHźHŁŚŽÖuö›§q„WÎGX Ďě(CŞRź·•sę ĘX×ÜhŢţßoşŞš]ÜX&~X‹!ýÓî¦ęěîBY{ĆŤ± C}+€Ei˙żÇ ˙0ľe$-â‘÷oŞySŞ"Ŕ/F2xć@˶VáöRÂ-wőF«}#ż]şż€S4gŢŞ„č3n Ö›ş9Ŕ Ż XK±ŤD6Í„±IO‡_9Ě®N]+%um¨Lű8-x6˛÷ Ó߬ŤjT–LŻŚšâGéójŃ8/Ć5=çíőP ĹŠőxţ-—ëë;ţŤźwô*ßÁł˘ s´éĐî$.8űkÎŢłŤhĂÝ=ďl#´I‘Óź´>ޡ­'fjX1šýępĂ31`lŇ(SÎě=ż«XbúĺÝKŢ|XőLľL)ň`YiüśőŘ#W8¶č#jír9AŻ~řť~h€ÂĽ´‹»”G•ŠŤźYÍô ď~űM—Öv߉GÔŁIöˇ Çś[Bdm TÓ\LŘš*ž Ň&99uă jdC”¨ŤÜPsrâ݆ůň•‹e'GWŮí!xŰÁlłŃ÷v̇şPá~©ŽĹö",îȦŻě„™b-DkGÎíUŮ`üAó± ó]»Ćĺůo:d owĆ18 Wt@›¶ ĚĄó‹ĺAęV‘ĄgXĹ—;ĚA•“>ĺ?T`L~űv·čÂp+ż:n­‡bĽ QĚóČ ­xžţ\[ÍŽ– T)ż«±ç±č‡źh$nŠĚ‰L•$čˇg—'¸hsůń>BĄ>Źë®\ŻVAßßBź‹-ÍRčŘe$W•<ÉnńzdJX]–'!Ř~P˝Xý*f9dŰ%; $2KMt?ĚfÖŘRŠxsĂ~gÄlL7µ·Űă(?ÎdÇ欌-[íő–¶ ç(:Ë´—9ô ĺńţD KvĂCßm—´}»ëĎžŃęÍ÷ďcv®RŃéů÷Ľ®żKv¦ŽmŔu[Kąůr÷,‡ĽwAžŇówV’ W—§˙WŰň1)»E!}MiÉŕiÂXŠúŤ·Í˛qřâĺëÚ8źłKwŃŢŢAó4ĺPŔU)ś šćĐ {[›Ě}ǧ]žD3O(˙hĄhOÍÓMŞĐÔĚ<ŇH×@Ţyq¬ †ł­u@(;ŻşĺŽTˡݏ֣§ş=Hh¬”ŚŚÄ׿ł%çëf™€fĽ±ńmĄÝ:‹$ń95Ř€ëJD€Qb‘Fô ď–ĺçş> «ňY‹˙! ©ŕą‘ÓĽčÁ\łYčµ šŠ\ę?µŞčO×Rs^#GžŠŢßQ½ű*Ş4šLßÔŻhŁ®T#¦đßf_¦Ę°ŠmţPëú‚ Ů­=:µž >‘Ţ",<šň1Ó>VÚ3mĆŕ Ś¨ÔÓzĹľ$qţ§ –°z̦ˇŔip@‹mëjG݉«WĽ ,ŕUg¶í)xřHVËŰĹŔZ×e^v‹(ŠîĘî…šű€ězˇě"†]=z©·{-Ă× ‰ ˝âV¤ďŚ…źŮ^ž=ÄëŢ‹ňXC 1Eú˝Żů˙k«w٬#OÇ#a#ć>Ę/®Qňçą×Ó0} QXą´bŠÎŘ„ŕ1»1&oVë°D:+%E#suą l`e«˘ÂwČX쾪žltlŢËĂÇĂ„°-¸K†‰¸ń9Ft’§ ‹îĎŹSgç5ÖęjĚŃ™}Š1lÝýďśĂĽČ”21fEúřzş€n¦j+˙ă’ţ2ˇQk{­´‹I¦­Ě íÉ ¬#Ńn~ćŕňµž<µ×µÂH8şŇ´ŇlÁ–¸9™l5 ňß/$c¸ÁsŹNĄö×ě‹çO÷?đ–Ýś(UfÂBŹ*ĆWŠŇe}ź›ýBr;Î5Qö=?Ćt$yňűÉ`ĽÍY7 g)Ő%3yĚ" ęÍp)&Ę®O¬«Y#Âł b rÄđVŃÜ _ĹžYűBßl‹…®-—T˙ĎĂů7z/'69š$»°qŞR70Ď@Šă‹eőţ‡öďáŇŮ: l˝MiÂ$=¤ž\ˇŮ¸® ꙶˇMPÔÍŘő˝$ZŢÓ Ëťs«äă/·Ő–ŕ÷pŠ«%aü0Ő’VdŚ‚Ę|ҧRx2FóĚ2żĘ¤SÂÄ‹"ÜMÇ1Ž}§ţď˝e˝ÉŻŞ$‹\Á¶ ŘÉ“˙K •„ZŚ®nЦű¨ţ4m[~P.˛Ď«‹1j4µj¤Uä‹;űđ›Óq"§`YšgúFĎRötÔćYŇ‹TŐŕ?F‚ťąş7D%D˙Eך¨ę°( 0”H aĘĘÜşę”FtLŁF–U8ł@¦JN>á4T-džB’•[:+´®L pĽ¸±9nc[®‚ŚĂ·żó‰ö_M3Ę~JńË}fĂí#âPo«ßOë™ßčF>ďĹW•‰@úü«ľc±éŘtďWŻ¬74yŐ…đo$cň2‰(q=XH÷@SŁ ÉO¨ Y÷¶ź]…ŰÝ~p{}éÖzRSéHüľR ¶!çÖ[&+/JđíL`˝»|ťnP¤U)h¦÷É iĽŚo6´lÁm»‹L€Ú8źč ü,VJ¦FUjÖa˘Á°T<öłŰšĐ?.~Ż§»Zx´šµ‰ÁH2yKžÄJF$ŞÖ# $˘\_í+—He]łg!>‹öÔ00w–ę)üPŤ[a02ĽĽíĄI‡%<×ń`%Ć‹ţ{’˝Ź?ńÉŽ{¶¦¬™A+u}=Bä—/#rŰĹÖ]0wřjÚ•Bd“rŠşTů5Qŕ2 {C·Íŕĺešp›Y®Ä7¶ť”Śˇőg•ßŞI…ńÎiʸM'Ęâ’Ýá®öűĆ©ČUcáh‹˘†°ZfCÁŔ…w©ý #ĆYYG"UNŠÁgeŔín4ĽĘ^ÓĐpI#GäY×B6oŁęů$ż37ćźP>NsžD%{+ţę[TŢ”Ű>ŚXôčHe°űľ¤†ëIrůŮL<-ň)źŹ(Ż±h3içK)(×ěĚ ńőYty环»’Ąľg‚úÚĄj'YőRŰhŤŚ!M›)É­+ÍRĘ.‰V«ćŢ­[Üq„{ąÓ…ę-¦*%" { ŃcĹë áyâk8zđF“mĺž{ô¸rŹ^Pź‰»÷Řż÷EËQK/Udm%G[]ćA-ÖóIĹízňzż :=ŐxŤś BUpÁ{T|8HWĄ«ź“Ţ–kÂŰ űO\䧔mŮF`±ś»âj;nx:Šňżź ‚ĘăhíM˝çqL˛EzÎżÉ(„\ĆZłŢó[$ŁÎÍÖWuwÜö®7î5„qúîWw,ł5‘ ĚzÍný? °˛zÁc:Uµ7Dă¸YV”¶žĐáFc¨ÍM ‘E#K¬°Ń Ţú”·3ŽIw:«eýZ°Ř¦{XI¤»P©~XŹ‹qTŃ„—ë*ü3©PĂ!ɢ’ŞÔćLy©Y ®ćYP•EÚĘË˝rńáţ/Wĺ?uĺĽćřh/6}‰ßř4ĺŰCíą5’ă=íđÎL&.ß"óů¨rç–‚MŘní=QÚ˙ţ›Ńćdˇ€Î“ůŽ‰®AhÇGC]–yvg3 ť{J°G)9ZEì~Šp—ŹeUů)ŇiÄŐTĐî\bȉ˝ć§»=0mŠ——źEA)öô27G|Ţ›o;VľU€„I˘°Élĺnä+’O+ [‹ UęvWmľpíňnvZ(řµżP3Ë,žáeĚmńÂ\ýBĹľ’śK•®¸PźLŘ ËNĄ)č9!)lÜOWÄ)–MJ$dŕËĂŤEŘ%/’KFşń YÁOł˝Ö©.Ú-ɸç 'Ö®‡Źˇ˙9›1´*N é¶×Ýô|NČUŔš“{čZŚżĹ÷H:‡Š©­.LÓá…n*1ĆÔY•öĽtwŞ7Ő˛2ř…şF¦}Ň°däl:ŘĐĄqą,Yúe~«űŐŽ} gĐ sôr^š’ –W´“ @©s°ć~Ą%‡jęö™'“Č#6 g™±)ÚaŹtÔK Ł‡Ř §“ČŁ&Čw;ۧ‚»|Ţ ¶Ygmŕ[– EwČůÓ[Ż…ź8jÓ#~ĺśř‚ËĽQyÂěĐ&'?ěőÖG9çnřXxFâ ę-äĎW±ëođ„<ę á"ű >]%ʶĄ­§®-ŚŻŁ¸đkiN(ARJŤţťÝFIwA×/—Ý{ pÔErżXŻĎp×xůzç”"śçi¸W)9ű9/ŁÝ[tË÷đđ !ŇNOôäB×@–ň–ÂËĽ v:řŤä ^“^5–qöÉ˙ ĚN6o’˙QK<_ŔM<\Łíh]:‰¤ő3żkÇŘ €PÉ=ű¬±»ÚĽĹ«ő4vN2Ń×(€G˙5’MůĚ xN'Ńć*±ąŠŻŕYKewŢ­3cnŇŞö=ߨd¤ťŮ=‚j€Ć.«ńűb/ö0ôŚ}ę (ĐfčM˛…ŢŇŘö‘éEaŁŚb˘Ŕ‹Ř.ţ¸ˇ ł@\ţ—»ÓźM0SýU/ëĚDpe-ěŤČV˙ń3Ńt-Öć\'ĺ»z\©µO\ą[ŔŮÉ\ ĽÎ}©Ę‡Źî—˙łÜż±|ÚfnŰP±|#đbK›ç`kS°çPéaný;¶ĄăcďÄĺSĽ&+TÚăćs1c<ŢÁ¦á¬ŔLéĺĐ/A"xňxµÓ†”&ü5°% _{ýÁČ’—ą˛ĆĎÜŃfÂĄ¤Ĺ6eOÁ°ÔR1FB· ŢHyçuý<á|;H…+čÄž›ßNÜb×F¨˘Ţ[{˝Ź’Óxá¶ę“ĎńSˇbIóŰ?đq#?î1­Ź‚`™7©Óű‡0Q÷q`.©Ž!UOPDŮŘ×`a€Č(†»F(.+/Z‹+î‚7_!wśÚ<ł¶ űˇX¨…ÁůŰÎ…Šä×Ęç>ç´öXźÜ~éŔSç±z.CÚ3N“AwÓ:Wń’jÄ™ô86?ŚäSľŤöóŢšfş‚ö7XĎÎÓÉô‘»ŘíäŠúΑT}ĐÎC…¦Ľm=çîéÍĎţđT^ňxIwcZF#Ö?&JŘżWAŘmĄkŕ#ĹŕÖž:o¬Bź• P>ŚŚń§ˇ\°8o.@ď§$Ë!Ę d«‚đl†"|\ß&°@–W!ĄĽµŁ ęě-âů® Z°´'KçąjĄJá7•Ń7­™†CŮ‘NeOÔ’ gEsĆńEOŔ$ů'Ęö˝"“éÜXţ.I) Ś<ĆŇ»ążLőH5ࣷUwĐ[ć{•śď2b^ҨU¶x-ÍĹhq Kfr08=ĽhçD¨%ĐŰm Ĺ•€#q±F×eśď¶\­4ĘP„ĘÉ&…lý‚éŘgőŠmŻÔâţZpěďť˙¦§Á±Â¶'™‡łĂ‰ąQń ön樜 Ź {<XŠ0ž˙ž-ëşS0oşj79˘đË«•ň·ŇQ2{€l¬Ýˇ"öţߨ'Q3:Ť µ[y[ Ňz$Wg•˘XIzt&ł¸>ţ/ý<}•[Ëžˇ÷íŠÄÓD{jŇşą‚¶ gÍ"ŕ0ş„>ˉll "Úě|\ŰŮM1Og°ÔlÄoŇCüp#*}ýĽ·ôaŤÓĄRci1Č®Ţő@Bá¦ÉÍbÎŐšŠ)K:Ŕa1jŤ´‹MşEî@ť¤źVqbŐŚüYJ¬ôł8zŞéß$¸ů4eW2€ÚiOôA°÷qţç{0Çú|čő7»KFnŠŰJ˘¬víIýŐ˙´m ŮáţŃfŞi۬cŔXý±ĂýuÔőŤĎUۤ}ŻţV°Ę&3ňE¤Fi XŚOަyÄżGÇ.9YäŇß’)S˝?L®‘É‚>‡‘Ľ4÷ůAh—Z÷¤ÄşEĂĐĘÇŻx-)FĄŕëwNóÝöZ9 ť ssŘGŰv0ޤW‚„Y›ßś=jěĐż^Ńň1•fşŔć^5Â/žě»}^ž~{I)Ěî:ŘM©\üÚ¤´qŠîuŤ°“úŤh:ÖKvÖUeN#Řě(Ĺ8˛ţPí˝ˇd7˙cű&îdi1Ë{kĐ(í:q-ŐßYÚ„~cŤ¨°T]·u;Ě •*ŹŹsZĆ‘66ó¶ś"ÔÍ”ŐeÉ`eô)ĆY˛0Y…Tmú~'*żĂAűŻ#´GU}—#Îţc3ʤQü¤¨úIĽŔWDaN%f·Ĺľ¦XecW°Źž?ĚZ‡JŽ‰DĂ‘§/UúHş1bZbs¦ćzäď?{«ôά…J­î‡#|ó(`{P‹©€ńBŞÂO”üBŤâä{ IĘßU‰Š|öyëkňŐ3h+ µ‹YłQyŹóÄÝ‘¤J+OŢ …» tĺ×Cć`ëE“_pö‡ Q^ů?DőNGظ eP-¤ËŰ´G ńÚŢą*˝“Tb;ET‡vGPüş:·SťđŠq´ ĺW zĆÔ©Ł…xv)çÚG÷}Á”ç"Ü%%­˘ŚÁďd"cÁîÖîŰBP7$t®ŽS«ˇZĽf@•ęĹ“GEĂĎ G“đLĘźVýëĂ˙˝[5%m…ĐÍh% d(ÁŢ”Nä`)‹>Ť”("Ţ3¸čň V`ç0óo2GrőqîđŚ@Ó”˛ĺ$‘¤ŠRŁ7E6lnë|küJááĆ3Ýf?ůéř7„“ĂʲĽRn@|z·@„‘ 9‘úăoţßŰ{ÇüĚFBD·šm2fŻĐç-şĐęzţŔROšµ.rRľ­\L>Âź‚@ůމľ=é©/ÝMŽbP0LkpÉŠ1ś™îw#ínĐŮŘŚB.×ř¨…¤<ľ`ÍeŤŕ­iż ¶ö˘˙·uČYjĚ ;ĐtÚ1đ”qÍ€Áú€Űoe•{o˙üŹş>ç-Ó<ę()43ÉĽĺŐú˝B¬čôŤůu±°ÁŁĂ÷\íO.ţ$ÜrÁ*g•Żtş„śˇbÚ)ÓŹÔby‘-äl5sŐźăŕJ“‡5´x{ÍÍşť‹˝bľ¶ĆŁ–śÂę»×V–Žwq€]ÜŮŃ F«{ź˝é_'1÷¤§`Üş…ꊙ2ŁAA5s/nů3őř1u<­ˇ•ďCLBľ@3‹¸LäosA›ĆA{S ČáÄUOÖ R6ę¬s+Ľ×„Érî¸wšĚBRâ>ŐI axš ëôtź\,jž>d“Őßo öaÇZĘź$OザžWćĆôŮ Ź×kCη%$Űővl†%ÖÓÍżÖżmč‡`:ű8zčÇ3á˙­9m`;ĎC üAůÂՀދîäϱÂą6ĄWwĺ+”Ş/Ő—ú˛ęk»ŻŤ»a5:]ř¨Y&P7¦‘»Ś¤'bA¦Č[žŮ&Đ*­řŃőxj#Î=Ű©­–“klϖ̵íX Ľ¤^<éŢÜDiĚÜ°Ý$Ż\ß~_ľţ‹‘Y›ĎśŰGÎŃŐĚ’öżiů·×·~ü°j±81¦NľÉ§Ç ÝŁ©ěŘ˝Ł…d¸ÁR<·…Ůżřąłř¨#őžű7;iŚŃfeŽ”©=Ş˙Ł,× ¦Ô-…tvÉň@8ˇ]ě"¸”Dť;˛4ÚµuHÔž¶˘4±äóˇC_I_Ńó V<‘ł8Bn:Ńż$ŻMDł/Ŕ€¨iżčďB{s˘ÄC)¬J'Éť{%°¤żćo’8źöol÷UĽ#f^éÄaĄŤůJI«…Ĺăą ‡i%­]÷ 9@”Eŕ&¶ú`n ­×HÔhKaóT@ÓS 2K‡Z4µ˛ĹëÖ,Z÷:•ˇă6Q¦iŕ€rŻËĽÂä.¸<{)ńr!1)±Ű"¦YKP{śf[ˇôkP x±÷|c!n—  ŠqH ?v7Ł{z"ÜĽőÓI’äLFS€ô·ŢKő*?đűĺ_¶ŽÁtj•F}ĎrµÂ tBeue"  ŤP1´žŠđ»TŻ)ó™ŃÇđü¶nä•ĐTŚš°%Ş=Çäű«l}đb­ďďPó¦¨ ‘"‚ D°€ô.¶av•ľźŞ„»kđěµţf2čLęÝtŻsĎÓÚřk§9ŢQŚ÷¦ĎÜ>Č{ Ěyi9k„5ŔD'i—üĽ®‚NĆc‚*–""±čÝÎEtî°ě@WÎÝM ěďăÄdś)7iźzSŽ6Ü)6S:fŁĺk×ő_9Ł¦S,sá(ţ”ł>¤ú)u¨őč˝Gő,@6lu"0?|ĹňlYĆ«|T‹`;Ży§hţgŔ Ő0*ź˘«÷˛ľ«NWôńµWš§Ô¤-’Ł{ßč˛:q „·Ű87Neg=LU™{ţIŹç˙ĽëH@Šśö jŁĹ¨öď Ąo™PHär`o Ś–M.Đæ‘ÍAĹÇzkĺ”›řĚ#<,Ŕö ŞWG;Îz!Ó3……•źl¤ÁŐłŽ[–ďŘ %Z·V€azĚS˘°.Bg×nľQďęšCsŹď>Ȩ5xÝ:‚_{č#<`GĄŠ·ś ›ôż›ąĄAŘ.ąW9q×d]—žÇ‹«\ś”OţT°’Č ńŕ_äZBîćkĘ dňŮ!vx¤Ę9ń7ŚÁë;îŤďC~|x·IÍů«Ô›ŞÉxf"EÚ¦4%Ç©,ŚĽĽžđ A·l *"|8~Ü6Ŕ÷Ζn;öĺŽ*ÍUyŤŕ!ÎL,ú ’5YŞř) >ĘäëçüĎX·“z˛¨hçúQɤ‚ž[tI\ÖC©´Ű<ń>ćřď’-pivDࡀ߿5{ÄZ…e‰›ö1ŢĐ)\ŐÖŢ’Ô›Däó¦‹Ţç3÷ÇuÜ:žČx4Ë‚Bt±™%jcSřŢ[Iřů îPŕ^V“a{ęrh@ńKăOEQTăyÎôUqWV±Čł˝«ĽâřŘÄ÷&¸9a¦"’űľŐ•fĽ’0ëŁHÖeđżĂ˝®ňÄ:ąŹÉ\§ůÔÝ˙ýĹýşŰ\çľiOťżŻŤv&,űĐĂkµÍŤĘCé~ÉOÔÎç:c]ÍUŔ1!ž6\ŚĘŚ˝hj})Ć&"ÖX;´űGvšę|>4rj9•Â hDŐ‰Xi?P$‹ü/@ś©Ş]‰đć˝3nţ9 |ŘݵäĐĆň?y1ş&I†Đn%Cz˛iR53莝ţűŞ›Zm“RđĹűq™ă𲺷n7 eŞÖŞ4Iňg‚µú%5XîĄ˙MŽ„tŢ€é@”¶y|ú*Ź0ÁęÝOm=0.ŽâăY€3Ý+Ĺ26/ętj} NôuǤîhĐä–îď“ŞB‹`$ Ę•’č…řŘŞëü&áě…É"WŹ0=’ĘČ#&­ű¨sUóŞÔ<,6ďHäńňWş=ö}ççK)+Â8ĄÁ_P!ČjúLleĎŇVwŇŚĽSŮĆváŚÝB>a|Či?HÖ»‡űM±8çV% ‹1•ářz,<©ü-`˛őšîjˇÄ#Ó|<ŹçXD3±&¸ °â?üć–H®,ˇHřą®„/«BťÝ§ #ŢĄîŐBâůń\4˛Á7ĺ~Ü€·şe>ŚĘ]/Ź8Ţ“oĺ2ˇľëpČëK҉7uz®lń ÄŞ±KÔ°ČSíUáfx—‡>”z\¬µ\/ÜýŻˇšuVęHÍ](ŕxX¨’łcŠsAÝƱÇĹŘďzzuäÚCExf0ÂŐęĺˇ&ĎĂ™NâűŚ@v®p4˙R-BámŽí×Ű´•ökŠÇž…Ź°űÖRÖ-1µÁ›ď‚ŠÜlµŘE_Ć?$ ůMă«ë{ć*ĺęŢŢĽuĐĎÇěhLşÄËOü»Ä]š(ćdF‚ź­vSÄW.Mi!ŰBńǸ}ZuŕŁgiäéwŕĹᩱ:75őâcYW@ŤMc#Ő&ŚnŔj€ps‰Â)u„l#Ě•ó©ŕ:?Y*鯔äAnŹ@Ť“˙ť{ Q43 W%Űk$§/´±Ź‹Űi ŮOü«ŔpĘáŽ7ëÂ}Ăź8ĎÓ¬¨z7·Hüz57Ŕ˛nzH+ ¸ „T›áеDÄżsÉk.Í€šj®ôQÉ˙öQp­AKב›¶b·ŰŞá±Ů}JIłłŚjěŘwŐăĘájL!Oďőď˙ĂćG0…zyDŃ3mŰđxšuËî»’•4ŚüîKQ ‰8ę“•ţ•ęq‚-Řî1 Ţ§_tI¨-PF „™U\|*čÉĄ'·«kln~1………V|ZÁô[˛•ýśťlýiâ(P/°(Ě(ë”čƨ*şN1+9=» 2Ż¬…PĽ|u%.Xotőă (7\LŽâˇˇŤmn†0ey@bĸ‡‘ő7 ;Ąd‹j˘`‹!–¨çÇkniŰtxą[đW'0 Ü8H‡` ~»€ěÝ­őMFćć2QšÉT¦ż ÇŮóĘ*ĄDk2®‡4®ZFß^QM)eJX×ČPn›ęIîN-7Ś*íěç:˛«­ŞAśMő9őăľĎn&<:Á¤X‘ÓJ§ú© YBnnS+z:˛i˙n-śTWri}@X9č,ŮOÁź(ŞŰŤŁ ÷P:Á—Đ ™€|Fââő¨–E±sZ·ć6ˇäŮť]ę• ŮűŚzq±u-µśű.Lm´ëÉoí~–őż ®čIűjľ>)›Ąâ‘üšŤKűž$•lN/b„z×X×Ő‚ĺDWď”k°…(+‚ü* ĄAÂŘÔX¶Í¸Ö{ˇż`Ş(\NÝĄµŃíǶçÇ÷$*ňĺ -—_âF>1ä–r`.÷–˛©ľÜ° ­Aß; vÍ0˘B¤]•Ń„ U&y(Řë©Y¦Ŕ¦aWMU?×/4É÷jDź”@żŇé„+ź©öiŁO+AŠĚ7ăËŰ=\çF/@hŁÇ5Óäj9Ö|3:@kî4i/¤›~I°Łg_˝—W·U<źľxĆösOµgei͉Ŕ䣰?őż;N‡ß+9ŽÁč÷ë‘Q%=µÂycrJób-%!Ŕ.Órď·˘řQý“ tçâîďw.ćÁ`é]ŮĆŇ4r“ăSsŔq07`·˛Ó.’™ÇÂlx$í¨^+EÍĹ”P D†fżč‡5Äiq1?Mx§ˇŤÚÖ˝?' »cĹĎ?I(ĚHöu8ŔŕÇ Ţę˙čsgý‚ż”)îÍU ŽĎş·k«ęíĂ2ËŹi«­s'šAĎ_bęţ[\kőĹTÔ/Ôvü†/ř—nČľúüű)śtľ[čćy„P´=ĄŰ‰ŮtÜnş@…úćc÷íź4*j@ˇjů’śŚFň“”ŢěÉ»Vnń¶ …Î řužŢIKJ°6Ú‰<»ąaÔNŻčĎ2M–ŞŁ± Đţ†WgŃX·ö‹ż}ľ:‡g` Ě\ĺlµŽŃrý¸ü‡ŤŁČXja`qČoáí gšě<ŕB"÷‚Čŕ¬CÜî€ú—ł?5Ě•ť–~ĺNU»‡Î)cä°čé-¦ŔťĘÎćéŹ7aI4t"„5–h !–ĺ°,9˘Ň9¤—fÎLxMÄ8B°¦`¸š3ni¦÷ąĽÜ®ÎŰ×.XQ­ZńEéëµbč&ąůL†Ă9a§îÁeďkë~Çů˘  •! ďuĹ›SĎ‚)ZLJŽCô<4»J˛S´[ ŠXď[&Ů’Ôç×[ő`RŽńÚ?‹wcwAÔůöUzBÄ÷Sĺ3ůT›0ţmŕ­B\łí^}ĽGŢ˙j]-Ń«\jŃÂóÍOWü˛H}žCD«d•×ŇŽ*űňW—óÄŻL{0®ł„{ɳɯę>ČöŁÉ`=2ŁQfćÓŕ>2‚–ţ[`8˛‡HHÍË°p%×îŞŃw•Ž$Ýi‘:ŢF׳߮pżÖLE‡Ü ĘŤ^­1§F®ăezGë*«Ąč¤ę5>Ŕ"H}5ś¸kż!Ś†ËÓš©»ą¨bÖŃňć5Ńáó…ŃHP0ü†S:X·´Đôn…;_(挱iáč`Ś6č9ç‘÷® r Ňۆô?WřŘ€o™°mqË> .x¤t ĺpjQoRĹČX‰‹µ_Ţvń¸Hńü% ót\ ÓMŔ×–|W€¨BlPa°ŞÇ3—dřlp>3+˝ž‚Ńs«fčí&Ăe ü6’zÔŔjŠëĄQ-<ťv«ěnëń¤<¤Ó[Ťk{2« T F4ĽkČŞ`S ؆yxłü×…Ś ‘GÔ áŤ§pÉÂ2ÚP™I:.ŽQ4ţÚDe‹ź˘• °1H¨Ë)z9tĹáěöÍĂŘ0j2HźQ.d'Ń+LăbúÁ¦ëťş4ś‹ZA73Ż˝0(đüY?®ÔěßBÝo† ÜP1´üăŮŧ&S.¨ UżÓ{`Q$ÔEv˛UPoŰýřUtE3GŁîjäˇ=¤]6ż§§¬‰_‘uň*Xő:!‚Ěj‘˙ÖDě_ńźÖ0tŻ}ˇqńK>y 6ćź:ÝÇ’dôĹŁuČ,Á<¦çÄ‘÷H9ÉáĘ,¸v?Qµf’jź1íe·N˘Wůű¨jÓvÔôOűÁÝý_ôčJ&żHEó;–µ.đ©+o?˛äŔmö}TS¸ĄŘĄ8ťI3Ü÷ăđÎgĎć«>ą+Ňą$·€pkÜż‡ńOňµFnXĺ׾/—7kHdOš‚ĚUŢOµ&wʸ€Ď{ ™'·ž•¬\i;1ÜG'ĺ€Ţ‚‘61N5vŚőá‹­S5˙-U,?KĎ>y ď±MŃqoňo(ś§çYbŻ‘űö«±=.B†˙™\¦|Ł·CĄ…Š±g ŔgIş "1Ś †Ĺ¤ť­g‡Ëd}¸m~Ő]Ă˝ß20•ľ8Ó€€˛ĆĂqs’d^%ççeŽŐŔôCOę1#>Űô©ňś;f{++±syVć‹'¦¨›™Żç‡tú[‚IĆ­Ć^x0,8ŮzŐ>JLÁüŮĹ´pZÂ_č/ČÎUÍł˝ţ9q Óś7É©}Ѹ?ůćDďĽŃVoaž.<¤şµéňB·Ë]QąH+ĚţÁćÓFń4Ő±6Çyl>Ř° źv Ĺř…ŤÚG3ăSď—h5‹Ť ž…SCĺLQĽę6H~S‚!ă%‚ź˙i$˝r}E„Wő WL ü0ŞR­Ľ ÚŻE”÷:‚ř™Ç‹V¸XńI/`Ä€ž“ŁËŇzc˝d¦Éeö_ôĚĽëaşĆüËoń řGS˝ÜčµPÇ4•­~N!˛Ě.*ßƶü"šc®ľóRwiŰĘ?MĄŚQĺ>°*hŚmĆfŽô“ ŁGśĎ1ű]t„şn~N÷u™ń'N» W©06—˘W ß6Ś4˝4i}8’fF¨°¸)Đ?…šZB¶!Ň"ôU¨Ú [Ý tU5áŮÍö!„8• ű·¬śŘŻ˝ëęH1gŔŽO”hĹOŽbłŢlUúh;Üs-˙ÂoŮBg ź™í5˙‰ řëą›Ź5Uň ¸ąáÓMľĘËÎ%‡ pvńÚKr¦Ň[ND6ŰYÔ}ü7-Űż¨%>ÁČ“RŮo…űY¬\ÖÔÓjÇ(#m0:ÎsÖyčÓ!¬ç ą§ŞÖČ$bćúaÖßX8LlcÔôCÖş;·ńŠÖűjů«NÄŚĄ:4if´âK<<„­Ä§YÂű“GŁâŔćWşrJâ¨á\sb“ÜWILF]jűt~ů߲„ď°lśj”Ł$v(=% ˘L^_ł|ŁĐËŢاk“´SJr zć{š÷^oÍű`ćp'ĄśMĹnËŕ鹍YeĐîQź…hM&t¬ŐĄęńN~¸•ňîZí Çž‰¤Ź–ߦľýÓHüN®,·‚îbšwxzŠ NŮ ÍâÉb˘Çk]_÷ĽPčÄ6"k‹‚rgQĎX:—Ľ XäĄô Ţ3W5d·?h;ĘÎtäÍ6a*‚iB Ôd9[ÝŢşîń€ŚaMŽŃó v7Źi´Ť÷čČ–lSNđńąo8Ô×DĄT3!ŇË ŹČ䦽qŚ ™O@XŕKatpÜŞ"(h©H°|jŚžĂľK?ždý–Ňys™őú†}óćG´č׸y˝j¤ă3ŔžŞË™"Ł§Vµ˝…ÚŐ‚Ę?6†§2É5ŐtM„şUüÄđŰ“5JѧjýW´ŤÝ.Šë‚ÖöĄĽ@«bă Ľ´ ~PĘc`ŁŁŻ«*¨u>@uࣦCň™8ů Ť±ĎCţ#KUyVb‰n¶<˙ŠŁ“ąáU!3›*-aSéYŕ·?›uŻ7ć7°HŁÝŤTÔ™Xń)±Ö}ÖŘăgÝ •‰cÍާxÚź!>˛]ŇÎÇłü1Â8>“m4$|¬Şbărô|oź€Ń*­Xqó0c˛˙sěč0ŽÖE§·‡Y’éĐŰ6~q«[­%|DłŻĺ‚›DŚŹ˙QŇU°ąVĚJ/0Čő;GŻŃ1=aČŘ·Tfő]ť9˙Đ×ňv>6–M·ß{:¶ H‡CäĐ"}Tů,él©VÓü‹5r*"î]¶cG§HŚQA•’^żv… Zźé±őđăµ`Ô»uHňuJ©dţ´o×#§ű^"“btÂo1[o“§ËF¤ -ÍňEţŐo×ٸ÷dN§z±Š09†8ˇ¸ZFX^ó×hŁĚkĐ6w?DNQn6?Ĺâ_1\"ÉôĎč¤gűR„IP?|!Çů ‹žđ·Ą´zňÓt—ĹîôÁźÔ-‰eýý $íȧÔ!g»»—Ź5 m@bDAVţ9Ý|¶ý@µ0×A |1Ť3Ű gŃËçoTµĽpWl?¨DĄ© á^ťv’]UńŘ)fvwš, ôĎňî Ť;h~ n {¨ˇtÔű˙_ŔĂ~iĎyAk&$ŠS"­”ćŞ Řu’˛\ˇ(›¦ÇµéŔ’{˙ăáČđÉŇ⌠&ćŢFĎ_Š­ľ`Ye® <Ľ%¨ŤD EfŢO87¨ş•·Ű÷~¤ó;Řë}USů óŤXˇ­Áqű«öDOęrŞýŮĘp{ ’ćY\< F`Ç™QiSJ¸«~d'ĐŹŹó“™R¤÷óOfÖ›SĺxCA‡Éy˘¶ŤľOG®Ńŕăřôr7Ň|‹+Ž쏰§Ś$ąUĄ-)jXX¸Ţ~óĆÁcßd·ňÔ¬ Ć(MhČáüN6-K0SABłMąź6EO®űš PĎßŃ›‘řpç Š–‘3r1UłšˇC¸ŕľˇ1G¸öC»}ëđ{ ¸=#‘Xá69Ţ»'’J¶mĽôŹ2äJľăÚ ˇĽeó<ŕôŐÝŢÖđľ]4D 9ýAô«Ň˙Ŕ…Ô%¤ŤÎ·6ťVZ{]Rž“$Š…m-.—ěľ{ >učС%hą¸ÉD(řé— S¤WµäŃ„4|Ôj’ŐKu¦s™3u™ľŰu[¦Ě˝°§*}IZf^’NsľUČöĐkŚɬǟx”§+îIµ°I)Ţe ¸Uű%2Xđý‰Ć0Ą ™}šĄňÖ­€«^˘űI*AřIÉSB*bçRŃr`«7޸ł·ŤÜmQQ…µϬݬÓIµĚ"†‡"ㆎ—†”ĎiT<¨ÍřfNlŇEJrk ”âpţů/*Ň#Čđ€ô^ṸŁ^(…?ś±tˇúŽ›ËUYć»pzö˙Ş{P0mťÜ»ý‡ńľëÍ Ü«<ÜF$Ü&€'¸hńť.ą)A˘Vś¸WWVŔyş-ł"čť=hEÎ5 –öŞnŘF †Ó„ËĺÂďÍ?>|Ś\~őň⧾·IK]ĐU €?ýĂ(CřFŇß‘$Łˇ_ňžH(pYtéÂ3Çf§Ćź/o‰ ‹"ËoO?ĎÜSŕ(Č#aߏÁüwřó+ ş4Ů÷Íráî—Ü^i˛Ş`tałiŰhöŹ\×6Ć ŻEsŕ;wg¤Z^Łçö—u*+ţ_Űʵ^Cő„ÝgŠÝ„8 “Ć7ú(-±ílű5Đ u§ťü ˝;jîÎO … /Ć@[yn?mŢŘËe–ě犓ŚşÇwßYŤ.Ą9«^#źÍv€ŃË9JâDňłţiÎŔOĚf;&Ih'ßbZ'–ŤvF˛ŽŤ.áe˘ş‰Áü>—ÝtLSĘ {R¤Ś1× ­‹mî‘\Š-›`.»„ÁëŢ ¸ř±ý^‡­ aň×ţŹçاG™Č>íŚĹ8–†2*Öm‘wX-@÷H Q(˝ˇ¸ĽÝüřB&˘źYśCbrh˘Ă0>{Séjx`J _,«^87@O&ŞÓ€+/ćGĐŕuÇÓ%ÓýĹîţĚ—bĐjÍŐmž*=ŁhŻ˛h¶rËšfť¦cj­üëšůďCI\÷}8·kV“.mń)>FGFňĎç\ęAŠ±TýäJĂ FE’–/˙A2üHÉCC[y)Ź sÉ$Jb^´ľXRX®JšşZí3I%}×}¨Ő2©y]!tŹ"x˛X„Ö: ëáźHá Ľ[DĂŇdB e@nôôÔAČ•Úę-XšB‚NűćEE.ä€ŕË7Ń„{ś żńň7/¬6%>+駸CŁ: éČ׿vD T®6+ěnÁN…/Jŕâ}!rü÷|¦Í}őá» y2;}Ü÷N?p+E]±ĚÇ~a}Č ąŚ37źÓťcČřÚˇ=Ţ<®0ŔJ\ë{}‚ůŞ«˙pébBr,Ľé¤®Ů#ĚB.}ďwy;VúBę˦Ą;D/…ý7G€Ěôě‹_űŻgĘţÎ »·w8ů,Ä:˘#śX~ôFq–uM4jtV˘šeŢŁá˝j„÷qěŞ˳<˛ŐĆĄ Ô'Ëç4@ő¸áR@ą=pŽśvŢĽ^}Š} (…¬‡ÜzÝ»<Ćľ´|ëäý–c, lÚ›"˙ ”ÄŽ´W¶˘„·4ŔPEeăoŮ-§L–YĆ,čpn z˘3É5€ ůˇĄ}ě»íłŕ{ÖźçTt %mIlřčDđÖ[Y“BIđńŕu…ňę9‡—Ŕ‚}}ô—ă}LđÚ[¨tQ,ÄËčÄŮË{p‰xoOś$őÓŤÄyĄÚ€śę%°ÄČz~¨Ěd9¬Y÷»‘˛đ"=‹Š ¤B…˘ď Gśfa Ä—ä\)×ŢžšŔŤ; ‰uáŠ2ŘöGô’X1ę§é©Ďś4łU¸˙X6*đ$G9¤aŠůóáś` ѸfčŞóŢ"˝{ęmpŔ†_Ç( gȨł×<Č‘‰˘ŕĎă: łrŐL^L<'ŹĚÜôŹąM«…©ŻÚ¬”¨Đâ#ň-}G÷ŰŚJ*ş˛ěF:eoüÉÎkţÝ˙Ţë~–Ň -c×Cm( hĄX aĘ˙ńöQâ đ.źK˙ă,qÜ2&…ôÇ3$뇙»Ď l•0‘Ú\’Lľ©żsT>~!×Y—Nřbaˇ·-xÁĐH~€dT¦H\[  Ç˛ ¬vŠ­ţŤy|2O R9y}ZĽ˝„¤Y߉)¸$ 8¦L4Ü9ü˝Ţ<5vQťËÎ č‡jRťtűanÍ úśźćA‘©€Wżi¨ě>-~ÓŹ/ťC»HóľCéqŤ´*8Ă}6űź¬ŔŻ‚SVn$-úÁífźř‚Ő®%TĚWĽ®]¦2ĘéÔ,ă”/©ˇTjN"ľkyS§uC hŚokZ‚ÉčÜ\µă-ÇëxnFŕßC Lň‹ĚîO{&ŘŰt_łßjIPźgsĎVwhŃCOČ“ŚŽoŽ`ÖéÚéDŹŮƉďĆňŮó’Ľxčú“Şc˝ŕţ¶n˙Đ~Ň|‡tÔ ŁŞÎşĹ¬zş.uP oöÂSjbů›¤uĚRĎ-±Đ 6Ô˘¶ř¶ńĆšt°¶b–ZŔ÷B”•bř.üŕ1jÎJ¬k\î#’çNO­SŘ®°hË_"o˝ąŐđčś?pN±ß-„!ß°˝ô…„6#¸Öâ"Ši1:×_ň±,ňşĄę˝żiÄČÜ\îŻfËľÍ-KÄ•Qe@źž ćĎŐK•űE]vşůŘÖ(™©r‰®y†ňă\HđaŁ‚ŕlwś5,Ă!ď_ąq7:/c\ŽŻŕ€Ę0mýiš{şź}„¶.}«ýf_§b﮲TĹĚEJ Xž…'‚AĆď•k9o÷*Mřś»ŕĎFŕ©nO…3r ]8uDKcşŐŠIÂťś­‘G@MĘ…mśACv¸Ź›B‘6˝4ăOťś.ˇ4¶FÇąB˙fŐÝŻÖĆŘĚÇdĚO6R˘XôµĂËŁAĚ+ęěÄUŞH˙Öęëî _ŢĘ\ v\.?ÖëdĘ·™ŕWkN¤3¸c‚Ž7"8« ŠčÜbž 8ćâŠ9|ňLBóďär'Đľ×uKőç1’üĚD$¶Qgď6 kłťšâč{°ťď;lËZĄ~‰opÎ˙C59ŚŽî«áfg‘Ňíž©Ë~™Rą>“ăŤ(Ţňh = ’<+bĽ!E¬J ÓĐł¤ÔµôĄř1•",¤—ş (ňFŕ¤#1z'Ë©­nć_""źőSî®;ĆČŐm¨4t ńßćy#ađŕlLVXČ‚­ŻrF3%ŘU(SúŰ›yäÚţĹZłg<ôŐJ©użwËHĚ÷gÎĂśÎÓŢŻ`…i˛Mf®ňťĺK„t˛nŮĂ*=OXŮ‹mžŚů"* k#p›«ň3hJ˘¦ Ű2B.}túΨ@TΨ‹ůf¤ňś±RâÂÖň4ý(B#}h \Ž¦#Ü"¤ ľĹmt=”G˙&×Ç­źy3;~ůMë¦x»;Ě2rä8n$ÚNF&Ř”Źg!Zś"“`ű‡ ďxVF2‡S»Ż´){aĆE…Dň‡Ţy|đq¨sȨhcßÔŚhţ{ńőR»±鶋qaE őż:ł ň]’ihO5r.®8kľČ‹’ńŕéŕČâK2xI4śxEŁ Ď©%‚ H¬˝’IÓ$jr—WÁşC§Î‰0ÁÁÚ_7oÜrßwÖüˇy匉Úži¬y ąéi¤6Lý$0ĐE ŹPŻÎŁ ńg§“™QŢMéhiS6ě”1ÔépWVżł TvŢHş)\ř¦ĂJčąXAóÝÔú$d?‘q)ho÷ö ý+âR’8gމő“So1Ę =ŻZ˙­7ÚźŐÓVŽĎSßmu Ŧ|+ض¦G#”Še$µcOő|oŞÎÂ0ôú¨)cŔ]Ąg"~ľóRżÔ-NĐÖů ßŕ!™Nő^ óVä̶ –ĂüěNâdr7BčOqý-ÝÜ uVdדß““'çJÖś[/ đTćYyž=hA…÷Ĺ„—dzhĆ2¤XqśjkđĹ´‰ę»J¤}OÜÖ{«iF<Řąş®˝YéÁ¬p2¸‡bü™nňłŔ,Çb Ŕ+‡ä™}ďÖ“‡ ŚĂż]ŽX·„pDH/č=lĎzUž×ß;ĐáůŰĐKwL;ĎVăî+"6E“uÓvl?uvĚĚ‹†—vůăťF—r\¬»´yláŃ/Qúż h‰ŕ;x`cp«b—\–cN´]ĺěň:¸}XşáW[´Ľ|Ű'˛ú€Ŕ~Gkp8ÂhŕÇ,My3öy‰~~°Ĺü|č#%ęaăuÜÔH÷C`ˇĹ/&Đ.–gťëĆ*Ľ‡sG-„Ü\›!HT?FžőwÂjO̦gáB(”f˘xŐŽp'© Ż]5‡*˛ `qa-%ŃĂź“öx)ÓI\^8 ;וr®«ÂÉMÁ€<7Ü"vAŤŽ:ţŢ~mď]Ď'Ď^)úG#čጲĘnđ•+\Gî{J%« ČPRuj™µôXŐĹŤňSĚ˙Ţ×5“‚08'Ký”0ʱÔ0ó=zÍA;Š“×ÝnyQó@“Ń-$e¨Q)©<Çł×Ëî9`q˘™˛B‚~@rë†ŃĂ îŹÓ=ČŁ±vbă (ĹłŇQ˝hl*v÷1?Z?č˘÷ˇěť3ˇŻu·:[ŘŔ8bF=ň¶î\§ŕĹqĚD~Ľz“Ő©Ż‰A$ᜲSÝfŤĽü“:¬~ȧ7-Tąk7Ů9ËŁDôeËgvłËř0+95ꋸ–˙©VLEIĚţ5Ł€ÝĹ8ÎáĽ)Ă€±ÚŠŻN3¶ÄT˘4`ÂwňÜ™łůśú[w i ĽĂO­á5ůÖ7úrŚ7VżéĐÍ~†Őý r}±á-ĹM‰Bp'·Zv’Qę¶WŤčŤóŐ‚®ęŠWÉoOXŰC¶ ©%eőEY ÇPÜ’üK±`ŕî%>:Đk„łâißMŹŠ¤•ůEȤjĹéQS×€~÷t÷í‹rU(wFĹbˇ÷Lżłž5 ďeś ĽűTťF©čČŠĐz3A"2JénŇý ˇMמ`Ż™}ďŁŕ÷dmĺµ(żÁ;Y˙ą–ĺĘ ±×ÜŃN®lé¶)Ż×Ţ‹€) ˘Oúťµ0t–Ź“{J AM ÚIC×Ţ%>¶‹.)«ąĂűäş/Ć ńĘřĂjpLë¬ÄXăů-îä:·Đä“Żô$”‚+’‘}§}˙śŇ´Ţ^f,ErTĎ[X^&Ą‹ěÓž>9 ĂRŢś ĐšĘGäMU‡{Ĺ[™ÄŃz–±‰Ëű™l'd1ßÚ%â¶ŇKßq#f¸p׫ůAI\ ě"bm>'´ ×Bnă+B?dŻ›•ĂÍ7ó¤G±:yüÎ%«S˙đˇüd?uű—Eyu,Ä˙““ŮUăŐďŰxRżîűÉdąj‰2FĐLn+áŽ#˙]ĎÔ!ŕŻwEýěČŰ‹‘ĘXďŘVďB7ř¬fˇç^ë |EŃ9°–ż9µ\çvźBđŮ:UŰçľ_rĚŔS=ÝPŚU/żń?R†ńÔŰaää•őĆâäĂ·†?$Â"t›Ň«:ó‚%Î0,Śd.Ź‹nn®OżřÖN+«aú"p% h€¤ýoŁßÄ `Ęö xFxN #8S‘]_’ ˘żĘvˇ™úŁńC¸d—ł\şĐ*¤wjj7ë _Žęţ(駝o´(ý·-ZOšo‘/n <¶' Yd|ě1k\3VqŃâśÂzMžP”Ţ˝Ť€<Ćç(ŕ«ëQt!§­xř˙ÝtyŁjߛך‚‡ă‡Ć†IčYÖ5ŃQŮ||đ<Ř*›źUí[V¤*ąĆäŞůöJˇ_Ť(‘ň†Â1÷ܤąćˇLÁ ăѨ–¤ĽĆ¸ŚÔɢřaŘŮy‡ňxj¸˙gö’—mż±c›Ţő0…,IKu8˛• †l»u‚šřŤď}©ĺ¨B•뢫Ť_pfť}ź›Vş˛˘âiľ?Y FrSs§4ŮO.dŔO)MgéŮiN{łJŇ3ńÉ˙ŢjIşyĽŢđ”6PőiýşŔµTŻ7#´^bž‰”~× –lׂ CánsËžĽâBY‹ÍĂ;›M).qUŽĹk_.úţöÇTÁÇ_~?gżp^^ĎČsLšÔ5´-DčŹ%Ži±9 qtůNüČí?F±€;Úţ»`Ôb_ý3 ™]ŕ[phéޱ>;ĹűéŽďŮRb4féOŔó¸7¤[¤M^wö÷xd—OŚUěW&fžĆEOfu’uNQ§j%˛Xî>‡­A1¨‚úŐ—´ËŇŽ´•i€;ŮŰíź!k7‚źxą4$׶ÎS°JĹU>DÖ»Ł(Še4–5X˘ę 5Yg<ˇUĘÎiľVo9p=ż–Dˇ0sů}ŢĆů¬ŢhJÁ”ő`sdýZÔďŐp+#)>*ţQ• ż¨µA®ă\@›nl{{ď/ÖGj™‘ĘG<ŕůbR)6d-Ú» ŻJZk÷j2™y!ś]ѶĺA :Ö‹`”Ús0ú˙Í*¤ T_ťWÓBŘ©ąwńEk'2Ë;Ž‰ăŚßşdűŘg‚ËÇ1â_üGśhÝgŠ˙üşhľ4¤'5)‘µ«Č!Ú…C ŹŰ`¦ŮExË7«áđH‡}_'řO5ç>c´’ä:éżäéµĆâË výQfŇĐĐ|<ĚQ__É^J×8˙ű†“oyÚ1ÚE uĄ’{4ÖY I€W,67;v…ÓýÓ,[YsďP:[L–II6´ę‚L! b16ÉǵZO˘" §@ő‰#MU5’}UđaĎ´ŕ2~Ň:}ř¬"Gý2I÷]ęŽÖ7Ô¨…{EŚŔ’˝Rw7 ˘ť8| p9L AwÓ\ÓuŃâtwEĺ´in›Áɇ ‘üÁúń…ëSK—Ţźů´‡ß6ęŘĂéä5ÝFç)‡» #áąÍôç&ú(Ë÷Ë6’Űt¤ęc7ťsš×Ëc+–Ş„8Ŕ…Ń@Skż&EŢ÷ĽűŠĄgz<öO¦'¶ó/Pť^§ö5ůlÇäG˘řkg´!ŚúpF¤ üĽ<řKD*öĄ?—ͬ‹Ź±Ř±›ą#Sőđ ¨:ÍŮsF—~ś¦-wŤb9šŹDlő22~Z8öÓjŰ”/c‰ň¬aCÖ`Îdr­ÝÂmvżLńĎĆóăLvŃtt”PĽe÷«ţĐO„äÜśhýŮě3Ę?ü6&ózŘŇŢ@ű%BcC¨ ¦„ˇ±•JSśŠtŰeKěÓ¸Ô Uż†Đ•°Ö˙T’­Ń[’äŤmż"í:•şbp,Xßiť ή‚´ |’^eSłN?»÷nDřĄ…=@Äâí7˘^*{W·źŕş{Žah†}¬ Č X–F[ź*ÓlWaJ|ľpZďr¸Ľ†{]S׶âl ŃŚeŁOváź°f×GĽˇýňŹýQBlz”Éś‰ŃŁîűŃA&çř~]ţLµb?ľ˙±uťçX¨AßßäFĎ5ó7šáűŠQ>#›p\ˬ)Ů\Źźz1Ŕ«żÇŤwĹĂ SÄÁŞ Ě+ľ Đ·>91)Ţ‘ Í–,%±ť%ţŰ ›í¸dZĚ*¶Źş.˘Ćyr÷Ú°ě.)Ç4ţj·ŃýÚĽ¶d=tÂáôĽú%g `ô‡®‡&ł–PĂćy †ř+óMUŮâŞŇ߾ëJúyä/Ćó,6ňą öň%®ö¤Ú´ĹĎ"Ę8ą'>ěŹŮ-NfA ÚŃ).ŮeÉh ›čëc<Ík`ž%eŽ\Y¸ßD‚W΄î.é>e×ě´ŻďÉĆT M”T‡So°q¨U›˛ôrajńµ¤¸_—˛…ŘhĚ7łĆâÓ]C˝\Öômďłqŕîăĺ“ÓÁf÷żi»Ź“©őö”¬ů°ëWaŚđAf4fĐűî˛ÁŘĎíá|Vś€Ńżî¬O­Äs[‰ŘÁź K%Ĺ Ů‘=Ż”ÍŇł =ns˛&€VÁÚ>ó¸fłçÔ:ŽŐ„|·fä*„⪇qµFzM[ ŚP{4Ë°mS膸낂ÜŃW̵Ż5…J+7Ô#:łďżš‰ű"@‚Ş|ĺ´őM@0ţfěv,tó.ř)Ó~y‡×ęŕ«,̧Á{®FŁ4'>ię!`ĺ<(ćÎ rYę¶4°ďĐ×hw§“í̧Í,ŰkY?•—śŃÇ9źć¨b‡Y'›«íg§-öYVţ ¦ú¸*—+[ýU˛ąEŠę]˙ôRaőN˝ěúyç+ř Á6}lĹÂqçeŇŰňŽÚ¤ŔŃĐpű3mzÎźKdžĘSpŔY~pŐi†Q ënŔĚF` SÄubĺcF÷btG2¸{Ľ&^Ȭ:g„˘P:c˨„e…z¦ >ÂÁÂrěj*ă%Ôa ”q"čŤËŮŮyUŮč'|*7¤LÓ¸E·ßłĂä Ź>ú»€|îˡHhťC|ţpĐúŐík›‹0ămĺţňkgc „iÉT]řŕţy}«˘ń•4ÍvË%ŔI6Őťń’ZrtťCLć–f˙O“ĎcÎÉ WŻHŽR0âţ-_IagŻnÔ\ź,ŃŤŇó‡jÜĄ}ÔĂ-s§©h©ŮĘůË5÷îs+hkźN«&@ÁäË3łř*•Lsľ`s*V5çˇÍŻŢnč0tÚ¸Žh$1"äxö͵W×AŐëĐFnÍn¨Đű*5Ź?8źPwąN ŐU•3ë—ĂĹá@ă5ĎouńA®)ŢyĎ7‹–&µ«˛Ö„[«Ćüëî{ofL«ß»#)řńV&`l,DłŻRs?ěąA Ľí9Bi|·pHűg§Ř=/©#ś[4ČC ÷µřěg˘ŽRëäé3ŇŹ‹ô9© 5űtb˙J‡´.Źp} Tl*'„®j:ŽúýËŘăţŘŽ{}ć=*É7?Ű·05ŤÚ°%GnĂ‹€'B©o¤#-ň°¤`¬0ŁmĆ?'čdnŤ[˛ÍWóSîÖcĆŃ×Ó1̆Ňţ óD|Ś~´™c›íÝVś“Şá‰ÓëÎ>ł’íźyżhęe}µľB‹Od=Ň1®iZ ”ŮlĆÎE0±rČm qż!¸ŻVą ż wd‚çw-w§€‰bŘüVvř {öűi ±vŹeT>ŤBA~ççܦ„k;“ařç&9újˇ ń–§Ć˘ÝŹÇrjµź›ĚgG&Ő¤'o- :. ×Xµr‰Xm¬€@{7¤%ddĄŹER´š&̆zÚ Y>é®Âş’d5 €ŕďÄ5Oń0:~f©ž– ąđH±űď+ĘO˝ĚaYď[*^Ö¤Z Iš7ç ;Y“B¸±»YŹGXt—ŢE>{Ö|–ÇŞWKšA±Wü-EŞmđ”ę€{×6*Í9©×'}OŘ{2bĘ‘Ąđ÷˝gň…ÜkZb{*š@7 ř•ź`SŔ·>)o P˙aÄ—í6&!ü»•aXÜtP ś3őŁĂŽX;Ăŕ ĆŮs ââČ­ĄnŔ"Ń1§˙ľ$Đ2+˘˙ái+°¨ĚR9DőzˇŻÚł—F޶ˇČ–!Řů»K9⾌ԳŠ°QŹĆi§™ď·•…9:X3}ÝĂó:yÔ»€ąÁ‰Ć=ť©îć‹5†,™ĎŹÓĐ:RN‘Ćéĺ@Ĺ˙fŁř§ę°ů‰čŃçĄčÖWCpţzî)Nť7M%Đjüú‹©*€Aä.Č{5vrlŚ”$šsBeĽôĘ:Í3‘sęžĘlŽ`68]C\©aAžâúćśĆŽ€¶ć1mŚ—ÄŮ,Ĺ+®Aäâ‘n|'ňÝz«x.9˛>)§ÇóµĘu%I`db{sżˇSČŕâ=˘áâ8U·?“¬ăP‘˘´›2 ďś:OuvĂŔZ«śf©¶ŁFŤżç ˝¶LB1ť+‰Đ Đ)ŘUÚ) Pă†Ď´$„ÁÁš*ś”.{˙őÜTđ/ĺUť>{ťĽĹ2’̡cĚ[R™ž»l%“Dí)Oš– CşBîT"Źy€H·ŃKŃ›l!Ě(eŘ€ŇwÉ>ˇ$G§áçá>}çłň˝ůbq˝@c¦ss=ň"ân·Ĺ›Ý^d÷A…Ă“©Xî¬XL[UP~1ÓČĄ8î˙2ţj­‚\:Ć\˘µ%%4¨ĆMđČ~ž•5<Ě€Đ4Wß!ĐĂéu ‰5e ‡®fî0 «öĚy »”©Kţ\‰vňŐB2+wUöC‚Ă_2—Ô*©l›:°®QŹ'hŕŘÓbPŮŃ‚ľIŐ;qüŹĺŞěYC†Çóá4×őôt!Ä?KNJm]#¨đřýmŹoŻ%mçV%Čń§ě‡ŕťzRÚR˘@ëʇŔŞrmb÷+&_Z˘°U6úě Â6đZ˝W˛ŮčfVÔđ{¸n˛#—®ĽĆŇ—ôěţěŐDĽÇOÚ”ťY>ő«?HXŻ±€Ż’3gzÜń˙Ř# ú¤ü'2X#öúĄůhJŞďě ÇÂşĆ$·/ux9Ę€Č2ĎŃ›ż;¤+Ü6×íPńŽi+täZ‹Lś»!ÉBÝĽŞt%ćé—MN˘eüLžĽ7L…,Ôk.˛i ÓîËI– Ŕvu&*~uÚ?¶\F‰yňŽĺ¨¦ěX ăM¬ L|+f¬­ bXä(p{Ş\m› ®‘Ď i‹<ěuůúŢ:ëšla]ÚřŻĚű“ś™G´i[÷´4ż~p磗ˇÄcć 0Ń´ř(ÂX)4HEâ{÷rrźÉťKv+ů¨ů}÷ó:,ąÍuEďöAµ 3X—\=›:&_w¶•»Ŕí$iZo¨©„!ćŚH<ě‹rŔPâß@"dOËŹ%ˇĂŤU?Áẉ5‡aôr&>‘ŞŇB[<ýő€š-NřĺŢcCt”{i"2ú4)ł Z«\äFŞß¸˘-!_łđ§ÝRw ľŃĂą‰XZ" Ľ˝@“ö p˙,ˇ>Çć.ÉSő˝ŐŇńúř5s_ş-ćé)EŞ]+¤čł!©˘V3ĎâAfÔ23úD ÜÄB4ÚďňU˙!ýh»5`ŮW°žJYzĘů¦~a vwŃ& ăŢf° Őx“O.˘†§ůµ®ËČÝ‹ó\ý„jlŇ™˛BÄKá)b‘‚ćÔT§;®Ě‹Đyć9™Ŕ$~™ů)^Nęg7ź:„ĄXR>>áĎä˝^CŘŇő­ö ”Tąg Lńµ ܱíŘíPŁ…Ţ6&ÓІŇD ŕ-¶řřŇĚU0:“{u¦±tsośFvfSPn’·&CúBaĽĚĘQiiâcü ÉĺâŕŠoAľuś~¸_Ď .u@H0Ćŧ“h•ŚˇpÎőŹßuşAôĄy˘đsŢ€Ŕ ˘#?âŔŰć?ÎKn¤wŢN^ ˘°Lß=ˇţçŢYÂť3„¤ {cSĺ5Ö˝őfŹ˝WÍD¦´k,¬pť“ź !·L…ČS B˙ĐĆ6FË‹ š ĹZ\0s3Łubú…řEÝ•łžĎ ż@y5}Jvo]n6Ĺ*‰z×­‰‚E˘öß$^ixŘvĹ]ÚLçę·Ç[ΖIb%1ź­s+qtťÍihâŠĺňö8çÍ»É˙µPWřt łoíEůśůÜ™O ěî&°4ěĚÍöłjOŔ¸¶TucöŹé˘B¤:“$Jí§őěűZ.ĽŤnÔňXÍk AmŻg†E;qôŹĽEë—ů†#vxŞĄÉ‘€ćפżCçČ<›íüđ—™.­öĽş<§|‡Ă:¦Š× Ą\/zűpÚđjZÁ×™ç:EĺyZŹwbÓXˇ­Pú˘ňf6+Ľ4Ą_ůuđ#Đ•ëRËG »XĘ°رk*Zcż‘çćŹL ř!Íp‰ŰoÖxô_HiŘ%)KíżôŃÍńöý‰ůuR°Śřě‡!¬ĘÎfX(ś2ŘďŤéącĘ„J"xÉ^j]Sŕűő±t”Eź­Ů§§«›‡Ľ®L(†ˇ*‹@žNí ¶‡:_¬á2†˝ˇhW´úÂÎđŇš—&CšH”« f§”dśTbĆÝŚElJ5;\žr˝¸’t7`î4ЧGę·±í`?ŰâfşvpąŤME‘Łť(,YpP}:§ŚÉ˙>™o GÜĘ÷řm8?ý°K<<)ňP)˘hŔłýq‘ ČlŻ? îëtžŢ)ěZôĽi‹{<–] ى»a·N?AIMs•b¤ôź°“Š˘Á]E1d(*Ó`önˇ?gşe•$N^v”Ekű#¨žĽŮqzŽs€qčçKô‡××D˘ń˙Ź˙cĎ_µb¸`µÉ9ëłDK°Éf^«Ăt2°â”QQçJđQˇlvßśť%©ęGJsµřţËHť/gÚül˝I$xú˛Äq6äč˙„g§Z=ĹDtŽâws†ęŚĘa°Ný˘™ńčŘöČîâUŤëo™đ9dO"šE ŠA Zv¶ľöG„ź‚<´4Ü(÷°©éÄC~Ç&"iî/˘‰?´0Ĥő®l`w‚cŻ$Vt}n\Z ĽĐ5§Z¦ăŽ\gće–ˇí¤čś®OHus×Đď^¨‰ŕ˝~–ŞXÉq˛Ą›Ň·É×h˲UB< ˘Ú‹îűąyk4~…dOĄ1%D+9ŢLčÂË.ż_}7N쉶°+x \ń<ßf/Š‘XáwęB‰ ÁíŁŘb8mPá»ĺ$Šu\ŐźĘ{Ä•§^úw€ś±9Ţ2–ÄҸ >2Ł×˙#3‘{ůę͆—ÎăeśYCjC.F©´ćą+¶˝÷xBŇGĂăöý¦¸KqĘéM“ţúXÉ! ˇuDĚ‚K—boPÉX;ĘokZţŢ{Şúh…‚j›ŠŠN‰t®„) ŕű&ÝäŠó§“ȵQ"~Şi8z˝‹6;?]_Ő„(¨Áä˛ď͢î §Ł=/Ą~« ;­{H5é‡9p"¤řWöőŔ˝şΕ3ŁĐ€ŐC±ä2%¸?u`9Ž2‰ą/%'±z&|´]8çXj«˘^ťµeőFIă ;ł@ĽX;wÉţ´Cň7«+¨ ŮnľY˙R^‚±ţâCxëpá¦Íâü“ý•śľBHę?ýgsśčĐ+ßP¸X+nŰňň†Ţ„|ä‹čGŰéâ‡]I.&줴?ˇ,żśĘ_zuĹFˇ†z§căvwLöű ó?mÇ^EŘP8C~ăMĐgşŔ©ÎD‹č?=§gk#¬ŕP{…&ň>ů­źG/ĤŽX"¶ű"lĐÁ"Ş»W.’ŚJ’z9Ž)ˇkDŚŮ–“RŐXëŁF˘*lěžÂ2†§µ?ĂĽśĺ4í˝¦Ę|Đ“µ¸ďÉ˙źTž’"$áK”Ô>E äC[řb—Z‹hŤŹÜµ˘dř¨ Ů6îI“'ś5´‘Á^î$ĹÔ×Ý aŔÄŰ$#ëśvŐNüÁoďGEfd`e/łňżEjsŘŘăXi÷{Â,ń[Zj|?X’Ę(;ËÇÇśĂB»R3€Ĺq Ő-wă6}ŐKíßÝxľŃµÇTn8ën‚7VëŹćĘžqf®rÇŃÉ´Wü6’g˘¸:݉oWh˛ĺ㌰Ĺl\řXśyňZúőzgÖŘçëľôKŰ›Í:.‡ÎŰĆ’'ü±ËG>YTLBDZŽ¶U(†łĂ!ŕ˘Ôľ$7”[$gÚŻ:e#ľ'É{FŁ“ĐĄr*Úî=BÉp+ŤĹ›íه†˘:\WhăkJG§ŃAgMŽIĎ2§ćłÍ-Ěď!Íŕh&Úś0T$Ż×9âÜŢNjن÷W`ţŠĎ6/ŽTś9’–>qő”żłčm˛G$Ťâ_äÁ7¬ďč<7ď_ÔyešĆx&ă_™LšĐvóžřQ\Wk:·FŠźÜîPůšąuńůŰäolĚCQÖéyN"«–<ßKŘ3Ű’Dë‚ĂÚ#ŁÉµ8D `0Ň0RŻzüEPŤĺ±xT:24ô–ů4ńhÉ]ŠliĎë.OV{’Nů ‰Ü´Ń™ďíŘ<ÎŁ©íŻ|"ŐŮJ’ç.U”ĺµ%řö¶LČBED“h1nIX>¶Ć]@͇9 ׋ÓߎF í–ßĹÉ8_Ü@ť/ôVDŚ%YÚ•‘$%o ÜůÖ,ˇâ썤Íú2:‡u¦ľ©‰ćřµŤďe Y•ŮčPÇ“”{‘Í,ßrłÎ\s¸ĄzÜ/"›vBĹY´ĚŢŔçs9ăC°ďBĚZç}żY~đý,`\î2ŐkŻ,ÔŐ‚ń‘6RPEČ ěx«*Čçé¶Ö†Č€ŃclÚčôS¦*AČ­w~€6 `f]©rÜ”d ć*úŹËć:ź!ŘĺC¸áĽůYü‡1\éťh›Y"öČ’.d=Ž˙3?°:¨ŕA ÷€ši.Ů4 PśóĽuM«H 43A˙[ŃLČh ®^Ő-eý§ĄMöGT™ź°:{­6×,BtĘó´ Ťi-K•{d ś0rsrú-$‡¤|<ŇDL'’xšďĽ—éţ(uŐ)ă,>Ö‹öőě74éÎś€”)dÓÍ;Ąn¤źč”„WiVM,ć[…%h,Ýđ˘H`ÇJ·ĂwűqÝsAD˝ąJ9Ç˙Ťľ0…Hy”•®Pńmş˛ä™*ŇŘă«Ĺ %ĺ‹ňVšč2$\ľż0˘*t@ľđRłYĎMşk%źm9ďřs†•k継b›·ŤČçťÍ ^G«ÚwOĄ}ŚĄ'ጅče¬u´9•B"Ř-։ĦëúzÂ<˘$§Ł ĺé±n˝´ůvŠÎF~íš˝č*6&mĽÁ#*Î_ł˝¶ń”Ý‚ť“ťÍ9¤c°˝ČN-ŠŔÍä:bűVŢâłę҇3Rsi‡`\’ç;”;—)Ío¤¨’ĺ3Ţ9ëŕŢăE=4RßĆaů^k<6V2éě¦$ß{!Ř˙ůŹ3ŤšˇŘňŻ\ nb·ŁO€Çs‹:’%m˛ŰÔ1Huď&v{>ă·<ǨËůŢ=®É˝‰ŚÇ´@ ÷Mlü™D_đ,őő—7âp´0őčeUĂöl’Cřäá,‡ĺZüŇM$&dXíuuRjá`ę±:1©1_2oq‹ĂŚÝdIÍţŤvÄ×Îń¦ŕsĹbĐĆ°ĽVbXÝ,rőą÷ă'đ-yA¶QŤWAé|‹y¤‡)ňÖp*’ĽŃëíY{ó_ %\ăű‚+›ec©^Ҩ^wŻeF0P±G şŞ¨ďĂ ţČF"Ý×Cęr¶ Ť¸3 śtu*­±L¤¨Ö Ě/@ˇ*ÝUÔöd¶ŮVttnÇhŻëÄ)/~Úŕ˘1ŕ&ť盇-!n=$°-›‘źHľFČgĂ ś˙Ô™ähŔŤ™"´ě(ą[Ţ‚$…óMµ¶CŠŞ}{szo,·>:xI—á©tĽř €s$ZJ:Kq@ioĂ)\čŐQÔsĚ´±®ŘÇË-~ŽţšKÓܱ3ĐďäX•w`ńĆxŤ%—Ă-•äą:cĽ.QĆmSÝŁâžnÄ]j˘çűˇÄŁťę­Y2 8ĘI滇ÄFkť#ž&ĐܱдߍjîŚ?y×(†ž¶'nŃÚ'č( ¨qö1ĚVs+łoóÓQ)W€ělîţKŽ-ü„9áŘÔąű,d„$’ČKîőÓľ*XBeŁ€Eu3kĄ¨°éóݦ0öB(ř€A cŔÍŚ°ę ĄÜ¬ůăô„,Wôň“´Ůvâ­ň_ ·gšJěç1µ#yL‹Żőĺf$YÇPäu„–Ú]©;›ýţM2!Ł]ź}ٸYé“ć zŐËÓÖ—‹»$ĜȀ}Ď/[UŁ5.…®39Ş<'–Ób˙Rx±ËJsĚ"Ł Ź^mť6WŇ4HuÓE‰3ŁěM(1?ú-ú”Üë¬ć· ôS—ś‡Ă¸•3˘źżň´ř~¤}}űSsÍ'ZÄiq8ΉžĆŠUq˛‰Tëń=⸥ĚěwFcĚ‘ݵśň‹nŻc®ůS„ď®ýrÇź]OH •ˇo§Af˝~8Eů…‡¸i|Fź˘Ň÷ćçî÷Ć˙~Ą\ń%ˇp…¬÷`¨w˝óŘÝ”9ŚH>\c—ŕ3Ífö„čťÇ¨ú w˘/¤Űb-dp4&đ¤Ęđy5ăpc•ľâoÓłUlŘ8çJGŔĂĹşâgF5rň,ĐM:: ĽěĐw áwß–éyL„×S*ć,強ž=k®ÍŻŞĆ2Ł !Ëâ„.ק;Ωˇ®1Ú•@WÔDr‡mąSâ*ăĎvW‡W™™‚d$»ňwŤ FĄFĹÁx0ÍcŹ5v)ŽxĘIçĘľE|R:Š˙`t6Ó ýśIĚp%ŤĂ2R—x™:ĆIÄťÁtX%3ÍůđÄÍÍ#b… “Üń… By ǨëŢŕ°ş§7Zî˙Ń Ű©'Qţ_d8>y- úţćśýŔ-Ô‚l„+›Us’?E3ÍúPĆ J˘-šńßÂŐ«tA9äÁ·¦ů‹wÝŢp–DMřĄ"ŕŕkŞNpăĎR6BÖ®?U:Úŕ­­`ŕ¸6 «ÚG€GéĚUp]Ç˝^˙ÇFBy…̸NŻ¤s d=SqŤ ěŹů,«,ŢBMZ`© Uh}x6ćúHtň%Áżá×Çw6<źUZ…oŹ®ş›˛Ľ'g„‘R`\Gr±žýJDŠČRËęžĐáˇgʵÚ úzŇřź(ń\(~7ă‘Ľe’Fíˇ,·J^«Ő¦IIc‘¬uŞă ™XÜŤc©°)^ťđn«ăĎóCě×Ő 7ä¦üHyCÍĘ••¶^´ÎöŔ‚aĎ_‡čéťý˝şŁ©6˘Ľ2˛Ż“i±ŐgĐ'4ë]cońL¸RDłęî8" ČĎL/RöĂStSĂź!FŤ ě2'Ô*aď/(ŕżü',nJ)_„wŕčl?¦ÎrfV`_7±(&cd|KSnŰNŮĄ;O®ŁŇúóśb$ěßĺCű*žh˙v‚Ě©úŐ8A'¸W0Î2¤ëĘĹH5;JźŘőż;EĆěÄťđ‡»ú;x°""ř»ńJű•w¬ßŐ*08O˘ß˙ ÄČ盯ăˇ5şŘ‰§ĽOkncŃ‚®ľe6˝ĚţjĐ>„9⇰U’†ŃÇđ]·!q ş3˛˝ĺűžßsÜ°hÓ|ZĂîRîtЦAzkT„ô î ß~ńĄKô š„ę˘ďëíR×{;“ îĹŻÇĘHň·`=Ţ#ł‡‡µ+VŰLŔ÷"ţ”1˝xunÓ;@N«9¬ĂňĚą3¸Ó×–¤šÚş˝ %€÷÷hőF2׶îQ¸‚g»ŢĆ©Dí·0îÜjfbIâ&sYś,šd†č@Eaď˝Ň‰[˝˝b~AÁB·0×$2e˛­¦=ě 9Ý#5CLb7đyµj”a ż˘1l ‰Á¶ŕe 1ö­­­ôz9LřŃí’6đ ¬Yo#_›ľ@ÝJ@}ęo¤äY^)ɲŘkŢ/Fńʦ¸×Ą<†S}¤Ť ±şĄź’?řZ´žŹŹÚŁŚäżoWÖ†Cć4Ä‚'S¬±ţ?¦ČÉ éŚ+ť2†!( bŔ¨C®ť›Ş(2!Ňřµ¬ §?żá'EWăĂ"µ¬I.ŕźř:BMgęl˛2›BŽ5¤lR0Î=Íq«% šŘăQ;ŞĚ|ʇdz©łs‚Ţ RŘ6^ t’G䔋 žKóśÖłw[J[k}W,¶ QsR9˝K{wx™5ÝT/śRđčC•ÂJ!…[-÷"fˇÄ›Ćp˙jÎÁDĹ&8â-ľ-Í 3<_JŤqdân´ÉŤ—+@ąŹ­e{ r?­pŃ"5\«×„ÖäçUşűŁ<{ÁďXj»ňăöÄż˘-ś&CE˙qé ˙UÓ‚·Gͱpk éŽô|1•»iű_YCtĐŘĹ­˙;ĎEn¦Č=Íađ·Qfô2ËE”«%łlĆ3`ť÷ąÁ8M4síŐş3xÔ’śo–Ć}Ř•,—¤:/ ‘ŘdČˬíńŐz‘%tëŕ˙Ť5MęĽŔt5o+Á·1Ë›^¦0·p©űR±őßš’Gľ°Ó,¤@•Ötlhü{QDs ˝±e.'+şĄAj•F6Hšź6|8Ď=Hă[đřsĄ„)+§dK&菺tsţ†‰ń‡_—úP–ŃM‡ľ§3š_MXĘ˙ŠÁ¤Š`âbţŽ¦…D3äa>›růP†eő€ýÖb,čŞ`3Upqťe`Vz×Ĺë‘_ਖ|Bą‹ÎP´şUPÇ:«!@ĎÇ>łÖD˛žŽäL~3 ·“-ŞJ}l…CŻÉ˝;ęŐQJ4‡Î|™ęÝUđłžÎ?ś±KDÚ ŕaŹâ˛ý˝÷VáłőÜČŐ-$ŃOé7…–Ü»Iy ¶ż§Çř 墨l0Bôóeż„đKľ™m–Á'AüĺjőŽoóáŘ®%NţIŕkŐ}°1tŠ9–ăüŞíe­Kľł.ätŁ(â%â4R#żQ•|$÷dŹ6Ňś_„&O1KĎ5[?¦ ůż‚Ý|&Ĺö†16śkŞjÎ’üw¬©xŔÓi»)ѲŞćÁĐ˝G±•ć>#űŃ0á—zî'.‚¦ÎÄ›ëPŃи” Ý°nIzĘkśŕç(ęřžÍ¶„ĺH~zcCřîüănąz±Mű‡¬<lĂË“í®úřĄćä4ieGŕŐ˝Á—źO8:<ř“Áä4~őŐ¶şőUŇů6Ăß@ú±Fá_rĽ§¸W|FÍ{ÁZhü˝Kî,0!¨ěnµ| ţ'ĐxĹÎŽč3ßÁLö2%¸Íţ[bÜÔiDPj§Fâfr" o)ď`K„hâ`" 5Bç˘÷®7 ĺHĄTśűĚ1Ęy8jo_™H¶âř‘–ÁYĎ<4Ĺâë’č”ql•Ň6I5-˙Ęt&FGúd(†;Ňî›ă×1źJf‰Ň°ů8aVŞJřÖŞ0A¤°]q™»9+Đi¶®ˇ«ŔZË…ţźíEJGšĽ»Ş [RG  ˘ëaAy˝ű÷ĚmzÔh2Özč’ĆĹܡˇT[p‡xÓľě!ŔšHH’D5b0}ËÓŔÁywÓ …Ľë±ŮůI¬îË ú¬kÚĹ@ÎVĚ#I›g3/óŰSaĚ–%ÜŽJ$)Ők$¬·Ýżą901~@$Wn{ÎČľ÷‘P=m+4wä $q +p¤NÂý‹(SZÂĚ4ÎynĄsÚjókv0ł[’äëÎihkK°Ę \¦Źű°ČŇjK㨾R8Úé”#éUZ—fFM“®])¶4őd÷cľĆ‡Żš°Éť-33¨GËö$@Ä{ľp|ZXŕy˙5–@4áTSýŽ'{Z†"üoVˇ±ĺüŕ ŕIüh—Ź[`¦ó-˛ Đa–"ä±G6`ZoMĄäŹĆŠUÖaęK OťnńćŇA"“ÂçF!¸€MoCţ3)¶CJëěB›ó–WC*BŚs;ĽÁ;Ěź7Îü©ŰĺUÄĚ˝<µł‰’M/b;HĆ˝ó ‰‘‘ A'U©×*ćÁyŽgk°"ĂVŘ-Ý2çűVרB@c“äóŠîT"©8»|¶€ŔÖą•^ĘpÇtx»=ćĄŐ“{Áh}%ÄK,_j.1„7_ů´[!îk´ ş˘v«Aú3P´ňém¦íô‰5µľ9ŇuGëXÇň…ç¨Vˇ°± wä?]kş¤m,˝{ąq«jŠůĺĺë’sýo~T‡oóMÎ+h}°7¦fŔ`ŤCÍŞąŘłŘxcçĚĄµO>ĎÂĄŔ•ŮŘäOiă¨3Şˇ2YÔSý›‹ŇË«ä-»-c{P$@5‡ńľ%ŃY3ŽT>`9{(Ą“(˘ăw \ľÉő%NŰIěgúčиŚ_ľ+.°u—¨ň<¶˘ÂĘím`JK‚[nÚy{n8r“–ôGű·vÖ5‰đ ‚tČPp[… Ĺk~h˘6+#»“xA¤JAĘÖJxą7Ôx{ÍKćYć?ľyť­•'é*r äZśÉÔ|l›C›RA©ß{çľ V•Ýě1đUVF’!Eöi·ś7ŕC/`łvŰĐ#9<^gŃńw7€YmŤ=H¨(V `őŠą—*?;ý#ýnŚÜ[«Ă|ů‡˙Öĺ†˙X©¸í(‰şšB03„·,˝%*‹(ŢÜvĚQȵj„ Íĺ‹ÁÚ}eŕÁ2ŹŢó‰ţ…Îďąr˛˘2űą< LLŇiŤĆé;ĄiOÂsW­î>*F){P‰HEĆEűł'KĆúµ‡zoĽÖp 3ȱąTż`×ĂČPqĆ`~'xyb]“ŮČôÎ#[ĘMbĺ}Šťh·r»ę­ńôžżÁÖĐŇeuCî\áčRV*¤ŠŢĺÚlˇ«÷wç¶ük°s6Bś¸gĘG?'÷ֲ‘K‚„dQéăÇáR×@ÚǸ›­ŚĹ…Mçń ©«z ?PcÇ™˘? ř586©> ‘ëŻţB0ŁK¤ľ‹ŻqńB՛ҝ4ćw,ěPř“]Ů‚sW¶Xň}·břŚaĘą÷'ö¸†ţA,e®#äM~÷Ujó |yçő”ź ¬ÖźĺnDö7Ąš÷˛·Äťś_"Ažň6řFŹ P]1âÔPNd„ż’@«Ď13˝“K2;S ĄMIŘűżĄŞČÂLS÷Ö&ďSgÖ~'Yn‚óKä×/=|ć˝á ścĺŰzŐQŐk =ÎźéÜçöhmXRp΀@®Ď\ŘşĚĹnţzÓ§eň"¤Ze‰$˘ˇcĐŰ‚gKZORh„.'Hăőűˇ5µ”ţĐu®ňÝźlŰŢÚŇ×ăV-4·v›Ä#čĺ”F¶W`y‘+7šîšF}ý9rC#ˬP»8öÉAČHqłśrxö "+µ1O÷”(ź9 Ď`U/;űwx uËâ”]ăúbě›ČĆóôů´+_*¶¬ ŇN ËŹĄiƆë‚ńR‚5ł‡‡·ăb“–ţmĐ+ćě{×ömB0Ą)˙ˇŕí h/:’żCŃŰ“)püŚ‘ňńĘŚ^)bŽ™Ś ™çŔ†'ş„—˙űoÓů¬yś8ľžČÜSëéo*4…|¸ÚŐGH=XLVŢmđú‰†…&^ĺ=(ů˝rJ<Ř÷Ż«ěn/NúŃE8üł-_˙ĎUdĐ«ÍY gŢ–iďîţ)¦wíăéÚJŞK˝\–E“ME ÚĆŽEvb骀C`¤TŬő~MKÜᜱĴ-žČsâá×ývÎ}Sjęˇg˙ĐÍśP¤ĄŽíWŻáVĂůFbĂ?h·âtR~kT>n=6‰µFýĽÜŽ˛Vń+ďhĚ7ąŽOľC󥤟i.pŻ˝¸öÓĹ @«ö›çŹłŻđ´Ś|tÉš§Ń¦ľ\««Oa98ĂÉŠéc¦MŤř•“™ 2IĐÇűŰęŘ‹ ŚDYi$Ľ†€Ą=[?cÎőuŮ:‘4 ˙?–ßdÖÁ?Ď!.ÍÍ˝[NNíŃËžłţ“ľpšO;/i“´i_AęŔ}‰ż ®ŢľÍĽWMĘ,‘ŇA'ßźí‰fihŞ™v˘]Ĺ?Ń °Đ›„tĆĎă)%×?Ů|Äbśö2…RÉŢĂi Óa„Ŕ &;;˛±w<ýŐjl2Ô!ŰGHč$‰GÚůčÝ$‘$Jý%Ŕ\v©±h1?\'?eÄ2W:ą}lŤŚť„Ä}Ň+“î~ś ÎŁO°ŘŹźi0•Ç+? ‹ `çV:<˛xüŃÄČqgŢîmłÄÎ0×÷]‡„Şîäe‰ÝĚy{ăüĆ+»™öbł} ‘-±™„g𠴧概ĆUíK=SťŘµĽ$I}:§9°›tŞŁĹcÚô,ŤÄ*mpµęŕB]ÔňV>śU›ĐwWćjÁť,¦OĄ’ŕ™ť©ćM›LO2Ť˛ ™‡†ĘeÚ”] dW"‰ö˝W´™ Řcš ™µvrý§şŠŹa çújNşAßÁŤűF3Ç7›µ4C‡ŃT¦¤}{‡räm1䤵»0>‰^Ť~zM|ßPµĺď˘*ă5ă<Čgµqm!gO|Ű€°Č•ěj™ZŮ*·Ń$K f›DŮę°çj‰·AŻ0ˇ6pÁůqóľµ{ âŽ:Ëázŕ-˝=ĆÚ.ńűRO3éxôšŚ›čłHŕj„RQb|Ř{ÚÎy’;ć*•5.ŹÔÜĐ‘őCE‡ ‰ýsţ4[vxź«» üCěĺ“ůG’cµYj÷ř_njĐŽís9ˇ'†“[–1ŽŐPÓ““ R[ “ŰVó·LKK¤ÄtYžG|OŮoô‘TXň[¤?łx–2Á»ržíѶ4$Ę6řFërůýřʆ㲴ÂÚ®P¸ü–Řah9€Ř=íÁěěď˙OOY ŰÖ2Ńľ^Z˝ ĚbOP6`¶YËćq¸tşáťŢÇĐ›®®Züd.ĐëÄ+ŁH¨ŐµrT ý•€‹ÓÇMÉžőTGíé"DHż,aT˝?ęśP×ĺĐdĂÉ<±ŢóOj,Câ÷Ö*ÔóŰŠ$ ™(Ä:·ĽÍę¦o@XĎ&{íĺ0řmĽšĹÎJeˇ­NĆyńXÜ[%ÔÎ_€âŘ`ßŐë•ů0OĄ¨ś~lC"ÚÇoű,¨,+Cş˙Šk'źŻ1¦™Í˙Čç­ýO™ĺ×ož$Ü"©m ŮÚ†©{ŮĘhSŠ¶7X™¬Ž Ö!«™ŃˇţÁ–H®E3XŤ9AµËôľş‚•VeLRT6śŃdb«ţj čş'Ô‘Żâ×.?<.¸iúço|bŹ;żČµYf—윢; ą4÷í%{ţ6)z|…a YČQ˝Ďo8ąpăÚ˛ßÖE˛,éĄrĂ[ˇ]١–'“,ÄÔN×YŤôkŃ]$×c©oQň~#Ďî9„é|á±cís;ST_ŰxŘŹ~†Ź˝fČť{¦®ŻW‚¬}ű˛Ű#҆Y$šS­˙%˛>4˙d&OđGLŻAsiŻ™6&ŤęM’†Ű¶ę±jwě!¦ËJ\ŠČPű{5uVÁř:ä@ŤlˇýX ŃLZŚ"t*˘ ÚT»•Ő錷@d^ĹRżX.ď°çy­Ąó„Ńţłoačß4Ň"łäŽëľĎľh9]!AD¦ ˘”Vr6Ö.ŇađXO’qňĘ^âŰA€Qf'"čPOw…˝äł , ąöĆúÔ×ü €ăDŁ0’Ą89 šľŃ7j&\—e|ÎLJ_ۤ^ËŘg~/ms„Ţâe ŢŽź3ý$Ö­Ë{bCR˝_÷±áŮ Óf Ǥ.>Ż§; RÔY:ŇvLów­‰}o+ĎÖe=±€Őá“Ó±WĚřŕµţzż˝Ľ§­»Ü2MLLš@“a=Ą˙ÓDR‚©Ähö˘o“xAĂĚł§`‚x4ŰŐ,·Ăľ)Öń–™€ŃŁś‰ÓfëLšâ&Xó€vŮo3ĐţŃŰFň2caŁššg}=V‘˛ŢăoŚéĄPŻ·í W_ –ŔiSăP_4ł®  9UôC‘MĐq‡ľTwşô5ß^•„WÖl‹%­)[ÇDé|úÜ­l†Ş/;”UŰÂ5+:ľ±F‹*Đ#ŔlŁó3lŞÂÄJŚ&v'ÂN,J¨|´=H\ŃNÎN )W1QŻ)=;'Ţ–ů®°pakńÖ3 i쌝üťŐ&ýQV·ťh’li¤‚¬×ż ßňüÂ'ÎünÍ^ŹLUţ‡Ýv}ţ8Ă$(†gI& ÔĽ‰ŇĂ˙5uŮ?@•Ka—Ić*ŁË ŃíćČŤ“Ĺ6€çSCPŚ=KöéÚc)Ć ř|±B˘›µÎŤ"‚oß@¬ňă‹-˝2-ĎaMF3‹D´đk%ŽyŽKâw­©""í´/bö u‹đxÁBŞ‘E»‚ÜJ|][~›Ä…M\Pž|evĘŽ× Ľěő,šTl Úv Q ZŃĹ‚±w@™GĎ)Ő›żAď·Śůjł!Ë怉ôŤ°Ö"ZxS4vękab H3Î˙|‘jz&fô±ô)e(W:ŢwL4{Xl2ńŞ=q±řq lŁ!ďs»Éw|p˝†Z8ů(á`VëöÔHĐřs ±+Ç^Ł˛ý\¸@@bŤš ZtFx]Pűתĺ{©)x`şsr“GňÚű‹žÖ﬉ISď©˝ąŢµ«ŘÝĽGÎđ ·gřŰ 7ó ˛Ł3bßéz:SŻ9l'ahÄiĺdăc4:bÍűX]°÷ť0ŕŚßË_@{u-Ö¬UĎĐNuI©)ÄrË—ŞiöµÓ=@Bü &Bç‘áIń()~–,¤FŤt'Xnä+¸Ş¤7;TÝ 2h_¸\ńŤŁž#)ÎČ%ÍŚbf4ě˙űú ·!kÁ=ëMC¨ś#ŁŇBń­S\Ç|ŕĆbK%ź[n‡;‰–îX‘‚JFĂŤ1¨ď€ţŐ2WDÍ»Úů^5tš¬|¶Í<Šě\ö(¦÷ů‚ŽçiOíuŇĺ>,ĎnSZ§¶VW„úĚŐĹŃ­îx7cL˛I‘~· ®ĽÍî)Î=xGÄ-V8Ĺ©ĘIĚÓ< ňX/1A+!I\ÜňŇoMJ±sĘ÷ĹńzVhŰţ‘ą—ţ»@ĽŤ"ŢTślŤËC=ŚkŚ÷UÚ[›K@DVůkrXŕňę.Ü䵑RRČ7)Hx H…Be)'2ĘŐ”h߯ľvóŁoúŐî…jWşźÚăy1-–”đ*¨té(č~RÁZh€'5kAśh=ěW$9Ň›4á‡7[XŔĎß_Éz¶űË:Ţ!®}tŐ+FÉ^žgA$QéCF€Kg,ŹË—ÜB@µ"1ö!5ĚśäŐt†sĄ÷Ó~»ż#â”±ÜÍﹸ\¸z~ ď&^ŕ>ž(Ŕ×<0îjpűIШ @—ě’šŞX ŮcXłčšrjôĂ D¸ˇ˝aő¤ ©Ý\Ů·5ŻŁ“_ÔX6­¸¤"Ynf_úçqtî×Ę0RšI‹®¦;ŃN`ˇőLń%TI˘Me8'‰kN:$n_4ypÓz+uü˙Ânî°»yŻDĄ0'˘h9ŤďeČÍÂx–ykčŇŕńŔ÷8+%J‹vçĘ䆢tŕäv)üTÚŻČ÷á:3oS‡ Ę˘™ç¤Ä­Côd=e~Qä [íŁ—J)©f5°¦M’¶Ó˝(^´2ŮíVÜľ¬!ż$ÜtĐŤ§«&ăÚ˙l$rŢU%őô>ťf‚‚-×hN’Äs;Î^Ú~©žř÷ßę.ň}np1G÷דl>T‡0_Őx9’;î2\ż€I\ű" lzôě)’I §dGĂÇFEÚŞÝžčÁ#¬¸ü9&gÄü“‰PSžQĽŇab,·Z­.K´4¤ÉlŞĽŻ®x†`?ÉĎ"Oĺ?=]śż—Éů_!®ŃŹ}ć&Ł:v…Dçť.DĐţt«!;*ôäF(ŚĹTU6 #Ĺ·¸ţÖWîůÄFé©Úć'®{řřźŰ„ú…Ě>LČxßJ™ŞżńĄł~Z§ž¸ *k ¸‹e7o}¬$;ZSŃH0VŇ!&ů@µĺ¤D@\Lí]Ö7Í8š÷óh-ÔĐΠč‘®ţ„ÚŮř5ć @Ś“L Ú—:(“ó”Ř:“¦š°´­ áđ·í+Ô…ăô dľcĐť™*bfŇ©ç&(ÁB=LŘo˛4 žx4Űč­Íţ…[ ł´_>*4,IŰ`_”«5[żÔ&ä84U¶n޵€@ý ˛˝ ÜŃńjł¬çx’ßľ1*‡rÝ˙ŞÉ˝*€ďĐRĎo÷ D‰Ř 2ćuZ®DČ™gć—®|ëÂ)÷uuWŚ×3‡ÉđýЉxË)¦0řćĚř¶<ŽÓ3Ĺ˝/ćň›Ť•*·Î­ăđÖµ{ĹţEBxÇ«µfCĘ=ő®bJ~O,{5_śVf-w™)®˛Š,—ű:·ëźč`#ŕL™•yWäŘCşt)oxq±űšÓS@ië°ÁCÂ6‘0ą“ôŰń±ë­Şáçý‡!ęĐsŕąśˇC š˙§÷€Ó*˝}ŤŞćp8ĹŰCt·ZV˘±¬lBçyoŮŕfČĂH%• ˛&Ň)ř:*ÔŐyŇ#p♍ٸ?8aĹG–,ęě¨kGmÔ´«ŘC×…{…4gJ…#Č€i˘Žż.ôE [ýč´\&;néMRoŮă«pô6˘ú¤Ś¦ňÓŻ\)˛‡féźŢ¸tC'ĆŰ–§Vâ3šŠŮŮÎ`uŻŻęeůt>`4Š8üŔ€PݵM.Y˛…2Ť‡ťť|ŘąP‹ńËhD@Űj1‡AKźăNęé~­$-¬=\čŘSW•D#l4ť!(ĐÜ»6YĽ řYPšúÔŇÉmĆ7Rá{•»>Gâ4e_ZřZW&Şžä/.r°9ö‹%‰gZ ybDFźbQ˘ř…¶"j˘|·jbÁaÍ/XRŚĽ:~WÖH§ĺ 2˘ľEq$íĎ…­FĄ•uŚX^łtŔ{—ĽúpWĂńR ܦçJ0ž'hëłúÂ۵žÂ¸špŞą…˛ŐÄR3=ÝŇC'ˇ ľ*źUŮ\Ĺ+ öĆ9LńŔ¬)ŤTdÉáÎŢŹÔ ň Ž‚“1‡§é˛úÉ̬u9RďéÍá<}Ź’ŰŞÖ5ü“D’ŃƤf®×źJÂőÚkNőŻ^µ€ ĺč>ÄŻ*ާuTc‹c8ó•A&śÇÎ>Ĺsś‹0U®”3Q¤0=EŕűĄÜłĚ°†T¬DŤmÂÓ]q®+Ű[ĽDΰfXßIAGâ±$ňčnŁě%jH BÇŮÇŚł"N®Eř_˘üTţhy”h{›x±¨Ž eX`ŔRń`:2逌ż#ŞśÉäČßWźc;‹^“šˇůK˘hcY=âĐXâ·[Oˇéx*ëbiwΡ¬Ř%%„ż9“Ť~$Ůś®>{bŠ˘9qmů‚&HGégQŚ˙é˝»¨ô.=O´b rN…ĎŮ×0ŻiŞu˘_ĐDm‘™W‰¬•Š»(:<ąT6 +ÇFóżłżlĹ?)™u¸±śŹ‰t TVž™ô7ówę|÷µĹ7¨%ŔÁňQ iP÷x±$ µüűť‹2ËĚdĽCX˝bŁ:öŠ` -@˝zĚ)_Ë8‰°¬qVnGŔí±pC¸!.ţÜŇ)ŞWŤ™Z5ĚŁN,…–ć‡>?0…łq܇[7ą8¸"ťÝŽĆX¶N ’ˇv˛FĽm(růlŕ9úě+đDŽ-#ÄNoŃŠ.Ł´ŹĆCgŠĂ滣ť*FNf%ĆÎCxŐ·a_J°9ó/qQ&SÖZŤ_|¦k•Ţ1Ž¨˛ň¬`VV˘´şź}A†AĹ$cf‹ô»ë}·z<Ä'çb»ZŇŇmj8 {ŤĚVźdŘę&w=Fv‚‡Ř˝ţÓ{źopš˝“mäŢĘ‘†ń‘ŕ;ř+\®8q›Ă\µĽÇĆ:EÚF÷ŕłSC‹…šÁM§‚ďÜ+57€ĺl•f÷n—ĆT‚ěĂa…ŔPKs缾y"ÚĂ“öů7=ĂW+(,őńŔ$ŘŘŔ·U0ŘÉ˝·ňcx?ĎÍĺvńÍ%I†ůľŽ¶ŞQŽş0÷’9ú&[ú˝±ů*~-4<óĂÄşú‘NuÜ€a2Drdş’Őóv)Ć ¶Ffő”f¬•+Š &‰ťf™}5'DŻ†eű÷FˇŹ‘küů1„ ŞW6°H‹Đ‚«/kF¨Z‘UŠů™aFŤmrÎg'é+=ňlŇŻ°™Ařč]^m‹[Cč’™đ'XPúďĚžpHăp3y±Ř%QV/˝Çkh«4Ëe‹1M¨Á-Ƕ=#C[®&QôŹÓŹFâ‘·ľŮÜ#Ă3M¬˛ĂHeIąodvĐ–tľvĘš\Ä“~ŰĄÚV¬­Ę˛íoŮA„aAPÉĽ2¨bqAÍ{şAÍ௛ěŘnźĚ}ąG S0ÖÜIśśÁ·rĐ(3˝‚ \6ľ®rűá( $y"gz§Y.B!š%Ş­–<‹B—U>0~ć±Âę±5$ľ” Ŕ3!_ Ę'n00Ż{ÁC*PUËËŞ{»YĽ¸¦5 .ĂŃýc•~źRŘzżĹŻ}_o*5ßärËé™ěčŤQ HÁŹ¤T¸DèţČŰ0¸–:ć÷ž9öapřă(~x™¨h»$=X·w¤đ©:ťÖ™˝Ăn%cȇŻ€ylď¬$´ĎG€ Wćů‰‡@heŞŔ,X†]Łh‘i—AÂQ™ě‹¬¨âU5>T’ŹÇőĺ%”9kLbO˝Y› P˘4˛ČîŽm@‡†´ űă6©]wřÖ}h9Ć“*ż»í*6˙1Ř”ćłfWc‡`iŮčđxčbp«ŕ]čŃĐ Ôż&¨ŁĆű´u°•vđ!gyđNÚ§Ú^€pA„ &ŐűĹ5ô1VŻĺitŽyş‚H'9ďí‹b!*™;Jńă 2ü>úر Đ;g)űLĂŐ´iAčkšÇrŚ=Śś»9?­Nz t¬8úI:o-ä:YAŁ”˘}ń—b{S xCWĽĐśĆ} 2[”¤»G‘ËFr†ńţ"ýČ`zýâă=ÔräĺLa3%0ç™bś’€Ł=KSő÷ŰáńŁĘ€µ4“ěI¬i^!Ó0›çĆŇ2q‰W­GbŚĆkt•’?V±3:äx{ bÔ㥷 “^ZĐm€Â•[Žôzü-«O«ĄĂäŘ5c• W c@‚ÂaBOCăS”În~u™Ĺ kZiáś÷$út:Ł&˝z ŢŞ;+˙ČŔ T^üÍë™ß Üws¤Ĺ[k˝¸c_Şěx»w ą•—ŁűIçQe«Ě+xĎČ–şgę Á$Jh¬8×XéńłŻűX˘Đ-"ŹÎ}ąŞ5§~,«ő4Ţ7ŠH"RőA»“wPŔŃڔ˝0-uZ“öŞăďa… ů¸úŮ´î×eÝ]Á(¸đ8{ăĄú”bĘüĐßŐÂK‡[ĹdjR­˝¬~l?YČ҆gyśJU/őé]¸kş ó:ÍŘ…ÍŃ VůŐĽ˘x‰·śÁ+Čü Rz'ĎjÍĐ fă…zÜ1›»ÖäřjE’W|V6uť—!zŇď6FW č°bäĚšşň}··ŔS˙oőéBçÄ.…ńŕol†qJ‡ľţ<‡âÄHúpŰ ]U‚‹pÖć9ˇLÓ•’CűđôJę<áZu·.wFqk¤”·hĘ'ć?&Çęę%Źżel¨Ęd—i—?ĆÚ tż.§žv¦ß`¶Z´’ăl©ťŕ0wwŰ÷5pĂÁ]6xÜg4ťpb>"˘˝}ŠŃË2×ĆJq6Ďî ßW,źËľ ]!ůîdť®5ü~'kwIş kńZ‘Ąs§ÇsFÄNŔľů‰Ŕ@Et3t Ęž:×€úř-1ŤÄ(ź[YŇĘąĎJňˇw’Db¸ę¨{˛ŠąĄŚIJנˇŞ\N…G>üĚjW‘ÇÄ;KÁŻČ^zýáÖÍÁ\áó<śc °‘ţ`şÎ@ÍCn5ÜxP‹ăeś)á5S@'ayŹYŤMÇL~Ůôá*ň_ÝčńËz1{c5{ĘgĘÄ/ËCµ_W{!ŰâD3PöĄOÝTŠď‚Huµ|©ÔôGk—7„ą©!Ĺ0ůLBv©Aá·…t'PŶuˇQÖˇíVëŻö@qôD*†˙ h4Ë›S0lIŤU–zÁxČ6_ÁW;6˘AŐ řx\9dŢTçĎ>ţ¬/—™F2É_+“0¦g4­TůĄť/ÂЉBwvś g}Ó ä.<Ý5@Â\gdb˙ĺšQMkČ.M‡o”gEë˛ĐĚ/§¶ó[­dýńsóB%ŠđU„ŘŰ fY°NÎń/q/F5'Ś†fŻěŹ„JđŻi*ńšJeF‚dŐ×Í;Ú€-ăŹ]á2Zá X6„‹ËĎą÷SµA-¸śş÷·Üçăź57Ú\BĹąhLCîu6Ł~éËŽŔ­:8Ł–­Ř!ĽˇKq3ěÜ)_ö˛Ť·U8Şx:»`«;@ÎRb· Ót¤:·v%luú&”ëi#§˛2Vv\*-˛÷9đÜúD82ÇűĽE˘fo čĘ'%™ "]+3lŚs=)-ňF®ěŢEN=}ÍđŢxŽ…ÔĚž»aŞ[ÁĺˇqĆ ^ŢĆ°h~Ţx&ň˛3éÖ÷h÷qMč˘Đ'‹öÍÓ?M Z˝ ąYj«!ůßŢ z¸ ¬ “+”ÍXrRRŞţÓ=ď ş€‹†­•–«8`C×mŃKČĎ{ŰEËrT5îŐléĂ’aąö‚˝kŠíń1¸‹±Ěľ´ťąťŠrĽ:öělvŮ3P^^vFL@=4Ź•ňő…8MúPE™Eh^Âó üQł`űŚ×ŻŽ„¦Íě6őP[~­~€|… Úćz•k­,‘ěxȆ+}é˘UťĂâ}bz.íiČD>Ž’\ę"-6ÉF€eąĘ»Îę†fá oŻúµ=ľáKVMb.eŃ6özuźč%‘7¸BŃÓ˛•Ń˙Xo\ĆímJÔ.ÇjË …ăÁŇ]ŠäĂüŠbÔ1@‰ä Ç< ‚ű‹A‘}G^„j˝RTÔč,őőč˛÷¤w.ţÖ”,Ő"žSę|Ń)|9câ.őě;ŐNTo M˙ŕĽ]ÚÄ#ĐíĽ1"ÂQĺF!Y·&tÓŮÖ ·_ÄB«_¸Ţ1׽˫OR;¦x‡{K–~ĹqnM-đ•îŤíçe·ŐIńGŹÚžT/!ß)Ůfo(ÍśŞ„ă ĎĎäÎtZŹ'ŚfCl锼W $ŁSŤ‰C˛ż«€Ůť€Ô ⬓4Ű;:ěöŻpŽ ™ŔPíě¬RŰyŮ‹Ó„ŁM™m:Ţ~ŚXăuÂŃäéČŐńÜ«¦6Oî«6Ő;• 0*ČĹŔš”čŔ3ŁW=˝5'Ě5ő ÖÔń÷xNî|? ôřuD^2‚:;Sa`qÁtÁ ¨÷XÎ ťďŇĎĎ˙Ířř—Ęź{Lň¬fÖÁ‚8sPiűŢ7ľ8ÔeÜx„›‚Ŕ±çÉŇš™ÇBm‡©SÎ2Ô&ő0LF˝Ű żśL ”Ç&ú\ ŔĘ„Ď;4óŽ•Ä]h›6á6(vZ7yéăuĚĘ°Čę.$Ç„ÍŚ×' –¶¬śkř’łŰȲˇ‚u~ˇ őßÔL"rTýůÉwđÔ=¦öyůýú©J­đÓÝë˘r%oďBĂă;F˘ŚĆ€ĆYĎŚ«&Yţ„-|đx°Éh`JJZł/0ÉR@aÖ>}ĽFđâpĆřꪖĆr˙yi•VEŻü4W媥dîâ“ZSÎ_đ¤ Ôá®lÄßĎ Vóqîđ˘)E(Ňľ”BLőÚąďĽá Î%Šđˇőnń4űI«“ ÇEŁa «yň×ňgÎ]f˘š ŇŚ%ö ~¨BpŇ‚‡ ‰çđ¤µÂ˛2/áb™ť™+8s‰ěžD¨Şż„ntD‹!ť6‹ąÁO…ßÎőXĽŰ—jÎÁ ŢÄŤR¨(XŃŻ˙GľůŮđąp)÷ô%q&˛3hćÄF×lőswŇ;y ć˝?oۡ%}„Śčő®.=Źş4s@ ­ous„ĹSšG:™™Ď>÷ 6ťŘ˘:Ä„«§<ŽÓ¶´,śď–Ľ‚­ă«ÉşĎăŕ/6nJć„ČHqĄŇő]…3ľÍ1ÄŢ?í,sŘ~„Ď7ýKěéŮŠŻŹ˙óÂŞE¶oJ¤‘ć’'÷Už·aEżeť‡ŕiöY0vźrzĂĄ¬îął(Ç×řčMs9V5¦UÚđń1˙‚\pÚ@˛]ň_Ü ˛<ŞĘąko˘ăš>˛ ˙ Úń$_n/·żĘ!Gőíľđćq’ŇQ1ďJĎÜYb8'·†Ţę?ND®z®,]ĘWŽbčşu˝gäré‰<ŔÉQě=ŕs2ľRňçČđD-ŽrE2÷fą<ľ?đŁ`Ů·ŮÔŔq©ľŠűq¤â´ˇâO-lżç¤Dq~¶Âq Śşď6"ćíjbąÂ~ËáŐÍŔyö±>¤Ę -BŃbW3R­®˘ĎU÷ TÂ%K‡Š8Ĺ—ćSŃ(]Đ6H Ţ pKš÷^–SţÖŐ–)$ O†¨'‰ŠeÓřRžŻŠĽ`·8đűŤŰ1)wŔ´żĎ‡ŕŇ°( Đň&#bŚLĚč1®ÓŔ¶ś_ 48Řhł§âUüŢäĄ[Eˇá ÔQĹ_ý¸)¶ő e˛X_E‹Ně±ÂĺĐlÍ“ŕ/7ŐjĆOŔ1°ŞĆŚt&ź.]Rb ­MĐLúŮ'EĎH '`×mJn6Ç4¸hH×HáR źF!•*éźĹKŤ–iY&'Uë„F1šN¸"8b {áý Qńţt/†SÚű©űŞw’VÎÁźĆň=Ü^ßBţčHtÁW˝8—{l©lk›sč G¶? -÷<Ě3ř*#'~“\Ô˝Ś+śŞÂRgĹ×ĘŰŁ łf×dk,'u˝ţNď&±Óu“đ żĺ?;Éřl‘ęćŔíOšší_E?“ŻpóâR@ ŃŤAô)µRiz×vQý‡©îëó uvšŔOR:ŢĘ{%śĽýMł ?OŢQ€®±IËÎM/?bQ|öMÝń­XżşW®)©ŽźŐ¸oĆÂýµ!V®Äá'ő"vˇÚi9z ô(ś4ţ:Rt‘˙XIŤ”´ě‚bţË ]ňô†,ĄÉęÇć/zČ„?°ÝOMĺ=Lb\S slmÁ”ĹNF„¶yIM%ŇX>H@KĄú»ÔŰş‚ľÎĹso-ŻŰëŇ€Źi ë ś9ýt…R]Ř“gŞ*X2šs™Ľ[PĚHł/b5vPa×ôöďĂ«Űg¸iŢ'’>§ö*íđ űMŃP:BIVNMĆţČ4†’Ď>¨ĺ‡‘ˇŚł\ÄŠ¬0óîZ©6Çž™‹úr÷Üă 8† ™˛'ůŰ ô”qÉ·/)÷Ä%8=|a=Ő_RZúSµÝGçŁ5Í®U·i'.ŇĐMvá,mrş+] Ů…—‹MČQL J¸c23©›vţ ťe&F1ĆĄ|¤ŔW_ˇKΡ Ö=6f)f÷4ßÔQ3šMč(ăkŻ)IÜ6n5e |ý^4yT©µ™ů«…¤m{ßú-I*ËžĐv7 ĺ!8éDüĘĹ#łĽSÝďÁ=5‚őç)ŻŢEílíÉz1¸řmŔ_:ësŐŕN`îŐŘëł9Ĺ5 ů tĽ÷¸%gjŰ:kű‘ĎľQKôÜá+Heâ*žŕ¨Ëőľ*Řů–úŘT#˙Şť~!@(Yš43%iŔP^– ŁßLzť ČfÇ7ËýS5a¦*âÎ=s—\˛JR˙ďŁ]ëí :źK^ÉpŢ_‘GCż•ĐţŤcYĘÚĘ:4Ih¤µÂd–…×DÝBęŮă·*Ʀšµď ˘Ę¤_Ľ_/ëgöÉ{ÄŮ„÷pظ´+JXşý”˘®Ny ŞÎvÖ´É[@ň:¸_ýuQs.rc¸°.}&1”'‹ŻĂáĚ šÎŚW  ƆaśĹßďög^¸ćŔ5:Sţ˝RXWőúŽš %ÓŹŐáű‚9ż±a‰Ă~z~‘a0ä„<7SX ŮŐ˙°Í Ăw"Ě|$™‘zddD­«ŞlńCiMŚç,¶Ŕ=e}üž×Ŕ¶“drľuGpvëŇ:ylmƬŢűĆCZŕî1%—f…+×!ž»óxGQ-Qłö>Š|h 1±Đ«yaTϸ?׆µ›łĆYÉaÁŘ˝0Ď‚˙Řżz÷ˇÎÓçYČ/r`SÖŚ˝DE:ĹŁuý¶7CŰśÖx׾IˇXć:5śŤ F 6vRąÔ?}M©T»µŁ>”ęQ^ٚ˟˙]yĘY¨q±|ŹZ ­ăH (V˛üIu+[íĘĽ‹8ş/5ĹŤń~xÇË`8éĂYÚ,Űű!Ř›šëĹs”Rgţxţ™i|o@Qcâ%ŇŠ Dî[Wŕľ?xĐ‹ćńˇÁĐ –†{V/Xâë‚4â/ds5‰tCWg Ű”¦ŃOÂY>÷8đô±ľgŘ«Á©ç˙‡-gbIÇ;eżĐNžś‚cSţJŠFÍÎA~ÚÉZm‹Ńă­ÎÁI@âŇřŁĆ»­¤SşuâL}Ń°0Ţ„|.Ç€{dě#Ą›Î['QzÄ tv˙¸´Ž®Ë¸Ă*ô˛3ş“}…˝xfŰőyH'1ăvµă[ś|…ęUýh™€„q펣dúr•0†ĎČxóMÁ)xíč†Íä řŐX‘\D ô/˘HrjđRć?0ď.đ©Ô]ç7§ śţ[Ě{Yj‘żF¦ČCÝÔ¨@ńhÍ°×Ă\Wšdâq2şŠbcŐIżj™ ŮĎtkŔSÉí˛ÍńŹç˝ĂčŞĆ7f°ĐQîҨ‘/!JFĘTÂWŹzU‚Ú ‚I‰OÚhÇ ęďGťbLŞ‹ô†< ɢ™‘ń ďuü°|uîŞ>d6kÚ" [®ďµ$. EPŰtăö—Mů=Ëş§6ŃCú@dklŤÝć™Z$›9W°FIöÖúÂMŞŹ~łáĚÚôĽÇŤ8¶ sŘÂ˥ŵvĹqË?«ŻÜQÍ»ouTłÍ9g Ú*$•ÄF_¤îmQ|S­šAŃíŘËdňĺC™(ń+$pQę+ů.“Áčü(˙I%p‰ÂjM7 2ˇm@?`Í]ĘËĄ_ËfÎĺ• čzłetĽč§:-Ű”÷Ë-ZIlTËďqE:ε7ŻŘÎŕ?źăZTuŔIa=Á2áßßŢĹ ďĂŢíąą<´Ĺ“j÷)§2‘jšč ě ʤéŹ ž4Qäm7;ÖJůFľĐúÝ ‘-erjţÂ'›]Ő›7ŚC8Ą Z^Şě2Lł^*…C´ö¬A!XŐ&KSp°÷čw­¤Ť~^î)#˙/đ@ńJ4XŐŰG’ŮşĎc!-€­ł¦Űřa—¶¬Ńzbâú˝¬G⊷tĚ'‚ŕö‘šyĽ»’]Qp߯tňňóú?íä<({•{ ŰÁż0ÂÜë&'„÷ؼ̵S 7.{¤Iŕ\E0ß4RŢ•”L‡¤\şÉÉF¸Ö7uÁ…]yMú³;éLVś–°Ţ)ˇXž‹ď(ÉśYŽŁĄ¦Ť^Î(ż}TsĺăâTĂą\jvcŚ…ú®cݸ´rß+Ţ×bśţĽRXĹřX„hoKߌ0š ˛·*ščřmň<’¦6©Ăżf'đ đbGYÖţ ŐAq¦SzÝhעžŁF˛ď3¶¤.x¨×µX´›1Űódčn…W:m.XQ"צ‘í^čď/í,9€|É­ÍyĚÓ«˛ ěe—˙XŘ–ĘüčŔť}¦łâćĐŕ/+|÷ŕ ='U—ŘČ'(z®K ˛„ŃĄîŚë >ţî&hľ0űLbg9î7*ęžŐˇ¸Ź,*ĽŮň±˝Óz\ź<˘Ľ 6*ç WeŞ‚Ů€Ą•çßKáöXýµOÂJß—®ą…„ô*żŰÎŃihÔεŕ(†X§›.ĚÇĚ´&˘˝¦űú7O&kËăUšg+lź¸ý9”f •^MsŘ÷gȲmgőŁâ ĘŢ˙ę8ňć]“ź ÜPőęŘe鵌q-AöľÇg®Y;Ő ňČ…áťş‹úĂcě˝®˙ńJШúm…ŃŹËrxôŢ&Ľ 5 Ö3a•Vt}"Í(8ň.Ą“Yű¦ţŰţ@ls†NÚŤ„!ľS»Ľcˇ'cK™Ł YŔĽ‹@tâEűŢš…oĎż 4UČ!@1ëë–Jalá̤B‡á 9w ŽâA‘ą ]Qŕ0í2ç{„ňc7ë˛đ5nr~ôďF#ć<*Năw±ší#úL ţUxţňű^fŞRÔÎfŹ6%Üw‹ďSŢ~˘ÔîwŮ’ë›v'‡_‹Á«%îN€†˙tJyťtqřÓü%ä_ęRź•5× Ţ<|’†"Ž‰«É4döv¬ôÔQ;…Źůóo„ĆžO éŤč°ś'yVéŮř2•ëąřő â9 G@;ýÂ.Ceč5®$V†Çe~řlăZ±¸NÉ:M °‹YW‹˝u v÷cU§Ö6,żŃ!P;îpYÝ.ˇHw×=«÷îIĎÝĄĎGăé‘EĂ€·[ÖúÓw˛ŁźňŹ‡)á Ń ĺ­fxĎZčd}~äi˝B›Ç{Ů/8+ őŻ/•ś)†Î…Ě[w}xß~¤<‹ć1ÔB pبֿ€Ď ŽM?UÖŃî_´*[ş2»×Ď^yYLIž´š®Ău"n&­‘źđBń.Éͤ*ȬB—m8ŔéE¨]˘áŢhÎ- uĺ8elě%ůśŚš ”3™s"`B,ęe9üĽ8ţ[–> ŐűŠ˙łÇV7ßÎň\Tç™\“ú¨°˛Y^«ŁĎÄ',ÂĽ‰ą)?î”[˘ `ő§3. Őn}4Yî÷. %ť˘ˇş]ÎË`ĺ Ä%Âőýo[ÜŕŮ~!uň„CĽ“ľŤLďŚËµđ¦YŐEhoăôŠ’mSLFí|˘Wš>/×ćŐ{„xÚKbGOň ĺáŤý/O9|ä{ů#Ţ˙~ísŻCýŰő2Xë™Ý6ŘŚűQdˇâ“˘˛ŹaƱ“í‘i…Žęg¶ĎBŕč:ý<©Ű$q?ÖcěđK›aa2vp˝(n|rHCÔvH®-Ý|é mLTq „ ´-˛°xcPŐF+sDÚAáé‚ŁXHłDXYBî$˙¸\d1F_0:čNÇŕ™ă±PU©|pĽÔ~xĂKšbt @'­ŚĆĺhŐNŰ#Ż(‚ť+ş”NX?Ť€D°ě mŁĐ¦‚ äřŘ4Će1qýŃEŞírbSĹ'čđU~§­I `ěk¨ŃażeKqł–ĺšR‘¦Ç¸ö±ŮĚ‚˛XAҬRyŃăQ%3ĄşA¸©5˝s§Ăěą~9[˙ż0ń`đřĺ< :Ö¦6`ęűćýÍQI©™Z<žy R߀×$†E h©zIą€Źá áóÎ?>şe'®UîžMľËŞV…nŁŐ’$Ąôż§T%ˇçŽ =ş%i9Ě?íWKz´Ę¦±Y¬™9Ăq<đęVF˘Ü9ĄŕöÂ.˝lG]{?®t KďŮ0o`úg%łç˛€Í2´äąqPgĘ€ ü Ó˘4=Ôµ×o,_µ]­múJüVEš-łnüš”ŕ°Ru…• ŔYKŚdΑoú…óřLĂßĆŚoŐŢä™L®JhN3ěâ¬I–)äéŃ‘HK i[4äÂO‰ ‚ë OďËžŘŐáĹ3ňáż—M öFç˙ŁLŇE =s1#*ăXĆŁ€Ż˛/_µbd5¤™¶ŃŔŔ[Í4Ű˝ľ3Dg –3¬‚ÍÎé)Łű3ę×eů7=PÉ ý—´řÇ°čR˛oîF5Ň^ଡ̴©ązÜ“µOć‰ÄvÖř+¬plĂĆĽ˝áĂÍŠóÉČáç®mEYę8Wµű2|·ŹťŹĆąăĂ÷ĆĄ9ôR¸·Ë¨xŚ\…¦‘Uď–^xžĽśťâ7íj΄ÇWN3ő›Źý®ÖLĺ'§ß$^xąęŕÜŕĐ,b‹¶Óú9şň7m ĺžëŮ„‘NE}* w6j•Úâ‰)»?í!^eîTđá>a±=Ă1yŕÉl! Y 3»Óçż4÷ÉÖŕ&gOë‚ţ…7-ç?5çŰžî"™!gĹ8d-±#i|˛„!»2"¸šŰëË„„×ůO«˛«Ü{~u<ĹřÖĐß´iáCa®ęč5ÍâwľŹ92eĆŹÉťM Ľqa‹7ĄťÇ ËŹ˝9í´‚¸,é†ÇÍ„ŕ}Ľ[4”ĺ:ţ‚śÎÎţwëIî©.¦»w)üŞ‚Ö‰±ĐľQ§Úš8QAćj»gm˘ąiť~°î¶°&2ë Ňľ­ˇ~ż7‚2vş s•*[÷bĄâgMĚbŢąć|GÚľXm:Áţ řŰ^GP¸Ů ´-Óě¤ěnâ[«c¤„zz<2˘„j79d9É:Ŕ›.ú©Ż7Łű5O×ĂRÉxőŰË‘[PŽ‹á­rme€®V&ôyRIŃŐ¨őSÜ°]Ž]ÂgÚ!Ägëk#Ny’˙ŹŽÜą˛¶żV1ęeV'×Ŕ ő˘ëÓ±kp©őŢ˙ĄQ}ĆŤ tĘÄpŻţ» xÉeś•Í”¶3Lű`¤źµ_»ldÂĹCćĘpvŞ—ěÓ-,~J9_+ČŢ ”QĄďşjť.x»Xů8ć㽬mŃ&sź2üŐxČîx‹]ó#MluĽŕşÓ}$ ‰ËâËƨćí¶ĎDµĘB…¤ď™ŁAwř2DţĘáM]ŕ­ÓjÓ䦩T •żwrˇű´26i=ŻÔ{Äd©)ĂFÉÚś”`ŇĘóRţäąúĄ?†ŻÖ·32®Lß}Żť‹3ú`¦^3oöUYl<ü ­Ď ŇőĺeĂ×zq‹TZUIä†ftVěoëţ}¤_Ba÷â ˛Ĺâď'ţ$Ë›C•aĎübfx"âŔŰÔŽ CÍ 'زغ¬xT°ÔfH‚N •RđÔŽÂ~cĺéSőŠŠţ[AŐś$żˇé®v@ŐÇż¸uţˇŞZ†0UĄ š¶45;ç˙gÁ=KE°ŞĚ˛8mú<ÚĂ>W'wăx)ßóG„J[Ż'5C`U3ŕ,S|±íŤ`ąČŢÝÝ;Ö™e»°üź"‚ś‡\mFv6Î^€>O˛ós…uW'ŕZ‘Q€Ą´z—ˇsYGŕt_MčŮ4yá™­Mf9Ě›BiÜÖ{ŕb.`©čUn[:‚ĆŚÖA‹‡´?Ęá —“˛vLô@§Bă›ý=e;&cŰ9!»Żf™cy“ĎĂ`iŃ÷EÔ¦…„-=ďţP ě{ţí> ŞT$‡® 8ĽĎ†-Xť)Żěb}Ýń2ÔeźâxÔ]ćę~ľ_•!™°é°]u/,¦_•ŢDČJ ˘ąą5D_ŞËçněúĺvZĘ^×ksF^şçđĆ~÷}‰o-Ř«_ÄŁ«•¦5Zäň ŰrÜôé ]řľ‡‰6ĐH©IźPpEÜ$|-° áZJśËőG‡ĘdĹ­¤˝˝ú÷…‚?Ý ä0Á`„†íLço!1ŢF‚Ó„{(rŔ5Ö°°/8%ÚŘľż×x›Ĺ™-Ö±päg›×ů˝RŐňĚě˙Ş0b^tţÖşvÄĘEÚŔN­a@†Üb™ß,É)WÚ*˝9ca'+¨B]ňŐ±óýĹđ© űĹňiő{—WwůĹ3 Ůý(䤑|2ß]¸››\şŃ1s6CCOlěLśĄQ“—.¨A›(Đ^ Çr5ö;C`čujs’Úó_¶łü 耓ŢDăŢčbĐ7UNŻôĐűv<˱¦ş*ÓźČÓ1A)«Č|Zš_j÷ĆÎňÓąĚ*{n¬ŠbW?3 ŮGWä"¨ţ ¨N±´ÄŠ.oˇń˙zÖatÁ˙†˘µ)ą0…ÚŢ[]P#ţžĹ§Ě[—GA{űwˇˇËN±™Ë­šĎ·Îľٞ‹đ”#kt©:4âqĆăvĹ XS´äŚ,ÓPA :°ÝAćŮ|ţ<ß‘7ő lZĐtzăĆ-.Q‡×5fýAă…މwéىnCŇqQL|ËÚú6ĽŁ‰ăÉŐŻ’źĐĺ¦ÎGĂ÷›ŢčĚ0˝MđÇ”dCÖM]ý\ĂĐ÷ÔX«FÖBđ±ÄjÉXĂ—‚P˦´,ń$§©Ĺв ›Á.ľ”Ç%ö”ôÔđ5 9ů18÷–#Ł"ăĂc~­~ÉLÂÇ{E _r°çö¬—`Üíď⿲뵆k[©Îhž©¦Ý¨ŚčÍqÖâ%§Z“ăófLbIM–ŮžĂX¤“SťuE•`ĺ9Ś†VúŐ}ó !NPë4҇Ľ&–#*Á4y»Ň¤ó˘2ÝUŽ>Ş7iwŕ§[ż•†yîpóŁh.ůÝ™ŠĹ:–T Ók…xŠĺ‚ţÉ\Đ űR•Q‰Ç„Y°IMGŹťŰˇËěfťł˛~[$ئđ4eđöŰÔSű˛€ jŤ•C7;ÓŽ|4ĹWŠ°F哤r>'évI¶h"Ŕ‹Ľç•1»htŃa¬ĺ­˛3ş­Ťo{V^|>IőmµŘQÓm¬rďłMŔkŰoL{Ô%™1ŕ—•KőQł-!.Ę€ŇŇńśŁŁłÔAHŁ?­€¶Đč&ävO®âOń$k/mIĆo)č5 ŇwF±;ZÄGV?¬Ëůăş1Wv©%íůé—~[y-őöqKŁÖ¤ŻúÄG&Kl—ÁĹ_˝ ű…~­Ĺ÷˝PQúmí·qäŔüťłÂ9·Q×ÔI ĹÝ |­[E¶}^>‡{OŃryÄÄ2űcń°ÔÄ´6iťa‚‰Y)ÍG‹ÜĚoź!ĄĘ\’U/^wńU yüpăǸ ŇzŰrÁšoL ×…Lx؆1!ěÂ)C…lĽý¶€®ˇf­s•PŁÔm.âTćëĂP‹}ň`u ·^tBG®mË#ŃçMµ?íĽ.!17íqj Ë#őBEü‹ĚT©${ž1›Á ŕÄ pöĘ™˝§‡1{xťę?üi"„˛SŔá=«U#Ż˘:±€hpľŰ¬ТĠŽˇŽ3-×Cť‰!şą¤[\Ą»˛ÂąŃâÚőұĘVv˝Ë(Ú;D7’(wĺö0UŔˇýGô5Ď·ýČăP!ĽőT °ĂO:]IZBŃ©î•ţ*5ăXşĚ•%xÝ­řl­č*Ů$´hřĎĐn­qŢʢv(îěevú_ ăâč\·łçZÓ®Ĺ^E:GL'BĹEń“G-—Ĺ'Ę>Â;aüP5Á·TěÝh<Ś'•N=µa'ŠÖ‰á™h`=ťbAYŞLějűŠ»‰lŹb€Âaü˘"żą)Ĭ %t?°I ňšgŚź]Bđ»Ćż÷™xEŹ;ɲ8›76/˙ŁZ^kÓ˘P[5šsä¨7d¤ĄďşEkűĽ{đ;K,żĘ‰lÓ4=ä’D¶fltFV§ _¸d=näsŔ—BÂĚa-8g%Ô‚ż\ŰÇ»QÝ‚ę˛0Çüßó@Ë5°Őő÷x1äFőľ]ĺáŕ‚É$XxKXßDöč„_ĂG'.g« öŕ„T%ě~NtÉ1·D!ZěKÂ>˙˘(eÝŠęśÓ0'<őŽ8é¶FÁTúĂĐyž óNH ¤´aXRX&¨•BâI¶ÄMŕMQšĹ©ŕłŠ€dśă&&`/F#x˝šż"|îéEńäý%°ŮµÂj[ «Îrű€{˝Ö¦Żu’gkKʶO Á7ľ¬HݵčłÖA€ \ľ!rę¨*’ôµÇ®ş·„%±®}“Żĺ^Ű~$QŘ&3&$슇C•óä[ŃZůžVžyŁč{¤  Â)µ™„SĂ]ËŠŠŐŻĹ3ĘąŹŃŚ{jqzÔ{ć+řwQ‘ é2ý:? rÖµ,âÚµG(0©˘Č©ˇd76ŘÇDÄâaź÷SĎťt “ył;P Ýmënłä ůŁE|[7˘ŕŹqëqŽF±|i ŕ=˝ű%¦šµáů\uADtśU´§›Oc?>ş˘aCí2ąŘץZh•Ü$ťiw#7őĆJ…%űG«+Bż‚pR”Ł3=u~ˇŽ™„aŕĄ_ÍŮ|ÇŰç:ŚŐ!÷búBÎĹÚÓĺ‹JSRóüŰ,Hs‚­ď©Ź¨liß%ĚđfMuĆ?JŮ#=Ęhęʆ!ăĎWčđ ř‡/Xʢ*0}ŞÄşŤ{ űI…µS¬î>)IůÖ–ś1†s¦]X2ć© ‡÷ěá»ÓöS˝(÷[ĄW`™ŤŇęŞţc$4 ńU)Ô«xy3ŐâÓ¶JrÖŮ µÄ‚ţ„AÔ‘đhîáŻz…Üáşf˛!áÍ G úî“­î›ôo·_Ł;R´UŮÂaól)lj¦ágßFj95"Äî塗Ǵ”.ů:üúMő0o[ľŢ#]™ßĆpĚ°pXˇ¶"0*+3ü!qý^‹«6BFá€R5 4ß9,@„›âíůIIô ‰á›ä"‚Đ­•Aęčľ,_q'`X˙®] «š•G8ŞEŹ8O–v*7•RuWTĆž×/:ŞReĐ;‘ĆBžÉYŮŃł!V6śA„ţghZ솬ůî$+J Cd˛†ŘŹŇ4u’î,$oŁ™¸}O«˘dYÜEň¦ŕeµ6o`ďŐĆvZ:śv+ááŢ6cQÓ«`ŕľÔ˙—Łµ;+Łp+Íłqc(?%+_ěŚfđ‚`yĺ çfä0“ŁewBĐĚ{řL+CNJ·`'ž–š6ˇ¸¦Z :aě(ęv˘^Ł"›Ż yˇŔĄIÇű€?su"ǭжąuB;xîwšäUcćJ9ĎăĚŇĄgŕţkIÔçDű%µüŮúÄNáCÇSô5\Ţ–’GŰçšĎrâó¤ÄŘEęŃZ"! € +ź»_»bň‡’ôć⨒ú[’ĺŮFIśÂ¬,;+‡0ÁfeN(ŚřĐXÜť#]zSmsŤŢwBżi‡“ßť‚Ö€lđA0üîHwŃ9ď—Ľ\ÎG6Nű\!ú Ůuă -ub…űx$PJĽőňr"Ď»áĘÝPw%iţ^G­Or8g;yq"Ó` JĘc ŻÁTŹK¦]×_"4đ<†8€‚p™)âIź?đw óÉ’ĹŤńC4ő±ÝŔ•î“B¨kĹôÄ» GKčŇ \™p |]ö;µő~ÁńˇźU‘ŽÖ68M[Á ĎÉÍ®/% _†w=ÎYbÍŢr®Éu=¬y:pᑢΦŽJ«’ů5á+VťSđ˛šĘcˉHQŻMMśkâR·B@lĺPâĺľR˛Wĺ· /§IAE9 ”ş‚ń5ć]uăp¶ÓŰĂ(5#Víýµ·>9 óľŁZÉ6 ”:A%7¶"Ń…m¶(¬|ÂSçv¶ÄşźQ˝ëËö\Ú„-çÇ,k5qqí”TŔ8,dΊHŞÄľwO>TşR[TĐŘŇ·ÔéA#y62`Ľv•B+ăÚúŽI×0đ!, ůńZgĚŽ4±'¸®ŚÎ´ ˛ď„Q3;!µŘÚÍřgU ]č­t¦śvĺÇ>Ź s{âÉ”óŔŘPyYŁ°Ň‘ę$GśĺQ.  3‰žqŞÉČjţ¨J€r#‘aÝWyZ¬—~ŁŹâs€ ”TćŠ-YˇĄ |]ĺ@TęÁŢWܦąćĬgË Z˛ÄN6BG*ť PU8—ŁžüĘn,ž—Ą´°YÓŐÁ/ËxáT]çźGiäú¨Ń­R¶¨]ŹĐwäpĽ’t ŇŚ˘Ź<ž8ßŕH‚¦‡v‡é ˘±)®Q «Ď)cLQ6 đč˘rřË/u$ŕ |¦\mŚťËŠ y3ŤŞ\¨$ď&%f­»32W)RşÂąĺ/×á…·ó6źâŠÇ\Ińd&_wÉ-éŰtü|nQ¨5ť–bxĄ"ł!|5^ĐŰ·.d.˛ÂL×ßY 1}ÉĹ7/\iT Ň·«ôt5·f]‚§Óf NPÂÖĚ"’÷€ý“llú xł*UΓŚţ“{ŁoLuơ›€+źm>ú%YÔ>^|‡‹¶ĺÇU˝fq#rśZ"€÷ U%ŕAl%VĐ0ôŁXŞ++)=ĘÓĽ˝‘SvĆâ.źzRŘ2őTߧoŞuű–_öN#}QŐ|Ą™]ž$T?ęśK\ń™ž×¬W˛9ôŐ«˙<คü,1§=ćSM&¸tZýűř>}Ť˛Á8ßPľr©Żx‰ĺŃń1ł·H łZ‘XŰÓţďĹŁd4{ËŢ'ł§Ş>¤U: ŕEÓôâä†ć;Ue ¨(XÓ’Ôźpx>ŚĚ÷‡@ěÔH‘c˘Ş:g…-éqťY‰ŕŹl®höúG8°č¤AŁ6źU mj“TćĆy~€¤Ú2°&EËI®ZËöĘ,Íxs˘l@ŮeŔ A*[Çaĺ{*Ŕ×€üf.sĄ$ŮOäĎ„K!}ęŘŔŚZ#?ąO†L©°P|Z‚'ž9´yń2 ŕ„ęśźę)ä+ úěG:ž:Şô`Gâ9ť,óţ=`ŇQQ`Xü#gŰyëC+$3’?őě‘Ó25Ü|’y÷µ ·6ô!¶l¦j×N|Ď]FOĚY jëź’ -fßy%š2íöoȲ4sÂÍŮxTŚŞmű„Ł-Ł—nw Ů!÷Í]â‚+±čŰ-”¬ďőWDu>Ô`7DÔz¤ ’đXáĆn×±_0äy>+§z‰cđ€˛Ďt^w@zSËŹŽ•ňëgu Č&čżĎn0'ł­śuQŻťbň˘Ş(b6ăřćbzÄżSŹéKÉăÖ*Nś»ďsq"ΛE©Ýť.X~ęĘS ś“1”ky]˝ŮÇ k5@1”}m“•ßuřDëÍ^qŻ´8.ËŚă}e«÷«”Ę\_7î»]^bîšÍŘmĺj(ă_‘Ă~P~Ú5R]IZPräXÇÓ%víg«+@ůđGwü ăÝ­+n^܆ŔĘăÚ­¸ĘSK°r›Ô Y řŠ÷ńGIżĐpĆvĺXęÍËN2$˛<˙#ÝÜbăcvcá´[î öŽĐ›š˛íMűĐąľÎBŹĘé×H2Ü5BĘv?Ćş žîTÔÄ´ř;¤¤řłsřĆp[©ÝQ ôk§ˇ”e¬'<¸3Ń˙6-”˛ęt Ćä‰H]Ü1\!Đv2Afşre¨;5”Ă]§›C ŰÝŢŧ­•gňlą~±Ú¤é˝'˝äˇ‰Ĺ„;ýŹáˇ„9n¬üw,ź^Ýý±1ű.uţś`]ŕ¤_Šú8uśôäâÍsŞÍŠ´ňë\fŹ¦ČU1źú™?’äĆx · mÖ˘ą3Ču4Ęóa_4 ůÁ:_GľĚqĹÉ“»ł ˛ÄžFŮń. p÷‹óä)G§®J ÷v“›üŤę éíĄ`ˇbdđś4 ĘŞsY%:‚Ú Kć{ Č÷×:eŤAJŤMÄĘlao?ř€¶Rşç5RżaiQ$ ˸ˇtŔćTąžÎęZp.}˙µŔ±dĚmR%ÔxSÎčn™ÇŃ~ě·Só• C’ĎG:žÇJq÷_Š\6Ýî4cjý@LlYcăÖDŔŹRô×âW‰‘Y[ň¨Śö懏ú÷î=}ÁNŐ!sŽc=ŚŇů/|:ŇRďýOĄęĂeU{4ćŰ&ŞÜ ±pó‡‘Ç„ňG#T§ěµyżŤ{Z‘śÍ $.^"”˘ĺÉéÔŽÎe˙ť´Ô¨Ń뜸úX°Î.·gW81T ˘gK‡Dôˇ˙D ö9Ýć|Ųµˇ+€X0éרÔ">¶×_ý=c˝?xćÖĄ ý˘Ł„*ťLŇ›÷0ž_Çßú>s GoÖďęĄç Ć¶ŹŻCVÜ·ă`vi÷ŘЉHĄyŘGŁ¬v Ö—>Łeáî-[¨Řk:‚yĐľ\ę›fÄŤĎÉüÉ⽎Brw „0 ĘüüS—PČÖ5Žě·$(dîÄÜÝéŠâĽ r43~0džˇĚß ›_*Ę 0ĘÁVŇä 8b­×±îĘt\p[ĆŁ ą7`,˝ĘđÍY”út¤X“8ď>¸WˇPmT±Y#(˙_`ěâź÷®P \±84 }®ŘŮ #•hlł˙yî#ÚTšÓˇ}vNO3´26ŕ’`Ł¸ÄoµÓ WČZ“báqôĎéŢŹáŔ› re,‰ÎYQ×’™N1[zZx˝ÝjAZş˛ÎÔy8cyć˝÷tEí@ăLł°UőUXIßK´˛âNĺŘixA¤A;ŕ†·á›…fĎKt,ŽQü±°DźîĘŃ™şvŕ¸ĘÄăýWl‡%i»"ŠIuLYţÓÔŁ×úÇf-«GJoŮŐŹ˘Ă Vc&QFĽ®Ś±§ÁĎ×yTŘé(&;>Ś©ćŤ¸•čŚ“đ®ň¬Łq±ą1ô¬X‰ÇýłçŹŽř€Ťí—¶ ~8đ‹{ßËőö/¨qł:ÂÁ?’kc‚>LÇ·»Ö1?ˇ÷#8:Ĺô®|?(gyĘ©b”Ř`S&aO°jxMŠÖ8¬-Z˙ŢC] AëN@ś˘!v0ż~IďhnE6ö4*Š±!-5Yâŕ´Š3ű./śr‰y™ ěÇć\m?ăÉ’‘V–ť`ď\ś‹=ÜÍ f'nUx4[µ‘L(ަ×&{Tă,ä_1 ł÷Żĺ–B÷˙+@ăúŹĐAúN?ă{nŚËŐ$;;žz©×Uő@Ăd‰öGźÍTwŔ'6'ÎĂ4yŐAݵ{«'۶÷^™%Ĺaůžu;ׂ©XĆadšP  EuŤ=ö°« ’ÉZš"‡™wż×q»P§!l˝ŃĘśţô9fé r "l>ˇăž˛{r ˙BŰP—kŔ '?+yW[Ű" †ŚÂK$ţaöł˝Ć-Ďxžć° ›µä6ż.źbô/ąQ9ú9¨ä´ éȲęňAç¦!›qőÎTíI+zs†ql—¬P8Ç÷˛–ßµz¦PóG¸Őž“Ň gą]ÓŠ_+Đ®ůŚćĎËÇ_<…·®ŔkŃs[ÚVÂé"ŔT(źŰÖô7}6ůąh†î§Hĺ„:óÔG±}<¸•y‰kű źň\Űţ/xŕj˙?c×qw±ď®wó[u,CčfŇWď®˝ą!Ů”·ŹPeű¬ĚDü¬zc^őŠŤ]¸i8…útßµÖÍ Ig[}÷ń«Ź ćŮź‰Z&˙[ˇŰ˘ťWtbµçĐ„âć á—ţ(ŞĺBS↠wń2l‡0ü»q°_1ˇ@ ¤:»]ŚÍG]ëáqëľcĺ¸veÄrqî˘5¶E¶‚S×H#jJgú‚}p);–k Ĺ©ń¤!Ź{đŻ8X1üg`H ČţM„âN[ßľrL\âďÂŇYm^’să}Őű[ýc#Ź˙áôquÍ Ę@f—™ô”ÂáăL§ÝÁp˙䞣îĎ/];·÷Şľť¨ř–~xJFěFńO‘Q—6§=BĄ!ŮR(EkŽŰÜ0ŃEZoź“›2Ru Ńöô âuúö»To®Z`6Y‘śŽQsżŻé÷3Ś& ăĂÚL2{Ň^ČzSGWžYT»ş †ţ:/Ů݇I ~?{­1ú¤-)‚Ă58˙eż!VnŠTć-<¬uź˘›{î˙Ĺ3Ú˙Ż ţš.:ëďg^ÚÖSŃ䍷•‡ĚCÉ™&8p5I+,•µ)ĺľ…}GÔišŞZ/”Qľ€®±ÓÁZŁ>ę{:_Gꚦ±¨;ĺÔĆ8áfă„óť-ľô…\Ĺg)­XÔ¨i+Ő/Ë/ĚwÎxţaůĽÂȨ2EjćŞ÷Çv1Iťż®:Ł?ĺî5ß!Ú%ÁČÄąCô2,rďüĎá|J— ¤e\ćŚčÍĹŞ2š…G§îč>âTQşĘšgŹ ¨q8éÎî8AęrUH°čÉ-űSšż¨˙?ÉvË©ľU»/„†Ł7 »Řcű ¤îE¸§.ŚŤëpĹËTŢO|ŁŚÚ”E%“˙ÚÖwh.I ’Ďbęó.´lˇRJ_­ŮD—»GŢ×?QTÎ×ül/Śő 'LĎ»ţË›¨›†iiČŞ(ë÷‡mr*đ™€űŃ(.|Ž”őŚ÷’Ô­8ŮSŹĄ—Iń^XÂ\ńzě řĚ;Š‹Ă:ă<&K8»4zÓQ Źţ9*R#‘ަ0Ë‹#418§˘Re–Lľ'Łż4. } uÓkYL’šËhŽâ‘Ę"q{eŽ w1#© fËjČ];âG(4…-˛PśTȡUź9:PX§€ňťýűžż2‰Wďg”79MÔy:5şŠęćĽrňë•é‰˘T#ű \gŐSŚzčŤ7ň±i!üYň>Éľžč¦f}>¶ÜnˇWoyů…ÂTö<1É}Ę‚p”ô č Ő]ŚV¤Ë~ŃžŔö)ŘŹ%AĐ6“E[ŮÄ—LÇ#čL/‰©iĆ×^ŕzť•/x^îżJ$8|Ćs×őF›0}4řŤ˝·>w$}Zbt“›ç«›VÚX­8]ôŢLtŞm,ăNŇťa÷Ożi,'îMŔ'ű3ń˝é•‹AĹUßÁřLĹ›¨=1®lĽ:^ý5T\ď&Ç(,×۸ś‰p˝>Y*ŹĄąěc4ć<Ľ0U_Ú nüG•GC‰UÖkOŇyâ6kĺKĽőr->Kl»¶0u´U»ÜđśČť@_.SŠ;ůćŮOZţ őLÝď\ çí ™|O»8ĄĆDK˝Ű| †Íâ;Oo®mĺi4ÖV’Ud"Ć#eź'÷RÖňH~邇ŰA\¸ŹĚŽÍSÜMŘ&&׉ČřP÷E©|ŤX„ë#Éž×2 ¨ň@öC™ăeő&}Őe¦.ŢZŐ-Ž-9%Jâ·ěĐâĚÍĽ–˛éŚCA<č…“ĐĎjmťľá;IÍĘíwt-…{‚Ĺ],îr'0¬ťk™¤űń!°öşńѢÂő' áP´čp`É ő°·[Šµ;ďn­ˇYR||©Ρ†äN4˘ţŚ'ÚěöéSÍËř‘­|„űŚç×Ú?.K>B8SkÂ~7Ď E3~1<¨5Â,´ÔčrĘćbů‘ÚĹŤw7ŠiŢU“´nä\ţűPłR׋O Ŕ€Ë^˛ ćüÜčŰß, Âĺ®˙Ý0^7Óů¤ čUrÚőń­É­pČËzč°·#yyř9#vč~JO˛Ŕ_ń0ë&T/§żđ⼎kŁ)( €¤ŐŚ¨}ľao€ľáßa(?Ű?şüŔĺ¸Ůp(,Ďgy¶®«ňżżc˘ůl<­ä©'űż`lI.ą8NSÚč±xGN5#±ÜéŃ9¶qÚF5=´Ć`4d|=(€MŻ°Óá?úšp¨äÎżÁX˛&ZÓ°Ţ›Ŕ×±:AěJ–Ą «BžŁdĎ:’ŞyŽäG^OźĐ{p§ŹßÖŢ%)h‘ů‘"O¨ëž‰lÜ7ĎfĽCÖ­ęËŰŞ6=u¸–VšaL0ń+ŠĽ} v&dŔ mş Ý…ČÝJů9{®+ž˝;ÁPÎc¶ Ýú…˙+Č'ëU:D7ZVF÷fýŽßá,ôIýRĆ3%†*ŤŇś×Tř¬ďÇŚ"»´AËmPtí’·–ébM»Z+ś™ôæ¨f‘‚Wşu]"zq÷T—íW :ľÉŠń]źR[¤˘…zÔĆ^ ĽÎ{‚âÎ[Űjî'Ż´Ťs8ŞŇ¤ĘŢďüŁ[śąÍ,†ôît…bč#ĆŚŘ‘0Č]Ńj ĄEŃ+św"^ČWwwWQźX´c řłď‚f…6OŢ™öT>˘ĺV®pÜ ë=šM<ą•â9ÂŽ:‹Č yĆDçU©8>ł™“@Ţ|PÍ!\Ý”a9čIZ†gB \‰B :^t~űnMßěđŹÎo«Ńě”ÉZ8Ě ‰Uấ*!#ŽŮAČ$g‹‚0ßO˘YyI´9şîFoŻ ş!{ʸoMďŕë°ů±óOą4>R%1Ő HţÜ1ĺöłëT,0e5q6Řľ¨±xáÚNłµV$1Q Ň57 Üůô!1ěÓ.â”6ţkş80Š>üyĚŇő=˘đĎUĎÉ+ŽŇľ¨Ö˙GKŞ~ţÝ‚'IÉ)úŔ„•‚ö8üÔŰ‚JéǦqđÎg\A HŰťdzŐź»¤|ţ¸čŃëą]¦ý»¬×Ü)¶QŃ™¦|TŔ Ŕ˝A` ł?ä5}ü"óhäkľř•ë¬E3z­Ă`#ť ŃÎޱłĆz:|U4 ˛FLťUW7ł×¤ňĘ<˘™]aG‡r CImk9R~LDšĺSUúPq[QµpÖ3Ř©Ş5öˇfÉŠÖݒѸ@UŕZ±=eĆfIRĄ˛Ů[M-“GU3Ůuöß3¤§hÉtşä=ÓŢp˛”I~8¤UDť¤$’ ´1¦ö‰U%OÝ:ťüm”Â=đŢ!MVě6†K˘ËŤ+„L÷‰Ě/đ ͬAÚIr´ ü•ş1ą×řądXٸ狚J–`¸ąjˇTmČŚú@hŚ4Ľb˛eý’×…]ĺ5Ŕ/U­y*ł€,7·Ýw*jĚ·Gžb6żŇ˝Áw‚çĐŘ3_'M±m@7FąđM{^›Á_m ö1îČŤˇsµçŁţí×ÁäS2µĽ*vĄmŇůň7Á†h‚.‘şę÷' ´…X'[˛I[ogÔZ„…9ÓV2|,ç)Č:T $SgµJ)7đuÚ˛ŁRŹ˙S]Ý–!Ł¨K^7&Ňđ`„žěO$.päZŃU°»Í“ĺs'Ź•!Ƭ[0Ghż!Ĺn”Ģ!QdřĹń[pŠťëś–Éś§—ßŘÖwPnmK<ŢZ.l M§®!Ĺ*Júr÷Ũջ՝hú><đ“L™Ô.µ eĆer”3' EަNÍšli›ń@k1NČ/±µ˛Mµß´{K4 ˛ëo@č—Ĺß š÷÷ł8˝íëŽOeěv5Ôńx;ó©ŔŢăSZżŠRR¶=Đ/Es%bÉ)Y˘Ş­Y¶v†ţ¤éYĄE#Y{3nÍĽaZ˘"‘µ-ŕ0WbŽ›ŰęQśŇÇ1˙®ŇÉÇoíŃ@Á&Ť“Ă#žk/Ŕg„>1óvźuIűřCţ¨şN ń¬˛Ĺ¬€ţXyŘf«ć­)řń„;ÉÓpM{çF†9iŻčx{ĆLÚěT)ŘĆĄđFĎO Ű—XĆ-§»¶ !!6—n•Ą ‹}Ôęnd>„ý¤ň…ŢP4Ef,6|tB†ž6Ś_z 8¤oQ®]p.¨ Ąčj™pż4#uś'=-!wňI‚·ËlĆ`ý=gC[˛E…nQ…â X ‹÷ şS™§0ڡ׷)”_—Í’aWęFŻ Ó¤m[é$ ˙C8ć1Üî(>™źxáČa0{pÚőE¸›ÁC‚÷Ćô­ŔŤsŇËî[|eU¦,+š8.„đ(’Č ¬î§~¶Ś9źą^Bř”O¶ĄĽ‹ö eČÇ*´[*„˝±2hťźäXĆ×ey:p˛I¦Ą÷Xż|Ţ —1 ‡ ŔU) ||šm®«˝ľ+™–­ć§LkĐĹŐ|G߉Ţű—D±Űg޶ôĽϡ´űř{€s©s_TuŃżí©·(n?Ý XÜf`Cl-îúµ-PXCsď˙4 $7Wł29);ľ§SĹîń­?±<¶K¤ňiÄt±yĽ>VlEĎ€Á3;Ť+C§î›X f«Éžűđ<Š©u®ďňjé&ĂćjqT,ˇN‹¶Ľş‹—VyeNŰ 'í}~ě pÇgÇŚĂóJbĐĘ'łő˝˝B,RŃĄ16ä—Ęţ˘űpź’Éa8^hż?›«|Y4Çţă`Ę?ĺďŁËĄügÝł†2ö‚ ŁŚćl W„“\Iś šë~ ? äyŽŕôTč[˙ż§ÖuůŢ˝ľBÂÜUOw`°»Š<Ď))[ßXńěZNď~ÜT+y<Şí>+Źi[_lžć›¶»ös9•q·ˇyT° ¨4ű%„şzŁgđ]ö\uG śf! Ę{Ş"ШCť€ÁWTŤ§Řq‹ĄLç†8OTW «čÂůí4pǨWśŞćBÚżÖČCîÖQĎuI–oŹTL$ęVI u4ą ŃŁĚÂÓĐľůűŘŞ‚ĽĂ¬±äˇ‚ř‰äţ˛”¦vŹ¨gCXÚ% ň$ CDˇě$ě‘ѤÇPŚfĺ…01‰5¶ čCŰ\“ă&ý 7Ĺß,Ł™ŐŔ‹Z)˘o9bţá{JŻ5ˇ"”‚˛¸Eąľ™vIŚĐ®ĄOCÔ Ë2 ŤÎ)Jy/ě'ńAőµÁźěÔ Ź/·ň9ŁFęL«Ŕ©¦‘Ax•2|\olűˇć¦xopY}ô*.I?Esľß7~ß5/ÇŐ»˙á% ţűŤ_§şSFŠ˛é w{âYÖżŔ;XXB& čŤC–ůL@µuŽ­$oŽÜšv GT[uěׯŹÎ“+ó» Ç4,C7Ç mZÖ¶‚áX-[2ł»z,ŔťżĽĄ;56¸›’ŕ.b÷UĐź¶aż¦śĎĚĂí1WŠőť^ĂY4!}± ľ5/¦żn]”¨V0Ü·g5§0cÁŐµ‡¨éźäX™Ú(“°îŃĄ“D°ďö(S˘á¦z…‘÷Ć>ĐX%Óą‚PcżđKüŐavÜůá6ďö#@H©Ń=03N¨J[ _´ÄéRb,ŰŰŘĆu4âWsÎë ĹB–\U [»:~Xňx†IĚ ŤĂúŐ ˙m”rc€°{Ą‡^Qí‘]Πr’¤ú±vvô~RT0K6Ô…zYÄBvd‚+eţćŰü¬ ř2ë®zÎź„őő$Ą@Z©Py4}Ůqöë1¨i š#&{(™—ĂĹ—« Ú8vhś{ěpőü҇†ř¶° ZćÓeÇ`ţÖ 6o˝”—´x¨î &<é9ŽÁ‹ý±'Kg€xŠľ‚ůĂ>%1}„ĄVe|öYO –®†¦–QĎđ^IëcÜtĽ5l–śuŕľÖŃßť~§¦~‰ýłh¤ KŔʦ™Q9(mYŤm‡}‰%‰šą@¦—ˇvíϨÜzŁ.ü#6Ť~ÍŤlôi Č·µź:śwşBůÓľV­¦”Ă  Ç»ť#‹Ż÷ęĐőyU˛Ż&G`寪Ź2ĐLns&ýăĺIĄ‰úůŰ9űłp=I”~”!·%ňËÇ!:µý\ˇ†ß¬j» Dx9*7uÜYĄ›kKŃGQ‹Žz­ęF¨†Ň)śDń Ŕ'Űöç{>•ÔřöČů¬ä‰͢–ćg÷U«ĹwEk.Ö‰áNtËźŁĺ–yfÎď•Ĺ@é  „čŘĄŞú&ĐĎM¸¨ŔjĆŁ Ű>Ő~·,GnłË’-ck§uÝĘՍ΋€W&Ŕ¦!CÂó8ׂäd¤vD›ť /U¨k+űb–ă‹ý·÷ ĐsŞôJ"#ž˘cS?•¬ę şV˛„¶‡óˇ>v ^'Ié㾌ł2°yŠäłić\]c”˛č(-ěqíß">¬d~ňXQó#ô6ŕ+¸¸=Ä/{Żçov–JDλŰué@”˛,Űâ©.aTrŢßŃj,±–zě’ĽŽYóŤ<(ç˘i¨ŔO»î®{‡{t$Gˇě˛3 ˛ľ»ĽÁ8łőëÓ·`ÝÇŤŁ|,NRűnµűŐ EŰ>SűĹň€Č-@ŰűpĘ"RŘ…©ŞwH6ű˙x?ńÂ=°BŻÔ`ńž—‰ÝqW@úňĘžĘÂ3ÁîMµA­čFß[{Ül_@ďź>čw€ÉŁÇcGĺ8ĘźtXÉR˙P»ž!EBKă%GPj‹HiĽěŻ*J*:Çžľ6m‚lüe/ŘđÇŢl¨a¬†´Ŕ7‰Łßńá$¤ry3/b˛č<-µ—pÁě=ZÉDtřk«Eá©ÉÍÉî±ß|ӖˆfNˇh“t´U"6“(Ż1hYIK(®FÔ’8¸ĐţŔgn€ŞYČ‚ćëü€â€ Ů`RďNVč/!GĽr,ŽGűżř ÍbĂq3ëתţ»EŰő×@ H­˨öŠ{äő íB±Ńj˙Můž°ôx—íâ3çB†Ôć5ěř'JďËđ9śąbˇM«ŐÜ;bHŁu“Ůщc{`Ű]öx›©5sĹŁ–9~Đă+ôĐ+X˙Ő¤Li“QŔěj“ńť„ĺ!­ćn•ŤÜĚŁűîčYCGęő ß×ŕŚF±$×ẊRŽA.zŰüÜľ¬Â´ŇJůřpUŤ3¤Îs†Ç»$lxvý—…o%=(űoÜ^ű® ‰Ŕń}ô ý,†Ĺ‡^ŘŤTŹ’ě÷Ě“äXp"Ď<'PĂŚ[ŚgZcřó.=ŁťZYđµ¤I{>Dš.5űîEE9ăŤ÷Aj‰Ŕť3}˛ç@í­î- SUĘG6tş´ÍPË? »ön ëBĎŤ_ĂĄ&ąŹ«ňP‹Ó$+ăiÔźÁÚMw›»hŠÎۤ;ś—K÷™vctͶ÷ŰĐÇżµŤŔ†ĂľÂY b•bŮý!ŃO'•ôGŁR(ąĂR„|UˇŹN\#ŚŃL˛+|é.`+›°Ľ‚·¸XMé˙˝j*ŔQ±Ű\•Ř{]H˛‚c"H3-FçyĽ_Çb#¬u+T†lď4zćBUqđäKGgÉżń®)tĂ{&ô¬`…Cp-ĘcĚă"<ô ĘĆ' /:‹?¦ú-„âáK­ëö±¶‡0#*ßT}ß" ˝˙^úíVQĘ´¬§BĆ)Ú`çpç  ›1 QÚě[މ#„ óă°›6ôÍhbęMHł$·ŃëĹőęĐQhus߼pÓŁŐëać,sŚuv¬1«jßAđýýĽ¨ztp­*°3  Ž3i‘Bâż“äp † arjŻf3«ś!|’D">jFy~·XÎĺ™űČ‘.‹ Š^Gzrw§łîMŽ)®;ŠAł5’§/l3u®›žŞŠ˛ˇËuýĂH{ő˛Dë?@îą[x`›t~Ɇ:ĽtQäsµárŰ 2#–Ŕ˝Ě Ęćῶüť„·»ň”/Až;žČźő†";ďHb57 č·Č‚CŰQ[S%%Ň ŮO(Ďč=Ćz0cŃ«!´•á‡„$ę8î:‘d§ř­éšňą´St~f*wüqgέl•l­Ĺ*Ře“$«á”x…ÖűF›‡:ŹŰ+í».FüŰÔö=JÁ¨Bź0)'뽺ż¤úúC>ËL ÓŚ»,źăđţ]HŤÖ÷„,}1”~,8*wf.ź’oÝ1z÷%ç$ľ(őoăŘ‹Ú–‘B,(bŹ>8LW:ó§Ií ·Ę‹—Rsń $,a-ﯳ=ëP6’kB?yJ$]Ď5hŘfµ¶źî{ípyŁ%%·Q7Łbä~ŞGTą"ŐC0)eÜŕ˙tjäI"čMXĹĽ†N÷+S>úB~lţH0F'JZŰĚBŤ€3"l<^Mäč3¬GŐŰ|®Ŕf‡Ëç+¬@–%ţnľ:6ŢĘ[;žü") šőicQ‘lË<źÔźßőŮ×W÷â¤Ř)q€vç‘č‰ĘNîĹQŚ­jóýŻa®!ŽĄÄC‡¶/Ň"ąÚ˛ĽudÉążuŞuNTÁ`Öt|p§˛Â%äéôaJŃ®$t¸xÎŚ–ăČ„EŕmÝ@/ŻËÔÓľŹŘĐĄÜŮťŕô)‹BJl‰]Ź)¬¬!¦„;.XaMĘŃľ÷SË`“‹mçÍ^2‚T°čÄ ˝d3$™¶yëĹ.?üÖ1ŁlŹŐm `6Â)­Q……i—b ˘?'r¨H-4¨Űţď#Ę2`ŻL+f0źeńpˇ«t×> ă/§ŚŃ ›«Č$ű°Gu~Pň9`/•lŃ(¶i3ţ+ąŻĂeAaEÓş,ÚF?U™É.+PX’óĆ–ŕŮÁ–M2(DI(ĄřmH ¦›BÓŚ-?ďÄę;ßcśNôRćOîw!ÚF”Ź«ż'ŹĘZř‡‰ţ3Ż°Ç‘ë`žaß 2 ŚnhžŹűůżôđŐ˝@ĂîĎůŘď^Cj˙”âĺžϖyŇźˇŇÇ^ÝVtęř,4/Ď‘¨°/=HůýQčY@Ř®<šđę]Sĺ;ĺ·/u-v ş¨!;7U›9Ő-ٲÜúevł7IŇpŠ‰‹í4#:5ö$®´$}ö†K>Ůě@MBÜZÇ@CX°¦Y‰HW@ÂT^â,ań‚´y’śí&ßzěÎüÍéźéűţΖ†%BlÜóžŤáLZ6;ąËÔëbd÷Ôaü±cÝŃ:7:؇Ɔľj%‹#”šşůżÂ—"łąąĽ°]Gb>˝aýF­çضźiéÖ)ş[©Ă“×i Ž«pĄŃŕÔ’†r‚×.DĹCNS·c:¸y»–)\đ_¨ěłý­iOŹŰÔóßRëaßŇ…d_űÇPěŔ˛üÔAž×Ź‡j;vëŕBËÂ`kžű"ůŔ°·ÔŠIń((·j9ţ/Á ĚÉŠh“Ü'†ť™Ć*Î:ĂĄ îžDɶ*Ń Ĺ=ĐCbŚ†ř>`#‚%'FŹP§nEô_uxĄţp‘z 4ý¤ö•`ä÷dă-13† ‰Ś˛qćö}!ÓÎ}¸7ô‘˛b|CѬđ" <}Ú—UXl¤Łs”źý>ăý6ç÷Š7W$/’ú± ™Ę1—iGĘëđń@ZFW{‹¤«urťŃZşˇtSml%9Ŕ­ěďŹ?ĺ×N‚`gŐ$ÂľŞ×N‰óé#OËŇĆěŇ[éć˘WŻs‹Ö°Nę“žGV7€Üpo3ŞvÝHçěW°[ëěÖL”Ŕ 2~®&şŽ6B~|Ś[9Ŕwł@ë.ÝđŰ4 "đR‡Š2ÂH°ĽŞ+L’c‚çĎßQkÚ­÷ůuV’ :ä -p¨É)WfÉF”,ÂâOĹÍßË7IŃ8Łó:Ţ ňQ´áÜÂěů,ĂďŐ_/:Żâc~rfońQÇWWËśĎď2 Ł2‡3Ş3FmZ…{GCWźÓ<ď$ǧ\Ň^PcäČ@vH°Řę~U‚dšŢó›-Jő_áĺ(đK\ ˛'vPmD8Š°ď)‹`xCTuuő8ż‚żmÜň¤ŤŚä•Ł 1]ĐÖ[ş>Ťj‡Ö–%$Bŕ„Ź Iş’ä4ᥒÎXŰ“ n[&¨/$PwčSŰ %cz°®8\ř ŚŇ:”j`>Ľ¸rőaě`'°„yUoŔ˛ ľí[Ďŕ}Ý[ IJĚqnd·¨Ë‘ś/j /ôv(…ŤTłu0´q|8`p ěŐ†©@ONÓÍŢŕeŹ˘)‘ Őž;ĄÉŔnx„DÄ jyHÖ~:qÓb{¬N%>q3ßśŞĐ')6$Ťż˛xiنĹŕťUĽöqWφ˝ 5°č…iÔpćšĘís¦ čÚź ¦6qN  §tuZ˛ńC`ÜAO0"˙Ckú&H‡·űÎĚK"-Kđ’J ä~LšćBWO’Üěn]ÖD éEöČę¶G^¤ýgżiú>s#ČSrDŞó:syÜßÖć…Q }?ÁdÚŮŠÓaiŞ/@Ť:0I‚§Ř‚®nQükw¨łĺ‘ăkîÁó·Î´Öb›-Eą­~<ť:AŹčŮ!¨łăÚĆ©-5Á~m9úEyŞŰń)“–E˛´ní>™ Č"Ů´—#ŚĐtu5XG…Ĺ»lGÚU:J˛N‰§Ŕ%žť.†TBŤ<¶ZÍD súÄKSOKę’7D»·öe~2˙nB}Äě Űa<{’Çę»k/„©ůńČ~JQŹť_ˇĆŁzÖpöŠŁzOÓ(ŚŮ*Ë90Ł‚Ö@ÜůtÜ•Đ ooCË•—˘+č Ěí+ť•@Ţ1˘ąüÎWüXî‡QŇěφîć¨âŢW‚g‘ˇŰLµcYsyŮýł2ĐăčTąâVp/Ü…Ś“iŢ˝;¨÷řÝ‹ć±1UÄŻ/ľ®ĎÓe$ÉB§‹KU–ˇ@¤öő—d@Ç&ž·Ť[6J`ÓĂ]-ĘëÇz'ęŚ}®.ůr#´Ŕ%š$sî3÷KHäćĚ˝oq7Ł×o=î‹Y*¶EăýÖ0ŁÄ›VÇŽĘŁxćË^FâaŹŰV !öBXoLt¬c°….]…ŁrĚ|€÷Ó,ŕ*Űci/¦JL)!ČyT¬h.Dđ_ąpAg&ҡµ††=;ˇËţţŤóś2ĐFµ¬ÚF575tě6Ńů¤ óÜ –I–Im÷.ŁĄXt«¨hm Wdô´Ż~—áËĽP™ťŚ>]2Ě,uň« Ęó÷–HěüÓ˝-p Řkcj¤˝]źĄČřůPXtN\_b tYăůóúŚćúĎoGq†hŰůgŻPŁ׿ťPµ,{nĚĎiĚíř··UżRF’ÓęcvăJFĐeN:e ŕVEô–Ć9/ŹcC?C&«kŐY¸'˙ń0{ŁÁˇ™př¤ŽßúĄľµ‘ś ÖŚĂR$e á+­ŞĺĂ­ě0]m(‘çú˝2‘…±8ëŹ|CˇĐjf˘žq…Žz‰mýŞçp ‹Ęć6ýŚS/h¬ţ÷.DçiÉ5¬ĆoŮqęv…wß$Öśý©7f˙@ă~äŃË'żČĹnĚ4ĄÓůkDíj Ăđޤ*‚>­%żĘEŢë*•’{ň릅¤©  ™ĂŁ‹Ôańj´ş7PM˙\ĽPĎ+ĄĽ đ6R#DjqŹZ©~;„~ľ]Ĺúuoßű6Ů~]űRŃľ1*‹ţłĘ7ĺţâ >ˇý¨ŔžĂ§[QÔnąÖd0>€ű“ăńľx­Z™rb°Pi‘V)©K,«úŢ[_…›HTßZń˛'cw§ż„Y\eQ”w/Ă缻Ś´gJ°Ĺ¬{® N`Ďč¦>ů)-<­gčˉI8ë-w™ÁCXý™~r_&:ťCpťBqǦD„ö?™“”o-Ś%35u>G_şZ[cTżąäµzQXţqŇźżŚŚx×AŞą7Źť™=ŹV'–UÚĆľ‘ÎýŤî}™\0j¤&AĐg«,/mTKj˘sÝűÂ]ÁôÓ’ůÇ!Ă{ •­S\±‰É'îKQ₆\0+Ťüžebd jd>pŹ2tëšćJ=‡#dÝfŻ9ş*·šE…m'ľTÜuňĘ´"<9~SpUęRn)Zb@S’d4đ ±› •M 2`+"­žxžµ1^޵Ma«,×ÄŘš3¶CËÄş¸×î´·Lr‡ăYŮ$ąŠý6˘­Ńü‡Ą!Ľź+m®'š2śGŞĚ>ßQś¦jTäsŮ}%Kv·D© žĚóË‹ť¬îĹŔxDůŇ”= KA+S-?wÉţĐü uuĚŻBC _«xG;Á&"XíŚR:¶č ¦·Áć8Ź#-X„ëďýŃ/^u¦Yăă™LŠ2ÂBIť`ą»Í™seô;í • üěő}N+˘1¤@ĺÍ´áröQx‰nžTa¶ű­u…oSNS¤ ´4Ëť-2Šůŕ/@s@Ó‚łľbő,ČU=ĘI{FZS’ĽµŠcäćY)?A…ŐŰNú ĹL(FŻü˙ÍőĤwiJŤZ)Š—^ŤŮ˙"_2čd!IYŁŰ'ż ľËÖ-ŹÖĚ(ÂáŇ ‘]+Çn/üwWúů0>?ľ‡Ç âśŰµńLEÚ bެ2•\ŰVx,ĺŔ‰á-%`zɲú óQ\|>‡Uh˛XśQCńŚˇ~¬o‘ě<›ÉGC5j· N”XŽ·ŹvÎE5cďR'ꟇŮ~qV·pő+^­Ňo4Îx.Đ©¬5Î2mvJŞđ>˝Ź}Ó¨Ŕű_Ţ^éş (ühÖ¤żfż–yďĄeÜ{&˘El&z—Š_K= Hn¬˘‹©µ´¬˙['Ő ÎN™\AN¶ˇÇŘŮ9ˇŻ@„ Űâ鏗ĐÚɬAÉ]°ońK{j¶›ŕQ<±Ńîí€éŘPč6-|ńtł‚îłům­(¤ČOĆ"†ą 7m÷¸Ž~zxĎďCľĹĺďI˛čÎţ q”É_ţÍÎÚvRőMµÉÍ|˘•Â˘đG=Ƹ}LLKG¨’6ÍVϬdm™żÝ8š2°ĎUnŘ޵íÔ(żť\†~GoXo…jj!\w˙l=és»tż±˙kş:VBś™°ŁĘĚmŚîÁ‘ů>Ž˝u¶ía÷ťźeB ,0Á4RîU‰Ĺ›Ő]ź˙Áż>˙·=kyŽm±ý TÄo“'ŚpűÔ6\_˛ś@Ů?a`>Ęä4Ňo|Ď%úhÉx‹^­˘Č/2XS2¦$v©TÝű¸ë¶ľÁ[˝Ú¤“MA-±·wOM‹¦´’ŕë+Ťńäšß«Â¦ß‰ëMŻ‚v%BIŘ Ďd?ä«„G‘­Ó‹…›ýŻ~¤2çŕä°‘{;ç%Ńcc/S™KH–‹úŐ ukÉ xí¨‰ź>ě•kç©LUąĹÎ4kĆ×ę*»0CĹxÓ“/áꥴ̊Úż jˇÂ§˙Ć‚{0°1ţš9C_/ ů~#⠱怱µ €#”dú„9áăâ®XÂT4°đ RŠÎ—űŃňPÖy‰bş­¬aśTL;@Ŕx úŔŹH_¨áŞFWĺj·srx+o©őÇŕÜ—ęôłh‰, ?Áąüű=Ďręř7ů9e8;áµýxj“pšµ÷hć´ę7P»Ú۬ź6ÚĐň(żŚßd·ĚH“M#–€ĹčŮżt9.úňrđ÷ĎňĹÂäŻX/5Ëxé7Ú«xĆűw¶ ć .-98˝óöθüč7# ‚Ă-ŘĘ–·1L_Ëą‘qBRŚüĹE ˝˙FŚ–Yőş4ĺUDrťÇL]+%ĚÖ &&ă´ayćíUO4ěéžĺ¶ŕŻÇĺcsŕT€-aÍv"D3avšň·%Y;ŠŇĂKd4ŃÖż¸jÂă÷˘7 „ ¸¨Éçą´Éőßžĺhĺ뢳rk[¤€–l뾀Ć$ŮŢL|b“eNŃßoŹý;µ,€âĚ‚ţ–QŰąÄ2×Ńņ„oď‡ŘŞŞŇí€yÁÔŁ^…(¸ô-ölG`˛Ť˛M‡Róř:´ŃŹ] HŔľ‚:ä¸8vúýhµDźú:tóŐx°Ę’Ţ!•ńsxv^'OIrZ[MMaZ\`N<5 žĚáć‘w4YDl(”ŰHö÷Ű"×ę âńuô—źŮĽ©o’ ‡¸`ŠôŔk鲷ŇČ.»Ő‘»0Ü®möV(Ęę»3Í݆’Ç[ui*Ŕz{L"ňú¬Ŕ%’Đ—Še5y>ɶ|MÍQ(¶őIkQr ×#\P»ŕ}ě*ą÷4ĘčHśGŢ“Vu—J#|ŇVĐ<Ô‚ÎĐvbs§iÓŔ’âä©^GŠ'Ů8̉»m!wu‚\Xëź™Ŕ™uq¬§:Î ţł’gFš˙޸*„Č­ĘĂăĘeúâĽňsR”s˝ŚP¬ć2[v©|ÔĄn/•ć|!}¦·wˇ82bşpą1NbŰAo(zFü#PŔuM4É 8,Ęv- ÖN;1 âó[FI«|qztă ŃR‹>ë)Jě$đ ©ú%"ŠX(BPř.U{oCZ˛ľ~¶“Í‚H[Ęq–ŔÔčT¤xÍŃ–? x,žµŐâü\aë q0¤]Č™©"ń™Á|óąÂ\«Yż6SŁÓjÓHN#fwÍ8Ŕ˛Jt¸Äń}/eřĹćlŐŠíÓO¨'ř2®&CD“1آ™}ĽÖMŚóbkTG˝ä"•ŻÖeľLFí‹9ă˝ p—?fĽíÓčň١ Î@v ŠČšúsĎ˝Âíܢ;ń2¶)ÜÉ Ű/¶ 9霪SS‰% ˛—Ä÷GcÖ–OW@đ6šF'(Ú•ę¦0řŞČ~o6źzöÖ Óµ(Ň$y2…‘CVBŔµűĐ-î Ŕ'łKVQ¤`©'G‡ Ł9ÚZĄÎF›W›VRÇÇČ>vöăKÍMj–=ęÝWńÇ-»˘č|ĎyŐ8·…ű…ĺc2+“BbTşoOAů°Ty­ÖůŰÚRăÁŽ9–zź_aKNQKË´$ť§8aA#Uc;§€&¸ÝÚ(ŚT¨á)©'¸B_B×řÍMŢţŢ}iýY!j1ÂaE'QĹš0ĘÚîUâ °ţr4Ä ”ě°)kç…áôT6±ĆQ)ż†›7Ó.%§1—çĹŽúě´MłŘM”UsřmÝťŢ0n#oů˛ÉŔŃjTÉ€śđ·D­[lÍB$<[>G‹FzDď|˘D3¨¨OeY2Ľí‡Y5ĚbŚŠ‰EĆź1¶(?ŕL¤-&ZĹQ 4·ŽŔ¶ «$mŮÝml‰‘ŰĹgőĂ[úŢăńc„¨\ěYĚh"©î› g(‚:…†©R–°´ä$ý?g 3Ýĺy]!Ŕ‘&†˝ŔuiZî§(?zźOťř˙¬ńmě‹u<ÎónÝCŽI?<@»_4&ţWÝßĘ";”ĺ9…Ü\;}×;k§®LŔw¶›Ź ŰíîyÄöB ýě%YĚ\Cţ¦Ć ŔŽ&Z|˘Cj(gEäńĄëţˇ)ŤFŚŽµ>‰e;zĽ”$k%€¸f–…Őţ‰aŢ%öŻŔ‰UˇzšI Ę¬ĂLŁéÄň¬.潊÷/&hj­żÖđÉ]Đź?r$P»]ۇËiú|)8&CWľ;‚?®RŠeE˝ď÷­ŹžŰĚXWŚëdłÓÖł\+ůúކöŰ 7Fńąťs:Č®[ťPDxžmđŁÝ"Ä*%[ŽýF"š^7ćvú¶ú9ô ŤˇŇg|7I§Ň‘µFÇ@Bţµ{H:Ź†Ř'ȡ˛äAëĘl/f»vz÷á78#¤Ę¦ó±ĐAZňů}ĶTŠwjâp—×Aâşµ7#(ľÝVpS¨hç­L4*Z¸Żsvm9÷Wčp řë©ß=ę· —ĂÓţ…DVQ8Ń@ůęyaćÍű·ŠJD ŔQďĹß44Ěw ^éKü/%µŠâl„”C± Ä…˘>‘‰… ~0BiŠ×°Ü]ĆJĺĚ%×âŚQwšÝë´ŠaÂpńN"r9ŻăŤŢR pŮ­É·‹˛˙ĐK›VXB…Ő8Ö¤!JlŐŃ— ·^÷ďh9 Ä\Źý^ćľöČো`śV<̉¤‹?vL.”Űü*őÍÉsa“š {W´¶Rj˛î¶u‚Ôn>˘cÉhÄŚCFÚžĆGŰ›üŚz´ŰŔyW¸§%ňÂ! “Ě%4rUC—ˇ6ĆăŻPÝÉ (zrÍâł’ĘÄŻˇ‹Vwë"0Żă·"ź)q†™0<"4-á°Ą${±îYŠPíŰňá©×†;QŮ U>5¦R ĚĹë#-ś´R:ł»»…»C˙¦<¬â‘tň9Yţ ĺůÖš·µôL±Önůĺa ±YÚĺňfŘCůUr'"Ő&Ďŕën3W]‹é —•ľÓŔ̵yA<Ż9ćAë¤!ĽKÝÖ(´pţRŠzÎeŠQź-‚ |X;Es˛@GćąZ ѵ׭ä#blAh€‚ěϨÝS˘ć¶µ'Ú%0Oč÷iŹi×'Sô/‚‹ĎYJ—C¶?°;ź"ŔFŽ Íä|Ćo(ŞÍN'Śgŕ*‘1q{ˇŃŤ©(E;˙òřĽÔí€ălŻtéÎá8$ań䯬óo¨P"Ś¤›-î‘ÎNĆVc˛Q*yŇ gćiF–änďJCő<çš°˝îá3C\ ţ­Ś˝€Ťű:1ß!RąPI÷K‡čCŚ/şÄ˙Ëů× 8kes8śźzbŽ/ťőu^.şF䊒†îÖdäÍ’™rŤ9GDYď5a˙ĺ¦ÍGK6ä˘xvš%ÍÉ}´çŮ&Ë;8jÇ7ÉBÓ9DNÔ$Ô?şŃ¬Ŕ>W\µ1ôoąřń’Ŕů, ¤4ÁŇ,\jçKÎF¬ óNNúÜTú–ćOX††­; R×Ëôă‰Ţ”ą“ł,Bf’Q_äŘÇA®EK%Ú(5eŘŮ‚Ň 7Ý‹v±«éjĄZ”%"Ţ}ĺĺÎH‹úOť1•PiĄĄé•ä QřQY(˝˘řŻW€>GđýF¸JÝL€v»|)?[CnTţ&ňµqD L`Ll;*ßRd¸@Ěň’†Ç$frAM¶'j1Ż©ľ´Gďä9xH ,ŰđňäÓÄÚ#á‰+ת…ë©+~Ĺ!’ŇMV Ĺ ëŕ\{Ëđ·¶ü6źź|>ř2Ú”H†Á=ň`¨ů’̡ E?BŢr°ŁÄŁrmşŹ0LÇď 8ü T° ”-ąiůtHY“1›%]DśŮśî ĎÎÓF‡Ú¸˛˝Ĺ>HďçFlIÂ^uó9›ĘĂ6Źü’‹Ő†ÓEG;6b‹á´+ô´|sD4€ůhţď(NăŐsfpĐZžř‡&¬«šKÉŘ Y›»Ńx˸Ĺݧ˝q„»m¨Jŕ¨SÄAą$ ®i{é~‚ĎŞ…[u —FŰg>Š'0B}ŇŠż°OQOPŚä=ŃŚ»˘ŤŽAG4ę\ˇ]ä¦F€ŕş‚hů˙x#Úř‘<Šb300{e?»f›ÎgčhKŠ"ľí’Ě-Q4ŰĚÖ× RÍŔyGl‚˙[¶Éđ¬<4­žÝńH×X§źľ `î¨8¶»˙"Ĺ‘µq©OˇŔ ÇL[•n†®źŞ‹ęy@áG5·í^ ˙ ŕ¸(W× mu‹>lBŔ±¦ý ÷źÁÔęýlŹ‹ßF !˘łµ;ča]ô!±rŔ–đĄ·$>™(ç[ąĘůLĄÄv˛Wúax9D7’ig„k‘Ahř€ŘČÉ.tłâ÷ >Ž ó”vÖ™ŤůČmęJ­8®ŹôŚ~·óŤlµRĆ~ŇÔV%ˇÜţ\Ç—<^ŕDQSí÷Bśz•-Ř°Š…żző™i9L§ÇÄ4ÁUŤ´©O´€'Eé“S­*@¦°žŹf ófTOôH™/Ťˇ_vÝ Ýď𙓢ÜŰ—˝ś «AĘĐďh„Ó?\!J™/ę6—šéËŽ]˝[KĐąšŃOÝŃŮxŻmô^:T5˙ç ĆŤnäŕ_çĂ-M¦C´Š.ťŤăUőgÚ<ŁĎ ičú„NŔ˙n5¬‹=ÖKiĎM‚ëŘÚRlFŕ©k&g 7®\źMzŮČ÷DGÖßéŁäňĽOëě÷rŁĄzŇ&Y縢˛|HÓÇÝ`ĺĐňW—×HëEkřd|öâÓŢ9CČgş•±N•úRć8>{K,•â_üĺ’ť˛'md†Ś‘řÖÔ |óäT"\ř\‘ĺRź›Đň#%ĺV-ď” ‚tž° ‘ćVŔ2Ęç«9ş1ůod8ÚňîéŢÎŚµtŁđGöĹ„ÝőăPg#·¦ÝШěú™ĎBý'çĎw} ® @Ww'śŰŮäÁÁ¤E±i¨ýĹŮpËĽ»–Ď ´`ůÓęrpÁ|ÁŘZÚańwěLYQ ľ9@ !¶mˇvF[&:b‹T*:wuŇG«ł d݇Ł–(@úôş÷9Ů«f9GŰÄ{©ĺŤ¸—sŔ(čŔ\Ş×ô]é„Pë¤đy“^`€~—8ÁdÉ"!kâ)%0‰í‹qz9«Ňd–ç&Ź#6Ę™ë)±ÄGw੡KX%+<,d‡ü˧ÁJ–~Ëx-[„7ÍŚŢŤj80ťčŹaŃőe}"ű~QhsřëýźÇśŢ¦h yvoŔQNÖÁP¸Ą\­ÓXN×éęS‚4> ô=RŻ=»3ÔEÖ*dřz`¸‰QßôíCEcXŕ&čŇÁyzz˝'­Ť|ů•VÇß±fA˝ÝJw ‹ŞůxT̬›îÝÍ%đgË)ĹŮ_`[‘äd7q’ Ú?ü÷ş[c´ě7áS[IOŢsܱ§"üU9°a¶x&ÍäłĚJÚeYŘiË`Č"źĺ°O ůAP˝‘­Ĺ«‚\ŢÍ“rö›QN'c'ó¬?—® IÄŻÁ@$Öj\í(ÉG.…ŁˇÝŚ< üý0¬éAť@´}|őVáČż†™đ:ß—ô;sk˝ăńeBČ;‡™H59cDćl~‡˙.ç%ă|ÁĽ¤ŕb¶tĐfZ gYÔžA]˙YŹŢ:éu_×č+zAfI1¨–0eëňŰwÁ)y˛ śx¶ż[ÁŃPmm sëĂvó±&ÚL™Î>ą¤•'‚‡óĹ~Öš±n„Ë(Ŕ”ís—šmöĆä‡;‰ÜbJâHyJ ŞV…ą;WËQihM]Ń”ç`Ł}%O\}Űŕ˝6ąVs+ŢŇ{ĐňĄ8Ž×š†,0¬ŘĺxŮ wZ§źĚUßÄí<§Ôkü+Mó d˝·Ý\ ĄŢ­ŢíĄÓ¬ŞUŹŹł–Az’úˇöˇđžYQ.ĐU ‹Ń§Ţnežc6pó]}~Ę úŹXľ¸ ©TŔR¦đŚćĹ7¸ÓÖö@Ě-źÄ¦«'ĆŐĂ ~Ü']ťĚCĂKcJ)ÎxŃk%|í°0B~LTvÔ©÷_Ówĺ<ă¤JŹaéů—Żŕs}ŻGÎdů¶´Ş Ď×Ë«}ČVŤČ׋9.^ ˇŮŹXń–Ö3@Ô'tÓRĽTml¬ů ŮcôŔ#‰dđç=řSĄ xµĂĽü+Zë”čp'çŰg^aJ1t‚™b¶šôŞ&i{„3©¬S´%•Ś‚I7D¤ş™p§Çžű‚«G©é]L™Öí|›ŠąN }INNŰĆHÁMţTďwxÜ’ ž‚‹xOŻɦ ä[‘Xţ©!ß(řą ÉÔOČpY–ĹÂéÇ’Ą¦ÍʱÓ(őţÓO±éĆ OşŁJ˘©iŔ?…AzP€T“ZjP­u+V¶Ń»ýĘÎÂ8O–_QŰVlŰ x¬ :kçţ»Aŕ«Ă|Fšms ]Ç×1‘.ĽF´G†°—Ç”$¸„`?í´,Ř˝ńvÔaşaÖîWóąůąę:űăľäŹĐ’ŚjIŽ¸ąE·ââ‡m č{˝čĆ®XľHÄÄxço ň}Q"Ýżŕ ÷<É˝8ű\÷Zăů´©¨‡L1ŞÍ¤A`'8»ůc Ůĺź©eŤ3Đ–" ,öN±f§äíŮăM]›K§xżZŇŹŇ%ź‘őT¦Hčo`[ر6 A ečx8˙y…ź¸VćŽ `«ó%‚Ęr?IP÷°]üšZŹPű諒#bÉkKÚ šZ{×R)ľâOůŠÔ”ö'[ŘÇ“ůcĎĂ{źľ…• ďE8ő’4–…7îTŽęĆ’v˙ҲĺŹÎ‚ÖĄói;ć:*µ»Î#ćbä˝8ďkąSoţź•Ř|Kk»q +•»Q ·xDoT4%´.Č2ÂçăÉsé ąĂ°_—)#‰l´T_Ţ<Ů‘t·îˇE» űĺÁ-‰"ç°đ&<•íĘ•=<ĘҢ©J*ťţ¦ Ü ť]‰o®Ĺ­O[»Ő5eŢńZ@ 3÷‚)ŮjŰ Ęű»t’ÍĹ—Őot0QC˘‹ťäxµ‚śáŽ|Ţ“%¤­#\ňš 6ýŔk»«%9SŞ!şWHŰÔţ'Äçy~sŇČ_\©‹×&hřošŃbg ô­¬[@ë€shKĽ„s|Ç˝„_dăČí7±± m1Ă‹´F§hwťÁ˘‹Î“ĂäéTÖüţSšäßú|äë ¦ń2Ü<‡ĂśÔwi Í}2sí¶Ň˙%6ôôćoŁG¶„×Y¨–MdŻRU eíí23˙°idĹýţ”PfŐ}Ĺ*?‘cMôµú5éZî˙´4çęĆtŽ“÷‹Yed-a“IŠŇ*Řő‡SVüN#űšOxÚy» ě˙Ę™ŽUĘ cşńŢŚĎŐőZşŻNôr- \Éí»Ü:áĂő'ÉĽ—P±ř›ÓĎ"KéńĽĽH€•ľóz¸ĂĽ = ł75l69)c2očĆ.F"łŐ`Ľ_ŁĽŰÖv‚&ĹoÖcG‹xsp+u!ęJľ‰söh–źóę® Ë{Ř U)Ď\ŔĹ‘cÚ‰úeŠ>¬ǡ­eI8©’§†Kţ‹‘*Ĺű¨~©ot"ő˛ąç~ÚyƬ ·…óTGüęˇűŹč§ĎĹgÚń5ÍçW LW;Äz'·‡s˝qĹ\óe&޵ĽŽ¸*żŮ'§úĽ4jhŔ—5Ń®nÔUýťT˝ąďyVd"e>ť6%şńFZmk1Ř,eE,ŚŻţ\YޱÜŔ •µô¨iŽşÜ˛×f-CÔJ|«ŕ-~’1 ŕ¬{¸¨—tm«ź–‹§ŃžňIMů#tőއçîČf‡â4‡aęOľ~Ő¦ÁĆČ[ľW— _˘6Ľˇ˝zy•â·ţęŢ8TŰý¦ľšUěaţĹć÷"©Ý)s2˛”w!;řNŮ“ôË RHY?N^_“;lşýÔX—©§.4Ň VÍ72´¬›Ů‘*ď*ÂUłâ¨ŃuɟР.]ËĽ!3ÔĹ\ôÎmŚĐJ§¤éhŚzĎů˙›–K AÇ[¦Ď]ú˘%??H@Ľ ¬˘¤}ÜXŔi Źc­ĺD%Áz^ŚX÷·Şś>D›1Äëć€@"x‚Ą*&ţ‚%¸ í_2Ô´ŞQ ÁĆ<†»yü€¸Şr•*˝} ę”č.T0«m›DŕĐâEq—X÷Akś…D-žrçÓ4Üv,Ś2ô]Ň,>ĺÁ§#¤şn-¦ÇçíĚZ5™9D7…µ<Š$qčš™óĎ2D¨XžmX˙ŚvĽS÷(p“˘ŕąíj¤GDŻęQ[†TĂËY˛ů^F>¨Ŕ}}ľ‹›Ű†jsŇÝěŮŢ«F/ŤŘň)µ„řB'±dr‹DÇuLt‘’7ŇŮđĄ›Çľv…Î$Ç*t0-h(= RC ĆLß–-!–QîQŽŕ`šgŇ=„-s*Ş2Ő×_á@/¬ •(xk¦dZJ÷n«růĂnȨsĽI0ŰŚĄ@ěľ_`6ęÁ†Ôk˛”k÷IKáđŰ)Ŕ:áĹ-ÂĆ0=/v­iD3‰}żk-j®O«ľäM\@˛'žĚŽR˛eW÷,2ń€•W¤ťÜÓ6‰ł¦>ˇőťĺ®Â\R<Ă%"şütöţšťvč8{6mtG¤’Î+ôÍěHwoKu0×(;¤vĽ•dżç“JÁţé0jvýÉDVWhť»4d0cԇ׬ňĺ6¤7éŮPÇNĄKWńÓCěK9eü!¨bɶ•=ҤÝqäF—\‚ŠąD{\Ô­;UE‚Š7QTĎtˇúŚťç|E;©ˇ@ äqY‹‰ÚDlTÓĐĂÖ7\ďSôł_Dž8…ĹĄ´6U“ÍrOmđ .ÜőúőA€˝»`˝EĂ`űîX¶îŢ“˘4PŕˇX‚@›uwź”ýé]śî, 3{îĚJv~Ă:2ť Ł˝ŹŹqO|;ŔŘŰ ő!ÂÎ#ń«DÍÇźś©âG€?gvKĆL ’·ýéWťuj±ďńrŢ`[Ň>Ł˙>·ý`÷IéŔđËkŇĆV8¶§w÷9s“/4Ž°-꾦Ą¶Ć ,ľid>¦ăYÜÝĚX;ďµUZ=ń/ř{\_©{Ĺä+éR±ü¤VůYů 3Ňo±^ťÚIŢ fÓ–^>QM¦ą$P;×>ň=‘Sč}<5ˇ#Î5=…­XU! ă1«ÖŔÄ–’ ú¸qHp…Đo¬Ę#j÷çýčÁpÂJAąC%ü …vߟ̍ű’pDŘž¸†\4‹íľ+QeôKMđ~żÎݠѬ՜4`?ŮZt>›@”ÖR0’?Ă=ý§yc OůéżŢÎŃÁ1•üŻL 's„»NÍřcęőKżC2r3Gµq(ZGh8CR[żóú1Y@fĆć¤4p¦ßUYőLťcÓZOă˙ŤčĎ6śĄŁ±O\M8/ •^łnn4˛}úđŚ_Ţ*ŔgĂo5€t›ł1[ץ·†Ě:(Wn/}"Ę&LkM`§ú;±łYÔňń[čłqľŮű˘ţm÷ß 5ÓBܸlöK´L<Pˇ$í#¬ł"{v@o|ŚxDn>ťfN›ç»˙ş‚ €ú.˙ťˇľÖč˘ep4P ŤÍ­aşŢâ#¦ĺrşűO ŮŹ=q.OČe§+¦sťÁ¬ú­0ÔSś7í·Üňlöľßŕdôşß (¶Đ ‚Ć”ŕö zG—iÉąB{—9ľŞW\^Q»Bmv©çUO3SöÓˇh˛c‚¶ŤáŇđĆжÁęyINkŢŞŻÚć‰cwUv:wĽĹ|ßy¦×…TfjĆ7ß+íţ‰{ł„ýúS@±4<bÓďĂwş/ş  ¬zďRŽ ĘG1[B’Ć(ä¬çë‰G2_C„şB>Ż;­Ąź”%nb«sŃtű^(Â8,5ľ~±Iş!śňÇȉjö‰˙ŻĄčś<ĆÖ6ř“Űz1–¨§—ebeŕ‹ëńţUöf˝šDő‡]»ĆTÁfÚĎľ;úSE˙ubZî·’9•¤HcÚ”‘ĘKŮ›©úŕ|ŻwFż‡č“ő˛†ťĺ!$ÎÚ—…c1sÂyŽ#Uy…6Ă@…ÁÂW~Tfµ­$öşŢ&Xţ>=ÎŚµ;• ˘.ď§ŃUČ,Ţuä¨AL­ń¦" KťśÖLfűçÍ”G'_O#ď@Ţó寤”+>‰#µK8L¦ŃđFć†[µě†'¤µČZ Ýúă–“Ú­źô¤u…¸ÓɢłŤH&—¤ (zĽFwř&ÂŤ1  T“ŕË%łŢÝĎŤYů©ęxű™D `‡˘Ôšđ–x®!Šçצâýä˙4zř—ýńÇ&ů¨áżSJ,¤Ĺ“nj0ÍmRÔń0ńqż/ÉeÁ”Ř(‰ČĺĽbTĐăöŕmV˙V'~.'±ľŇ+´;Ź ď9Y*«¬6ój,xMa>u.Ś°§b1Ź©ä@ {VőÂŢ"DV6Ĺ&ş4n^Fř]zíFf 6~»afĹJÄDWŚ„h–ľ-3”ĺčhÖ”Y˘Χ|"YIÁ6Ú.ĽO·AqEh=wűĚţ(•^5®Ë9:†DŤ?SĽdC¸N¶Ő·ó«ĐÍđxžę}!)oŔŇ VŹ:4én˛ rbž+ßŮčM·.—ĆĐÉéťP`—BZg»i‹a8©QődęŢg#–GŞ—Hîěé‹š+˙î˝LŠńky»µ. Qgt©@Y˝ůcřĘ„mňŽMűďFú‘L^ôágjścß™Şpđ"CńĄRŰóN…ť?ăgţŰP)‹JGáxÍß kýîĚGë”›žtÔ Óáb’qmÇĂR?˙žUńm\qăě˝}F57# ˙’.;#ç÷ÍhŻa°ďďď±󠱹,ů2aßŃŽ$! {ü;ü¤dÂCx=ő©|o¦¤ ·ľř˝çŻj?އĺőyÁˇŐ”ńˇ=gBčŔS!z/¨ŕc-uqĄ>4¦î’ńşßÄţ–Ń<­€ÓI˙ëD(Ślý»$[Ż^Cí•°¬3ާ7Q’T}ÝíśČöpöţńćěMéZö,ť} Úţ.{m—+|^(I~Í%É·Y&Bj‘Ôű‹Ţ6—„óF=ngÇ~PNŁĄÎ™jr@/Š˘bM^M†Ż/˘^-?ŐxSçţś+îđü8™ řÖ2ĎłţC„7˝Š(‰ç»nÔ(5“Oľd;匫H§`=XĂöÁ,_kŘ/čŔ(řX&ťĄć‡…ÓpjűIđM" Šqĺlpâ‰ö7ĐľĽ>GšJ-…ŚŃ#˝qě};Ĺy†<]·ł`dÔ­Íxl~©ő‘ŤqX/ň©.…ÚŐá˛řjŻ6s´OÁ’‹ÂPě˛ôţľZ‹łTb5ÉbËĚćŕÇĆr†żě1)<ճç.ň ý­/Šö‹łÁŃ'ŮÓ&|BH)»ţů+Ôî‘Ô<sÍ°ß፠Ň,cÄ:Ň?µ}›ä¬dőçąąúŹČüé m×nQą¶t€}‰,čµúVÖĹvÇËđoÉfćď´†˙ű“iq (4*{ î~+¦J‘IvťµĚýjbÇ P GŞŐcI;o'΂˙iŃÔÎ#”@–ž,ˇÔ!¬Â5n­Ô`sǬę{ę˘E€É§÷GWN™ĎŘ™2W<`GT¬ AąĂF™Cij͋dAŞ­˝Ă˛˘ŕŁ^?ź!ĎLfLŹH¸8űLÍę4×l…*Ěz†CÔÖši¬Ý¦´A”ö•F8˛ÇřLĐם[k=)ÇňĆ^‚Ťv3s‰ÚOMŁµw~oąË˝–§UA¶a’#ö ËÇóë4{°ŤSąYŞ%śTln‚Úťó­Ň)»Ŕß\6»=BU¸@„ńHTLŃ­˙řW]r<,mS˝1aÍbüě¤!Q‡wTg·ŹýSr€Ö¸Ő™—µśNhA6Vď˛d;ËR­GŞŢ:Ú„RȡäKÝ®’‡űŁvY]©0ĄĂ[°'’HJ üšÚćżwç$í]–BAŤAn†G ô)}]ÚCkâEěŤ ş›ůť ŞĽsw¨a“ťĎO“ó“Ę»‰Ć[Eśő ’M’2~Źh§±űŐďč(VŽąAĂ·§äA3µćłěc˙yÍ/ToTžŰK¨‘bq*M¤ô„2ôŰvĺß˙ŕyćaĎHĹä –G?ˇ zHz,:Ą,$0Ň‚}EíŻ"eKčÓŔ>ÖŠďň*$˙!îhë$©˘I‚D”,«ő!É“Ž¦’A8ÉŁőČ]©D€ŠŮCÚ»-sňU‘ţ±ÚmÓéT03cŠÔž;ýěA@ż1›ßĺŕ-¸ –„ßîZę˛×ř N’4iˇÜ˘˛#´ŔÉĺęU¶bŐpź p?‘Úée ]oů$­ŕçH#»@°ĎŞ›4©6Ě®nÁC©Ő. W‚Í÷ŽŽyćpŁeiÂxůŮUŚßĚŹßS0\„â2l Úޤę§ßĹéNŚű”-ü۱ńŕ#Ąý“˛»üPď>­"b9ôNĆť¸jO©]hI·y⫲Ə ŹěŞvd§ZÖgŮeS‰űżŚ =“j|J4¶ś3g^'T)2X¦ç_§)łZĄcŮÖ­3ËÍ4Š>~šŞ$…Çř¸0ů ů%mĺ>5˘o0ăüAo«ňss=ČeÝQ[ŁW•Ră™XDidĚţżęC«˝Ă-§3čăOµ§żűá0–•żĐś—qńo6›oĚ—Á nÝ fŇř}DOłTÉßjs` 2ĹÁ¦Ď"ńÉ}.KJŢr^ó=čüIŮ˝4č č´„őžJufTń‡j.Ľ Đá@óGľXČ*ŁŐnL§_úĺ4Ý+ëV>đhŢ?45Äs2ťb č©* Ł0˛’ń3+>Âlźf{í}X51µ™géBă‰|BĐĺRHW!Ť3ÜŢAP¨k€Ö'‰‚tä !ő?řh3řrĎ~ŤçNŹAáÎĽ˙fhřŠ0L¨Ś7Hşź“ śäpó!98ĄA˝G« ´HJO5ýë˘ uňS#cv”â—`.’޵ú¬b‡ůIJͱ‡#$ÎŮţ0ëě¬ň |mĆďĚ›ŮyŃ´‹….%›?ü±ć>şćËÍç =>˝ŰI=ą˘lÚłĄ‘YţRȇ ë·´ĘĽę‡}ĎiÓÄ6ľłŹÁqĺ3ú˘ŹĂ á §ť/ĹĐÁxÁËOĽÍâŇÍ˝F@B)©6D“ %KÉ’gIŃâ–¤yČl8ŇTę‰ofý®ăZŻĽ[źÖâÉJ['¦’˙˙}ˇ©myěĄ,ťóşé#5’]D’ě6ŠŐˇ2-ýnćŻpÄo¦…«ĂźÄ€HCźŚ¬۱'ŐÂT#JÝNNOË›—†FżĆ¸•řCŃÓ,÷júy}¨>›{HuE¸ëűs";A䦴߀ŢN–Äs¨ýrďŰšÎŐ±˝á ŇęOB*Ć ô.î·zÔąé/§r']ĹßńAş¤ŮfF»ˇ+SmSśŮĘ #ôsęת0Śg6hr嬭*š`aőôŚ¦áß Ůc¶Ëćök,"řE!Ľ±`ŘOĎ·ŕ ;í‰˙W:í)¨C¨Čy“ öéÓcI-n«úU7÷ZY×3gŚÇ<1'÷ŵ9V|ŹËŽťk'đQ31Đć TęěóŃQyR@š"Ü0ËájµŽvža÷ &ˇÚ ĄýŠejŻ4­QőHfą…ͤ&@ÉŔ1lc6-j­[ OEěÇ}§~“©‡Ě\C‹iiĚňjö~fź Lť#]kś™˘ă“­ľŇ2'nŘ_őúî¸ű /Ş r*Z÷(dób<„3„'ŽĐ5ŚµŠîü±í%°ődć"vÝĂ]ň‚›ęS%˙LN¦ßěfĹGĎG+ARóč="ö÷ĆéľťÉâĚťľŮ`4ÎM•ož51ČBçW…ŘŰ7Ä—›ę™Ń•xÖ˘J}¤˝<ĹĎwKޤYpĺŤ~úőĘĚ<Mf÷)J,*Ő:xĺo›¦0ýzŹŢcˇ‹ÍCˇ!Δ` aÔÍŰÔ•Ë÷F¤ýŃ'vt§ – Ő&Fžôg{ůÝ8ŕܡ\Asp.TĎ<íSÁS·,™%A%ćÄGÍoŐ폄üNCr1qtOČ(°ź, ˝Đ›Đ‡’˛ .puΤ‚qíđl*!Á ź˙ĄđŐšrGOX¶ńz*“©|—=‡ó  VÜG“KĆĄţÇ9ŘńůESąĺ`ŰDÝ ć/Ăą™™Â QµĽâyp†pŽ*m,麊J®tČ śÓŠżßŁ˝ śµż˘'L]k?ĆÜ}a˘IŚM°®°e·2&dph”P ńP3—TTcjÎ2‡ă®É.”vÎ? \Ší.ĺÍ3-Ăą´1My€`ůś;Č·÷¸·j‡©„öş–4î(đąşó*wsŇC^U]˝^D]˛/'+ęűFÎŢ’łÝž’|Ů-ąMĂ:´ŤIĘ*»Oç…Y?`=Iţߤee–0pO”41ъʆ“-Kމäpˇ°6k/~űłĎ]ň™©=÷’ŁóE_;Áqˇ68wTˇqŇçŮ´xaTF`‡'ß˝z7)ń< Db&’ *„ –×f›Y©˘l 6#2Đ>Ńí^­XRŠ5Ëć™íť·‡Í/\@Ş.ăă…Ż ŕ \8IKĐaí^hÔĄ%{á‰+ť˛˛c@ζPŁŔ:Ľ[ť1svßéYĄA±m×%X ü˝óę~U<ÍńŮ’Ť •´LÄŰÇĄ˘Hř ÉëT¶J1}Ý™š…NßĹÁÍń©Đ÷ˇžµ6Ú[näꢢO „† Ńš˛†ůĐkP}ŐJ0:ľ‡pË)agÖ2·“çŞS¶ßRâR\ gĎncjcŕŘ/Ć…¶um†)._8iÔf/]zT0žżŮŕ[ *ĺ¦ý•ĺ`3K\ń`,3‡—FŕŐ,«“i4zš€ct©ůóę$ăÉWÜŻgĽAŢË:ž¬ Wĺ?´T÷÷˝KDő’+a…Ęđ=çr đ nďĺňu ÷,\’Gç¦ĘHŇíR‹§O0—̬0™yă[Ŕ·! F' ™¬ReFŁz^™*Ókżâ=đtKż*¦=nů[xü({ŕZ¨ňoe‡ů…´tÇJůGšD˙šĎ/Ţűd¬>’Žiw‡$Âb?ŶjVxižow…Ć)˛˘±2Să¡Sż2'‘č~ř4wjĚ°ůˇŢ«*Őo’Sď›óľŞA+rjUövW:(o@UOŃş7›uîi®4~ĂŤC|J6řwřĹvu+‡\×HEQěür»…sńü㱨öMÜş, ëŤm.(ŕęťE”`I.ÜX+R€|ˇMÚHJ—2~\F ,ŻuąĽcďŔú¦_E˙|'~$ .ĺ|UmN»¤Ýś.ŕé`çÜŐmd…yF‚ĹžŔ=ŞĆh÷ŽlG$ĚŮOŘđw˘P…-Gę‘Ů].•pâ%ˇęcôĹŔuâ űźG§MO#0(K«a%ZmKŕ @m8‚EWů˝˙ž>S_˙á0oľ…ř{¬3ÄöČ&42…ŃÎFî\i4€ÝÝ4IŻtv~uÜDz˘.îM'·â{cGŞŚE?Ř ű†Ë×3Š/Ţ>şJî€ÚÚ*gmRĚĚŐľ,íw5ĆBÚ,IäŮ®”ó“Ě*˝űł±Úlîki‚‡rR©ú#J‰®îĽA=)S˛Ş#Í›"Í' “7ňb­ćZŰą żĘuíĎj“ ·€˛>(&`ĎÚágŠ…ŹŽŚť,€ eąršg¶1Ü>g.)áPJ\ŮŇ~Âůá‹®úÝf†AüĹpŔ*ĆĎ {ůř ʤ?vG;·ýŤ2ôŕ"wűg¤: îäśWq-±/ĘűL 'JŰşâö’ÓÂűččÜQ¬Bă?Ú'+;”á: ‘™AŇŚ&Q}AEk§Ä!Ů|xG[ę{řMž˙~†W¸\Iks5áWyëäLČ$©S Î:8ßú*ÉărţU…&řDRµ‚Ü#żg•ĹÎ3TVĐ|sKYjőZw‹ôĂU–Z˦.V?Ů´®· äîľË’IµČ*j]´ăäÎ!¶9ăťč†ÚůmßĎ©p“zŞa}Ź( 9ZBC]ď7»@ˇ˙¸«öĎeŇľb-°8€KZĚżG©^x<@şµź°g‡Pß&1±\ĂodJÎ]G ×P¶´Óuš7bĄi‰L°Vč \e\ߣŮíWěPŔśý5f4ţc€Ł‚öd™Ő5z‡H1BĐAOb)ŐG`iÜ;Ý‰Κ‚1ńr@ŞŕŽ˙‚f8 xJu+ť)Ö?Çw¦Ë'ŚéŤmÉ”J›«ĐÝä)š: f …x\ßŰëć‹Í…=$ˇvŃŽŐÁĐ xk™ťD5DbCľ‰}#wD9uÎů’Qx\7 ‡­g|ľ“äĎZËQk ˛“ONŤëWčc’ŮŽ]ŢK˝Á=Ěo™Ŕ\Ű “Ýëz?Čç{έc°"4ĽĽ†•ż+§6‚:ľ‘ęOĄżÉQBëE~Ś„xd|O0€këď×áćř¦I‘×SbxPo÷µhĂŢçFł·%9 ×H'ž%ąŹxŰ÷jľ:ęŞá 9¸ëq™¨<ďů±Í*¦´ >!— Í^÷˝>Ăqš‘vÔ pOZęa‹:™íIoç)–{tQ N÷wĚ<ŕń%/† ±:fëaJú¸„#7±šžxú{u›ŠQs˘ëOTíA F“Ŕy2tś“uCßŰź9,Ç^]L}vpŃ<ěä g†–„Wy,OgÄ‚"f1=MÁÚçŐö߸/őxqf#’}o+;oaÜ×s©§9Ü Żż#FŮ"\ŃřI¤×Ć­ď°Iđk¤€€I¨GĚ~ŐŠĎ‹[$´'3±Jeź˝Á˛vý.)f~ű}™qó—/âMäd/ů'~eu!ß˝x:ÎPŔúĄĽŠuJ§ă˙OVzůÝŁ¶´™=ż{±CŐ‡Ťě€#¨lĎGů^ˇÚŠŁő(–ŽËŇŮŮ…YěÂuH˘ă!ăyFV Ž"éŘĘůj‡ŞKÔô˛µń4aÇ]łůaÜ÷¦qŞß¨ě(rc‚!PjŔXŮS˛d5$J¤fCuL9p†ô"j'Üëi‘Ú–e+}UbňC¬|&ČĹXĺ3ąŕ5˙=č“úĹW [x©‚çy·FđsC6Ój‚/欑óŐť=‡šô?0ÇŐ’·~És,ŘŠvť˛6ÜŮ• (Ř–ň«O90'łÔ‘ˇjm¤¦;gc‚&ťBÎĐ" ˛÷æÄXdg?(q&â©A„°™KéH¸˘XW!—9;Ä‘Ř 9émĎ:48-Qh÷<•Ő™]O7 xî#Ü°KÇ ůßřsVqc:×ÖE‚ˇ¬NN;ôś"0hµ@~SznevJ ˝.Ő”ĺéĐ?HVĎUů{rŁnzTd˘„äŮćýËÓŹ®¬˘ ‰uMM‚đşŘŇMt¦ÔćIeyPsúąŤ€´m'Ů"N1`ÁÚ¨˘-IŰ:óR3ŃXĂJ€éQĺrĚčPS má;łźáo%ďz«PxCá:°#W7źoją˙O®«ET †Ďá{›®ţ&Îúç_„¸ś«VĆĽ~vbKĹ;˘‡Ž¨âŘ0řŔO~*Ź“®öĹ­˘ľs€ůp„ aÁ·˙ îLjÇdť±Dü€˙ç¬kŰč·Ćx÷ŽăâęfĎw{ăTŹ™Ť€\ҶiÜX$˝÷¦öţË@öv)UâPMM'î”ćď6ɉ—HÄ%“WŇ]šű&˙“‚dÄB›JWÉÄh$Bâł,çÝ@7 ©82 ő3á÷ ϦkÉ4Or ĺgö6Ţ–­Ů”(x~`ťű—ď“Ś,‘U\űSü)W˘Ą¬Ü ˙w˘–Éé÷ä:ďĺĆń+jŢDá_’bb9Ü3G’ŻšFt.Jä\Ń´˙ń…˘!ýlŐîĎQż«ë÷fĽ–k㙝ۅż4 žśLŹk5ĂńŤ¶Zk‘E3?·‚ŤC ]»KB™<´AŰÎŁI°ŕâÔ Ú®öţěĐ““żňˇ…uöZ„ýő— =ÉĐ®A+ů4†ňiwî¤zŰź÷#1ÁĐĂŔmrÇĺýđ®ÉU,ćx÷7°aهË# «oe­i·ŞÖ¤Žwz`»y˙<…őăŘÄěkţ“ÁuŮbz÷,kÇ||÷Ö/ĐlÔČ„*Ý/ýăőŹż©TPëŻD©NŐîšpEHl#Kť)ŽKB앦/j3±s(#ĄYšľd_Ľ®#Yçĺ”AfbŘ„2°}âéÉ4BHyL!Oč‹śO€ü<`ŃâäŘ XĐwŻ0 fŮŽ1šöď¬! ÷¶DŤBZ±¬aô€nzP hcćJ˝§¨†çfY+ w"ŕ ݍ鴶ކvŚH3ÇF=aLŔ~¸őź|7@ ău‡q[˝ÇťMó ´VÍüëÎ[Ľí÷âřÂ?Ć×˵…aÎW. j` ©ĺ^Ű˝q­§lĺS¦›śÔŚ<çŕmźStE{>­‹cŽßl/ËŹĽgĄsEżfڔ璜psš˙+˘Ź}/@PŠ˙4NěB!ŁpµI‹V€3ÎäóŻ›.Ĺ]á)YĹŢ˙—™í‘lŐ9k5š÷ĽťlŇ=TÔb1}1WšëČ\)śđok»ő Ú>SÇbî0p2AşsÝ+íí`‹Ăńf ôłWRŐřűRŰé[HÉb,€Z ¸´K†ÜĄ›íbÄíĄĄ'ëCµ™ó#5)4{†Î€ÎyăQ› OŠź…ľvŇVľ¤ÍĄ± {r7Şńć[ś’hűśM§¬.TuĚm—EśĎ÷§9,{řXÎ>]—X=kQŐ¬¤;[Ť2¤7nČEüYLý3YŠXTbX!Ř—=¦l{ěîŕ{¨_,„ńlÍ$KjLčš<Ú2l;‰ĘÇŮWËb&´“ 6ă%Śś$Ş„n +ĎŃ‘p¸ĺę<Űź˘w03˝@] ÖÔj©>O`™°Ú‘-·‰űŃzP2çź-ľXÓ ú`?qjŢ–L‰%Ž çÁúžž%+.R‡\ \OWwüşŚ{ ŚrńĎ­3,xX*Üö;˘# ¸Q# Ůë#Ü"ýµA˙v~ÎH·čOáąÄnč ”÷ĎŮ"3#¨ŻW7'hŘä™=˘BşŘŰKŔŠ2>Ź˙­żíô:í%zż.ŤPă;JöDÄý¬ósŹÔ&,JŻqŐ ‘¦źË ¸u/ ©řÝ€ŕŁl˝˛ lT‘âţVî9[.Ýqőަ†÷ăHę*´h‘ϤŔł *Î{e­ĎȦ„văy:řBű}<ńrÚ«¤ň(öąÚëŻ_˘;;°•ŞJćnďlüÍŁŹxÄĚĺ lŮ śSZř‘3§,{Ť<¨•Xťłujě ‡±AóćŁ1sýKʨIŕLŞ€ˇŐ?cg,I2„Ź´ôVőŵQŐC}ňúľŇz2€6ý¨Á^©Ż†m†#mÔţ3‚íµÂŃĹďpATy˝%˙sźQčú<;±őŮŘ(Š!i“±Łşv2ł_P‚ěňŇ2ňéÇWˇŰÍY;-’ĘU™ s@N–3Ąśŕ’ýë9Ϧ/Ą.—Đ•‚¸…˘ŃSŔv˛ÍC®}lő t쥖‘żJ1+ŞŰÂŐk\ ą_»U_ŘRłg®eŠWĽčv>ßiĎĽľ×ÚďJ0TÚ´€a¸M·‚©ÉęÔ`Ź]HĎN´ śĂZűâ`ÉŮŰÔ%ÖÉqR%B)4ṇ!ú‚ę‹ô=€ FZ}i Ő7N×y†(Ť«°O˙Ť(&A›Ěn ÍüV’Ţ`(S Ż1¬…kŞT"řÓ2Š„îsµNµöř~48tŚ˝Rm›úĂů‡[bë$¶„đ©2Zqď¦3DdZʼnüREĂđ¬«îRŁGĎř…ţź›o» żŰ»ś¤â Çk~ĚďOéT[; Čéy¶\ţ‘OlşŹŮE7†]^#g°p˙‹1EËá¶2\č5Ďm„c#wVŘ›ó>•cˇ„ˇ`ť˙\8 „ÓA64J Ş+Vů†9}~§Mý“[ë~¤EWŻýˇëŕöÉĽxŚ}§bÇ70ŢŐ?Ö§#cŮ}ń´C&úf# H^ŃăţřA ¬)\˛ă! ßÓůŤĎ‹ôŹ]1; `{ óăŔň+ eÝă®XĎŽçšk¬F#^áCš‹°·I˘l8Cw53«ŤPoľtéz†ŇŃ};÷;CKěŽÁ zµÇaç“źŹ2ž[–ĺjĆońšă]J±p6Ę…Üî,>“ĘRŻńÚY?®·śTő^ůÝOHł X€ŰUL kęÂ/1ő§8LP. –ÎŻj¤ –÷2»PÄ8&›r;í§™:…ĹęůPÔËLE§owÔúžKYž\J´őŐow ˝<ÁQęď_:×: Ę:ť–Ŕ3Xţ '1čŐIHSË„Ë.2÷ŇeŢ´ť'9łR_1·›ô`işMčË’"UČ'ác›ü¶ÄNö “NŞ]đűâď垬âQ.ą ä!PőÁ­qîÉá}vŐEŢ„Ku@ą'y{IJe|>@ŽřF;“KŮúŐßQť´ä¶AôÚ^ôÇ••ÇRŠ(”_ęą„çËE]Ȭŕ,#Ľ ň‘ĄŤ” X0AÇÝl(žŚqŘ_‘:ĽÓE;ěcqRÇ4ŮHýuĘÁ”­–2jŠÍj·· se9Ăs]ŤsVH°[d°SÎňÚ4ŇwŕŢ:÷ŠFĂěP޶«A™’Č—ő•ô?c˙0l¸× q&ĄţÚâĹ%Ň«d^Jٸ *“Ăş•7x…uÖź-ÝkŐ~’2Ý•üA1ččćq l˘€ú0´ČWçTż=ŇpRšGâVNŤ6,…§Ŕ >…AÎj“âd3`;‹k$Çe3‹@x)ńÖŐüéÍ?“=ia)‹ĺf%BbgQĹ$™÷yl4§§>hqMÝiĺL>D6OňŤŻx»ĹÉđLü™C¦)ȡ`u^Ťţ´[“ŕ‡ˇ{@d=i´ŻÂg9"ÜSśdV%)¦X!AŤĎHžNŔtj¬e<Âľˇd«ŰęiCUÉ5‚ŇąCâAŃIutÂÓJâQ©3Q=V+Śă˘‰AőÍť Ä™%„`µö1á‚$őČceߡ]^Txnż'çD˘ËÔl¤¸inŠµ;µďĺ'‘rć$6ˤîŹ#…öüĘni»ŘĘo­.Q 4“Ú-ĽúŔ€»÷°ŕú|>Ƭí¸Č»\©o´łi˝nÄPöRR ¨-—Đ–+Â8‡b ™Ł˘Ń˝Śű3b§Č©#ńVçËşöů0:)^‚N˘»]J˝×ﮂŚ;ęĘÁj Ö+­ľ°Ď0#µ„%µĹhĺî4 ËËC§Ą˛&÷\­ş*E¦CĆ{kÚĎâ —ěŐ\-KĽvÂż‰&P™=ąČf˘sŠőŚë˙®–đN«„i`Ůď÷Q Ş&˘°mŐ'ľµÍąäřÝť’ZőBŹ†®S[x©šĆO  V2™†‡ĄÍ0™ŻŮÜ•á=~ÂBęáÚ<:$­â•Ńö€˙ó·W]ĐkYżĐŔ§DuľhŻv§Ű`ĽK06 .Ľ#Ďb—=÷m#ŮÓJĺK ™»‚Iw‹âToż…gÚ„x˛"SŮüřé+p$(^6üis÷ҸćßGF˛ÎKś± śĂjŰo$äUÂ\ťGef»[ č-Áąˇ¸Ţ…Ů3‹]í{®`YŃ{6ýü±»_ołĘ±9ĺĐ(–ąO–é ”{±ňđâP ĐŇRd›rĚF~x °]jjÖôCöˇďş·ŻŕČćCVk<ŕE=ňHčŢ?V‡…´ĂďĂőÍpJ?ŕđ.źşÁüMĘż˝żěôtąçł|ÔĐ€WJNK‘+ťmăĺ—źčëVžăľăşę.?­=ćÇŁ¸őôal*DвcEĘp/´ĐU™Ě‹r ÔW‡×ܬś<͢aĚ~mÎÎťÎ[a4ń ÷Ö5‡I‡sĹIĘČe źűđ(wŹťŤu—H_ěŚDzöĄqżsoô¸qKGҤ´NaAÎÜ>NčÁü& H8w1‘‚ŞęeżCg KÖ”F4FŘŻÉB9¤¸­R©˙ů*”Oc^f&ąŞ†@ýSbÝMźe1é¦ÉÚsźÖ < n˘žyÖ§Ů×Ĺo=ăîţZ/ë˝ű[Ř•ŘĚY<(ţ%xR7ĺţM“wÎhď6MçÖÂ2´U} âńĄË?bvPň ýcYÝ˝Bß.,•Séún3Ł°hč$,Ié%Ďü=č+ţeFTńźT­…Zaϱęs%ÜŽeŞ•%$ĺK)pł†€.%ÖWŽb,2úÔĄR ”Ž/dz2'5čţ8eZĚAESM)"4Uçt$ň%€uÂľäł+Ř|¨6ĺ"Ť¤ÂsĎ˸m–»¶ő& UW(H/`&‘”KŮÖŇ•Á©j˙ăČęŹdöĂ^p~Č ňó :aí–`ÉżźÂçĎQd?ů SćËE'n1ü(Ă« aŮ6H`áž´ŹŐF”¬K;¶}ą{F©A×Bő¤Řî^Żű1•”“ľm»ᕆ‹ĽQ=¤»ăq•,[=Míjµâű»ŃoűÇg 1t n.Šŕ/ÄÁ)çÄk̨>Ç^5— ĐąőŃ÷żNn§ýŇ;/Ť•nř]űÂ%ŽŠóüŽ¶|¨ć(ÔÇ°ĽČS™´WŁ¬^IÝăí­BŹ>>¦•řTŤ©oe˝í`Ş˝ťěŕ6!)¶×Ó&&- §ďđ^˘¶™;6ÎůoKüv,‰¶8‰ˇ,ÝMľÂś×KÚÜÜU1—ÚNÉ°•ĹgPĘ+¤rř쏄l_ję&/e)IĘIp5:H‡±‰xµ^#Tľ‡R´ôÝé»—b|’ÝďR˘ÖîľÁŘD9…dmrOµé‘´ED6řr:T[´ßĆ·ŞŮż-ó[ýÝKČoŰăőŽĚ»ęˇń µqć5Şt0đgÝfFÂŕ/”(9ßńOš_j¨ý3cx4V&ĎŞŮđ•j€ßi»€óŇűžůŇ\ŘmŻŁMpăwwLEßRLXhťÓdÔ 'ŐCą¸89.‡©j…IöKş€-Ő®2Η¬Üń5ň÷$ «ŢÔř|+|hôJ–’CAo,ÝŤźâWµ ú6Ë–%`řŔO{w ÜB'fo—VíuŮ÷Ź™Ó‚4_U!wS[źcĺMA-Hbó/a©«[-†•Łčí|áí7°~¸ć×ÂK:ŹĚÖščnx×`ď@‘Uöî‚Ă-ŤÖ”eďëJÔ”Öôôá’án*HZ'˘t‚Ť$y)ŐrŇ#’˙Őn_±ëěX]ŇY©–—*h k@p ?_©Č…Fôk¸ÎMK ›cź ÔfÂwśž§¬­ y—[‚ČąŰč‹kM«Öŕ Ď—RüKYŽťî}]Bíű€˙ů˘á—, “˛( !· µJ¤—Ö†ý÷řJUżÚ«XŽşv[î“ G™:tQ.2aˇ—0Kĺaůâ )ť VFÓąÎnÉ"B9üVÖ(& 3µ6Ô…Íô3ąR$Ô5«úö©¨ţäP[śŤ=¸rŢQyEţ PřŠýĽ@ĺUyDˇw&fs‘°o¤$aîN€bŻ#D‘ŇĹV·Y4{2ś€¶űP!Şf-ëÖ˘”Ŕ—'1«â[XBVŐ˛ šĹpŚiDç~ xÝžĽŕ9ł67•ť«ŁDUzŤţ`YjMÖ“&_¤;‘4 ń†.śI5ďP–leÚâ+Ż]Ě»ž@Ét÷W!Ëř‚čŕ‰:áU¶Ő;łGĂ‚!Vsö}€O/ŹqZ851Ńů™‘k4"ň4ÝSĘš*ĐxŠ?ůßh|©çʬů/:ë74‹ŮţÔńr‰w{Jkîť{ô”ń˙´§3[§Ůdň¦Â÷dŠĮ̂…iĎî8gňĺ੮8€Ű źÜ"™“Çşˇ€*ó2Óţ_%j ×â§x‹ď^ŔłQćĄ4qĂ—>™mĺa ¤aZq>˛ ‡ÁżĹĘVcëĄZĚD¦qâŠIëëˇáL<'ů°Íc+ql˝ćeĂ^Cncëo`ĂhîĽ:ÉWżđĹ”żp©qsŃJ¦ˇÖtń5ĂÔ¦k5—!ć´‹%vN6Z‡¤ 1şîv×Ę˙Ś'o–ˇÉwpTŚ .Ľ÷řBö9T‚#4f ŽSŮYłôxj ¸V˛í&Ů#„ĘşľOó:ź’źZLäď•Y*5†¶4ÓĄ;2Ř&Ť©ˇ.˙ ‘ČĐ„ÉlÖ šţ$‚Áł´´ÔĆ {ŰaŚĎpŘoPÉu˙· ł.ě¶%h—Ě]˛ Ň'B>*ť‚ME~Bó©ý3ćć 2ćő7ôľP/ÎüŢ©¤vĆÜîΕ‡ďŮŹ”]Ś%PQC°ČoüÁéťť‡ŁOz¦FY7ŤÔľn Ö|5j([Ŕ‰®-!NÖMËę&pEhP20bŚ§´´°|“Icoî«ÂŞg Žä¶”Wőýȍ̆I§ŇnŢÍ<·’«íŐżŐÁfç⍛'mqĘ•€ÇŤ‚Ăő`%–o č·µµ‘EÁV˛ńĂNŢÜŽ#Ů»Eßň7ŃG?ę* g¤ęÚ:¨›óŔMęźHj˘ůÁ±j=©ŞsSg±?„ĹhÎýŤhŁE€ŹëŻüťŃѦe˝wëť·]z-Ë\řŐŇŁÁÓő÷?á`†nŢF'ź™®GŹ8 Ą‘§Nřô§ŰŠ5¬V%QźÇű†w+XľĚ{-7,Ë]l:Cóˇ}>2E ßěT„.& ę^®ŘÉľ(Ú)O¶Ç’:Âű$::ŘΞm{,?ďä…ő8%>•ĎćśoňAOÇŘÉvľ•;Ç”f`ĚBqÖ®ĐAxqě`\ë=X-@ŕ)ďbÉL|´Dř*- a˘PfÂüp_­÷3ϤĘëwÓh´Š®ŐŘ}LÖ×tM®m‚(ôaŠ‚őVěÝ©żAń1®ł­/~ÔWąFÄM;/|¸[ůůGeröŘB“R^:@‚pn“ţάáĺAÁśÄłŁŚw˘OBR»€I_/=Ŕtí6µ–lŰ1D[1‘ßTČŽGĎ|^“wóZ0AFš‰2šŰ·˛ŕ”đąÉJJ©ý´vř§P+ĆĄ·Äpl]`Ł?aJ)EĎÍÓpĘőIchçŐLĂ’ŢăߏňĽîC\× 2ÍŮ}ÍÍV—ŰÁ…Ě®G}‰˛@î©ţńá¤'TˇéŁćźÝóËL?~|Î/Ď=żSń5•Eíçŕű7‰Č%íS)E„ŢăŐÝŔ>@äöcůO˝P&’4|ńc–ńjpăĺß-ɦČń‰aäüńY*µqHWż5Z=Ď;ű8’¤0ťîń›á˝V5„Ô»ĺW0´ÖŃÁ˝´ĹtőŁ0 #bŠ@—tË; kÔvŽŽÖó2ĚqY52Ř!Â}$máŢŃ´{-DĐÂvjćň†›Ç~ÓÝ’\DńÚ”HçÝŕěÝ“â)§Jú2ĽsĹŞl‚´(Ťé•3ăTÍOç}çضą¸ś˙Lş·†~Řţ”Ăq±‹eůëLY0]c?ćéúWE×ÔĘi/]äŘF†b§ŕ‰văM+ąX7Ď‚5ˇČ©Ł?°áîĽđěZąŮĄŃÔ>ˇT0˘6•¸´ł·RĄŔ†ý'K»-u`C)4‹›­A39¶3FŁől…Ě]ţÝ*˙'ţÝ,j%Ë©’"` 6´Ą˛EĎ»E­®ÓŹÁVŚPďś Ľű"źÝŠ«ön,YĂY˘MŕŁúA'Ç„+pXçüm\ďć[µď¨<4čĆŰ/âDńm– ćźKk6ë˙$ů";óAĄ'‚P¸üČCđ'ô(7Ż&áf«ćÎl ąň#j(Čč eŢezqe“Ć1u÷ń×2&¨Çş#WşŤź¶Řc°ÂóÜŠčFčťţF{‘—‘÷!e˘»µ%“€#ęIqAKĄď°đbśÔŤ—e€ źzKtżŐ4§ű10‹˘ě_yŘú6H•LşÉ¬µ*użycb\%úúćľ'Ŕ­}=ńIWĆ°L¸ä—Ž|8âX‚¦h$RBZz33ŘžM'B‚ô=őßĆäĎ®š ~ÉY Ň Žö}m¤ě›:Łş¬Ř·”A…úrŘ+Šđ*o¶ďŕsżĺ&ş[ őÜćTŁ ‘ŇęIř’»á DďĐŠúőä'­ČăMIşs_ň¬m)iBáVżů Héâ3f6<źôř»đ™]ŠşŹč_µU‚„ţ%u›Čâ‰Ĺó úŹVHmđ¤€=µżoQ ;ŕżđ'/W™ýq{ąéĽK@ůŻBpź†á`ćâż'_»pAŁÂř;Rß›!Pç۵®M¬Ň…t ”/t`ż&ĐcPďs$Ě"ŽAźĚ3†ń6sk-·­é^$ÖCIE†•‰űßyTIwťăĺ¤4%$ůLţ¨vCâRÖĄ¸ Wa$‚ř W´1쬸t(Ą 3ZÎ[ňOžĎëąuÚżÉb š?ti©fŤK]A0QmáđŢ÷qŐqD€ iŚó% xT@r[Gyň©‡âă3ýU!č@;Ź7ýżim·–«ć°ĺ-©‘ß°Ń÷Ą č˝YEc ŁC;‚ô śFŘşů_ôŽnź-*ĚüČ9qŰ„4CÝŤ\Š/N0¤z›6RŘ}]ćůPXâŚőK€oî=CÎ>ô†ęÓ. îµt¶ďr%OĹĘúmyë¸~Ś26źËó|ĺ3×±±ľć™¬aš$xSÄŃZĹŢř7Űşg}ąÔľd=ü[9ɉ#G+>e}Í­‘ -PuşúŮÂlUwUĺé }(L¸O(íŽEcl¸Ž˛ÂŠ0$ŹŐ1â{^1±á˙v«J=űw-¨Ał+3ť«ĹŁMČ#Ĺčhm§Y3®Z˝m3ĹaÇp¸¬çöQ\n.3h—mk%Ö'"żíQ\h”żBŐÔkü/ěéöÔ6EKŁ=ąWyäCzĆúFĚ]óď1ň!4ĺłµéŃhÜ”đ1¤ď{Íd˛  Â^ŔňQg)Ö$¤Ą¤âL…g„dhj„ŘňÉ=ű⧦îđ¤gĚÂ8«—–ťś>8ŤN›ŻV˝ˇ„ß—.Jľ•qç(ÇŇą?ϦŹyy©0kĘÓŐ™ł:•:˘ F·m;ű™ZµŢĆč-F‘€7ŁĚć$)čYú×Ăů;ĽŔ%1đ!î* Dd©G¬ĺ¤ĺRĐĺ’g‚´•Ĺ‡řuŤcŔŁű?Í×ýrbě{ŇLAžÝv4@IšM ç.lóc÷ĄóÓŮؤ0Z—Ő!cRpŽ=ôť¶=!ŚwŠŢÖşnţlUqá© ±§.´N?ťóőÔ zÉĽ“$ľvJ„{řĘŞý ł”}ŇĎîRśŻNšůç”ʶőËÍU—qGŤ3'†ë|2ŮßK +Źtěš jÜťü«şzčć'{' XáA#zËbYÁ…^ÖžÓałłŚ´´qPĂď ÝŔ8ů7úţÂňţděÎ,%R]lŐÜ&–’ÉnŽR•‰«›)jÓŰZőţîŮż§jd> lľ­>ZvVČ.>¨jZFŃÜB-źľ¬†–‡E![̨çę!( Ôt6ŞĚŢ<\ľOLď«=ŚdmÔ–[®!$oTÜcÍt BŘđdČ}I›Ď:7¬=§.ü!]=ť,«%‹š ř÷fPž+Ç?‚„§§ę»ň/3 é˛šÉpsh0MĘpŠkË“–Á«WwLqAsÜj<âjÝFi-…ÓË ý…eŐs ŻîčÝ}VúPRfż—DhÍWh±=;_¤-|söÜRë b@€h€Â70ÜÓ„A2ľU(” Ł™ i+Ü­ýřOˇw&Ł5ű‡˛č˘üŤđ`rͧ©W‡ű pŰŁ8‰+şáUÇ Ë'Đ–x’űit÷@ńW?>˝Ĺ©× @–ňş/J.ŻÎ­űŢűÓ˘äöhÔ´ň(·q‰B8˙#éŹâŠłÁ:÷ŐS \ ÚÁ-ą±ĘmĽ¸Ú—Ť@Ú%tŃĽŰiá­Ŕ©\˘N`dt~j]#c›Ď3žĂ=˘» ôů4ŮômDĎą%˙ü:ýĘhúŠŁ=ŮąkĚá/#ŻLÎĂűëŘ‹é’"3ŞzáŞŮ^ÇO[qůó7ÄÓ¦]&ü0Äż^†ů‰řwĆ ;sŚpÍşD$îîź‹ć˘A·Siă¶ĺł"kŁŢ÷Sşđ7 ‰ĺöľmó•ĺ¶ü†Hp˙ă;űái:ZÚźwćmę+$ú;f Ďů•-G}ŕ]ź[NÁŰi(Á÷Ş_ěo«o1§qŰ ŁüŢšá*Ř,F ¦IN©x…gá«WDXŁébe&ę5]Őa]ű`ĘE® B”Wćü˛2Éo]?±3ŹU×Ü÷Óźďď[KÁ†#ÎÎ Ő:5Gp!]ÉC:—®ĎkTřÖ"ý{ňC©Ŕ‚ůęĽbś."Č™ž9PHĂX-ĐţS=Q¤X4MńŃxÚ·KÝ଒_–žl·´Éôq2Ýsč;”~Hf=×,Š@-Wďóßvv°ŰW¬;ílhqâ ¬9ő‘‡E…Băejř® Mć€ÓXŚ9ÎŕĂŐU= ‰Ťm§%BÔ“ţS|@ş:íÉ­ĎMĐ“´O™C¸š’šÔĐsŁĹęAÜl¨ůKŕ {ł[íkęăé1śvÄ!Qš.xÎĐ5ÍD!‘tnřĐ“bŞjp´‰9Ó:çč8´eZ5żk0ŃţĘŚF¨K #©ćü»ťŞ4SíŰî†Î(+1­!ŔřEć¤Đ“$BKCţhî4ýčgÎD MŁč(Ť]Ô®™\‹“PYňHoŃ•hËěuSµ#ŕ«sä%bJ}Ĺi5+rŤc«•´ĚFŚěFóQPĽÁŽ±.kÇKňŚÖš‰hWÖ¶č Ĺu:ëŔ˙6‚,Ř#‘¸©K·źÄ·…ÄĽ|x),Ź•mŰkW+Ťť)LLWâ©FŇQgD|¬]"Ă4_BGď÷úązVçMWł†!ŤŹâîçX÷©‚č'śR·‚NdéBbŠđB„‹”ňjŠ –o•žóBÓ uĐľ‡lŚ řŻÍoX°~mlŕa…ęľP[+VS†ď¬ QëH˝áSżxń0¤Y¤ýĄs‡śŹ‹ś‰š-ŁeöÚAUĆ@+łD±ľsüo_ţP~¤/Ü l8Í;fđĂUö#LĺŮ®ě/ořDĹçč4Ýúľó„?®5–Á#(ţňOVlz±Ł»^˝Ć-ˇcÎÖž—9mG-*…˙ˆ¦Gę’™,!.Gż!fŔ&ŕ˘U@ÜA®HoUJ~\o……Ă㢖üŮđůš×ok-•Ş$iŁ!ÁäkCwĘ/Ö €ľó§ÍŰĹ!ţ$¬¨zkVpôf_´‘[Š7 0•ľ9ăĚăĐŽSůvěś—ŢÚüľń#Ú˛)cgűľ‡7As±wüBŰy]é7`4Ŕ €ĺţ¤Y™ nSX[ŘÇŐ­QN%íěDÎ×-WTď˛E»ENx_!wżačPč÷ÄÎć§Ć ÍÖéŮ/.n{‰tOô˙ đ›®@šYž #tqµ‡&%ç_šďőh„É­ +7›ŰťČĎ]—e(9{¶!’Ž'Ď!Ż7U’vmN&ÂÚ Ň ¦şó:¨ŽŘ;9 Ő†«TsgËÍżíQ7‹xŐ“BČCśgţk,ÜŻŻüoč(ĨBŰ hť€‰Š &Ätř1~@J-nťÝ.ŕqb6·>V·až‡Şžŕɦ^nEšQČí=Ş-'â ü˛®ąClVU»‘\|óÚžA:;Đ~^ű·ă^Űh˛Xůjź×pşsOĂkš~­›{-°˝*/Ißj›×ŕKĎb„ů˝_zË'7v¦‹XLCu;IU ›őgž\÷Ą)şŠ;ěŰđíËŇüńţ€ˇ9y‚fćzآŠ‚6,_Ý+4‰p˝| ߸Ą˙Âo KŮě&Ů”^V€•hđťP`ŹßËa‘§Ă8OŰí8€Ţ™Uý&93äc?aś`Ç :˛^+čYŘW‡%śŕł 4BĚDKŞöř]xđ(nj_ý}§3Ąťü¶|•ć7ů*ű‘­Ź©Ä^âËΧ|¨öěĚŔá&–ÇMQnŘëä˘(P‡@aůkC ß:ő;môËrp(µbˇ·DÎë˝í±9–]!š YŹ˛%óű  é™Ú›%Në‡GŢř”č!!­-_7â÷ăŽĂ÷śÂpH-‹]:4öěŽ'{ľÂćŇż H“ÚüöČÚ&sŁ]dĄ™H9ÍźĚ.Š Ľä6ŕ× Ń›­”â/:őy"` yŕěćL^»PäŹýt8twJ#x§&I&‘ĺŐ=6_HÂT;¶®8–N6h¶+ÆּÇö«ĘöOS6Ęâ± ˘Ş˙íZÍő$ŰÓP8)äO1˙ÇZÚ6ť×T0pÓEłŔóg<ćAĆaźI0 …ö”Ö¶h\ŘŰnŻ´Ű Ë#φńꬌG2´«0j˛ˇ¦›îĄ¸,cn"Ńvm5ŇÔB°kĐ6RůčaĹKŇÂ|6ě8ď™ÉňýfÁťlzn4yRĽ©źżÍŠŻ‡ěض‘™ 5Źd±HűqŰÍ2›—ĽM‘‡"(59MÓ˙ŘünąĘShśAŰË@lâ»ýi#űQ„"ÖHehĆ"…ĎjC‰¶OâpŞÚŚŻhK)ł×j„ÔíŁą†™q2ť=ˇ 6Ą1ľüpS3ełÝ‡lł†-çy†ĘzŠöc5GźýKSu6…Ĺýö€¶˙ÜĂČNŁ[ćBg›& ¦Ö®oäWí÷Ćł/[i1G¦čů/äΙřéößęÝ®“ë&˘Vů8ÍJĽËtüHĄOS6Ś%}˘€ ŐÎáÉČŘvĎ.'e3˙°dt÷ cŇaačŢIĐ&›`>-đQđ¬Bđ5ś ˘’m©mESćD@ę4µ<ĆŢܱ—BŹ ňř $Ű'Z/×5ĎÇ”Ů.Ł¶ ÖÂŕY¶>QPĎĽšň50pç„z°1fi*ZiäЦ 6ô4n¤-őÓíę‡&>7ń\< …Ǣç˛k”}m5÷iäÁ±ďťD~ ÁöżŐ–rOĺŇóëÖýŐďÔ§Ô(φ8Ém›˘”V}n ¸%a‚éît«8ŹUď‹ĄMĘźôčWC)»ÉiWâL‡/bü>YÔ8kŻëÎ@%5Ž3Ă“2Ď(€•@´žˇTmÝiˇÄ/ú@B¨—Î8Ó”0 şčöp^ůböĄ' ÔĘÍ, •9u‘@9˙żGž±˝ÁŐ#uě?Ş,ËÁgzÂo–ś7 pe ăË&,÷žÝsAŞv˛ !Ă!SbzΉr©ŠóëĹţŢk«ćľŰď ç¤?ůĘőÁŠ´y󽿬”u¨<%kĹ< Ő±L9Í!"ěÇĹÎŞŻ!˙SbŇŔç˙şfďËv©-7Ç(˝˛ŢËwĹd©şS1bKźëKÁV˝Ůě‰w4sáG.L˙!Aż·e§ěô˙ţ@gVRGÚďîHa9ÂjÇ8ľűëQv ôĂi4q™Gq´¬ďTĹ«~aŬĽŽ˘ŕFÔ,{0yĺĘŢC»F&±´ŃřŁ¸v‹·űµTŮ7‡ë(7u>ŹgŃJť>ôvéŹcuhfŰ‘pŕŰq·äqE‡Eý<» úŘ`»Ńfř‹ß“šˇM¦%Ń4Ž9í3‘‰Lô@%ri •)ňÇ™š~ĹÔă<›ýˇP 6QÍç3Ůôu“ăg)Đa沯m#;ىüĄŁoŮÚ5ő˘®éż¶=ŇńëĐÍČâZł4ľvxÁ ěĹ'~¦w*[‚üCĐ|ŮţbµkŐĄĂ‚0ľF®>źôŕ` €ÝÄÔF^SČ‚L課Ż˘ł‚š?~u”}¤đ‡öňś-Hö7Ü,>ĽE|Yz!v ŞIśÄ68ĂöSŠÜßČťA„·ˇ“DS4źś¬ĺ^Ű]ćTY§v¬Dą ĺŃiĐĺ˛B†·ł9gŃůrcp÷=ň"âZLjwëÄ0ý)—bŁXzý…võěö¦¦â‘L‹n#?“¸©˘kkY#yâö“Źö…˘©‚ńVeáfI1ôCl×Ěž˝ßľOŤÔ$N_!ÖŽć6v¬@¨W§ś˙ţ“ ô)ő\T?VK-ůiiÚoŰ\‚Ď6*’4'Ě)ľu’kďťöçIšťçëoZGąŁę >¸n9QřîŚů‡“p—FdAFŐ %{gżřż`a$@ěËäĽ<ćzčďŞęŠý†2!×x¶Č`ž†şÚN'ŘłŠO.ꔉ‡O”tÇ[UĹŚhԭ˲~Éą„ň"§3vIŰ靶E‹k›Ă¦5+VýxŁŔ¤ KŹ…ÝŃĄđ †ouHŮĘsrF7˛OťmŞJ‡Ď ünÓÜ+9÷sŇ+…—ŔSčśÉ[><ĚŁßF"bśE±&űŕľö!q’7˛6$ÝâéŮ™cÄkçÄ" l4™ÍebyíýĐ‘f!zÜTuYFČ7a‹ďĂŻIÎÚé G :ŕYKçJÖř˙łĚżP…ĆŮšýťÁÖ1űË^°ßŰ ÇňŞAJ¦Ň1;`Î_ž+âÇŕMô±%’ÖŠ®Pýµx‡çtH„üÄšc ‡±É@ń桋Íí®°Ř6é,Ë{ç”űě_ĺćvĆč ů<č 6áŁô˝(tWŤ ‰żÍICâkśňéŹ~jzÖ‚őě§ŕ4(ćˆś2$ҧž“oÁ±á.łfÇÓ¤'Zň Ąeˇęmo[JĄŢ!ÇŹÚÎnTd{0Ŕ7€ŹU•ďFÜščř4vý¤N;â ăĎÇB—¨d ŕĚňĆ˝ýŐNť„ÚŇ\λŦĘoü„Ň ŻHDŮÜ—Ó´Ž%®@d¬^'hµŮ°şÍĄŁßJv„§ ݧ•Ţ)t*˙x¬7ű‰×f’ ?Ěŕ%tcŁC§!Ë—|Zł&*Ý|­.•Ć3,ńI’1őÂ6Áo<-ą<đ‰ş.î`8oůţ‘[ď3m|Rgäɖ_!¤sÄzÉжÔ^#8k÷7çE+#[4ŁŇŞřODćľ·f°×UJKú‚s©ę¦"cBß)dćŢ/;[şˇwľî…nŽ=ؾŹ }řҧ.:%ń ú¶(ü„©0®‚s¦k¨É[ŘĄëgŤoféö( ?äqďx`yö!Ľ¸†9hľwx÷™Ď-Ú ;M>9ô(e$ »˘ŘÎďfă·EHQÓ…ó#ˇ."łQr$XiĘ€:'ZŠÂ'ši”éý1°Čm“©gřĺWt_\ ócŔgŇ+ßM I2Ë#ŠHÓpq«#¦ÖÜvgkzܧ~<µ mŇ€9´¸ú[ÄW6‡Pu•G5Ę”ĚDđk-cň ·6}Íöp; úÄwÂ]ű¤ö‘µÓrĘE7qTĚ!:<é GP-˙©Ďk †­ß]’/ËůPE řáí‹účk•qEĽÖËnQĘ,ë>!gmůö“AË&$b—n*> ˘m…úá RŠk&…ńŵŤ`›ŔnĽÔu·ÓNi†˘nת<Ö-ť;ÚőĆ–Wä>0ر¶ś€Äa_±Ĺ,gđ˝;‚*Ŕ±Ó+~Fś[’],3čd ´žźĘ¶ţλ\i¸Ą*ů…c,ďň™ösčBk$5ÓúŇŰ)+d¶ÉJĺB_ůÍ"/d<\¨Í#ĆJó ć†×"5¨QłŕÝ™qâ§ű1áÓ]ăťrmEĂQ¶ČŹfP-מ&cČČÁßŘ…]© 媲.Ŕ5`](ŕ΋“4\Űß·ĎČÚÁakgÂmEơđňłŚťŽ—‚•"Ś´~ź ­cB†Î×KcĺV?ħ¶ŻE jjön"5Ýń"™+?ĺ,üXű%;ţd‹Ó(ă“˝M$Uz%aôîµň îĂm}U˛f¤;Kc[?ćpD+NďI}ő§,I™WŹůŹ/’ĺAWwßÄJđOµ6”o Ő©x’-Ľ×Á˛hĐŞx‡"› Cď Ď˛BŚ'|ĺ#,ÓűE%Ť%,Öżđ^Ú¨ }ÍšZU§µ—ô!X$Dč—ľ=V'‹c´˙Ô?é(o|<ş¬ňŔŃ÷˙»–DË…Çc0Ż“âNž¦âEˇHÜĚń «rIW§ Ĺ­6El<ç%¶kEĽMI1ŞŇÍ•‰]3ái˙ iÍŃ řqпIJۡň)Ô.vţ´Ř‰·b4şČ9ôqUđ¬ńPŁz·Č‘L)BôDź +óÓ8}n}±DŐ¬j™ĺŔ:mO…¬ź±,ŚĄIbfµG_VĆď“é/‹·°ÖGĚE4¦ €ĘĎmRH†]&~‹ŔKZöiq~€úŻřů7°—,YŐ>ře”ÚBJę „q" ÖRV.&i™ˇ´®4ÍFÄ4Be]Ňs´‡VYä w şeµ´T˛ŢĄ~{Ą˘,kôěŞÓýĚŽ X8[ŠuumQ,*:/… Ý0eŰۢéă8"rç¸`KŔelÎĹg±wÔM ÄźY*UŹPş÷L:¤áĄ<ëŽk÷ ¶aLŤâ_źo¨„ü;î´ý"|ĺhĐ° Ś”1¨›rYë?÷L †L‚:kÂ@á)äĎdM·ÝöpŕÄ J’;‘ßKF˝Ťi2OdćÔwxŕ<±&„A' lŁô ¡ä˝ß'~ „w˙ä’˙ü†6!ĹH 9ÔFS¸î–~¤ą2UŮÉ“ Š¦IfrÎd%üţdCR“â_´bKTLř -şl^ü6„¨m"@tabëNćyÓŚČfSR弦.Kňl0´›ăş‡'’á#U°ŘŮXS줸( îJl†[…oŰ"†#b{±öFŞťŻÇŚ7ý±9Żo‰  Ô‹9]ü@ ,M”żŰ|q°^Łđ(s÷—Ş{ö—ť I VÓR1X0*.€ŃÜPcĆ˙ž­şH¸7‰Ĺ÷ßÄ6srv|ăďŚűآÝŢB•őž¦Çf"K/:´UťŇFé€~1á0+‘ˇ×=˛Ó-\cpZě^č­KŠÂWÎí¤fĄA ýä`»OGbô)9şÉpęPţnměĐ4 ĎvÝNPrß A$v#h™b­đćdzhŃĘw}p{ß·fpW3GśÉlb|`«=Ťěô{Č›=§¶\ áĐá@s”Ůʬ-„‹ţäjť±-ˇ{ĘÝ9ÓŔžUé'Sţë˙uéďéżÂ”!Ńt+-ŠŢ^č±Ë%Űć©ÚdŢôe#Úp˘ń×Ă+:G ň|ő¨ ŹůőŃO˙X "ýałéîšqülY˙Żj¤·ßęmKrŢrýĽŕŮ%…,cŹ‘ĎiĽ¨Ş-śŰ´Č×%Ăj°šD3hđw‘çJöâ=}Šk­řSLÁŞn,f5¸8°N“ÓÜ+\x……-î4Đ/~¤d씯¶2őÄ1\,»Ĺék§)ë6ŐµIkšµůĘ ”ÝYŹH¤řţHšTZň9ŚMp2ôçUěrS4L–8˘)l`-ń1ę]6Yźěą“°=ťRűă}„čź‹Öš©IOÔ1ŹŹŘ˘îĎĄę":Y6'ľńB}i!·:ń©şb™EîyĐĐÚ:<8ŞF ż€”&¬jőĄĽO”/?qěĚ®ßĎ$ÇVĄ&˛G”ÓőŻú˘Bä 7p…¬ę_čU0HŽ¨Ę(˛Ĺé˝Ádďś wWĄUJń©,Nx#ŤîÝ—­2(ŇćV†ú­Ócwf‰×ähâĺe IŁxÂŞH”™‰¤Ţˇ•µóLLhOí†á<±Ý °Ú>ĂfpZÄ‚Ź!ěâ’™¨ŮŮ5ꢢ:A^1^Öž‚’¶Bw\qß/íčËĄ?­'@zÝaH;Š¬ËҲpϻ'áU—Š–=ú°%•YS‡ÚtĎąéLEűčŮęű Ŕă¸ěř!«ŕc:řł»ó|„Y[]»â°¤rf«°*#ó-DĘ[&ýk0äý8¦ŮFJ(W‹ęý–ıţKIa2”ąÇ5ĹZ”îôC€LřĆt>˛-V`­ˇcĺ$A’ű9jşŠÓ-íuÜŤ‡â7‘>0m tĂŇ«H ĹXQˇŞĐˇ1–ŞÍűů"ÉŃânĎQ#1J™gßép^kY ™ě^4@–¶‹źşž~‚§ úF‰ÇÓ•7ú°3ý˘(´WÍę–‡L…ŕŮ=oZ µ\Hźč˘붆ś§>H7(í%îéś8ă%«´.®C}î›ótH6äzlĹ:K ţ3ĚŘ:çéHřĺH_)ëqŔŢçő‡±Fu(¶‰95A7%ŐąG`ŕý;ýčc47IµŽ× Đ;rhD E‹\bEhϨ‚ŁźIoă¬Â‚}>}öY䱟g!+ť#ś|öoĎWb'y>C"†š.ĹĚx¡ŁÁęÎüˇ*Rąář¦pĽhűË’Řúňöä%ńOLúY‚Ăř¸!Šf<*}x‘M €…ŞÉdęŞĚ[‹p?}cU¤zĄŁz‚Í!ůSĺ6ş–É}řçE^c ;A(Ťć•a’PŤŹ€ź Z~ăŐ˙ndQń\ˇŹÇS™ …ýŮ®’Ą”LšŹr© óu«€0Wu~`™¬jLZÂŘ2Ş}UŁFpž˙ú„'č ßďďÚ3@ă] ¨BAúŠz33FlféO`đ32TtŻî“­ń¶_‚«VO¶Ń—őą‚ö€‹X‰¸ćý†ůŠ<2ǻ׋đy¸ßC™·0bp]XNLv­[¶G_ĂÍÔ  ´÷żĹGż“ŹŽ‡Ěđ“O|FłQ0袇žjÜVa—zĚ)ÂĎBⵓ‚Ă SÍđiěD‡€Ń@‘rëqbů LŁĂߨë“NpµŁĘe=žó ë‘ިč®R2\圤/dşď¸Ť§±ôÄ[q×­B§ę›6¨†®oaËJĚţqĽ^ Uß{dwťÚŚü¬ˇ­›‹qG‰ÂóŃ9źňťŚ\7)GîŚ'óęµLBß%ęÜđp/±áŃçxˇ„éňć!,ř=QĽ•äâ‹ă,ŻěŐ€gbŃޙοŽ—lŻ­{Iś+~ p„ď´rm”É}hˇCĚw­­‘ylרžN@UâÇąV€Ň©Ä št˛YÂ9† ¶†¨ěkŞ{ń†}Z/¬d©Ž?1óďŤ,ćôĄÜŇ.  Ű Ő/,‹ÎUż0Ö…şc~lś‰G‹gśZܱď>cŇmüd«ĂF‹«·z÷TÄ…}~IČąňŞ;í3ĚY…¬/Ö<§YjÓú|wö&°–!=m9î;ŻNÎliL_ăˇ6Ż’łŕ·ě¦1R:NŔWŁÜö8 OŔ |ŰŃ˙áÜa4ąć ŻĐ_Ů+w厺‡q™őČ®MPD0*h2F„¸Ě¤1g$=e™… Smš (Ő<ýÜfż›op»P-—čö[®ęć}‰ĽŹ“ĺŁ ®0mÓéµÎśµ»vĺPßőŃ`ÁËsˇ'őxß1.ôĽ¶Ź¬nä¸ŘŰ8ś¶&Vő"ŇB+h$ĚŽ ¶°±Zô˛ZĄěăcôűiM.ÄU˝&Řzń ôňsşňІ¤=}9§AuFŮE—öĽчşcueQGHđ|ëxşĐŤ'Ý` rI} ¨Lkj¶óAÚë¤/Ă˙B¸‹Ľ±čí¦h±ŃWú/2ńÔ—Ă™Ůß5]sú0ôÇ­uf»M%Ň˝!K$t ˝K!îx3Aۨ׋yůŤóQE¨Šď¬­~Wm®ŕU_ńôß’ÖĘqvCq+ /*ń`ĘbNłß]ăŰ1;JEefŻűŽŐ.„źŻ®á‚nSUW¶cC­!]°ń"Ňz~€śµWµŇ1<([ŤhżÓ€řá¤cpë*â `âŇKBĽYÄzXqܲ۸–ČrFĐŰ©#Ńą{řańŹłÔP}_rá®–ŽŽÜÖľĎRQ“;PÉpérĄÍÜA·}Du6^'nÂlÍÓÇă?î-Ń”™ěGˇ“z° ` `‚Şj ř(—©L'¦…$Ď#ů11ňâ ¨Ç˙ö4.^3óUµŕ{űFh÷Ľ‹Ěz Űś7ĎV9€ąÇün;vţĽÂşsźÁĺ¦sä@D6Ž5ÎŮ˝•om`őU.ŔćŔYIęšdďl9•2Ň.€„»BË  "üŽlßeEۉŹ§bË8ÔŃë¬Ô-j´źßTu™ 7)ÔšoIUÍŮĐ ćđJA"}y–Łq븱!JÎ"püÎ04Q˙߬o\"y¶šcůSj“ řî …&/WiŔ ¨ľ+/;F }ÚŔÉiŹęݸmŇŽî8ÓMť é#ĐŠµÉé#^ 5á°DşŇrĘýü°k‡9™ ł^ŘîúŕÂř3~8’ĎLń~ĚéŰĄKM1™7$Řs lűC] 0Ć-•´)GčˇyÝ(nÍa졾őÝ"Öî‘띡Ş2ćĚ"hÜ™[/ŕőý«× Ěf¦Ń ę!Ďő†Ń0B±°_BÔIÓÔŁ˘iđŽńő™ăf„<,Đ<'©ĺ}b ±vřg:fśÚűŹÚťżo§'¸JëeőuĘ€€ąUą7j8áf#ő‘“hĺˇ;cůGIűt}kÚÝP¶i®ÁHju;*oµÄ1ngĆ ŔŹZ­µoÎúŢ"Ó_ävMܶK3>0Ő,Ń•tˇ“OĂh'P<á¶RE“ ńä2BĹíx úX¶`°°)2ŮšůwŇ:P\ť¦€5ő¤‹Ů˛´ÚŇ·_y=î…4Y´?ˇ‡ő“hR®\!Tׯ¦Éf2 ť¸«Ů~ŽüČŤłŞc¨üľ»âĐ”­żWrCpž=ľ»Ŕ*ŔFŠ–čSĽĎę8C"D§eßyá‹-H˝i¶îčŤŃ|ćšŘtBŇ–đDio¨ű‰qŐćeÖ°÷ä3I䍤Dá^űA}˛î€í¨ŕ@1›rľÇş¤iqwÉÜnĐđuĘ~Ŕ7“·úŠT úŚ«úÖÓKÄ•»xęŕsßÁČwƬyD˛dR• ęôŔbŹ–ÍĐxŹÁËŃŚ—Ń“o©™k*TG?(™í”BgSČśś^¬@E{ »äg„ B ź´äŦ8 su˘H{†Aă#ć?¨˛_€¤„8Őü¦'9ŤX ‚Ďm<"xŔäN=ŃŹ`šő‚ˇ,˘@s/`ôöŻ DĆűĎ•Ţs+]ŹlYY}ýPS’ÍĺOSŇě6ŕhl9ßŰŃÜ^˘ý{‡b”±T~9R˛ŽHĽ?jćé-MP$’]ďQěI˙Źj×»¬ˇłbĽĐÝvŤďüú¶z›fHSS±rtĐ6—vĆ ńýF~íM[LL!ţ0oÄ…Ź?x^ŽĂ…«Žş2tDţ`›+Ś¨?¦Ž±ě}6Ζ‡v—4ŹV`O,~x-I!ĺQCɲwËLH‹Kş˙KČ?f±¨9„$‘|TÇ—ĺ!íižÎąĹĄ_du/ŁŠD2ŻÝDó)¨ËSçäyăČľR«I¤Ą|ą¦Űű—˝¨¶Gµ/}Ń·ëF"brE¦"—ľ-…˘Ť§ §Ü¨ZĎH(e‹’Š¦ůą$NZÚxë’ď)]/wüÔ\î~¸Clj‡^…ë‘sşlöX'nvJJ\x˙ú|o=ëşFJ0Îýą>BÎ @7:fş|¬0¸ołç'jI?mJ*ř@ĺ üĹ,űpg ^Vq2˛ĹF@…ź~bŠ…é8âĆ‹ĺT§x«™ 3y69˝M"őÎoˇY»çž±đ&‹í[ŞŞć c‡ôű:É^@ëŔ¶A¬˛TŃ™śĺ%gllą î1´ˇóă0 L3č©5‚C řÝfŘujŞDAÝcóśÍ]ćaĽŁ “ődÝŰ^ž/2bBÓcT˘=.CD &ŻFÁ±X0}ň‡eQĎ4Cá@oŘôZřđ9r&—Ľ»ńú.{‹¬zZ„w)IĘ´Ď×€>·—'š+µÂyXáf 0Ó+¨AŇ&0·ŠŐş¦ę %ñ®49˙Ąu¨čGÖJ‡Ž‘&'$¶+Ľ‡ŇŠ=Ve"|ÖßáÚŰžfýë#TÄkÎŢEĄňÁŢÓßąŁáUOfKe˙9ÚŃOĂŇ­čüÍëŞůđĎ5đßóŽV‹ZÔ‡ę’őTŞ$Ńç […ń` Ý…Ő”˙!ÓW ÔKLŮ›ŐŇ˝¤kĚ| úoZ…6ś ŁŔ¨"®©—zTnb‘㥪…ĹĄĂÜPţÝßńc±÷u 6zŃćňśąÉ/\YH]śiÚYď ĂřbĂqî4Ő©*ýuŐÁßŢÎ"ľŢ™= îđ7Ľ×N©&|ËÖ™9ťé îîmŠ>Ł´âÇ(!$Y9Y•¬Ö>P¬…{ţćţŠPÂĂć-W“Ă€i3AM)węXL÷Ä rú¬Třa„ę 0Â<«¨Fť®YŹ”D+BĹONť7áŁĚrs>O0¨šÖŇ‚łč„o˘Ý)ÔŽ\)*F™j+Fâą™ŕ`Ú.rťR3±-‚rŔë­süÉfđn>©äWĆÖ;Ń•zfC=PkŔŮ ý}Dý&BOĐř°•ÖÎDŃÚý—4˙_hŃíTAלWÚźX~žÁ¸ ±rĂ“TÜ ˇ~l‚«V‘jH™śQłŁť¬öÎ1»' ±aTť.˝9ç$đŃmH­—íí¶Ý ź%]I¬lE•Wpő°·ěű¤µćmSµüüşB(ĂRÝ.ffµ/kB¤Í11…1 @+pV"âsÖ_(|C®-Xů˘žI)a†¬F´ä2\ę‡ÉŤď…÷'ć–ě**7‰@0 ]‘ŃâľSĘÂĄ~Š “Âżš'´Ç×Z"WĆÇ "á\ü0–’ 6@d =Ş/S©e®<x~'€` Ţi5Žńp7|‰8#Â4ˇPń˘SI˙íÁl,)?ŰłP“¸~ô4EßZăµ.ÇŮó`{řQ‹ęjőN:Ö j~jĹĎ~Ľ¨›,\OôE7[tEĐŽO¤łP ˘‡ę$ Â%ői3ÜŐHaóŹĚč*NN—óO4űŽ›HdvLM÷ŁŚš©¶©µ“@¦5íS#Ь€9Ü5®ˇdŁXb bľđ¶Ćhő'\Ć٬*0~|v™‰ ĘXµ *y f3r™ß¤‰Ń™ô„đ&íP€±ŮS~ɤŘjg܆‰č*4ł Še–LáúbB9S Ř›đŃL6,5Ť©ÄZ¶JB¶Ń®~ĚZďĺ–C< řűŹŹŕńcéMxÔ÷7L˝{l`"$ pŽzpĐ­_GKjČ%ąüëÁš.`ET"nüQÖBÚG(éךžN>Ż[ŔĘwÂ+ŐČD·(M[Äe×,´‡Ż… ĐňE%‘]ň©`)‡žÓżŇźŢŇ-``kTĆźN ´NáÚä8ş‡7ו—P))¸©6Ź[~%ł´yilë÷đűťS#Š4Č{óílgÎlĘ»Ł•—8GÎä„…îďţ‡Śü?'{ßóDQ¦ľŕąRÔ)é0“ˇtâ«k`tU¶šőĹ®ć¶-üŃU%Áľ•I}0˙±q ĎC,5Śéx–ˇB٭ꯩË[ë¤o„í?‘+s%ĺf)¨yŰ ¦ôÁť÷gÜť M4äŐzÄľ>çö›…- Âr‘ R$í]+ ˛˝ b=ôŃ'lŮżĹúúÉ•+:%>—q6Cĺ5ßQ}=?ɱ»9Ľ¬•ŻúB,±)xźe«°ężĄů¨Ş ˘NP?ěĺܶîiî˛ü8©ÇĚ-$Źf5w%PRŔϱŔ‘Kł+l8ŰÍkyŤ‚ÚëG˛"·2˛¤3y"ĺÝ=˛”µÎq2‰Ćś?†ű‹JáeČR$—&i ®ěUő»‰™?ßL2*vZS˛5„h^(ípó)•b«Ŕe}1 2@Ň[—ç,SdhrHCŰč@ˇľ»ČŘY@…4Ľ¸>¦MF·WŮ‘‡Gy†U/Án;‰<{Ű_k &¦mő.FY łN ­çKţ …_NA=¤żCý8z§ôÇőş  Ť0!ş|ěÄ@ÔŁéűCxvŽCľ $}Ňa~:üÔÉQ»~\î҆źvńŇ3Š_—¶×çđ˘őjšt‡ˇWGXG•ř•Uuü°ŢŐgÔÎ.^–ŹG_VAw[ŕH^*«iVĚÖŚ ´mńsüŇWčŘPBű$˘ncďUďj#bĆvô±Äo$&5uűzL]ęŃĘđ*Ó•ĄôB>˛íŠĎ´µ Ş ‰’U‹LĚĎ˙/¨^˙”kVRĎÚŔˇK_ÍUş7|#˙Wž39˛ů-TçáyÖö»žSB ‘T«qíŞô‘ ‚ÉŚAI„˛9‹„xśŽA‚4Ů/éőţ!é@P5€Źţ}ő"m¦7¤ŔIDÚĄeT?rh–č9‹Ę»Ć‘üř¤J†\3cf\Ő·ąČ~`– Xě5üľ5L ľ­ié‚3$”4„‘¨LŤ}űčSX‚ ůÂűEôÖ#\ ҢTzC>´•}(Ą-*TpĆ'\Äp2 @\ŠKÝtt°=B„Š{ňQkM äh]şź Ý‰`âdšßá~Ôwm’Ćmí™\ÓČŹ“µB٤2ć^G=RĐËU˝`ŕ=iŰ cD< ˝Ë?úoââß另,…›qŢĂB6äqn,ůż§7y1.¸—4ć§)\ﵡm×tĄV˝'ă)±¦) mA×údÔqx÷¶¨ř‡±5ü~aL^ĘĚ9cĐ#[+’SŇ’JKťîiéů/ÇPŇÖ™·/ÎşYő®c  =úůX’qŤ.ˇúW5EŃŃę¸, pAͲn+,ţĐUÜHżĐ$n˝—p±'ťřÄ$p.ZĆĹŁâŐP˙^©Śęţ&Ľ ŢW¶Ef…â˘CAç«:oQ6véµ»^ĄŻĂŕ~!Ü—±(:¬ür÷Y&DD-%|·ł!°˙GXă«ŞźůÚN!‹ ýE?‡w1č˙ş 0>ŹĂ‚…wç©ÚWeŽµp*ęˇ>š‡6ĚsŹ&¸Ž QŰC­TďCNĚi$ô˝?ç$îĐ"©ž!ŁŔáËmĎia—ű=~Ďşžş( öŇq'uTłĐš|ĺ$·©z-Ü{¨1ď…•ď_=Áv”AĂĄÉ]Ż4Řf%űYé·nćÖ€¸/Ă%yˇĂ;I¤ęŠŤ˘}5f˘N6~ŹÁ´,ĎőÂŕ%†ˇe@źD¤$űÎÖyˇřĹ/ĂęýM3ČŔym{ę"¤ň†żK¦Oč Ś-w¶ľ¨{ľšËF~äđEEn¦Ăue×»E—”1Ő´ňVţU´ý:¸ö֧¨eU(S$Q†2ŞYÖi†Ś$†kădęŤQ°SÖ7s¤m„ Ăŕ)5ˇQÄ"˘ĺ’¦g šč× ˙Ń«ÖaU“Ńô˝á š:Ä<«ó ć˝ë ŢE˘Dĺ$î#7Ó@újtŇ—łÇkJlń­Ýň\áó±É~|î^»7>.§ň_F4ÇĘKüE>ŠéHńżbůP"ŠýIź#$¨ś0ľ–®‡Ŕlޤ/ő›|sť7HžÓŤĹóĂŁEĆ!cµ×Ç×-[Ą˘0ľŕäŽÝµ-ŘŚ; `TzQ.4ŔHÓS;‰źµßn§D„ŕ2÷š§V®ď¬¸ŞŃ7o±…Ó|ąű!ý™ďqč5* n6ď+5w`ŠťJčŚáŢAÚX¤€Łz÷Q„ o"5sóÚś ¶„›‘žúęϨ.ĹhZ…đnmkůbÜe"TŠćçÔŤ}ěÝĘiČGů˘¸§_7Ľ÷´Ś‰›E-[`;ˤ‚$©Ë»9wŮ_ÓVˇ¬­á#T]°Ů_‹ž˙ĎKó6Ůřňż>űŇůͱNF!"Ý/­ŕ>r!pĚŠq•X§äűU|ŢG@peDŔÄŇÜU[^Á!M‡\‡Śo×]çüOC_2ŇzńĄ×E×b¤h6RC¤1×5Aý~Á$‰ń'ôű]ŕKrŐ˝U‚±®b˛?3şÝŐbűcŘ"‰ü»ĐgJĄĎb žäeéĂu‡|4ę– ÉTR4}Źa1¸.ŕý6ň"ŘŃ”aëď^/·5:aKc’zéŁĚ©6t·®ÇY{)”ýśľ„€ݧz8\­ź]‹ĹHŚ»úľ:„ź™EWTÓŇś|1ľ˘˙äbOäZIHo‚fYź‘&•oV‹ćŚ™Ţˇ*$UXé0xl\őŃ—P>UŠ•IXĎ*_Šö6ËŰÖNĂ'fŻÍťĘrÇáž«Ű·rÎN.ůĂŁő-<ů¦_×iěIxKjďdt¬XŽLÔv?ţ‰Ť”‡đ\÷§—aŇ|&vlp"AÍćO/€JU‚Ół –n{ÝăžW5^ŇW$ą~ô@T5TYŽęla@Ä—m;ŻŞ'‰RÂŞ°ĹyŮáľw\ň“.ĽĹ˝ŠhŹ'Ě\Pş^íµ\č=äýüUěBÖ×n{kcŰ=›ŽĂŹ5 Â`±Vę,ç¶3­()şęť¬/h`‚k,ŕXŠĺąk#}{w”Zćĺľ]GţŹŘez†)DšâďŇŮhČtkŐŘ+łLĄ ›§ç ćwHüĆ3k|µŐÝŘ®iz`˛ŕB%Lü¶ ôĚŔ¨ďžÄă<äÍ/s†ëÂ6ŕ3}h‘Í#?Ż˝Éó«#'E÷óéî+ĆQŤZWZS–+üňÔâ™nŽ×¶Ň¦!D>›7ŢÜw›=UşěPńŘňę¬á’ÇĘ·Ęk{!‚¬†2ćvů/ť60č»^¸ş´övĚÁw]Ő.ú nw÷?Ł1‘eCŕ™Ô~^4Ęî$1|×ĂúgŔ~ĺS/IJ+Lě9…Ďł€qUCđ`Z:ł5™b#ÜČkß© ^™J7ŹŤâź“ţHš]ń$đ1uĂŮä"9fúĄ^'ź×§SĺG/8ŚŔ¶Mű˛{ĺDUDqĺ |ÄŤ™ňmj…Mšu˘Ęvg—ú“ńOAydń_ü]ŻŤT3XM+‹ÂÍÔOx“Š§4Ř6•@ë”nSNsnDüOPb‹†RŠsi¶Ö"ŻVJő ŻÔ}J®ÍĆ=Â%¤ťxŞĘľ¨góęÜ·, Nk°R„Ŕ-Ó)†ó:/\$EĹúigĘ Á é#Ě#2˝sĂ «\âĐg÷v¶µ»ü9Î.u1$qoŘHzJhc h¶“Í)&h†žÎ 9˛7™ďü|Ő8ŐC”›´ 3+ô˛F<˘˙|R÷:(ônř”gżżU]űIE›(ěăĚPcÎľGhyßoaĹqř[ W^W0ĺyËĽ×/9´čŞIÍ@©8R×›nfŻL0 ü”[/zŇŞpĎ:pV¦jşv7 Ą\÷†©×ÂňđWS/KĽ9đmňˇ›ŐJjáZôkHß)Ü«X¨} rp<—“SîQáÖÁśĂĄđ5On‡? ‹ń€" Źt83·×m¬j“V]aµŞ­lŢŠ(ĹUJgjíËQÖ‰ŻŞÖ"µWÄ•¶Hď'”0(hĂ(ŔGçË–2˝q^#§OQÁľ ¦đ_%l‹=6š˛J®Ĺ&Áép\“˛Ť< UĚ—&Rb·˝ ĺ4­°Ž ő ¨#Łň€ĚfCp´‚Š ‹Ěxrx3µH¸ŹV¬  Ty™?†ĺÉ«Éç•e쌿ĘU:6X/8EÄ2č䋤ĄQĆ^ÝďZžFĂ!:tKúŢíG˝KÔ#`‹1ȤO…Aň#˛Ôv±LĎRŇ ĎăŕĹn3Ç‚e=Äq˙Ý ±Żßg ˇ4H­oî8—ˇÇw‰ÓOĂš,ŹM Ui’řľŹIő˙ÉĂ9uďm5ŕéo…*|3‡cSfÁhpŔŔ-z"§ °đ5Ŕ) Eş0Čz›ńÎ"Őő¨s€PŘT'í!Č;F•ö"SäX Ř6äó0„¬žý-úXC]®'×F óěč­6¬ĐÝ_@oTd¸.ýÓ¶ńmo§ČW– Ůa^ë7B”ŢĺĄúÉ…Föô_ňš5đWuúĎp°ą'ä€J=ĽCżź r86=.˘)úBţŃĄĹ•‘zľŔ\ËůÎtŠ|-@ •xÍľß6{–áŇ‚˛Mś¬c ~¶wyďÖż§ô€ţş Źűčőr!†bśofÎIkŇ—6 Ä Y¶ołS˛€ć…ÂrŁÉď¨ µ4 RA^ę·ÍŇAĐëG!Ç ńÁÝ<·°Sľ˙ý~lŚWC č*$ţ˝ ›ąĆţz1=í.‘ %[_đEš!ÄG4őUy’ÎYâ˙µŹR¸âÎw‚P—ž¸]–ćq}X{.8Fç–yÚÍ°6Çd€µs+\š¨vB=ך晨yí¸řË %ÁĘŘ^#Q1†˝Ö^¶ô4áae¤”Źb·Šo…Uź•S»q„Ź "g)†ŠŽ"Ѹtš  $ŕpŹdČ÷ZQŐěÎ6W|ř˝q´E·W$m`(BEŔMđˇřhçĽÍ[BŰç۶˛Zn™\Éa‰ŤČĚąÂőÝJˇţDČ›¸­ż#ˇšĚ {Ôś6ßT/É.,v›§TApŚQN7şż=aťĽŐXxÓĐ,\H˽̫?çĹ·ĘľÓw tvúß…Äď2ĄŻęE\Yc÷3…EOĹÓů»°“ćŐ’ÔnŽ{Üźů”Č ‡Jé™Yń]ő“WÍ\€ĂŽÓş$dće^TáŽQ•LĆ Ůr'+˘ľ8Ř<Ą*ĄŠ:1ćÁŮé hpňŹiyůäö#ză^f¦Ęc™lwXGóaABmaÎ,†L4]oăjG+˙bxާc‚ś».T~ä&xŰr™Á*Ęý¬úpa'׏óg·qż Nh^ąLL—#µËę‘„xŞ˛3s12‰ńĂ©ĆtLÖ ŽŚCĚ7ď4(j{q¦ŐX‚ÇwďŘŹ>®,Í•>©%d3{0Z”'ę×ţV,ŃH×l Ľ€ĽÚ˙5N˝4¶j‘xLGĎGĘĄÎO•xąö ôŇÇť•Q;3dť¤A—~Ą®ÓŚ±y §}ĄÁˇĽň?Cáęś!lAf"ÄÂgŻ!Ť`ôu§~Á÷7 …ŕ}ŞcÍ‚ŕč˘ -´iˇ-ŞÁx÷ulJ „F"”e67"Gö8zČžé ýůš/Ö ;L( t˛ÝČ(ç Kîă§+ńH>#ű¸î\ó×ÓL=čé^k»¬v/äĹŔ¶äd÷‡ĺNpo<ĺ+ŁrM[„ xß…Şşś…Tůµµń©˙…Uś«ţ˘ …Q}•mhäÚŢUýG’ěžqq`ň>¸iÚV‹9ŤˇŐ4бo›|l ® Z”g‰a`c#΋ď¦öÄBđęń#‚ClâlÚŻńŇ3Q2«Ú+Aď­ áňËjJĎRc!h´sďd{§ÄˇB5ä–.Ľ¤5‘@÷ŚPtĐIzf™${Ą1`Ů^˘Áĺ–ŃÎE/tţQ(ľ‰.ń~ÉŽ÷dśaűżb&ĐÂ7‹Öů–=Ó]ת[ˇŹ}Ěz˝ŔŔF2ŕîóö¸AČ Éľ‰Sß–¸=Ő§ékţÚřeÁYpcäGÓ~ł]6Ż+ŞŢ„#np§čÉKü‚°`+[ĘFUý }Ćń|˘žO—í}"äô:ÇV«Ťş1g.öUo#vިŁt«•ßľ“(łZq’hµ,}čeRT S×ĺJŻ°ąIöfłŚsţÄi ße€‘řXXŞ]ÁČĹ­­6Ńc9¤¦š¤ TSë^şUÔś9Î8F¦!>{K*ŕ©k˘]’ amnWOlÁL}ť«7?djäµfß Ę¦ĐCŠ2ľI]:Ü®#ű¶[ű— űb&叅ĂţŢg HáÉ5V ĐPÇöÚŕ“á}*V*ňÓ±ą•ß+HžÝŰúŁ[Ŕ‘.ěV^`)Ř[©hżŇ¦´Y§Ž·{ŚJ\őxÎô–•ŹtQžý3r®ŢG°Śĺî Gńvi΂ăټȸ—Z˝sl—W¶ĆµojŮźYŔئZˇbÔă@=jŢŚkiuHAü˝7ă8đăj•¤»L]AŮ{6ˇ] (WKŽ–P˝ůĽëŕ´,ă~ˇç3QjÁX.0Böĺ­ŻO-eVi˛ŢĽ~†˛E)ý<µÁPľTrµ¶™¤l:Ѥ9 5BŃ“K»7—Ą)9—ÝŁXĄőá]ĺµAÁd,ä­ É<’/3WD˙*‹ %ít QD©[)[bugăAĂ&µIH Ĺîíz°¶źiFç wă„Ö‹kŻ’›Ď(#Í]€ćÂů‹;R­–?W;ÎŤ˙~aJĺőe°«ě€S‹>2DS•¤)Gfďpe19ź€»‡5"Îâ T˝é«h&Žş¨+2ĘůI/[¶< ÄşěWÔߎ˙ĂoZéţÖ7dŮTöÄĽ4­®K,J3Ör ¦ÜZ‹?"V ¸(ţ6ĂU’%öĹy3Ń ´+Äů°Rí•ëJ"|Dz «Gc ăHbÝqóĆxŃš{>ś9°jĐ(‡ÉźŘűGŻ.uF‰z…¨PĎŮ,‰Ş@Śű;…wŁ‡rýŢŞFĘ›:¬ßúPŐŐËÇ‚«=®!ă7ă”ězQ`m­H†<Ŕ0ňÖfW¶—Ż‘śÔEńąeW¶+ůjyýŰô»Q­ďbm]ávă8ÎŃŮŤJ‹:­ĆÇvBć!rH”%š9uľzţ‡JŚ^®fű,ţvęźÜeţ‰¤"Ű°nY¶DÝŻ?íĹÎz;‹Ţ‘»ö KH39—Łł¸‰˘,¨|ń?îšś§&[×Çň`ţ :ùĔžTÚüŠtmř@â(˘´[dfŰ1= \ź"&K‹Ć/¬kf)ÝßX«óĄŚBN×i™koa˝{4Yćd¶ŁâaŘ:++ÖZ®Ěü7xÁŃ*Hőýš±SEŤ•'¬Žášąé Ťń€Đ|QéŹĎD.˛żf ”˝NPĽ_‹ 0ČgqFSŕSł5+Wôfď‡|ŔĘŻĆá•6Roö…÷}x8¤=í×Đ@„ÁqŻ{ÂVM@߇á$W4-S̡W˙"¦Vⶩ…㥅őĘóÍL’żäÜĎát&ľCń\üELô˝´¶Ő$řĂU3@ýyÉ0¶•Ë·Ż-i,‘npW’T:ťN/&kA.Ős@xĐf!X’0«ö0…Ml§C´¦uś+˛Ŕµ7˝#É䮄”úöbŞą“ç2=5ő1¶‘]w¨(WxűőŽŐ…çe ąţëżWXÔüQD)™ťŤ_ Ľ@z®G Úźđu+ĺé§ov,öQ!¸Ó>R$«č˘ĎÉ‚ťýzęŁÔčŔ(áŕ$®K¶)±˙=4höUî@ŕ1ňOÝčÄôá»)Ţ#tRŘl*ůű­jÎ.µ ˛eçg‘I umD…R;¦ůŰxŮ4]ý=!Z‹‹cÜ÷+Řâ Á!ě2)íŻ(Řüîü®„—-ĺѤŞâÁÚŘÂvĆ”µdËł9Ô—C[ţs…g‘÷,ˇ y„\'”·K¤§Űuąrˇóü‹87ĐQ#5ÄÝ!ôĺYd”ÎĽ˙Ąý5„äč]˙}|Sµ‡s…S&§»šônKëžĂçŢ1…27zâôűşŤ ¨w˝? ĂáęĂMĽ˙Ą­ĎŚ Ťćč«-˙\Ř»XŞX«wÄŐëÁĄě=żl‰´ÚŠŇ€ý‰Űn ô9űdG–Ô´…Ďőź°×1Y÷H\Ä ˇG)ôm»ŕ71jÜŚ¦•ÄEJ\–H+Gˇç˙‹ Â&äH#‘g 7ĺ|žD M<$ňćŞÖ™bŮBŐo×Ň5xłśşnÚ¸UGl/JÜĂĚ—Ő7‘ă…W8ęCj“&;Ýŕ«ŚÎŔ$˙»YT÷†÷sÚă_OĂŰIŚť™ż„Źt/|€¦(`¸PôIú€^ $Ţ÷”8ůąŚ#ĎŐk9NgInŠ˘ň-ś-.Ňg›K5÷¶ąsKlű@Ö§ú’î.÷’´Ľ]üŢť!ĚÜg­Pś_♋Ür0:qšęS;@˙ćרîpŽÚrł•?VË\ĎŔc_ck]pö<Ę-1Ay]ú,Č*‹fôWä–=,Á˙AŠ] ›Ă&ş;01ľÎ´ÝŁQ9 ^.NÇ*7Ĺ3ŐÓ· Ů€űůČçČňWqHRŁB°prýOy2®-Ź wd.?ąT(Ł˘`’ż'Ô˘’&q­ćç­2nË ”ĂJÖ‹ůűĺpĆŘvĚ1XiḬŕˇüEDSLbÎ:ňÁI "¬)Ä,«•kż7óYi®¶ŃW›Ő*.ďH&R.ŕ¬ŔĘ«ůÄ®2V¦üN$$¸a>.e÷f†˙vţTűѦÄkŚźťJ gßdp ęW·Éˇď_á±­é#›xL8,Ç śçüöæÇYźř=_â˝m|(óÁ;gÖa Ď`°GěQSţjµĘĎ€)mčÇgP *ű>+•ĺ9Ľ ësP»ó«.ă1íÍ®~Ď„´ţˇdß©X‰Đ+Đ& ^Î0)˛ůZĘ$bMz Ň۶îěđčó3Óiúľ:‘JO—YoŻđě$u­*u*4bqâö0Tďy„>Ë…ĽŮś>:Ů qúłá%ń˛ečÔ¤Ělâ[°ěH‹,ÂMŤä¬hü!xÝLPt)•‚y]~ń ŕϱ9ˇż‘€{†J°=@Ę©![±N ˇ±xĆ_}&FĘă¸˙ÂZĽPňEí¸Ľę Čü|K¶Ď,›†vPUő&ĆWFě3ëwâU@“@jႱlË“Ô"Á`â̵CpŤŠ‚>b=±U—4ŻľQňëJşéS]­R"™]†ŢoôX„ö–U+őuĎ›…%É… i{žÎX[¨IśĚTEtźFĄăËžy\yVI=d—O‡‚®6ňM•ôŕőKă˛đŮ“UńĆx}MóÇ@ŁÚś˛˙ů;÷ój5‹€s[ĽîŽşł/6ŰÂoKaĺ_á˝#iW=}x¨?1=qE淪‚ ·™îč@×7vĚÔТ@ďĽH†=2Š6M‡âҧonRjôI…xOŕĆ8yP;»ë\ŐU‘ł !3«Ž¤ýĆ„îČÍíZH0 aľć>MjRW‡đE¨ĹMRžVöiÉ/ďq—”đ’öÜĘąž’Ng´?nÚ~`´ÇÝ˝uaýÎ_™“Ł‚wň‹ˇŞf?Er·2{†ľŹđÄék5FĚ!ąFZň+Śc¸ŤPN Q&Ó;‰‹šu˙őΠ­/V"Ëő#N’ńD:!MŮ€ťŃÝPfkö»Š7ë<¤˝1Pü'לÖ<·‘ÚpÔ> ĎśsíA<’קZ,°3/0J`3ë‘sú jľT(Ó,bţf´÷y3#Ó!6kµć8±g\×ĹXłľĂN°Ŕyšum–úż¤ö¸Ov‹(Ľ>ŞĹŐŹ *ŐCµ ŚĄÚ–éc~ôĐÖ˝ś×îŐ–‡đ0öČUď˛<˛›űD––3ŃqÖ"H´ů殺j˘1ItűL»¦2GäşăÄ÷č´” íěvo©X= Żćv‡ }˘ů\ĚHöo8éňąÄUÚF†÷#}ń™ű¸śťěĆërUUÖ ň\ĚŚ#}{Ňľ{sŁšöĺĂ2–éŽű\~«ëHę?ĚÉKTé7q›Çl÷ąK¨zĺl{’NSÄ@RmçôŐ§ćZ¬ŇeĽ/×[lY mKść˙/zßČ×qŢźrh›Tqäć@9%^(/"{]˘L.ükF·âŐO8۱-6źŽÂNÜoć đ9[ždÖěo05¸ťłÇ•BßŢ [. €0żäů®@1Ö!Ůü°‡›ÂeüĆČźžä±a˝Ľ xq ásŃőbQG( Ţ~‘ÚŹ@"ţÉ^§Ő™ňŁ’ăŘlËĄHř7~ě÷î=öĽô(ŇlBČô›SﮂśďÍŚ›1’ňuÜ1\ď†(ŻrЇłNą-÷˙ n„ŃgýţG©ž`şěšŻ‘ ö®gć¨=9]0ß°9ŹÄćĐŕŘŠXbäD°As€ć4©čżM â|B˛'ˇqި1ńű‰uQ•S8"”Ľ%=(˛¬E«ö#łŃşq‚ôÇň*_ú@}Ż("FŽťfňÖ6«ę˛ Óő*Ö”Č"ĢŐogîŘë6†™AT‰)710˙žćB|°iL,Láz/…FšyĹŠHĽ¨µŽČČhoU ;Ž• c ‚Ů‘˝ř‡a4-Ëk%V¨€• [ľM’«ź*°¤°ňü(”CĄ™ă”88"śÄgŮŐ\‚<ŻŹŰ#_*dB7ňŤC/µ[ůĘëđ@ýüŕ?iVaŻWň‰™çđ’JT&|±®gyĚ(ý{ŞđńĽß‚şˇżpߪ·Â'˘™ˇnßW%Ä\żĘ§˝t*N˙WE Đ˝Őőýőzy šłŃš><üŽ'ŃďťhÍĽ ¶ő#Í_9JpĽÎ˝˝ë#.÷ôč<üÍŞD”DjŻzŁ$–9¬žšÁë‡N» Ó^ŃJ¤ŕůɤOŐ^Š‚©âßXĄé‚ěČş]Őnµ'ż1–±Yž~cú·ßÇFsÔŽŕČĺ7Áő>łśĆp.#ä#ńĽ]íÔ- ĆaŤzQEśźŕ^•«@{†1X ¨Ůl ŐFxKMě/go­§P¦9Ҷ5C|af*čőp|Éôk$ܬ¨,-ŐRńo‡‰ˇŽV±;O!®’EŤ* źx$ë¨v°ŇÖU&°3¸oîz î-zŻ?řÔVVA-Ń€đľtuô]xŮYL˝;ńŮôîýĹaÔćŽ2%•–ˇ1+w™ĐĄzFÁÎ«Ş # ęIZ^ˇ‰âxĎm6 ůéěňšPń¨-o°AlÖm‚Ex»dǿ电ěyML»qiŠŰᬋé¤JßÉoMŽçť‚ý»8¨Ń#„Ü 2ěŹöŞś-÷` G¬ę\ň¦ŁS&?ć—~˛đˇÉ•fţoĐC\ÝžôŚ'<m P+t ŘĐ˝¬&0˝YJżĚ@ĄJHµ J›Đ)ú…ąC €Ű|;¬ť*jî¬+Ś“Đ°V3j ‘ŢÉ›``”»í¨ć1b"Őćta| (ŘW)ńI„Šb.Ő{˛ 6 .Ŕę(śŤqń‘çë˝ŐcŘ”“ö7rŻřMi**F놙ş‡ÜVo‘)đOŞß’×ËďĐzôżşň&Ř3 k"OřŞÁ˘7jµZ™Ż˛!ŃáŐÄK›3ÍďŽ txďţŰMëđz„„ VŃl`şV÷á †Âź7µüů(ěL˛iýlߩ׭/,‰}&d:˛n“*ęIŐźwyz_îeůş÷ăËţ„R ł–t«­fł{VďŞ.ô#ČÍÉ„Ů©4ĄÂTÜi¦nSűußúiZmRc|˘qŚŕ2ń‚Ľ\G~‰WÉ:÷z«čiPMšâCX •˘L¬čąĺ"ó¬nď˝e˝E<98í`$¶ť,Ű%Wuč”ç ¬sW;ľ=§<›wyĄmt[ѸF·+Eu ˝RŹ@ť_ˇ×đ#2źŇj+ç`RHDřyĺPüŇâźÉ4*tťúd;YĺŤ/ëäX¤ÝµŤÎVA(śŽcÓö6ţ"‘'´}ňoግjGzU ¦ń‘6gT™Ż§AÍ„,«I¸6Żö»rčž@‹z˛¸X]źĹ]ĆĆAÎ.éňď`óo2P>bcűdü`îŢ km.={rŻĚM((Y ›1v)Q gE%QżPVŢÓá·›~ I$sˇ†ŚÇ2cîGö§Ś•Ţ|w(ä?„BprsşÝéÔłdĵ°ťÁÝúÚBv=¦đÜDt΋ßÓuŰśŽ ÁçHŚ1ž/5dÜŔzŚŃíT•źžÚ*ůa|§>¨ÔĚ=ÝEk- ×?ć±~ĘÚ´#i‰K4kű¶EgâBK_ÇŚ ¦ń:´µęg-újöÄPk2f\P ’étpÝđ4Tv }Hőěw&Z*×bÇÔ_®ţWůLǬÎbĂ4Ť© ݉j€8ęţň©‘~Ż8ˇük .ůˇI!Ë|ôBe©8ďÓz¦ÚЉŰ'x Ç˙d˛–Ŕɤ{ˇ’dö…_ ´7`vm]{ÜAĆš0ó­šj\WëĹŚiYg]*µ†?źFćQ§´™Mv(΀٠&öŘÉ”ąRb§4r˝2”FZ éYS«ŰR˘7ď ($UŕVj§Ý ĺŽVŢ{MÇDň#G #ZdĎÎ ^‰LDIqý uP’˙4GÉŹt–ÍUżŕMO±ŮßsŞOfe`Ʋü{?ÝŠű/÷Ç˝ń «wóŚ^5aŁ@ô—m–($ śHyD ל§ô!ä0˘íëwÍ:= łűĐ®`{Ţé$É6.Ł">OÖłiÂůU˝¬ń9†ÎŹĚ®8¬ý ÂE’fáHéÄźĽŇ ó˛‹ŘÉ® f/$L  ˘yŔě>pöWęĺ%j©ŠůÎź€Ç‚hVQoă•_~Ü$Ĺ®w•rQ”Ç”˙ ·Ř°P•I;î7!ţč ‰v \(ŽłOq˙˝ŤRŁšŘEá9˛ń'żA 1*—€ éŠěe·áEÇćj.ăő~IćńÔqĺź;…1bK»öąŐ^ŽAnžÂÍ „ÚĎŔő›ä÷Á¦_.‰.čtüZ±ĚeŹ/" P$Äľ•e“Łőć˝ ‘oÁăRöţQĆäÉFČńAçše$2Gd±Ś·‚N{˘s¤Ôżü“óĂľťĺ\Â7Ҷ»çfŠč\’ó,cꥣa_BS•~ë‹špÜéÇ6;NÔɤ6­'¤;!!ßV1łĄŃĂłOdä—ó"Zî(ÝŔÉňĚĺ#›íŐĐýt'P=]© "xŽZÇ~FG™pŰÁÔY‰+[›ŤÂ» j|4ŇB© ř!¤ w9osTĘę^ÉÍe'Ć#íAŕÓ4$uËĽÉ5–Oq˙ϱyčYEŤ›a§DÚF[K­ZVęX®lJŤÜŃX–+pő"Óa·e2G$'|>˛ˇ-MżŔ;ľučł°|wŐĺQ!xŃŚ+“KJ"ť˛đx/^®Ęw ™ëä!ě„S^w`ĚG˝ľŞô™M®’Ą9o±ÎłźGĺMÚž»Ąďx’“ŢfůM— ™‹xM.?RČąeó¨đ¶€w Ô­Ókyʢó¸´ĚśJz›á[m÷´5JĆ ˘F}DHť«XZĂrq”îMđ1!ąna1Ěhµűí6sIś•„ ş |vVŤä5!útąđsgŕ]P„6»šůÓYm·®Ó —)âR¸‹ĺ”Ĺü¬$Z5Ł´Âť®É…ů3‚Żąe­QKG8| ›k"1@GEó–%×@ :ăh«gd8?±Ôčl‰‹ä;,§`oç}Yvĺtwź…ŢrXö8ŢŰ^¬Éx˙=÷Ű*ŕ´ÝďŘ#XŐcá˛ÜîâB śż5ŹâÍőiFlśUlÝsýÜřIé_¸:ÝČFˇ™,Gđ”8/n͢í(°-7´·ŽŮ.«Ivăâčfo!]×eeÉŢĹ‹Ď,79«$ń „Îîô áŤö?L$X@˛ńŘuZ¸š¤üéO"e1~µ˛Ŕî A wq ÇŽBu_hŇîş,ťdˇr˙ĐJFÖ˘z4Ô;Ă*čŐ·ëşŃ±´wiÓĎXUť¶ŁŽű™iąJ§›5v©Éú’a§^ĽF<\ýp9ý7żŚ,ć9Í"ʲf#»$ŤęˇÜDźŢlLOµ˘Fâ¦U§šlżŹý,^E L?:ÜRSﶆ].šiżáć‹Rj\Z+j¸\WGłO»4ôÓ;›ë!°Ł1qEîÓq!îŢeס<äŘő«É|BČlndúąr.Ů(Jçł.ΰ'ú7ŇúO.¬Fčę]yůŚśö{Áô7iŔf¶qd‡˝6IažF&Ť1Łä!đL‹čřăT_XÚ~{´É ěQŘxÚŘô1°\uIč7ĂŔw攏”É•Ý°‘Bé˙}jŽÁąI¨AĽŔˇëZű»EńĎcV˙§~ĐWÝ,—(^±·"Š×}çŮÚĹMy;lôÖéĽu/ďáeeiĚD´ěť'ľĺ ňŐ`xÝňŹćŹ*đ…E1ë4ŕź$ż"HP~Č™‚—|ŹŮm;©¨wÍf¤älęrF5Ćőo˸ÇŘŇÝŻ`ŘV”bÁDň9jžŔ޶řꮊ0^ŁŕĚŐŢÉ)óŘ#ďŕ×÷_$q«Ę˛•ĄˇăčqhKBÎůf`Ř’’ś iľ€ąŃČ»°4đOŔߣSÝ%0Á8ÚÔ‘ďäYŰuëű­®éśCŻ«y#¸,Źúä˝%OżBŰ/Ó˘ŰĘr­ú¦xä¸űµsů Ţ5xfîtŕÇ!3ííTU›ň©śy#$zYź¨Ä;+U{#,mÉ®ißGÁ#ühę÷âYś’ caŤŤŘÚ·n)źă÷ŻrňöÜA†P8Öl8ÖúBčŢĐŃŐ¬]Îl]LśB Ŕ ‚Ë̱QÝńĎŽB‰E!šPlă^Nq1˛ű¬H´rÂň˛”ŻL8hĂĆb3{ćUŘ šĆ&Ž±ű'R”Ag¬`™ŇÇóň·‹I[ů±8âNřŁťÁf°FźĺšÂˇĂúÚ\¨R“g'Ąďyy:µI8ý¶¬Ë/ üę+Ô)­k€Ľđ.@I–¬w+*5Áü‡Ť}±ä˘.Î b:: äHz¦o¦¶«ëQ#Á‹\¤vˇ9°ŹKˇVÄƧ8‚$ľ×n¤°%¤^ŹŔżH?ôĽ%( Ętóĺ׿ż+!§{°“ÉJÁ˛l.ńŔŚÉce±JE(QdřŇ‚A«¶TmkV»*9EUČqRäŤzŔ›a}˝QŃË$ O0©óňźZ1W !—ď°Rä‘ŧ”¦ő·NŐqűMř‚§ oM¸ -ŘţŐ$lkFÔᯕHXĺ)‰ŮŠm «b‡á{ZߥZ1¶Qűş[ŰŹ?ŮH_ý …Ä>Ôľ/Ç@őC!PxáxŘę!¨ď<ҲákĎ-­c„<>+ź żńá´˝›<¦—ŕĹG˙Ű‘XrcVđ‰±g´źDŞX¨s]€AíëztîżZFÎŞk‡©çaé&éz>gáűB˘j ^_±Ybź]+ˇˇápxgŔomĽóăČs éÖ_༻ČíW˙Ą˙N\¤ů7őoVýTǬ°e†‰Ďš®đ‡"¨ŁXd5qčźkX*t Şěß&ă•[&Wˇ]qś8 †r/L1÷«˛äÖĽU×uČłśďÍC;¨}r’%f·ŞĎü»î™Ç¤ĺÎřqžxĺТ6zâÇ| iĽ[ă‹ĂĎŢc'ôH“Ţ;°V.PĚš–‘ĎĎ6\L÷/+JĽfYç|é e7\ÖŐÎŮň·iŢ 4Čg¸q™ů«Í)ěĂś¦ű>—eYY¨;ň^A«‹ćßRU”Kxk—%L@Č,Ąßnd !ŤnB©Ruýěl^Ů|´Ó_'¦śÄ‚cóFyPű–M. ±ŤĐ?Ę+ŠÍ*Vżżçuřň±˝NëËŽł¸â“ŮhK CˇŮîŘB6nÚSݬ˝â‹eě·+1]e].ůľy®,WŢ„–Ń‚˙!Őh°Rz>"śű đýşŹ_2ůó5]—ůy¦E4SÄ+YDŤxaÔĚ6µť?çťń0Ś˝Äx(şeEú#“LÔT¤Ôé6;%}ĚŞŔ˘Éż ~ 4‘mŽĐ%đ ëŃEXłfšî‹˙fń`Or—m×ę–'«çŁzśvť~~ŔńN? őąőrÖĎc×zžS˝z'CýB° *Ż+Á^ěś©X˝B˝1ő0řçíL™3R7vŢ<–‡‘óóurC˙i¬‰(ěXĐ0N§ňÜąßŮÝĚLRłŰŚ.ń’$*ĆÔ¤¶|ôĆě3_ětµn˘ş0ŃĎr"ęSýî«ÖéŇ<ârKçRor#9§xÓÓĹękŇ9Ü*¨yŐW 7jü†NjXn}/s±ëˇ5ú±ŤS řÝ÷ KŘr™]tN%NđőĚŃ#€Ë·ęęőo”§AšĽw˘&:OŰŽGEß:B5ŠÚ 2 Eôm?ő[„·lf Ż°®š^Ů«"ňöÂé‹báżĺŞvďtFu*YëüÉ9ߊ-«Ü ĺ=Sďpł^µÍĐdk÷éf‘\Ú“rzý0ĹO¨‚ďçSţ«˝ÄZűІ‡)Ěă´!éőĂM×ďP@źs.cÁqăgVr|f ­3:‚ďî‘Đzo}"`¨ĎŐť|^WtŁ+ić–‚ŞPý˙gL[!˘Oč&ůŻŻ:q2á×îĎs}f¸ĽÉ“&Um%aSP)ň·Í÷NBgŻĹ_Ügą¨ÓßÎűémÄŐž'Â7Iś$š×Ş ‘JĘŐműő¶9'‡¶î‰„Ä!-m—ČbĎ\ëĽÇqpJ¦h!¨Oďß#W\¸› -M˝ťíş„©ç şv@\h –Î 8í<šĚě ßräXr‡b*Őf0`÷Č^‰—ÔŤ-aîO9KŠ:·6lD Oj(¶łvކ|~ŤĽĄé©`ÝË)MJĹ®> Řvěâ#˛¸Ů7q~ KŁ„ŇŞ"°ńŐüŞü̢ŐR2év1JţŚăËú—ôP0€IŽ u›Pv‹…Ľ×äçßõ‹xy{Ł÷ÜľŃĺLZ›g„ŔÂgaf^JĺI1zŐ‹ćŤ>„k ć Ń„śBŇě`$7=üŰE9,Ü°Ťń•Ë–©/i˛'ß‚ť,Ŕ•Aňż8‘˛Ićđ*wO(>¸däüéٵŹÔřsg™×ľĹ} Bŕ I ś¬?żm>L•§8÷c!8¨ôPV_LÍĐŽ tú.Ĺ’Ţr²գŇ/†ęJÓo0“T^KňŕDyž —ŘôŻ›§éd‰ 3Qß ˘&XxéálÍŤÉLXąuč‹vçŐi…FaYŽEÔX6ŃK‚ kĎ‘‡ým!§jŃFűEď  —î°YÄŢ9Ťv˛üžpĆĆś/ŃSŽĄ×ť”ěóśV6ÔpĎĚ?D—WÎxéłîŕ^é áxă^Ůž:tήť.·^ŮQ&˘©ăVŹŁ/‚oÖMbČëH©‡qĎŞIK|oŻEg XĐĂ—ŻŰňBš©Ô­J÷ďď_6#!t†ZMPăsŽ®#Ě‹ě}‚„»°käÜ)e˘±W;o„Dl ffą3µ©b nq-Ł'çß˙el`bloÉ©EÁUTkůc>Ś”Eu&*0źc÷¤x÷ÁDŕť« ďÝ\$ ‹式Zç@•˘ŇƦüło7cdTqtŹŘ˛”±ÎŽ(ŰóŠh‹*ĽNĘŔ|ŇٸÎ/‡ĐĽâH騗áĂŁ ¬€{Ľ0§Đwn—Ăž`X|ŐĽ|ţ?7féÝ2î§Ű,FdŻFń,ÉźPíEźéŹo˝¨i1J``ÇÍ % Dˇ81‡ÖäěaąDż:ݦ:˙S—p%mĎ˝ Âmgű|ő‚©Ç)˝Ď«ě†wźóXŁz.PĐŁçżG‰Ú°żěwÓܢ„ÔőMűTÂeGŠÉ>怚D†ü&‡č÷«ěţ\ÎĄ9‘‹*´1*kĂ!ŃĹ@Ý+ísĺä đF]ÂĽiÂ?Ăyő‰É#Ś«ÇÇý´šAÎĄ‰ű»Z3ä:Á_zNBË;]ś?łaÖÖŰęĆťJ°lO&áúŽ»ź5 ѵńAn3»l~)4żLŚîľâü[eLr+íˇÓ(!ĽQŠçQQ€R’寀mﻦ¨;ľôŹµ É—&[†ňěÁĽz!ĺUę(LhŐŻ0˘ĐöT‘í·Ż—˙HS u!<&ř–!7ĂŢď'Xúw]vŽ’/° „çsd`9Ăzű[Ă×Ķ8«ËĹ鋦Źůé¬v4ąqFş3fQJ€ëî\ópďxé•FĎ@p DňëkÔ<^axąnííhţţaÖ\ô—íżOĆ`gč_W;'řÍxŤ9Á]Ýůŕ  …űzýV,cş÷/†VI$ů×~ŽÓi nţضYo[NVtE*ŕţ?ŰUp{ń. \ßuč…‡ôlěŔ8/ Ż$ŽL©* íďŰŢzĂ6÷ěłjQÍ2Č”¸V‡ťş!ú™¦g9轄řKę#bŽ±&áŹZĽ$$ßToö卷Lé€Ó!i{–­Âĺń4i°V+‰Íŕšžt…ľK?fó<*Őŕ8 ÁHĘÉ\mŮ[2®¶xuß}6§í XňöÇ‘r||Â/€qŤO»ŕ8cjVQť>´x1C<čÚvÄő1żŢËŢť k]˘'˝‹~BŻI+ŇŞŢ}É˝» ěséókwűĘ™IHífý3Á·ŠéÎP«żH·7C$ł±śîę]ä˘ă JGŐÄ>:]Ö}/őĘř×4ľ¨^“sßĺ)Sěú›ĆčÝ1h›1ŃB ۉ÷óçć}Ç1äk)'oĄa&%LßFŮu×ëjáJß×ÁăńúˇříË,—żWŐŤűJÎ_.z(`ÍŘ 8—ĺđ’­oôśŽä·ĺĹÍ~Pź8ě_šĄĽ:é1aˇSě~ŔŮţÄ$Tëwb±@â5ůkŕ¦Ô ĂŞ펋Ź`Ę›cmňŔ.„‡iMT›š _m AűqşM7&ąłö¬ÍpF¬ihy]?†5- vŞnW‹]U uĘáÜ‚ČĂaŮ F[ébďü3“ťÇ•Č­_ ١ P‘Ó¦Äy tTm ×âE˝ŮAłýŃ1Ż#6¦é'Ý…ł:’Î/ćĽÚ],ĺ•ĄRZ\B–¬źj4ęXi®#ŇË_ľű`řĐťHźîčňLŔj˝äJĽĄ&ň[sţC8ĂÜ6‰,bWüMŢőžľĎH©”GU9›0·´-bnŽżŃGF<g:m(^Ńi¨ËNG ¨łpńnv!𢹒֨lî‹_ĺ>Ą”+Ý݉\|6«—‰Ő‰rđąLA.¸Ulďg.;ü35¸ "”.ęő0ŔÔ)«˛Ęt8%#0đ°KF/m_Zś-*ÝNçýMÍÍö\€dčÖôúŁŽMĆÄŽeľe¨qŘĚk%•,Ŕűşus©C¶X‘Qę3—~\aHÓé¦T2ŐkP`qIę ޡ§=ö4¬úROô06Ý%°(źşqlÉĄsAĐuU*ˇR•ÁާďęT$pvţř‰ęá+ Q°Y‰NOç÷óµîţCűë‚›°öďď‹=–SÓäÇTş“7«Ą"§·ĆZęg]𛋩éç)]Mř0 лݯWth~5´jb@R´§Hˇóĺi ˛h©ţ™ŽYé›Ý &¤Vu[倾<-ĂyŦ@ËÜĎÉĚ(ÔÍ2YăŇüľ7/î…ˇ¬‘•öŢ\%A7ćAă }ţŽµ"G ’AxZ[“ŃÂ]|qWÝť-˝¤%˝t·'˛OXL&E·¨⢯ŃEš`ÍZ>Ő$JżŰWř.ĆIĎSí •zdúÔr »Ŕ0na&X¨3Noă÷.Mô”´° ĘŔ@oÇ×ÓauŇXѵpG4{Ä2U€ĎčyŔĘÖKO_?Ýx†ÇméĺÁZfIRçś2şČÔx¶žŇ¨ż!ełţŕŐ'ËZ:ŘjŔáÔ=-ľfPs m„Y&LĄćw+ lĚx¸NQ —ŢĐpëĎ7Ą‡â-CÄW[z\ç 4‹N_4ď%I߲pB 'Š]ˇ öŐút(śřX^‚;~Pľű¦+u~,ÉDĺ®×uďúšs¶őÉuá=çÝG?Ź•lŽi7ňVK8Ů«*‹bLĹgk±ŃYű?&ATô0°Ä)_7öló­C%Í+H"~"=§1HxL ‘¸ę†HęÜçÚά×ŕGô°F ďňa6<Ü×BçCb_îÉĹ~ťšk6Á?T¤”Aĺ7¤ i»ńv¶9 żŇ…÷ř*pV7*b{* Ď5Z‘ő2*÷«ąPI€dRä•ŽIűśż§Ćú®ŕ÷_AżÉč6ü»uąNĎ1UĎÂÄ 4°8ŮX‘^ďěR1“ˇßĘqŁ˝°ŤBőÄ”¦bd03˙ç!Žďäo |8–ćŢń<:ůî9˛ĚüŠîŻ•a‡CŞ•±?µ_Ď šűä˘×áŃ''—¸ýftŁţőôĎuG±Ž0ş…ś”BN+ ĎI .ÍŤúر éX†ţ|±Ô::–{d-_4ýżV4GD5"č/nŕôzď‡ÚL˛hŤĐ¨?âŚń3Ť.ďĂN®óŤÔJ¬żwP|ä&ca÷1'ţ·`ůăbżľţ,ä˘e ×Bé3¦NĘÇ4äđCŤ`\Ń®1@,y%gâܦ Í„mĘjžÎϢőď˘|tčą‚†DW8רľPîéR˘6ZŁĎy+Uň˛ą]­ :L^#‡ wج.“^p$|–“jŚ8­ĽňmŁ<č8ç‘Î;}pzŁ­•ţ¬űťNs'üÁĆb;܇7ĚÂm@Ž>yômIŠŮl§˝ŚëˇÁ¤Ů{@íY<[¤Ě&óý€H ĆŮ};"g 1ŮďiN6nH'¨żäoVr` ®JÚĐÚúśUKżµg3) °S®Ý…|pńś´Ég™€]ZýSkZ‘G S`(Ćø3Ž2ńÁ…dőő`G̲ÓŃP×›ë™ę#DÂśbÝcÉĐ‹ %§N‚1Ň›XzŐ,Ü~míČhŻáAý— -’aëE`ŇÉńý sfĹ'Rśőžj„VRŚÖ7`3_§ ł´Şůa˝Ĺ\M„ľpÇšFĹěĽřćć¶83÷ČXż–ŠĘŹ›#éîŃ2* Ú&Ô×ĺąÓ…'…ŻdÔ7°˝M‰U ’· p·%¸íŔYßAĺčŇ€ŔfÉür¨Đ)ÝŬŘŇyÇd,iúnŤś] o~ÝŃs8˘!Ŕxë‹•[±pšź´#ŁĹ[ť_Ă€c54đC_˝ąEXoŞ#KxÎqS¤¤,úhŁŢ/âŞ2N¸žYf‡źjŐçBi´Ë˝ř™ ±ç•W¤BQ|h÷±Ä" TaK 㡷Áó™„S)€<@\ŞdĐč/‹áT–éż9Jäű( ěb$˘mĆŐŘ+RŘćެ4ź6Tp¤Ĺ®rŇ2Ô‹üI}Uăáď¸Ô˙ĘPbă 2Ą·ŮşˇÖT˛kd‰— D)Č^Ă/4ÁżöNŐIđipIq˙MîÉšĺŕX´íĄH:¶$,!gůĽXfůJ’¸ vˇÄ„2âó_QŮ-$†¸ž/V5ݨ=}şyŮÜábůާxč—1…¦Ä‡-˛µp…“Ä觹'©˙ĐŹŻJn·§‡:"°!(uűŻŤĐąftěVç•ŕcáLP'*Í›pÉŘsd Ź†›ŰŹ—˛ňč„+˘Xv#ßŰ<·v=¸ÂW4ř'‹úóźëŞŰř—ě9ťĘ;‹ĺx(Ń”ţ5'[_¸V,¦8ŹnĆÂĚýNőMS‡TóÍ ŢFjŘCÄżT]’Šv ĘŕĹĐ’’Błcë ĘQęę>Ę_éžPë`Y¨'šT:S ¸SIÎŕE¸éČ#ęÔńŮ^iŐZCëQŮç°VKŽý%ó¤ŞUî|RşżŰÇ€’Ňr´ěŽř[V,žGŹ«4í9Wv¦¶\ţ q”’j\ńčß%ö±µä$Ĺ %kYĆiifAŔuĐŚXŚ®äĺV]b0fôÉ™ĆAYÖ h¤3†Ł«ô[﵉ĘDŠˇ÷ÔĚđq§`1źdk*ˇß«ŢÜ­Sëi1˝ZQĺ™ N#`2űµXŽW‘Ö {ěaÝtµp/VZB(kŮ:sn…NQ÷vQýˇű‡>«¨YÚů.ü$Ë;ĚaíĘ vV¬‘ŰpOŰ]>)IµÎ—Ň…+ř¨‹{nˇ0GGTÇíŽČä±É\C}#›”iU•˛žPiř&áK!äÇß šRĚtI»˙ÚĘ,ŢC]€‹áĹq‹bfH,¬ú\M%[+¬lwpŕ­CŻ1!Č©"ÍÜÔÓQńMçĄţŕÍt&şËŞ&‘aE#p€Žue„Ź—jĎo@Cl‚y-§ŔS>ÚÚÂ| |tţ9ńµX¶©“b%iô9ŽţüÄ‚¶™¶«ŚŠµŔ 让‚]¤©ş"»?©bEźĎžGz’¨áÍ´éŇîôűfXÖ¤Š ęOC>ŃŚzkßÝw{ť§;{ĽőŁJÖš˙ů3’Ó«ŽŠR9w=vż5u"śk rÇ@UŻAŚ /uظ€ą›˘¤$É°Kg|­vĚč8XË:ŠDÓËGqh¶î ň˙oňxX2‰4‹íú Ť®č¨qż§ž˝zF G¬2 ßL0Ť/*ĆąëŻ{ŕťµ3ľ„FĆ<üt}\‹>4¦Č°9Ż°„ad='P¶ž9…•ĽżÍň=Ś)ä'·zz×$Ľc”Ě&‹,ăáz DłŐs«Ľ“ÝeĎ‹ß|t‚mE,á”-Äű|Ń‰ĺ §()“͢ł şŕ‚jÝŃN:I'Á- Ezđô ffn & í\Č?-Ť6~7Ç&Ř?»‘Pż3z 8ťę̿î7ŰN‹ˇ#+„Zy©ě‰ zŰ(rs™?˘ÝĆ﬋]˙Ąˇi¨ü`W?תÝí`´C~â^­0b…ˇN(Pňh&;ŁŢ`P Ö¶Ż##Ý( K±› ä4ŕCDěęČ)TNHhz@÷ËcQó˘žëO¬ű>ô­i„×Ŕ¶ ťËµ-ěĂEćÁ2Ő“^AÂ[B”ŤpSäBÝé‘ν6lŠQěćŁtđ;óoČô­…µ7@şşŘ/Ź÷)6üÓGť¦Ňtř•EĂŠí´řlŹ$6rĎÍB` Îg¸uń,šťµgtx¸Ö-SnPOoĎ[ÔB0˙IŮN śÚü,(2mŔuAŁĄä‡/«â*P«B·G/ »2+¸ÚňňŘđnL2pśŽfýŰ<kŘyžŢSU7úů‚ŹŁé”2®4˝©’j×ńćŕFTŻ9{¨ńZŹÔ˙/ˇż[]řrŐ i¶˙…ď]Ż'31Ő^OôEa‘OtŁšopŮßFť(č+’7ŤŰ+µŰôuĹýWÓK€2ë¬ú+óS‹˝=Fńškt”\.ökc°ů#ö Ś&DŁ/Qô}Ëç·ąm."qjf˛¶»ĘVŢdě<#’ÁuFmuôµ,/·ň7˙¬ľâ´Ygä[š/ŮŰYíUőîôb·3`†XčE"¸_öőThh†Waž†ď=ę + >äř¦2ŕ,â5$.ů¸«*÷Đąřľ‚H,g­…BMyđ*fEá 3ňÍŐ_Š¶¸Ăőť &Ď +Š.oOÍ;{ÇłÓËmÁ¤SĹd«ďRL”ŇVĐ“đLĎLźĆF3vtâˇÎNës čgq¨!¬zNËŔ n‹ĺˇXUg•KMߏO©Ěę4Ń· Űd8q:šT ˛lk§GĘŘtxPw>?5ÉŘ? ¶( †ţ…ť6o°ńšÇĂ(`>´ofo”{Ëů÷26?]ĺhźéHľĆJ‚ďÁDahcéýůqŚ^4 X=cÂ˛Şş€őܵÍů eĆă@ă˙ˇvĹWčŞń€ŁJ)îž rłlćA6†š E‚ŃqA¬Ú˛ż'˘jŚCtSŘöéX0ęÚłŤGŠµNÎŔ™qźVîxäćÜÍV ¶óě0B»éďţ=?Žä Ĭ¬ÖőçM÷DďxłÜ҉h›ş6ăĹ…5óŇĽ]6î˙ ož ĄÉ. ŐU´ßéÜXgŔő´µŮ@¬NŇfbxęqIü«ˇăĺ[ „]¤@Y­rŁŞŹ‹€—23xŕ-ťˇ!wÂĽĄ1Ş—ýú‚\\GH €ŰˇK˛,wbi=¬§Ş-ghF=¶eĘ„ňU´E–QśÔ­ł(LIZMrů{UÂ#Ęľ5Ĺ ĆC|Sާ\Kb-®nsjČ’‰ŁR&Ä8žČ4 k›_†ŁśjoA SEÇ<ą!N÷jóýȇ©)qFĘ%‘-.‹}x Ť´\[ĂĎÔWÝPZęý$`P€-±ľ!‰¦ěĘ&…ł!~˛o ‹oŔľ4a',r­k¤t›|o/ň|Xy,ě&^ŞŚ>óEë&. â‹L‡ó˛ľüŚy=ćh•¬é6ď%&‚•5±v(ęS%cŤŐąŠľ†TDď>Ř1¤«–6zů-iÍŢŰďäç–żć˛Ŕ!ČĂž~°U„osf*J`ëúżÚDYDoĆĎŞ.Đ,…dg6čç$G) ť{ňMş ×bYŤlö4íR“*…‚^ÓÇh0€éˇŹ@IŐĐ/qtBÄ“I.ąö Ű\ş.ŽÜáîg×›0Ô0Óĺ$¶ř'A~ϸÎęÚ67t.oáŠö»¦cť®uŞv·ŠIňş%ń'®ŢĂd-&O”Y÷č‡7Ę6ť•µę1h7ö‚Ć04{ř&U![m€ggO°A•ťě‚ŇăEj5Vü® Ŕâ`üµćzÇÖ|ůeşůĄó\ÇyŽw™!·ş°ösg:Ą·ŢŇŤANţU Ă=´Ě[Ó¬¬áAI˛&E˙_y§>p o ľřŽí`xtľ®hçH·:6śCmŠ˛Ú  MŘůËă.›:l·5 [°¬¶'6‡ «ÎBÎ8ĺÚ=ąyÝ)ź;ń$‰tŮĽ¶bl“'gXŞEráĚ G‚Tíéúg<«Ľ°g§10Ý÷Ô<7!ZT§©–4řVŽ„‹Ż=#óÍÁćäj‘Ë®rô]­#2C>nź@Ť›Xm‚Ń„ÉĚwH‹ĘĚŞ¸˝vëµBűc?çú¶L«Ä7N"šX&ŠC]ě9©/o§‡Ţ‹ł~ń'EĚ}†ö1*ď#ŰÖŠ¸G· |Ź‹Ż‚ýś,¦ýIť6ď'â`Ź*G’ ŮFe¤*…ĘM­V’ÂX˙„(ˇ Ż†¤]ÇnżîĹ%ĤÎS8Cís]6 ş×Ţ'ćstPâkCYŠiá§HYQźŽ ś–oű( ŇzöP"¸×—#¶ZĎÎŹł˙d>†b˘ŚR"ąŁ¤CÄ1ś,źö…ŕi‘Z C BŮ.ßćÍüÄŞ‘Ň{ś×[ČV˛Ś•ŁăťˇÎxś:˝_"eh¦ĽŐncđ“a%W`§üD9_Q"=[ZŁ…ÔX „„¬ąąíÔű®Ą1vtĐ‹Şš¸´€Ŕj›×ÍJŹ˝ô‹ű& g×:#Ër3»Ç#7Í(„Ą]śä ĐhvxD‘ŽşĄľp6lKčŇFëçúájaë)ź ˇG<Ě Ýq=>Nĺ•’É[Kôëăi¨I“~`ň¦ćNFíţŔŮ:¬wËWţřöę†.I2[błÁk7eů+|kÍXďXNőÎüa :2J™ăúH‚,1{ą®ę;śnj‰űŇjÄ­*ýŤżÉDăßśč·Ůd¦Şu1ŰzűĂ(›ôîľ­´/&ě6IňŘ3ľü3>ŘV%UŕÄř±:ËÔ~ď+ÝwG °ÚŇ3ŮĚ;Ő!.L,©đXtf®¦°¸YmÖ¦ßaP!D/şGŠmjL8Š»YŔÁË1ó­Ń0 č aŞ ˇĺ‚BꙦ$şÁÇ ‚J*Ňţ“ćńč Ó$ŘU_·ň’`ÖoáŃĽwŻÇÔ™Gô„/r›‰ [WŃPä‚ŕxűž#›…ĽÝ]ćŃJňN.@ń ňÍ·ĺ±ÂłŹh®đ]´r›%ń_\śGĆw.SIe÷…XÓ0nîŮ©m Ë'+yľhhŚ{'aW˝qś Jśł„“o, hß7öŇ]K/ĄJz i\Ä°‹í?…‡mż©Pö‰/Ť—‡ŕpJ¤ŕa’¦ěaĺwĚ]ßĹ-ŘHIŃHV[\yť~5cáĆCK˝2Ýpˇľ.Y„~’ň.w®ëóô šFfŤŮ˘hH”<$z ŕö»ŁyÚÄgAĹKŠń«|Ú6ŇÝjś; ~<´XÓ͉×bR<‡é7‡LÓ[ä“Ő±e…^+-ü`ŁÓţşąfţ˛K˙2u#s :&°NyŁp -daŮŞe«ĺ‘”ťU˘Rl(*É6Qs Őo‚jö1ć!V qe4W¦ĺő¬oe8ĺ »Ă±ë5ą‘Đ}n,Xď]k•±Nh ’Ď mă#ŞşĆŇC,lKň˝ĆĄá‘ĆȡĚ,*Ô2Ąs\üő|r;nÜĎlUBZ…5űĎúDmżc†´¬ŘhىčĆD€~â jH§Cţ׹ ťl˙@»U%ç’ł˘TlYެBjaőŻą“uôsŢ׋¤ŕxbç¬ ßćĎâPŁD~ő—ĹŻPŐqůµĽxPĐö¨†ą‹&tč]ň«Řńž÷xńćĎ'RŰňüÄIń^38ŕ+÷ŐÍ0SĎŐŔXS+‹ó4čý<É 1úÉ:>7MŞ’¸ô ëd|0šéťA©sŞ«Ťď=fA^ćOłµGAy\Ëą}ŞŞ+?ű¶ŽĆG“Ψó6ăçŁŢTzđ¦‡1[˘ą5 TďżęIŤúśeeĘ·“JĽŃ“ř–ľb“PţcÂEĘr·Ź-2ŘÂ@®ŢAÂÍb8µOtý^Hźň\¶vöDŠ±ÓÔGDš!ÓJäé'qčâx ‹¨ [w*łieŔ\ď 9§QYĐľSq…ŕĚp‚g`:ÝKńź…ŇQA*Ż±ˇü‰pűŕÔŞ®CĄC3{ đ"ŘŚ6oŰ?¬_WÂě¦6/ŻôÄyŐż‘ý®Â)ůDf]÷ {$KWé˝ň#~GĺĎü ÁdÜPî äÔŠbĂ_ôZ]®pţ5:jáO9®ËĚâĐ›jţ껣öGĂcjPf#›ôภŽÂš|šLÖ†ązČÁ6̉p[˛˙ĆÜNbšé•WŮL _ŞÉ»¬ô)=řŇ„âAĎ–-Q«1d„č‹S~đ+ˇ’ĆĐęEkŘă×+_śVČLNŠjˇU™N‡VŔ3$ˇ kś9˙con:T—XúJîAÍ@lţ ´¸Ú˘‡u˙KÁ0M â(Čh›Ű9Ű‹Ę˝QčŔ߲°ě:—ýů{ÉłŤŠpú ¤^ń˛ÖąěÜ’nÔÓ^ZY ţ­0Uë“«ă¦đpë!ëß=«p?îčCŽ&P‹,{ˇD¶ÚĐŐľ¨ýä¤ôV Vע>{_ÄOX#H ýqAť˛8Ţx 8ŁźĘűáŇ ýwÉUČq ěiöé }OtyŻI˛ S CV<ŮjaĄRŞ7ĐTŰ/Ť~ŽeóQ Óö´ĘRcăßy1. é4Šó°ůP”Ýá,Š,Ŕ3&n~ÓŰ1uË/5żââÁKÁ'*ó*^ŔĹÚÂŢ I<Ś€NÔúĆË?LOćÄ” ̇>·EŔ Ű>®ĺ$nÇ —¸·’ĺęxŢBŚÂqýˇŕôL!…<…O×_úFíşj‚€ĺr…ťo ¸yęúŚ˙ęR ô·˘úeŤëPáŽÉ:fe0(‹Ŕ|¨4'Ľú?â“ ÓO[>žoŮĐßĚĂg•Ż Ě3´‘ŕVťp~ŁSűí>Ę8égÉ™9âPJŕa]TP†gĄ_6Ús›Ąă Ż‡ŰFZťř¨]¨(*5®_“µ|sIőÇT74ÍIŕŻDß~č<‰Ţ? ¶Ş˝›-˘€)Śẋ_©+¸˝9Ą©žmQ˝ÚáY/ŠA±"K“;fġ4Ďfíď±V-řÉ3ŠZÍ) ÁŹÁëH^Kufío‡‡>čř‹7Öe•řşäiOđŽĘ"F$"GŻ›LΡş¨{Ď÷ÖŔŃ‹Ř{€ÉNµS˙`ľ(Üz2®¸Ş“„é|اóý8”mÝÚ&&ăNfYoâ¬\&Â(b PČTĎSşh{®W!€nî»3äˇ]ĽSżs˘tzRkö ”Şí/8ĎS2śóPMo}…jŮţ;ŮW8[AaűY‘ŤîžhËmQźľ!ýX'†qꛪô#Ĺ5ľě/tč2/ ˛Ňs}–E!ß l=st•Y$ź›¬ËťÍ=„“§s,´ŞťÜ3}Qö ĽC…o~Ia„MtVoą\ëďqwűşLä"LÉîwM –Üîů|ň!*·s_ńşŹ¦µgx¨‡¤Z[q©„7Ă„§ŘH´*ÜxĄTďŔ­„˝eK•Ç|,xbýtk3Čć"ď4\4L7ŘrŽn#Ö¶‚fl#ç‘ąR1zţv¤“H`Zf]ÎN&Ę'ĆĘQđ fÚ§ce>®ü =ŽđĽ—Ä W«©-vĆđ¬90'˛Łg ¬b¦Qű‰P-üÄš·*•! ^ŻXŠĘ ®Ć(mĆŮ_Ť °Ĺ&Ťű—đ:óYr3SňSٲ•O„7ÁĂQ6)ĺšk‘ôsx“Žp«Gç]5/¬cBÜV’OŢ‹Ź»PÇÚUuű˘7¸ŘV d"3¨+0)É^I’Äéśx«{üN|7m=imZ®»éŐNZR$“ř‹°1=_şaVż1‘…t`Ôh~?V†śa€ČĂ…¤"M¤$0™ÝGŚ:Yy–Ę**Ľš…ÜcD೥7ÍŢ&”9!Ľ}™G–śľýU´*zrëĽűzŞ1©—uů¦‘JŔ}ďĹÇ~%Čń&¦µĆ;ŃÚTRůĄĹ1f“ŕĘÔ+jŘYëQ™|Ţß|¬wS=IFr}n!™ůS%‘?YVŞLOĚž÷čÝ Ť0›ˇöÔtíĆ/ř%-ÂÎ!+ ĆĹŠÜh*¬ÉĹ–8¸sܤK Č{kĂD;*IhΖqHzťü…éGÔ<ă“>ę^’wAná\j )”ć(†•RşąÁ¦›d­đăl¨ÖlŐQGň¸a•„ek6ءY@ZtÍ ^ć=±"Ŕý,ôP $t ŐfiS‡Ż>ôĹęŘ€IŠh¬—óŠZF¸fß?ĘÍqL•ż{šÍ§gkL@9&sú#w×äÉőˇü,;^ń§ Q šjRőńĎźŕp›Ď͵Ëě•ţ Í°Y™{‹WĎ—KŃ|ýŽţ J×dy¬±A^sŘŢzŽťř:ţ[ŃYőćżĆωu†y7Js‹lS03>#M“.•\m:´†ü»ç÷‚Mţµe2jÖ]ZŠ —˘#”*ÔNśÔ~ťufëÓ™-Äăąµy?4śčµaőDçٲęłxĘ7f¦Üi©‡x‹şÓŹ>Ő’őf;„j'ŻÁkţ(<^*ws“G{ p|“—+đću‹e‡Zó˘H‘Ů}ôŻŔc! ű łžëôçjh«C1uw|WIyý{Nt®(_-uÚ˘ś€—dâm Ö‘…üßÎ;X6ĄąŞOâdŠ@ŔÝżoĽNžÁć3üqZ ř˝…Hrč‹â‡;üŁ|Ę|kŢÚ€]®ÎţSgt!Ň´‚˝@Ľ!đX°e–®bDÍÄźp“źđÄ—‘¸·ü:KjîiMĆ÷H÷shŁÝË;9řÂÍζ™ ¬=Öjăm§@f\ÝâF+Ů*bťkÁ §DţSúŰ×Q›ýşşŕ»˝Ź ۤ P’ ł~<ÂdüvJ–-î Ůńó9űF,cą8C–±ZÄꛕď˛eĎ&/eĐ|dçj­p( âI]2ŞjŻßóXqŐ¸˙üŽýË/ E Ţá_Ś˙ŔUěňhć©#‡ qy.˝Čn4r#8đTc:$•^Vâ\úâ1%ćH91>¤™«˝S QÇíb‚–dŮ_ ?HvÄU˙&ŇÉKżÖSţČE¨ÓMúć@IlžGđ˙3<^`ţ•ňÜî˙°–eţ¦®™{XűÝrqT‘$:ŹJÜktáýÚ¦âáFMžśZ,Q:ŻÔŻĂ>×^7 Ćß«łç&É°5ő18)ę˙†ĹŰ'éP'}J«ěâ>‹SÔąÉSţ%ża%Ö˘á+ŽżČMălŽ¦+›ÇŔôźňVy` »áŮÜ©—š4ö—ç°ëĂKVŁ°Źť•Ö|L±lS%Ź ĐK´*w`#ݨ·/ă>ęSšÁÂÚ(»Ü%&Č挱Ŕ2śOmçßřW bă«*Ł°ńť]z¬÷zJĘŇɇĽá –¨Ł¨ů˙iĽ¦?¦äŚµźBw›č0ŮY3{Ć0Ľ¸â—Ź¦xÓy‚‰ľČz¨¨˛{Ľ&0č»ÚTyv_ľ\úq°óź4´_]ĘuŞ˘F˘»M ߪڪŘô“ąÇ AµĐú»(—Ľę^ĆFź)NW7đŕ +“¨aň Ş:ÖöEiÎOŔÉ×iˇĘ×2ŃË(ÔmbžnŻń-XNŤ1G9?AĘů¶ęd’ť°Ę@PZIĎƽڔ%ő»Ű``oo]¬?ü†BVÓ×× Ţ…"ŤĘ7® ) ˝)ŘĆ őAN¬¨yßMf/ÁîriŞ˝ÎîÉĽ÷› KśÂł^cDZ׶÷ßęf'a|”DFw|ÜËA‹Uî»ę¦]ä»Ë&őŚ1¦S«aîbZ‡HMô›2Ěđ¤=ÔˇSä&"–Ľ;Ź7öí÷…J7—+ŢMMÔŹŔ÷ˇ¦ń|Č YL‚cZŠťcŻ#›l Gˇ×Ŕ‘ńÍqë‹“mÁ])•dš‘Ô˝ř iwËL”:n,EiIcL/EŔŇiF–Ŕ\˝*k?€chX6rß ÁC ĺ–3H̡÷e jŽ: Đ‘†“–’Ď´ÓŁ+”»ÄfiËŢ&ýµ°Ť`2FČ=u“\•BéÔÚ›‘XçZAĽgĂ!›ţCä†őÎŕšý,¸ílŃ|€ćub6ź‡~¶ó°Ź|0UÇ—[B¦+T“$,6ŮpÓ+]Ńě7ǔ޹5Q<­Ąkł‘r6Á·ËwĂ0±ŢŰC_1żxîzeÚťcRN[gúµIiB,š+‚(˙˙×…|Ą˝ś#uÝ!fźŮŠLÜŘÜž°n?3 ěwᆴ y‰\ożuÔqTj‚©*č’Ä*=ˇč়˘?MV+›)„uiq—F‰ ČŇk§ţÂĂ€öćëÉ ô­xEŐBĐ,Ö+ĽŐÓcÉ Ďăجc&& EM=âD—2Ńľ…{ťż&[ŢEçÚú®ëJáÇÁ?ĆA˛]ľŔLŠŃźĄíN„$Ž–rµ·».ňJ«ˇřD'Ć˙sJµžKlCśŐţ ŰPm÷ę˝ňŻöşžęuů0mY_6xŘż5úŢfüůŞó~1z­vn†„‚|Ní4‚í·&Űi¶Ľů<ďŇŰ_UÚoEźPŽHbcÔBIîŘK’ĆjŠ- Ăcŕó`Č­ď#KÁU¬ÓQuüĆ \“^5GAťĂGą}Üz¶śýqŃ‹idWđ©Ţtüđä/Ąx&ĐüQMÄXĎŃťfxŚm¤§^ëX‡}qěÜĆ° Z±(ŽÔo˙Ä.Ý-“‚˙ÔßĆ·J^ĺ7|ŤQŚőó¨ âş%nxͶů¨@RDôą’ı‚µigKş ň%pÄg ®üť—ˇáă«©Ô%~é•.Z”ňĎ8ҸŞŢďy LHµđÁj©ď‰ĺŰšiB ý® °n vnĐłcnş ę«Kś…žŁ_R]-uÓ˝0a‘ăn˘6íIó‡d$uë+JA8p!,Ş˝ÔÍim·ÁčÝđę'XŰ#Ó°Őjj‡salb‹î×úC_9±˝gů?eR¬Ś˛tC(ĆďR7ĄöÝ<0VVbĽ,z@upl*1ĄE´ÓnDâs1>T¤Śa'†GÉÉöÇ`š3dMŃďq k;Îj¸řŢŠáLś–c}×}˙[ĺVÄäřŚ9 g“ŰŹć‹·eE= SěůTŢă0]l]Ü÷?ŚććjkÓD"+ ÷•Ď2l‘˘YŰě V´ěůx¨ŁŔXvŇč*Ź|19}ËQňŤ3I'ĐwáŤ|e—L5+PG9?ź&ÁďśŘxDś6w#¤_Bąí5:ëüŻÜ”ˇ»tçi=–ôŁćŁ´®YP”>•Wę(Aő”ŃhľAzşńZ-ę:mÚH­6ÎÉÜbB-×g¦ľIj ­ K•ÖŮ©°„¤ąáśűG Kân'=Çm1§>¬`ŔßH<Šdł6mdÓc ëďúJ T%Ň%~UkŤ®Ý]ŃřfđčžE¤Ęl3f0AäŘŤj$ncć4bť BtfÓ éV`âx«Ŕ Η¤tËŮ}÷“jté¨ěúVf_čMWĂűň`ŰČF ­>”Ž TŻ'·„<Ý1vI%”řÝaČdŃ ± y‡WÓďôD{*©źS»3ŮĄŚĆŻ}N%V#lě;\N¦žďĄ·Sij÷çoű„Ü…ĺÇÚĹ{×Uţd‘ziÖKÎĚ¤Ú ›Č„SMB¨Đâ śŽň˝bńvŤzbţPV«ÚńeóY:Á`^d‰Ž´ůLFŻ'\Bfe—µý‹ Ćś%¸{ˇđuŮh,F`ĘŞ”\Á»`„ëá[SÚxŁĂŰ” .ĂôlQ,‡V˙ź„$¸Ôč˘Y̵٭1Ńéë–ť‘8ôn*˙-e©ěX×üL>`{=ü>%ĐF®±‹bUc8 řv,ž;ÍŤó=íĚ?ř‘śíYö0Gľ2`ÉĐE­“ś„58mž[ůŞ~>M_8| ë5žP;ŽĆą®őĹ{"“.Ý|ŢV&‡mNËëŘKDi/÷8łőTće“˝S·‚ńĹţ/]I:SlÄRšQ¬Ë,É_‡wâáa=ÝţjŢěu¸2Îł†`ű ×"łělŮHy F< hq°ÎO·í*s× Ń:EŃb írB=śÖę¨]0SZgŤ9»:Ń <®¸&ijN–D[cŐ¦4/[KcěA†çbÉeőĚîôŔ^„|ÝëA/Ś´îĚă®1 H0OŚm¶đđě=ÉĘ$Říľ¬H2żtúC_ĐŠyđĽ aQ`K†÷čˇęd_ťĎĎj$fą3>¬Ď_fk~[pĎ‘ĂĂÖŢo-`:ci\ť•ŕŃĂ^Ć®ą”聾ëÁ¤Ő7Öf Ĺ>>IĽőčp©h4Hö~Ąba¶Ôđćˇ]˙ŕW®Łcbű\3ÇľT ŞŹ?ťvN:g'HŚ¸~1Ë·­©!íÔřµ~¬žgeĐÓĺMż0 „Ä w®żť©@ňc´ź››E4těxwxyX«h5Uµĺ (Âş\bmFgi•y‹żÍgŇÍa•lEQćK$ë}46mö"śGě\ÂM'#„ˇ.·­5&>ßÄyśź(XşĄDňĄ'ÍŁ2MoĘâT"R”ü–t 7Ç%˛3É=~:<ů8ŰľÔŇŇĚxló`ĆâćK[fn_)Ć\䤂©Äé8,ęŚ.é; 1ÖËI ŤMĄ‚8X.·ĺ”ë©U˝‰_ŤG–Ł˛SqĺŃľ)98^c™Ü„™|ĺťš!R…ó9uŐţ [!1%öŐAÖ)ÝD˛W&*(yKÓ0s$ĺ6ćëů™DQń»{´X‹%ýmůËÚţÄäÎݤ›Ą÷+vŞa»Ě;ćÎTď?U–ŕc`™<ęY“C°ţüú˙xĄ‰…ÁŇ­Ës¸ËPŕ)ÜHx&§b˙j®ë/?izZĚGśOýíLÄ9ŃĹ×ű F@ë g"µÜ«f·r"^˛˘Ň6bVůCŃÉ uxá†Zžű4ąŰĚřź–z†uţ#*ůÄŃŻHt´ěźďzg‰Η.ŠiE˝«>Ć!ÚĆ>´8Č'÷÷I'TŮ{$ç[¶Gy‘ ůÉŻFÍ’tLŃţza†ú>nZćÜ…§m…m¦9ZV¸ ŘżµĂö€sw>p3Ä«9S0 Í +âŤČ=ĹłýM¦Ő ŐŢÁ˙­âň—¶>&›ĹJűL 3-¸ÝŇůĄ97°Nr±Ö*ĹĆm÷ů~o©C™˝<˘#âzňz+X€´ (6-ŕ›Ú”¸HýoŚ~ŕűľ"_¨äę2ö.‰ŰŚkWÖúüA*!”‰ËOBTĽQ Łô˙:ʹݶööUŮńgý‰,+ŹśĽu×r>W|­ľ¨~›+FŠM›8Ëk*P˘o(‰A ş]đ–FF-×Ú%Ŕń§µ×ĵýĹ÷ŮCNŤ'yI/Ű·Vrˇˇ·$ Ëěđ!ŻÖc$Ŕ^ĎÇÍnYbęł.”))`ĽL(U&ŠacŞgá­{hMô+č^ŘÉ´·•9aéŢ+‹îĚÝXj|ďżqT—†/"mVŔ4řŐ#Ră…ŰCbśů<ń`ő? \ i˝ rŚ©Žm—%Ç©‡Ňű )ńśTÁMÍ´vťx2Ř­t»ţ­ŤË °m2?x~Ŕd«ěţ÷öÇ-3!ędŔč,ăC¸S5eת™XËnŘ7|÷čźgb•KßîĄ%ż+Nx¸gĎ »Ýň 5’KŐÔE)Ĺ+}đŇçĂ}¶kQ5Éťş¬¦ žŻŢ쇣ęf˘ŞHÁ0ĂĽ^—)ŚMĹťŚµů–8AŐÓÜ5ł<ßO Úšĺ5‘=v«´á ń­t)4·Oę$sвäŹE`¤żÓHgňÜP8íö , Ęßö˛VđđÉÂ%„-łÄňućá÷—G®t$Ň„’8ÂxO¦áŔ9îŤ"Ś%Ř‹śB§…˘±A›ßa|8®{×ztĄŘÇĎDăŤm™Łô׺„^ˇ˙ R0řizl çéţŔęČžÎÖ̇îKîXîŤEv‹ŁŤcµ>ś,b‹ íîĐ0Ď\2 h7^ä\$ 1ÇT~—_Ł~†öÁ™ú•qzŔEčť5ä8ôMř#•NČ &áhpÝ6AlĎ«đ ş'K¬M(fyŐ ¬A±é…ÍTCë¬ĺŐ‚đž\·U3bˇ=~Ńé0ç? µS”?Ä[„Ł•Ôč™WÎOŹÍ6oŚéx¦ť`łŐ»/ź§đ5*Ďvó)äsn¬ęLŤÝBŢőví}ś›ĽÔqr{#h¸úošÚĐ!ŞDtďm%ň)ó; r•ńŔ±,üFŰTEÚfQie<††‚ËéŤÉ^AÁC˘Ý1E5K ÁkŘu*d€P\>‚Dt,Â+–Ük¸Öp‹$F-e˝á!˛IŮ—Imi[ äQ’¶ăĐ«›,BrwňꧤڝT18c ź*AÉ/6ˇÎqţż5ˇ Ş„JR`’/7ă–‰ź…p±ŤG‘w˘Šöłw”8ń˝ř‡nžŠ@,…íűJgd` ‚TÜŢöĚt ťkřŢVvsđąí0# WŮ=+”h.ҬQIź«Ů÷XěTę•Fúě˘#ŢZ‰gĂX§‰Y'‚dřŻľŇ@˛©äË®Q‰Z8iÜ#ř‘Óô=%őě&v|fËÇĚĐë®g­˝yîéŽCe{_i˛]ÉÜâmŹĚ%Đ0·…řŠŐą”‘q4r|-9íÍ,ńëdíq­×ňHóv÷Z)ĹőŐ-vFîěěhćď×\኏ŐÁwV:íĚü+ ŐQžÜä„óúK®wÇxŁJKčĎeâÚŇ-ʨĽ†›Ĺ‰”ĎPúTÝĺDZh:·°KCŰĎô*ĄşrÎH<ÉçA΋ĚU\s6ˇÁ6ɉ´¤(T‚k“E$HH—óuĽaźĹÁ€=ć”/üë¸Ő4@˛ěIX˘¨Éh×;S#6ő©ŐröđXNił]fŚĹ“/}ĘÔÁ6 [”ôëĎ׹´FS÷cXEáP´wž*ś;Śnqjwµ±‹»<őëNŘ‚Ň “]‰š0>3ů5mŮRŰŰ^čc¶dcÔZďŚm´ŞUá]Pşé˝E˛ÚÓ zůľ Ëtň˘0cR‹Ç2SČl©<Ć-/ń$Ýߨ^ŮÁkąş Żq8÷?Iđ‡µ-P—Í8¨˛kí#ÍR¬#-:§07˙bŚSÝ©áćn«}›ĺÚČŰ"ą•ŠşX“č7)ĎÄ˝˙Î ©î‡öĚĹč"§'˝ `ÁGĹIŤ9đr[¬-\š>ěŻEŻ$‹2š—č­ŕí“Ć•Î=±‚ÉçVH\ŞŻ±ŢFM™‡ŕKNÜ!@G ŘMPšGZ—Ń'€Bëţ§ŕ?”oůvď“ŁčR+5˝ŻŃ×!řő~cżźš<aĂ˙JoĚ9„ 6gůí‰ryÖ`ŃĘŐŔÓ SýĄĆě˝oŠ[šřF7M„Ôéîo§ŽN3ć˘ÜěÁü«/3¦uˇ†¶pô$Öx@ÎVdźtSŚ¨yŰyË‹XÉŁ,WJ+ˇëÍ'ąyŐâěĐ´<ÉML‡ř*ł§o.Ü‘!ßKÔt©3 näDh­?Ä)&Ó°ř±Ť8áE/rô»îQś~ŔČ›(¶ĂôvMńÜŚŹ dNnčď8˛ĆF…a?•@,ż%öGü˙7WąÂEŔőn‘…>ŹS˙É;ż¦Čç”´ëmL(x"ijťäEÝŰKĽ|cE冉·y÷¬á(LF_Ă»Š 'ťP¸˙«ş˙ůc“ ÉŇt  ŠŻTňÍPĺÖ˛ůI !źÄŢŚď–µšNGRíL˙‹|ë=m"ť–T(m~ U,<żiŽÂ-¦'Ě—s¶^· ÉZną7ĚZqDTˇěŁoiF®mXáNňŚ¦âžŞ’Lżd c,@ Ç^]oÎ5#Á5Áď ôõU$Üíť]Ëf XZ=ěĹg#©‚Ě:đ^SýYţ@ ¦“tÄhśiYOWYćD]§!J­G€ Ť"çµ=őýß|¬Đ×çËëxw„먢Ň#ČÝëA:U«‰í>ë°Đ*ş?WţĽ+(aŢyüĄş´*|.úÉ íĚ'ÁŃJ7ď"… b‘ž˘3S_;#DZOë=ţ‡sEn‰ŞX @Á6ç:Iâ†ŮÁgŔÖý#ýřÇř'×l3čůů¨›ÂÜö–ĎřŠš“ëaBDg dľ˝uďďŢ#ČTpi(•~ě홂sŐżá×\W·Âۧ*xˇj˛ę‘” Vx=ž&ÜŁm›Ö®LF¤w6†:Ź‹k—\^eéVZ8űW’y)]ÄŢż(ŕŇ)ݲöXxÍÁ±Š(l?¨ —ĺ´8ź€«ă^«#®m:Ýú…¤y ¶8Żü$ÉČ:ß/|EĽć%|ßľŻV5ă)k:ŰuĽxhŁ&ëŔj@Řţ7Š~1[8ť¦öÓýČ&ćP°Â=TˇTĄř3©B/˛µ€™2w‹c¦şľA[ĐĽ; ­ŚH€}+řf.cć?3ŢYSµí×y¬ąőbU‘ęrb\•ň¤ĚísÖTĄ¸­˙M˛q“-Ç[ÂĄĺ¦[µ4¤<Ĺ·F„G)a˝óš®\OyčPźŤ|'_ĐŠ ĚN] Ţ2&Q®TĽóî·`Oé23é@čMN•*Ŕiî;Ă\ů™ąH#řóGş+/O$›«€ü«Z¸ÁFéEďíć„6Đ)[âi;•• ůĂ#Ž¶ť˛ËÝAŻ”ysŕ'oVő‡NĚcuĺôŇ)¦9KSXŮÓM;¨F ŢÖO–’×_ĐšžßĄ Ń]qhɸŰ_‘¸‰ş\Ąě0 ÔGÜÂQsŕ1ÇBezŐ ¸f›Ô‚tpß 9čć"-"ó+č_0­ép›X0p61óŕuł §t^śŢp›eŰĐ/XĐáĺq±­+­99®Ěť=.w`ýáśXŮ.ʡ?0$úM Ëoöńôňđ6âl| ,MU\Jr@zRß»ÖÇ—űT§Ü‰VŽŞťC™'ćD’V1ÔW—׎€i:eYĐ‚RY&ĂŞŕŘAfŽű!ěű*Kŕ-+™g•©Úą«(zÁŤHi˘2†ŐčŮß×@ÖAŘ~ĽŘÚS»RjŰ*óqĺ ĐŃâĹťö&©MM"4ó$Ł4 főŁÜ7ňÇK9ÉϢç@(,Řf.ă1ú®r7›Iž 9ŕ¬Ęa8ôößŢ(´ hý·@jô=cL?ÚÓÉBú÷N21Ž°ŚOŹďi1î^%˛čŁMq‰ ™Í34#w1Đu—·źaŁ? ď r:߇/M鲴NúH!Şmď’ż˛Ă+íJĎ ů0Ýę é¸ţpĐßBQUvsV\S1ÉĘ'(ĐĐ !Ů‚M¶¤ś>îák4!61× _źŠš$JcO—R†5ž¤Ű}XAřHŁn(ť,zşĐd`rănÝL5CR’4M¶;·îšőJ¬†ŚţN8Ť]űż‘Oň¤dĄ–ľÉą+ĂJ E±ĺ°+*:OCŕÔl°$ŚĽć†ů…ë˝lŕYá¤ÜťÍď)ř™cÚKŤ© 4(Ý˝”2łëö.A϶źĂý) '”ýůeäÉ0SkĂkv„§Ü”NŞr‘GĄ÷Ő[,JDZ‹ů˛YőOdŐř Íwź}65”„±Od9›aĂ3ć'Dtž‹™ÎÇ?"/9¨ţFtÓĹU¬Á6ĺ›ÄT{V,ýĽA ćÉ‚†çÓwE@ŹŞŃłČrą;Üâ MĚpž|řĽhô–@W爵Ű-Ő2ĚŚ3¦ ˇëĺŤ˙ÂŹýŐDÉ(>i #ńaGŚUŰý«s§ć{=:vśvÚ­Rzj˛M÷˙Yź´FÝS±Ť'Ţ™.YąÚ]bhţťŠlßńřč¨ëî¶@ Í&˙LuŞ«SfűQ+”†µŹ‡pš~¶üŤ÷<ş€{ľÔkdzżçDđ7)T4·~Ď,^?[Ŕ'Îł±ţ(Ă{H3íżđR…˙ĺ`ěë©Zr— 3ĽD\»Q+ORhV™ ň»źz¤ cŠB[°Ń䆳‚-†(¬qGÚ‚uŃ°bü—ßЇÍ4ŕeíáV*żYcu`Âw†/ŚŁędşAť"|›ź”|Ř +ôA· Ź"Ľ^zą·éË„{—Pű‡ý2]4y:ßďî ÖZŠ“+aď\ÄqčRx2d˙žzi…ybh˛´B…Ç‚[JS…Ä»ZsšĚżq˛ëÜǵ“ r#’¶`¬ŽźB@zVž÷Ý4 ‹ő솶±„ިËMČ…üí7›zRŕB !¤ľ™őéţ3łĹ¦î?Č&Á`ÎéXs€Ďă§ČVqÇ š±«d/1dćh˙:°Ż«´¸¤/LËŃ|âB?Býěb}§†ÉAŻ9Äž‹ôżŠđc]ď\MÄŚfNŮ1>öřPrĽ*«¨Ç„A‰If †34uăunb›¬ A”ěE8ňŕ0¢˛/ŁżB -ŰcĄI•ÍjŠC]Ąňĺt Ł„üă·©7Z,čmT~IúęĺŁ{ž©—Yź$3lîTďĄ?DpńHbEéă[+ĺO8Ó€§Î„5)? 'XŢůU)X7úp]ěJ,Ĺ®kŔV­ IHź™.iL–‚>Ę…­§“THIŰą ZĐűDî ÷I—ű§zÁsšˇíľ(Ö ű[Ë.¤Î?ŕµfÁŚĘ;ŤDžÍ±<‘k‘XxK@•Ű]%:<’h‘iłÖ(d‡LŢş§ĽĎŃqá<¤ľš®¦îpGOĚ §ńá›HŁ©$\ÚNąDëČÁÁLN_· ¶ŔzôĚ}Kĺm1ogWÉôąţ ^Řnăě›=nŕĹĚZż$şz´EţCRTůńX×íĺp±oH PňüAŠő®-řŻÂ ~W®›§ šc’¶m&ýsMéČJUĐŕäe0"©tŁo” Đă豣ĎmÔاţ‰YKy…K0.‘#ŤĐöEŞ…ÂĎ/<ěĺ^hĄř™tŢ™ „gč‹™c÷‰‡Äłđ6xµ«ËćnłŽrŘIx(Í9ˇM"Uť0Rýź\\ÁŠ‚;içÁŤb#ÓĽşí: \žaŔŞąŘ{Ę˙vizŠ!'ľç\MóTQnQxOŕ'HŠë‚8mçďŰű€XúĽ„EQĐS°ťyyCxřv%­žž kľ­=$úuĚTNčłôlú–ýśĐs]Eźč^MEyČU¦*@ë=•)€v žy}ÜO™TkúnJç+Ń^Cݤ (űDŠ—0çÉ˨}%DěL©ţIżę롅d(A ý‰ Á8ŤŘ 5"öç±FŁ0p¸ ŢË­ľ™ĽłÚsýN¦X «âzŐŞŮmŇĹ=<ŐÄjř +žáčjëÁëGzj Ž®¦ź&*«(fďaŕ%n9ĚGuj‘®öwł°pC›_^dvě\Ś×Mčg1rű˙˝ţ ‹Â2'l}{xH_@Ľ.»cú©•;Ůe ľá죚‡Lr\D€ÁM×VŇ}Ým¨®˛BÓH+͉®śV—řç·úUY·ĽŮŕ—FĎQyj‰´1IóĆlvâ#câi*Mî¨7řW®Z©•pX“±‡$É»c|űSř–óŃ9Řp ÜH1ŕ—łXRCX¦¤Ěk€Żśó›üŚŃ} Ů°óĆŰLh…îÇG'ŁřÁśěKnĘ(Íh–C`·a{· ˇ±S«%€˝鶭÷Î㵬f!Ďz2đ"†ëq<µ÷, –ɵöÂHšęsqȸ;b)Ç4+ĹŃţymLPŞ“oH oEyzy2ş-Ąo§mĆbőwÂđ+#~ĆÖ%^,żżńjš@”ű|Ř&Ő§ö¦›âÜ÷ ľ;[gŰ ®9©ŞęöC3 ~8Ŕm^ŤFWÍĹ|ěxôýű”˝)ůďĚ.ët®EZ¨y‚–¨ ŰCˇ#ýHKetoŻřxČŻm»J§’ľĹR.ńŞIÓmiä.ŮgIó´Kep•'ŞŮ+ȧ¤Í˝|!°uľśżuĆ+—xĐyW0Âë5 lx»ň;qç^)•é•XěJ43” 2GiňrLÝĄ©u †Ç 5VRk3#T%>Ő¶:uBÉÉéżÜ¨™6v=ˇňőeÇ·ţ«…Ö¶;î„ż?ă ¸]ů&‹•í]ďÍ˝Ś1©°q¤şSęŢN{:ýhî§* ŞżűRYňżç1}XÔn$Pň·”ŚŘOľ%1‹Đź‘ţŞü”Lp2včŞI=nKOšâ)IǤ”Öą N™´0ŞÎfv\oT0§Ŕ˛XGĚą~Fó4÷[©Gę¸7~¬žý„Č´`ÖáÔ¦ęĽŔXź!uĐQ獇łqŕśÖÖĽk¶†Ži+qĘWo†HîżQO¬ T3ş«šŤżť9Użĺj.i"cŞQŐB‘ŕ9ŤG’ĆćĂHŁFmô·.× óÁŞ_cRj4Ţ߉cőč“We˝T˝ĺń͉´Č-ˇâ ĐSG TďČóˇ@ˇ., µ_łb¬şÍĂł«M[Ú1P«×䦅ÚňĐźV«ÖO~׹/˝”ŔÖC´±’šE9Ťd|Ş=“ŇG:óđ3¶ńD&ŁÄSp8‡ Ď=¬a߀'›«žHĹŘ˝žXfcÔ­üň`˘Ńű‡¤Í«ęćě†[Ę…3ŇËUäĹý-™GC˛,*h CJ/0yLJS¤á´Qľ±›}‹Áwľu.żČÝŁRÚ‡y&ŘH)Ŕ‰".áJęńú­Á4µ5‡ Q.l©­ ľěČGŽ†¤Ç2RÍĄřJ‡y˝řZ÷Y˝±ţĂţk-BŇĺaŮś á}*¦ă)@ X×ůUŔXAźYĄX•Ď^q>@N ­”IôpÖwő^p| Ź #v™ÜŢ×äěś<ÖĆĚ8 Ź0Č”sÁ{¦,1`5˝ăa@].âú¨H|,ă˛/—ŰoE@[łŰ`w“Çx•Ě"lţŰDĂkK|Ľü„^z©ýp] Aě›|ŕ-›«Ü5}‚Ą5ą÷ęf˘u€g5°/ąŻ]řÂQł×f;O"Eč çT j)Ţ8ăÁ1<ŚP1Â4@U©ŤČ±Ńz¸ńKźâYđcľş<kŤ-V¬Qá·óaTĐTš$+Jo+˘Ťo“ mßx˝öŕ,űđŘzČ—]ť5Ż±Yů­Ôo/‹)™WĚ×i+CrL}(śO +`Eą `ýíÎá—yrë¬Y%ď"©‹ŔŽh›ď¤`×Q…Af_Ö~r醦Ƌ—ż!M$dzX˛ů˙ď<`§˙{­śt-顨"ń·<€©2>khcéżÂoó«R¶ ń˛ö%¤s”ŰňÚ)É\Ż ‘EQëpˇT†YĹ€X8ĘÖ4ś:[4bâ:Tqtí[T2¨ŕENÜss§kä.TJëJwîb<žs%<Ŕ”±P˝w!Bú+[ç;sá—jäöR·ŹI ŚÁő>×3ŕÂ{ZĆşÇďFе‘ęIĽicĂDMł|š÷"öŹ…ç˝LŕTPżĘL4ëísAíÁöݬăű›Íů|`Č[KKÇ@$Ä|­AIöHMŠHŞ.Żëź;f†(L&‹–ś0 „6Ô }»«›8Ę żűw÷ŕ+#(T”zQĽsÂđx?ˇ_^;hŠc>ŁŁ€`w÷cN—ĘD¸pś%«i™Ä–ݦ®” ѦĚé*ŞăËŠ’pGjtš şSfÓŠZŢŃĄß8]Ď5ôIÎ×ÔďĐ”žÎK|D)rlł°Ç§e¨©‰Čˇ/xťĐ›`äŽčĚŕÓ\űĘöŮ5er ’`F…yĹ+ŽÓ´*‘zŘĄnţ3Mú\ď%p”ת5·Á3u©*+H{6Ľ€Î…VWU¶[H$’“LÁú§­ËSöçőtÔI¸_ÂŃ+…$őůéĎ#¨F´žůŮTWŘ’†¬‘Őű+ěh¨4ĎŽć‚jkôU';›« ­2nČMŮ´ŔóÜâĚ›3p#ŢÄ,=.‹ÓôˇEŽ‚pWŰ ßüë@BN*“Îé8çâÓűŰţ+ÂA¨âĚn_6=.©řÖÔiÜ)ťkó®“’O÷R€Ě ALH¬]©ER&SâŮűűŤHHźŠ€H9=…ęz9“üł×Ö †Č˝l&I€@îł•/† ©` ˇóšĎ%P`–¨÷ű©ŔeÁ’NGܵŔíŢ_çyc¨Ä/4ł÷âudUk­r˙S/č×s†Ôőá÷|ĂMY‘®‹†‡n&T´ÜśîŇyzżŁúb#ŽľzAx mAqiűÇH:`PÝĂ$4Ζ9µ©ˇĐŚń%‹VÉŕ˝Ăĺ6 Ö݉x·ĺńž€~­Ů,<çP»1ę›/m÷Yĺřüę”8âLëí˘ý‰•.ejoÝŹä˙Ť J8ď¶ Fµčşb/Žá3©ä¦Ő«Ź“šř”xaěT$ k§Ţm°ĄĹt§Ś…‡˘Oiw—řÖGŢË‚Ăý·˙ť… Ű}†ĂśîćéyęĐ™Ł_´s ‚¦m,á`í’Ü8Ix.ĽŽţřDŃů_ňý€ß÷ ÖĚćVh ĺX˝ÎÂúç•ôŠ5F”°^“^>UöŰĘ=–Ę;ĆC\=A×ńŞ®iÁ׿›N8‚Ôüő¤.›á G1¸V5/NőRű#ń‚ }D4˙2 ęr~&¤Ľ]0Ă·\?=3*óÚč믓uc±ęVlż­µ"…ybńKXă±ű@óůËW˘Ł¬ĆRĐ`ľł“P÷Îަ5’O8ľôF°ŁŘx_ß [ϲ)n?ĺ Őâ:z-®ľŔYFŤ-ł@źíçs/ťőˇÍŘŔ¨*Ź/–‘¶ĺ×ÔÓSÖTĆţčŔ‘¤@†Ä=— oO“úr>Zdt2ZŻ+‚TFÚ´´’®Łüń“±b^;t#mş„RŘaĆ(ů‡ĄąęźńĆ:Ó©Y=Ň|§ó/Ü‹§÷Ü)Ň‚=‹« \*B•Y–v/•ÉdĐç颰$gLůsV™ĘČßZ.RŐrń\)¸÷‡U_ÓZ~XX.óm˙îÔéXKŕp&YBÖďr8çpěQĚÉ6´a‘H¦&V9ÂÔ ŔçřĐ»/:çä+Z-Čő‡Gůďĺ™óŰ›lY@ţôđ3*ŞK–袟15Š+sü±Śđ.+‹j\_o9đŠńŰE©qmůąťâúŠWR¨D©řÄ©(˛›rŠ)aířZ./*/ÚJëĺ–y#®µĘ ˘d8X4äŰÇř 1é`‰íĘĚ—R Űj§Í– -~cň¨L;ńŃ’`ȲlČŮL'·uăŔ& É)»őŐĂ°Žżz:FŹm…ś…Cé~,xţ‹›ÍŽËč·°»Ň˛Ĺô97”ĆPK`ÔG‹=8?řEŻWĐ‹„ňűW[Ç‹/ ¶©a(áł´ŕžŕěŮť"ďăň>3 ÚVcôµ=j1R2łŻ;F”"Ŕrź|Yĺ·łžUÝ-![ĺ=Sęyxňş źľ>Űa×uę_Éó;%ČtjéŹjçĎN+1Ě~h-Pe:aĚ]ś+ř™HÜ|jŻ€]›]H8$ĄŤPQŹ=Ť-Dě¤ÓÉ€Ż”๥ݭٺ¦ cˇ”hßż/ľQF,ĽŢŇÔ'9“«–ŘÄťťmu‡#hoşNŽ·T¬“Ř‘V%Çěä™{Üd1©á‡ˇDŞhěIżűVT|˙B·GôŇ™xz㊠ŚB:Ť5_ޤU÷aIčć‹TX»¸§[$9ą˘ŘŁeŔ±Éhv @÷>Pa=˝\™_i´,)R‹z·EY´ n_÷ľ Ď_gN6;jM€)ź/[†ř•‡%+sřĹž„ą3d÷—)lí©ÖŮ^qömËčäz`xĄ*SâÖŢçgÍ W±X1ś$‚ÍxĐ•¤ą‚‰řP?b˙~6SŕÎKŽŹ®§/ €iľą(Ţ„†=KÓaó„ŘžŹőł=é%CČ ›wť‡ÄtŻç=/ëH}Ą&ő耖÷*ESÂVV¬ŹýĘńGqÁ—ć7"¦‰ĺ˙Çő­·řâ&M˘“:¶ďÔdą"Ô©8M1oß2ŁlëBŃÝrdžL+±ľ!îőc¬pýŘxŚgńů!L`PÖÚUęąŮ b»Ž‡™tŘӨȍĺ…>vÎg”éć٨Bâ_ɬůúş&7'©Ö•'O–Ę5˙ü}C#ŕŔîŮ—(˘4ˇÍ—úż±„ ©6Ć"®ô˛­HĹ~Ň톳Ĺ!Žî—Ó_^âTˇxŹçs‰j;§Aăö#żgŠĚ$ÎěąČą‚šŢ2Ł %űSňşłŇ„Ă”űoM·8Ż[,{'˘Ćw|X3|hA=¬Ë`ňŹ>yŃiD}ůA™ÔĆ•Ö÷Y]¬“S3»éĽ ¶ ń”üâ;źřčČS! }€`üˇPč.é §l¸©“§Qšż[wŠt°5—j±Ů"7†@ůL ÂďfOt€»[1[‚‡BUGĹŮzŔN)ă7(u Ő<ËĹe"ÄPѲŰŇ‘ÝĚ{ÁúMęâŠÔú;ěčhdz?TDżź™/ßMĹ^V†CĐâ°ŞVčx¤!cP·<ËÍ#‰lŁ2ľ;zuŞ ˙^ÁíEqžcVµźýŘÄ-ŻL4óżmwo^Ǔĉ7îؖgHrľ¸vÁKr˝ĐĆđŕ/ŚŇf Ó`i8zrŔÁľ*¤l–Li®ńŔPŤś×u(ĺĐm ¤—’÷+dá "Ç9f°F m,)ׄžąĺ¬čU yęĐn‚ţšśŮlÔŹ6g'ţéôąěŐA)mŚP§ç…ďüY`_5„ żB˝ůůé_ݶOŻ Âܸz&«ŃJĹČ0Ö˝]$?ßíy¦3®K@Ă>Ť˙yż÷| x=Ţ{qŞĹŁ/Pşç¨Čfżśi uĹű›¶J7Sµp…}&Éy]BÚ*Ľź0ßú‰¸Ě˙ó«u€ S|bp$—?)VŻ¶Óä0JTŇ<'5&ľ$ T¨ąUťÉż» Ö@bŇ­/·NŠż<ćP˝ŞµS|*ôĄ«wyµkĆo˙‡âŢB˛+ńQJ lq*D 2:Ăő„ť©ŮQw‡Wţ~íÔI@Ż(©ĎD /3Öäš0&ęq´ű>˝%=Ę·3 ‚”tž Ů&ĘGÜ1ßcMźmř˝bH -Ý\¸kŹß€4Ń~p1h;`ŤŻâĂŽ—‰5AW´;ŹÄ˝:g˘8—l™÷|·gŽč˘Ó,¬päOyWh ý9}ŰԲߴ_ő.š.†MNŐŁť”âF'ħ‡WDÄúëgKLlëHű!Ź–¦&Xđ«uŃ ¤czT WÖ:^^§eÁ˙ÎÎI@ ńL ,ąúb—#2ÉďÄYŻúíÓč=nľŇtkŮN+>“†Ňú¸€¸3MŚ´Ý}Š„lâžÁřÔHšw<ňSw©·ďP$ŃFP+±|oHFčáł ÓH«‘‚đ@í7[—E4Ü|ő‚ÉŃń=öS$xŤ'öUŤi§â° ·°¦’”‘Ł’ ^ÓŮëlł_Ó8 ő}C¦ÓĚGŃOW‡Uí˛3jJxŃéé˘âL‡ËŁă$§Ś“9W:^D. _1J CĚ,:sd‹*hfâĂ\ ‡äv˘ĚȢTţtÚ(č o+˘F[čźrůŤ¸`&LdWXşęĆrGLPę@ň÷/“5%aâě«18UŁś|pĽ•ĹŁĹBn·>Ž~ô–éâ/‹¦Ăô»of§csšĎŃrxŢör·nydŚ¨NfçH°¨ř{‹Úo)íý\ß–ßľý0–VútěTDô–ĽcĐĘyÇa—šiÄĐßŃbÚWĂ]ŹC˛”eřÝ´ňß&“ćň ŇrŻ`îĐţýľµ9Ů‘ŹI Ám¦0 ě^sq ňĆmGV‹ňx¦Ů-Ť×ŮU5 ŠćÁ@“®´.Ežű1@&µý2˛Sĺ\3Öád ixęQjŢ{đQÔ›őÓň3Ëo|F ˛ŻZGĚŠ¶öăĘýťÜ„ëËŠ ó†–ߤu´ß•n;ôä3 ŐÇ(ŃN®ł®ÂmbĂk1¤ę3›É¬ůţU}MF”7ÓŠs­°ÝžNíŐŹ')Š?Ça:1{˛ýĄîˇŰ”‘tNŁ9¦Vظ"QK>*«íë)3ŕ$ÂľŐˇőŚ¸ŕ}0ŻŽJ!׶WÔOťŐ×NŃ­×îĽűŃË Ů|o šößzŇycJúܱŠÄĚěĄ`)ľ8—ƧňńŤPfŕĺĚ»a»îźf8“ňóKăC€ëř’ű8µ\Ż±YY úçËS·ÝţĎź!)w-Ň÷+Ç@îÖ~vÁĐáA?öf˛ş!%ý3ĐŃĘFDDăîź`”`ŤĽŘW‰”ÉĆYÇ×'EŤl@T> Đůó-)µdŁ8ĹϡfîČ"ě˘S5X…Ľ@Nĺa¦V#qßsz·Úm:UI{9‰şKŘgWĎjŽYB‰%ŤBlV±!댺đvVAYë.InD&ÔŻźˇ¨ĺl5¸¨ń--é{ ”_¶«ĎźĆh Wźĺ#ť¦Ęř‡±)J˛Ądb.Î9Ę N×#š(^Ťq…ö(Öáß2´ “‘ď‰Wťš´™Žó1?řţ>ë©n•iÍ@Z;’tÉÖh‰$ÁXě™ęó„xa;ăěHŃ7“$Ń`Őb]#ąóËŚ#á9í˘žswäýˇl?ś0Ś3J1u|*_Ţ>SEöŚ>Ą@=6PT e a˘„™ł˝ôéXI›POٚͳb¤KUçě.Áo“ăŚ,XÁX‡6čYĚMmÄ&ÉčĐa`H$@ř(qqě; °1=Ý1íŹzŕ]Ť}îč ë§÷itŢ^ý[¶¤ű ć-ÝMţ1 9 ť‡`„Ôéz弶ŰnŁţW›6 \Ľ«ŐĘÚ;Eáˇů–“§_#Ů˝ňŔcî}yk«í¨wBČÎçZ`Hy(Zď ˙ćÓÝüÔDýÓ1üťŞľF'f˙î4Ľ‰N$Ş,ő‚`‚M‡Á5ďî2ýÄŹČlŽ€Žíűô–Ił¶•{ËH#Ţ3†Ď±EąK|\Č©x'\cÚ Ž4˛˝g>5iÇŘ8ŕ„Ç{óNśď A”ŮcŃťŤČ<Ă‚%Ś]‹üi†¶ü#ËAžűp†$±[¬ń0uŠČ”˝ý?rPwě$Hć,j|E„@ĽĎů>ߢ\[îÝI?lS @′Ě”ŃĐštŚĄ ŐÖ\ÇČXóĄ#lNÓ†ż2őż)ÚžSđúéú2ˬă­{Q—Ä9ˇ€Ť6+4Ĺ‹Ěg\iÉö¦í:2ăŇ…MF*#킵Ћpnś.?L“<]g?R›WBż¬Ă-hŕPÓ•łnHśaúxJąY]qrżRšJ˘ć¨6-űdsĺL’–`šJ {µ!ßdp(u«,á¦SŐHŇÉ‘ćŃŢŰâłÍE+¤ąß`ŠJĄÂ7ˇ}$čű®ŇoJ|dz’±áA˘tčßbóv–2ű[ť3Nc|?]ăvofŤţ®łˇäŞ7Ö1ĺ ÖGîB˙¶gŢ–as ·ĚP-ĎAWUDsšteťž`}đBkó“ ¨‹z­Iľ×ËŚÄĚ ß·I #ýŹČzqł:ĄůŚlón¨`âg« LëO@µrḲźGsb¦d s,:†.ţeˇú;äońŐęoäz†+Oo7ÉBŠ‡ş€ő¶ůF žaµ×ëÂíűI7 ińŘUą7ÓXźtËí~ßQ˘¬jó«MxQý’Ŕ´»EŽÄ'i> ZĄ­ç×Ć»×ču‚b_ĐíŲŠ„ąî}‡wr*˵<+p† .‡Am3ĂŢcý‰x°«.dŐ÷’kşxĽ.Rëĺ{f^v¸•ü=rÔIsżE"­ É⼴9•éaä­ŁÖáYyv_ÉP/N}°gĹҸ=źĺćtk}€äŇŇ ÁÁóÍßŇßśJ٤ćPËdÇ)Đ=˘]ÖŞČx觉šü¶řŤ?AŘm!wGĽź |ŢkăPěđ‹«@řČ€úČŮżę–ńr¬Sq3ć‚ZËgZ~Ź‰ńźj€í¦âP I{Á˝Iü `Bgâ»;#wą[§ řF@ŚS /ŹĄľ;U 'ŐµCH˝ţýAőÂk¸řő„ 6MĹŻjOF¨»ăőĹľ^íđŞňčŽIÓ@j{9%Ď"ÖIȲĐ-A<ń«D>˘šćë {t%Y˘=Bá«ă°e+>vHâba:hţcëv]¦ŃĆéf—ú˙¶J?:ЦĺÜńls`ť3壪ÚQ:(-‡ž—eş9|Öó>„†3(µ[–` ě%(ú ™Zwŕ˛2Í%XšţÓ"6żąą7ťY ­*UvÖŢć´˝ Ě˘AŮťçš"ţp7qo<šĺ9ŁÔ?óţOJ‚ĂŞ¶ť|ŐUőF)cµęş8_…r_ÍÇGžÜ\±:¦s…7í8ěUĐ.éŔşÉ-»Źň}Ľ„ôžďn;şé‚f'Dő  ég.Šj;$PWo÷e6Ł‘¦ë Ą…_C^öđĺ˙Ȧ-˝Î p~ńTK‚ŇIź4ľPű~r `ř4G6¸ôĘĺýůF™bŘ„Â) X«_ż¶vD¬†5 i#šíć[źrşÎVŢuc…„´ËtÁ‚źŤť—ÝTŞjáb0¦Ń"ůŰ‘v@D4/U”N+˙ťo4ő€ů„§_ok š#K‚ĺ[mÖç.~mź¸śۦ© Ú6ÝÚ ŃÔá<Št.›Ř 1Š—8°ç_ÉLěžť¬qrÉý!fĹl-ąĄ!˝üĽ OKFĚíĽĂĂ´ő‡íç[´űuJŹ1\ëţĄŃ»˛b"(>Ű©ŰŃžÓżfůĎŐ‡ňŠ ÔÚÂń`%4ÖŁŕzĺwţCvjßľÎ;[w~ĺ9ž3íŻ"¨Ńú0â.c1Ţ ŰjíS}(‚{0ă J™4Řr˘UďąxXŕďĘ–¬č™='f©‡ Ŧn{N&ľź[Ô¸R# ś!‹4ąűaYÁÁEc; Ł‰ÓÝ?|­U°Ě¤0ä şÍŞ'SDéN¶Â8±ňś3č˝:ćáĎ;}ĺüĎŇČ]ß<šnń؉*óîűŰgů.ďEĽb]v;ö•ČN +Ľ˙ ,IÔË3üţŘĺ :SP˛ăAÔlMGřĺŻHMÂxśÍÄ řţ|Ő'ę!ńzę^=ÍżF=Ř!ĄńhŇ B ſy$ľsj„eNE0áw…O{ZňK˙«ł :DˇY§§#ŹÝ3»RĂ&[Um6©,\O¤‡“@żŢĽŮľáÜĂ‘u7A 4­Đbyµą¦x{xĘÝńÁëú[cĐýOîĹޱíH«ţ.KŐŻ[|ŻćQ™3HđÉ$ąvB9­NđuĚ,3›dTÁ’©í %Ę2y ŠóAŞe˛NŇ~†ÉyPýČ=›'ie ŤAV`=¬¬Ĺ3Íy ąŰéçÚVF/‡bTćőťpëTüާMéYúR!¤ÝéšcqĽUYtĆ:˝i0ÜrÖWą›†Î‚µ\DWn÷ŮŮÂLZë±nÖ}jázîb†pDŔ u·{}Ćđîâš"^›eŕşI!ŰîIžâ1ü%~!ńä ŹU ·•PąwQĚÍ;ß«˝ŇT;Íîz#÷DaÖM]E*`78fŕC6QŰ3ĄáSUIČöX˛a‹9†TťÉpů˝ Č jÁµHŃ/ÂĽf[܉ ÓŔĄ;Â<•¤ ¤Ô` .LěiFÉú–iL\$éŁuS÷/t–˙ESÉŇ ]-§ô°ŃŁp‹çoiDţ˙ˇls÷ 38QkM˘0ś¦\ôÂąâőúňŮż«ďOĹs—MŃ’îňZGF´tC&ś•Ęj'%ł"lJ¸S%öj f:˛‰3ʨß™=BóSżAxç{°ŹP(yí>©řŁ°˘QąŞ-¤—“ÓűěŇâ)ň€Aç­4Čő_”ź&ĐoĄ±®ĺ9ŽżvÓ춡9Üäę$ČkÂ5Ô‚¸m mĐ ö§·¸Ub+Ś2`­íCµ$®¤?Ćc Č>Ň%ódŃ[Ăőů™Rą ăg —¸ó˛ż.ůŤĘqô—Î2Ţ÷€ţécetĄBĎľŃ."ŞŮ»¸čîŃöż%Ś5Sµ÷ѢyMÄWęň”oa_;•4ôŇé"5c Ý÷(CY µÝ±!A\ĎuHl$öW‹ŰË5hĆŮBŚm‡o~Ń‹„'†&ŞhŰëű ń‡¤>ikĂŽ@„ÂĎ$˛u¬U: PĚÍ<ů9–Č)xLö_a ´!ŤHbůâ®s­öDç6T ¬ä7v}>"„ŕ“hľ’oi鉎ź÷—Ąä*`ź†&p.č¦.Ś’¶˘ôěµ{ánüŤř5%gť—#µëÂ…ĐÔÎ-ÂR‹áľĽ@ŻŚĘy˙“îć8żwWsąLŹzÜR/T¤ÄŚ=·ŚÉ̦iÄÍć+1¬Źá¬Ŕ–;sFŽ ‰Á)íĺś/ú='¸Öüši¶*>츪ŕjĄ}J2…T:w#˝o¦ćŘÂFĹËĄ°”!•–ř\dkĄ™ŮYҬó>¸Ď*Ş‚Ý/ý“ŕ6łĚjn!Ő»ŻT˝ýĎü‚Pô/nҤýŚ8KřŢ`Óž~ohů4YH'4Ú×>îˇ÷=ĐŘ1ĚŔĂŚŹžjv›+(ĚL®ôi:‡őÓŢ$Ţz˛íúŚRV]•ąĂĂĎQ5V* Ěží­ŔľO÷Š*Ń»űL~śńµw©¤NŢćvXBś&Ĺ…Á"Ëü4ľJ˝]ćâ×Ţa1‚ŁÓ–­fT´NľFçµD±Ť‚]Ë‹hŇ?Čj3^ťR˘ ±Z@ái}¨Ř4ř!şú‰©Ľg›¸hîĺŔ´Ęvďç]ĹʢgYľK—€ÎąŚMp}¸Ł 5lşľ$˙ˇS|ă"Ż7V"ŰĹŔĎZ ęŞB«]w˙n:ĘDzâu/DJDyěr;˝Ç]_MńZşW{WyŁ&ź p±Ł™úkpWÍĂÁýË]3qŞąÖC…çŞđlÝ]ź5µ¶úĚ’VUĹ1Ô˛SéŤ h~ł™GIđŞ8ł˙bÇď(â'˝n¦ń㮏ў»hôW8Ęb"†‘ ö×€$÷mÎë9Ypfń=¶éáEʱ#÷š9D’Uă6ŽmŽĘćŰ"ôůұœľ¦˙=ő9˝§ ŠzJR{¨„{G:ŮÁžüŽ»Zx:ŐŐ¶M­ÚCp¨/ŽĹ<žt…"'Ůp :˝É(}ÇIyâ˛o?ŽejbX(Ń%ÁďAS—ťG˙M6qXYˇjŢ´?×q§±sBج09‹@đ~kĹŮŃ]oÁ-}“¶hܢě˛p¶Ń|ťőX‚éŹäj~ÔŞŐĆqĹarÔÇńŞŽYgä_/ë_âšK¸qÓíšČâOŘ Ă†#LU•°ű»,‡ÂçôGĘű9i\ľŹx,pĂź3¬ěx9‡.hł9ůHĚóŹ#Čd· dâďéY] Ŕ€€Ř[Ó€şuQÁŤGü,Ş”ąşólłŐ5ý-ß)˝ęÜ 4ąÂ=ŰT¬Đć+ľE˘żC_Ć·żävÚ4/bB@ĎŇS‡ţ¨ś4P›…MÉ+±ĆKmŽyŐš ^¸áćÎë„Ň J٦`iPN]±Dţ×ËŽß٦fIzUńćËĚč9O{ "MŃ#vĽb:źÖ…TresÇ\Čüâk:őźCü!iŞĘôđrqËź|Ei’GE’Ť<*=[ĹŠD›cě“^ÉžĘíóΚ“‚0u‹ë%rÍĹ;Sž,|]袅ást°XĐx š$«;âA¤“ć#ÁĚJýčjj:?(˙ú"‡ł Ç“0ć-]2˙ Zd߸ C»)«Ľ‡ĄńiĂZŕۨкăń+ÁĐřęP­Ag}šj1ŕWR¸‡ńß+°şi[H;úÍĺő*ě‡IL.Ä:Ôë Ň>¶ĚĎÓN#ČľÜ2lÎ<˘~E÷Jő9 \ Oűtóú[wçF§j#k´¸Ń»~ ńö·Ž» €6űá€%[uZ{2 KďŞM¬Ň¦RA-wŇ-¬Ć%F–­WűÔĎ| ^ç.»ó)a­×'&Ú*µÝą.ÜgS"Ő ź°cď|B[_ eţRÔŮşnb¦Ýt«ýɉ~|.uú ,Ý`­Ţâ¨ÂŃŚ@w)›ś9°ČüžĘźX‰»řXžůfďčҦáĺ{ÂgÓ-•Ý@ł—íůźťüÔý5?Oggw–a~HŹŢÜ~ĂćÜéĎA$ť—SFţG†˝ĺMcĆ%‚ţY"—u ˛EŢxťJ®Hľ IÔág”¦™#­ÁŇžţkňÇw¦ŞśIö-í„b&Öî—)˛ĹŰö>úę¸<Ý‘ČĚd?«@>ľ˙9CrĐI_ĽXźÍ*Ŕ_Ő§ăŽĂl„L.*Ëě_» JBś{›-˘ĘşŞÓ$[*ÝpIsĘeÔ‘"罸hW–ÓŹLJ5’7É-ęhëôR8EŇŹ^LJ¸\TÖŘ qşhünÜęmä’aí…9Š®PŰpčŔěe+ßŰ?˝¶¸é9Häłu@aKXŰ-˘/ ŃÖŠ‡ŕÝLkőŽˇâ+éýú` cĎ®7۬cąŇÄ‘>©]× |k6NOnU]q5Ů+¦Ź ^äQ ˝©ůÇ]진»1—ďŁzŁ” ű]{Ňć­‚ź†Ż´+çćDd~ů¶!RGŢřçő_|“¦ZĐŚ|ÝÖ#stzĬą#Učëťź„ h.ű±ôBź,Ţ̆2ĺţđ m·¸$ü§Ü" S?j*80ʀ۱Ăk­UúG&0¬Ą “ÜŢüV#ŤëLÄxî ‡­‹űŇ©śîĆV}hcjßtŇł„ ¸˘™›>rLŹ-u«ł´jj`q±8‚!ŕ}&w.úAąmĆ[eóí»+Đë±9—Ć‹ @¨)yŕج'ÂÖ>—L Ukl™é¤’ľ)ŤŽŞ˛sß_“ˇéAř»ŁďwŚŇ¨yš7Ď yfa§×ô%%ź‹:,€«=Ů=‡†\„MĘ=ößk¦§žX ¬´†wŞߡq¨ÎÝJlOmnˇĘhIşHúł98·%<ßßV`·ëĂŕęÓ†ŕŕcúQÔďűČę‚ Ë«J5F™“FŘYjíŤĘ ů†éĄú[¶Ë“ż Ě‹üĆĎ×ć$6“uDä÷Ç>ŚFťO«¤Ľm–}ţŞ=çžNŤ ěó®bŢÄĂžGj…UŐfŞEÁKÍEádQąŤf bG¸3S€¶@¤OSĽ'ĘŮ;ŁIću5ÄĂ@Đćíµu^ýćţň•Ďj ZnĂç>KCNNV¶ÍUO$Âő9Ľ‘¤ěÍ»OÄ:µéK#–ż?XH3,±v·ĆEQv˙¬śI͆đ˝óý_ËÖĂľ/"nŘXŃŢLĘ‹L@‚d5ŁKP1ˇ´m—JYΨßc”ďŇł¸»­§+Ů­CîĂäµuł“]IVn81*B©(,ÂŇ™Úcř´IŁŮÄ®ăVĄ’ ĺ%wć ?7^€Äz+š`Ůęçdp­ŞJ s"Ă»‹#xĂŮąÖžďm±kUĎĹÁŔłČ>8fe·ź}ţz&ťąúńćďŻD‚`x|©µ*BĂ÷tÚűŘ~2ˇŐaô"…·-Í›5N"ž9Ź‰–Vđo=ž#¦Vďţ4%!d÷oşÔšŞĄ§ŻşÂvŇţµ~Úta' o?„Šçôę}{ ]±ôŘ’˛Oý8š»SsľĎúć¨ĐׂrÝßE4-!Á±…ó~ô?ĹvÎáÓŇ&zmGĄ1ád3őV;+9Sk»4&tâžIM]Pč$Ĺb,)‰×›ş;ţlăpš¨Ą9ÖŃdóí:“‘c‘|ˇÚLŞň–îÝÄ•pËoîHë$śŽ žcf\ÖůÉĄ–¦M{ö9¤“sZ’ĆśđsşCPÇRÎş!ꧏڅDţa<,0ĐpYjÁ|E ôŤßáܢuřÓ]FĹż¤Ą\;®× öągxs‚ł~ô´Ń›óDłqDő˘ĂH,0! `­PĎń‘îŻei8†R‰¨NĹ˝“ËŠdî{Úýc˝ŕě˝ę@äQ}(o„łßŤIŔcĄJ‹^«Č,R°{2ÎCř&ůü}­©­F“tçK…nË;Dň’ÄwC®ĺŞňy3íÖS˛&«ÓęÄÄ_Ř©°ČHü·Â Ś°Ę„şţC˘3őô štéŐ—á[÷ĄJŰd-¨’Q®Lě•Ĺbâ%˝áĽ¶ĐĄXĆ /ÁŇĂźĹĎiAÔ·¦§ $mS^+=k~ÍĂKöhđ×N7â*čI^Ř|ZAgEľx1$”2–đ}ÁT;G"zi Ş„Ţq—ÝdSůÖ"™.!¶[Ľí·»Ď ÷ˇĆ(#‰¨ż /=R¸rŰ´z1°pŤ©kę.Dc±u3č÷Ă3đ˛“f·žď3sŔ›Uń˙všP˙2|É„TĎá—`@@OŃAĺRN±}ńfk}Öą8 ÷ÖŘđ[›úŐo$ö|őÓ×ďĹs;8Ő tzv<¬Q幺ĪáÉy@„Úvă[anşP«”SČ y MHĆŃ9|%¤˛5+)ÔOůÝĄÔŚżóEťÓ&­çű$ čŰ˙ŇîKT^ů®ŐŚÄߥڽVpŰŻYýąŐÂóČ€ĺp0ÓÚrÂÓYµŐÉ›@:ú28ĆUł ~Q­c5Aů™ ÚJčÁxN¨ţ˛_ŤěYŹůŽµ‡@T ľą|mžĹck=zě‰ë“Ô Jd¨Č{pR®väíŽHÜýŐđ /`ĂÉ%iÇMŚ>…xe…î1uŤťćďěţp-Äe·<řSqÍňďDF=!ŐřhQ &ž Ţ&)źńHí’וËS& ¬Xő{ŻšX޲äa`˛1QőµoÝżÎ\ć§>ŹZi#DŚĂńJ!“(X­Ąě”ţ"?ä‚<ťĂ˘¬9Ö{WZ Ë]ż6q !šaUĺ„ű);CoůŰ„śr3ôX9 Ĺv>.Čţ)9‚řk ş`ĆpE.ĆÎ Všô­Ź2y°Tq&H‰ăíÇDzµş|[Ńţ%Ë)‚řĄb…_ÍĽěQA“­č— YŤa\˙殤$”·Ŕć/QQrTŽĎÉ:™Í ĺŰv—MţÂQžď‰:XL8NvÖ®BnÚVfb*˛Ę¬]ĽaŹMk"p_rčYrŚľúÁŤyćÚČ${%¦vpüýŘńřD%‘™ߧżżÓ$źęN´¦ĆŮëN ™ţ”`‡üIĂÄÍ[±pKĚôayu>ş—#׆ŐL>WýýŚ’;ěAN[C9˘–8źşž ŞßőˇOµ6ËĐ#6¸D&`ą˙b1Fjě†qL‹ÉV˙*íŞÂçŕĎT7ď‡-‚/ŇeŤ#Ř2”TV™ L!ň­A.ŠŮ ĂŠ㮪ä.Vç1Sl·~‚GýnĚ[hY: m Ôř7Ö(‹çSć-q:_!ąA=S(aA‘÷4ÄP¨¶3őÉ Çµšh ąÎ´W1‹ ×Qŕ(»ţJÝëEUÂ^îśq.:ú†»ké&fŠŘ µo´(é†ÍFe­ÖĐŞµC(./|ś‡„b+5+°ŠŚţ®!CÍl|ÖĘv1Č@¤eD{Äş-Ó0‘U='±WzXŃwüŐé¬uwčĆ8=Nň—ČÂi0ëv˛Ű[9d°=˛Î NĄáĐlŮM+-ÎéđÜ*#xLeÇ7Xȉ]†)ä&>ř÷´ęĺšô†Ő 61đl…·*#âČ´@˙) ő¦›gĆ_U}d\Ő ěWqá ĽËs}ü6Ę률b0pµź*„˝5Vf´­;Ť)řTˇć©mČq¶*»nňP0J>Á0y{±„˛Ą•ö~µ#ăí9ý€šzá‹‹ř…Ć˝qxWKoóíµTpÁˇ!A¸w¤¶˛¸Ö^{j°Ąc3ěÁ×”dë>;A_Ź°«ŃŢ Ć‘ş{Ť(ęô*Ic¬‰ĄŞ0Da–W#v±čc  śÎ‡¸N-^ ł“1çŠ_)ă–Âş±ôÓ™*Ł¬ŕŻĂ°ëÍcôśgüřî2›‰üçR'VĘâdK7ĺŁ8‚` čßlIo”Ý:xö˝ 5*‰÷ÎBŻc%µ*u¸Ü# đsvł.Ą=;…Řđxł°ćZwéŐą\łľWúĎ ŃŐq6h}šBFŽm@h'G0>¦GqÓĎŐ>%_Ź¶Q_a.2ě_Ľ~sń=˛©l>´Ç+÷>ÚKjć­ĹłĹ(<§Ős["ú‡ĹšĽő¸AÇɦ’ťŤŃ„‚üĽÜJ,…_;µˇqÚ3ć3ąĂŞ‹¶~ÖkĐ/óJŐ{zę4hNRńĎYľ4¦•Ź1Nˇů[ĎĐLc@WţšRvP+ł=]ç[ŕóU°x‚žŰ‹P‰đzm˙ -Ë«{.{—1©su SV+i„70|¬Î®îň»°_>÷\„We¬¦¸ §›Š,©0übP9·UŠbcĆRx[“ŞNt;Jtpn`ť×¬a`ř=»X:Ĺ(2HdŚM1qQäôË*ˇĽŁčvŐ_g*Χ·č2•ô5ÇŚ¦o7FͶQćÜuu~O‚/Gë>-ęÉńçËHµ §â¸lď·iń\öWÔś5ÜŤoó™Kv 5áČMŰOÔw\‘Ĺp±ýí-Ž{la”R‚˝AŢ™×U4Ś¨ ŽP/'PEę†>”`H<úáOŞă{PUĺĺ„KřY–đőyýjČM*c$ÚYňł¤MĆÇ˝ K8Ż˝Í/Jů× pIcDxĐ_?ţq’¶&µDa{˛¸…?Báz<+&č5ÉŽrË“‰»‚Ą"°dvććok /„@ţ*ßE"Ď%3IâŚ" ŢmĎÉK,@ Ş^2¤űą›Iź#Ň>×fúĹ»Ápµ{Ćđ¸°Đź°îÇ–3’ˇi;Ź‚2ťŁ3…bŁ—MéŤ'ÝBÁ`ySjEb{Bĺ1Ľb}Ƥb$FŞĚç0żĂxú|ĘŮ/łşG¬.R€aîŻ˙‡+Ťż,ń6µP˝źŚtůŠ.8ňlČ'” zŰň.ÇDî2Gűż©ŕE:&Ť¨ŞńRDYŰňO‹DX±2ă¬(ŔĘ…âR/•ňŃ^©l®6„5sáPnÄEč1 LqCÍČţŁ o·2€ŔM6:ÖŞ_ĎF3µGłY'NqIÍŰÄń=çÁV5Š5eÍ°ńkĂhş‚«ŢíDÇ]µÂ´MňÚ?ËąV®K4´1Ą.÷ąC©Ż‚ś˛%3őŠ”mĘF!řµ¸ń¸öäN7’«Ě ßx5?Í9w¸ćoý’žÁ]w!B¶úŻiYí`]ßJ‰—ŚŻQÄaöŮkvL ˘ZI*fW€űŻű!ĺní‘CBr­¦ŘÁ°2 ůŠ|z¬Äsˇä°”g+¶?ľu8&¨wÄÎnľ1äÓ¬ËáĘ›BK} ĄMS‹Ťťä«ŔŞ3ţVŁ?t·49%ŕťČţŘ|Ć„l¸b,oĆŃTnh™\ě'¸“&­žǪ6BcH}Ú#ź9ä61 b॓ĐđC-čĚŹ ßşĆŰ&QdE€$yÖę4öüť;63M*ŔŘ4PyĽ ŕmtx¤ž¶U˙L(ýUp˛^í_$" Ë&±ü L"(Ö‡ţQhŐ8ôÄn›F ˛ şÎi†ÎŰj÷/«5í*›ÔhUýÝĐŻŃí[H©!Ľ­Y3ÎAř-ߎ1Uĺ‚otôǶ·Ľ+Ň74ŲҋęňT`yßžqŃČNNծӱ˂^ň÷7Mą N‹ĺ3T37?Ŕ›« Çę9©xj9Úşg‚ˇrÉ áő—ö™Ms'ś>ńňL }®ÇĹ„ÂÇ÷iď¦2×íž›ˇ¤×±YŐ(Ť ë9Iv2ŮâŕתSdźuÖČrP„Ď!RňpˇĂ…“L”is°LŤYo¨˛ľlÉĘŤĐf¬’ѶÉPĂ4Ç«Žnó¬f‹Ö˛úÂú˝rć t ‚P¸büL%Bs( ďô†•ľĄŁ>–ăŇq_°Ę…튻ťHtv[„Q¤?­•š‰oź]ÉÄ»+ âK?˝mfěbÖAÚiJóŢ•Ý™V\yŚ.’›|JŇßÂi]hđA«śź"‚¬“ĚZeM.Jś°§ĹćBéáä<^ýŹeVÍKRÉ‹á8N@]u[nůĆí_…Ů öeh5̆ĚÄOĚ+Ăâi|dv@QüŻGÁfĚĽČ1Z÷ą»U „WV´;&Ö/ ˙ŐfFÝ?ŐÉ ±:5 äÉż"1{쩲ě—ET ŐŚđöcöOÄ˝˘wpż¤ů2ĚWp*€őÔó=5kţľ¦żÎ}Ť.•µśÍšh|˛¤ ÂĽjó“ݱă7ú#Qű‰ŁK­O}T$ r>Đ:z‚”ÇÓe;`m ĺ±©ł®7–Y,ŻEŕ˛ňŚtYŤ%×ŘŮŃť§ęµňü8”Ö;ę-, JŮổ-D… ·ťyýjfËšYlîw9ë¸C{ ±ČçkąçëĚd Ü©CŐÝVR+Ňp¤âď?ůŐłÄ' W„S8§=câęĚŞ‡v»Y(çŚQg“fŰl N§»‹đgÂň/^ż–˙he¤çÓ·hř1×›É''ąőSP§ţ÷Ń× °ŇO‰[çU‰ÖUôťăŻMN'Ž…< ‰h•ËgŐv·ZpoaO<jÓÁ™iÓĎăĚM(çP°·‰”kë-Oćbąp­ HŮÓ˘RíČKŐîĽýĚ«ë+ÓgčiźĘśĆdň=ô2Älkar$Yo\`§¦F?ŤeMñÍ*ŃżV;$2·nÍü‹%#cL/üzEÂdÖřU·Q€šVöúU"}"7Ex–78ŰĆĆăđUˇĎi=+DŹżż±íżŘÓNÄ#K•cA?ě«Ëři:Şn9¨]ěß •ĺâí|gö†„>u®^¤ ÇŠä° á€Wü8{ńg‚˘Ţ«ĘŇgd’ŕbť7ö6bżA÷&Š(żŁFú[+Aĺě}Rľ żKmKvĹ´˘Ô¸§+„ÉŽ÷#§ *Ţ9e/†O_m¤s 5ż‰V@çlťÇ&4*Ý(ÁY(Ć>ż'kÂ…Ţá ÂPćÚ·>ŠˇÖ­¤ĎmŞ<…óĄqm,Z vŻý´‚ýűFu›u^¶"oNhÄŕ4–dŁĐçÉÇuÁ°ś!¬9Î`·“4Š,·ÉBbYC)ZLç›8Á.ߙƄ‚ÄŰÖU¦ô[>›tJ§aŢŞ÷̤bf•—uŞňÔďÓR ­¤°N0ćÁé/–S»}č|ÖĹţ7Ă˝ĹvěąG¤|ŃI:GźĂË•ŐĐß_âtú%łÜ€äȱá´±h—Q¬.sď=HL=Ń‚ĄGă‰Ë’ËąĘEŢ9ů‡„ś±\ŁĚí>_MŹŃ‰. Vú"ĘÂöő …x+®§1˙$ű~‘đ  «˙ßťçßu( Žń‘=:QĆÝzDJF|;{×Í®›4w°6­V Ek˘‹~:ŹđO1`î©ř¬|,Bg% śEd‡~C­7^a|T 0©ÜżX<ŚOm B€+‰ÇP¸Ĺ˛0ÂČ+í€Ôđ2ż÷˙! ®3XĂ]GčضŠŻŐ3Ö?ů,B °x˝Ë&ŮPČdSn}óĎżëOF˛ćf ¦wo7őCóľŁm7Ś‰ ®ť+Â9®k)hęéËą> xćSQ’ˇé4ČľäŻď%Cěî_ű}˘qŹGśĎ¦¨’ľ|(¤,"ecŁÝ°Í0i6`˝˙6tČž\ťîŘJ1Ë#ńłÔ’0guéĘeU ¤|};Ô,YEc|uOşť’rś©tŚNú70ýÉ&|ŞŰłöĐ„†é“p ;®«†[ç|®¤.čđI‚JĹ.úŃPf·»ízîrťY„‡™—§ul|'±Šő;ĚâaËä5ˇŤë˛©ŕ˝Ź*u%Śźńj-†î#«d×Éqí…ŘĎVVŮÍ˙úńQŹi- 6J‰5üb6ßŕ°& iu3[ľ•Ű+¸ >cĂË<ŘĄ0ą.'ĘZq{xűĂ2ˇÚBěmţ‡wŕüNIĄo0‡ł)7W„B”vs7á»Ĺu¨€Ü˘]ĚPÔxVŘŻa’‹ö› ýÝśÉ+˙(-a˝hľMQe‰Ć\Sp~šŞAęđęuŘO;ú˛;ŤŤ%‹Ąb#Y ]´ඊ#߮ѱśG‚lä0“ŢüĚE ťň /ä\jľe¬Őµ€7ĐľąĘédŽ ŁŹĽÖn},ů˛őĆ˝KS›Ż°^żÂ KRMvŘ3>ÁŠ[,šŇ6äĘ5’ŔpűxÓË–ÄeW‘F&Ţ“eâŔiÍy›ć—9 4އEIü"?¸M*ĘúEÉ ô |äy| ¶VĚş™=0˘ĽvDX÷Ü «:ˇ¨2ެptďZ$ P«ÖŚ…lđVÎD0˛7·ź97]5Ń`m"❥ÓáĂť5'ód¨·Mxy4YuuçÇÚ%c çé/*NP’ŁŤ“cŽ…˙€B„€%GG&đ«µń§Ů»GOÔT§ěŃŹ'*°[uT™/śëŁ÷DđO¨^ ´¦G«±F4śá#¬šŘ §Vź¦Âru^ĺZMšĐďĘ‘¤”ł¬‡>­1 uĄu\m$¨JwŘG÷„ČD [őí#š9úoÂh&KVR×[TŠĚĐ”Cq»\í J *%¦$1FO b«TËŰč’¬gĚ–ţş4Ýű^‰Űy°€†RP¨¸Ęa€<–ržÝőÝL )?† 6(ÇÄ÷V9ĂÂ69ń_›Ke`?,WYäq;kŽĘţ•DÜŢ›ŞĘ źĄŘéů˘Zť§FÚěîzÇfWÚ—íşŐ—°ŠĆdečÚ<é€'­„ĽŁs¦2^Ě5H9„@eÚďťQ9ó“v¦ČNľŽÔ˙ÁßiSB>wwŰ㧧ŰjJŃ)\ŇAď…OȆĚWç“–˘¬|\’źÂŻ*-yĄĄĎFĹt ‘˛Ő©?1tìęľú·]BUaýßě’ ]ĹĂßý3S9řčsś§b@™¬ˇfzŘ×ýâ~ÔöÁ† #§dĆ ÚŚĹ# 3ţV96VĐd /Â^[\«m`vQ|yaw8Ä[Ő!Ýęë˘o'ŮTGô&Y 킢1ć´5»y¶Í[žéÇ:ŘčɬĎ4Ši-˘0ý’|hŽ’ }¬ŘľxǦ Í®ű+®6FŚ™d;]g}1š{ëKD—0Řä㍖|…lŻMâÖJkDSđVµĘJ*7YšGuLBZ$¦Ű°Źo–ŞĎ¸é€âĆ Ť]‡µO{R°Ĺac7c– łß~ÂJ[ĄşíI‰-.}2ű4,M“fĚWrýÉÝquÖ†>˝ę˝zb[ŻĹŐ˵ “»XßGŹ«ű§E¤k#c čű‡ňÜZ†Ž #/=ú¨—„ú /¦@ ĘAr;Â%RěiĽk >0C»:rLă fjßr €­Q[µáďĚV¶ĺüNÖZHHR:…»qŐµg[ŠGáŮŃpťś…¤–Ź}ć’’…§7şűŔ˙¦Ń.2ËŻnŢŻLS»`WŚÎŇ©×Yb(bÉxýđzŮÍ[+šÖŻ(ţΖ $k Ôz˝ ©dߣź´ÔżDŐŚäů‘ÓBč6tľ¤×Ö±ZéšgµCľ]Ž›v ÇK'Z\Ň@m´ă)T†ÔÁőţ™węcÔ8mŹć˘Iĺ 8SńŔĘźöľ°-946’7bE$5-8ńśą1ú•€Dsů´üUaúő}%ÂŽ•%–t±»&€L0 $ł|ő@^R [p«SČlp·± ő äźđ3ÍVĚî}ę•ĹÁ‹ţď˘ŘÉHĹo¨ŕô‰°Ä*ţ|3UZBŃ-ëz(Ĺ67·¸ůtĘĆěçöµ“Ŕ'j ľoŹţ`<Ú¤T)›ŞÓ3·Ýü g”Tž'7Ţ W±'”JÝ ĘŽgŽ—\Xěb±Y˘TIň9‹]śsw‰÷2N¤Ű˘N¦:•ý™OňˇA †‘j3~D¨0¤ÄĂ’*¤?`kKi¦ŘÚo…óTť=š˘búpQßꊕ\1ˇ@ V;Ň;ţ… Ńr Ĺ?/’(SŤ#˝ź¬Ąá„8î>É÷˛Îó˙˙ üRbA?đ‡Ô˛DţĎGJe(oőÓňŘÝ…S+}éĐ™^™‡ĘĂě1řń4S7Ë^NJyk`ţžĚß` :Ć™·ËdűC˛đ´š y”.öÖĎÝýÇ%q»ďޢ¶Đ˘P2túš<ÝđŤ>>Q,A2!pŕ'źˇÍű^«ôXÔÉD@:Ö|ň‡IµQĘuNÝOJĎĐîîÁ0¬*©0ŇA‘ôtU(snÁ™HÜtć¨EĚÜěĄ8¤OIi‰câ{NұËËúĹ6őz*ä6­'ąŽĘ~Š@RϲuL•höV4{-űý0«ËrúŽřˇ’QFXžgP[Ubý×Ô«ęťvýź–żo,M™^Ň»ńżnđ› ó]űĘŁ'.% ®lŞ–Ł“o o”ę(Č1´[möpÁ†Č:ńß đQ[1żböWśTożĆ†ßW;‘ŹWÜŢQ‘WŇ=ë•­zŞ–`ë3+a7ŘŁLő_!-qeŰý\U lz.ĚĐzJĘůŤ„ľC…Ůym†gnż@ÍĘĆ4ľŚ-2;áT]‘ČĄet×ÚťČ:'÷S7ČČsFäę/Ř8ý7ęAçĺŽCđ%í:’‰d[čeŕűŰýĄrôÁŬ6»}‚DKK řC§—Ҧź»D]ŚŻű2I[|˙eÖi«JôÄĺúm°4MŃŞüđĺ\Ľą,đaşT4ĎgÝ;íş¦7ه"B›SńĚ Ĺç˝qŚÚ0Z wň쎝đ'Źü{đ2ęÉcViE˝cßcý #ą«¦éŽŐb•ů~®äJ˙ľČźČĆ%]76ăG†NŐ®µu-®!Íśa ´Ňâ@=—ÖéZőÍíő+tĂ˙őq&ł|ĹU÷ŻßĚĂřG\űë¦D1h0aÁ<˝…yFöOšŻZ0zÝ-L»(˘1Aš˘­đĚ-Ä5Y¶˙¶8oŢ;ň´y˘lNĂ K.ŠËS kŞäÉęIC:o–ýšÍ‘úÝmšCčĂźş.A˝ľ=@ĘÓöýeŽÎĂä‘ŠşßÔ řLŰsSš{öT_UýŠ83ňš@ěµŢüUĄĘM‰#–ŮË" ŞŠzî6dîLĹÖc°n’·aŤ†&ú®š! ,»ćěZć/{cĂëßľ­5‰®Ä÷NŃăĹ!Ňg¨ż–Ó§t‡nŠo3gł”ÉD *Qä|NK•Ĺ!™) ÁĐ?ÄĐ"ý˙Ŕč1•N_úźVP(í–Eâ9–$ éü< L¬NRńŤxvÓůJ›H§4×iÚ¸&k%;ŹĐ׫‹×5ćĚ.çS™wĘëžbą,O'„ˇ9Ř&—ľłĽß=îcRŤŞŰ©`”߉/ËTťËaqAÍ{ąˇ(±kŢż^5ër@Đä°˝Yořś7 ÓH64¶“&h5(^,5†Fę˙F_7-änÜ[Ax_ŕ#;Á6&ś+y¨Hnk—z>DTȉ×J˙.]UVˇ/>©ämΉůü™Ę ŢϸG_X)čöŤôpł2}$•q4îčgXp>]ĎŃr¨„8r*RŤ›©¨Dît“Żb¨”Ę)ÖH­„Ć×$ď~ű3}%R¦ĽfŘrÖ{¸Š2”¦ŘÚĚ™­6,µěię/Żk3‘ŕíÚ¶©„óW– ěŢž3]ŮđeCR™“r[ĺů8l4_«tkTčž]¦nđXÖu>\޸麣ęPNëiŔ€˘Ş—–Ţ—ž9ŕwTô—Ăp,K€L„V…Ű1Ý’• Hż‰]îY+}t‡ŕťŔ*@˙şŤ=˘ĐoRĹĂŕݒšůˇÂ‘˛FĐk¨­kP]ËÎaW.iFEWş˛§0Ďĺč;üQ‚ł1?ŻĄMG^2ĎÄJ zźQwfŇč÷׳ôËĂ_Ąę•Jx2ČUPíŢ!Ç1~sńŽ>Cď: đhđ-Ę*©ůç8sĘ~8čőÜĽ‰€÷ď/H:^ Çţäq­đ!n c´ŘN<á®»ëĂĂz9([a»čď%źXRöŤSţ8…Ék‡&d(>çÄ…áŐ ’Ă3c'†]‡ąĺ´°Á>0÷ýÔP'ĘzšS^Ăž«…b§*Ř-Ď&ŃĺŰ”ĽÔ°[—“©Gš§se^6Ş«şŘ$–ÍÂU¨†‹,ërxoÖ(‘.˘ý'áŔµÓÎËlČ^µůíybsŃŔ-S·‹ź-ÎŞ1 "őÄsÜ>z¶ ĄĐźz:?6-™¶í±€Ä±2Câ€e$»’Ň>vňpA„\qŰ&4łô˘rćĂöGsŘ$P…TY üâo÷Ă~!+*ppńńĎftĎWî~_ÁůšáĐNW€”ÖYmđy©˝_ęöź+©°w6«şí‰ČB±Ř›Ëý˘LŞoQ+›J ZÎh‰ĆV|żOňśÔěoňOGĂj_«Ţ[ěoUŠŃMŠ#ÇąHŃ\…)±źŁ»î…e™[ô7KłÍÎŰ›¸gîŁĎ´ş?/„VŢwTŃwżŁ_ôsŕ2`oľWŮo/ż$TÔ'P·¸zp}Ro_Ť.ăz+‰AÖřý‚Ŕ,|<—č®cEW2Sčż)Ógĺ k´©¸ÇÉŐj”‘˝ţË`VĎfsďR‡‘ů.},±ÜbKć=6Éf“1–N "˙ ˇ_ŻęwQĄ™ˇ\¬NŻúň,Ň6ĺZ·ÎËě¶UNéyôŮ©‰Ć[ý>*hžˇ$şb"J¨äl;üH}†3˙ş|KEéáÝ/1]ď_1—ŞÔT{Źď–{»0HwVą'ľIc>Á scŹÁ)I#ôÍOđşě ’Ç "Ę Š`ę“·/JV[ľČ5YYč`§č ŻFŽ(/î®I‚¬|Í.Ů#˙—äxç ŃWĚrŕ)ąó?Ř;  /5â_IŽ-¶uô ™ţéßx—ü-‹ů×ĎvXÚ˝š5:T;ťąÁŕkwK*Ĺű†¦"Ҥ€ á_|"–$o-Ô™&Zj˙‘l2®jJ楛7Ášśđ4ĚúJä?'ÜćľSśíW?ßŮ›ĄP˘ă€ts2äÓÜ Ó*#îh‰´R4łLĺ?­Č® ź kK|Ę.+¨pR6Wř^Ř…áü1MnŰIŹĹóŻÜ[xT Sďe•š=Fe&rśµđQ}EŮ ‹…-ÚäąóË.Uë7ć~´Ś@s<řq};ŃNnť k|DJo´ŕ„•Ř—]®%`s-J`ś˘ü\,°ŽçŐĹě»]'včŽmäd;éŔ÷b­ťť·ÔŇÓűź‡ŕpV”ÇŃY;·Ądz&l9>Żqśö‡ÂđÖá(;_OśEWčB–ŁĽ¨ĺ{Ó<ďĐÝľ”vŃă˙Ş4.óé9‚çŔ'‰LÎY€0*űh6ŞÓ|®âŃ‚şRŠ¸ÄÜv‘ăW¸î? ľ"śÁŰ’VË®ôU×\ő#Xjjs™Ň52DŰď1€8H—†Ädö®n4…őCŹUpaZµ3uřrtCÔę×DJˇ¶–Ľ“Óč.Ŕ‰hFžcYĘ!MĽo­Đ¬›Y}öÇwO«Í{5ôĄ¸¬=8·©ÔĚ}˛´5:î.ź-A«Ů@‰ťÖ|áÜą¸ɆůyEŚÓuëYĂnbQř’Ú®†Ŕď…/ĘeśvB/nŚřAO9·Üz.¬'vCź©ţrCŘ$ŞÇŃáŤÄW›ÝÝšęŰšÜŇß)Ůxs I°őkż.Š©@|Ć_lúÓç_  ę'żáTţ*ŐMeĎ<y'WĆqRG„sTZ©óŤę¨´ŐžŞcľüăÉI©ĆÄDŮl;އ2ůrv›ëýĄú Vý”˛ĐŇ!cŤ¦Q “şţ ›_—})Y¦z±ďG„ÍxBÉ´–šPRŔ‡>2xäoř˝Ôµ7CĹwąś"@äEvXjěýnuůË`ą=ĘFSZ’LJ#µŔÍŬł7†O–µ~°_“}öާ@d9m’Ş˝BţM$ŞĆŃÝĚ.€”ö©S&ÜÜ<^\ďěśŇ+¶ń~aŹŐżŠąÜ%“„Čľ šÁ˙Ç62q+ÎhŻŮ4Y´k%–gsp@Ń•ŔńyŘ|¦mfC>5IĹ‚ĘO˙ăő6ËÇ}ŻşľŠíkˇ.¨Ąé¦nmběČ?ĺ'śž´ťÓëĚň9?뢹Ó‡ö©˛´Ô}ÍÇMRs7®uËWľ5R§'ŢĆDoź~KăChe1m°Ż¦NąüťA?‹ěRś®r÷SˇJŔ¤`°łV X䬕2_7d$˝ôT Í@ěĺ˘hîBţÄZÖ.ť»Ŕš Ş#‰ýĂćT·Ţfy—ęýß AŽ)ßéăúB‡˛)çy+üÔ>®‰z)c€•áţÝÂuŮ·Ą!Şh¸O™Y‡€}0 ɇŃůE›öůôĽÉ»ŐŐŰ$@™W9›Y‰pďz®¸;łc®= b­71‰şĐčl%ů—Ö -őĂOB2‡ĎÝň*őBj0*%ŃËt0P׹+đDIvš¦ţ©ĚŠ¶†Zrn-ř”f°üĽýz\Şť’_ô×7poLôŰ^YÝ=44C  öá Ż§sĎdú«"qr.{ó+ ŮxKN‹,v¨:ZceĂ-·iĐ×Đ™Ľfď' Ń ë™o­Žˇ˘¨p‹=_z"ˇÉ:sÝX2°ůOőAHJ¦\¶iŘĹ´©Ź˘yĎôČĘ)'ÝYüîŞ)‘ ňyě™U«Ľ¸ůweu~'Đq ZuÓ228˛ş“šÖľť~\R×n©)şm ą­ÇĐSÔ0ćň2 ¤"ö ˇ˝óăfüń^Đ{ŹŕWöiÇ…ţ§Űý˘Ův ąŐşTý‡[Jľ|śFB îŻ" müLŐö&EźăÉ{GÄ-vTž÷ËZL©’5«lîŹÝĆaD[?čΖçłÎ·€ĂMÁČÜąŢy)©Ľ6¬Ç)Ń€ó´őŰ·˝vźöU¬Čq8čǬş¨i5ł––ýN/ÉĘU1ňŘ0]F“JGĂ[ÔOh+đ,H¸Ó nqŘ!şy\ĺń›Žżĺ®6/2§Ě?Y» RĘÇĽ˙• [ďý˛W‚čŹ ifhŁÂČCrŞî˝é\ňuO8·ĺ[M%;çË˝ňüZ}seăI{LÉÖîÍ.P3Ŕ©´¦FËkĄ8 Ďěb=@‘©q ¸WŢ×ĎQmînŔk÷eó/ľĎš9’ÔĄvy-TRG©Í ĺÜŻ›—ĽőźÄuçh] ÖĎ܆Y-Ľl;v€uý4=ZąŚŞ;¶â‰­ň¦š«6cű;ăţnŃ×|\Sś±Ip˝d¦í/»)±¦őˇđťFfbzBiŢ€Ľr[Ľů¨ l»)[ź”š÷ö°-ćŮĽą6âú±C`P”K§őî|Ł©pG^şIňµşEßDúö6p¶‹ eżŐ§-kÄrá.OyüP Ŕ˘‘ĽáWg|Ü4ĂM‡.ř˔֚Ř(vŐúBmXđś]’ĘŢpŞpĎNđw§kęsz\ ‹śő\zÂś>íŽxĘj şsđ5C\‰„5ŰF ëöř¬Ďř›…ß DC”ř[ÝüŰP@vr /ő)•XíaBć= Xufp6ÍÇa+5—iťŻţ˘Yz-ś,äŻ:r8¨é°|Ł ve'×öjÁ}ËÄa%6FQ4×~„u1íÖpůW1 ŕ€ĹâşíµÁ5ÎL–•ť$wÁÓ!Ńđŕö¸şeYë×&b·mT}<źŢ€Ö ,g '÷`ŤŔĆďMô@»<’˘@á±9ŤĆFaŤý88”) zn6ŢB„Üö0ÄĺĎ*gˇÁT.ô[mő´Cˇł!;toFx-Co¨X—>~űŢĺ÷˙#™H@4ŞŤ­4/Sň6ŃżMł‘ß«6OłŻÓĆ?“?řżţ˛nU·6Äs/Rř’FĚRއn=Ý+3©IÓi¸žślÓăµděţ\s¸Đeůlˇ\)‹0­oéîKýü{'#×$,Mˇ ,˛KËđoFSŇdź¨:¨†áŮk«×r}ĐZ3^>iÁŔÍé ěó|J‚ŕBSiHćD´[Ľďwá/D ©ČPljů•ĆŔP}tgŹ'Hy™ľ9ă´"Ţ÷"IµµVÜjąĐ#>$e ˝¬t»>4‘ľßT®ĺ™\˘šRÓRŹD'âţ02jmxW˘'Nť!¬LčĹ~A5ćá¶ç#÷*˝{ă\ŤOAâ‚7—ĺÍ©Ľ úçµě!°)ˇBčŽęŁţDËÍ&§’5Ι~¬ąĄx§ř‰yt­Đ/\cĘĆ[4H\†Ů€ Ź÷áJ>9ŘÍ Ö›Ĺó5PpâABŽď˘u^âҾijSqOШ€HĆťr gcBęŮD ÂƸĐOÓUĚĐßĢą#\ô<`Ä!{JĄČD‹±r–ňńvNŔ vç)éď´7ťńĆÓ‡ţXHľ?aSoť„ňŤ)ÜKhkm÷Ě+Ę+ą€mzj, µ%+Çfáű ĎI ű+ ¶Ń;ß™ëÇ’R~Í·(¸’ÁŔ†đ(č˝Ć‘̱d˝fMőÜfˇ]Ă>_ŕýb°•›s†k§›Q†Żę[Ú‹őíd¤¸Ó34}tŽh,´Ŕ[Ó ť,&.¦¨ĚÁqKZW+[ µ›×Z>PGU/Y”űďS •zEtĚĽűĎÝ’¶.îwKŚuëÝI”a3¤~z䤣H‚łcépů^ËÇű‰fQ$lĚŠFý˛ÇQžavŮŹĚĎż gG¤-"ἪqLĎ~-î–ĹógÎÓ»ÓR:˛hb¨F€Óźň(mL.\zj!m`îÂö¦ť^ŮsóŞ RćyTWE´.ä@#pI ¤ÄEż+tá·íµ°°.ŔTŁ„yb °účôd/Uöý nF–™qÂá=‡í;]s¨*îĆ|%Avśm6‚Ă®ŽĘŞDQRSň˝\y()$xëŁ>4‹8zhÓ,—šßiG Ş‚ďĚ_>ĺ ±JNęČźbËHĺ˙é`W¬ťźŽł-éĽĚ ßź4ĂíÂ""I˝ą&!‡ýp6Ä˝§ÝŮ(r¬?tcÂÇâo5ž@tJ¸F§ť€žď71ĘSÝN~řşüĹËF‘š‚"©Úk|Gń(ŞdÉÖžÉd{ˇiĚřcŮ î łZ‹–±ăź\% čÝhşŚ…ÂŇŤ-t@©c^ô4®B-@ëćże6­“ĹËĚVܢÎgꆊ•ß‘%U¦›Ą€Ú„9“$Ą·í&äŁ[6 yÇŔ¦Đ3ĽĘS¶8üľuÍcýí„n庇.Z˛¬îdf Ť›=^€{pźH:¤’·řĂ…¤găüľq¬>Ĺű2ăbG ‡46*ĐŮÖ>ůěÜĐÖĄŽY{hżź«y{˛¬4ź9é[°“tärÔ¦=%M”‡ ţŢn´©ćV]¦FΛY„vFíÂa…đ–SÍéůÄkÓUT=U÷]4ý1×Ęűď4/É˙ö‚Źš ŻEŠ»Üäiţň7Ž`ÝŚ}łn˛«E˝HgÚ;Ć—(čĘRşj^TFwńÇěFÇôĹÁ’ń^"ÉŽŞ&ŮeľČ–Ŕš2;‹ ˛ŇźŇl!¸bWšă&d±2Öůń«{Ě%~ń 5čnâ ‚9KQjłĆIł}śăc#Ť`KN$.ŽeĐÖŘűA7~}Şw±×­"š–‰Î ŁŇDA=v˙¶ăŕ»ĚČP±†? Ed”bmT±˛Lń˝É(ąníÍ!÷g”›ZO5¤2l5t™H!Ţă۱O~=UÉĺg-ü0 ˝|žŮđ ^RĘéěA\—Ś˘ÖđľúÂĚK6G÷ť-ömcăË°Rv3ŘË<Ě7˘Řˇ ä×dk 2…C˛ŚŘ-ľă9ó…¬ĺ­†•ô¶9ýU4Á@¨Ň|˛W 3˘-@O„î,ŻžaŁ73›ë˙éE/FŇió/ŔI0‚îŮ….©BÖ°ůő·ř –őq[$Ä@ąĹ¶óJ őŢjyL.·Ö|ţ ŃůçhŽLˇÝÎ)qÉÇ[$ wQ=Ôž®KDă4…™¸Đ"}&ź´¬g$H÷ČfÜ·ą0ŐŮ{‡(©ŐU»ă$ěVÓ9,ç~śÖĘéÎ寙Ţ|çĐÇ úúT«žűŘ•>é‘Î?%wU"D6´«·ŕ¤™ćú.§Q[«’?e 9Daˇ0š†cbŁď˛âa ^/śSßĹAG´\v|Ť2[//ýăKź—>~†í’şzŤUĎ8ĺż ™Ű@ěô;Hhž‹\ĹdVÂR¤´ŮüuLy9_Ĺç|‚cućľNŚŕ\‡|F@Oű–5ş^ ®cz’qFqŤµŽÓcéěęÇ ÷5ÎÂbt^ËDP@o’˙i|iQ_Çú®ý‰ŞPŐÍk,~¶:ŐŰ,źŇp¦ FŠĹÇ`Űş:Wż†×’é H×íÓgýĽńŹÎ˛7ŢŔ:ŐţJň•°Wđ¸3ŚYŞL-Ěł€Cţ(ĽçťU&jĸGIcxÎ9LŘŔ‹Ĺ(Ę5(’0Č(3B`…ČÂŹ/Ő>RŽ™–FĆ2‘ožľţĂňšFŮś¤Ŕ¨ÚŻ|ž‡ś"ą‘ ÖŮ3ŚÂI«Ů±‘ż먒ĽŚRŮ&Wűëí ¤U^„ĎŁůTĘďÁ¨Ó\Ô¬-őn §żÚŘĄ­®L8¶ç[?Kq:qđŮđMł^»Şw «fŽZđşń¬ŐÄľ~´€Xy[»ˇÔ8â±?7Ş*| Ťç˝ Ěç~Ç’mŮá6X…ú;Ń6E¦˛ń- .ECO•î€É±U¶źrÝ"¤ËŻ’µL>n ]ä‡Ň–sí´•š~­vć2Ď-퇮Ś*Ä^ÍT^Ż™˘~3şNÇ90fŔ noÖJ§2ŤźißXSç1ëâzoECäz`^®â&u=˝CÍrkűă¬Ţ¤‰Żâ<_˘56˝ FigeYŤD,Wőćj˘-ůs^Łqi§AEF fö{€vš´ńó8Éú9—Ďm C᥍Y©Ć˙»¨řť4fÔeÜ RŁPÎg0‚ćT#q…ď ®›…t…ôD pa.2—Ĺćö ýÔ&ŢŇâcŢžŠŕĽQT˛ŰpÎâăۨ,Ë+:} ;^‹’'(śgo‘‘ľëţ“ú–ÖŮ«G(ŤÚ«*FJłĆŰä†rJú@[Ćş o€ă€SKĘŇś0ňf’Č˙;g_‹§Ý“ĄIyąÎÍ8u5 2KDüćČT W^UĘlř $;_Lh ˘7꾦Ůâm#Öľ]=u*KN¤¤"s’¶†+¤OO˙&/bjČÇq¬Ő†ď+3 aĄ„mďFq A2˝[¬šz›á™äŢilO˘ű–šâ•“?ů¨_׸0ß1Ő)KrŇţÂĐáá60/”ÓĺĐ˝ú±ČĄ…$jZŤĺŞËd»©YΔ4ŞÇ9\ą(oŘ» 8¦Ä›Óů˙ٱ˛çm‹ş&…RěŻ`ŁŻť˝­éŃ·\đę…4jáéÚă]zt¤Ř¦«rÇ@>9`¦x˘7Jqď77@7Ýďa÷­€ç´Ş*ͤ]Ű Ĺމ˝aS î­Ń„yfĄ˘‡Ć«ÝqLŇ×w,p‘ř2öq™ÉE€ŇHŘ–ÝÂ÷‡ŤJg$'‚Vň!4ńĽBµ ¤đ-Đ!٤ߕđ\#Š2 ÷¦(Yż1˝ŢjŁő…ŕgpb˛ţ}?+ąS'rŞOĂ[%‰é—Ý7€­´^°¤É:ö&HĘÓ^ŹH¶ `8nHÓHˇĚ6C1KÄ»…/¦sĎ–K[z)!đ$HC˛·{LÉ{wŚH€390ő˙©ŁŮ4äjČ"1Ap@î3ńŹź4Pç"yAuˇÎ(,í#đÝ®÷”ĆúŠµ¨řx®°0ą+űÁyŞĽU×ű~ av |OUÇ>ŃnHŚ @Ő±-µ;ŰgdGň*Bˇ±K!Űł_Ýź`Zť™×>ŐRŃW·ěÇiLÖçcGáéK#8Ěő1hÍäLĐScFQřů&dÝůÄ-Ś>R¶ĽÄŰ`Lo‘ůĺuÄłu$EĹG‚C÷¬oŕŐ!w•ŮJÖ‹*€żËzhËt Ç'śâ3źŽAěŮ©ŔHc@_›ĹرáŻŘÎUęô`ú0úu˘ľĺQÔSŕđv'”lĽďôśčň)DĄ$uŤŻFŕj$Ŕ—dťšŔ˙]Ć7K^˘ÖÜß8¡Fß/. eŃźÖŢőĆ ř±%ŹËt3uÍiÄú}qÓ— /Y‚ĺ<÷çz;ËÔ_)ťŇđmŔčc<9ąŇŽfo¨Š˘é8* | ›]€¶©°:Óčd˘–Ć@ÚĐHÍŤWVź©Â鬢ŁÖ‡-uHc,5¬GVĘÜôřďN˙5ęyŔŤ›X•[@ÂŇz<ňůş<%ČÇK“›©ý}jčćťp+s€ĚtÁ u¸!y+‡…)°§×7 ¤ŢOD ¶^5B.`Č·Á!$轼‚ć;yŕŹ{¤yÜ•+ňˇjąŤŐ ¤Ź2‚ىe ‰¨ Ć€4Ö˛G¦_aě§szŤÍ4eŰif5]FÚů»·âHň潚>=mæ/dŔßeH˙Hţäçx? 2ţ€®+mĹ˝MőçbÁ±XŃM¦¬Ô׉űşQőJç˝&Ř"á ö,ÜÚ©ÖC$Ăć#0éŔťátŁ°ŇäńW‹ß\Îó…_˝[±°2*ţĆéĄăMÁ=1úŘ)¦ď-ÄQ3wLŘ mő˙ŐâÁ ~˝JMVUJKűÂ^á ÉŚýlďÎ/çČöKzH=–ÄÎ{±› ľQ˘ž-•ŤŤĺ’­¸PYGŰÍ^»C"zř‡käކ¦¶¦˙pë"ZPĄČ´úůŢEź dh>Áľ µC_©#8™@ŹĚă0Ą9y5hmş.˛cÁ2eŢČ iVK/á·÷¶ú¦ó•Ű“µŁŞ4űV"¨˛|4 1§ÚiO(Ň×Owł¦ĹSšë†]°ę˘˝ę“â!Ş á0Đ 3,Ďl§pBÚ™7Ż­Źě•w(DAĂí $Ť—hŘä4ŃÔşµ’«vOązđ2­Ć6:hF[şDČ:-,‚c“v"űš1/˛ŚPrMµqŇO©&¶<1GšĄ?DtI÷v?Ýőlnĺr1¦ýĽ)+·~‡V/:Ýđo鬥 âD 43tŠNŮi‰tY®2ŃđűĘó܉˘_˘–źDi U[ᓄж€Żą±4ß•©Ň` H@€kŰ€5c }ĆŽNí;(Fw3}§'Rť]ń°öŤĺö‰ĄR"} ¤)‘yzüŐ+NĘ°iĺýQ€$ˇ+ÉĎĄü%t2^ޢ\:şKŕs[ĂΑŇe]ëÂe>°ŔÂÍ<”-u'čűôĚCŁ±C]zn6›?e–Ţéôęw?z×řiěÎhâb32}+%‘1Îq&Z¦Z!8µ"€>|6ý/ĺ†[Ök5L4‘wo´Š3„ĚŃCH.ńOĺH†§:â_Ő ’nťý>1"ÄřfsđV›Éő[ćŃ Š!5E r3ŠXůćŃötţ\P&v*şTׇĚqýr}*2}Śŕdh€JlÖôó´Q>_Őžű˝ňqw·»X xÍĄü¤Sťcŕ[ ‹¸®jq·ŠRî¸ßm$łţ˛'k­şt‘¶Ĺüó…ľ{ŕŠĆ.üŠ’s¨ÖůĄĽPżŹO6Ž1xÔXá\LTzÉÍňŻżË=9âŐ‚íčŕˇuâ?• i,,ńł‡í­§žĹ…á”u˙„ôŁ©×ä{Čcg;$Ýc‰Ď52>Ţ ^#ôF—¤ ů”Ú`ř)!eŰ­#µfS” kë„ŇZÚ9ľű°¬‰¸‹ĚCž^(ŃÖďÓt]ÖÂ&bO:^Ą$ťůxĚ© dÚôkrŐ…Wb+g?ŽßvŢ*´Ü—"›•i†0+2úűÉ-_ýîö z\µvď‚ç`1hÂŕ|-DHv”IEôZ î WÍ3枆Ś`p)M´N ÝŻˇşňÁëgQöôlYżJU~ô"AéR™±ěnŕá<Ä?ç©|c­)+—^·2‹j¦KŁ™(%Š‰B/:Ż_č•~Ů`tIä0|k|+śřŰ{őÍ@">î{l˝9ĺŃžŻé…BnjýAŔ™ ' î%0ß쥂Ab‘Ăşőëĺ„«Ď˙ŰüÜ­ËXóçÍ >Ňʡ›Ýmx¶ďľ‡wdV#¬!¤}ŕ']r07ó4Ď>]dJŰ™’}ÔÍM0ßE »"1ZłŚ$ň¤śé-ţŃsYb‘DĐ×Ă]8–§®ˇW`1Çöőw–WÉ´ 3ěđ¶˛eÎGŰŞe8]hń7ݲ:"ŻĚQ‹˛·şđÇQ4’đ*b,ëv0ĹëŘA7Kć‡_˝#ĆŔhŞ°FŰaŔCÂlďž Yj?ĚhO÷ĚŤ‹ ŐĚ‘^•y~śkHľÓ7§—¸‚ŞJ-¶çjżK]ďbŁ—âP2öëVá›űz‚%B‚¸GӗءäÔą…żt’hŮů8YľĎşű×p1×íEH_+}5[–şźe\Gý•ŞŚ4MeŰfń 9:GzúYń)Ä>¸Ză”T+˙PyőenËÔ+ІĽ ^zh&ÉĆŘě;őq»'[†Ţ‚GąM郞1-ÉľoÍ&Cď~3ŔĐ µ˙ň xL]ě© ąú©Ď0!N©”ŞI©3†ž•Ŕ!”RĆW™ÜŔţ.e]„ÝÓ‹^ úč0óĚ#fµsŤQę÷§ $hÓvhTź:µ+ňŕńΚ°·Ĺ¦t§Şż+rpPůÉÎHŻ›Ü\.áÔvâż!Ý 5 HeĆi ®îvţ1k)[Ż…hŰ~ âZÝr€1áÄŔ» u8›› ‡ďΨ%xÇăţ¦ öřą~XHÁ řQ}juáO˝ @Ă.˘ŕ`P긅‚:c†;^P‹ŹĺdnbĂ–ÉŢŁsĽ1+ ŔÉ‚Ly5płaf˘›xXcl˝dKT˝ëjHUJĹĄşżwŘ ůŘř›Ň:ł*Š× ëÇŢă…~2‘xO–ŕ.ĺĺ{)~·rSűNń,,nGDëŮÓI<ŇĐ7FDĂ\AÄmů©˝\&ôňÜ4›©« ň”ӼΠ/Üľ Čđ™Ú3Anžß ,jHŞB ˇ !¦ą›`I*Ž;tÍB 1 Ýż-Nţ@´ĂłaćyˇěÉ™µťGi¦Ż˙…ĄÝűd{ĐřŁŽÓ×9*8€€ó0Ą/K›K;DfşF«sôă–K©?(ko^Ď «•0ËőŻK™k7˙”TěćăÇáXŚło„m¸ăTďZe«ł ů̇ď:‡ąńŠ ¶°` ŕQß*‰˘·Ţ¦ţ4™Đy­'E ×ô¦lšM¨îÝeYS©ťťpůÉś‹q‡/“ÓäćĎ©§’Ô&żŘ"Χ®îŞěĄĂeMűÚi*Âp¸H׫:&ÓŽ"ő—Ra1™ěô-žęđIŃôE+§Ź}ńđ/áľšÔ8`S˝˘ŤőúÚA~YÁ~,SHťJ‚PD ­6/Řóh´ŕwnN¬ľĘ9=(.mé™ůDµŚ,­ňO¦n[Ę€x'CM™čŮ«őđ)?UçřQ®ŚőšĄíŔŤĘč’fĎ?ad`câçş<ä-Ždˇl˝ŻO&ż4 f¨řiµŇÍ ż¬očFtoŤMmzVŮ…wHăJ¡ĄN$+óDI„U3Ŕ#]yęĐ>Bä9¬AÓj*D+c}&¤ Zżą‰c’k)ą[¨&kö‚´n$ńŹÔľvŚÔ-%Ž_epg—­†ýFfęş36Ş0őUłns”ŮwďG¸7€é â^ÜyžhýkŞ€=˝&Ę9)3lc2‰bvF”>Z˙CµZô!w_Ďki« ÂŚs!Ś{kKj—·ćzÇÇDZ)¶A[ ßDČv”­O u˘„T§=á‚™:÷+µYě’7*9.,*Y¸;¨ä{ŻA.ŠŚaBoŮUdPLMp‰JHüźsçëz±•GßĂhĎé)ÂĚѸ±J wCŐa¬ô÷ îŃűÍFpÔ$©ö_sĆĘÚqht&ögčř˝ťý3Hţů['zß‘’Ů…ł3wLĘţYÍŢčÝ*M· ćJo±(qôV—â8~żDäĚ5 HfŹţP‚W««" €EżO˙yg‚ ® @©Qžs4TĂla;§]ůިŘÝă矀ßăvŃôY¤‡PđE+ó÷a«ű‚ QOúŔŘ‘}j:µ OEB„^5{D:!Ç-ŇÜ ž0μ¬ŤsřŹh(üÍ:™Á’_ŐKÂÔăĐ$Ů—óÚôó[='$- ŮAř1#H|™„fŁÔ×÷wÎ0Ę•§ţ_ukfă…vëôçw Éť/×ű©™¦ň>a»é§|áâ«ČľK0§)0Gů§Mk3ĺT±ý"ćŹă€îńX/ă ŐŽ˛HÜ5$*AŔ® ^á&öwbLÄĐNI4ŐO´’¶g¶äâ’’˝µbš‘ČÄťţ›Gš‡đC¦ďż™¨T |±łxd˛űŃĹóž#ňšTŽs­˝ÎLd"1×,š*™MSpÔE‹Év†«Ź ĽĽđ‚ ­m軫ó?1Ů7ŁýÁôg)Ł^:1"¦łÖď‹UńVzY ™ł»óĂŐ„ôĚ+3Žö‹ńl·]ĚŚjJجན]0[;Çc{ "硦®˝'˝–{‘[=•n‰-îÓűÁgo=ÚÍTBFMŐů4Ô^|Ő€,ů+$źöđr†rňťB–ı(fÇpâů¸ön¤=–‡L.YĽŞźcőt[űwš‹Ůť‰” Şvň/‘<™‡Ż«‹řÁú"ß|Ś[¸´K—2A„`ęˇRÓËŔŹşŰÁôgAžydÄŰčkâD;’¤ŕ‘c'OëY›CŃ®hČ/ŻrcĎV~Í\đPălCt§Ĺ…+O_AIp@¡n]łôç‘ÎGÍžŠ=|ăö€p«Ä­7JTv<Ä(†¨TfýÜŢO¸Łfő®^8ńâµň۱ _ă†_‚R}úRj39( 0ÍŘŽ„–Z?ÂAň]HŹó—ď«`ţ&€?GĘ°¸UáĐř{0ojä‚#Ů8íŹĘ9:Ô1śî'=;÷î㸺ĽĎ?מNŤĺRáuy ŢśéŇĆŻ®PoĐp‹Ĺ,7>Ö_¸ɲ oő2¬©,,c DÝá@ňO°§.×Ć“¬)ˇ[‡k˙Ü’Z4nL Đ9ę^˘OÇGĺĂ ćPMąlŹiZŕ–g.wu…±ŮŃŃi˙řßMŻô«2µ :‹YšÄŮöý;łÂzËÓOµÁ"–˛ÎÓÓ·˙’:× L‚'K=Q/ÜY\ öF™}o­î*÷7^ű*6µăŘö…uS‹WŘ](X˝űćw§ŚĂFNî«’˙},Ť@ŻjBHŹ¬˘+ Ô¬=+˘iÎ{ř ĂËKúĎ1ÄĽěT< oxЦś˙žLŃşb{Őż$ŚĎËbH-mľčŞÉ<”!gŤpBÜđą)P—ř^m¨ç(©đ±öË=ů’ŞĽł‚Śp­1M1P.W™ŠŔ¸]Ę#ń¤M$§šÎÝžť6Źď]řbJč$E"A”¸(Ä0:Â4Öĺâţc1 CÇ^ťCtnü @ ´^đšü¶ř!˝sĂťU"8Z r(ď =Äjbî”)%űcÝáöř⢎‰}Y»6çy8 ëQ$w,’ľ”ŻE0–˝_µŐ*Őy.Ś§ŰýÓ§X]÷şě(÷U gCç «ÂťňV.Oż@j~/ăn‘°:z•<řđr˙YâŃű#űD…Ę›˘ůg$óš%ĺÔÎŁSr™{dtvž|ŘpKdŇF+bşÝH“§«)Ţr7żţ2Ë$8SĘĄb‹ŞË6Ţq¸«yµ<żśřÚđ:’± Ăş¶pUŢGégÍyŕKËi^5–LÁ Ô·IÁ¬¦d\|řž@ÍnŐ9čTáťnŻÝ°'@Ď@ T? ~'ľ4\˘2Ů&Ł9P3ôŢs#ľĄÄ„q{BbÔz€•¦˛f„Űsđ–$XŻ–_uzÍĘ\.`» Ć«§p(đxjPˇo«ÝłWđ˛ÓŮÂiWŠO·Ŕ ĺŕřőł0¤”ËUŐp€@ŕÝŞÍĘĐ˝2ekCĆ÷9Ç ç¦B"!7<ţ@M#3řhŻí[ábŃkł ŻĆú±˝¸qŇ·šî˘\¶®ü`—)nşó!Š’śţŔĽŻş»¸( })†`Ť0óŢ„÷ěc÷“ĺTŇ>ĆO;TJ^,…yĽbÔ`.Ą©C÷ÄÉpŕhÄV㇌Ŕ[îbâ5î—U'ă MTáXčsę>bBŔ?ÉŹ? ëKŮŰţřs ˇu)|±üť0ď 2äŁ>Z‘ú]Ů(!¨rvŐĘîśoUe¦]„µĚ-Éł$şÂDDĐŐ¬ZĎ×K‡IfXčş ›𵇭ĺß×oź˝Ż“­†X’˛ĹśoF·Ëpîôh¦ÂĘĎ,B8|úfKi«ÉąźÖP€,ĎÓŰG"wg÷ôłű·.S<]ňáüĂÝ´<MĚc ţúöŃ(sQ•­I4˛ÜŤ Yő0¤Ü xäşĐ.dyYk7Y7=¬úđ ‹I.–ČkCX†‡O°{U™/˙uP˙˛ÎŽ$›…9AÝ™·ívuh~„¶NŔÁ7^„ Dż•M* Śăk•;»´˛F Ą {˙p‚¸qw4,W}4¶:ń;"ě"O^1ËjÔ•ďóa€¸iŤ–›ëÜĚĽ#kýËÉD“„Vş«  yMĚŔ÷® ç«Ó7čk©ŕ =ŽgŹăé.ďQŹ `gJP{=r´Ą®JžmĄ˙Óţš]_ |®‰Ůúč0»Ź»¬V±C/ÖĆ aźźcźSEŕĚxŇő1¸?ůp{ämÝ!Ú ·ŮRŘ{ÖÇŐaoSuÝIn$ľÍw_¦Żćc»Ă[h¦ě˛VP BĂ׾âŠG4ÜC«Kj`3˛Î—ĘĘL ňúŮo82n¸÷„ÎH¸/®+ôˇÄ}~glnĽŃ=NűËMk,̨´|˝LčTőTgS˝$ŔK1Ű}ł˘ŕŕ@$Ę:-¨€™×LŁ„k×Shăé|šÉ ŮşÁŹž¦(é˘ÍZĺ_>tPJNävˇĄô´[+A– P!”ɨó‡/k’&­K Ď«DŕT)5D%«‚’ŞĹK˛‘kt=E ż8©Oúš”Îń ÇćôÇňVĺ'!FgT˘™V8JLó±+yď7ŻŇłIŇć9ňüď9cÄXírňöĽ¬Bă|O¨jöóď}Ăąă9dH *†oęo+ÉĚ~ÓÜaYĄ(Ş ČJx úö˙yŃą†Ôi„´·OsĎ1„-šŢzű~čbŢAäŃ׋Jtŕ±· ¬Š77›’5/ŁąŚn€UVNS¶‡D'ďŘ% sĚŻ·Ă“źÇ€€%<.¶›Áo[ţŠ„źŕŐ8ö"ť†ů°§)݆Ż˘h+j{ÄgĄŢÂŃ#%2Ô÷Nę9€CâCť˘Ňő&Ď„/I¬eäéó 2ŤĐ"–!C‡Ťk¶ĚˬZŹ˛d•87¨ýďl2ÉŰjŠ-ű'dčĽyś¦ŽóßčuPw6ŕ ×{=Ô)îÔěžËÎŔ®y‹Îň.Ŕ8|ż·0·ŚĚţ7“¦L`Ҳ¤QĘ0©0äÍöďRbG‡ĚÜJŃ…Ëx˛ţM™“'&>–~«Ęu)ÎÚJ'oC:ż®”gňůNĘłV4„˙âBř­•ăß÷á5I‰'ťŢe–D7\íDuŘf…1Ü‘1ź{IS%€uş|g‹0CąŔGL:¤.R@™Hőž÷WÚ(ŤÁŞő€.ÍęŚŢç{Pߡćx0ÍTb›đ¬¦-†“ż…˛éěNîÔs°+;•čČL49ݸą‹!%žpZăîŁó/b‹Ŕȡid>}/ŽĽş\Čé +ŢSÂ3ŐĂC†Ł_«ß¬^ťBë:÷’nf® ä…ťćX#7Ó!Uť!u~®$ŇKkm]Oçy}) yaÔţ­Ď,íä)ą;Ž×d±kqŹ®N–ŇĹŘÚâni>Śę˘ŔqzfŁčŮ‹‚IÍ#O«>ĺ5Îo†‡cc;(ĎÍśšŽďď\­\üőšg”/4ÔkDl^_iҵDŚQĂ_o2µBôtČ·| ˇ.ô¨Qě’ó˛{÷ý“7%‘ˇz f YK<>é<ŹyĎ*’'|‘ú ÝkF5;óI©ĐüľĽ°öć0ťż4‚MBmý$™ľ`RôjĄis–ó—ź6(żçň?ŽăĹäC€ëI”áŞ<€­&ăÄŻ…¬°Ů›ôĐ\űŹ„Ą’PhAf]q—9ăí6$L‚qŹ‡NUźŇ÷˙ťZŻâ…»Čě–†™ć`ňĎš˝ŕV€¬ÇS˝ĄćIÔ~Ö#Él=Ź¶Îđpö%•ol˘xxŤĆ"ß‹{ß(_jĆ ËńĂÔŁ\$čČé,ź\QćŰ)›´ Ůt•s'ü0_Ů~żÎsŇóA3ć–¬vťćňG"]T]$ůĂŹ©™¦}3ţÉb†ş$>Ĺ‘ŚÎE5 AaM»oţwăg†ŞŻlő´^Ââ”ŰEBÍ»Ůýáĺx¸âŤŞ7źő"Hßć[áŕŐHä´…Ű{?©RĂŚŰ˝ŠĽ @őçď’+tžaë6ěŚu1Mäµ7á’9xń+xv.Ő*î¤4 ¶Ě*Ź̆–xAMjP©Šđj±?€Dě-#zyď–-uüQ˝Ś Ś j@ĂÔ /m _exlQÁIlŹ¨Đ#ťXNV˘&ŠÄŻ8ţ?tęşlüÂ=jS^&YŔ_hđçŘ´¬Bjjx‡yşĹ@YŠ©|ĆŃŐXV4#sŠ ˇx0×nuˇĘ<1h…Wß pś}®’¸˘ěó†2Z Őż+•#ÝOQ8!˘–f;L+6”ŕÝ7ćë [@ĐTeě;~4ŕ$Qřo€‚r5}ŽE¤˘ř­X~µ&Żď™ĆőL;¤q’BWpuÇvů ƨ)np—ăś)`ÔOÓ# ’Ô Ç3ťë‹¸Ă!@ĐŐ6Ľ``ć‡{]8!Ť 0ë©*Ë©g .đŇs)?¨ÚĂ”˝ťIçL”c_Ńé‰Rż$}mßĆR‚29z•Fxçβ»ÄRÎçü±šúGVŁě·éN=¶:şyä%Ą ±_’Bܸ‰Ű?â {?N˝îqĄtFB™Őw›Y/ćZ;oȢN(ËXäÔ(zůýŞÓ˘–ŮZX‡M1ô^śłôk¨VĎ+|ť“Cżž0y˘ SyŐ0 yçđ* ÎEÍ|lÜiő<=Ú¬ĚüŤvî ¶eĐT9h+ÁŞ“H9ŞÇÔĂŃxč,­†:´ĐH9ů¦Jń–8'öIĺŁ0­j·€nL°ŠĐ<4UŹÁ5— ÚDÍiP÷Ä|ř‰‹îhF/UxRž9ç§Kó¨q‚;_-±«ř¤†K{ářÇĆ~ĄŽŁ^Ntżfâ—%Ţ ÓÇ=ÝŰüxJ)J51%€¨âľ›Y6RYî4"¸¤Şóѧ¨ĽXŞGĺók,l§˝='Wż2±ŐM1ن]Ś }°•ňeźĎG%Ď+™ąŰŃWşU¤‡^ŃDTô%ń¶č×›-Ýü|yßţŞx4éűďŠzGŠ÷Ŕ)ś‚÷˛Ĺs«UŐ%ŰŁHTSDĐĆçąÜîµnČ9F‘p= n§}gŃ3MőfqŘd–ěĂÚ̸2a°S&ďÉhőçˇvjÓ~f5˙­`Ěš¨_8ĆK÷CwŚG—.ň8—­ńkľ›pąµÂőćU)VöŃ]0>ő0>Ć+űÎwňuć2©“éUµÄ®qęďg$dź˝’ť‡Śv&zĂbŕ„¬Çvźw!˘Rţ=Íyô“4P1zT\Rç'*mýXRzâąz=@iphV_ÍŹńF'ÎôÍŽŃşkXŠKâŠĂn´-5’®RĹUĹkyŃŮ:°[ĹćžĚcĹ»‡-ť«L†ŕˇ{ţ°µaäjPlŹv°|ôqQ4#“§ŤCú·Ţ?f\Î| (Ob­3v$Ç>Cep©Ą·v ĽH•¶bjě6‰îĂ(»bÎă:÷Kq{çĺČ­9€ŔŁ±Ť<±J!qŻ÷śZˇÓ)ç$Eö¬Ô•śB&@ţGŕĽ8f R†áĄzŻ@ž¶ČĆLđš~žÜ@č¦â×}őyűţţ0K?Ą|ç†ěÓâD¦mŹWŠ`–,Ćňgđ˙ 5[Âdž&†¨ó« ôfđnc};q3´Ť(AŻÉ}ŘŃŁ„ßÓ'ÄÁqň™ujtí§l őp 뺲PÍ࿏ŐÂ:Äć§ßw€5AW‚YÍž¸ $PBĹűŮř]ĽĂp=÷J1J4ŐŁ¶'ě¬í¬Ú~ó÷ŚołY›ŔÉs=¸ŰeŹ•QC$ü¨ŐO Ćźöńö{‡;ąôÎ!Tgźr‡7ąŻí«@ťÍ 8]_ěŁvűq]~sËěQĂ0ĆŽ~“ý ÉŕŽ«Ěń¬&%Ô`Ng†Ż k™®hĐŹłYb˙˛˙^<™ĐĚvWŐꀍ«P^ă &ÎI¬§lКǽ†ňíwż™Ű˙©×Ż˘±Ĺ.fĂ(čô©8ë~‰E!Šm|a @ËXaL±ÜxbŹ”|Č!Źlu+¸i#Đ; "M.G+Ö°äO§ď5đ}Ť«ui©c-řČt¬ë,•§É.ĺGUę›c{,ą2âFCöI–d…FÝIT0L.§·+IFŇJ"Z˵ĂxË…#”c Ąhôé¸CČşň=ؤěŐjˇŰ*•Č›wÔÚ$‹s_GÓJŕr)M†& /Ć=uĹ{paůţ̧üĽę—F]čjÖôĘÁtSCR­<Šmúá[F띤|иöđ´†kĄž[ß*‹«§”­•­·ŐŇmcŻĂďKÂÍqŮ)íˇüÎ6ĐŃéŇEK8ŘŇŮzIůÇX"é ×úDź4©ôJ%(BŢ˝ąâ„Ńĺąć賞ƆLçO!Ö"rűu€řHĐo^/3Ęëa•vh!•§­¸[E“‡š#"k7é&Ę«Sk»/ôâXĽIŰ×Fđh`ë’€ąLë¬2]|VŃë=5?Pö@¶—§Ů1uá‰2gf4Ż˙„ľj|ÖiÔ3"b ¸”VIYcZćţt $B HŔx^e~ šîѢé“lĎBťĘFËúkncĂĹ ăQqk­ŕ ź±°nwźČžyýÓ÷±ŹKÎß ůVüŘĺ[Ö!€3ŢÇŘ…Ĺ´­ŕ¤-čň¤Ł‰ş}čIAéŰݧ>gÎüőĎÂ1ŚZz•îe™O]1Eő±»fô–wĐ"PXŻžbVMX*gĚS4ťlşˇęE{AćšůĘnľµC\”g€-ž ‘N Ó͢cS{+ÇŚŁ" NčđŃ*_î8öĚŚ8ă…J§řů+–áŇš4cÄwߏĆÇk6¶ÄŻ'˝Vą}\1Bبŕ T.w`”Q)ő„TűOŚ$~ĘE¨ŐQŘtół"¶ŽG¤‰×;‰ňž,ČĽaµĽŘaě)’žÓ߶bŁt\JBđ1kŻ <®‘nm@ÔgťŘ«€5ô˙q™éľ›Ł·@MBg˘- ˛¤ËîÚsGˇ$ç7uě!Öçťéžůo„oŚ8ĚĐ0I 3r'ĎT}tz®3úî^eІΉ\|i‚őŁę‹˙Ő÷RYUÎ4ΙM,” gZ':´ÎFőB˘6ě¬Ü·?§eĺr- żBçQ).Th!®ŢĽś 1ç÷DµEhŚÁ łe—ˇ". ş×«AňUq< ŇÍPhžp«ýL„ŔŘŕ[XǢF)Ţ^ ­Ytë;,/k/‰©á”ÝsşQ ˘Ć¶EX¦Uľt%^lîńw"Ąfaű»÷˙ y>U3ń ź ÝĚč̶0Ň öę2c;¦˝y«„˘0J"+•Ö=Ůč}\Ö Ę:]äŽ[“ÎŞ-Eóős:%5˘™ç­#íµł¸>"CůŞż×}hÍëÎpL¤ ŁŻT؇h=2ŤŮ÷w”E'ĽÄűî Ú=(†ú˛›¸o}‚’Ę–u°!¬Źtß‚0÷lé>ł:•gűä-Q6Źţ{.heQgä+řľŻÖ˝rZIďŮÁBT˝T˘Zn&¦[EĎNiÍbńlä×˝î˝Z…ž¨tצ[‡Éź,y^2őh¸Ő~|¬Ň6Ć®-ZČůQÍđ~é±ëbű»†pJ™ÔŚřcą d!źŹ™z}ńęý‚ŽhÉqX¬ŇÉÄ"çß|$`.ł_>r`EQ}ľR¦v%‚k­‚ő8ś+ @{ÄŁ†Ŕ»{taŔcPÔćŰ<»Fx*+IJ?˙d –ëß6Őë…}«@5›-˘)Cň~4›\Á%ĆŢ·ĺ¶m=µ§Ö>¤ţVҖα•}/Ďxî­Ł)J^sCIkĄČty7 ÂňIki­Y9Ŕ9›€?Ný rŇD"f*>#3xŁŐH|˘ źéś¦źLÄŔ`M<‹Á¶đîm´;­EU(WwË"iĺ ÉńĂ{uçöĆ€ Ěů§ˇ3Ń9Öž˘Ş˙•ş@Ź6rl6hIŃ1—¨^:kLËoŻäEě·LąčÝ‘Ďĺ¦xI:4 -d/ĐŰz‘wťF®&łaËó]d Ĺ]M¶mnĂHđ2›ú`/…Ą`Ýz~‰Nd ř€ĄđŻU›?8‚.2IěÝCe€,ř ©hëĺgˇDě3‹äđ¬I×Zöp LQŁ˘ÜÂfĐäß÷.=^d?Íęž-˛lüSWPĹąw n¶ß<•,žsň, úĺ_a¤¦ú“Í4®…˦Ł‚ąŃÇbUůôô&ŽŘőOh\C±B±ŕ—•u"kîĂjwXęĆ´źĚ×Ó¤ťĚ Ęâ{ţžř-Ż™[€´j/C}Ä®Ôck{Š8„c@×y/néľ“[Ű“ťx,Ó‡‚ĐWἾ’‡Ť|HÄ„v·QŢżCËYµń˙K|çŞ%x×gBx¬X'¶dď[ľíßh6p”Ö¸Á©Ě`ŕätDŕ[‡Ű~˝îóÎ10‡ńü’4/ĘÁçÔ䛬Šmä]Ś“ÜóĘěłÎű"[:N P Ô›îÇ?ŞceJŽĹ8’ćŐĽŮ_«¬őz·ä„ů4?žHzę™°/«Ťşń{Ë )dĎÔđѸˇ™Cv@+.6çxç˙DĹ"ĆĘDc)ÁkG{G˝ ;JµřC‡ p5Ä\Éú5”ÁŹˇ*ěXŚÎ˙ďqSl]<Ćç™PęŹ>ѡĽţâÓ OçÂlOR×wďju]r‚V©6ąosL’"O±/´/ĎŤˇx†ýW ­đ©sXŘ<3…ţĹ’V7µ€î3čĘdń_jŽrÝpG›Îý"ńÜŃi9¤KCŕ Ş _cőš j¨˝Ăń9Z?Ýgň‡珦㌝7F[UJŃ•ę^š‘:Ť7ţfl™#ätŐ€(ôÄăśŕ;Qĺg‚Sa h€kň…-ŠÖdÄbaSdë7~!hLö-ŔtDúTI 0őĂ(MÁŢß=ŇJnĽÄ?dÓnQĽ‹A˛ a|oň˝nËěF¸Ô7Ž¦˝Lyű¬*CŞń· ”TeüŚ8Sĺ ‘ejdT°2 ‘ĎF±ˇ¬0ŃPk˙#ń8{Ţn?“¨(şT_N˙ôří7±}"s¤« v”űD»KVÎýuו€Źd¶ŇŰ‘‹ő‰}zĘn?˝P3aÉ˙˙l'˘­ČřÝę\űđ%jF®M^ü¤=ˇ|DŁkÉwŕ%6{ŤÝ.íč‡Ń9ň5Ď)ŃK*>)[Áć6Éq äŰHeÉ™—‹čSÄ»[ĸŘZ“ŻÔ:ŻPŠů@đCSřĆhhˇŕÖĺDť«Z™IĎľąĚň-pśë ٢>Xč/ŕ)ö ¨č8Š§ä¨›€Ń¸_¨a†Ŕžp“ńËí2đťNĶgw·!–tŤc2±‚{&ŢoBÔ‚2–ý'ČĚJK6g=–ź¤Ä « FŻ§ávcáúIS$©7'~ČmSŤjĚ7ĚTd%ůŁůÍČ7l<Ďf;‚†&xŰSóú$Ţ:Φ—«Ô7>4PšÝG‚Q>µfńúzÔˇÍZ nyŻŹĎl ýí,c%vNĘb3{$>źâ’îţ¤aH¦ňc˝Wśî—I¤ ˛»łëJN,ńę¶uSĄ,.tţşT槲¸ČłŔ®5\ŹÚ®»ş6ke®.<> ™W‡Ňĺ)ó>$ý}çs;)q-*zSčő—4Ś ©ŢĚ‚$ fÄ_(Ęt?”Ô‰4¨KR‹üŘ—m·­€ă7M¦ś7§$8ĽŕŚű8÷T*ÖOâÜ‚Z»×Aó€Ěŕ$TŻŁČ­51ĂŔ‹1 &ŻçŹőĽA¶KÖ ô ™2ĺ"–âáŤĎŘĄŘ»|Ž~!xdZa†ô’ţ$µ™*ŞşN˛ňLbĺ@Ć;0Äť5Ę?Ľ-.•ćQ‰×:$u©Ź]Řü¨˘Tăí0r=8:@IC—şZ^ˇŠ©q§9QojçĽŰďČYzŽząŽ¬^€3R÷ńý÷cOćđ\Bďś­Ŕőîş Eţtt—LÜMĺňß‹řÓô[é¸í&ČŁúX( 3SLĂqö'‰hO˛µLŃ~·h«Ę¬®Pę’ QăČj{A¨yřuz'VŮ˙$RôÜ Đc˙¸âĆGË’Šeźęđ˘čśü~ÁEm%®áug;K{uóřuŃYťĐLŽŇĎׄƌ—m4q%“Ü:$Ěďď8Â_)áĎíÄGw°ŘÉ…rÓ']4—Č 0ž$jeÔ uś&{ADäË«z×0@ŁŻâ 8ăr˝ßŰ®¶×.U[)Ç»aŻwS|m@üĆĽ.cÜ@»¸±&Âv!zT`0jťů×3äżÄŕXp´x܇IC j«:ÔĄaÝy4‘ĺŰĎé”…°Â—ŕŻY‹ ~S–il„n¶÷ťŹáŇk±˘€ çx/÷ŁM'ăg k ¤‰ŁüŔo=f©-îş|M\rĺ~˙­ÄčmäŞŐ0âWćę{âĂ’ÝP#ŚReVÓ㡇I’%ŞŚÝH ĹŇ[˛×Ͷ´ ,„3v@­ýďY­–\†SŁ-¸†,ý:óŹ‹/Ť‘˝[ Ľoň±žnÂú=ŢëgXmg©ű łuGń˛ĐîÁţ(cĄ<wW$ő‡ÜAȆ>žăřŰ˙ÓňłËŞŁćĺ’Ůł3Ě΢_Đ|Kvô^„†Ęjťűí+úÝ%GőúÁĚ‘÷ąÉ\ýr–Dö‰í„äBĎŔµ5,…3}‚Eć=pĚĎ MÁ¦ä®öq_‹¬V 3˛×ĺSŕŤţ};M ź.ŤF%>óBG«Â fpDú!i«Ë2çőÝpţ˘ÜŐ%žZ{–]zsńoßÁŁc3Rô•âźmôčţeć#Ä&$ĺ,vĂ3ą}-»Âs‘$ ňicp–b÷÷HĹ=đŕ©ÂČşRó?űq öSSř†©cÍC6Řľßîד'$*Äz©bľµSŃ88€|¶ŠžSq6Nާw ŕK±Á”CÉOÜĄŔS’ţ»hÄ´%a˙p`“×™Ív†ŹŞ˝ú0śŹ"B@“ CË-^™bg;ń%†°yȤ­Îý ‚hűţĽ¶X?š¸hŮ<©?±é{ cKU‹'h&G`ŻH¤ţ÷»ĂŰ`?B˝^!"Es:-ăE˛Ě^łŰzRѧ(»o_Ri‡tńúŠÎ¨ř!ĹÇ‹ĎŢĆŤĄ\"Źnů#Ő× Ný ;PźśmÇú×âÖLN=ßőkź˛móP pP»·–î{âůőˇm\úîô€ş°*jLéX'=´¤ń#ľnhGűV˛sě2jÄçÂcxPĄ+"f5ů”&OŘ@îˇR3Ž)¤¦2|V8ÄŹsU_¸˝ń¸ÁČ´óéxµPGŽťócB掉Ä3“†Me ʡ¬“„Wžc˙˙¶î g¶l—´Ű›Ť¤Č˝ď*¬ĽöŰ!D€ ţw\ĆĘ«NÜĺ±ínfżs9#ÉQlčě8#´ü=‚|Ž‚ĺĹiĎŹDeµ‹űĚ\\fšŔ\Ă9.‘úŽľĹTl˝öŚą¤@·ń5D®f ÄúěGŤüNŰkÝهůř(ŢÂ.Má‚-´WýĎÇŢ|‚Ď)nď§ÝŇđ™Qý‘Í=ä¶:b ›ş7÷Ů\ě“ú¤FC¬aźÚIś3,wÍ÷2Z±¬ߊ#Lý±Ňľę°ÂBľôG â yŃđ>Oúh:ŚÍklwb÷[ńôDrş čşŽfął¸Ž*Sl!)/GO1 •i&k…~5MŢŹs'v{iŃ áwžÚ%«YNH•ŠUĎ>O†˙ĺčK´ódĄ~z_aNO€o›‘ Kă>°%rtł÷a(™ĘŐ¨F}{ đČ­pX’ü׬ŹV™ą@`űM_ŮJ•9gťUďk@ů TD^v†ú¦íeH®´i™bâTuÓ) #N޶'˙řŚ ¨c˘Ţş—Ç33Ž0đ‹ŞUŻĎĺI:‘ë;ㆶ’ÉĆA ő(*»W˙!Ťχ3ĆÓ[¬p˛6„ m›đ;Äpb»Ččd$Łxv3uŽ•um1ń˝®ô$ÂTG¸Ý“§˝śoo™>Ô±tšŠ~h©Í;‹Ź± ,Ĺ—Řj…‹+gD+ČCňđw! C\“|߯Ł(ÖřĎ˙ÝKX]{#Ŕě‹ô˛*U– {A(J,ĹWäV\X‰2®@ÖÓ˘,Ń+ďUŽe×ÂúÍȧaŐďČ!r:ÄÜZÁşľôŠ˘_}Fíł¨Ą{L”ăqf›ľĄ‡uŠ’$Í]ůŹX|?ף/~ýQD#WxůB±UŤ6ęÉ/% G Ń•&Ä•Ĺ9×gť&ĺYĂ“»śĆÓn[|¦\ß8%!ˡR˝Ăeke4AŠ|ćGty‡pN‚î˝—™ZůĂ#5Cż€KóÝť˛ČtyčôŁäéA ]qŽ·óDעżp''ç›ÉVç W‘W‹Ýă°OĎÁ2ą(HW’B8¦˘Ęŕ{l8ťÚŞS•m4yýrKCZRŠŹH#2K(ČÔ\Ë«ią‡‘°IDеüş‚RęÜ®ŞąT–ť7ż ¬z`sCKÂÔ-ůŮWjbŐKŇ–xM‹‚µČ#î îöĽGž_ţá_ŕÝ3EX°znśř€vşĐs«ˇ=ln_Ył.{‡äŔ[óĺ“OóäÖŚYÂvaĹţ|Ö4č&e¸Gž âR‘š@ŔSfĎ!3ˇ.M điĐtĐ ¦D“DGŮă˙Ś  ¸­˝ĹĘłĐč/ż77ÎŤ·%_%ů¦Ú®¬Y6)¬’Ôr_އ…´R“ţ"Ž»űädŁ>C‘‰cçî?G˝h ×°Ć‚mbż€t>Ă5[Ůvh32{'PěQR óá°éŹZw€ggX@ĽnT•E›Ž>:_xăžťž¨ÎŞĎÁ1ř0úĚ)šú`ľ)*ÓťÚ3ôŁJź¶‘kŚĚń+˛Ńˇ»˛éíu¸a»GDŕ€ Ë»÷n– čÄ„˘m‰wÎÝÔŢá¬5MŘô]}G#ťWJ+Łuŕ~$Thî %)jF‰o˛xű_@•ţ [bô:HźQ× ĆÁŢ*kIz&| E6f$°<wş(ĺ ©¶ ćÇ«ˇm™pµŐjrfßeyŮ y&Ňĺ .Ţč*ŽŞ-ů×čßťGn@Ŕşbő\Ăó'™c—aWţxńó¶ż Eĺ¤Dđf6}-ĹžW/Ű+˙ź I˝r2k Mm=9u¤č>Ţ(đT­¸Ő8VI*ľź4ďÍsşŞ*céžV’žXÚVö¶Ŕmű_ú)h¬Ń5g‹G7ěąý÷z‘Őę©JŰŘ1a’1dů—{VćA:éčŢ85„‡a`hŮqÉ@qZž÷rŇŞÉ{©ć€Ť(ż·Ç .ßds#č¨>š '‡ďZ¨¬A¦ÔLhýĺyŘ0^A2ż‰M ˙[®N'¶&?Ů p€K.04#H@ByóôżË䨚Ü4ß·.ź=`L­tr«_Ş4ÉÍN Hi ´ő´ĐM¸{#GšĆ5Ćçúüđ1¸$źnč`dÝÇČ ?ňw°Í›˝X^L\Šó6>~â±FM~ĆZ§ókYâeËłç÷6ů}pŢmĽž ÇŤßIJ´ňěwp…cěă(–9RĺóyáŐ ®´şá >ôŔRăM§Ë&ĚÍ$ ´Ö;g7ĺJů›×ť$U˝űO˘ĐtܙܼQ)›¦ą-:FłI\nŻ‡čĄE K_ąČ>‡ćÓ,2ë„/řjâSŹř+†ţę©>Bűj Ę%˙Ç—wś3Ü·2 ૉ2ĘtĚâA«Bęz®zÎ N7‰îŢšé3<5+YÍcĹ^r*oćS0H{jJä7AÂÖbŮżLü:$\J•Zŕ)‡Ëş·%Ę~SPôź[č#§8+Ű‹ßČ{§—XÂC{»˛m“fÔw˘Ů~Ż±+KŹ¸h;ĆͲ:đ”QIZ]ičř /$´*˘Űp¦-‘0·?ś!(·jE´o –Źí>‰ŮÝ˙ ś"z+»Ë‘  lçzW›:ź‚sĹ˝ĄA¬ÔoŮm˙˝}ŃĹ}›;EDzšK Ţsť>é.6L(î'ktôŠËx ’mN?rŇË°ő Í—pV48?Ó†ůU_Ľéí=˙Yý1ľłĚ •ß ¸·+ç1ďđ>±dMZ_ĐJ'ň2ŹuO·QSnw±“‚wHĺŮ·*şVĎQę¸]4]ËÔŕ]ŕPOR”uăűßÂL†Í« :`_3Ä«&nŰ fnPÍ™ś~CžÇ`Mż×¬Łrlöú_aPĚA¨ĘĺwÜćĂ&¸%ť×ăŁĎ7WŠ­Ö˝ÎXFÇíN.|ŘŤě@Ćß|}tŘf>ëŰżÉ{.ÍŞÜkŔ)~đ žň´^§úŮŽwŞ«9a.i@ŮËh…Űă:YÂŮř=Da~ĆDÔ^ †„I6Ô„W®×ĚŠy˙K)e_䡙–O2!·łíóŻiÖË‹!R‡©×µ ŚĹ #2qžä4úÄXamĚžapIŠđbϡc*§ öÂh ®üĹ´îJś–˙č“ëVD€|µ”Í$Lm]vJi.ž0ÝU>oňřuŽ›u[dn"Uč9%ú zTź[4¸Q§îú­ŕŘŠ€L§OŁĐeéÉyýr’Ô‘ŔşV)FFČm 5;ŐQŽSlL¦yj»¤µ´š—ĺ×VżÄ®đN›8z2‹@‡.čH¦{í:í˙›LjŔc;ö#r’;\/ #rÎXläÜ-ÜÝ+[FK‚i#âAűłŐ•^aAgňćÖîaőç0Ç‘‹ÎbT­%Lź V€‚Žëí_Ĺëđip“ăk˘÷XĘŚ·Č>Ą >šxŚ3á9Úš§R´~šóýuá»GÖŐ.Wó'§ę›eŇjśV‹·»‡˝Ě"üĹ=Ńă:8Ë ”ź>§±qŕWvq*z Ť<ţÍ^‘«÷T‰LČ'÷Ţęőü9ŕ†nA¦Dnů‹ô&Ň|J‚2úy&SÔ‘řŃĚtÔpî8ĺłIJmBŃ”=ŤXig>­ÄŻÉú¨EVÍnšşłĹ{éŽŇddݨ,nzsŔ®¤€?iĄ,[hU Řŕ@ńd_Ú^ÇçžÄŽ*^îŢe‡­úşôhçÉÇRŔY”ă3{ë’`á”NęoZ %Ŕ\—â /vL´WÂëŃ€őEMëz%IôÎýĆş´÷śÍ MUxWCiË ŕbĄµ$ű/ ×9„}­XőĚ`:*}ŮďĎ/Ôúăľ_/u]Ó=kÚpá>ka ő Š<’,ž+~~p2?ÄuĐI_žŁ—řó(5%óX\čZV{9–Ť(!ďyG’ëÔřzŐ·ąj`\X3ë[$[Š¶íöBĆŇëQďB^?Äk! 2ĺřLćÇwΑwL€]XYÄűôőăŘŘ l09¦G¬Ô>EřӴᲫëţBO#xµŠ­QĹSUSYŢTf”¬QÂ_ěöOe‡ÚňX¬•řŠ ­SLŇ8z—Ë”°,˛z[ZÖh<2CÍÔ|±"î™/«$‡;żF•a]H ű“p'°±•xoo…wă;PíA5bŽÔŠÉkÉnĆŃhD3!ŤÔĹ`K¦jĺ4ŞAżfNZŠý" śaF宑Í.T‡" gV¸#$%bą¶­S0Ę<ŹĹQf˘"ţM%ňş Ň°_öopßíÖRŘĹÎ:­ýîś6ą0‘ë{.T#xNźzۨ:uWcţ'Ľ»JMPäpSĐ pâWŐC†9ěVx´‘+H=Ż 0×ŘţşŞFŤŻ~\Č.Ľ;ĺůŢ#$[H­u^@bŁÚbuL»Ú2‹`@j±ŁČś!ŹŤśÔáVTbŰ°kŔ­±  ‹äH°ÁâŹ>#›÷ÇOfűć:ÔOHޡµ˝öŃeNŻ„Q˛ŃMĽ±ľăßĘČŘĎ?€>:ËŹ|et' 1‰ďP]ÄřćŃ?u‘É$ľĂç^É«5ݸęőş­$„3űUú)pJXtpŇE+ě!ż‰;ĚEÂůń;Eú€Ł› H€1ů1y§{Î> Ű>úĹ}´!:ˇÍjÁFóĽ«+ó‡›ďżµ/Gă:ÜPÉC\·Ö"Ä:tLRs‹n˛"B2ěa썂4Đ'Tž ¬´Ck(7*TÓŇ ‰ŇM đĆčąLpˇWß,Ż=ˇk†×_ěC ďyNßšŽçl&9@ѡ™ř1ĐęŤ!˘-úřHWí,Çu xDQźu$ۇ"ő¬üŘDüŃ{Q1śŐăü4"őAÔ^§‰ćĺŇĺ/’Ć)Ś*ńş'ýŢ.5…ăPĄŃ*Ą&°.žĽ›ü ­l|ßPčŻ{ŹcÝĂT(Ţîš ‘ÁsҖȦކż!ÁK¸ÖŁń¨ÂLVeâ­ŢŢÔ¦4UÜWú9đÉGsÍ™đ7Ľ‡ ˇSłbÖę´áCĺÁRű˙qýÄŠAŘ"GňQÁ.ď7ąťzr‰>ˇ^ráAś©›‹Ťż’% ŻÖÜ˙Rz ÇÄŁ*–VńVzÜ´k±:%ľqXů-Ô¨e§ť(¶x1#1Úúä™ ×ŃžőF™–~áęÝßż©B¦GZ ˙#ţŢc‚ýĽ»ôE÷–;8ěVY—ĐóŻŘ^.Ěm[sö Ę'Í&ŔjŕmĄaÜžČ$ĄpŐ0őő–©š“V‘c)„‚Ś†Vr_"Łř2ţČź]‡`ąt:ÜÂeĘ°AG˝®y)Mř9ŕšÖšX Ä `´dőKĘÓH‹«—PtóÆ<ý\!0Ť* JΔ.;AÖ…© ĄI E=/ĚL˙F‚Gś®„d ąłPŠkle¤©~iŞâMđáť âŰ9š‰Î/šŐ# -ȦAµěôď*é>)|0Ö«ÜëóŢÁJŤźŃ€ŮYë\ľëžSöřÔD˵YŔ`?Y|;׸ěY·Ü\hµC74ąiş¦®5{aâA0Ľ¬eŹDŃnŤŔ9©>•Ôá·b 4—]ÁżWŘ©đLČö„(¶v=%y1ţů˝áC R,Ü€°iúžćO÷GQÔslîń\Ő>ż,Č_Č[Nł@V–z¨żć32Ő,ÉL &®€†™ů6ł¸˘ç÷7äÓ!Űđ†ś»°Żę„Ѥ5lŐĎž·ôöęéëź0<ÄŹ‹ â’ÄňÇÚCß]Ăb x"5u,ěD6Ę@´ $ŤLy‹ěĐ4S6A0슭ę絇‰p?$,|LX7|4Ľ;±'îp1ŻK'ůZgôו´čˇ Ö'˛Ę°>źżčVGáL˝ŠoéFN ţ-mn°©”Ď ŕ†ČMhäesÂ4ź)Şëśă©7ÖSşa† ˙Ł_ ,“Čď^Ô+žND,đríđ=V˛Ń§N+Údľ8¶űiˇdŢ-3[#Ě ýĆşYu`ŕËH$pĽ(rž˙0@0UݶTË>e"_¶¸î±Jńű uEqŐđÔLÇI…K^ę›zT€ć“ěq /4ěŹ4öţÁKě — N SŔŘ(k_B4|<ľ)FĎëbmö`;ďÎĎű?[Ő»üS.bńq|H¬5ßw }“zÉźŃpóuPĎŐµh@ ;w†ŕ“$ŕŃY űËŰĚďvšŚ„`ŞH¨ÎŘŮc™8ꥫ2`úD~ę¸w‚Ó3şîŹoôĐ䚏nkNďJJŇIiăŰlăËYj1@KÖÉ\ƇđHŹč@Ăňř“vX_Sźń:î©ş[ţ)C9Ęq}é_ßËăßě$L¶BgŇ>MѬ'HKOÔŁˇjĐšňdýü™†Ž}·¸í¬xm.fý“ßš±Ôt´Ą_Ô~ĺcŤĺfGŮ•Fůď·±Řţ!¸­¤Îú®ÁUřłpř$.öp¶|ëÂéh˘·Ť[aŇ ć0ĎĐ‹żďh¶q)Š–ůđ·˝í_ĄĂ'ăKľŤłPON^ŚÄ©ŽľÝßlü3!Űď‡f¸m Ë{ť©ő.'b‰…+I9˝ áľ•)čĐŚŹwĄ%©9SVOž9‰ĺ\¨Ěgez{v]Ęg§ŘóíĄ ôäHIqb‰ž0RĘÍĘńář8ľ§‹âžq­4͢FwhCbÂúŔŃ+ĺZqł9ëBüMĺĂ ¨/w·Śý9CN»-Ý.6gŢîM¬X˙v,ŁŢC<ŽßŃŢ”Ďőč˘ćÝő]¶őŕĚwą·ôý(ÍĐFUá˛â’ÄJŻ3]YeĹqf¶jîy©ĺÖc VłU>«ë†çŞ“ ·E ˛˝|ă挙Ö7L˘%ÄľNó“Ő|3üŮśŽLŁBQ@Őĺ°áÔ[‚%̶:/F'gk ˙‡ŘéÔiĹf ýtɱzçĂK 5h|VóäĂŐ™é[8.`—e{ śÉ…Š7Juú˛ŻÁ´®XĘBz›˛¬N«ĘÝ!LŁF«\4 NĽ+vM.±Rn=úZ®”tyŹDI˙Ë~¨,äCM•oRśJ4˙´—Ř—E!ŕw~ ÷?Lj5ßfcM‹¤žę/\ä@9UĆsDUÄ4u/őäŕdZ „|y.!)3aäŇ6whËÝJtQŹ~h˝.eG˛¶ŹMt ţ$F©_ůéÔe‚™d^y5©¦!Ť iŁ î¶fâÝ >463Ś%ä>JËëîžmnČä•Íňôďü›-OZ‰ĺ?+ bA˛F6­NµżŞGd ®ÍÔh'o'®ÄÇd&{ŰĄľ/ S7ŻĎR‚@ČÄNRűę —Lji]ŮHú^Ň—ÄřŔśí]oĂUU«âx5Ĺ:WÇ·ôĹ&¸”-ź‰#–:N˙ÜĂ‚.ôŕŮš×NňůőP"9—ŤŠ­—bňQ,Î;ŕÎ **>§ľý»¨†©úc:Ëź ´Ö'{ľnżLËĆ!8)§4Ěý[ć¨g˙sŠ•čľéhbjB8]”d† °r/ ΤŽ‰"îÇUKŠ ćčaĆ­=§Ĺľdßßçí|w.˝V!´í+HżŞ°›SÚĎH6§ĚÄ`˙‰7áńJ3”odh®K1'zĄ6:č ĽŰŠ?XĺňvŤb,ßvr‰Ś8Ětő›Đ?*ÄTą¤­yŃĺ:hçM­íűo°ÇO7áN+Í×c˙ŘëŢH2˙sf‡ÔźDĐE;B±áv^C]qŚż#ąĚQÎża.ĂaU׉p1 üZçuqrÉĐ~_ĺ†1HŐĎ°‡§-!/wśoL!čîh ÝŇ‹8‰kĐMÜ~۶0ÖđRkĽXŐ­,‡:Ĺž¦«đ7 S˙+\űNwRg=ŕ–vTőţ97¦˘{őgŮôs9ʦ˙%÷%§˙÷„ű&ô-úW„ąT+ł’{Č 2HÁł€Żb+Gčfń"š­đÁYžN)ő(ľ~P`„5Ś–/-˙(âҺí…ăˇA*ň}Lű~;ŻČ¨çŢËčpS‘#cÜ-ŻśŽŢţěöŤ’eśR›KŤA-ăźŕ1­13eňŔę±Yö¸S¶Ęś)ĆŮE¨VĆP)Ó1‡ą’mćg'Ň`¸‰]T!ţ„M–Š6U­¶Ťq]ăĆJżĐ´'Fĺó…ĆYűâz FÍ#tCĄ˝"–!˘_şaŁ·_¤úŃßs#°ńˇ.±an`ü˛ŮÚÉ9­dd-ŰđYÇ)ůC,Špě¤|˝.S4 ĘΙé !jŐę‘rŻď9BKŐ-Ú=ěZčy$Úqî‡ö/ǡNÚK{ŘŮőß6‚ŔĎn(lĹ਼n*Q9ŻÎ KSźÓ!±°ťÎ:ëiÖ4ůĐ2TÁLÓó!ls—‰iÜTŤÂDDî˙ełŇfAMV,Yźů2ćÇŮěX–7^Ź(ł¶çµ‡ĚµŘĂ™OîĎîŞ;™ĘÂ}Ž$óe=M]­\€ÇŃŃĺ $®>SŽ¤×ťeš|Ť®QŁdîzwKÁ„¦€—F•}ó•Ěé«Č&ë@ě×»Őűü÷?+ň´oĹ›‡ˇ†·•‹˘|:kŇ©ž ‚GÍé%qśN,xŦ­k6m«y@ĺÖ:ě=01JĂÄ+vápLĄ°yÝDŮ{xLô«^©LhÖÍ»WĂť{hÂĚB“W)vŚ¨ÔŔN“‚®ŢéIP˛Ťúďé;A¨đ–ZiÓ˘Ť Ç*cLMíŮ–Ž}ř¤U›zjßW"ăŽů1kóľđěDUA‰ŕ÷mz#Ě÷QÇ_ýÔ^uáţŘŘż$vwébĽôŕˇqJ;Ä—›3š†Đ ö«źty-¦śč”3‹6‘«ç‰Šş% d{Ă€(ś_©|=ěŮ!é\Ŕ‘»>§<ŹĹ zk%ŞÍZřIKÔ†¸Ł‡ ĘŔ?i 7é)ň®ŐCĆL:+©tę±D‘ł_°Ť6L"‘ŕhUÂ\Ţ7o2ňUÂGMÜĽλ®*{MĐÚ3x[N-~‡*Bm]8«’4›:AłU¨ż2ÍDËţFáEĘRHţŕm6;#aŞČÇ(‰eĐâž´ őeý'vFNŘ$iĐVŘ[-¸—Frt}Éjł{Ó^z\@Ľ/“¬ot86qJśÖt˝ŰČ—ŹŇlČíÝ•¸p¦OH#KŚPóśL8żc°{¸0Ŕ{łµAÁĘůtňM.–iČ}iÉĽRü§ł–2v Żť„›éŘL=ůÍÝnZŞÝ–,ůPKFéC+A(,•ěţ5€­‡lń7?+‹¬ăîNĘś€Žęb¸M?ďĹĘŹ…^†kWü%e@4B3ŐÇZčąNČ9űżD1kěa>­.;n˘ÂˇDÄ‹˘lý{I~u;m”łT ëé (,aZ0YQµ‚Ĺ%ŤgJ °c\Ôşţż3?ĘüÂëy'wű*™ăx´®éÜ­ásŐpýşTv® ţ~™YxńhńÖ ŤOĂ Ş†ĎńÓź+ÖŚšłÂô«†Ő×·ÖˇR§©v`|Τ¶ŽĄĄĘ¸Ś°·]öH¸d'¨ílpj$"gępb;:‰˙ń ?Ů2¶ŻQÚ Ć—)˛a¦E9ĺÉů˛a©ÇRaů ‡ymřĐ‹ZďöÜ™ćmö;gY ;ó µ°Tž/®ÎEmßđ Ř:ąöT! 8˘Š˛>ĹŤŻpę`#„šňw™&Ăq´?_0 öæż'źWy]XÚýˇBßQ}8ÔĚfŠŰMęčhTWíäŞŇ!ßÜ4ˇŚ4*ŁŃ¸>,SËHo·Ěu_ôŃ)H™qľZĘôŹ?ÚŞŐń5Ś5ß›˛j_Ź•“¬"źíőŁřS.P!犸†4Ś¬ýI‘U"$‹š%HČ McgÍr«_WdŇfcÂFF?@Âx!ú: ÚČČŕţ Ú6w&×zr3|»ő»¤/˛7WŽ'ÁzQx<äqnqŤ1âŕČ%˱@ü®„N”Źüţ-Ş[$VźâÚŇTAöv'BČ­®ĚŤDřhb V -Ż­dHOIĹ ”ŞYčú'íóÍý2Ü7SĽpzşĎFŤŹŘiĚ.ŚÓRpŞö4żCâÓJ~· ŢŁłÔÚ'UŹÉ|čî:Č~ĆR±lÉĄ#]]Ż$™ŁDčdD*4$Ăuqă ř¶rŽ ˛ ú€µ+Ř›uŘ6 ůrBŔ4h' Ö˘¦9y^‚ÍIóŞ´"WX#řzřGWEčŁÖ€®|·ÔbÇ‚sd>ĎĚŠ*z¨‡Í—ÉnTÇVř)bj^{ÔvÔýđŔDŚo,/SëŐ„_ZЧëÍ­{ĐćN!bŮŃőŽXý*HQ‚ °^¶I !¶"ĚfŰúČďDÂ~˛qhĘ4FÜH DüEěj:r.¬ÁÂĆâřy]nú˙Ol˛Ř,U H’ÎĂ #a:»-Ô¸Ž°^g ˝J—ÖŞ'Âu 'ö|Žw­łtŃőüb(öŠ‚ fą¨÷C`ŇşFHN˛na-Ô4É5ĆeÓ\—%awqÉsŐKm?RŮ&ś~(ŞĎt¸ŚWĆEN†Ćě‹…×)čoAl”í6©Jěyčc›]»S}VMf'űŇŔłpf]qÓhYçş­ <íb}™o°'¨ňŰá»'?żÄ>wÖ6Epw­˙á 9ÓulĄ+xľ`V}˝ţ2ŇߨÁacÜEłQ-%?îăiŹŐ°VĄM¸‘üŮŔ)bz0—ç#ÝÉĺ…ĘUýěĎ‘Ďü@ĺ5€tÂ}ĆCöÎŮW1wo€^íaăšµ´LîF|ësµšrRUŕšţJë±<Éç`ÔŽx“čtÎj˝6’,Ć[&ąu EČ€LMhČÖW—¶ ±ČT 6 7Âz­˝ůÄ. ŐaxďÉ(hšďëú ó§K‰Żó¦J(+9¬č9¦ĺgď!źŢšĂîB!7D‹ČŠçëĽ*fřÄ@ń*Xög¸Hf©[ź.Ň{¸óťú#j’/ é3řäQkx!HMRaČâöžző ~)¶QOo:ž»-Uă-"ήĆWčŇ˝b˘Č\JX§Kq4hÓ?/·4ŮpŐě<<'6OŇ›€POl…N) řŐŮęJvćŇO‹Bd jňďDj;m@›hkUcu­Ę9H†¤v¤t¶ž¶sîGJ=/«x žm$2YĐW÷:´™d€zrC“ňo%¦«l Ď óˇÂz±c¶Ł!g4\ÔŤ >‘뻂Đ^¤ÎŮĚŹ ¦B¸ż‡±ă‘j8Ä«^ÁÔ¬0ĂăżgĎue1Ű'ž«Í}Dŕ°1¨¦šĂĹ!ÝÍf…`şs4Ü65]űW;2‡jżÍÎ é¶W21Ě[1?Ož9¦pk!Ęîí&Č"MRŰUxůz7i\ť6ýŚFn:qܲo7QsşjVńŰqd\t&‚–U±&j~jj,YüŰ7K§ŃiIÎkç/p`jé6ß+äT9ë{` }µ±ľ›„Č›¶k¦oŇîh’ÇN×˝Ťd¤"‚˝ŤyU§PúÇ Ő?‰ł%‹§¶%OÁPuŔaçKԢί˙Ş[¬2ý¦†"ďh7&¬ÂěÎ0$Ķ~ĽÜqˇúUިQ¨ô˝ć îž9hGÔ¨8`Ł¶–[5*cGnĐőâ…2ŽŞ9ÉByůÄ€,—ę|ŻI3űŞÇ>TІPöu2 žbÚkźŢ÷™Yč]B;_z‘©¶cŽ¬~3e«Ž‚áÔŰnë’Ţ;ńMHʱT/AĺŞĐ.O÷,żĘş5|Qdc¬+!37ř2 ×Üş ;٤ű$dđ*w¬éc´ëîLzřNPĐŹ>ŚĎÇ ó#9nŕÍ@¨fŰá°W1łëľń6ńIí3ŕöÖ«Ć‘ŤHr}TXĘj,Ô>ŢQ€šĂúű-\cźSd8›·Ý*ĚŔ!´­Ď1E±Şś^„yÇ5ű„ŮY=şńłĚäuüíľg€śr)3;뾸 íRu…ŘĹ˙O°Ü}ą^ u•/ZěH;#äůń4ß+ĘüŔwy}!Y:Ű‹ľ¦R^xĄČöi&28ć–ôN­1ŚŘ—‹éO,m¦kß ý‰ç™ĂpÓW%…ĘČŤUnJŠ‡b1DIŞé ÷ßĺű‹!2ekÄřjż9\ KŮţî=ÄÔ‘n#6\WńUńcý‰_%»ç*yOŻŇBaüůä5Ódt0ctŠd€g|ŕXmÖg4-¤—Ś4xcéY…ŤkÖ<±lĚ’zˇř(3 µ`4ź•‡ö đň·ÇÉż„Z9«óĚq©†ÜČ÷ÁÁŻŁÍ)×NŮÍ>ěÍ€´qfu;ý°“ÇÍaźËő¬Wh>ôĽUŰ5&/8_ˇ”©Đ^Ę”™ŤŽÂE› ¬VłĹś1RBN˙„ †ş™Č°ÎÇ0rľS1*[ÁQČk´y´(~‡/Ď}čŮ•'ŽSĺ Fš Ń&–Ý*ÂůzáÜH1 žÉ'(žXĆnßG×`5{íüůaśł¬#ĆŮöiq;[ęö!‹"žNčEkEK÷VhĆŰţ»äë#Z¦ŰHŐiřü™öÖ[áů¨1ZaŹ´AVĽŞá̧ć" Ůo:Ł¦F:ńń/Ńě?ŞOÇxYuÝ-‡Sżţđ#á*H?¶ş۱ü˘łg¦/΀nÝÇřď:ĽŞ†žˇ–]HďeŇ)ĺŻ3ч+ĚB¸?Mś*FÝ„`ä­(ý¬š±ŇHĂGQź…K–©öB —‘b'¦·ĽdŻŁŔǺݥÎ"“N‚YâŢŽ(ÄEčoÎŰ–\¬ľîpŃj“ě‘;| zâo‰ńĹÄ'‘Ä: SŻ8öŕj˙~XY®źŘď66D9¬@y.Ë€öłŚ/ÉÓ”ë}Š0Đě´÷Fyf ásOT˝qĘĐűb2°źĚ_ű#ľÓBlXlőđŁ÷Ú5T‹……'€÷Št˘Pďn§%îĎnF.&I$ßH$ţ¸öşśO¶N3|âW˘A˝öX ŚÂ ä …q§'Ł”9˝ş‰łzHÎ8ćśqÓPí6~i¦+ăˇřŠ"lŕa_Í!‰˝4ľş8Ăm\:Ňx“”áçc0žŐŮż®čň“´é©qŮň ¬/Ş{v7ęFŐđ~őÓź÷oôĹâ¦\ńaŠ -<^¦Vy™b˙·Ăá-I°ÂĹú»'lýČň<˝RňZ…›u7z˛ŰŕŰhdĆŹáH4ýŚAmvę dUůaňEJ‰ńÇYdh;űĺcîŔ>¬e2ˇ, ©ŔG·O¸ľX&˘vą=Ű†Ä Ę)[|‰śŢnÂ}âLD#mÓĹđČfüD~gŘDý@~‡úőř…'® ;š·«"IŤŞ ŠÁßZ˛łŢr9QP’ďą ;ćýrŤ/îg0žhą—M0€M 2"Š¨Ú2Ý®Ź4§‹«ąęln|ŽÓâ~ď> 9D•@TAű“8őě\ře/H¶â”jŠ1Ř9÷ÓÓV‰Éy“a1Á©Ň ŮE¸b ÝމşŃë†ŔďĚ=ťln5ĂáÇFżpD2đ7dˇ·ď‹«Žň ~­KĘíÝřNvĄ Ťbť§&M˛!ŽOŞ÷±ř¬źâŘęD˙óă5Oq6ľ—9Óö ź›¬U0 RóY÷/”|آj"OPn)y2 ćBD®:yf ›|Ţ ÄBÍ °4řüęŮuIZé‰A˝Íîź;t-ź:üŽĐ¸Ż¬‹řĘa=–­Ô˛¨ŤŐŚŤ4‡v|ßÂyDš—¶łćÝŘÁ(OgÔpF©Ŕk‰4=EtGl/ »w |“aeň‡ďî®t!ęS7ż gpżĹ«›Ó3ÓPi,E Ń·zB$8Ńm~•ě†Ó$y87ÍsŐ_ü ±îáޫ㊽ ÷7e7óŃé¶n@nľ¶Ŕ©'‰‡Ő]—ÝĂ2i\\‡ŰpN4M™ÝŮýŚ2Ş^?!8aU*p¬ńőżľ0Äž^)8yŃ}E°Š>čX1u‰WT…ÚƸđ{Ŕy»&źŔď‰S•^"“prśvů;µ“žŤ™Ů2”[¸Ą~ŇO«’Ź ucÖ+­ ŹqčÓ!˛AƤŚß“Eł<'®Míć °—űc‚µđ,¬őµf¸ŮĚ–Öa(?sżĽüů=‘%ę÷9ą¦ß{řřďűdÍlŽÎ2nŕ|`›ă\‡Il˛=˘ÔţęäÁc6Ö$±G¶i ÎE4ź3~<Šoŕ[XGZ—y'qŻš‡ ë&zÄžChč j®dĚU–Éş†ŚWBµ„|˘l ;]›k8—+ż†–ĐÔ"0Ş+m]Wř‹ T :®ĂĆŃíP´AôŹLşĎ•Ë?š§8Ů 'S "źD?Ţŕú¦z(ÝMÝÁ˙őYTˇűąˇ/Ž¦´UÂ~Ú@>h@źÂŹ–†ŐzĘT&버{>Î0®ź5}-<5×@O±h9ętk‘ÄC߶6ĚÂé!ô¤ëŹOXµŞ c5*ŕ““á·S®Ŕ·”¤»Y…ßçbÖ3D*ÝüěCĄďŕľą/(—’üSj6×t6›Ń]`J“7ÇEćŚďµ2TŽ TrJeŽTmĹĚ÷˛–6JţuĺôLłÔaşÎÉÁtď#kĎ»;ô‰“ÄWçXÎŕ[‚^•¸{on;ĺĎ_á'ąŐ[r•ź8ăWÁżŇ$ÇI}ĺZ8ߨÎÉ-[ĺĹ«Mš+vŔrÇ@ ;8Ö”¬Ĺ=«úá4 ÖRD wF"G®[Ť?™ëdv8dMZ˝ÓBA‘žNďýťzĆžŕüc®”ß`Ô|Öź¨l[6ĺܱőXÓ}Đ* ťEßę ułcš„}U]󙟫{›“ô. ?Ć9»:·ŔěŤ(äAł6& @›s*_eŢĐ´j#&[ĎóÁ+1–a9;EúYźiae5Ż¤BăŢođ5Ë×ńQ-UŐóévj﬷/EźÜ1ĎÍ^ŃizZ¶˘KłĘÁű?ęKř ÷Ä팺 HţmeŔ$ĄW€tŢ1¬ůhŃdžűˇú›ÄÎ7|88“/'S·)R1çĄ"lćś?A™JÓŠLŁráyGî`B^¨,ĂŁűw)< e=oz °;Ö;ú+\OĄ° R™¬ăż¦öÚöĘEWŮ]12ä"ç'GÎZ Im©¬¦Ü&j‰ŕ łhYOý´Jĺ´M}łY{ž¤OTÚŕNś]ďÍ[˙ąŤ^}ĂđFVdó:ű´›ń Ťn‰á¬ťRVžÉłk’…ŇŤŐ‰~´yZä<Ő'ö~Ůz)p„f<CĐ2wtáZŔyP,ős¸X{ßĘÚ?ĹúŠ”Í4-MĂD\#ďXյѪ›ŚyGâÍ#|Ů}Ë•ĎD2Ĺ_%0~ß05Öő>–ą»%ű5Ýü"BR}ř¶?‡ b×Ç`îN2|ç 'żAĆ<…^.ťó!}wd$ę—’ĺň•˘ľ»ß‚Ö=xgG)m­hŢë á—¶úŐ@1ďŇ“žfzŻuG×-í¦ŇK ŚP4ŘűXËĄo‹hF¬C’ßňΫT ¨ŹęcZyŰIÇe™7-˙PkDí‹NK¸ROsgyôDž»ŻÝÎÎdZ€—/Tl˝ńn¨"Ą1zWë[Á-zn ]mGŚąĽ°ntN"RXÄ#UËd<§'B)TćÖ2™Tűň§ŐOźé* ű±hŐĦąëń›á‹d0IĚŻ˝ŽĺËsRvďks4qj©úßXžrŘÜ5ĽfĆ5Ö¤M›&«Şąë0+ÇĂř¨zÇ|äâĂ™”. aKşÖ¬¶ťăŘüwËp,Rz…®Ag{ą§"·¸łťkÉt ä‡w5ťV´7?·!.2ţGű2°Ľý]±Ňú¬xâ ൹čŇń)­ź%0iŞćó>­ú9Ś&Í×J—Â"E»[ĹÉPZ°UD…±Ŕ+ă3†‰BŕĺA/›·•ŐĎĺP ÂşäLěÓŔE®4ź05~0bH·”sŐ&`bÇ ×io^/®÷Đč}hgp ĂÉ•40/í˙&¦@Ť bĺMšß$Aô'“rűí» ŮŚ÷´ŘkOäęÇĎž`qC-e°k^Öćߍý\ČKdŰVŕB»ź±gN"ScsNü@îç;K-:ťŢ >C§‘Úí¬*‹ô|DXRĚHřu[VaŘ L%AĘ­ş^‡WëC]Ő,ÚÄGd«µU™ŻĘ˝—Eńť’¸¬0¬@~.—ňs1oZű]˘ÝQ«BXAŹŤpă_$î´ŮcÚsA6˛°‹÷0mďsř)±Ćy%”=ÎY"`‚‰ź2p‰ś÷ë×^ŃćănH|‚`N\őâNT&‚;(‡óZžNć„ňx„Ě~-ŔĺL©ăşDř7‹´ß ďóaŘTŠ­Ŕ6d)Ç©¦c Ł+jŐĚ0Ég,ł ÷ţ ěx4Ą°QÍßPżżţsvŠÝz_~TČ|Ňu€Ł4ĚOHŤ‹>P»˝ŇS?Ńâgč-ŁŢ7ßâÝ˝ –Ö€¶rÖ`łëřÍ}ĽK{x \¸…PÍy"i…l#qg$ćď0yź›źË2O8D°Ěy»ô±Š8fw>ÇĘáĎ•ë”Ô&ţÚX–‘Ö}ťľzk­F†‰@€©,‰,×/ŔkĚd4&¬ T žÎKBe;ő™ÖÓp˘wt+ôäy©çěę•*ÎÄŤívŢ}^Ă=Η”iwaĄ­ĹÁ§ţ1µRiM< †ŠÔd˘ö”Şř` ~yŚsO/Ů(ěx8f}ýojb„„˛čMcŚ6!"Q_c.¶-"ł}×úRÄ"Ő“WĹéĹ|µZň»ikn¤Ť =Ő ÎÎTh•]«R· –é•ÉÔj[ĽD!˛čĚćKÁó×­ź§ÁxŤíćr3TąŽĄ}ň·K„ _ęńEäVŮŕůůk'čŘ.$nĺj»ššBö›ß'…~eŘdRžĘ)/nR˝QQUtş‹-’¸ňn˛šžůômĚŇfJe™öaµ¦AŤžzÚ/šĘł­lčańĘÁćŘ ŹĎ+Ąsř‹mŃhÝi-.Q8Ö±^-vŐ/C”¶řťiřĽěß< Ń'ŚĹ0‡qĄýSž˝ý”ú…Śt?žWKo o=šA茻¨â2Nµ%ĺ?tΫf†Ŕ¶ťţ*´ ćrĆE?rÝ?qáćXł2ş7Ž»ždb‰ő¶v? ţ}DEâń2JŚ—I̦ňÎV)“ßÄ꽜íu5®ßš;bé…‡ź \»Z+´Ť<¸Öz2q›]eVö‰CÍŐ`—FŮýGÜ™=Ń'ä8vŽVÎäBČÓĚł?G+aăşĘ3ňŢ›¦ŤGaóĎ‚ d="ifNÇh1xČ6}5^ôŕMU0ÝľRâ˙6^đn(ĄnÁ4j¬űrŠ¶%C(S§lÎ6ç[*}Ş`@[Y_T%2 Í…3Ă7­Ć[¸úÓ˛ęUhëK«ě5ś‚Ůpgź˘|j6ü ™˛:ĺů6Ńöú«‰¦Ł0„– ˛„ń ç8śŞ˛Ô)\<=hšTPZ€.Ę›w„!+ÁÁ‡öçµÇíBä¦*[EC ¸$,J,4[źZ$jP V-érÄĚ…ßj@pX¨}ĺíęÇđ0ţjI–ť`]SšQÖÁwT»ˇBٸ„aű"rfuúÎ …ÚCőřňŰTäpSţ*¤¦Šů6÷w"ô¸Ósń§·Ő€$™Ł°ĽĆ(xy%;BłvĄ;Čł±íę ˙¬Ő‡ç‹>‰ęqĺ‘ÎŐoę’$ râÇ°Dg,‚‡ë3FÁŻU’VČö˙š0Ď7-őş‚—5zďžYż6Ő®wA§šb Äů/ĎčÎČ!Úňűćš‹Hv=őĂ:yŘsT€ĺÓV̡őHvG)"eŚ0Č-:Ú„Ys[Ű aËšLĹ :elĆ$›@g,‡âßĂjÖqň»Ç*y2Ęśů ü†Č7â1¶¦dlĺlF@5Ík3Ě˙:vöżYű źS¬¸‡ť,%óż#đ¤I ŔďzĎ×öAáXĽV÷¶LŞPŽ‹Ń  ŚŤý6eçëÄĘę‰îs™=á,Ť>ďilńÎVŕFOqh\™Â©41őĽ‚Ůťi°^tfű–?ńë‡ăŇ“#–ŃXN?uiľ~ĆQ¬™í{Mö Ú:ÂLbßçîĹ8L6,HüŞKź‹yÂţj nqĆ‘O%Ą˛#2u…Ä?žô¤At(\{­ĐśÜÎýŞYŕşÔ}*b槖FaDŃÚZŃÁF9Üö˝MQŠţĘ…B­řqj+JŠNä'~rV“™)}Iě\·C!nśéđřAPŚ¤vÓť«›Ě¶ö0ĘĄmÜLÝű>Ú«@Ţe· &ç\Yčšüu\–#ËĚ_cđz®—J¨(vIŞ6ť3‰D€ŢSÁĹ çĂÚ´ÉU¤PžçĺˇäĎMŃ$nJÖ?¦Äxś×¨ę¬6I‹ëĘwWKÉťEŚź(Ö´ńťńŽŇŁ˘…%©żíł.ap…+DÍaĄç.rϨúŮ©źŐd=ÓVǢŤdî9z/ę™WÁę `óńđ7Ć—yW ŕ,SĂh Îbş…[ ĚT„;‹iî*E8Ö>Fg3]Ä1Ó›|n–ă›Óx˛Ë†uěF2W'¸ŽPç˛gUŘjDÁĎ˝ÚC˘t‘\¶úŃy€“Ă5¶HČň G•˘ËäĄXţ uCź%ŁXË/8Őĺ·Ř•ŢY?÷(|Ęí\}Sę¨ţČN·ń&˝n®d®ń¤]žęěh‚áçśËݨĆ5řD ‰ŚKŹ?Xfźţ¶Ď‘nQTSą¦˛ü<ŽŇÉÎCŁwP‰K ŇVĄÓěłű¶ń¸Ř÷^ßE‘{38ńťé2’M fjýş &‹”ę=’-ľzĘ»ôno‚`ĄŘŹXź=čĚ`§ű˛č/EńymĐUg|âS IüRŚŤŠY!=ÉU@ř~ŘëýRT3zéĽn­ťÔłŤj˙yJŞš/NU* ,4ÉČĎ«í•Ky ÚŃ7Ő{yýú»Ţ3ČČ])EíyÖćdÂBůĚĺŃ0@É墬 Y±FFI?ÝΗv^ř*`ěůDĄE¸¶×őO[Ž694ŢHß4ŐQZúE­{ˇv´"5'r®•Gą™\r‰Ŕkw5>”]7S<o°ŽA0&5ý ŹŤíĹ°§M•MjËx‹!p\é<© ů«Vç;~:,}śöâ€đMĽŻtJ—,×Ţü!Q’';¸Ě ghŤçá8·ń€e˘ř°Âç D#Hxýşh­ôŮ]ú• 8éĚ>J”@b Ża’Ę !oągŢ×vń¸Ě’ggŠýP U\ŞL”Ű+ÁÔ‚Ů—M’÷ćt…±g3e•ŔÓn-Ŕ\0~ࡧ»ü°±éŕ‘ôŘ|ŇžëbĽürcQŚ *íkč}Vf÷7}ś«<ďSŕůÚ¶ízfÄěOÜÓW6ŃšŮÉ™a>ÚŚ+ä‰ăřóK‹ţÚ|9űeĹ{h`™÷¨&Ňľ{ŇŇ»6C퀰âb¤ÄK´eĆm`ŹĄ·}đ÷ŘϢDK,U•GŚ‰8xř»RÉDd„;k‡>ˇsŁU;t˘éx˙ˇżKÝ„śÄ7TeösWäK5yńjĆ)}*ř< ŞÓ‘¬×ŘŔ¨“č]Ú¶U¨O…t¤®fw’˘ĎÚŠ“i ŽÇdf\ŤÁ“ŘEäĹ&Ľă6Žű‹-uHbxM•oÂ`É=UÄyÎ4Iż„7‹Z˘,r„ÂŘÖűű+ů»3a7Ůć…Ü ŽE&‚ŻĹúĄ&X&ÍĹ,¦ď-YąŚÜ…’»ř‰°BJs/lÝ»•[Ą*îř]†Q…*Ľh‡kńHMBmçţÔĐŮKô ¸×ľ°)ŚçńŞźéTŠj3R͸ź»ö¶i!ú‘vgM+uź›nwŐ©Ô…¸”ýçŽăĎv’<ä*´°ë ¨äľ¬ë+›‘}’íl/p†đ2Řŕ 6 ¨˙ť ‡3©8y8Uź+¨@›'TŽ !ľ| pâ”mĄ$Ë gćŇÖ ˙0úxפ'ŠÎŚ]š›á<Ç~ćr»xą7Aô§ É‹€Tě@€OË|ű+k—yßMm}śržµP)͡—u ˘ön‘ş ˛um5ô!1±‡!c Ň®-mÝ@›d •Ď¶Ů@<ť}č©ýM~îÉĘ@3]™ŇĺîűÜŹíĹîđ0Ëî×eZʱIe¦ýlČ[¬¶·-ŚÁ;%‡Ă‚ŚĐÝ„o$l>¨¨Đ©+µ¨™ć-ÉŃŘ2Ĺ ’Úo¸+1;Ýž†Ó˝R?LZ4ĎD¬ĎŻ•(•łc·ęëö¦Öä<(`@WPÖŢw[_#ÎŃĎĘO5”=«ýyŠÎˇ©EňCÁ±#‚ţ˛§O ‚*†>Óqeęy*<ŐcWŇţGSa’&5â±Y@© ŹŘ=•+ ôŁ[t%¤Źpß4y úŤşÂśĚ‰âc+9Yo_8—$­vĐüĽÔe7;·Ş NĐ‹”él%°ś«± µÚKřČż˙ÓĽDľnżHŘ^ĺŰĂ—eůdY•‹ö}ékqÓś;Hů÷=)Ľ‚Ň@ô‰ Ž¨†X{˘i',˛ÖŠ\ř™}hŽsŘG“@!Ă4ĚFąjÉ"ž†!zrgVá=)j˛¬mĹ0l°0j¦ĺEN|Ó…ŕšć¤ MšŹ‚ÜoyÍÖŹôxYďrWCîqš],jě»ěŃ5‘žíŐř»:–/’BM(}6q …˛&š.˘™L/ŁCfÚ‹jF*™§ćźň=Ńť;ýlúUÂŻ”ü7XĘŠ“îQ hzRü’HN”Nt˛|]ú«˛ŢÍ}¬ĂŕM?Í?Ô ÚĄC‘ xĚűd-ćóž™ÓÄFm4ăôcÚ6í‹áĂ› íIĂě%ýůQÜ‚Ů-ËDlůkßŢśáŮÓî0ŹNą ~b4ˇńĚľ!‘†‡D‚‡v°ÍhźĎ^‡8b2¸8=NXá1GłľČ[¬!Ź—˙Q¸MŹşň7NîľJ‰/vŐâhmNüb†Ę?WľRYČ«ŕ%)f4p„ŹÓčJó=HŢďŔk .vő¦Ůz˙ĹpWí;×bę,M_őÉ˝ĄźŐőřţ‰fX!ĐRĽß‚ŕ‡O~vŢ öbY“şL…­¦uPXČ˙ëXşJM|źÁą@„ KXĂ{eŰP 9Ö’]1X™·ĺŔ;Âąűžac@âͤ­!Ż´w猟ťBţÉ02lĂŞSě’ŐčSVą]Ŕ-NÜćĐ\^fÂŐŕDš’UµJ>Ąo :8(‘'˛ĘŚłŃ¸/Ľ2áßzäK˛»ŕ9Â#®7ŻQ­ßtî{†(Ú.üő]b|_çíM,íF±d‘ůq-±I{µy)LV‡† ÁĂŕöĆó.…ŃŢx±içĐ ˝BŢ´Đţ%¶:ó‘NóĽ6šebiŔtąfĆlöm›áH,¤MK-¬¤ąŰ M•éRątë`D ‡¸—f? ĎsP3ç4 ˙EoC¸T˝QĽuŹBKřĽ|›;; bŐ>Wł[ĐŻ]ˇŁá{ßYÍýf4Žš/EíťńmĹĹŮŤlˇÝ8ü?azč›=â“S,~Őú‚üDđ…4?ç4˛-Mpťčެčq’˘%ĄŢ!JNSęhͬbąt­dŃ:Ó–!Y«yŐĂśÖq_ć“°uľô±Ší Z$ŇĆϱ1€‹%Ëvűŕ9BÁp&çp‚˝_0ĂŤ 3ş)OńŮčĐî"xJ`Ó6Ƹ¨d(j¨šă{îŐeŐňh-ľA8Wč!Zů!8GťŻ¬'e”KÂŇe>ôÖ(őđ<Ů·ŕ.mi#± YKu7.]X ¶?/™@ń#MIqĎ-ŕž(Âo Ěk$ý8Vm»6vsîŘw©7Ȇk'Ň)˘ůŚ iŠ*žcL )糢•%äÇ/ß ĆÍDKJíĂBq¬Ňs^§rú›Á?‹śł‘§â‡BšŃąô)%¬CvĄQ”†šózŢ`ýk ,Ěď· †ŐÁź>/:ާťţúą7ZKl™Ő1fU`Ý–ńYÄu†;aťÜćל"|ő&3:{!÷ř »ń)‰~DAVnŔ^2d,ŁBĚş4xÜÁ`ŢÂčDü83lżţ'ËĐšÖhäÔ9c‘]NúIű¶®“b&ůÝţ«:ń5ewý—Řocş”}'M×Á_Ng<ńn@›fyrn[Ŕ[ÚűłpâqŁóŃY«!ŮŢ*čšăŔ¸ ăŕX­ťß\)hÓcÄŢÓH.{TÁvŘžč]–•ű`HÇUÔUó~2UÜ$”Ôü‹öBŹw˛ueQGŠHT!UR |/ť!ŃíbǨ´âŹŽ§]’žAüI®>ăRXŤř§ł@V\¶ŕşwc÷WÖ›]Wܦ•ČŻÍq>§řůg,hwőie]ŻgÖעĽßηYAţ¨0ŕŕ»:ĚŞsÓCäȆ5L^d—8´#«ĺŚÚâˇĂ ÷'ź™T­!l÷`·©§Đ”[ Tö®rM|6yc9o‹C'X©–¦XU˛nĘs+pś$ećżkyvąŻÂŹë”_En |›Çĺ‹ń+¸7/¦ű$Ř ś¤ť‚ăP0Á‡gú,śýr7R>fŠťzěşR˙„ĂévŁliP_cß{śi75Ž%nś§ö”!ęŮĐöB`tąy˝Î®k¸0EI`toC€ÉS¦‚ŕűňĂ’šćÎă\„|˛°´cîrŘf|ű[¦”Lč ę4Í“źLŕźç­ń8fdZĆě0ř 2¶\P•5…«5´WŽ…GŔĆičvšâ¨ňožrîüu”¤ď$?“ň5”HróxŽŠ•"‡g°Á‚łß[Í ” Ť—‹”8Q^‡kś¤˛翎óҧHP“ýŔ›Ń;Ö~]ŕ‰?NWöĂX">땤ş+ )DÍ÷`ęË`.Ouâ uŮo$Gű9ł uG8őÍ0—ĎFŘÄ®+ˇw;]Ön¤"Ć˙' ®ë8‰E4ĺšµâpśť‹g„sť±„zč•S$¨ĺ é´>Ĺͱ Ů'ôt“teK&5şíYCŢ+H·ŹŚ…Y/>’Ęă·ĚçdÚĆOŕV=í CŐZŽř(1Sbvě—J°ĺÄ Í͉$¬“`Ä y¨˝Q Fpě Ľo­,ftÉ5Â’ŮKĹ$ó‡0Čz"ŠÚŠ—yË•Ľć­löNSŤGhC'=3(;6Ëä7ÝślŔÔ˧ ŁM}ĽMąoE´>”…_Ëgâ˘ĐE(·ŤÓÎo*ęß‹ŕçvf0€śt·˙\dW yŤJřŔĆÓrľşľî+¨ “ĹÜěŔG·-ŔËšyË%ĺąă™Rđ`üLبíů5kŘ7€|đ€VS>â/Ń*O!MÉ0Z<âEśUŁéÖ.–Ě»‡łî‚c4E Ľ‰·§C•á¸Ă!đŤ’ÎÖŹ´ŤRą;5Ż-l™EŹúąZá° ś p.ë#!~兒Ԭʍ+[Äj ÍlüI îąťęY€%€DJŤ0â|ş‚o‡¦\Ýš(źňY‘ŢůS˙yd©§¸ 8KFZĺŢč˘íĆb_cü˙żë6·ł_Ô˙§p´yDcJŚK2Kň]¤’Gf=(J v×äôeT,‘Ť)'(Ź‹ęÁY\Ýń°ĆĚŻ\;jłŮ )_-¤—ě?3Ě‹C™`ˇ<ŤQo7ŻňŠç%ëÓĘOćÂWâ´$Îćlt~Tç Ő6Zß:ÄőŐnőuťÂŃa}ÁŹ,ˇ­†KĐÚß 2– ę¤ ›†ZŔ†üÜÓ˝ň3=vyŽmâű%{ÖTä—äXĚĆ®˛Â‹”±›)°lĄěŁ ś9éňßy\mŵŠ? ëv‘ú„äčOËSvâw×”aĄ +>w.tfĂB¤ »’ßŃa: 8¨*ł)hý°«ţú™˘1Ңg6Y}Ŕ¶UšžOÜϢÖ?­ˇ*TG4î˝Ő§qPbNĽĆâgÂ2o‘…µG—5Ůű·c3H‹qÜŻëę}ä!ťŞ3ü{h–®ŞZ¤đřŹ$QĆ_ŔEŐ+äH&¸é·ůČ2eSěi2kEńL{1ţJ) ŹÍŘÓfŘe<ŃÎć—‚pk7ěŚ$¶­ęe€^Ęd¤‰Šr¨7a¨Ľ»?ĽýťVşŔĹň¦+â^Pp϶,¦€©vĹ‘ńĽńÁ~¨˝®·ËNóF<řk»ĎŮĚ(b âvÄŢ2*őűĐöq®©w^kŇšMčŠ9¸qq$’&ë޵ň†ÇÎîŔ˛Éý[î×_P&-"ů5đ…Í/Ŕőŕ|ě‘6Ş3çUčeâćâŠ/^ů†N°âWčlB÷ =ĺŇü (´yÜľ€ň&FÉÜŽLŇţc·ÍďXtAűc×QË€çŘmöU‰Ž„ĎQ©Ę ]÷V]9î0ŃdtC…˘….˙L ´%{Q˝€ÚĄqëö=uKYŹćYűľ˛rŐ€´I/5đăĽEÎç "¶5×#žÜ9RnÉŻ€¨ë­O±ąôÁ°NhĘžÚű¨ŔbéßTóĂüŢË„‚IřĚP–Ůł Bă|Žg¦řč·<Úđ ç'di|S6´D{O‡¶7%j·Ö®`(~tö?Gß_|ŞÎÁ¤źŠŔk˘ôŢ ź”0sDVÍÔ«F‘·Ało™ŮĆşĄTŇĆ wög"jWŘą\¦µžnŠfý+ôÝ6.ú˝$o÷üŘĘ8BÔŞ4sEŠ8»űD˝$łĘ|ĚsYÍť´ę @śswżĺQS č’ş—EdU·ţěL“ť^Ć0ŃPľ/śőÎ&uŻŘ˘ŔhŠ= Ě f‚íákŞ@ŐS$V|ňŞź”sTŔáÁÉc9FŐ«ä÷e$ŕ5ť˝â`‰4C}Ó.‚z$ţĹiJŇĹ›—KőQü˘§r\¬ =Yll[ëÓĆ=BFt˝ş;î ĐŞÁ/Ś´€nŰI•ôGÚ¤óvQ~rY&’´tŢEť'|=‰SnŽ‰+ůśë«öŁ–ˇČyřšíŐŹ*ŞĐ‡C˛Wu=~ŘQ wĽäjďˇěnÔU8˙?WC±/AČý§ÝŻ&Â˙Ŕ/D¨OĎ]|S~ R}ßm9şRŔW9Łěç$ť¦fŻ®Üś+"¶~’rąVţtîyµ×–Ć®łb‚˛¨€q=¤dřOúMÎíĚn<ʡąy|µ˝čŔşMŇ|µÓŁYsC 4ÚšŹşâuUÍ{7ýň ďşIŕlP{b ŮëGry/EÖĄ¸Ŕř‡˙ó= ;"K9~=…-”¬Ý˝ oa–§ű¸‹ ~€X`c¨$X- "UěKĚB¨5P4ŇĘ ú á36—ŞxÁ1®h×ÔůŮĐÖ†#“Ę7ŇOďź0·˛D3‡‘:Ń_ŮÓÉl9;÷q ŮďĐŰf¦Ó^öbk{÷Ćţž pŃš‹U¸Cß÷FáOĚ×f+vZĽ©HvLž÷—y? :Í\ďóv^'ÇbÁtô>ľűőAÓńîIë!†]üěökBÁ{ żĂ6Ë粲 Îň9ÝźgG ń‘ĆîsDű¸¦l§XěnŢć`T)`›LBRabŇý¶×ă€JÎĺŐßŰŠ-}śRšüů— MĺćçiŽÇ† "š–jeN í3^Óc_›Ă»eÔ5Ţn— e äýŽR3Ś$»q˛Yą4»ŕŽfg¨÷›ĽfńdśźôxŢslČőĘ1ň wŹsŞmrČ@°+Ó5sMUŃ´U´Ąęř1Ô-OíÂŘĹN˘€ř먓ŞÝŢ<ęą–ľf– JđÍ{0ŽĚéw-’űŚŃ/¦Ş0z‡Ů/¬¤Ťó§űuÎŕ ‘úH>ČŠ±mďBYDnäĆ#ř¸ĹGłĺL4ők¸®-=¶˝ű‹ ÍÎwŤ‹Ü3>sŢŚl#תŞE¬Ĺq޵â•Ř®F _kÚâT­ârŹżŚťĹ Ą-9…‚)/—xč+ &~ żT±«A^öXxWH{Ë–wĂ=f¨ŕ,|/’°ÚjŻ˛u\Ń–ižH>@ «5rZĄ°ňůG±xB2ŃÝ©ĚWYAD €7ÎëzťŔ-©Ćv9ÔPĘT&s‹_łÜĹ4˛#ŕ+`¸tиčă4< SsĹß:÷VŃÁíŞĎ¬ä†w˛lŇlłÂI_°› Ý A’—Ů'Ýe[,ŮK/QřÚŤ€B˘ęŻ`ź@›§kĂŚ±\ŁlłŢJ]|‚~Ťë\byt°śÎČÖLÓĺć>şąŻ42–yź I$•q͸ýx„čÍÉFčźvJ`ćPW†Ś±Y˛×SYzÎ4 ®đl2 AYľ˝ty9D]Í–‰ÜOď@ř`µž„ă_^(’ňÉÜײ7ü»ŚžÂ19ü#ÓnĘW‡:ÍĆ].IŚ.éajźÄ欙&™K&Śu§é—«†‘OČ·gÔł©_0Ź!WŞÖ D÷ ĐŢ6~ ‹ň É%ś˝Fě¶qA?$ŢÓ¬ĘEJuö`IâĎ–´pjĘďŁBíŘţxKoűsT(Ń󮝟‚ý˘ę~ó c1™Ša‚ ĆŠ™•@ĚCşŠ 'ÍÂ:wý· ě^őKôĎ{áżhw›ÁôóoλŮR­)…l B$Źíř’&#ęţ'Łyij͡ŰS®ł r€j†»č_‚$Šu0´Đ-µ2 đǬ¸f™l÷˙>ď˘uíŢúTÚGđ9§ĺôa™ăµ¤řDRÔëÍ[źZŕ8:y^T÷8ó¸*˝’ăö'"ޱËű™Ąé­›x,ýđęeE9XčÁáסVŐkÚ˲ĺ0š9-u7†"Ř.‘,'źäaŞ 6"§ÓËţÍČE4¦9“¦ $ö”űm;wAMšQă%`ŮQ1†XtÔb­ĺp…ý>›ťDM 8PGĂö§Ă™ÓňĄöţMçDďşşTy¤ě9>řĎŻ¦‹XHuÎף±§[.ť SmŃ1µ$t2÷łş@˝…˘S 7|wŽ ÜĘSQD4“{ŁőJçw†TłńMĂL7űÍąJgŹ°8ňŘ2f{Đu zËŢ––8¬¬ůůÓ°F°¸ĽęŤb*ŐbcCFTžm1YÉV»`ňTRâ°*3>¸LŢúľĄCxú Wőv^”3™ ‰ŁŻťba­YS ř#YňŁ‚đ_ ’R‡÷mˇÁř$üY¨nąźíĄčˇĄqĽŢ=´C3vWłý¸&)­µM’¤T$Ž·65/a"îh–®;‚0‡ş5|KQ­¬xTÄÂŇX6µ¬dÝŠ"lŹ[°ů3´…p0ú]Łä ź^2ůDčÎ2‚<.«n«”}gµ¨ý ßR˙Ę°˙8ŞçŃŽEµźČm{¸ĐŐ/ż‹óîiüŁňŽ…r{™zť!ëbXŠĄ0mGçč˛'·^Ű\ ÷ˇ0ţDŢS)ĺŠPĆ“žěý®Í‹ŮąÓśˇd1®µ5$lâ ţŢ\@Î'îr!PxćşTÂ\)}xĎ ČăТëͨśŮwiőPEîááĘŐŐä !éUÄŃ۲–ďIľsŐIÉăQ„&€b+{ëŚ0]· "`‘jľ?ć¦FË+żjsUŤ.Ň á rť@"8ÂŔćÚ,J_ĂK18łÂ´ü磿xá‹'ţő†‘7Ńí4 Y”tا݂6m_C;ÂíXopőeˇ7‚ÓTRĆYĄÜmE©m*#ĺ !M…žĚďäăwJëźë üŚ3=éBĽn:#{ÚCF " ě33Фź ž “u~lß™{_ŔŕÁůŹ1L‡}AżsMúöE0…Rp:ž×±ř<Éć^Ńń Ű ®!±yě#$p™€®ŐÄť[ś˘śĚ©iÂFÁ÷g\ć >ŠËrů'}¬Q¤ŠOŃÔ_MQł÷x÷ĂŁâ°-ą<’®Ő7š5Oo믚YnýĚŻ-rs™}9’Ý˙‰6yEÁ Ů,)ű¬?±Ą8- ť¦ě}®%©8ü¶á¬ŕ”ßŕ–u#cŃjJ)èuň= ż <,şüVzä« üx=âŢeĐ‚@§^µn‹lx¤\ŐďR`Á[R| MŇ|-Ä#üęČ\ wß@z 1Yw€Č)¶ЉÄúÉáÝ9ČrçÄ–6ńâ°ŮĘ'mĽ÷…¨f‚zá·Žš}<Ö«ŕ”sš Ő¨"#­ł8Lxľp}ˇh"CŤxDř~mx﨩ˤ˛_Á‚Îĺ*vöG’Śé™c¬¤†>á­óoK°ˇ›>ž{n‡rł·şą»›Í+ %kŽ* Ů˝‹Tâ “?V¸Żw¸“.ĆE{>Ń Ű°&|°6„5Ţţť|q¬&ŕ&ťňč72"ő6”U‹JN;qÚł÷±‘Á!ÖŻM÷Q]pń‰‚Âł•t.śµwö~çQÄşyĂ]Şú[úŘń=„9bzĄ•[ŃÜBDCń#ěرuŞőűßrA¦?):źëşË˘E#‡ÜÓ©YŠRm˝ĄAü›ľ„źI~J)ľXz˙˘„ąUK…Ś—ôčOIöę‘ęvîě ­Ö• őęMŇm9@fpĹŐJřq'¤Çż˝müTŐßëáWîÜŠ§űĹžwsč›č•LËÖÖÍńfšIy&×ŔĂ®úŮ<˝ľßř˛÷Tđűů™“ś±Đt¸îîMÝZłhŁÄ–®ffťĐ B©®ľ1$:SQ!N^Ë·cŽ…UŕĘc.,Ť Oé*l3Ń~xżďíŹńÖţ8Ěî|)›tPbÎKíX#€ŻăaTuFâ~x@Mnîr ™‹ĺL©{ÁS^wĐ@†gËeŁCk E-Xçžȶ|Çďuë9ýçc{6Éěß[ź’Q¬Xzní3÷çnZÖĽ»ŃRą Ł?ÄěĐdÉŚĄËf îŘđffˇăąvRňęěhP!Ô*ńźIŁĂÓb wVń>ŕ4M4WŃ4‚gĺoß—L*çÉz8ż#uš›L ŁŕÚť3M©4‘Ř·ď!©ş˛MÜ©OCNÎúG›ëŮ˙kX ĺcNöěŁňcüµá7žÚŘhëŮ皢Ž}„€Š>Ťă>í s±Ęɵ’đř sue!IT6[h['ţ 8Gš>L_¤„ť±®!DZ4pSÉ—sřń©źËţŮ褡ŰŢŘócye'¸ťŰ/Îë›ď(1ăQNő5z‘ĺž—b¤ W ŘokĹץĚ(;hŐwĘůRĚ ÁŞťí8ć›ę„Ü%ů§!g˛bUëŇ÷ `7ĄÄÓĂ&č‚s7ńŁű‡ÉßĂv(Ä΢Ę%Č/č\lđ”ç=śpÓóvT–×ţé‚É`úţľ˛3+áĽTVţ­öä ĺR~:meÍNÎt 2Ęű,މÓ•oÂý!×hĆâuËĎŐč…vÁ"‰˛ľrŔßC<¤Ŕvłx6Ű9Sř óá oÓR%đűôpPŻ™R Î_3V‰ż™gŮ»n˝őá„âîĘÁ í(ęĹ_ćX$!†J,°źŠ“†/z!Ť#ôŰwÁMoÍŰJołn‰ÖşŽúM4‡iĄŔŹ$^ôŞ˝µ ˇSÔŠIŠ6ŐJ_cRn(Ţ6^¨… rFʉh]dűÜ&%Î;íăŢ/ý~Ŕvś«-ĄÔ š.Y±—Ăś5_g§_g‚d\ÚńĘžb¦jśűt ű‘da-V~ˇÜq4âű,:sdrA€~w˙ pśD%R®|ě¤+-řËëH­;€“ű¦Ď€Ç[…R„Ě>™ęňłnJeŚ>Ôé©F;ĆşS?Îg×}s|”4+ż-űʸĺżČ˙Ű żPUú+8JäNŔ.á‚XQč®ôŻFü€ů0‰€űQÔN}3ß?w![‰yŃ‹íXŞ%QCÝ´ŰvNyŘWT›˘8q:îsÎó'“°ě\_ˇüň8„:(vQÂNĽłJľá]ÚÝ™6ö˙ĺJ”%Z Íy‰H7ÝăOÍ·HÜoŮĐއłă#/"Ő :oU׺5ÍĆŸ-“ĘĚ]x)ą!»´Őńą?3 µ®áż¤ňwˇ,$YË+Ó_´żKď—ëé “»śé¬XDA@C×5”}Y0zĄ7ŮÎŹnŚáűčŮ,ôŠ`…îťąÁZŹ=™Ń`ŚĘqŹrÖ˝÷3ë•&5¶ćË„ě`YD°l<Á”†}şj«e,Lţž¨÷˝AĺĚľ:CĚ©înx± w›ŔŚFŃęü’`Ýô2îB_ÉţH$çzúmÚ—(ç:ÎCôô˝‡Q ÝKÉříţĂV•m•çźËNx¸c ń5bÖj8ç°pçďí^^{oă±’Źűú8aTńU|‚żí‚ýMÁµľ÷ŹN|–şo"?Č Ş}.{îRÉR=ü—Aš>|dóĚn—›AqÁüśëfYă‹Z›Äz »Ű»ďř.ĂAŚ[Ń ¨žmőŕvýž-qú™çÎő´EmۉîvĹ~_ ťćZ1F "+¦Śg{MÎ Ű”|Čë*63x` ÇÁëVv>ąŐĺ&[©=z¨ş.ă>¶RĘż7NíŮŹĎíŘY3(YŐM CJ[r.k„—En©)˙*ŁÖ‹’™°(.iä& 9[ŕôQźB˝ęÜĹ|9ŃiJ ­ťíĘ|`9)ľ2ĂńĽö||Ý6=őž˛ľW•‰ĽŮ‚u€]'Š%  5k‘"ŇDżŐℨ˘ńü7n%wýd`úŐ-ĂÁGďY¬Ííţ«*»+›|ósµvÄŐđŞ>JÔ' [”äđá¨ŰfůČ"JL.ŤM·eßVŹ$ĽDÎë;5;zĐôn»÷ůµ* ”đ€v©áéÖ寗µŔ3¶?^×Ţľţ X„»rŽXc¦µ¤Ťű¸“ ”Ľ[ĺĽWĄL\':tAĄ!$-ěęň4°nŘxńj^”.er!űôŔ-B ×»Ď=;÷$#nµVi>Ć“ĂVFvŤkŹÖď|+źS×6ďá`ÄZ[±S«*tU§~ˇ(`2sW‡µv’·žłęX±Y­Ókz.™DPĂł–<|˛VČwu·•Ĺ"Đ}C»jŚô[‹sŰş˝@É•QkXĂPÉŰŤ{RX”×$qظ7»y6ŘýD‰Ś&%ĹVÜfś_•hCřC'˛Çžőçä}ÖčÔ±Á¤ŹTô–¶˛Ćłlţ„Đ^ŚÁyó2>`&Ä˙5Ĺ Dŕ7ÓfÝ·U%ď‘g¤"Ĺo#=·b”Ç>ÖĎ‘8ĘY ŚŘů=öŔÎJ2đF3fRsťxßLgj¦_ŬQî źz‹ű´Ź·šÇFSsŻĆˇ…®DzVP?VĘoá)"›Źqę§o;ů±´ĺ®¶·_ë–@w çÔŻ <®Â(“eÖ1Ę› báß|ĺ; J3cłbÖäŘĽ ©qx+â€/ú{ŞőÜ.Ó÷Ą¨ĘÎC!>7;Ýo^zô^9¸W¸B„0JőrÁ—iÜĺj®«@đóGAlŻu‰ĽŠ —ß—ť2̤ܰιB 5‘ŚŮ‹LÖ]Đ RÂůń”Ή;\ěu¦1çâÄ©Ç@BĄ÷vH`áśöŤëĺz"·˙EöÚuţFšnP]˛N Ëă9÷ĺźőŕ#8$—±q{y“ř‡Döâ|úę…’Ö‘Ę!pŇ `sULt'*NĂź{‡ořôŇă[O6úçő•Plĺčw/ Í®ĺčw’µ“.ë/„؉`řŽaK7śR}ö˝ŞŰ^ł%lűęOţčđW÷Ą$j˙7Ź¶Šë»MS+d“E;Ćľ–™ÓË–§%»ÄîźáÇZ×Ó>l¶fÂ)jFT€śÄ„Cy‡¨=5۵¬|#lďʢč%)ĄÉšBŮc§/i×®M A•l¤šÔř®ýcÁƇ?eđÖI>•ît˙OÜYý\ř„8ç›ÎlÎZhmŢ®`|€——ŹZKŃ•`€U7Ě[çą&ŠO ¸Ŕ¦#|ÎIé«Î>{†‚L¸ś ¨Ţ ¶řH ÄL†¤Č±RÂÉ2˘©ŐŃVÉřçiY†żt.ĆŕUţŐ`5’?ľ<犰OŁNB"),ŃŘÉţ9GxýÚ†›¸J3©ląG>NűáJÄMČ–nęqĹ[ úÁňäĎDwśÂ†5Ëç.bMµđ9rîlŚ"ŽžűĹţ¶-…w´5@ŕ{~âýTőO"ysĂUĐ?6qÚŃj¨Ö¤–Y­â0mšwÂaAĽHó4ű#ŃÜí†×!ďŠdČň Ó-Q=ř­»ç/Kŕ\ĽR…›hkçž:€$9Ů fsôu‡X[ë˘˙t\ŕM¬W× ˘”YHÇŔLK%•Yt+‚]7ˇZEfl$.ă±%vľ]íäŢş‹Ě÷ô$ ăO_•33ćŔg¸®tËEŽö3Kžg]N!aŘîj_[eP‚rÔĘÝĘŹwš‘,»\y3~_1‚ľ#Łi~‹-X†ľŻék ˘şďú-·€–)YĘ@qX¤®®‚¤‰š›ě„"çy·5®ż,~_´âĐ _jL#Şb{CňÂ40Î"‘“†hŞý‚ aŚYEŠ—:şóéLś!éI䦝8WŞĄ…&P­ÇŁ€ŹšŮ˝ŞĘŞ$(sOŇŹť<”‡tłźU @ëv”–QB>[¶wÎB•©ëü.°>j¸ü%‰ĽÉ–·cqˇÂMLŐwfŃŐůŤş\âj±RŽ× "˙Ą>ŠősP€µ—úšŰ¤tNěI )w úĆüEEŹ6 ôk¶v%Fg@ąa…2Ú˙¤ÂsxÇľgĺwłâ2h¬Wëő“c÷8Lw=01,0&†Ä®:ť‘áżî+#.\Cęň®y> oIx’`~Žě»] arµťôz‰ß®3W˙ë„]ŃîžJZŇcµ-|ďšž’»ĺŤáëçńßŢ\)‰»Bc2ˇ·eú‘ZĎljř#ťő°ĄňÔĄůBEI¨ýwS8‡ŐUâ˝őîÝá|at~řűÜłZw&‘GgŤg(Ź_p$”§×ŰbĆ(ÓWË`®u6Ľ&€G“>•A"ö˛‰e1B5•13·>+źuü“0™Óvëúëuíĺ59Ń‹ E„űy‡ăŚălőÄ„SŔ „ťVW˙Co™‰˝. ×ńŘýĽ.ňv? úe)>ť~ţťîźÎ±-;o™0c˘ekĺ4HÄʼnݢ7K ZŃ<śdĂ|  RM p*X¶ŰßôKžHl(›'3D.ßş§v$4·YłF­s|JÉm (#čąýöńtČŤFUÜ-ŔßcŮĆĄĄ…ůÉŮHťí~ŕńÄĎ‚TTKc¦ëw ě˝6Óçv ˇ˘•^A‹™µS2usS-‹bËQCÂHîđ®K– /éBn§zV/C§• Đş±°…Ç'áßç˘Ćűî{AßŰ8“‘ 4 `ŘŐĄäŞ.¤Z~!ÚD2ěÝř0<^,fňw:p18ië>N­çcl~^±8¤ ^EíťBˇÎéqŚ™Ő8Ó2ĺţ]ý4"0Y¦kA~<—gUÖÔ„ĂjńđŚ$5ČŻg>)°:Ť PZ ° äv@čîŽ$§Ëőüę{]"IŢMÁ¸aqÓŢéP_ër¸Ă€,ČIC…2Z_Źéĺf˘ŮŸč«Ĺ}žľ;*Ő:®ń/<é2'rŃ`÷ŽNOŤĚËtűĺ(ůËÄőO^öăÂyEôIžCěMż*P#q/˘mřelFgőśĽăn8–I±ĽĎQw2ˇĹůĘ{¸ˇŘĽěE˘âĘÉłž÷0WŇĽŕ’pűî8ŕ.ţŻ‚Äé7ť0Ĺĺ0ü‚[ęć˛ÇšAp™‚YąEÖŮďťH04Îhq mŢËC(¨Ęv_'}YW~e÷“đÉŠ‡e‹_ę†Ŕ"&4żŢ©T űr¬‚z‹90ýcew­´GlÖ}gsŰ[H¶üá±5%KKţyPk‘Éý(ŔŽâav 5ő°,iW±+öf÷^#Â˙ůVz«ČÓŇŔ>*Í>°j sFMÖ«&ôlX«ŤI;ňCÖž‚ŹwuůxW÷ ^ĘQ§üJÜsý‘nR7»Ţ% Ť{~îî5-NuˇŐěH,?;_Nä!؉nřKiĹZşá‘¬÷™D{ŘhúýůĆţfľuěe×~6°•3CţW:ĎÉ×E”„ű4{ěł)~ť¸ľ#´rvt~: RqëfěíW†CłóE˙9ÉH-Ôz¬j§_é<ŇĘŰmŚçŚ.gjج$č |–¬ë°´Ąj«-cßඕč_—’u 3Ązäľ|zDÖüíI¤ş'F)lßŔILßş˛ůťW:^˛X–Óä1ćî/ëtźV´dWţ©ÝÁ ÷žG¨bĄ}…_˙íÉ+)RySiÉH"DÍâLćĆ’ĚZđߪ7R-·€Y<Ú§yl[FŁÚZË0§SřÄŚ0ý@ ťąruZËşWŢŽß4ˇJś®%R$Xk0ôÓÍű°–`‰Ă"ČŮ'˘˝Eä%X٨˝fHYžĹR (˙§ó[Yv> ą »!čVžg)9nˇ“a™–’ł`˛N2>cĽ}yšÔÝ@Ź™"×V,pgá‹ľŃŕvâ4Ř×0 1Ž>áršüVř‹ŃŽ— ¸ÚSd M Kľ†ű!‹ŢfY°ĂhôčSlŃőĹŹ}üć+«ű[äĂH(·«ú™†7 %vĄÍţi‚tžJĘ…#§6¤4±Ă•őcĆ4·xŤ#ŐŇ‹G•U%ň 8đĐ»+Ă<ßJ‰:»Lw Ńů1c2Ńz/‡ĚâŐ[ľ`ĎZC%ĐEBŢ;m"29ű“+nGEżVž˙‚ęq©®oô$5M6Ť—dđšJń2ÎOtq[o!Ű#łşýčcĺíuő-5‘fXÓŕŤ/r¦Şt‚0´»±S§°Ü±ĺ$ďŔ8Ú¤ŔůŽÓş÷¬ä™@śzĹ87‘¬ÜQŕěöüęľÓřĆ/*)żă®áĐYlćŻqšű˛J,”7m6—LeĎŻ·Žf˛h˙Dü@n.§Z›U˛…Šö.‹ńOy/•Č›îáíN‘9©ÚZ¶!ČaÝ˙_­=ľ†ľ …Ť=˙Őj$ŞËŔďAWĆv@_&<{,©‰´g0N%Ńą‚±žyRč•Ôđ'ńoY”–·6ÝUĘeűxar$;·|,"‹Ć=˘.ű™• ĚB˘<«EŔQÎ/U\rl­ôłW|Nc«¤ QxB˝Y “ ŃŻŃŞŁâ‚“úÁÔŽ§iÍ+M§ť—"R%éý h kę¦Mđč—šhĂÚľő OÔϱšĄĽoő—Řîű;UŠi‡ą@–L}Ś`ść+»®C‘8ţ„o^j&–ĺ jh3lóřě–÷żÇYÝľĄłv1:kHTâ™?$@~lËVăzĚxŞR˙S$Pi‰ďת(Â÷ŘŁ1cgŃ ×µáÜÔÄČĹcŹlŇApvŹßďRŢ×Ű0Ž¨9€}–Ë@¤CŮŁ™PĆCcČë`’XĄűŘYŇĎçeD™#\öĘ@§§ţĺfy'†nő7(<16\ńDĂ´ p«oiuHË­­ eZ…D±@Ü‹ŕfKgnb7ŘŚgé¦ű{Ž_ÁĂĚ%üuN-2ç PöÔ2F8(v<#‚€ azĐ,Oˇ>#Q9Yb%:ö9Ó8 °d˝.Üş€Łď>‚˛uÖWÁ™‡mŻ2îV[Â>ćF>ällľsä×™ W} m÷zĆ×ĎlĂ}™]sZ lDť~Ž˝ŔľÜŁô,+6ö1ş†K|băDÓą|˘[öŔŰH(!úgŤç {źűÇĺČÖ ů §ôŞyA¶ĚĐ×ć|é˙˛OOÔh]łXŞß»ďϸNČđĐ8Ëe+ĽĽg¦ –fîëč|1,çáz#®^Éţ¤(‚Mg¦’cĎŁÓ×Ĺ.5«ąĄ đ2!â€Ďůř÷^ZăŚĎC?4XXP†T_ďţŤ5÷tËOšÎ%˘˛˛d9Im>•<éSşCYGµ˛RßDc_ĂßÂüQ€ß#ľŇH…ĘpUXwT˝ Ĺ]—Đłűč €#|Hqstµ}áoĐÜ€-âöşúŔŔém4ÇżÓMÓĽnëoöľŤ{iŞi†Ö´‡Ů!Ň©Höv‰nTÖĚĹÜŞŹ «9jPÎÍů~oĺ‘Ź‘ä]@¦Ű´IÖ0©b)¬€€Ś®ą5?¨Ó |ĚQŢÎ5Ą"¬"Tř>e” A+«ďú Ň`Obu ĚTńž†Ĺ˘)>:Ť†´ŘmŻż^%ăś,ľ†šĽzb¸ëyFČĆŠZśC —‡š°]vťBxÉ-’k"{30ŤŚG1˝úÍűjŞŢ;Gi"§EoË#D­MŇÚÍ•d*6j€ÝĎuEÝ<]XFĄLÖ"jwŮ žĂ=—bę0«)‘/Q ˇ€Xđa–ŽPÁźxlBëŚÜqí“ÜO‹Ç»bj>ŞU©m » ĽdmIášç0‡›9ÇěÝń!ű‚çŤ IÁk& ˛Ű&ćç‡=T)O ¶ŕ6ŕGěGOM§‹žÁĐă~Î=µÇĐ&đ’9M9WARŢćŤÉSVu4‚ăb(“o„ŃůrÄYô"`Ż|vźż¦X¶‡Ë"čŰűDťş||…LM3˛rŠ®ţbV;=J ?őčIk{ýµ@‰At!”÷eüĽK†…uJ5ˇâ–ŠćI;”Ź;‹jŇ ąxSÓ–@ŃĽĆ·¬zčâWY*T O$΢oż±‹ŔlŤsŰKä‚ĂÍJ†T»łŁkD‘"ÂŢÍ ţ9ůň4ŽÍme5$°™>7¬ŕśÎy¬ż˙ă0) [PűĂ6†ĹżŘ@}×e<˛Ťî’éálµD EŞáĘűI®Cş8ĎŕĆŔru¨Ů0S~Ôę‚áÚż@VEQ§¶éĄčmB†łÂľ”{–b&ĽIÚâ„ńfí‚‹ăĹđĆd,»8jĚ÷ĽÓŻ;©ąűńn‡ÓďŘu„ÇďöŰ'dŠŠĚÜl±ëYťŽQĚâŘzŢۤ~sn…żYîŰÝžČ ŢQ§x Q§€e)ó;nč#ô—/Yt^™]0tAA°fń»…Ęć ÁI–D×'ŚŤíŤŤdđčPÉ@ŮNFŔđC ÁĚÔbH­sĚţŐBly-Źq_ęó:Ş7şXč©ăůäâëXźVĹýa~‚ő«§z"1ćÓm[ε?€ÖŹQÔ ĐijĆ%ÚŰ×oŽ€aj é?Îę_ś­É©ť¬¦ňZ,Lv{•A Ó·9sŹ‰ú߈ŔüË%Âů.ŽÓu×;śÇCŹĹw”—ň—ńoucŠ¦2üdŰôgNÚĘ“•ájŠ™úéń?8Ckšé„lńE#Ű`ŕE‚ÚĆM[;¶ íFĺ‚·D­NˇęxžG±7î Ö•`n‰€»?­ÓnRËç]oäÔâz:Ť€¨e¨$jVdařčńŹńĎ$—ĹĽ´˙ÂČv|ű¸%`0rrěňî™py$Ü&oGěz¬wĚ»Q¸SľšľŁę8‹A0&ÜІhť°±(öCkµW뇊¤ĺŐzÇ°—)çI,Gó™B&8v¤N%iE"5@ś1…=Ě ŽÖÜŔ´‡łPÔ ÂĚţŹ¬#QQŻšoĺ€o?QVČě jď äő}LhŁŁ›RÚ WŮlµ’§ů!Ęšśfg=ĚŹot´¦LHXSöŤ77˙řë8Ž伙p7|čÜj§€ÝüJŘ:˙D‡ű¶"Ée´ a#‹†Ą÷‡ÓçjŹ{›lµ^ăcáÝÉţ]8y%çňaˇđů+~m5Ü ™4rŹ×OüÝ´Ő‡ ś%řącŕhĚ7Kd±DÚ%–Ľďňµä¬Ü×/g °·řĚNĐßGD•w7ŞRH»(Ü•0ůÍ_jŇť…˝^Bä7×Ď+ôReD°ě´ =$[i‹ç’@»śěË–“:‰Ú)[UĂÖ83WŹ¨šÚšľą=ó Ŕ˘U™ĹĆa\<•ó±cóLÁúł,¬»÷šyë+_VštĘČ’ xF/PĄ\Z§© NUř¨™Şwş˝(O¦8‡[ăyb»:{DKş$PôęÔŞ‡xBBa9RHű0âĆ÷‚3e–.Řqf˝V/ůD·á]Ś˝ď#>śN° ő ){’˝| fO"‹(«-;`‰8aH¨M[|{Trę/Ň ŰŃqÉ'˝ď'ČI–ąć™´qĆiÁĆá;k˙˛ÖwśQ 1ňŇ°7ü+şźq¶ ‰$ÎL_E­¬˙iÉvęÄazŹ2¦÷ć7Ďű6$ ôα€?›ň_ýz06Z<ąĺő€/^Úsx{ѬĆ26¶îǙµ‹dyĚ«­ybąQ».®âřŞĘUŁHM߯,‰[‰_ďkńĹţ|Tíu í·cęöşp´,PłĚ2tµ±¸§e­ăd¦Ĺ¡mŇśÔßłú'I3Â&ŞËga4µň·I3‹ˇ$}šuĹ'tĎÚm†¤zo˛8ŰyfWľ9řHŻ¦ÉuqIzÇß­[ üšŠŽŕľbľPߥş•ź %öĺF\٨sGzoé×aZüěÍ‘üľš_|Łň2?ăúhz{yń„×ôIŤ°‚ú˝ řËĹő e+öz(Ĺ`Ţ#dÁÝĎű^Ü+Ż«ö7"Ćq \ĂŕNk·ŚÉĐ˙ä?¶ÔAőća&,Ď/2°‘˝¤ĽśŰÇR°_4´~í7˛ ?‰ÓjŚzE_Ś=~y_ŘhŮ!’íŹ,_ˇ_P3*ÜY3ő­ÂôľR}٢Uu»*?‡Có?ĺGÖ8¨Ĺýň3âxľ ŔŮ%ĹłˇíÍf¨¬ą–ę´˙Ü\^ÝAŰÔ‘ŇÉ[ ?}ĘOKŁő^ŃĘZsGçë "ĂmŁłQě'¸ GÄ?ˇYz]ä|őŹô~b)ż ą9‘©–’GɆTš%§%eí=5 Mb4_Lěs§lL¤VÖQTŞ IŮšć÷0¨Rˇ9ˇt«ńGm ÜYá Aľqt&żíp{ńkrµ†rôhąž‰´·÷6Ř®„`DđŰ…žÁ7Íb¸ŽNśjîXÓCŁb·Čhő3>Ë9A.č/QĹaNS5G™`ë´cxVuĆŠŢÓŻí몮¤="?ĂěCÂ0ŕ ă—bĂ ßc|­81µzŮŠŤ:ż¨}·î4ÚI 5~»É¦: ˛éT<4Ý‘…S0¶m;˝vî¦mYŐů[ÄěI©ŻW#8Ič#ˇ«âŘwÜÇXÔy üzwV:Žv|oq±?ů×´ú[&Ű“áqűžŻéĄ^&ĘŻú„•ůĎ|Ó-żâ%\QtôRzŢ›4Pb#8€RIŠÄůšŁhé¦îg›Ł=X;VO?<\iśb7Ő_ô’¬^Ň?ĺ+&_”ŰÇyąIśŢ°dÎ06,÷aŤ%ž8Ş^U=ÂťŕŃGĐNc[ź˝ij¬¬¬~¨®}DCqőytÉĆ’ݤ‰[|pEY“ŽM˙Ř‚ůן‹&÷{Á"¸ŢŻŃ„6±ď=ŢnŘËǧgŘH†WŽMůpşĄÝŽ7´ôC/PB ÇCitäDęĐů_3iËľŤ˙©—˛ió0g…€( ¶§Śţ­ ‚€ í§U­‰-°•'uňŇNdŔńbËśm›±t{ű]ňµH‹ö/”:G!úĂ7ĺ~|s4sł[âĹOŻ9¬0Żâ~Ëo4ţ ˙M°ő4rĂţů˝Kď ŹE)~řŇ©O¤hk|>'ťű –Ţ@¦Uh Ěu§+Ą†‡gň<Ľ˝‹©–±#łmwÖôIoˇNG!ě—¬2iŻRŁ `Bţxz+i„Ç}łžśiUm#ActÂfĄbŕDY'fÔŤô~rp"Š8÷!ĺÚ şq%h±„d”ó‡@ÓÄ|Ľ÷”ŃŢşČѦ'I2Ó¨„]§Ú>9•”R$ T˙ţy|?¨-ś×‚ˇîŠKŢÍúăáů·7渍#ţY]Z )™V˝ xvD[_¬¬ĎË!ź›+ěę M̧C4=Š?čŮ^łj˝â[?’Ң1C¬lXŢMů€ÔŹ~â,ŰŇ`Nx|ůqSŠŹš4{5Ůí4qŚ}ÓÇâľX Fö/>aşw7€""QÉďŢţ¬+¸Š¶»Đ3Ął0t) …~Z¤—ôođůoRŠ–ę­cEíŢIťÂ<čUÄ]Ś˝q—r~±Kp»ýQI„ŕj·ER¦75OˇRmNm/™ČíŇűYă˝ŰÓFZ§š‹FçrnE´`9k¨Áš„Ćf˙k*«13ré2”á±Ę´Ş•[dWâ™*üPČpÜE>j¬Ć7{é«#Ľř‚4ŹT2ÔýP±§–&ú¤+©ţ«š[(ŽŔÜľ,™űĽ ďţîÉ;ţbt ¶ÎuiĽű űRD"¤mB_µNűˇdő˝Ąôxj6ú{~xH<Ďîű>B ±ľ WÚŘâ>—~çŔw\že$‹ôtlת̴B“[â2¸Ň)ź*5sjřĆÉl‹ëô•:řĽMJ˛s˘ĄĆTśżŻˇ‘ötbEŰÝ$ő^X!Mëž){ČîxĆ…Ő IfˇŐI9ikß»oáÔz’µ[ŐÓąę9l®Č%0ĄH˝â ĄE؆NłĆ‰GrT.PÍţN¦3ůµašK O@8Y7ň›ě¶ÔŮNwY2éh˛%§Ď8˝ŻPýÄÉ«z˛Q`şü1ę#U­|€[ŔďłŰŞ ‹!ĚáŤé¨(©đŃU©ńŞáŹ©}dđ•÷&Ęů©wťgnhç\jI¦’@˙0=?Ś!ë-tť˘™ÉyŇőG9Îç?hÚ_Yn!T¬-r–ţAâ‰Ýčtc’äĆÚ¦ő$,Uú×ĹŰ`Áç?üřs ‘h'ô#s—d6Uäë/ˇů­Ďť—Ł^#Ŕ¬ÎĄBřh»ůîTŻéç`i†ÝcA‡Iá;L¦hZ*ÖŰź”?)ńx7 Xč­ËsĂąÂö»ŢÚĄ«›;¨oBI-š’©ŐÉrI^Qň°ť€§é„ôŰS^·ľ´ţ.‚Á‘€z×uôŽOČ~ >ƢVô)t”šçöµDĹU•|§*öA–yéęTÔĚĚÖś–°ěőrEăžź2M6]T»;Ě6äŮ@~m_D‘&¸¶â§A# 0v[‰ë@Đ5 ˛’ďĹ»GŮ‚ X/ăę'üYă•—(RÁŇĚHsť1ćú(zNďí°ÚäA"¸vÁŁ…ËŠć ¬'/›¬„wbKÍúşĹřrꇠříuµŹ>˛ ¤ţÂS°»•»ąkqZ_žM‚_wř4ž_ţ‚  –č‚"­÷°mB_ząt}.˙žPíBzÇWű“ÍŢ•é[ç~Ż‘Đ"Áĺ«-ńráÇ<źŔ`ŰŚťżôxWÄO ô¨,eÝćWŻÁ„ôü‹U{ópm„ŢĎ5;żĂ€‚ZO5cýćńˇáJ Ą2ďÄô^ş} µnrU ŞrŐWÎČăÍ8ŕér8®´(íĘ„w)9 oęůđ' ©\ĹĘŰ7©H»—“^=L QRťOŕĹĎí2J[őž[ŐüąĚgy0řŮźNz_ű)¦0Ő 1šHécüë<öH19UÚšNެĄ@ ‚ˇüć^nÖiÓąQT?ŚÂ »CšÇrzLźĽz/©Rşo˘_‰€Ńý :R_Đx‡wÉ»^wôŤ°nĂî!<‘6ččŻdOx|řĚöylÜ•_\°ě6´®x§çŠG޵ŻŇK„= F?ÔŻÖcv˛WbĎ9nBőö».oXFč}ô.řj-Ş /> gĆőŠ,7:Ú0S©uňL‘8ž»&ť4)§‚?Ţ?eÁÎ-!ćĘ;Žöśj^&ák;FřdŮşx7uM ¸ -}ŐÓńÉ{pM ć(NqBMĚ•Ś)l[”íBĹ{Ţ÷ ‰­ńĄ«NP×ńXj»5ůFK÷Óëíid¦M>„©ÎŁ1‚dÜm%XŘBĂ…ě‘ôÂ3´LĹĹý27Ř[ďęIt•»štă=\ćĹóęčG+¸9^ËŔä‰-#Ę)ą,Ëîç÷6mţ™]ş—ľ· «§ nŠô!ËuO_ţÓ[}!¨{q˘Ëś@•Ôĺq­`‚íšLx"Í;µ÷n+ ŇmĹ’=¸ťŹ’ë#LČ’€|lŻĐÓX!¦(4˙Áq´\(Nxů›ußmá*v đę؆c¨4§Čđö˙R4ž™2MÍQ.·ĚaÓÇ’®Ĺ)ş8·ęDČcedăf2>é!lţ×ǽúšuBi8Ť„ĄĐ …9ĐŁ9H÷ű Űm;H O2ÓéńÍJűq5ÓZ:_űŢqĎ·Y»ĐśŞĹ€}®i9ňÁŞeď®|3˙ĆŹz[–x ‘&_ q ýK—ńrî§í"÷Ś-lá0kŇ–  ´]Ę%A­,jÉfä3†E!Żd^ĎG„‘ŔĐ»ľmľžf0I´đ•[)—ŐnG˘äčWWö-1S–}áç\—¶?-ŐŤŚjç*ö„ŔҸç˙Üuuó‹)°5¤¶cb)uĄÇÍqÍ0Öy Bę<ÎłÇŔvŢŤ[7s˛LSÄ”ÁŁˇš´Hä ě!Ź¨H¸mˇq×ëôuo2cpëôô ŢKńšXJu)7OŹV Ľ!“+ôQٶ«®őTĎäŽ\A׾m }‚Ůč8)¦›‰@2ťR ůč,ćđZÂťKż¤§Ě9xá7f÷FL—´S*.ř;˛=t'‹3㡄by} zŇîţk[vH&]ż‰NiŚ8DvYŕ?ŞC7 ·Ň@ËĹ/ź“îa˙ˇę4 +OZ˙­€X/Dő¶@F¨Ľ¤Nr¦<.B ÎPŹW~y– Î*ŽŁ¨Ć\q¸úDC?lźîČ vĄC=Y‚¦9ÍgmÉEźß€jŇNPJ[ş•Čˇ[ań#ľč‘…fZwé šM·Đ"‰_Oý枤A‹ ĺ ü“÷äĹ˝ť"YŞEş}w¬ÍĹĉňeŰŰ3ťEp/eÎâŞb,Dá+µ' 0TŔ¨c9ý=öŘ =Ĺ4†°î˛ $ żîÉZĘôd±|ę2CÉ°Ź{PŞ-őŻč]ÄđŔúgĘeŠ€¶¸ö­2ş ëŘs_°7Áń`$ëŃĺśżTŻKż´ÉĎŞ©űu>NŻ #Zy)>‚ –ęí±­ŇůÉů‘;'Ëś€2}i CÎö«µI†3uÝc®xgľs÷®4t«Äb‚ą‘y iŃ#+Ř.áb3ˇĆÂdź˘>ăŁ,0‚5†YIŠ¶ ?d2ć/Ű<Čh öż ;ę0ÎŽúqĂđ[°cFµMŘďb€Ň<%´OŽĺşż„I&¸8Ť»­E±źëĚ3 V]«ă\żeą5»‘®j'ëĘ´äŘ°Îňăß“ç–Ł’ąî–µŰĺŘš.%vşbóĘeą€í+'_~ŽçE•ëś?K‘Ź>ň(“<Ę/ś!ýßź41“Ë4÷2dÝ/PPĚ˙ ň0Ą![Q°ąo ž…WşÂÉ9D«˛•O4Ćţaf¬6y0 µëͲĽżnp÷ŃážZŘćŤę.Şiś0qE¸€xBH]>”>cĂZjăŹeÍ›:}Ń; ř™đÍ •¦Wę`*±i“ů-­Pě$8i“^žAZß~Ípç>ŢEfć‹Ýź‹r{ďűźNÂŘő}ˇŚĂ›>P>ą~$ íńz™^ÉR"ţtÚys……ötÜ("ÚěËŞ5’€8ŞiWýř{‚Ć`Ł)˙#ď1÷?Ü˙˝€0Ó:÷ÄĎťĹJÚżÉóm.¬$O”°*Ä€Ô–B^¨Ś¤Úź—0îë@üÖ sň#6ź_óP%:ęD›…ĺÂE‰Ĺ—¤˛TÜ˝řgĹY:kYPţűčÔ3áoŢăÓ˘÷ÜŁyIśMi•p€üĽf–V•Ö5zăĹ,ľŹM˘DpHµŮcFřÄĺŽK‘ě¶P|I¬Ö©®Ŕ2Ne9´h%–č Ćűf>Ĺ*lSXętäG‹P¨Iëv9ĘŁ,}JCŽąů4%ű :3|u„ËÄ:“ĚçiעL‹—Öéý(ˇSŘô—ÜVŽ ҇¬w¸/ěAôŔ4ŃęMkÁá!jÖ SʇҹďXEÄA˝Ĺ¬Ť*…[ďFâD60úK q­\a|«çSUŠ_]5źťÚSŐ„_Cł[ ęÎׂˇ?µLôhÂ8ňI’˙q˛%Ľ»?Zí˙úE­±a‚pKÄśúva”‰¨zŇÔ®>Ž.řďç†_=m|qHţËčmB47ňú Ü.âś2 Ů,Ľ%txŻĽfőÜĺîŢRÚ ýńs'Gc»ôV˘âźą{@ȸ”şAŮ0Í!)~Ż­ŹŽzŠőô—śg+˝4p ™26ńÍöF0Wń‹;Ęßóv÷é6Âş1Lâ`§cůob'd§g(t‹y$N„Á`ë,J)ygJÉxLLÝ V7í žâz1[Tť‰xú¬„Ćr Ě› YcÓčk÷7`ĎsZ6.MŽÓ/ľśÖu8Ř(Ő¸é~ËfžB‰‘–WÁ ,C˙6ٲLěn˛yű×ŢH›żćÜg× H¦Bĺ?wdz·ţÇ;j$Ő›)Ę`;ęÓYs#ş†ĎóĂĺţŤ™Ţ\j-Őö±ŐŤ{÷¸Ö¸ç?[T†ŔMJŰČ4ŐRÉvńĺLGJGQ†GäbŰŰd »Ó7_° 1•]ëŠ-:·_BŔŕ:wć´ Ô\uW!¬FŕËuëçčžď®n,ytßYăĐŠĂÖŔ”ŰČm8CÔy4Gs˝vÉtÓ~‘wćĂqüx€^.˘ Ă€[ž^äÁV•qańÍ˝ŹÚmśş2Ôµ°čhÜ­XW:ŕIf}KD ýÇN‹zdśŞŰ!ăď´áŘźý–höíKÔŽ'&ă PäýrQWđl‹-Óm$nÂŕúĎOŞTNqĺRŁhśałDŘĺ•ńNbÔ3Ł†ůSTöŐjÓ¤°K8}uEÔňA(ě1@r=‚­*„ŕŘń@VâhŰpđ[‰9Ü_€`á^ţŔýwÎ÷‚öÓI9qGĚÇ6ĐĚQ I­Élš"?‘“´ăa@Ë„XAĐd0ÖTŰçˇO0ťYďÉşÓ6ŰČNĘ[X7ű_Ö{dé\.ó_ĐŠą¶l‚w·}ŃRY@ŢP”߸j=7«+]c‰U[-ÖS´ ă9#F¬LďZńř… í3šp'č7zŠŇŽ[a–ČĚ“asKę㉊˙ĺĹ›çÓg ’ AZĐą^Źź†ĺ |şćnÓĆÔ' ň@«šo >©Móéa©ZŢđ*küýtĄ.2 ĐŢŰĆJk‰^>ű;oüîkŃ`®}ÄL‘…ôvzX¶^ uKť±¶ß?Pł~Úh•%đWĚE9ÔĎ,Ü4QfΧéîÚś¸jĺ čőďäfçtxs4´71ú+2! NM~Z=¶F–čć4NlŽ{č)©Fa=ę'üĺ­ť'Ă”>ÄU]őă¨ČVwZI‘^6{É&s˝gŹ”™–â’ř©5?Ź–®l» dP#=Ě/Őąiމ©–ĺÚ˝v(Űň‚ßy¬aeDÖyŰúďĐč˙Ě'.ÁiŘb÷Ž‘– ňăžńla´ă˛ú–Ń{–żÂ±ť†AÝĺ¸7—l5#zşůÉLĹ0GlÓÚQ/>I ¨ö¶Ş óűî°ô‘”ęSerŠĐf»ÓŃ·ZŐC]ő­Ř ¸şťo†w)G"ÎĂZˇżJ~s̡Fµé\ę&řąâtěĘČ®»G·ö2Ő€Ç,$Řb>/í8Ćľ~±čĘVĂ˙.ŘŇŃ)]n\–Ö •8\”éĹ© ż¨›o5»ňFĚr۶=Żń)Ě\jjÁ%KĆ QL{°űQŘ?:×B/ B2‡»ă“ĽŻ2˛>Ws!ĚÜb”eó\hp»U±p Ő@lwîDŮN:Ő,¨ő\ŕáńMÔG‹w1®}đ®ĺCž¬ł_h¸Ľ–×sIm /ůÚ¸Y$‘)4M§3{»RůgěWŻÖßÔť~Uî¤%ź¶)ďD-kyĚ pcÚ~ŚŇşŮ¨ Żm6Ȧ)GJ„  öuZ©(żĐëܧŐp ˝ŰˇFůĄă[¶jąŁ.13ťČR-’ ›…PĂ&T˛1řŐżJ‘ő;†zŢq’ěŁÁČá¸Řbha0ý‘čĽ(ËČ_ €JE„mžŻzş1µ ýă)˘G ˛ÓŐp(ßŘ:!€•ö}˘–)ú˛Iš&vEAeľ˛Ő,B2R•'RŘăG`"żŐ6śM+ŚV/ÉQ‘ ź¶‰ú˘Z±űýhગs9{¬ét8¦_ƶČ&| F-Ž,â×`¨áĄťů=KK”@/KüAă#ŇY•p@ĆĆčŃ^(ńŕ··ŢV˝ţś¶4Ćéyí€H„~ÂÉ7™–^vn‡ Ăş G±*Ăěö˝Ć{޵7žµE§ŹÜĺŽĐ×ô· HóWt¨]Šqöf®Ě¶EÚĽ0ç>x„*˙v?SNˇťÔłrD®…¨©qóôD(t‘MYţ®íť@‘Ń3nbĆăĹ,żŚšŰśź.Ťgżý7Â6i ľ) |Éz6Şjdü^ąOÄíDpŽň“uą3ě.MyiáŁŔçiPi¶Aâ–0†45žĽ Ł‰ÎO\Ëâüé¸ŢiŃćń7t}UżżqIä~FŤŐżsH8„8燉ł ĄŠeşeűţ$á˙U0N…şAś”YŁŐčÎŃĺj© kâ‘m<٬\ű”c·Ç ¶9şµ-eŚ’śŻ ,ŇYű &"Ó-¶Z,Q_ÚŰ—Ĺ| PH4 šřćň‹ fŇĂD5,[‡|®„×0SĽ”Żt´Emw…Z¨©Üuçš•ĹŻFŕŹxß”ŔH^s„©đ8s^ćű21PK4AA®bĺZo€‡|¤€Ôź‰Ńt§E8 ŐcC‚ŢĽÁgȱř©nZŰë+„7:-ÔKp¤h€ŻŇrθţąK©UŽPž|b1ŻaMdtŽ.Ű“sĘŢť!>mLe|‡hRű’ď3ó#˛ď”㍆rŃ?”($ăLu+X•ăjô]“J«ČŰúÍëQTXËíÓ®˝FcBačá=~ß~Ž0Z×®k=n*ÖÇÄř˙!ó䕲ě=Ű2.ĐĹ}ŻÝe•I‘¬µ¬*7'ě7Đ@fí<ô­LµŕżžDđw´včS3ŮCńË}Éźů&ĘŽD¶UŃ4cŞ°ey§űý=óĎĘÁ“Řü>™đŇOҦŮXßžx…3aaőqĎťqŠ˘$1ÝATCŰŃŠ?—®Ď ĺĹૉsí–ä´c××4Ě…;¸!vq›úšžš %-WëŰÇ‹\(.4ÇĆŞbš=ČĽFH /ťJ d„2ęć݄⣿ŃG˙š†\Šy……č5qyJH)ˇ~ň^ůC#Ń4ĚŽóĹş€Ő`˛¬–ô@Ů^®KŠ–âőEc$±ŢaĄîČşg'ĘíŃvM·†ţż›0űOŇÖ`{R©Šs ꎭ QNÁŮ›\ Î'ţ8-éux™ŽŚ‘‘”ÉGiḠ֢\ŔČ»‹f)éÖŇ*V}ëx~4áK-\čV!ń9„ÚzŁ0axç6Éb‘§ ,(ôäpi —‹Ż B¶’_ęĐ#h"ź$ŃÂŢ ±łÍŞ$1 ˝ş ś˘6î“ŽĆGŹFD[PĎť«EúqG˙:zb»&˝ĄĽp¸ůC9Ć_ńެŹtĎAJ<ŮFUʨ+zżÇ2gÁbÝdEĚ r7–Ę|Ź¨ ?{đŔ—řč-«wŁ‰Í‹l>óJbôkÚüý¬OCA› ŘT'T…÷1.§˘ýš'ś%ŹAŔ•‚Ó-"IŤŽ ÍŢ‘Á—…†iŮŚ Ŕ(]Éîi9ŕ9–DĎb¬ó»ŐY>`oĚąú%6< ł6ô;̇7c­»ŕgqŚH7öĄ5Śs!đ§T·&h )6ö°Ţ¨;rBętđŤ4çMĹ©ŘĎé쾢Š+a\F®2mr¡E˘ĆÎÍ^í䆜h»Ć;:¤ägk.nĂ2ŻJW˝nRÇŽ/7˙_Ę‹ôv´×ÚŠî—Px]şéËaĂË ŕ`` ¸ŽŚB'…ÝG•9T-Ż˙>\­›ÓjĎJ±'ٍ䦼4Ó»üp% ůŇ3=śÔ¶C]ľë îőÂŚnŹ €j¦˙ŔŤĚŰ»LFl{o˝Ź±%yÇqŻ¤WHĽáý*_ęş/^ZQäđ)ëËí1 mţK&@ó ¶ĺ›óDçSů UaęÁ}Ż˛ÁÔ.ŇŚŰľˇč€-ťҞ±8‹RÔp¶zăä«FŞ‘rř¸D¬ ăĎ;:¤UzWÓŹ¨Z9ř˙—ť„góÂűĎľh¤•VÍjnżăHU‡#^-6‡D*—7 6µ¤…‰ÍV˝ČŹ„&yŇön3f-‹¸űuIČ$KAF_)ę?ć XÂţĐ ·¸Q/¨0cÔE~Ě?ťdLm1ş|ÂúG'Ť’ŽG^N\I wYĺ€éÄUŚ™[)•Aŕw×sřL &ő¦WĚNĎô f‘Ý w­RŠŇJr]I˝l·€ßŔú"gĆ<ż'Xc tŠXř’ühENI b†‰ÜŢŻ:5ÜŢĆEÔY,ČE(ÄŇ˝”~ąpč[ţDÝÚ|éÖ€űłŁf–?RşŇOi¸Ő™A˛®;ý+b2ľ—?;żz-‰L â¦BčţEÝ“ÝßP@#ü<\BjQ÷ᢲu‰™]ű0šŐ4#˘·IQăWŞ^e»mÉRĹß]NP‘É1’;ť¸»Q®˙ňkGyňűrĘÜ­Ŕ?3ňrý;VˇÜ6WĘ$7_©4‘ · Ĺ®śµW1Gfj¤Ë r,ĹĘťI0đkć ¤qň„¦RĺwćÎŻ§ łÉk™‡Âë:‚˘„L˘ô(Ĺýo›=Ą€J‡ °›ĘgPĄ$}1ťů[ŞuôŤ¬*VÂÚÇ|!Á…śËˇ'ý?Í[2Űk[ÓýČ)BeQ•ýĐ+BĆśŁ|ÓÉüqĉ«›Ď*uŠ»zSJľ†*‡™×U¦ĽÚ¶°şđ(‰ôâíQ]ÍŹĄ.e «Ţŕ7ÂŤűĆ|Ügü{훥ӕQĆůíCA׍ëfíϲžKdÝ0-&=Ý&ttč7ÉŕÓ:TŚ`j{žÇ¶[ŐŔ{+›X?ůwÍ$Q’©Ą(ů†yŇÄ‘f֦Ϫ^T˝bAď?  MůQ-1üžîn«ţç<˝ő ksĽŮ}2źG ËaF˘ŠĄ®D ĄP4\× Ţy$5ř·_aŃq7ŃSĐhj[řS@µű^c“Ôf–˝Yř~:ąĄgÁdQ}A*™ôú!ňiĆĄÓj}ĹP'Q§n-‹)©|ź2Çﳌ–‹¸*HŻČ8/ łż5»é@ ÍXuşńTňÍöhđ·éÄeŻH&1Nmł»ţGí×!Ł‡"/ľ Ćí+‹ąŕÝţq€<ąăˇxÎIYz$xV¬} őÚ$•,±zż»kŘq0~&5śĺřŔXźâwâôó'iŚ»ąŃ˝îŃϨZt:ΡşaĚ8 ßGJeé+ĹŻ›´ËŘű Ö‡›»¦€Y¬ä%2óćřĎBÖD‰v<¤ł"Ł 56÷MŐ3KůL“®Żm‹RÇśF?bnlş‰s·D]đ˙!Ľ•íŰł$J·śr=^i%ĄÚë0•Ä™<ĐçÉ`%·»őńłŮçnÁSńLZźŔo‘¬”ŽyďxŢ>“g°8A$—ŇČ…‹¨Ĺ}ł=ĐyiČ\bŁći]ĹwPjKôüÚ ˙.‘‹zeĂçc^—~‚ŻŻFX ‘;0â+G/7ÝY®ˇ‘äß'/­Ţi@›¦‚:”`žµ±¤Ő€Ç4¸kzÔ «čéĘKŹJz%Ľâ•ßfx…¨:b[xÇ&éw+"ËăgČđú@ţ ĺîÁV6˛"ę,oé¬váÍ/[ůrçoߪ#}0ťŁ&źł-­ ŠŹ öŢćĐ-ɡ–+P„QĆĚĹ&aJcßćí®Śĺ><öóÁ»íNmňÍü*2BRwJŮÉáí$qpG‘RWĺŇQGk9řŸ@i·oöŞaew§*iˇ„ÝTÖßR`@ă› ÚKăÓíkŐ·5„*d>a9ß–í§âˇi]9zď«’–´dKâí[‡LćČÉ!0ag H Qq*°ďł42RZĐńŚá¨Ät†°ř•˛ĽkŘ%ŇĄq5˙=“}ą</- $’%üRzNŹőß“çC}ĽY˙QŹş>5˛`,¶'—â_Rz)\¦G[y¤ĆŚÍ|”T觜 ˛ę82´ňŕó3Jé¦Ú]Çô­iăµ%3lKo¬ťÚëIZOĎ5Ż%Ţ/(żŹÉaÚ÷Ń»%÷=-DÓ´TM¦ŔĺE2k${°;LĂr ?‚jA>wy9°s~čufpwU+\i ‘«üMTÜď/&Ů:ŕËZXH›uí ŘSň%MP`í*ŕ˙čA5¶X´Xž(˙ô\ŕ”fě#zAľ’ŞŕNž[őPĐŽcăÇł÷hŽšźÄşH?E»=cŠEAÉg‚‘G-·cj~ťg8ˇ­yŻru90ŽB:S”ŚÁú4î'•\EL$וë/ŮŻK­;jFUcc·Önj#,Ę‹Ĺ5UŠţŽ mÝ@-©#b»|Čî÷KßeČ´J-F®˘Šđđ+zqÍ }iÉq禣đ¦”%–/jš¤ç 0 ŕŰó´ůĚŘ}ŽoI¦Ę ‹hÁK­Ěň<4¬GâÎŇŇa!żŇ} 4 óŇ Ęč”aÔD¬%*ńOż‰ÚÓSÄŔ—Ćđ2RzS,Ý•M ŞG§×lŔZ¨E?Ái– ­2+…ú,*tË»i‡ oíFsđrť«ű“˛ÍéîlŁëoÇ‘F1Lŕ©®?ŞŃťşý-¤ ĺf-Jě ‹7DăܢdםČră·-.$ĺKş–6|>d-ČC–„i;čmSźkăŞčÍ˝śTq§5"ÖB4ÄF;q=„Ó€ËÝA&1’%& ŚNg"ŻÂspvAľR:ĆW[věÚE› HgŠń‹R’ś_)3Ąó*¦rgE#V§Ź1 ŻqÎ!(° €€k“Ä?•Y¶Ĺ“)vč<9čüý×đ@¤<`ŐľmĺÎČö1ĆÎAü†G>xjY ´* Üúçę?-ÂĹƶĺă®s+hNýâ2Ő ©A´–„«–“‰ĺűi ˝/>P‚„Go*Lę‘ßĐ3ˇŠ9â÷űě3倇¶5QŁŽÁA!wóL>ĂĎ€< ô»™đS!ś5čÎ5‹ßú> ÎYĂZÝ4b†kOŠ”7ý4ö†Ç“ITŮOUč ˛m™îj·?d]wvé ;S­„őÝ›ÄĆzöĽ ę!ß~á´˘^ăYĆe€˝ŻÔľÓĆ&µź~µeŇ4†^Ë űĺlĺ$ËHC6ü+sxä.űő}ś?ÎK HŰřˇ3ăÝŘ:é?.ąa€4b*8ÝWÖ<‚#0Ǭ0vŃËň„Řýę„×nŠç ‘¬ëśŹ. qšAôŁ8¸řÉ"·ż‘3ÄŠ*ĐÜŮn÷yDNw¤ÝâEňjĄD(qö]č»V LÎTOV*ŕ¨Âf±Á8•(ťš1 ě:Ř­“9¬™­bĹéö>óúá/]%źR°#G<ĐkłwRđţ)´Ó­`€L~šÔĘX3ó­ËÎĚ=ŻÜνĐâĘŁ]ü˙% r}Ěχ=ŐŻ˘—o¬őwŐrćţ`ĂycČ–>o+3–ť:ßL¦@ r/ ˘JHc±4±ľ4ů” ďK7wŽí'›Ú© j HôĄ‚‡P⏣Íl2 <ćß<Ć—Jß;OY*sdŕ÷Ţ–8ńr:l˝Ęę˝ZČg·‰bˇ(駢W=Ň 1„Ţ‹řĺío[V"ér3 Č?ˇ4iśHľP­±jŤ-?FŔá9řĂSßĺ!şHćţđM˝ÎQGŞť BŘ87ł ĽŐ‰Ó<@9JÂĆÓÔ5î#ăD*ĎÜâ[¨.]‹4yűŃČ[ß%·=LŚµRÂżqŇ+Đ•‡úv]“–ŞĺÝ.źŔq×cÎеó sGD;€®˝řçž_E$&Őü˘ŽÖ’Ž‡ ´RłŠpTPktî¨2‘Ţ"2>ÖňÇ–j¤RĚĄę ń CM75ęÄ°ĂóRĺFń·CM|·+B[ŻµŽ×r(W ;9ŻVGPč«&Éř·†TfgŤ5ţŰž™Ć}¨8†~ĽŁaęTř‰˝’Hkđń˛ţý"•Č1ĘTŤŃßÖŢpËďÓ HŤ›… ďł“AĆ ĽžZňańݬÍŸśřz€@”nş:•úËS?·×c9ú Q(kWn˝*ÜyŁDG_kšHÇi¤©ŃĆ^]"ŻýÉŐjŻRŕľ×4Ű—ďĚ3~Ď›>—yŹG"ÂM°ŻúčÜ.މőë)Ę1e ]@ĽüŘíO‘Ľ9yenńܧýHęöšüŻBÄ!Yž€›‡®bFJÄ46Ý…Ş22J\°\oúßáČăk‘´ ۵?ě§*WSrxKŽÄ»%č…Ńx˝¬0¤A˝„\•J–&ÇpR‹ĄŰăď#[‚˛„!őĺ_`»&zŽÔĐdEŮ3ôŻ°"6j‡Uą‡—G ěžÂ)7sÄâě(HŰĺ÷ąN‘§IP§|k Ąa ~oşbt·v·ëÍ7ńżŢŻćYZÚ`ż‘ŹXÝî‡üŃuÚť€S×ôŃáéŁ÷&źň«ŰLúűN‘2ĺ MEW‡©Ť U¸ĐŞ©4۬! ÄBŠ…żR;ťµĂĽ§4ĹŠ4â(ČÎ-ťÜŠ `ăkÇŐ‰QŕVĘľKµ`0ĚP&”kC­°°®śÚ÷©©2˛qŢ]% g[ÝQąčşÇěź}z|$8én÷›âĚnpq°¨ëęǡLEkťác›eź$;>Đ$1ř¨w‡úOU˛Ś VÜyŘPţá÷ ĹßŮ]‡Ľ,ÍćÉ®lm× Úł€(1U‡±v„8Tşí&Iç­ S¤ÄďŇŠ-â_Zk‡+@’lBu(B;/Áa¤Đ’©ńĎ â§W'F˛7nn‘©ô¸$NE Dş]Č;ż¦EŁž*Č%TpÄQ›uŁhÂĐ—ëűC JËó¶;´Nv(&ŢÇă=˛ŕ…Ń7¸hřWHc‰-¬çk† ťhˇ«şfVdnł`2zŃžáäÍŹ|ű”a‡=$Sç¤ăv<ăîÓäOít$ű½ę"´*¨2Äuś)Ĺzěň±4™ˇđąş«’˘ą=‘ö 0ΰńł9>Ż[<ŕ­G¨TN¬\6BG©E[o`SÚ®ô_ć˛ănő$AÎĆgBŤfÝ'R…k±Đť.e" IŁxâ¶BPŹKk*\÷ő‹D€‡ Ý)Öx¸Ů$Ť‘Q»şK9%6ÁŻ†'Ş ť‹+ezö]řď÷0Ě[şĄľl‘_„ 7ć©ZĚ#aý›‘šsŻ˝jöh9®űŹă”Ná 6ăëny۳䞲“Ösň)¨‡ČýŹ>]†4‹Ă^\îkî9bçôą·ęšq-Âkő¶5ÄłÖ üîŢJíúFa´„ë!Č`MÔ×,ĺ})uŇ#=ĹÁęĚWÍx~·6· č·ę.'Áo×yş©«Aě€Z¤Ş­JÔuUAńAĄĎ÷§ë Ęůź¸pW'›—Ö:č< }0ßj\ëyŔ»[NŹZĘŢ‘~J€j–ŤŢĆřŁć„âZđWOHxzťâEíE,™pâzîd›w±—·Y‡cm´î¤Ěĺ:őkŚł;p‘{ë–ŽpâAŢâ9„+ö‡ <€ůşóÓ1 Ó%A=źďct‡„QvŕńlsÁrtXxÇ'!—ł]öŠČű56X:I^Š4xĘnőßË!Â6ßÇJ6k<ą‰Şv„.&­+Ó>Î 7N=Ĺ.|gYŔ@©›üRťřr '6éżÔľq9q…ţŘ9Éý±z—«©#@Ęd@(ÚQ‚gŁÝěŽÁőÉIF»8ČăMÔŁČ ü4·ŤZˇ©µ„iBYüL~) ¨Ë}GPÝ~°Km¨8FA{±F9 ůđ6 ·őÔ đFş®¬ä31,.EcĆuÝÇrĹ=Řa,¨JćKĂČ©OŘ‘â2çXú«‚>űŞ‚l3˙ęužŇ:1źýŞB8±™¦)HşjOxňΨĽÖpm¬*Qüiýý=f˛"±xW×»C( ŤŢ i.lŘ—/˘ ľu@Čm`î sůz©gc#(›RĐ\u<ĚdżQ'9Çľ“†RFŞ”W­‹8(ö{óÓ#˙(\g‘ĚŻö"ř«‡űŘc]!ň’[ŰwşÉ0eęjF/¶Ť1iżßšEJł(l2Kň5aa•OËŢi­'č|cXÂŻ #$Y=[Â* 8ľĄ€;ĐoĂV*ďľIŘ78óYi`i ˛UtĄ˛ÍJ?Źë×B=Nɉe;ń@.A˙a" rÝ´ — ąďĺ6‰Ż«ĚFnŠ%YćżßđTĄůY)üëĚ÷lyŚF¬­ť’âŹ>'(룙jâ áÚ…hĎák €<,„žM±B C±®ßµKk)Ąlř§ČĄŚÔ6EŻ zţŞŞĎ¶9`•¨ú=sµţ±D ďŽAg‡Đ>N ÖwÚµO9Zůîč[˝Ťi«]Ťţ7´'Ä-Ă$đúë©9Th5IR~!ZđŁŽÇáĹĺc#Chť «2šŻüÍN79çřM„YÍ_N—ÇÎRÓá~¨$.k…Ě|ęÔ˹Ѩ|žéŤ!®B)Ś##»‘+UęŮ5ÉÉ]·ÎŢLş]foÔ—®÷"!ß'5l(Č8çW=V éí1—µĂWa}ŰOש= šD(8r¶ź%}H—©†ź"ănŞďŹrÓ=sRxöś<÷µ—đŔ‘¨Ź´řⲴ,S“ÓÁlŠ‰]xđŘ~Ae”ÇMqnI(&wý%t€ą¸“Ő^>ÎŚÔŠąí:đÂá] vü›¤şEÓ…2Ůú†L¤yhq•T{WµQ1ŇrS;±Q¨ń%µâ+ömŮĄ¨ĺä´YBs7 --őŻĆŐ}‹u…˘¶§ĎË w¨÷Ą:˝ŃéřIC»}Ôe÷•‰‚nwľŠv@ ‘ébży—đX Ź7ŕ˙ą>Óő«|rw=0ł|‚ŇÚ‡4Č?3^VE­÷,ćę‡])ĹÔu—N2î´ýĐ‹ĄęřŁľÂc·eúňńE tŁ2ü´ŕ K ŤĚĺY&dş)ĎI@ľ@«áO/e;Âú´ (Í)‚_}öł–Üű ţěĹń+fĆ[l *Č8‡‹M“´»¶‚FŹĚČ*c3J~lŢŠ“ÎŻŞÜ˘{J(X˝a;âÄţt)eĐZ,hiM7…đ‘kd\ŹČâŕtŮu¸$aM‹O> v‰lĂđ€8ó`çŚoÁd'$'á9Ż°ţŽťŔ^r„ ź  ĄŠPy] CH;1Š¦î÷ú‘Z’Ç3Áλ…_ů¬Ů˝«µŮŃűqřěU!g±…„€*ŰDmM^`YĆrZ`LËüFs’¸Ł3QŽy:+·b¤˝űzâ ü#ĐŇyőŚxŹQ“żŤU'ʤömÎOPúZa"đş©đ۬Ah?EµŤř×Ńé*×8L´rÔňYĆƤËO¤HśS•Ťĺ7Ř‹Ť Ç’µúutSÇ€Ć÷c7†u¤c ŢŻ!•1âćË|ĐŹŽ´@­9Ox …J Č÷u Óϡ4ůwÍU}˙I (ŃýÉ_ĺVÇj n-†Úd¤˘ń‘nŢ^Ic|§¬TiŞDPâě!M$đ[źvvŽ Ú/CKµçßµr\#iĘÝp¸îF Ľvćçî[H•ŕáş›ľÝÍtbţŤ˙_#j‡Ő[uH9#´ˇlśÉB”–čš,ąt©LŰVÁ”˛“üď?Š»`Ů`˘¶łGpD ¤…˙ü1Ů‹†qßźp@ĽyČ|ăÇ&WZ‘4’wCIŇ8«ĘóěčeUŤ§ú”,^}h‡2ë#ŁE'¬Ţ¬NÎ3×sĎeřj[áďZ7íô ¬RD~ś¤1ýX‡¸=ĹľĆé„×dźŮě‡Í©žŁzT&/ţ‚ŕ˙‰ćă­ňv%Ńľ|:pY´mëß„y† ľŹśgtŁĹ&·^ł wĺÔ¬ŤC 5Ŕµnň,­=ĂcĘţÍçÁřz¤„=XEŘm+ľ«9’; qt¨ëäřUĂXü­!8†<Č|ŃŞŠşwËCvăęŔ¬ŞĺF·Ľ FíęÇčďΚ2QŞúž°ÖRUbrŇ˝…şjŚç®v‚íăŤwRXűő4şhÔ팂‡â ŐŐź‡~WŐG”“Ľd}T}čjłDžHPYéĎQ[g4¤ů¸Ŕ8]Ó§PÂVĺv&Ž7eO§Q%0PGÇ%łܧ–î…ĄNjky‡sě ű‚&ýîy~S@ă´‡»ĄżşňçŠüŽrXÎß/>ŠŠTcŽ&„ `ýńĐËĽ™V“ŇG±óR3d°FFŁ ¨RßĹöł?˘ĘäU§{Š”ç{ bâXŇC*<‘š^ó†ř=iľ,W¬ĺHĺ“ućÇ‹>0÷iB\.áIšČ„èţ˛ťdýá{¸ícn“î p ¦·ŘÁŹV4t~´±–jĎöŠ.{3°80ťţľĘlYîŹűÇ"w˝3ńčŃdíđ ˙ülý‘ľ‹Ĺy±· ä ~ 玦酹éÁ÷qĺu ˝”tgš¶Ük¬_˘QÜĚŰË÷H¨Ą­°‘x˙‚Y|µ›_YDÂń¶°g-ëËRż‚j„ćĚ„¸QÎ~źĆl™`áîĺ“Ő΄űÄýěąÁV—t9ŕşĹ‚®öÂä;@eŽ'uˇDEN,VhąĽc ą‚Äü×˝‚˛uIÔj ˙«ötçŃĂoÉŚ‹ô}ĘŇgůgJŃҡu˙,Ú>ó.g`ť¤bn5IúkĂ?Ô@[Ô{Ńk= égËíxŰĐăn˛#FĆé#z˝Ä%ËÉżÄ8ÓůҨJOkbŕc•~Éź˛ÚAţč^ň7"M·ź¨U†VúX>(YhŘčí™ßű­3zďm-ą¦ę‚~Řćą­Nzŕ6$A j^l Éą d˙9~ÂŢY¨[ˇÖ•ŕ>șڨ«Ń¨&#˘¶Ťµ ś†™Ş;Uî —Ă>ü=ĎĐü{_O&:ŠxłôjS071ĂĹ×s(áÜłŔ„ń2Ü<…Šź©V\o—VžÇď*ŚłÚÎŢęvcř‹cÍ=dF…$ęµU÷ł8kü…†Ü‡µńĄa|ĄK7äßÖÉSĐzŕĺi}«ĚŰi-„qęĄo¬ř!ŤĂŃ?té Šv˙Ź„gbôŽHÖĘcĂE5%[!Yüa&ş€ËjĆbXíIŮeF=ďkőS Jo›Ě9®¶§s˙T@ŠÉ7ĽĐ(„|€ęý&@âÚ¬'Ă«„TË^Ţ6o`đG&ţŹ‰Ś‡„„ńč@'J/Ë™±iÔ®%E0»sWśyÇ /]ŢäŇwFęi§nâÍDî˝÷Ű‘ą…q8qŔ\®ú‘cE”Vp#k58Ę×!Ε\."˘HS-Îó™+Â<ýAźŁÔHí öÔżvΕÂě3dŇúëň™˙<~Í)Đ9ި…ë€pvY+ëMKąÍ\rL̤¶©ąpŽ˝;c—<Đ™5·Jé§DÁ5U{Á‘tb6Ţd0݆îJµU(>Ďśúnj?î`EřcfôeűÝÓ[ő†IÔ3)„P/ÔÁu¨ĺmj–™ąť1?$ĎŞĺíŘ x6ů<µĎ¬k Z-ô+îp V‚=Ҩú ˛¤KŇŞ3dđýI9Ţ•˛ÂBŘĐnqŢp«˘hĐĚJĐL–Ŕ~}—El¬«‹đ8 :Ő‚·ŞďČř7ő?ßé”˝H¤ÍÚşBĄÍĎěá¤6¸ –O<<ŞPŹ^”ď”Í?Ô14är­Żś–îŻxp-"çŃB8úf PĐ >éÍ1-*´ă{Ôôpc@Ú¨č®@,Źš7Żi¶‘—=Uß˙ć2BˇÝďĆ5¨˛_žLT‰,kÁ™ĚúşőW™m}żŁJÖBť}/ZßűĐűÇç ăŇŚqÓć–Ł´PÍçµಛÇVaP3X•çŔm­÷'ĄBHI”ËOH`4Mč#âĚUšńnĘc3źs±ÔťµůvÔśĽy)¬:z’Mˇű0™öJm%n7q~zŤvęýăj?ýMŹHKę§čxÇN¬ ÝyęuÄAş ‰%_ľîv¦˘ŠňşÉŇÝ·Rp„űËܤ}űí¦ł–ł–Pů§Ń@B#“ëřÚŚűîëî* `*Ŕ™ĹŔĚEZŻ§‘ÇŠP^~Ěä‡fËC,©âüŽ/´Á-ž·|SÓŹ8ö}2©ŞuŽqÝJv“óú^ îüŔ¶qXQ„Lš‡4"łoµŻD)­ďńiČűĽf¶űTÔ˝%°ÉÄ•±šÇŃ,ˇřg#e…ć.-ˇ·Í}6'ő=ľn$ܧ€V©kŔ±c?× ,ě^Łň§ WĎć˛IŢ {)M7‚ßѨ Ń/ÚęźřĄ¬Ňs|´`8ÝgęE¸ϲëŢ2’ŤĐůŔĚ ´@wăPőÁŃmS] Ć Čr ‚Ćő2„'~^ôýčłľ«Ôńⶺ˙hŇ_Îś*eŚ/Á†ĂS»tx0´ůńč)÷!O[nb<ÂiĐ0<Ă^t 5·‹“FŰ|’:eUµ0 MśOŃn€UAnUľ3#ω«a}‚´Ĺ™ ž¤‰^UŐżfÂËČ Jó1Ů4č(eąŞ0í±ü?r™ý’u*¸ř<‰ô@Á‰§ꢠť!8v®Ęm#ŢTżcySńÄ[K8ÉP«HÚ44ŻŚ3°Í·%ó@<ÍějccZ],Áę+Â_LEŞd”lb«Ůř+ÓĘáłř[öĆ@¶îś^0a_©řö¦ńk3)Šç§(NŚ%ŻjĂł·÷°B"Şžvą‚KuNŮRµöGť4ŻÓ#‹Z2ŁÁŚ~|ŕz¤B#i*Ĺ?R0gŚ'Aľˇ{™ÔýčőöČfłŁőíĂ°'îč¸Ň!—ŹjIbŮäCé[?°ę©öÓ„ÔD—vjPXC¤Đô ”w«•µq]|Ńť^×&MĄ\ď3eXť śmČKęČ°wŰÍď´zKM›óRš§*;^-‡Z 9ĂţŁô=—X§Á$DzΩßĹ*Öň%ąŮ*ßix*ÝÇä¤ýᆎů«"ĺ™Lń—ą{K‘)Jm"ŕ=) ĂKţ©ďŽśŤÔwáÔ‰sjÇńM.ÄáÚ˛wńý`ó8™u+kŁd˛˝ĎYN~hĆ5.hÔâ€ÚjŠ®“;Vɶŕ˛Ě´X—t€¨¨±#ś±W‰ŚŤ ůńĄq+JÖ\C:är°íh>—äqŃ idiéźGš“D¦Č9+iđćL]@lČ÷rĘ›°<ďa(ŮAđ#nŮ9¸ýľĄ_/oŮĹşµĹŽJśS_,ÁUĆ$ËŃíŁY®š× mD,:Ú*Ţ#ÍoiMľ.KřUĎ™O”0Ę`Fť« í YÄ á±ŞsŇ9]ń‚E"¶ĘĎrĘąô5ďY¶ęS¸ ÄŃGľ’É`A±‡¨Ě’ĺ#ŐÂçĚ?P`‘©˛o1nŮ€ŢßÍŁ}!ľ(ď¸r·Š QmqvŚv)~uMÔ›íKěNťćH8¤ 42o9| ×řu‘RMÉ•ĄťYÔČ/f‡`Vˇ‰ iőŃfWĂFJŻăŘ-VlçôűÖ¶«* M˝suß #Ň·Ěż™?Eľş!Ý«Ĺßp/Gc%;ć:ŹĹˇÓńO1¦.ŇO…gŽő żU*ĚńęşÖĘY»\vj‘<‚pŞü Á]]óˇ{=nŇ…Ř~?űq|ę˛@Zˇwş’čěäulű}–ýďü™]¨ßŞŤ]|<H_7…/5©ĹpôD"{.¦Üč*ŕëśę ‰/*ső˝.€cN¤˙ĹAčĂâĚ… • D_˛¤Ę@Fń͵Uô¶ŹŚ/ĺö0ě^¤‚ŕ]j ٱ”ßΧéÍűŐo1Š<Źý™P»n¬ â«EHtâ0ß9ěŰ}­5_IË Š^G‚!wŻžauĄż;ďź·ĎN‰’v'* ă(ćÚp÷g°™ť' %¦&ľ4ó8ńgkE˝Ô_(žFÜĐLN2…ßĐ­J*Bgp´bßQ%Ă©´ŠjÚW;á×3ýČŘđP7ÚţĂžŠ}•7Ꜳ˝•ź qń¶ W}_› 'n‚wŽ[Jf˙¦%ĐŁ“(®o59™=ńY đq„as;cBÚű˙{Rß…°ŽîxíÄ1‹’‰®(1ŞíDUĚו ö…ťd?ŇzĎá=äŐ:ŘŤ1†OĄýÄ),‚Ň·Ęŵ˛JŢę’m7CR9<ˇDÚ ÚTśNĚŔËŻ.C׬´?®ż„o řű9ł5fúŢ÷ˇ-Úím¤f úËĘBľÜąćÖ¸ţ QÁ¦žšÖŕą™ąÁpř?ŇšîđőĎź˝^>íćn˘ç<\ ÖÄoôc:eG@ť;wŞf}§IôOVZęY'ň$}ş`@ťŹjłG3=‹‹n¦•đ­ö÷ÓÄÎţEŽ¬ě#îŠÇŹ4–šT°P·ÉQÔˇµ»dVąż˝Og-nVßśú…óµ¤X¸śĆwŻ0â ¨?Óí©…Łł«ÍŐ<˙8HÓÁ’)/­‡h«ďČ™ĎV~>»#°#:pK摉eó“ŻôŐ­{Z«z)"ÜU“…ç ËŠÎXU®}fŇ©ß3Š¨š˛,{űdZ‘~}#§6/żKtĽ°Ű¸jEf7/NrÂfţܬtX„“ţ^(N» KdÓˆgąŁÍcĽjD—…¸%[ŕî0ľ˝ď?{)„µíag©cR¦ßh}áw8®wŁš‘/JŔ]1u  6 ˝†lĐk4¦ Đ^ąc»DaşNÖIÎśg“k¦\`Ăśš@ĆŻpqN ć߼ęTŐg˝ÍmŘ…ćËŐli,LTçőꤿ‚Ň[2ĂŠGŚ‹čw˛ßk5íź’y%™Ę廢 wÔŃ®»¦µĚ‡.—_žŕ,ä)°Y=Ő×Ü8‘ĽşÇ€f˝CCľ6ď ¦łďĆľĹů×bÍ4lýŻnMę˙"k´«±‡ëüUuI‘ťjmľ.±+łű‘Ň0ä](ŔMĐEnş×Ťµ%2j÷ć‹|{HýhK=ĂÍc‰ÉŁpÁEJl´ĺö¦‚ńŘuŚĎeÚš5±Č­{ÍظrŇ ç¦ň%C}Ú=5µ›˘Ż˘…«ętZZ2Ě&n+·Â˝Â·±oËP=ĆRŞV^ÜŚ]<¶v°đOőKAŻó"Ű@1c0pÇ ’ F.MS„ŚÍ'µÇěË°iĘ.–žh3/›ˇĘ ą+á€yUÂô'ě1d˛ś7A¨ňVŐžáżKÂőĐX^Qł5F ,Ń*jV€uíR«ű›i uĺóJ46¸ Ý3—˛Oă(DT¶bÉľőů»´Ć)}§µÝ2Ř0’žL…u<ô‡Y”ôlpOe X“{ňBře…¤{=F5›Őí˝ć„]Inź1ĐV‡#…ësF3‰č†8€]é:ůońf…ö`Ć“C]PՎنÜ©T˙ř~­‚ m’ŤŚü("6›*e2Ţ>ţä‡ßĘŢ׸$•¦ą„éBśäż Kč!Ś ¤^Ą„zđ đÝqtď‘ćˇd´Ąá§Č!<Ŕ†^Ǭ·×HyLŰ˙ŁyZĺŢG„wrů_¦ŠyŽ­#{ŢL˙‡—¨‘˘űÁöI¬ň}(÷\ř0ě‡5% ŢP4 XăŐŮ nŇ‹z?ĚďÓxbZm÷[¬‘ÔřĐ€pnâ”ŰŹŞž^ŤH&”ÁÚn…şłďŁVqŽ§ŕ¸•ŇÂě]÷;ľ—ZAúÎ׌ę&€ťv»í‡`Ú-1XOkŮjěżň䣦čGU4żâ†0öÄ&ň€ âl<–Çë¤?ăĂ8§LĽ8Ę3-sř‚¬^8Ţhz±•_zOĚĺő ´Za?ŰÔÚ áBq”­ťhőb@ăŐadﵨđhé¨Kćvج™†Ĺ.2ťQ,•ÍÇňJĎŚ4[×ó¸čü Ü2x~9Ą˙»Ń $mţHZfÝ…níł–ú^y1 \Ń&?*MklJ•+­ š Đđi‰®2 r"®ĺSô]ĆÂÎ3hRrV9ĐĘ”דîb€ľgRÝU‰Łň€î¬QĄ |Úví(«°,ÄVHíĺ!Ý÷7äOöçŮîŇ…ń÷ś¸G3ăfęE"VN đâĆ8 X˛ŔC˘ö\k…ÎyŔAHŇÁs!Ŕ z´Ę§đw}AWŇîLĄ4‘›ŇBRP°AĚDxçqH¤‰rˉvĺµ+ŇŁŰźÂMŃűfćŐę“\Ѹçî•ŃŔčdb'W˝5Ŕćyâ|= •Y„ 5«•@_˘Ťă¬ÎruB  ű—Š ¨kľŽŁFí-waXwą4v] Iˇ<<ę'0fFŁSµŕ0d ĐÚÇ{§"áţ‚÷µîf€ü¸… C_Ó±‰KŽ ›3Îoî™"‰ňC¤=9©)P<—„N{pU@–ŘžŁŁ ŘEpě%ŚŘ íjş7FęÝ|vgm…OnYZŻ™í"Ş ˇĄôűwßÖÁ-©ˇę…ąUĐ‚Č]’˘č#Gë‹Wl×5ëqÂľÉ-t™Ln6 Ź;¶ćťť^ˇë_Ľ˘»Eř(ůvhÖëĐ‚—¤s• EŃ˝{ţk/Ęr»Ë#˘ßW?ÍfĆ9TóĽ®}?:G/ś±?$.Š”ŕHuŚ{řÉ3yę?K°[)śőÝŠŚąŰČjAOa(šQ˙RšśŰ×T$<ŔđCď6k˛&Çś˙ĎÍ·Ôëó©q1ß’:GÓ'Ôě’XŻu¸2‡ÉÄ?Â%­`Ýůá¬/Ň[‚ç˛ĎŘ™ÖÍNăŕk WľŤ®şŁşĚđŻĽVő–=ô¤-ÇŁqĚ‚;SÚ”J„SŁČď·]_*Ö8!‡[Xséśő:]ü[ČeUL¤Rc#ŇĄĄÂačö,Śýö6'úĆď¦ůwëpČ=hđr˘űł®içă’ű!#—ÖĎĚA[#ě*AT;ö-„˛r•ŢR•mś ­şă )3€3ŚH»üÄTi¶(ţ5ÖV×X÷Gë![‘™˝ěÁć,{ł‰“ňfΞ¸KlŚo»Í8ö„KÍĘǤWBş—€ôXďņźtňÜLŁŻIŽW Ž^“ůŰeĘc ĽDě¬U«¸Orúěé%X"ȬçŻç-?Őy]8şŕ—, NB ą(!±â§Ä¤žr.o%¤yr‰ľ®Ĺ…<ß4űHÇ'ŠU"|ß”",+UŮ®Íܨ—ÓC)›µ^‘ź9ö›¬kkŔÄŕМą[jdâ`=řFă˙ÄÍĐĘŹv= ¸Q‰ä…7żxS…§“gW sď󨚲ÎĂŃŢvëIhtÎ5Ń—­VI«Ďě+žůM.&kô"ë×#YgČu«sHĄ–Ť[j†ô/Â’±ßwËmş:ďÖĺ¨ë«ßŹŕ7šó^˝÷ýO‘!­,iÔ…ö>™4Ž('ĆŘ½>źÔ¦ęA]űµ¶mšr'Çl=ýN÷S’”ä<»T~łžÍ"ěŮ8ĺśnm2ţĐ#ŕšFý†ŕ‡4¤ĂPú¨.ĎŤ#¨śšňd OŽÖ—×ÜV%[möŰž—±L»đVş}`šŔÇVĂóűFimE˝sĄ;˝s…Bź ן…‡_-ş$5TÔ6E¶űµ4®D$Ô/4EÖ=ţ’­‡ cÖ łŐCH•·\:#Č|PgĹ…OâĂ:5îr]^ÎOÁeşnGOÄ»o®J—Á0qůjzVüTç >é'iĎp qţ#@ˇ-!Ę8ăOź˛ŠĺŹµEË(ß=íĄîÍCfIŚk^ĽÉľ”r7˛˝É,ĐăU¤L¶"XďĽđkt*ś‘Aqőqćç˝UŻ_y|đA ĂĚ‘ľÍ«foFI|‡xł”_ľ fIűöÍý4óůÉYŤĘżoÜ˙罩˙.ěIß ť§™h*ło´Ó¦ćAÇČĎďŚWĘŁ‰¤#&źômsVQ–ąÁN?ËK±ç\ßvf!Q‰'î|Kdă“dZeŚkßgP˙Űâţ°©¸ţEÇ.{äzâňcďüGNOQ9o}­zc; 6«•®+7đŁ©đpqV1˘„Ű ĐóĂńjîąZÇuć”0Ež|S[‰~⏂~ö+›ażnťBßRťsŘŹO0qU›0K×Ag\âËD9Ŕ•˝ĚbĚ@ďĹSŘ<[ †mÓ&¤äjN“ń.IörDŹq¤!’Ćťtî¶;¬Ţ„ţ“ű9ŤXťĆ!ô ·]ßJµ…/÷ dä§0ń0iŃbPÇY˝­ĺcY®Ú‘wa&9ŹRm‡ľíwjĽ×‡c[ÉĚIĺŹF#?íŇCP] âŠů¬+î ěyéÖU¬đâžrĐěSTµ™Î8Ľ`)Š]‚ ď .3Uó»ęŢď:ăü?śÚŰŚłĐ&4źĄF†_Ej8 ”Ń´B9®„j5ěű|«űŐ]/gMŽ ‰…­·fřDVÇßŃ0@˝ăquąbđ }UgS°-Ř@eG…ղǺd r7–P._^~"fëWŮű—«,Ě80׎6d˝Y¤¶TŃ/Ór_"Yö_˘ľ}B„/a~جѤVąÚ´ßIˇ±î †ĆçŻ;oĎs ídsÚ[iĚßbŇĹűź˘?Ć€vBo_¸ľl‹ň§ęm|D_$ţ9<Ő‚hęۆî3O$ăpLé5śÖ­)űµd ŃŮAŽńŞây‹PĎyä^±ĘĐRYčelE•;‹‰‘Ńjšä¶f)+Pđ!puşŽÝę{&§}fÄš|Ś•ťÝÁaŇ„I‡ÎĺŘçX˛”Q>ŁÇňřj”‰1ü]ţ»Ś¬Ęąd42ŤVYzď•”âÜ}—ĎšŚsdď’ý+ ý·@ĽJréőEŘ}YĺzďߢPč–‚»“b`ą !z ĂžľH1[ëÍĘ ĺĘDA÷ňţÚĎěVF”öŇő#FÓśŠÖkŘÉ讇–ŕĚ°' _wY#ČŰ,]ž×UÚŰxQŁšă3­ţ!hęŔUÓM7ö”n–¬äH̱O|‰'’7w@[b¨łummž]Ňvű8…=•v‘a+ĐĆÎ 5€ŻëďsÇŤ÷äôŞâݬ¤X…¸ľÖ©«;xPIš*˝âŇ_%Pń)š°‰Ű%Äü>”kYţźŃtj!D” ä łÝî Ü`WÔ\e†ľ%)¨Ć…¸Ľuŕٲß(•»ŠűÍ€ńËO…Ć ë{}[[źô«“c˝ľ+*“b75 čuxąZP™îÝÍžĚűgýüÇÚXĂ‹×|¶péžâÝRj‹B+Ł)¶~ Đ­rPíVeĂbŞ–¦DŢh¦/MrÇ«ć­§^Ü»/Zł ź§ňX/#M°—ëĘLJ‡ě«UDžޤ`î^ŃĽä¬0 t}q‹UM{¤H“É<'găţ×Ó¤îŕ©Ľ¦bs.ÇĹŃgxvzËÚA„Ż]!IéŰ+‹q55’ +‡ˇ|ç˛Ď*Ż@ŔeH|/ăéB&fă›P$Đßú‚ĄŻBĂ·(1•§ý?î©c…{Íކ Â<ť2l/Ľ}š[Xš"رv0Ó+—㍠™ ˘9ÖrEůŻý‹ )Ź{ß ńeDKDí=7Ž đä_~ÔŁňn菝¤ƨRÎ9ńYÎőG~ôš“®[Ä/‚4·»Bń@k3UóąĐôáz =bBŃФľ…̲žˇmáJXŮÇ |ç…™±«.Ę.úÔÉîɤn¸|Î*žioN¨˝ë\8Q®+ĽÔäCý†’ÝčŔÖoŽ$šßkbr\NNű"-ŚŹ˘JĹú>âGZ%h+Ć0™–Ř폞Ďm·>˙@¸=@1âµ Ż‘»ß:ÄÓ|lH­ľuY ˘é`Łý„Ĺż¨Á|.§K:/Ś.T“˘M˙ô®ń7…ŢjH2Š· Ł,düSež2†ěXŁ7-~JqF5Ć—VżôÜPÂDb`ŞXĂ}w8äš0oǤVC˝<ů+RŐ˲ťRÚóÁ;t«µ~®‘Ŕ}ł˘§Ę;óqyÉâé{bšŕß2ĺÔPJK„Ś‘âJ\EŞĆâ/R(¦˛1™ň7ŠŤ»áÍqżsĐëćĎź{ź\ú%ËyŰk4/ířFDíăě™Ć™Y9PŹN ş"łáż ŇZ'ňýđOCćűąJVÄ˝1Wć•Ë}Đă"6µŇ(6뵜—Loo ›MLf˘ĂYn•„`ökő 0ômmr„8ćő‹:®JŐqĂ+XI:®ŤnŹ›ŃyăE(—ÇLŁÚÓńô…!büŃüîűĎA Z‡Ë–S¶7Í‘ťłŢa+·¬íV€K¨5}ká[۶ú° śů) Š6D üÔR§>n, x bŚF‡Í-t7ÎI}ÔĂĹ÷Ť¤ÍőCŚôĂ®ŘÚY„и!·wô“!Č˝§uŃ{łąRv<Ł ĂUe:®úF;ç¤ýÎ\ö ůëń}­kVj¨wüú@ ;Ŕ/Ó„űŽŇÁúŃR­Ŕ"dSM˘¸„í rBYľÁ05#3‘. X˘„SaRüeúgQfËÂ%dÎÇ|*óIhóg˘9Uf2^ľrŰ—7 ćZ“~ǡÉü#nĽ<©s¤–9uÇöÝDĂ$Ĺ<¦F1u´ęç´DG2nďűý™śč÷Oňâ4Ç?cŽ2:]ÔĄ[čý9ĐËFKćËnƨ튄4 6‡/ŇĚş29Y‹µ$Uł„W=DL×Ĺ *«Ż ő!ľiËm;ÚŹéUŁřÜ?FÂ?>T{±—ó‚˝.uËŇ@ę€âB3=6é†i)şS–$µŤ «bjđÎĺžHôÖ…b"TećíťIM XLc^x°©|„™:Ţ.@ćT2ö$Ż–*q\„Î |ćî{…ŹÝM~ČهFľMDOhbpu›@Ű8ą@6‘HŽEŁ ¤Ą~Î-­NU?‡tµ#Čs¬±%„KS0. ü#©` ,Gű¦{Ě4ĺd†sd[¶1)›ŞSŤV(5bÓh0‡ť®I9­4ŔŚ:Oc!Řňß2_ ®ópž b¶‹ÍCwŢ夵 &ˇ™–ÖŇW@­@”.86%­xC¶f˙>wéÍŇłÎ×ÎîěŃřŽ0Š_Ńĺ}m_§¤)ĘOÔ±{$x4íű\篬uPţ|GŽÁĚPô?f÷–eđ-ń˛; ‚~¤…jmťÖ? 142Ęť«Ä®»¬9¨@ëmËĘ(Dý{8h„!ěýQÔ©Đ ŕD­†PbßośĽŠ~íľ/˘±b ™@Ǧ‰U {őű…)Pw]µi`Ť°\e˝äw[+ĽN»9ĐďZ¨řµ‡đÓ“{ŇĄkţÔ3ŽP2ÉtíxâoEh, Łw ÄE‹@va"ZĹXËž­BłIçá´Đ!ŻńN·2ŰŮ&´;ĘÉ٨ =ÔĹ5µ÷Ă)ÝŚ,ŮÚýâ—ŞňłťČ{m2pa\tśjćB(\\žFÝĄçî˛)@eŘZÉĘe㸫96ľĂR¸źý^'Ľ]±Z˛…”}Ť«¨ô˸H‡XË"CkYü›čĂ­¸bnú Ĺ$ÜO¦úvčěš «f‡Đě,5€ú‘Âźp´‘™ÓĂşń8›×gMŁíÝň$źźÄUI~%ĐDđ»Ŕ÷Ą˛%ž€*Z~x3'źľýČĹ— Y®=Áă˘(î@M„•˙Ş]úłô-cđvż¦Ń†B‘ţ2”ŇĎ].`:7QÇŞ"s~äINěţ÷‹f¬…wqČçHšo¦‘ť?/hG’Ë<±ĽGRî¬ŇD\ăﲼBEKÇrX­ r^G†Ś]۸aĆ’{ńˇÖúĚ7ßř9˛ô⦵˙DŁ#OěĽŰ˝YĽWjDx&UuťŘß”{ÝK(+S/deňAŤĹMRą¨Š-"áO5śZ˘xśă?ý^Ţ!“ 1B¦H¦–eŔł­âťT4Půćö+QoĐȇŕBŚżž ˙›zhţlĆYŚ÷ÁH(„+•ëĆĘéC‰Ái]Çčd»}k8’™;:'Â-?.Ě{bŮHWß)ŃĆ‚¨ ëŮiűˇAĽö»'2ůŞ$ą—žnv!}¤2›\C1ţL‡­Îä$y2éx§ĹzQoyŻ–ă‰Ů#SĽK<×ŃŤŃß—Qřń‹8ĺÇG áĎú eŮźf&tňń „Ĺ‘Ć÷ZĐ;\ŕĚ}.Ĺ`çŃ ÂÂčôgĹłDŇŽŢ3Ó€ň`Ézrč=@7€ TŚ‚’+Ą”ߎ¤!NM™•jýĎŃ8Íɱ ŐÖÇŻĐž¤¨¦ľBúÎáĎĺ?sč¶IŁż™ţ¶,ŘNí\L Iw¤&VĂ›‡“1úäG*ú{_ľĚH+ŽI¸ĐÉG>˛Đ·@IŮĺói·›ąhžĺk„ŠÚR¦VŚfMśż€XÎqĽć(Ë7‚%S Żk ÄÔ?$°ě„ĚÁ·iüáhOŐ7Š'¬hEKâ îá‹ŕ‡ďc/©M۬ź˛ĺfVó— Ť <ĽĆD&c˛ť2u*Ł4Ĺ*7á¸8tĘś¤\~™†^%ó¨Ľb¤/‰Źcéş~ Źç>Ú+ůuPĹť( ŘB'żJ@ăěĄN=*"pëbý”«4(ěË„§)…ÖrGÔPGŚ×—[Ŕ4ł$Säzů¬J}S/ä‘A/AâKĽ˘Y;ëŐ9ůlú&É~očµ?sC_7;Î[bpŹäM¦Ťâ@RŁj5š¦ SÚî ]÷ˇNÁÁa|Âp¸eú›%háXŃ•›(ר·„»8µÎÎţ%Óż˛_$ʤw2– †m_sۇĹOď30Ľf‹€şŐ5 ę@tŇüg|‘ř¸;ś—XxŽýRŐ1ĺ©>±áËUľ„ÜvaJŰ ÝiŐDZ.@ÔbĽ™D ȶ¦zŽ(;d™*ŻÇđě?ĺ@¦ŮóE¦˝Ă˝%1ŠĹÎtjŢž4/’{Tů;ˇ:łĹ[Z ű0µ643BÎşn’L¬ŕx[ľ(«nO#ýÔ%‚}ŘXôĺlÖ^űâź…Đx!ůUľÖ‰R÷"şm¶đ"Ů°˙ĺŢkj=ÍYŰ Ĺž±Y#qž\k)čśÇA…Ç­,ÖäfOS_Ç˙µÇÄjő`t‰“óŞŽ@C9A€Č˙Ę&W Dűů32N6NąŔŁ×ÚÇϵŘ5QĎ©ŘŻlň@Ą‚Oeă«í¸G]<ň¨Ý˘K aBBK÷ýnŔQXăłŢ’hh@9"gĐ+'µ{·h:ĘŘ/>M+\řŔ'ń¬OŁ–¤—ő"S‹2%P2ÄCaŔ© MgĎŚ¦ŘѸđîĐ^Ž‹ĘqţI¶ôu!;đß‹¤Hɶ­ü<\ëtQI•›:‹öó51ŽBó7µi‘Ö„?w@ Ý™ˇÚ/`AńĹŐ}lé´ÍŹ<óě=%™e·UŤF­hµďM&+ä z™Z`dµkv˘¬•ťóKÖšlF9 D^y&¸Ćă:ĎmDáWfQďM’)而á>Ď÷ýjF#ă÷˙2ÖŕĄ(!ż I'~łt}b¦ß &ę!…ĚcÜ Ü5©ěŞÄÉK˝b¤"řč@ď(VµÇťG6dÂeʧËţŠ ;›‡ýŕÂ14fⵢ @ö«µ^e˘ QŘ:[}>ÁÜ:@ŮrĹ‚$¸wŮÄgLYÜŠ´?ĂëdĂDb_HyѧęhÄ,$ČE‚<Źb¸ń§5÷{á(ÚT`‹î"ôZ9ÎŚX×ÜŐfŤĐ!Ç;±( ĘźkŞ':ŽűDµ{éŰ÷ČŮ‚¦/=5gŞD4„‘˘ăMíŕ/‘sŞëhy÷™wC™Űěuvâ­ÉÜţ“!w8ěî]8Ó%1.§kDôů¦ô±Í-Y}Đă@aá,őŰdk)“`KŘ8H‹Ž .Ä]ÂH‘YqđÄ´¸Z›čŢźńCÇ·`Ë'xe!jhHp!—i¬>ň¦Mý¨s•R§«FL×`Ét|51ž®ßĂŁfÔČâ>=câŰ\;ĂĄz­źÂŔ“–´ĆÍ—Č~Ů<8Ą¬l Ţ Ä¤·– }?ZĂ‚c©ŰĄo’'ů[Ëm¸4¶x`ŹÇő±¬‘ď0%tľřz ľ‰@ŹgĐăQ íICŻÍĺĺG -Ó[…ĐŻf8ü.&Ě®zOsq!Glŕuap„µi:: T#­të6J ĆXí”：!ë°fn€zRVßÎLµ j˝ě—±Ń»đŘ<÷ˇ&gÍ0”˘§ňŠ‡ ź qˇÄN@˛ĎŞŁ`ľo‹uăsŹ ź2Íuűč·ääż L5Ą«ôÜ$v›€gôGns‚ĐËţ»D- ç#ŮŚ…ÓSťĘÝőĆ,x@?vVWŃ`˘'5^NýMőćCM­\»Źií8šµqBď_ Ë|ߊŤADÉ;_Ă˝Ą¨L†:é'3ĄŤJKşdĆC NJś/Ş˙ŰąTXůz ű ™´âŽÁҶ[]űşť¬ýî¶ŰéiŔŃ,Ňż:řôöüQ=căśRȉ›ďp?ȵ}Ľ7rł"#ĎîźĚg1EŔr’ç¬Z˛Űą´‰8ăňC=°’ű†Âáël\"ĺAđé+¬źنł©62ˇ—Äý ­¦B}–8ޤ,éß9ĹŞEE Ł˙ą–}qźŤP›đŐZyá‘Qí“~äĐĆ> ÷ť—rkLV! ŔYŠýcçÓŁ”qŁ[čőZROé'˘yÓ…Ż>ĘąâńĽ¸*rmĽÇľW ă#ÎĎ]¶´yŠz9Ô=rD!ÓĘŮéżYzϵĘcOÁ˛Ę_śęYéwÔË€ŹpÁŘü$e9}©nˇÎ*F° ËŽĘ:5{FÜęD‘ŘÓ°Z¶€jŽV–§Í̦;ᤝ‹H gö#ÓŐ' ß&YłÍjăő.«ÖčóŁ^ŞťćÄVÁáY~4ČĎ0ľ(>8›OFô:/NŚD9ŕ± !ËxŰ‚ů«/˘ř”ÉD.T+3*éěT«T~‡žÍç­~yšŞQj§PÉŮB3Ň›q›§Ó4Tj"!bO›v^{îXčË,#ST ëM”4¶“Ů€Ősa łďdÍN‘Š^ź­uť0`%`€ýq¤ët3Ďr˝ˇ —Hlh·G›TŽ °Ü˛ÜhÖît¸Ä4Qç벓ËÇđ—×»·¸buĎüźUhP’źyö?o–§’^Řć‘˝ç„u‘Sţř=żD?Ž‚Šk)Iצ9űwČ>÷Ľ`NA)^9âúZ•Żł8jE}lOč/fhś‹‡ I‘ şˇčţ»”Jk¬PĂÄ2kÄPĚ9íRĂL«Ě vňt7’ŹdFş:Y[ţ˝0q88Á]2“Ě]Ńyű±%ŕٵ§h`\˝Úč‘ńâă$8˙Sđčv–žéz®^ăuxČůíwŹ9á¤j¤F>Y GŚk>Ć[äSpYľUJe…8EÇżT"{†hv1ł^v›ÜŐŐl¦µ~7ͬw™Ť#˘v¸dRN—‘ź…N;ą>µą3/ě`Ö¦m3b9QM@ůZ^ΑކŔ%Ü,ô#†›ĆiÁŇ!˙‘đŚuw)ËŔ‹Ŕ  ĺ6Ďt ć äÄw8‡ëT0“;.Ł -Wtži˘Ż3âVńtŠ*^)&yI&ÜřúHpLsH­ěěŇ•q—¨ZÁľ´Ň´{ҬÁ×yE*Żňm+]ë¸$w‚*˙ÇťţŞ?ťüGw@Ĺ÷‹ů§/]ŕZ ]Î፮ęU 8©ŞR»ĆôŽÜýĽëšÖű¨Ţ˙Ú€ŘŇ D×Đ°îlEĄ?=,\AZٱmrAŰU^ÜO0íl5ŇxBŠó˛Šé2V)3㹣$M¬ ®=\U5éŹdę@ë0řŕ)PŁ +µFéĎŐ× «ňčUp(]ůŤMíúYoś± .ćĎE~ « -FŐÓ7÷NSŮ$¦IFŁąŇt0L7Ŕ €ţřeŚúĄř"•ĚŹS,j‚­'Ć«üB•zd769P@ůţ.…­‘ĺţĆŮÇŹ°1RÚíŘBŹű|EĺvĺÜd÷éPh39Jd´ł4ęˇkČÔ™~‚nAŤň\í/>áŕáĎŐ4; ťÝ'ŞŠCŮpt2÷~$ ł(ü€¦ĺÎÜ”Zť®†TĘ»µX¬Q^h?ZŰÚ˝’Ű W[—B|ăERö…ęR\fqäë~ôôŘ®řh.%ÍQOEťpvĚ5@ß©%PO^I1E5<úŔŐČÉ®ĹB~ŚŤ$N]&§ńŔX†ę‡>†—ä`y©´p(śżX-޶3Y…MB#č+D6jŃ29Üד‰±­TŰ@ĺ$;ëőĹ©íś'>Ť\ËA/)*XĚäč´H©- ]ł– ťr{äBé„ÔÂ!ÜţOČ5i=^ă­<÷‰‘OĘ‹! Ś.?řJîqs™Ö¨Ć׎śgD CŘ9~MA‹E”e˝úÖ·ˇîoG´˝®˙ä ĂŢ®NÇjló‚ă­ąsíň…ń8E}6Teéš2-ŁČsŚ±ýG[ď'A¬SÎť–‡Ş‡¸$.î»?ŔŇř?XöM˛W$ýđť;|­ Ví¤ő´)Ŕ’Ť¦ă—ş żW®  /ŕ­J‹ĹŕąPő'năĎÖtă9{ěň{‘Vm]¶nx3ÄK©<J8ůBY..±ůÎý˘AŘlN©…Ł7ŘËůşOÁŢc±_Q¨tâÇa9i}:ź Bˇ·¸µf ćĄj*&ü´Âvšvbmś$hŕS™——ßK‹ŇŞ]Ž¦śÓĘ=¬,ŹöDžÎˇŻ±Ř6©fĎë_GW xĺ(°†tźb nvŐ@?Ţ-!‰ĐŁµořnýť¨ŠÔOĽţ挦AĂĺ3űôhôŠAiÚ$í[ŤiľYP¤_Ź)ó3cöAÖ§;ű':î:w1§ű”Ý“BĄÜ—řý7ÂąR$»ţş>@m™GŹţ6ެ3[É1„ˇčĆXśU¤†OʉrYřýv9PgòíŠ":¦ôţu’Ü“ŕŢ60¤şŘď9 ߥ…®Ë‹ąPŞýő[kÂkčd[rž!˘‡™…÷‹eŢ©:şÍ$Aß®ďxl¸2ĘeŽ F0N9^0ö“Iµö ‚]8Ç2"‰i–'ťéÁ^"ËXď—P%źß)„Űęż ćŤjo Ĺ­4©±yřą5§äđ €jśęz¬Ř{?…˝BŁ0{ůĎ2uć§jg…iXížs"ßéËR HQŰ59Vv‹ŮPŘ ±Ű]ÓĂÎóó÷ Ô%üť<˛Â ]6Łg-µ3 ©KÚôwÉí ęLú󾀵ĘqŃ(˝(ÔÍ P\Ú„J«a!Ăó8)[q˘9¶fD+QČüt‚ŽŔ¬:›µEÝÇ“(ů™*ŃAň,Ŕ©ŤË´ĆSµě@ÚĽÖSô‹ÍF{†łŐ$‰`€=f’Š#ł1ěŽ^VC0^%ą'ăK8zÎűd_CŠě«ćŘ4›)ĺĆ5Ü«áIWŹź,÷C'C™é7µegYĐ\U.*Ú _ň1‘W@¶ÚůÖ[ăR_|4ž.Ř·čăA0…’[¶rĽ;¦ĂEŘÎú#Ś$˘‡đČU !:_—ěĄÓĘ řüIß…čĹű)ytřđdóy,”ź2Ýf¶k9+Ío|RĆv:\R§ך,ęÖ§d˘NŰEšÁçîĺ ÇTîůAFW”q‡ŻÓ,üŇť1U@±F‰UŔ„j‹‰´t&$wČâG"+L€z`w‰,ÉUÚt¸Ý! @ ~ÔYř\Ś¬e_ Ţe×OËÚŢI÷cŕ©R÷Úřbgĺ÷´Ţúr†RSĄŰÍ5#ŽČţ¤›9uŽŘ!#lD©I¦űӨҋ' ±˝3V€¨ô7r軥i©TĹš®ż8Řęťő*ph„ę¦C±śŕ˙Ú ř `®b…kn©0¨T® řö±-î÷rĂŻĺ¶#ŚKq[“ď®Ęcđ¨9i˝ÚChS,îăQ©]kĺ&%X)7+;ť»µ&]4únó=QŔ“Ł—CaOTűßľ{Úçí'—['ÎŁvD¶'1ľ'ybx„ľŠś±[·2ˇ)Ąn*‘+™©Ň· ńźBŞĂë+„5ü™ť˙~Ä(úăuźgś_łąPLő{i(]ľ€:;µ¦ÓíńűŠ¸=nň <„ÜÓ1*ú2±˙[1R,!I,V÷…Ţ«xÇG—>ýdq bFë0ŤSçĽ?¦@äA¤żL8oÝ_`‰îQ]•&27ä NjŤ<Ë…“Íü…őź,HÓŮţÔůŚ†WΕ\ćqźYľ[!á?čiCäÜń&Ä’™5ď@:ż8¨¦ŮżçdˇŠŕt­í-„ď(yk‹Q¸đBtć4Ż zá4h•ÚýVJ_¦†Sn %Ü,»yŕ0Qö2Z°v[UçĎĆHzć 1űĆE6Í˙ŕř s‚Đţ«#đ([„ąľ ö\x$®˝ËIŞí™č/Rł-UŢžLE=…ç#@ ëg!·±žÜ¶s˙e$1’•=—±qP¬:0 …ŃľŐó«ů&ň(˘w‡Ďt­ř_4>wd<%–ŚcĐöiăjľDÉšrU{}]É6¤i-EôoQŽFm»ô´[­śĂA˙âZŠMÜ2[BÁ+”ĐN7ęhŠţ"aEě‘ŻaŠ˝á ¸•¨´ětA4ř?"ŕ|™­ŢőóX4be&ž_Ě˙NkЉ—1Á p-źd0Ĺú —¤Xɨ˝" )sšTyV{Ů©é[Ę– ď Ă4ĐöÁăŁ2<\ňݱ‹xÚJg[ŻĎ*/>Ájön]責č$ zňßÝD9\űŽżAňěB9M-&ť^Ĺřw.Tn·_mžzLĽ›.C×7 ęTŠŁŇťťžÖÄ•×ÁgĂě{¨ęČ59 Áĺy-ł#î€K¦ë`¨¶Hᬕc ›ľj,ukPÄÖ=Zť»ĂŕLý2b&Ĺ©§ŕ'—<äsťsËúŻĆou?ĚŘÝ˝mÇ%Śîú†í „’úň€ŮUŢ–JëNü– YŰ’ćŤu[™$Y/|CqN*ÉqFň)ľ™=-3V!ńl>A"Í.˘(çĎF^6ĚCŚlźŐ u¸†Č—“ąĺŔ‰µR"E3dč]Ąě2ĄccmĂ,áI90}Îç\9‘XÓéÁ˘„§ćĆ ̵×qĹzNŠ—cA‹HoŞŁ”KŻ>Wf+wJŠâíkróS‡z~ôß,›ůZ¶ŮÇkh4+9ó™™ĺ;ŽÚ“b[Ŕ(•Ýl0ä ‘//ş‰b7šëR2x6¤›Ň VĎÝ Uhőj©>‘t ⯄¨qŔ‡ě«€‹OQ’ę–LWÜe€‚ßÚŹÄś-$@Ż”ZŞˇô}ů7bąÔ†™8¨çúęc ąŞâúŇÝşňĚĐl;ÝřŞ^3K]Éţ2¬‰5şuÓéV˛ßqyK–wY-OsräB›frĚ{ws˙M"WvÓŁĎz«÷ÓčĎľ%ş˘3Ł\Čn“̬ŕ¬.mđnÄŕÚ‹˛ßÎS$,{Ltë7ÎKMFÝß•ľĐ—éi ˙Ç™GÝ_0ťĹ:˛j2ĆAíHĚöJ .#ęPôD#Y`DtĺŐÎ<ŽţX’˝»_ĺ϶›D†üj— (TÁŽĹÍ+Ż1)FěÚĐłL%T:Áy·±^öž¨¬2,Ě6OťŁ\»ţϽґ±×u%âHjł11ż ¤ô6Wą®__Z‘‘(1f–^řÓů »Í úÂýˇ¤_ÝŘ­9~[7öžť‰c {jđŚ •ÎŇVăMŠŽđŞ3ŕ>Ţ/V>8e‰¸¶6¸tcËdˇuµŇţáĐ€Ś{˘±ľáMáŘhNŢŠ Fą K…ü[“Ş.gmĆéC~ćďż‚ô.ˇî[ĹsĂ3Źl‘ŁÁçú•—ąjÉqŹŘĆ˝v}V0OBŔ jIĐŚá7)Ç DŔQV <îą÷ ŘFŇF0Äuä$ Ü¬ß.X/ęiĚ@}Ť$‚ÂĘáU9ńÍ=W îËžŠLtÂyć‰RU›Á':Á—Ţ0’w Ínc˛Ä¨? ĺ[÷ÝŇÁěŚÜ糥;Äc¤ň¬®·ÜÂĹ5Ău"żI‰=”ÔŠ2WÝŮ#ŤL…Ö?^č;@"TřJBäu—ýŮ4­)µy'šBHńzµŃ%Ť‡vWĐVť–9vfĐ•^zn2şoß?ćN_¬˛"@Ç®†7í˛™z ;•¸{W„ý;ÂFťKgÉ+cřÄĽ G/aşÖ<—‹4‹ÝAI^vÍé™^kp4Ż~PxUĽÜ)čYVzŽő†čxßz-w§ÝfÍž•’ňŁw"Ł¤m±.Ç·SŞm“Pf…l‹’UU*1ĺph[”Ó­ÚV+Ń#B"‚íď›ů=Nŕ­‘óĆĎŘ OŮ 'ËŞŠÁw $| #«Ô˛ ]'ŘYxJL^Ç\Ľ[´˛Z:†óňÚr±5ňóZÖ[ăăßŇŕĚńÝ·ÁýđŽ¸*~"7[ É Fň{f+d$čĚAD“ –x2ĂĆ@*W;\t ‹Q2ćśÖöjČüŮ…/ŕ3­•9˙Ľ±Ř¦âÿȥu¤ÚWŹŽp©]ßĚO4nÚ§´€čł L´hVmé·©#´ÇęvaMő¨Ýn˘Ąt?»ľž˝ÁUFţ>=:űťÓ—ˇŽ6źńľáÂÜ-ş°dvśŞŕˇ˝đç`żZ›Ó4hoµŠKZ÷šśĺő¬ŢAÍ–ţ3Y`RĽâÇZ¨ őÁ1›ćŞ"­s¤„)k.Ć«Îg„oyěK:Lɧ4Ő>a¬+(Ž‚†ě˘ĘÜ S…C˙zÄĆgDŔoŹX+H)VYÇ‹ű#üŻ˘Çhîˇ7Ĺ ÝÜ?ĚR˛"Ł-ł*íxÎf'^$°¬Ç=,rĹ.f4Ş´żőĹAJI‘†gNÚ‹e5Š™źŠuá‚*S‰Ęô–XŠ’&Ô5R~¨|^N‘K!fçxKW‡<WbrµI%:ŻLőbe@f—Ľ3Ń*÷–G¬VŢ•ó`ŕ¸ĹđR’XY3ĚRá!íĽ{;ŠŁĚ_¬ŻUB1ö±Ű9oŠ3k{‚aćëü.vëq˘hÎV{ßź$¨±šó3Î÷P§ÜehUؤn+YEQ&îdĎvZ™V$@±-Ň't§'‹-źŃ‘˝c®ŘyŰžG~ž7ľÎTĎ«űďcýi,ëęíWŠyřL4é8ILÔĄz! &°‹ůíö–¬©p_Gw|ŚnI±háÔâC<Żvămc°§ŘX»‰hńšďŤµťaqň…p¨B0"|™Ŕ.×Âßům%Ż"·šĽ-@·)3WW ĹóĄűW|˛śˇQMë fŇăĄÜj8ľ‘YÓĆ˙ »(WWČ ¦©»őň¦ŻZĄôçĂÎÓTÎůN9%1Mî,Ă·™ŠĺJĹv¸QsÍ,\¤Ü×ńg"Í‚ĽäMբўĆüťp干cú‚ŇĎTÎ@w—Ťż¤üUBF»ŃI@`W$ú «f@ţËÔř[Š^w ‹84ĆČęŕ+˙đÜ“ÇźAÇ:4ń ös4‰ÂCµ sÚx\Ś,â¦bł-—. ĹLÂý© !Ľ]ĐÓŔD|krş4áůÜă×ÝóÂQÜä$źńŕŘňBxÔ-…ż˙c¶ NžĆŐ_«ŇšŤ7T] ŢZ–żSÄ „Ĺń× Q—]ĚÜ6 #ˇDăăá¨i?ŕ÷ ľ¦‰ZÚ*Îjńcąwş÷SJĐ$üĽŠr<śľN=jŕÓNÎúĆť”-H>SÎ&ęJÉ© Uř`{[ŕ\óCe"2ŕ›Ş/żejS!ĚůERĎcdŘF¶d›ŮŇńĄ{ĐôäČ°ü˝V—żÚś5ĚSžŻŚP´lĎŇú-ňćŽ7Ż+ÓőĂ'&ÚŐŰĐÓ]>HJéd>D­u"’kPüVĎa“łőúSčŁ~yóĆcęż©cŃ8®FhČÇ© µ¶')¤*GŰKá®ČĂéhŢzűÓĐUQ×+(áĘN2P·8©ż!őüĄţs»Đyf PYÝB‘ńriű~±wY>Šwˇ”Ż)ÁÄŹGžßŇĽ\˙«"Ó˘s›¸$1ŐUxčcW~µŘyĽ4UÜÁuĂń \ét)_VXv^ßU×k^ČŤ6N=-ń9 żgŮĽÚsů÷eŽ”ŞGIźŮzOî…żt_&f(†ňĂĺxű‹ ô6oĘŻ§Ť†Oˇś¤–Á}i™H¤c0 ą˝¬’ÎEHđKťŻ«‘_!°GŽô“Hq•Ý—Š&ţń 'đô6ŁÍ&ů̆ŰK^íŻ¶‡Ú@—΢˙žUŹĎşLýEů“Âě({kż‡<Ye5Řsđ9qç}Ěo„ť‹ŽŐéo,Q“-7|¬łôţúäGËŽ[źOHd ˛ĐŽÄř‡pqy”§Ű>ÖËőńĹľŔ:ë¦5Ąe ¶Ýó:t«î(Ú®©„žŠŐřd˙śn!:™FđfŰŰę„ôXqďÍCäďę¨ŰłŹĽf_`ňČ^¸yO­ľĎÚ«Đsł˘ýň‘sUľ„Ŷc.xP’ąc2{,%-¶yÝ7YđoţŕçĽý˝ÇöY#f,FÂľjo˸é/-Ö ršˇ$jtĹÝNŽě0ˇĆ[ţ§–ü¶yš5äţ‚ů ‰˙GŐѨMë*·ŃZĹBü‹á†•ôý·ąbr(Ix+ŁÉˇâ< !"ĽĄ´ˇÓ›Á,(Đ"urČX†d%B!G/ö~Ć4ęc–$ą50˙ž%Ł·xÇÉ/¬[Ő5ĽxUCEÉŽţA—NŐ`TB0h?ŤF$ŰůçÝ`xĆ2ăvÇ®-ŢĘdV„ĺ>]K!ĚAµ öJ°Á‰ ąk"Ĺ»ÚĐ_yŞ+=‚‰ś3ęqśD]ŐÁEŔâÁ&Á±›z=Ž‘ĎRżé˘Ńń)˛Č ¨\Ý«űňE@…ě‹qlô”ş†9éő|çtíĎ­¤ĹKý|ÄJĘŻLŚýL )ô®ÎÍŞ°Ý™áüĹb VĘ)Oô\Ă·č<ó‹iËX}sŃŢPOt—¨Ď~–µűs®eX‘Ş ëSɸlľ˙NŹŮßLJđLňăvßF]_5˛p‘ âÓQv:Ö-qĽa'ůA`,[ŕn«·úp†ĺmâ©XŚĽ4_ ń\á!ÄÂ2đőLQčrŔ(›ŕä®F󻡠üa[AoĹĂ{.¬Ť0`e—·ů(oű;¶}ĘgĎđňĄ‚Í3QG×ÍAĂeŠ Śi>Óő´i3tj>Čľţ®r¤Żxĺ˘Ö [Ë •ĐťZřś˝’¸ćŇhƆŔž+ťwyĂ)JW úŽ űß’,öŇđT&§_±ôt°¦éD˘ŔQa9ŢXd šŢW†rąš— ν[†ÓŞ& ®ŕ|vV¶ #¬ó>ş8’,fĘĹŃ^(HuŔîKs§•Ř·š Éx-Ăľ o>ĆhnËÁ7ëbŰŇĎ–6÷#١,PDÍf~ĺ;×âLW㍕%W‚˝=gg#c©Ąş[í×Ç“óܬ „eU«6šśä1ăGÁO$4h‡śGüi°QěŻéŁR¦6ęĘz3űř:‘‰%%„Kíú5h¦ź)˛Ů«çĽě#q2s,Ť5şŤ÷®wĎüüÜt»‹l»8Ł á˘%ńź1në˙¸oŐ|~ÍOŘěüŽŧsb=»ý–—`Ýy¦|N wĚfµ‡)‹ Ł§'ouý?Vm(ČŃŁ]KDX?Öb(˙Ż®µÉĺ+Ý?Ś#Ć}¸7ĺ€ŘWŕ÷Ţ%¤ćZbŠ—b 5˝ŞšÔDx ŽŃ9ö§ÁĆąč˝izש #€ţ%\÷ßu–}śůňËř ÷á×fĄ7íć& ¤çEŚ8źżîe SÍĆZöwmťČľh—QSM“ÁŮŚÎ Ţ„¸˛&îľÎa“K‚5¶jb¶€ó m{ři×DŁW„[$ĐâR =9%˙“H)TTĂęug+ó菦WEĂŤ~S«Ě´Śž®‡w‘[äµńć Ň~†˛J%l˘« ’KőąÎËQˇ ŞXa©~¸o}®­µţO– ”mçA«ľ÷ň’'©‡?É×óbíÖWGš–N“áíí„jź‡$ëlWăd܇ŁŕŮ=˝Ţxł8xŐ;{€8nô^=5Ś?‚yĄ  :ő Ť:1çˇÓ­kî<Ňé]7„ę§Vn„Ě 9e+ä'Âżü_ĚZÝőËÜŚ\ŐćÇ­lbxÎÖńĺ(ácö#2s´Lk×Ó^ů­ÝlÎiaÂ3Š–tľŽé ŤéWâÇA›v÷¤âÉ»?Ő;-ílÄŻPÇęň§ńhsçţ˛[ŤwĽy‡>%áqŃ_ᨩů_"ëh“(mL N©Yú+‡˘5Eë§&Ztuöçdô›¨(tĆxf"CMÉčŁď¦<.:—“„Ő8!“$q´Ţ6Ź@„żŃďňč®ű•¦7ÔůľÁčfŠÁµĆU=Ąn«ßo%XÉÍ°49-ősÔµ'K˘NĄcĐN&‘h~¤g—F“Hhźľh›ÉW4NŽNAńŕŮWĽ‹»ńä 1 Ů"JÍ=ĺ&2ŃćĺˇŇŃ'z­m‡—ĘJ´‡ČôřN @á/ě8·¬čvgt˝¬«H,"ÉŢ-'NĹś„^ĄHĄßŇoŹ˘ä)H[ĺvÖí—˝3ÁŠd^máDů$ÜbN–ÖÖ…B¸lßC{?ŤŢPyŁEeněĺâu Zç´|3®ŢŢ0ŃS‚}â,ýOWçUzh­9Řc_‹ó<ÚBžSxl/­Źaý­ü5š`XĂ-:5q @]>8íŇĂZ5úvĎ^OJbµÎ¨ţvyc˝t0•ÉÎQK0˛’ňIrj?KŤŻ1ŰKî„ž­3Úőł>±6ď INüČOCô‘ţ¶gW÷öŹ!•V(ɧA5’0ľ|6ŔÓCďqË6˘ŚĐ”ČAţ&bŠOgjвí?ĹŁ#KćŰčÓ! MX őÜZxµČME¨0GmPXś¶íŮďâň“S^‡ ˝µ/ľ"đţhř5b&G1cLµrŇŽ…¶†KśŘWÍ)·ŘKÖ‰k“•7 ¶ěv¶ŤKńKřTÝw^}uSáÝÖa†Pé­aď4Űeý]—~zçŮě A'ccâ*«C›¦_Î÷ÁOX2/ăhCn¬=ćďűe‚ŞÝŻŤşĽ L=č%čÓŚJšľ+ń!IŽ9¬ŰŃž˙Š­;VěČë­v—Z@X3Ü׎ű IM” Ă!A°łÂ/ő´dÇ%˛z-”–îľßX€iC™Ą‰ żd1zűĂ!ŃloË|’· őWÇX˛b±żš¬OˇŚ}ďÁŇz]‹rf‚ÚęBFĽ±00¸Ö´ŢÚĂŐŔiŮux\keĎP^ý`Źň–˙ëÂGDG\Łîľß{„ąŻ8¶ě— Ą#:CaYžŤ 1›: Z2‰r Ë>'{·Ń„$Owˇ¸GtŢUĂ—ţ“JÔ•I!ôŢ ˝J隶µt†Ă™ăšiä!ź\}/]O=¨Ź–ÍÎ.\°’Fö?Ňł"¦čú¬â¬~8…zđÄşˇQ¤Źź ä—qŢL¶o+'FT¬6:wUĐźűŞč(őÇ[Łďdµ u>„EGĐ%űmny—ݲŞLýŹ^â”OCÓqÍ~ ,‚1Č—´¤<śÇ4”lýŃ´ ÍĄŕĂĹ®ů˝}Š‹ŕĚgZ™S1[±¦üJţoá±ŃVi‰6űÓHňDř>uˇ7jŃ^5\ş9 3)Ł3ń{ĎÖ'ł—]ńe†:+ąöz–iNóYąÍĹź¨Ĺf’"mőŢ[ÂŢř Á?lE_‚>’ÂǦŽrnöbë&µß°ź6żý<0ö6µcg—ł7ŔsyÉű<€&l5üQb Ě©3.š…Ómýąłuc˙Qy ËZäŽD˝‡ŰJÔtľ~op-ŢĚń“\’ jŰ2ŞęĄ6ýÖ.‡iű%°íT©¶ÜÜ4ąą®×ćVůy¤ŁÖČđ~)qŤ¨4‰0âč9qŕK@ź%­ IoĆ›0貣^ev_¸{-+ŞNň¸O¬"?Đ‚¶C?5Ąă\čK6sxH"=ÄEţŚd¦ăk,¦\‹éŃcĽÂC&ň *qU ”3EK'č&*m ŃÜцćrĚ6m·ú{­ő>Ǹ€¶ŞR˙é5qĘ:ěe€ŐżÍ[]ÇqÔ[XD ¨ÁwŐĂÁě*tiůě’™ »¦/WئB )MľďQ ´ä1-ę­ÉT[ý˛ V®×·e Ł–UŹ@’>rńřtĽl«Zľâ,ľŃŘş'@óšQ\@ŹQ‚Ţ)ÁÖN:7:Łď8LIě8Á=ézóyŔ ű$Z“šŘjËżç©Rš;ańŐN,{É‘9p‰ří 3=óöŢ%łbŮ]Ëśśj)îăk\-žŞńÎĄŐ Uß;ÍU¦]bő4éM‘¬5hWK˙8 Â·q'Í÷KMĂ¾n©°U,Łńşł4·ŰŕîSÜáÜ ńí °dCe"f“«a ´j;D9la ‰düa“«ńoú”ýݧ÷¸ňűěKüRfČ Ňî*ň 4ŻóFQŠ<ć9ąŔß1şď*Ő űŚ+KÖčO/R÷™#IXĽ*n¸¬Hmz›_­H®kĆ÷ß;†ónÝ”é’SŘď‚Qh{ţŁ­–ö’^éö1Z!’ó%4ńíZv— «Ţ8F˛ŞĽ§FexDűEg_ŤŢD5ĄÉŘëśvqi"~çl­{e’R ý-%37ŇůĄó‘xĂh 7Ůýî"ĘdfŠ%.Áĺeˇ?ën…PVżßëi»ś‰)rQă@4ń}üw¤É˙ ę6·-ĐÄ"ö"~:ůéúS«tÉ1ÂoŇöa¶¶`ή~âÂŽ6áöąćs|đ€ĄMďŔśüDżj§‰t ÇôX—׏uó{yĄ¬ „>¬ŹÍ® ŚSh_`QĘţđ»qĂń\˝¦‹=¸$ŔéwçÜĺj±ŹEŢě®rQĹ´gąó[Ěgý “"ĂE:] đ¶ŻĂp^ŕ0ૻ-Md(ť` Ú8‚oÄ\ĺj)Dɱ3őĘÇŐÝč¨Q’Bîf綦˛5ÝÍ—Ęf3yxŹ~|–źW#B!Iyůš ŁËhLB^N¦ËÂäŕŇ\ďŁfgó>ßĚÉ•0÷x‚őcX[ÁyÇÎXÍäp—6ăpő2pu?‰ĹQu´fÔËň«‚['-\'Íxĺ•ČĐÄüM €_¨Őźë 5đ´…$K¶ž\‚/ô/'Ëv9éžĺ6EăYľBČ@pÖ°«1–ütK&`â$Čđ6¨‰J¨ÄdňřvąŘźÇ/×YSŞŕ^eŽewŹxŰ*űIÄ?'Ö_źčöńlEĽ! ¨ň.T~ç?E§(eÎ$3…KÉPĺ÷6ßÂ>ş3Ę!omŐ§ä;@ý\˝%Ů‘ŁT‘ó_ĂÖb@kŁKPőa¬şąyu^’’·R_díIyň–@\†Šw¦/1Y¸¶z‹ X‹Ě@gsď¶SíčŞTk?éą—{Şě›@ó^™FoRg\DÓVâK‘Ki-ÖžEŽľ¬ßąźÝ+kÁĺ|†r´W(¬Ů4tăO˛,×!EřslĚ@qĚ%ŻÄµ0=› ˛ËĘkpút„ŕ:P¤4úŁ°"8htg!‰%¦L4ŐefşŃ`ę)5†ľ”ç§w­wgQÓ¨o;ę+Os˙2¦äÉĹÍ´YgɤM«ßs#µü„65Ϭđ3ţŇB| gś? 멸łÄöjŽţuúX æ3śP¶•Gý!O˙ňąo=m|fĚôzŹîˇ»–hđčŘű ¸iŘ4¦ă¸„żKۡŢÍü{ůąőěçt¦a§±}ť óm,B§_Ĺ˙źCßJç•ÍźB°|őĄúż4ę ábä¶OŃ"׆ ])jďáđ-őx´D*&č]©çĚŢ%)‡égEröhsn§ă(yF›ůtŮÇÍ<&¤vFźŃŁKŐ-]X+«ŕźG•Ś‰°Ó6Ďä,,ůÁŁgďň”hXĆÄ…93B7ôo ţ¤8K.Ź!&´¶ě¤0±"‹ĄÖx{¶Kłb!MYĹ7ěüᚆb"˱í_X®¦†oßŔ€Ţť¸:¨í Dí ŰMh,čk‚ËhíJđČkĘżaHŁÁďWćQ—ý¶”ş§ů5ÍĐ{ü iŐE‡rz űKÇ/VŃâ ?j‰&–ë]edj"ŢčőŁőgů ĐSŮMd«ĐsľU˙š¤”‹«zsŃťă…b8BN6ĹÂ˙t4úźňÂľÎ(÷Ä…WL}؝¥[Öˇűw{ÁüeV°WfÚH‡ŘŮíă^w± Z]ű Ë„bߢňÓę¸k»ëŐµ!”ľwIzXĚ sŮWމyµ]zç—÷\%łÂâ}ç7Ż'ţ¨`2ĹRśő„>®?P(^©ŽĘ'ÂvÁ~˙˘I© ®ťŁ•ý¨/ Ąmî{Ż+– ?Ľ*JOT†ž­ŽTg˛R!ţ»r«RŘ„P°DXŘ_žĺŢ,Ŕ¸Č¸qöŘÝEĚ%DIĄ?`ôşf>-JňÁ¦R'eO©Uż›M ý> ‹ŞcĘJ¬LťÄB˛ ~«ÝxŽś¬ĐđR`[y¬r§őˇĐb¬‹•®’ĺqLmNÖćc 'ÇţJAĺX„Ă·"âŘí»0äËÚţh¨?}}lĚávă4h„¶¸•|·É‚˙ç(Ňłáú5~ýĽ]Ąă5ď*ęP8'DBj]z ¨Wˇ‚˘T.÷¨<ß4űŽé·Ý›€ţ~Aűą6ÜŢ!g-ßÄĚÖîĺd®'ÁŤPâń†ë–ľůxIŃ$kVJşă˛ć:kŃoJŕăDŞ1¸â7ˇ°Č˘ă —ă]ń——ď;?w1ôĂă$=ďă`ď˘7{¬r1Ń[i‚1Ť>ÄÔA÷Rť»fF%Ju *75€Łž˝’ÚťˇÜýĐ|Y.RéĚtWqOíř8ů7I\dş‰^M™ËiË%ţ›§•Ľ€·Źßŕ¬ag) 1ţj™Dâ­ůsĚu˝¤ŐŮ(śBŘŽ†C ÇĆwtpEŹÓ2(—ޤa>®—Ź4öBŹˇ˘†áÁËçŔDµť#Čäŕ•Őşę ”7X€YJx÷FYČŁÄ7clŔ{ęd@Éa)âŹ{×Đ0\Ł=_O‚Ľb•FŻsőŚ„iŞg´rŤú»łÉ9ţOµÇ®}Ö €]xSÜcO$łt¦Y‘ !,翶L@óUWtâ´BG‡©StťeýľY%AgëÜż™X%ň“áĘgş»ůő/˙­˙»ŃF†’Â9b®¶âĂ·Ç—í˙i‡`őkťkC8ĆŐMg/_dóńâî1úÍłK[µýŕ%ľˇf¶alTĎůĺŢ,ŚݱoBC!ë¤nOx§ żśŐ==–µH'śnňęĎ^ĎőE OoÄ-‡źkO; Q""rOÓ…Ŕ.á9 g|ć’¨ăRóť,ˇim:Âłýwuu Ý!ł‰EăyŚ¨sRÓÝđSJ©îóbg3QŘë­n—#¦Đă“ýĘ/±i´é—­r3zS@I+˛Ä§LŞg¦üF¸Ý÷Y˝çˇoŰď]‘)™úęN.-ÂQw{ BÝ;ę¨J‰vôJ2r¦·ŕ#Bžť$Łť®ćŚCS%‘Ě\Y/[Éçî2ÍŞ^@ďČRo˛ňvĽ×äŰ·ö34oŰę˙Qâzvä¸Űxrü¬{´Ĺ„• śˇśľČ`áçîř>ÇÁ‹ęíÂdOÍ\‚ @“MĐ+– Q?u¬ŮWČŮş÷DŢ37 á$ÇNş,ü뮡 O.7M,-ËŔŮüc â‘xäőCmB§ąS÷¬fţĹ[Ôsж˙Wż`Ť#_6®¬^ť¦mý~¬ŁGiŘ͇|yg¤n/MÚÝOüL~rŢL~ń° 2Ą¬Á3^®.J«áŮ á]«ĂÇţE˛ú;ŰdÚ®ďo XwF;Ś[ä‹ŤČ>8¦ĎESŮ÷PĽ•lnťĘ@=X±ŔÁcÍŤ”ĹŮtů`)ĐÉňą;©ÔÁŞLlš0™WOQĹ›„íz R1®§â/sPϧŁ¦˛ÄČ@D™!-ůŐ´ZJňö¸Óń&*˝Â« 3Ă­ă#š e4—Yt$ł›.9¶€â[řĄŢ9W-‘ p° _vńË4ďŻ4,1Ťcď;Ům˛5[f¶Çh.›ŘiWđI1őűí‹Ţ|ŹĚŤ9I}f.\™tň_„îŽÂł…B6‚4ăíëqFČţi0Ľ(ŤK9®UýFł…J6éÔ­_“jüÚ°Xś§ś:«Ą&zńőöý7î‹Bž˙<ďu˝Ś‰Ś:ź5‰I䏵@}§÷ŽqeśÁýTCߢŁ|­Č.-×:ú iČňłšAŕdÜż|ȉ ‹Ňecjŕ‚gÝŰg×%ȡë&µ·É˝Řîć' ůÜŢ ˇD©ŕËϦŻzoŮń‰lÁn¸ĂvČ9ôźŃŁö%»ígw .Nj©Ý§čY˛ç LĂË5Ps‰ÇÓĂB2čś\$+ż˙ Ž ů5ź©đ4ĐŞ±0|†‡_ÝÓ߇}±\m8C®+‡oöŐYM]Ŕ,Ä8‡Ř‰śyE˝‰é{{U.E[v[mŐ[‡ş±Äń{G›»tP.o°B6[Á°ľFń¬·r±R°Ţ†Jyőý”^äň·đŽŤ>TaűčGÉëInĆysĽzFtŻÁ«Ř§÷ Ďë5g˛c1ŚżŁ¸8ZńŘć.Ău[™ Y ˘OŰ–I´â?°8xKĂp/Ĺç€1WęĚ•ďĄ3µňdâ\_Ô¬VŢ~QĽi—Z]®?„ŠŹfF±ŁwË{_íë›ĺyhKš‹JȤtĆK¬'‡ňTZ®žÇuŞ:P'pŃrŇZ–ěnľőÔ& €6 due®‰ź[úŮ®Ë]ۤÇńG… 䎌ôb>ꦞE}ôźómÔ_“sľç°F¬í©Ç–âŤđŇU$©Ă}»fµô*»PŰ\u˘SHÂŤ)J@3ćqú­ââŔ€Řńązt— lýjYŞýî¤yöÍ'Ük2vŇ`č˙_‹Îd.9ůÖŚ~×a1”?¦%ĂĐr×4Ź»x¤mU _kÇ\nh] ™vĚ„€Ë>ş¸EňŠ„4óÉT1ŮJ˝ …řÔňh¬úb ĹĂëîz‹j±­Ô ćŃŞ8Ën/Á+(P®b¨lŘ)'öť~k­ďÂeµEsĽc3‡+˘ż®ÉalwW ÔjX&Îz4rě!âŕ…ÝŹ»¬ô–ńXŤRĚÉĎđ{-­z!''\ŽôĚźôĹ©‰6•t ďÓ §]â/Ľ2×,ÜU®Ş¶Î;++<ŰŢhŚ{hŁü¤0¬s‘PđĂmgţe9ĽÓ=ż ¦TLyżć%ôšgŻĚ˛É?1gÜŘ$Č-ÍPPuńŤÇ0ŕ;d‘{k@„KG¨ŽÖŠnnČ łĽ7 JaÖ˙ż8čI”?3`Uhaš~{ĘksQ®:í|M˘ä˘źÇýÚ‹ęŢ Ezş°˛nď­ę*dbQ¬RŰ=¸ÉíjOšÝjŽÖ¸ÔJkí9ĐFúBa{'MTľŞO¨&@™Ŕ¨GÖ äK|Ą'LRߢwčf“ĚAŠhvć ŁŤ¶+@Ôn&`őÝM­ ĎşäëZó_Jéf4®vł{T6ń1żľvéŇ#LŞ˘íOĘkSŠoŚě«Ď8Ć‚ą˘ł U… ¤đ”Á'މPr‹ÚK‚éîÚcZľĘĐI+ĘĽ˘™OČŔł ă=ÇHíKRíŘküěÁ™Ç*5®¬éݨĽç%wŔŞě&eÚzSč|Pc$<5˘n‹Íĺ;©ÉÚÉś®Ďóí?TD±sˇĐŠ]•,äLű+ýíÂt‡+Ü7Úѡ9 ¸l‡ €řďT+1śeí§ĽÇOłzżVÚr{6a»“÷†ĚňŘyÉ,xŰv0ÂYňÔe™`‡ ýŁ‹&Ą$0Âç@r˝ÝŚŇ"Ł)±żS1Żřü ;íućűËßňîĽo‰6źč&úôÓ_P[&^Č=C3މI j}C›T¸ř 9•‰ ⪶MĚJ]ČíÚĎ(u¨µŕúţâ5]Ŕr<úĎÖ“őĐEŃ ůT¶ç!‘p7x'k"?¶Ľ ˘WKä}ţîfߪęxéo®4'l’BĄó!AM‡/žĎ˙ž őąŮŮ&ÇçlŁ—ö‚­*}MYîňË„ŞĽ’…Ćź·#ü§řib*ź÷‡¤%aŮÝެ€J?ë%o»ë2á¤{µ‘…-toLňŰa‰ňE"„q'¨`cÜň {€«‚˘JsÇ5ńÚ‘Ŕ±Ł,/t#[Ą6fupdq·ÚąÄ~OčI‚·ĐtFÍSqÝGAă‘xË&í]Ťĺ[č‚ÖÖ2—Ž…"ÇőłżĚ|QśĆJČÝîő1{%şőéĚ%Ě W"ĎŽâ2X^O¤¬K˛eĄhĺ,9ŮL‹H‡M™ŻÎ¤e*7Pe-0őéź<ÉDŔĚĄŢHăŹQ(Ţq2MË3C–pH¶ĺď¬óCÍy!ĐPPoy0?“ŚęŰŚă5BŔÂÜŻ+„5›(˝<'ą‘Âôɶë ÚMť.ů L6éâV$ô7‚Ń\eĐÓémŰý"s˙á ČŤJΠ{{óŢ–bŻaZŰwß‹ —BŇé óÔó7(ĚLĹí)ÔŚ"lg1†¨‡¨=KtšťŹňîmë:`®´áVŮâw%;:ĺ2Eě¶cÎJu ÇČóY0 &D&·ąĎf´SIg&'xaëÝ\˛±ÓŐśoV’5*sPL+Ýšđ5{ÚŃĚÜ'ň72–s›=§ŁG1)Rż!w=˙XRx ieâss&×{+ČTDűä‚îB˝{Mqx–HupčŻqv±[i‚›S­iÚ=üŤ¤VŘĐyµNTďŁ5Ú_F´É;´¶Ĺąií±±űóTŞ˛¤’ë@ź‚AP6†÷ąC›„ÜÂ˙úňKđ`cň—0©jt ­o´H„< xÝšŤş'†ňĹĆ €ĄĹĄk1Ô_2ŚŽďWŢŰIęĚâ~žĚ‰ípˡŠ/t"ťˇ ÚUp™GŽíűB^6ů×Ĺ RB‚ Ćş˘ÔÝE«X=¦ÎŐC–›™ÝFűň7XrŁ5pˇ" wŻ˘öţü1ąřÓŤÚ3ßř µ]Š+Ťĺü­D­öÔ¦‹ţf†§v$hx6µŠ şŹEł#®żÇ_©y¶±Ý·ÍNĐ´ö ÄĚ*ďąŃ’¦Őăý˝uĺÉZ‚x÷Bë„Ü{~úLdZĆx6€BgćJÍëťěp·66’°®†Z˘ŰY2±ŕZţŇYLűě ¤6âË Ä\±;|Y5fş!ťć˝ŕŕöěÂuw«Ń•ëĚ53‚í)~šüŇĆ(ćÉ=¶wXá8m˝?{gDý5ÂH5®7cşĄ›*Őśń­dÖ5 Á=3ߢ¬'­ÉFGí“"UTRÓ{L-ĂäEAţł t„G ö73رľ“@÷+rÔf·ěďăd¤µČmr.ŻË./öŃŤ‘¦ď."©Bđhř“r˛äŠJ®{lb9#c×3Ęc˛qˉ”ŔŠGÜěÉ—ôqżÖ$ü<]âĺ–4GŇX0W1đsú, źU Ť˙[[r,7¬ŠćQŐ¦QŃŢ#{ý ¦AÖ:¨ŕĚ…{Pjĺ"2;QăŁÔÚ8?ŚÔ‚Ýy”_[– űI -í0ŤÝh€v =H+ć(j6ŠMţöét˛§ĚÓĹžpK®]ţ!KÜÁŹË ‹zč”Jb€#ŞY%/«ŠîŞPđ€ö{¨¬GŻ–ÇÔOâ¸Ă_^/ąŘyĄ7…„’Ô*u°–˘úŹD]G”ˇ‡Ć>ŽžˇAźôŘŞmkáżű°ú«‹š5âľmj_RDV—C.bŚ4W˛L žÜ!¨ E¬tâpăßďă°ô¬yA<ƵwĘČě˝ç%1Áóži’ń1U÷mZ|&őĽî˝Űs†J]SH‡Ďä¦đĐÔM\‚ďG]Á´®+ŻqDd_EđÎüüˇFŚ{Šęš,žBń2 1ERÂĹ7˛‘mĎ–«ľmŁč:Őę IČßĂ[n©ą°%EÇôńg}šÄăĂ·¶ÉČ˝3HuĺB—ĆďCFAúO=!d\˝h‹“§žc>µžI۲{bŁöÎW˘,o×Ń'Ň$xÖ>^ ĺ$C,§¤Uťq$ÖćQĘI78Ŕ7=ßĘxŞä˘c}Ž’L4UŕŰ7%—jŹ5¶·)ÓŽŇdC‹nT|Íd¸rˇÁ7.ŃćaxOb7±sę…Î`­ţĐKŽĘE’´ŕ/j2#ăuUX] µS Ť6Š÷řµI*đÎ Âüfuáo>PE0<äÇŚ>ÓÔőb‡Ň´ţkP1+§ZADI•Ă«’iç 7Fe¦ü\bmŇ ÔŇWż÷Ő˛¨"CzP…Ş<|Ř-.ÁD«©WC0TaĂ”źü6đĄ.µiĐ,žĘg x7&C`ąöކB>g1JłŰýç)¨ťP/ŘDĹIżi/ż]Ě«9Ś=„ý†í‰\cß%Ž†_«÷÷ŐŇâjÁ[‹a(»ýxEő}u4­}”żhQˇä˘ď¸R¦x›TĚPâ>Ďž`ŘqËÎ0\»ĂÂëüĎŁą~D…`{gtŚëH_3cźa,…Iěľ?‚QÉÓÄifF|ËÉşŮGÂ9LĺŃ„uQx*Ć §E“UŠ ż€>)&áăËO8CíXţâEĚ7ĽČ 03c6ż2?¸J1xłŹ[‘|•ßŕédOPh2h^°­ťmvřąL,-ň‰@Ď»‚%m˙ôŨ˘¨°4u{î<Á0jî°Ŕ®%Gą×z hmËŇ$qZE_TÜŘŽ÷uÎĆ»§:†Xý»‘ŰVÝí+Ă9™ŔÚZÝ.ZËuď¸6ůżĐ%Đlěýĺ6wő‰+[˵é)¨ńż–cnB‚XÇî& ÖĹźűŹhý€®\ů î*8ö0CşŚT;ëjŤ4|([Ŕě­˘QËx¸¶řÁő$Y"IAmŽi'–ŢóąÍ ÷IAVâúT‹2%€¨*&-29W“˝1űę1Býě-ÍűĆ’ŐUú®y¦đJ—±»ň&ĚşiŠ@—X[Ňü)¤ mŹ]H9hë›J îV 3V˙¸Şť¸Ĺ`6Á oąm\*Ě`ęZ%Ďň0ßxi—4ČiöŽąËg"„乼=I) Ł‡€É‚qF˘DnVa–‰-ë…˙ßĐʬŔ,†¶Xh3 gé>0ş»Q °SźMéÍż˛sÂ.-Ą/ZoHÎp;Guňş÷7Î,0…^–ŃĚ 0۱‡$Wa-$Úšĺü†üj]Ô®;ŻT°bÔ–^°…¶{=Şm^¶˝.3 JĂĂ—hŁ¬,ohłĺ:˛»4¤’@9ŇĂ1¤ĄdţˇĽÇIoÉ •”Ý0‹(Z k>âZşáŽĂňŇŘÇ đ»;ÜÁŹđš¨¬ĎÍ—nvŤę­şÓózřŚń–üŘčyŐků¦s ĎŰ^SiďUłNEd´ U*XŻ2äJŮT´A#{ç”pÔ2Ž]Eâ™âËGgdq Ş&¸y„Sµ[Ż9 ěd.N.+őeŁŽ?ţ«”ďÄŘÎ~#dk(ĽÉݲş9°X{Ě•i¨ ęq•E/ÇĚUÝ=•tDM.c dWż|,ěłńŹ8”ľüÉň1’:seň†řwŮâ,Ť)¨‘»Ť†@Q…Ůî|+yTú´%f„Xáá#ÂxŰ6˘9Ŕ÷¬jh8G*íŰ“ŻŰě‰/…Ž?×R˙ßtŔ9…3ĆÝeÄ–‰Şóy´čŐ6ĄŢ§óÓ¦‡+a#RÚm˘đÇgĐn üöÄPF…Y[¶×Ĺ٨´›ŔÇA fťË¨:łp´@EýŐ,];űQýH¨dH'p>Đ2mčd–EEűšďšáB.ŚşŮjclµ÷Ú©żóîK!˙Ľ:(ç·&ŐzÍ}5˛ŐŻk0Żź$rí(páĂČĺ˙»¸?2ąlśŢžĎ-3oá÷â,d’śťTŞŠGĹ—Íç—MŐ‡©Żaa şÁ°üjüµ:v®âěŚě˝2äÇpË{rđůpŢ`w%ce¨˝igń'~ţ¸ŠŞ(…°˝ş Ź°Ľ•@V›x=Ňĺ„…Ëčb4’wĎ 4±Ň†ş_ěFę%÷‹XŁË'9 ö9:ďđńŁÍĎO÷Üş’iá/Ń+‘D{4Ť‡fn}Kˇř _ŢŘQ:9O¤ţG®hŔúÉŚ ™1$ÝďýíŞ cŠ#ŕë§d KHŃŐ/µ˝ŰŠĂ‘˝q/Ö;ÖČX€ŁŞ ;î ,ÄíE$iÝ€>$‡›§Sg,z'¤~{Mđ­VńŤ«ÎÇÝ ŘÖ{·Ź_Úů·µž8 š<<ĎőI%çG[LŞQZn9†dże· %…ůC eu&ÚőŰe‰F•Î˛Ę0eŐŵSpƱÖčB) I諸7úĽ„W:±Ž,`ý"«ŐߧPÜrâ…웶'Űôj,|+CŻŠ;ąîd¬BSÔvřhÔ`güÇFČ4ůň-Ő%aCrbfĄ·˘ăˇóýÇ’ë°¬=KîYMuôoɦܗx¤3ŁÎsý¦Ż·ónáłőĐéŔćľ' 5lľJ#'ŤZ¤ á2É*ďĹCę€TyŔ”ő˘Ő‰lF:Ü‘1D)…7Ł$G©Z}Uש<ąé.ydh<ľ%'ĺń8ň%řK¨¬®÷m/#í5|:ŰŐç['·ŰŢ|ćÂöv´™WP»*Ęú4őŮd >aŢ}Ë_ÜEü›g”Î8Ź |PÝ8Á‰ĎQ…OŻK}ÜŁt>‡+Ź”ŻIŻň»ţěęYĂ°Ë|˙4® ‡čĐĚú™·XN äăź]ëĘYQP0?¶ťłQoĆ,0‘k$R||'Ěż•6É]”B:ÎŘxFé±ü‘XŐ- ™oę[†;ĄaĹůtEfs¨ĄšüělA2?Ěřm%Ľ‹r\÷ír0igä1Őű9x=¬<ú˛EÝŚ'<ŞĺNŹ c‘ŐŘ‚ľ‚YoČh(É×ĂŕÔ^UČĆa†Kĺׄ·]ČŠĐ[gˇ™¨gř.ˇ2”UMźÍ(bE Őh٦¸‹UŚGˇ‹bśr˛ěčöŚµ 2ÍűÔń¤xŃŃC8*A YŐP śf[ę˘Î™2Ť¨cmD)ěÇLÖ‘ŘbŢř˙ČD÷1˙ŰÄzíc®ˇäîkQ$§j`‚Ś ý}—JAŁv0¶9»MÂůČ_ł\^Ý#$”Aí‰ćVÜw: ´ŘŁP˝†+o’Ö'+TF‚¶]ŇP¤dϬX™¦RôXb!iy¨&FoŮHuŚ3® ,ěX¦°Ľí‘t'}®üÔŇČ×Çćőş1‹Uą">¤lţ°^÷űŔ˙űwľŽ<çI• Ş}AMoę:–{ůÇŰTČ‚hŰŞťĺÎâ[Úó‚ żR<ň잦"ýíkíî¶zzľ#5SŢĄŹYĚÚzťyĦ*Ť°‘¨QiZÁĐTŚ~űŞ˝˙Bđ&=Eôű¤ 8ýŻĎĺ'2áQ˝ÚF´Ł[nlş+dţ©µ:Qű[BFŃSŽ8>Öˇ Ů7WÓľü®q•žFކçźęťfŇ„鄆÷ 3ž¤‘©aĺŠüŁš“x9spgĽ'Ô×}&öĺHię_ ˙JT}6ô­ÜÄ=OŰű„ś6Ó ëW±\–}Á Ä‹‘Ă…h)˛K5ň>i+ă1m1; ]Řб‡~jŁç n1‚ŐVd›Á˘0ű®3'Űű…ĽPŐĄÎđs« ÉuIHž’°L‰âS~¶qEíX_M‚Ćö~.o˘ ˝G"‰˙!ęßI–|Ąţ´«éĂ[%2µâ˝¨ĐáX"+KáéuĆ%fşx6źX%pWJŔ ATĆj?#]Ćú2¶lZôţ¬ňâ?&”oÁµutLŹ Í ťĽ»ę´ŻkÇ;uKCC¦¶˝vĺę\5®Rç¶GĆduC„`ś=˛űĄ bzÜäťdĎ6týęőqlď B¬\z™ŰŤŽÄ•€Ü=ř˝l—3>®ŕô˘ĂÂÝ ‡Ĺ*ëŁ79 úŇ%ηņۍÜ0nF [˙Ż5ŕëŰ\= ¤ĚŽrűeŠěT3â+¦ur¦j·ü„ŠČ:|O.)Ü:R›rÉ­Ĺav«L{k˛g˛˛Y“nyWËö Ď• ĚG›}ę¶Gmô>Žb óňŁ^‰űŹ‡?’¶rŰ­ˇ äm~úĄu9'ÍAzŃB%ÍÇp(Y•ĄĺD˛%˛Űď‰Úw đ¦Ta,đz ä8ąripíW_ůyŐ öţM˘4(1>f­ţîí0ĚlÁM®šď1U ‚qł~“ĄĂ1Č –)äS™ăŞ[ŚŻue>ť™KĽ_ąÔ©0Ç´ŃDô şŠŁHˇť|@ÖUHí• ÇůË VÉűž˝i|7“Ýd3çęÇĚ]Ľ9~U¤´ônß<UŮ?dĄ† ł´B¸á˙ýy60d .ţÜĆߢ¨YŹË6çę<4ÔË}%í §«í,*'ZđŰ˝G€XŐ!­Şr”űí¬]ŔĆđ•;aŕ˛KJ†e/lW•V˘ćłŚp~ůŁÝěÓ^źŕ­Ű»…]ü(>3Sa»+ĐŁ’ҦIZ2Ƕ ĄÁó}/ęBĺ°Č¬:SťâěZ˛†'‡6Żš Ç°Çźë14Q©ĺŔăĆĽS®"oô˘_Ůčˇ_s_I=‡§Ë†Łą‚¸žă{FĐbÂKÓGd›š˛ŠBěů·˝ÖWŁ1$bËD®RZµë€«%”ĽăEVX\ČŐ&w" i˙ćź„k ´ŕULÉ2ś‘¬îy/ľ4NŤ”ŻĹÍĆ ¸¬Lîą˝D’bgáĄig P¬Ä9Ü–dzd°ń†ě°ŐZ6čJ.ŽAÎ9ŽŐÔƬ#ŃŚ“}Ęk“ëýřě€ÎĂ>l nűâŤXpŮĂÉ…THAAł;L‘\•kĂŃ•ÜŇ79Ä‹żń °™ŮÇ,şF_–1ŁîNʶú¨ű ˙§*9pé­\|ß4Ŕ ěMĄRöŠľe=MäĎ–Z„· Ăťđ:ĽĂ Ź`…žŞdvĘ„™ä·%ÖlŠŇôČszöŕšĂµ¬XŠ ťŁ¸ÇÉ€Ký” 2U˛% <į塇,"Ęý˛ŔÂm0pl4@`B ¦Ç»lĎůsjNŠMăeU9xpÂÂŤĺ\<Đ"ţĺvŁóť đ94µń´j&ńYJď("żşbĆxŃ‹Y>#0e±™÷ętÔúăÎő·@ŁfĹ®+ţeÔeE'32 é»&k™oh2¶}©Úq™hhëŤĐ•,#Ť]I달ŕÔ’ ôßëâŤ6Ä:-ů§Ł)!V­ÍW$»ăč[qx Ě$/5JMŃK.86›´Ćť©ąl™éŚ„¶bEh’䛩ş 5´Ć;;Vá •MFHˇXo$Ě8ó6µDg’»Ô–ËnľőeÔ)34ľł‡ć©ä ú(·a›sŤBŰ' Rť†Źöő#˘ÇşĄAV‰÷ćÁ×(ŤŞW—4;–9ib<DtÜĺ„Ięíy/'Ĺ–6ŻX–¨čsĎ|źˇqč'ň5ŠqSĹ<®“oţ@U¶<,ĐŠ±×‚Ů˙ruZufBŔĚĐçѦľŤŘ~ř q°l.Gö:âc^n—ű€> <ŁŻ8©í 5rî4 Ç·bëy=]ÁlĎéš!&ŽÔä–pÇ»uđ,®ă.í"‡xWŐ«FG—.‚ËŐůéKzî˝(+™Ť}óňľ9yS–łĽVŔâ‘qśĹCa+­ <GĘn›żot†Ď™ł_ ˝FxŔŇą¨•‘Î~äüČOú ź 9áC`™®a­(Qdž•mY˛ćZ8_QˇDHĽl+ŕ2ŻĎŮ+uÇÉ`—Jđ*!žnÂ6őcĹäH ˇ%ZĆDőČ{˛ Ú<Ť o´ăµs‹©¦ůÍĹŻŕ0ŃIäˇmTôBxÍÉ  Ż6Bă.ŻÖŁ&Vöŕahś–±ď[·Š¶°ĺ¨ßc˘wyÚ”EnµŤÍ˛Ż2‘ ś¬!í©ď|k ú|á\ßĎTAR¨ĘGą'PźFöŢwąŚoóއdN’yË mP& őóßIe÷ ŘĚHÄlżR=Ť.EHc8ĹZ©CEŽYUą3 s€’5a}ÂLa±F¬mŕĘöŁŇˇpş*)Í]¬<8€AçńS¶ýgÜ{–3‹xŮ\˙Ý`;Sa/’t´·‰Ç–ăpdŻ‰Č­#‰ŕ®Ň§ĹJ.꣩!“`Ó’ľ{ůEQä·˘µä#—zm*Ą{Ă' ú¨s«gÓ}r8| >”˙HĄ­óŢŘĽ¬.}š=yë@Ľ¦ßČýMőnĄv&”tçäcĐvd¨ úuÚŐ[~ĘůU8 1Ů8*”łčM70ë;ףTăÁ°p/2n¬¤ ­ôîxÓ ŕÔh)>çv_mű`‚µ治ťnBNxś×¦0Ť4ˇţ^Ž' Ýčç×ăÜăSáÍÁ‹QX=x ĺö%řλ˛Ë\Ě34%‚öţ~jCOB2ą­ć(U!ĎŮjŁaĐaš#çú ¦WiRq‡ v/hW¦ŽšQxĄř·˙iĹKâ˙2`ęűMoBf‰Ýzuhęřŕü^.ÓĐwçĐúéQxĽuÜ [+$J=ëą›Ś×öţ$ĺÁI|Ď}łăKŔÇxňşę-dqÓâĂĺěÜ}ť.@FSωj3‰˛~´53žxŰĽݧ¨I»Ô§Lľ0”ťq;i9’Ęś’#POëD#ř¦ç´ý^FłS" |qßĚ-ŃĚXůů¸c¬Ő©ő™;FG˙zpşŘ5=p™®äĘă.ÔP.1˙ ČC ůH2ü3I'Ă ŠťóřP†>~x" ’~:9yUŤ/1Ě+n3­î íqäöčŇj"ÉŔY–›ńÝ ’p^Ă4Vţç(Č×Ym!Y)o«ôßÝIÄa ç'—”Ŕ—_0¨’ÓŇ©)ŇZ@53q6JŇ´ćÓIľś:›Ćż÷ ‹Ť>W_‰®dĺ E.í%x`¤ěU?ßĂ3áŠ!.»XŃ´ÓąĽe©ŹZ § 9ď—‘ "…TR€fŢeĹjEş—üPrŕó÷$Th/›‰#Ě/„n]cNk4‡ P‰Jb~íŢ $í؆łT!żOXúuvő%!űŽRŚÄüłK”ťĽTŚ“N‹*aË ¸.1ëSfÉůŐçćŔĽUě_Żó$ŮŚo±p?Î ˇ(oÔĺ렅 íh˘oz˘Ó!ýj±Ť"1yvIFeN†=ĄGň-řÎ}<NŽŃ‰µ![äp˘Ü‡z˝VűÄ´ĺ¬Ät÷żKÝ'zŐ–€–öŽJ]ETĆŔ«á|Ŕ)2VHhj]˛ĘHtůî &· rH€AőîťűRdĚ´ë¶1aăţÚ<öŇ Cf¬ČÚ)s”í„AL.1Ź“LrvŘ™%›ső5HdÍ<S‰áBűë°R …r%ŞŁ N|NuµÚĐł4©›Ż`ZÁ3Á˛’]·?cćZňäWÍPk“)ÁáŁŕ>Ź6ś©Ě´ßS§€CO“žż"Ĺ~ŐKťq†UßÝü”ĂDhuůł•ôĹ=ůĽúËÇĘlG(`"˙‡ß…9PÝňĚT-oŇ *:áßLçăţMP7ńDi S9$=~¸‡’*锫jU-`SűPbÔ<ÔÍ“p×6ĘvöšČúĄ÷0pçSęWŐŻążwxŁ×Á&úŃ ×+•ö)ć5ú¦C7fű©®z/,÷˛÷úů˝“Ęl›%UÖ˝~Eež¶O°üĆ^şŻ{ńË•[t\Âţi´Uę ¬—‹oiM.SŔľ,ç˛äŔ®•ý[R”‘ńÓčâG†$R©č&F¨ŤTXť¦L-ĐćkG±ąbÁ-ÄBrKőé B¨ä—8(7§~…K4[?¬ˇS欷;§ĂźĆöEĄ˙2ăĵŞń[ˇô’µŻ v;Đăr7śWâß•§{_iÇÜ9Í­%îâc_vŕuwŇ-ĚđMp§‰»9e\Ź]ŘeülFK¸čŮźrňËżÜ×ű‚YËwÉAt‡m“éČŮb;ŕ Z/YŁt˙! ˇgć‹F٨T§’•’˙oJx4ÖöŇŹĚ™Ŕ¸´V5üłÖ•d8ᬛŢĘ`#{"o WĹŞUË×gP{Š«>|0¦ű?A5¸ZSŐS%GCs˛ć×lyWüz[¨Ž™ëńßúŠ††{ˇ`esľ ¨;¤nńlöăżŇĺw Ţ;ŠL=› ±ŽŐ”kRŚßz<”\ţřĚrłwů 6®Č+¨ő•¸‹gŐi˘»čç{±Ů÷tAľZŔă»ĺżVŰ·»Y0'}úOž}ýPÖ!” ÷»ţ<$RxîÜcľ3g¸ŕ*‹ńhÁŮ^áX¦ëĂcOŚ/oë$?ą)UVĎíc˛A§xČĎRof0ŽôNň8ź úú]Ľîš(›â7ŔňŠŕA0‘­ŰwîMü9äÚľą­}˙źďąĂ_z)RvŘfrFÓËCŕ}]ë|!ă†çyü¸ł đô_,°mâZ@;JZ~ 9V3_ĽCIő;Ę„ú l™ŁkY€6ś6&ŚqP†·Đ®™źěĹHŕŚ"¸8+,ĄÚŔuEň.Ź‡Ř(W¬oĐ™y®¨wüřż‰!d’6Źl%ţ.˙gŢ:TL"rqX©č¬+‘Ćléş˙¶śŰΙŤˇË°ő^ŚŻŠëwjôUŕ“}ZĆeŁ‚ëČ—ź%ŕŐ˛ü[ßĺď†Ýˇˇ¶ Űx«ÖŚo}|ĄđÔüŔ҉Ńü©˘ŞµLßQRdqšu­tđP¶Ô,Ńs§źřfÔăc•ś®—€nŘE1\c ŮŤźF]Š|"ZĐŞk­Ő Ű‚č•%b)c Ř䱾š‡Ň çă«MÂĚíbQ‘şŻŔ‰čďJ)AŻRvB)•m]G`jEŤďY¤˝*6Ť®®Šé|w®QäŐ´?.G˝ŤZ`vđL…D/Cžˇ¤iş0l”Źş4Şî `ÚĹdd°ß«čĐHĎ4{ “‰ţ…ËyüA…Ý”q6¶Ľ ›)Ý©})%mU öŠąŢĆâń϶fQ§d=~ű ńĎŞéUY1řA0/KŁĂéKÖ–ůŠŞ‰µůńéśŢĂŕ2wߑ͡çt›»>–íśmm$rLÔŮŤ:Ę*˝řX6›ę3°V”ö«ˇeĘTj^ßjuUÚĄ<VľÇἻŃĚĽŕÎ^mçw·»g™î‰ESJőÇH›¤ĆXÔlÝ?®ćk>ąďŁ[\á÷ím¤.@ő#D2I71›<![™•JĐB{:ť•ľh˝Éi·jňM䆓kńoŕ@n_•1Dý0®KhÝĐ8ÚŘ ä©[ý#ÁL7Ä|_4Üi­üĂ™ ‚/Ě’k~y&Pűú¤“ÖĽ ‹ů†g ˛“AR ‚#Â÷SćfÍÝf0ô|.°tZo›NÔ!Žz%ŞĹÝęźIw»­[phU÷ĎJĘXYô¨¤şˇPoD 0s,0ÍąŰ9Ą0j‹%f_śy+¤}Ćü/e=GÉlő¦¶t?Ŕ™Z6"Ű”žNćÝV\e=Kľ‹Y˛‹Xnš×˝h\â«®Řâ:K8¶MžűcÇ༧éë„;š"”:÷Ö¸Ŕ¦Óc_mMŹq‰VÎĎɤv›7Ąša˛¶±vâf)Ć›o5Ρ z!,ľ± l«(Ý?´°ă,“qđÔë<É1ź™ŻD(¦ťů«“âµŮłu;G|<?V÷eGs†q­. .gÜ„…Âq’ߔٗHC-ënZmÓ˝ßĂ%‰ –śÝT†\)¬›ŰťĆĐ{c¸”ĂÜW×YfĚ'Ü懭qµOŔBÄ@Ţ+rőĂ ¦gď1ÓXJm9Äę7Äx&ë¶P1Ń“ăęřG?ů´Ŕ^ô¨÷BónäŔlS[`ľ˝±f‰úg"×;Uâ»c‰˛‚2iU,ŐĘTŽąŔ”ŇxóŘűµ†ŁĂWŁ)ôWĄĽ [˘‹‹*đF5 ďT/M¨™#őeTé×Ě#–lÚ÷«Úqgłúǡꔽ"ś¶;ŃíRŕ]$ŹxüK-ŞĐUO‰o—©<ěáÖŤýţź$ždĹr\m÷tö•›N°%zł›ú -2ŐÖÝNÓŃL×,Tăeb5öXĘÝGť'gDDXËÔ<Ç9cüζąX:ćâ2­Ş‹ą6Ţ«á—+q[¦VŔšĚ†G1ŮOÔ^‚ UfTź>ąsüĚN’â7O›°ŕíau éŇ÷čźé/íN‰\®*™¬*© ÔOtes¨ *z‚˝U1›Éť ­Řd0-˛Ú~ ÂrüPf,“âŚî©Ş±I¨ĽĐŮZęt­=ă ßcíLD‹Đ”-<ţúţĽŰBO‡=¦CĐ@”áéŔcľ{Öv’ęYrG"ń_5úË řŠŽ·1ô8zÖ±eFë “˘%'…—gN•Đ§łlY`”É$…™ĽçańIžRw©Ä n ]ĘÔ”” Íí®ct t[ĎĐÍ3‘FSČčq.ä3p‹“R¸HÄĐč :ˇq É©«ăQ9ă°p~é˝2«›âžá{ x˝i$šqs¨ŁF—^iXtčR1ĺ×Ô b¨Tý ĹXä‚ě´ó­’µ)ˇŃܦ4$ső©˙şĆmň_J1”BT8†3; Çńb% V~×1¦Ĺłô1F_ĘďÍŃ}E»9Â;#¦ő*”î%?‹±Ű…ůä´y™KC˙ÖťwV6x:-ŐĽ%±,ď@íTOr36Đ›;®LžÄ«´µ'KËÚvöŇA…ôTZĐŢI±lFČĂŐÍQ˛mľŤaLłŔ¤ ömk‹ŢË’7» FC‰R Q1Jm±µw— 2ôś—±aâ_JżQ5ö˘âďgnĂCQOŔaŇ*„đďB”)ĎĐ­ui˙Ö¶ĄÇ@Zg ęć«qöaÎFH  Ŕť®đúŕ÷˛V,ę“j[Ąü—łĆŔËLó7Ć®‘GŁógč×ń´ RnĘéŃ0Űô^čŁ.(Í|4çĐÖăă 䣼”ůIÔŐv”Ťă3‹ćăČhq×936ą sa\ĽRc›á|z'ąŐ~F?|‘”çz ĺ ţ†Ń] !4xX˙Í•QŽ{—Ýk^'Ą§ú9€Ö/_“D1ŚŐ] ™GK$Iíx¨úČßSbxe-F4űígXĺ‹>Ęd°B¬Kv*f«Ŕ]ĹŲ^žĐŃ0šEqSN$Ô Í:9űż w»ÔvvP ţTNƆAx÷ůBX˙ßV|Md“pÄ'YtT9ŮÇ|ŻnčĄĐqB'Ń‚=ń¤6}äĹ"Q|˛^É÷-ÓöľH¨kvűžRď-R;ç"ą—LÝ.Ś1ćó ú&µ|ťÖÓKž ¶ – ţbi›„Ob`¬…·§GPÁ/,\«8Íőş©c9Ć6e“18ŁŃ!ŃU®ő}v)T–z2Ó;pq© *Ş$6#ĺřhŮ×iâńČÉţ!˙ďÜxĘ{Ň _©xŽü›ńÎĹZuöďŃVĘüť ŃfPżhIÉSiM”ęéoW=čĚĺÂŁ¶ÉnaKIş2žAËŽs-˘ýUr3•ńm1|‡Á«uó>iźŚ+ ǢW‰ŽSĚ^őó «ń˝í8ő'Y´ËP“… š[¦›­źë(I%YĐťÇüRË —î¦)¶đfĂׇł•«?Ó±Ndç#ąHQâ\g§[K„Ç˙×ysšÜ¬żŁŐ“H‚ĐBMęXť>Ëi/i(RöšZ{Oă„ *é€/·‰RŁrď‚ľ‹{t63ŐĐMÖÂJĘCĎŹĆĐ$¬i)^˝^ś`¨QFä|zs’ĐŕÜŹ!Ďí żł&đçN秞ťqU¬?ő¬ÓˇDXŠqTbIč/ßo¶DҶôvdŁdpXčí˝q~śŠ\ÎŢt*’\ ţJÚŞwÖ^¸DEL4 Ńřłc,ˇ0sň\Ü-ľŹ6% ß·:VkÚeđ°Ěü]ęI l5ś{T瀆ĐüŐ©¸Ęş¬@4ת0[XUNr#ţ‰4iµ2€íYş·Â™äjś°·J…P¬ŹˇÄÝíEw®ľµÄĎ°Ô–ź†"ć˙ůMŁt¦Ł]ř҆ ‡$K(Q›¬h} żľ‹Q%tˇÎÉś ͤ˘Â¤ĘDóĆ‹”`ăęĹj‚>Š6j©ÓŰťfXĎFVlçYŮÖiA×;­,|uEbó¦Hž«K$o@9ŽőšÉ73îh™Ë×-ÜXňÍ­íçÝé ¤ ­  @Â,9ľAúú čĆ”KĚíQě4J8"˛o¸Ď•¸2mV(#ߪ9jv ÝÍs†"‡ëş j’'Cz#·”Ă<ňťçŹş°y·Ů3ö_żYrŁ)zF:É~¸ĚŹĐřňżő”ăÓ!Ć«ÖIaô]çG¦ŇÎ/”b2ĺ3ăÁśë1«0*ąójŔ$B‹ő#Ý;÷ TŃ˝1eWY÷PŤ¨“#¸Ó&®Ď§Ŕă8ľĘÉ.hC>ţB‰Ş2â׌ŕ9—l+F=ëÔšÇ?Î:™ŔĚ {ńíjBFĆH Űś——R"ťĹ†ÜŘZF?–áěˇ\_>˘¨¤đN%ôňýŚĐˇ4‚î{!ý[”cŠlĽřźHF4DËq'kˇ•ş!­o4ˆJľˇ\aµďé¬ö‹fłqµum’t ^­č"«,0!y †iNűŽ ÚďšjOťGÂB9)†§¸µeŘiyŻÍÇÂŤź ü± ř„7JŠ˛ýˇĚř+jř˙«íx4k™şVß'z[[vąýč|ÇŰŤc‘%;„hM÷QŻ-ďţSA2Ź6`v*j ŰqÜáĚ i§Ľ­2Ç đŞĹ€•ŇU}źH©Ü*@),‚+(ś łá±Ô?pĂ|F\Ż ‚K™Îk) {VŁĹgu_ŢwpŘ‚Ôj Ś6ĆFr4=bŤ íP;AőP7HĐW:ë˙x"`-\~¸ĺ¤Ač4˝éŠK•qyUďѬr,¬Oj“ĂËG!“kë¶ËĄÓ>ď’ÝUĆXzÓ–D¦ăBÉ7ŤîČ‹”$y˝ô){.ď˛:ž?§o~Pn` sÉ˙YµýűQ=CDX¶7¨G'FÁÚ_{f˝'đνňŻpwTlČÉ 63ěą@-yŢŇa¤„YRüç@y›Ž4ńĄMx) Úk»?-Š)ĄĎfÉňŐĽ›,ţ0k•–´ůÎĐ?Up´•Ätž‡Éý˝ĺn‹ŁŢńż\ĺ4Ż•ěźő9có˙ÚgÍ<ö ˝nŐ´KŔ&+µ)Âa±q>ůR:ćZö_±ŔvĎ× :žâ›Úď":pĹ]Ř ,4‰Ăi˝ đezüţß‚±ŠťŹ± [ cü56|ľ[đţű4ňHüö×çŔ#•"\ý}Ýĺ“Ü_äúőŹýQ":‹ćm|kĺČUż)“,ĺ,©al:†µ$ľ`=T6ńHĚßÔůˇ}eŢUµ3Đ  îA-|^Ç8ĺt¸ˇ°ÎS±)q:`"1ŇľWź?«•a*‚ńÍ)Ú|\ĆmVfŇ ÓŚÖF3a®áßůĺú^Ű7s„âhő|4V8“ľřNlEŞŞ5!h‘I% }7ň8:?Aăżî%—aÍî‘kH’zŇ M¶î’úz&ç—÷CSTývqđÓŁç{Ř<¸dˇ,zťá©•6KÚ“Ę\ĐN˙uÔz ŕ’qóŃĽ~f—ł«^ZK­eăęŰëżzÉŤ™¦Âvg‚´VT_o2ŮĽˇ„‰©ôCu†˘kfPĽ×˛\?oěé r¬%ńĆTň< ~˘~·íŞ2§“í^äAża=Gcé‰~’kŚ/’÷±ĘŁˇ’hUjúô6ωÓ.YÔha@5ş–1 ]Č1—V5'ńdJ5ÝŮĺ/gěŞ9˙Š˙ůŘ;ĢEsJ§,¸¦Ż"€Ú~ŕ—?°ŕý!~ÂWI÷ÇŚ:ž{A»yr7W_ČÍľ<4µD§řvčt@D„ˇy¨ąň„`«ĄŹ¸JKőSô.ĺzĄâ­S„Ú9¸tËV즗ĹĂçßşşo^  ş¸i@ ÄKz9˝lŰžűŚöµ¶‘Q«8éhźâ¸M iLlĹÇ•Sş°??ĄíČ C<Ŕ…@żuˇéî—Ňśô§3NzQ;¬u7UY>đą›H×ŐŇâ~eqČTL$J‰•%ŠçqzÓż‘óâęJo-[Ť áĎąťşyĘŐy¬TqĚŹj[ČYa5p„ß0A  ÔÔN.ę…ć JŁM5źúX—ć_JČ5 C4†IňKq®Çâŕ ÓOJ€G\HŮży’©H [„÷gתšĂ/‡™1ś˘aË܆Gąđó&š6|Aę©5ĺŻMuř4h•Ý™KHÍU5ź˝‡|Űß_DM«ăŃŹwm®&ĹX€®ůfóë\ HĘ»÷@‘ÓłnÂť]M¨»VËqă’ţÁÖ7«Šüúö˝­÷׸ç˛`.@â•V)Ü_”ĆWx¦ÜČ0(ń‚+&öOwsLaăȦňŕćtŞB9Č÷K$úÝ+,%w|˘,@fuŠ#ŹÓŢDzĎúQ??NeץĐ'+еěDnT‚{˘4““ŤB<˘UED}fťx#ĚśEcZ©·$č­Ŕz V) K÷8řógO9v@ńAc ËL×·5LLćř®ä>úvîźÍěłXVÜo©¸¬fy–)J,óŃőč÷č~ä ó—[ý­‘z5D®ýŐ»µßÔe+ŻôžŮÚGťA‰UŕWŤ¬=ůPńÔrČfŽ­;BéřIA‹`hUkŘ2›Ç¶3ťŻß’Z NĆ úfYaą)®ÔůÇ…P”^kÄŚB¸oć/çs‡źˇGRę¦` Ě‚´,.B*"qZŢĘÜm/X©Ćş‚/LVËÓĄĚ]Łł«zś÷‡FĽŤŁĆĐNw;Ű.~Ě’]”¶UQŻŠżőţW É•xüîR9"úč˘ä?ĺa“07‘ŰäÝĐi°&™Ĺ12¨ŐjĚ ˙ˇ…T@µŻÇ…cřę‰ei{˘)üř¤dëmANË:D¨ĘłéŇŔŁČŕÁ5§Ęf@:›w‡ş^{—Ę“§× Z˘Űlń:ç“őěťZĺˇg?ČEűFŢtßVFňÜ;üߧG´PĘ{cͤ•Á=!΋ýű„ÔâäÁ4ň¨™G/^jkWŰźV>"ý§­/= ůćÂă©,V®)Yl„¸ÍŃ•)î¨ŰĚ’.bhą@E;č~t CgN?Q6ŃšŹ¬ŚtV2·ëjłxë‚Ŕť˘ß.äĘÇ:ËérGĐU‹ÝQ1¤w«Ŕľ{ E‘z¦ŘžCĘj<ú°Ä 1›^nBµMéײĎďŇîW[ź-–ˇ§)^«“ůµ;8m¤§hĂ“ŞY.ô–ůŠ¤áę?oJJ`z€m„Š1\h´=śh¨ßş7Ľ¦Š¸±żö QčąĂ=ď»M' Ţ“».^9Ç/Ô;ň^ŕů•ż!6âÎÂsV=Ą:j/îx¦Ú]±íąĘ HÍ5.0;ôLćYôy*™·y<­µ‰{r Wµˇm˲ľy‹ ÜŞ.ŞňđGć!‚ę!$ŻaR!;ÄÍé( Í˝ňskZŰjÎiĺJ;vţ˛‡X µjůvéđó‘ąIqş ŔIU-**uK¤çž®0F‰ăŘRwô˛î~Hßyú†‹¦w]Ť, I&Ö{—rŚ:…!G„ęĄ0S±űťfOëNŰ’ű ŃŘĺf®JžGÇţrKÍĹMČ/ż .eöÜ “Š„Rßłe‰JB—OuK†ÉĽPŻóAŰEŕU››Ă5¡őO!Ů„94ÚASČmĹ•Ě%ˇg$c×ě#ąŕŮGÖ˝ńÝŁBŞ8C{Ďĺ(Ld”§]ÎĽĐ&z¦óP{ĂęÔítŐÚ¨ÓŚdĂ/ řë/®Q®8s*‹Î‚śNJ5Rn/†‹y¨ëŚľyőË_Őď3%âŢqç§]yBĘâhr cĎ‘eu™Ó;˘pĹr{”,٨ŚżŹë$ŁmđäńŹÝ<®đJŔY¸‰QۆšÇ Ń‹Aý4[ˇ ČłA6;Ő“cl¦„KÚ•Ş$ŢH ^ë<Md®áyv‰/l„Ö•|‘°µ*ó«Ĺ"ůí;ƌ̵ŰÚĺŽëPďk<;—ú+é†ě˙áCR ăK˝űů§í¤n¨#<<µşöŰ„8§łČdĐцG~ącŘ)\¬(ÔpBĹŮďĚi¶…9éPLĄą}°ˇ@% mlţh™ëť»2ďl˙8ŽŔHµą&€ĎÝöĐ Î=˝L¦Âhô^D,S¶0h0đtě „nǵRŁRóś7Čň˝ ĹkšúďRă+·|Q·ÇX¶˘=ć·Súń5ś‡ÎbsCľ|’«ýzÖ-ďÚžôÎ3|Tm•ÁŘĽxA$`//N—ck&ÓZAĘ4„FČůu&ëĎ )ćVk>{çş7#Ś±fîŠĐżÄĎô{ł÷fŽśkPý¬í„xz±cvöTžŔp*uú ë%‹€;µ!PşâĆ}( 󱹷{ŰVŔż±Ô.ńž~r˝?ŇťOp°řÝÄ©Ô` OÚŽ„Ą…´háş0Hë˙ĺŚaő„ śa_źú™+opégćŤ,“+ÍĂŰpO÷ě•đKBš2˛m€—ĆĐü–`Z˛TÎ7Ńco¸Ńýż4Ď$Ĺ"ÖĎy˛¤iÔAs\¬Âč‰6±ąh.3KĹ®1háQˇČŻąb[Ŕ›ĎCŠę“S™Z=q´âŰŃ­ËdFe*-ýŚ|ŇŘŰËŰK§ĺH«tőŇşcłRć2s Ąő?žµ=ÖµĹMôÓDŚ@©éRžËŇÜíeyN¤[Që(ŚĽßŰo’«!ö(51[“Aäj›_ś] `^j_ýî<`ËůîĄd(˘-ŻNĽ+‰+#čçîĺP%Ţősşĺf;®ËD‘6G×9y¤f˛ŞĂ#±†IÁ ŘnkB˘öşĄ‹ăвüć.±Ú­áük1żŐš”áFŁFWKTť‹k>ôA)ë+k6Ľ6Ç[Q0ľ‰ľHĚwŢŮĚă)FŇ/řÎTĹŠ…,¸s(!ŃQ vq°Ę)ÝńĂş>]l€sĄ ęZ­ś…¶´ĚB]|§ßý,'úK^ll°kű Wc–9¨­ż‰ńîńL6Ň‚6ő˙„ę2Xťs4E)mYđîäĹĆfxe,j^Śšć{ꂧ›Ş€jaŚülVĆ;hýĐk[4¸9s4Š ľ§HÁ==A$RKm’IÄŔŐÄݵîŕn‡ 7ÝAg!ŠěŢ÷-áşL%Ę2‰®ÖBBWú›ž­ćĂžÖČŃbĽŹ|…íoxq•É`řrŚ%´Ç§Ë<4ÄAĽ+Ř°?B01btî6Ą^zśd©¨ËĄ¨¬>¶¨ŠÓîČO1Ą kÍ+ój=ĆÂ@8ERł{yČLZ÷+:b>$8ĺ¦ď^čąvŔŻÔź ­ÔÁđ:,şŹX¸–xUȉAĄr]˙¸MáHÎł6N:(—飻÷:Ot–:iP_"¤ůŻĘ~ďqG„J:Üő~ý´ř GBĎî^öÜí˘ŃńQ{7xmöiŰ5 ďqâ äś±\1Ł –_KO®3°íČó¦ÔŮ-G]†Rţ¦0rą…•!}P?°4¸‚%CĘ’t‘Ĺmp‘PëvšÁm•°S;¨‚3°[ĺc§öŠ| ô¬lN±ś-n2°Sꮨ?ÓZRέZ{†“]ŻšĄz+0@vW‰W¤OŚ_Gš·Â¦uNwAŠŘş,ţ9ÁŹÜtyjJ–’ÂhÚ×n<ˇÍG·V?ಓëä”r;{t™éSŕ»ôp˛„ćřĹm¨˙Éź%쮀Ňf'(˛©ß¶ýËĆÖ}.¨ ”ÉŃů»¨şůŇrt:Ô$cÂH´q5ËT— -˝DťK^»”c?ş.;ąŰí’­ű›w ‰ć~ü—í"ă] sryÓ´UF@c–žG€ˇÍµŽ#cÝ–ŁŰ#"ŹĆžýˇřéËţ®ôi$_ H‚í}§gtűQťąłbóĹDŠ»›ëň©¦!vĂ‚w‹‡Dµ5ŕűDłď@P+Z7§ťQT8ĹƢńe1¸H>Ű:Y2k„×’ÔĆČOâîmŕşső·lŕĂÄńĚę?8ե뛪PNáM-ŤD}Gíl|Žs1ĚŤXétücMůüRBťvW1ÂA~tId "Ťű@,ż’łüSQŘB˛Á1h?%.gÚ™żĹzö0ô”ŮÔ­™·6yk7¦BK(ťq•XŇËÁŘâ¨S‘¨·©Űbčş™ĹŘźňölćŃ ^| ĄÁ_ígË·ů\`=žę:.Ť"YĚ…–đ[6qv„.˙ĺ ŽĆšÉAđŻ/˙”‡Ĺ®’fV ţW†7•ÎŔF˘\&¸7kYYccĄVŢ©nGŤ6˛ČÍÓ™€Ď˝7‹2K^Ţ$çŮlザ5ÄFv_ •ŞW6Î…Ť]°ÍzĄXż“çś˙ âü¸H)ه°‚Ć0łöýOé§$$ü¬Áž2ę8Ě+ÎE)·—VěÎ1$yę'árâ›J©‰ÖE¶*&ÄöŚ'<řE2“ "?Óv“/]×ÍGŞ™?ÜSرŮYţĘ 6,ěĄIń~gä\Š_9:ÎëBZcZöŚŻżQżŔ<˝¤¨íGθÇţÔŐŢN‰†*&®ĄaB•UXNH›Â€©7y¶¶JKŹlâ%ôŠh8µ—E±)Ń">|NćGďâYˇ7#ÁˇŕőĆ‘ ~9S ˇŻpH ÖüKH&AęËJěBC‘UŃ@B‰áĘÚádCSÄvöđd†Í‘u ĂďŔfśÓÖŁk«±KňĄčăŢ ‹ N .ôßxí ¶ ěĆâÜe°€ŚéAFwxčĎ)Î9r™9I8§˙€é|oÚť—Sńył1ÁřĄďČ;¨«× 3ľÔZ lŢ´ z´¤ą\g)ŁL~&ßđË0z‡ˇ uŘCăMAE `IezęçĽĎ$ö˝ zĚđÓńŃ„1ěnR(ŤŮ“÷˛Ô }3ŰZţU¬h÷F<"Vbü™– ŤÇmżłŐXBF‹ZÎIâe…Aćtů\Ł,80kJńܤ¬9őh (%lő,ëŞkx9‹wLľě˙°7˙ł–š,ě«8¬nJ˛‹ó ®#ËÚ%ął Ż}”içŻÄŞ’Ľß|µ\žąjäEXnĘí?Öçż×1zu´gŽ»’qG4±˘Ŕ–f‡ŮG*cíYsYóŞÜť4L‡Z0¤wĐáşŇG÷KŐ\Ů?MN[5מ‰©p?UżĎ”şŤJ”˛-85CČę ßlaĐb°÷Ľô;źŻô]‹|ěýTŃYKĄ¤P†cÓŮNĂ#Eű”Ť&OAŽW‘Mő­·}«íIyC¤Tň }άz”@•Â ^¸†íöx°Ô7rŹ”즢¸Ď^x ĆŚ4LJ&Â1 ‹˘@ű“śĹĽL›ÎëĐ(0N2´v0âÎ3©2­Čyš­ţŹ­6YEĄ}ö›–]t':!N‡Ţآ:jŃĘ)ŐżŠ9~Ů^ …Ď(ŠL)v'Ě^é)Úę°MĘpĂÄ° #:vP–Â+űµ—Ä-ľ ¶'mč•›¸,1cřuCůJ,×49'"HéBÖîíî|ŹŻ<ŮgU¨ôDňĚiąÉOű¬CP7äbĂ˝#Z^Ć'Î'čÜáÖîú†]žGTŔËżÚ“Ns†×Dµ_jc&ěĚŞMbčśPa}n®öW_ë2„yˇ]ףI_‚}mO ’¶t¤úľĆV TŰďc ˘®>˘Ą’¶[Ü[ďj.:DE"é›LjϲoŚ¨OÜ`®e‚·ščmáWŢ„ńťëN;bo±oĽED^+”S\RĘ.ő‚.*Óµ]—ŠöRr!aÝşŐ2ÉfŰ”ëT{ŁÚű}ł'ż×‰w2N—.ş9¬VTđ2y|®á8YśX FDďý¨Ş!'Ź˙kľ‘i¦Č’ŕR•HŢ`] źÎBś•pḫ7 ˝˘Ń#QĐXŇBž«0‚4Ćč ¨ťX$;pńA€|"Š´žŠď"t9NuĐ™ŔRt4BýŐ’2†_ €G®§čQ›Ţ…‡ŁwIn[‡Lţ^/Ë"=ĐÖhŔÂď 9´Ą«Ű7&ęCá›™‡ůośŻĹBQÉńˇ«ś^OY©ýŃ-ąHcĹZĂ%.ŇŽáŤé˘«ŕ«CZÜۇV;NhŽya6”Iă$7S(â94\2RĆÄ>ˇQ óĚÔô ŇôŻ'[v[;ŞÍDÇÓyÔvl貴éçYG(˝łt”µź¨]Bŕô’3ś¸±&) ŚB®żI\15^\Ťĺ ľţ®łĐqĽ‰wŻ’@/­L DWT7÷|RnüËĘwKRlŢ»´LŹşú†‘M•×ü^«©®MÍ–Ő¸[y .U/Ó·Ŕ'ĺ۵˝L-· ”kđ+Ĺ“Ńg@*K°M÷ýxFŞĽH{CĄD2[cŞ2ZÂ`S9@„Č•wYąi ń—®ćCnI:=›Ě¨X¬űó—T")ŁŔśĘ ŞZcđo5@”Öd¦TľCČ!öřT}[0ÂkBäĎűËÎoG-tÄ«Šs3DŕŚ¬ţĘH«t¶IţF"Ü`Ł*ŢĘ™­§•Ą¬ŕ&‹ť˝Ĺ%şr;ÁÜNK*TţŞďoI6¤ÂßśHÂ0X6Ę}Žwía”Ý)‰{D‹·ý«°¬Oř{´¨usŃŕĘ[Ł•Ĺ7<ćDMů+3­QéŔQ‹ żŤO_ü®[ŕuŤA;¤”‰ÄE˝ŕwź÷,Aő¶mű-,ĄžHbŞ aA1ălô?JgÄf;aí ­€g#ĽŰN[š6Ľ¬rFÇwÍO4Á)Ŭ©ůHC™öć±ZÝ`Sš;­¨[é'3Ëš" nf›]§I˛Wóët„ŹÎUĐy‡Ö7*ŰťÝ`öK`%.©6\¦ĺŤZk›R;];u¦űŁŘĘ´»Fg…Ô<ÖźÄW§H·f™•!” 2ůžĽ›e˛Ho ĺ"˘qŔęÔSâKŠGŕëY¶3Ů1p¬ˇ10ŤMK$ÁV‚•}˙Ľ Lß[E˘HÚŚŇX ĆăĎČŽ}ęWÂ…]uŽĂrî^ŮD/ő^3\ů°bŘź ę輠¦qE÷)»¦‰Î•yŠ÷¬ÂlhGé<çčdtÁůmQ sŽ`&öŐţ?\dgÁź`5éNęÖ@íŐ°\ TŠbFcíŽ5öŮۆ°?§?wJžhq<†ČGG†“E„Ěu™«ńoµZm5Ó şµfş\Ţ´íE–p¶ f2Ć&‹őGîf¸ \­áĹ–ÔNhÓ6;±‹ -ńLôË‹áD¨rPľó>?”ĘÄEĂ›)u‰–bO–Éłc§Í}]çp°s¶ś­-Úh…{Pü˙Ş1“ÄPţÉě}(Ă6~&é şśLĺąî002şk™â\ ~0QÓٸáâ*psiׇ•®VSdWś,›Ę· *A&9ԥ›=AńäČ&Ż­öŤŰ5Ő"`@9čńćŹDŮv“O•ű^Ąuôrţ$ĆŢý.†I<’ăňWĎ”ţžîŘÎQ ĺ ^=˛“˛wt‰Ô˘ňÜB.÷Y”t Më=Ű/ňń=qłË$Ł+)Ż<˙Úś­‰~y˙—€$júĹŚ[9Ôi¶v”““łťĂUŮkţř7Ć°7Q\”s Q˘ŕ˛“Óş˝)š—ĺ®íÇNĆŮ‘ myB®H·PóMčď{D7X…§X…ŤJ\¤ ‚!ÓÇÇĐ6¸$ł˙śÂÝ1 łČj(÷ÖhóH⥟¬_ĂĄ [BÎyá?a-Ž€äB—Xl^ľ)`nOu ŕ¬ű.-kGřÓv8gÁb7őŢŁťťěά3ë~Qą-<ď’á˙ęŢI’'ď2rß@0sc˝ éf-K,9pî®˙Ä?"µ=âIÓÖu5Ů /őűŁşĆŃü(sT˘x©m™°FJ&iÜ»§µç/ťž÷äĆ”ll†(íÍ&@SŚÉËSB46Př‚ŠBŚ`çĹÓbk“¬ {pV1'čuĂ2łKŚëęČžnz^€ęDkŢ.¸sĚj»¤ăo«şvwńĐ+QÁ‹â]WÎăs ‰"ĽxqD·EĘóöx,9,H k«–öńíó΄Ě,µEż}÷ iä/ˇc-Mő3żŠÇŠî-Ľ–ĽžŢtË ¤O±Ro”Ęśé—ä5¶›č4Ĺ_đ7^‡‰ţďÔ˝ë/l!-CY®ŰHšd©‡LĚ[ő˙ĽÚHaŁ…ŮťÎHŤ UőÎŐI‘ˢÔÍcÚń†C{AéS şű^ΆȂ4fgňŘÚ PĚ`†ÎÜß›rÎ&,ĺeF1 Ś-Ëž Šp:oĎÓˇ¬¸ŐRy Xö1…ąNí¶VmëÝEš <„WM„śPČ5^Í‚Ş_@RM[bŹT©+ÖTâˇňčĚ…âG†r&tC8,włˇ%錰,˘LŻÝľn®ĘoĐČ=…š$ˇÖ7]ăÂÄłÔčÇíŘ ćžWmKc? P·PNźĽË«tjBľ·su˙ç)1Dyr iÜ23š ě»qŮ Ô<ŽŰ‹x‚m= Č™”QL”Ö?óŚÓ1âů,†)¨¶! 9ĚĹ?ĘZř˘XC'PL¬ŚĎ0ÉqQŔ6č“VĽĚĺśÔ"ĎŢČn‘„q Ar+hĐşZ§ngo¤ŻřŘaľŢ«MiJóŞŘ8uCŤ=KňsgEF[&˙Ţt*§wÁmRol±%d¨H~É7}Hńđ"-zUMµsÎNuqĄ€7ŠůÍ!dŽ:7ĺÉ´őΑGO3?iŤ‰5e$ıkęĐ1<Ű Ťť,Ş>˧÷á—y S›÷UAŹĘű^L>í,9–Z6Đm”Íčö‘řy±#,•Ź°hĄß}bĺ”ԭE_‚’ŔŃOÓ©}ťĹŞU2çŰd5?:p<›ËS˙,˛ÉáŮśml×Ç}SĄĹ±6T©ôĹÝ«ŞŚB4Ź4äŕ†Ć¦'bôőĆÝ…qćtŐ%6B¶]ŠŞ2i;A<Ň’şŕ A`ţëm€qϵĽ¦ů0†–ŕŢÝ“äŞ ÷™#ÄóÖ ©ědOś[–Oś3}NUÇ‘…b×m¨ŽóLŰŁ‚µĄĄŹI‚™–·Ű)ĺ+yˇQľŕq3Ź—ç{a–â,_F Őb N·štŕĚ Q®&[! ĚŰźç;rSˇ¸byŇÔČ۶'Vů¤‚ë¬nu`Ż˛÷NüMű~µÔzęZŰŻś8&b-ô*¨*ýE?™•>­•”۵ zé™jMŚŻ˛‹,÷Ý[Ż~ř¦÷§TQ<^o2j¦SZo˛ ôŽ)Uť«Ż”sśÖeý˛ë$&}gb’ÔůÂĄ3‡é|_§j ĄçD¬G¤±X5Ç ^tôŕ;yO`ő-!cho8^L[ţçlĄž”—1ĐTZěčžý“]¦Ô[Â߬»‚¬×>LH˘ŇŤnÍlüJa,Ud™g´Ás Ç…ąTY#/´Ík<ş;ăm;RËë_|ü°^ßaâP©Şyýň\ě 3Żě„Ź^ˇ:amĘd&Żeo\%˘=cý“=Lő}5 „ ‹‘jŹwuLP6»(śĹütYCôÁeÄ. ‘BÎ\D"‚ł+Ą#sĆg•>îüjÚičqěeµéKYĺ7čm]ô  Úűg'Ü1Ôf„ą˛ëcă\`ů(Íoţá[&EyŰŘÓ:˝ §z›ö«¬"ÄżSDňŽ · NĐ+˝ŢÓŽíQ$‰čŻrĚ/ŐÜtdÉdôÁůŇAEĆ9ň•Ř â‡ÓJ®ov>¨‰>_Ŕ’OÚěĂz˘)XɵĹĚű*ś’Ě÷<­ÓHEđ#ç,Çe˛ň'1ÄźbtpńÜPO€ëŻ¨zÔ,ŕqł§+pí[HžÝ×Ä´Uůlz\°;­fůµČjCďO‰¤QʑᶉľSĆ(˙ÎôN&´Lüű}ű´ÚĽćv’3ÜÓőŞ ÓČ˝¨*ö`÷™Föq??pp}ý*IJ#ŠNײ…“ňą»YĄÝĚéDPA—+ü· >€ů5?őí—;ýqś‹S`RFţGľÝšß:˝od$Č[ҧŃčůĘ•ŘÎŘÎ)4Ź ŰéCÔÓĐXC$*Ăť¶FŽ4đ.Ó­ŚşÜ[Ű(]ţ{é§MŃgzc(±Ź˝)·Żq†k·a3ŢŠ|­”Á¸Ţ_ĺ㽟S…47>iˇ•fę¤hO(äk]´[\µÍŰ-@KĂ đÄ6h—łľh«ěöQÚxÔZÄŔĺĆ°Ął¦ŮÍĄbŹfP!Ëű#®Ý#ąîâ©a2*ÂKS/ź9:ÜîDe·ń ?%<{ý"łĹ«@­jQĂ7ŮT†âi?úSK×(şmUe†ÖuˇőĄŇÓ•¶Tç©—\† ręž‘Çměh ©Ż)·g«GYµD?d`Îë“vAńî‘vĚS›ękĺ˘%X‘ ±óňLÎď<:ű¨zţ‘OT”ýĂ۵ȋ\_K¬WJ­ÄŮÁ^ĎxĐŻˇžĄ:č?`m»ôĽIţ"j6‚as˘×Ç×YEč“ůĂśízÔ$ă M™í× Óp‡×„=¬†Ó:MXpŇŕ%L`ülęC±mĐvW®·ăóŇ#žLë»ŰN=Ę{Ă")¨ßžq˘!1yíÜ ",OxFR<.g57Š —mďVŇ)ŢUčÍS‰ktŹtÜšä›QZ6•^ĐQđĎI+Ö{2·üÇl°Q/ŽSŮPîĹuj± Ô]Äš·đJ1zĐ®í_újlÍ4} ¶|Äâď*ý˛ä}8Áy +JłzÔ•ŁŰ[W%nŐôśY(d0čL,…§ĄmŁl÷*Űߢţ»’ĽŘˇÓ âáÝ€zOúfVILG€f4ťö "LČcŚ. ypŐZyB‹J‡ą;ßä&ýxH9©™<Ł«+é’OIw㆜ĪÉĄĂŰ©Kw.íBµDˀ˷<˝“ŽKFS ů¦E€Ńś˙YŮ}Ł˝ěM–Z7 Üô 9VĚĺÁďbO±ŔĺéČ˝µS°‰ŕ]VÖ’‹lŞÄdkÖ $Ú®ÚÜmśą@^!EC,ů’Čot¤g¦Ţ!9fÄ(ş'µď{Pđď9ŻąÉ˙ĐLä pˇ+ óX5wIŰ=ŞŚČ{bÖÔcţRŘűçŘŃ,iő:ÁˇÎĹóF:óă#$ä•użI3™LCë—Ňő(%%›ď>ČS›żŮĆihdvö§7Öęqżmł“nŁţąI{űoV'uěßí‚ýĽ­›ÜŚ}EMĘ_7†,u:|k˙Ľo*LňË‘Avě‡Ţ•ż+ŃŔ[ę”ńŕŔ<®ëÉW@tÝ+®Ŕ-˘äŘôŕľn† 3z·U ÖK)´W–mSĂ/(äÁĘJWą… …¦ N¤Ź”r™g^9ňSŃ ˘GíCĆ#‚  ™`DúěŠäcĂ´ě?I}Ö«®V)ĆĚ'ßHÔ<ŇjCš˙‘ŕyudŞĆeŞń{·í(Gw=#(FŰÉŮ>q7saŔjߡ¨ŚÝ~卢Cc~¬kű·@sµ4U|r_Ó‡1Ô¶•v…=ˇ´uçąĐ9z¶Ń¦a¸'’0ž6ę×~+yŃ÷ţžjW«ë–Ü÷ô Ó •ď‘_™z&!‚ۉ©&Ňşćů6Ç|ć_/©Ň“j¨óýŁ‡2«:úÇ7¦Á@´îëN–Xd§§ty®GŚ'Ź˘Ut†™©pŚx•wkA"öW@„ţPÓ—†´Đ:&ę+íîšµ#m/Ö„…ąĂíĹűůz@ăw‚™UŢ á“ańV{Ęďn†?ç÷‘ź~UPÓű…(â\Ę ćÇ.u=§BD¨ĎËK |¸˙{¸Ń~^Q˝ĎŘs'ˇĄ"-†óCĺ/Ô…+řpÉŰŚ§•}*çQç$ ¨‘\˙iâfy)+®ďÚ,°^úŽĂĎHÓmŃzÁ猀Ľ˙iÍ—Ť®0ŕ†Ëµ7CŰvCŕń5§öĎmL| ”ń˙)˛#ÍIőŔ±žĎKu‚t;jk ÂŐbj‡Ť=‡Čw`ť¤»BÖLč’Žq°„<”Ď…j=(ʰ镢ŐĎăhH5g ů!¦x"żK‘Őć–żât*ľó@­5‹Ëëča_G´Š“j®*–ÇŢVćG“ĚŻkÓ k3ç|›Ä+BŘÄs†•óQ‹Á!Kŕ‡wnŠCÁN‡ ˝üSÎcGEdśü oç1Vţ˛ćS“.Ľk‚Oü\Ćî Q]éěôőĄm+PŮAolÝŮ!ÝSYN©z~–ý!z€$ °7ĂVwó·Đ?Ş ˛µnü7¦íˇ]5ä¦Á|X·ď&+hť7lÎ˙5á†\ŕłę!;_ ˙Ô 3©‡h[Šżra‚ŚN©w'ş‡ĚϦâ1¬ŹĐc ţO×ęJJ,ŐaŐ*Ąô°ɇÄqľ­V”=ą^‚hăwâ…A"ĽDČaue5Ő>}y ‹«qŰ&7e†-Ëł 0GLÁŠĂÄTÎrĹŐĺŕ«l3ÜńĹĐn’6˙°qU¶AhźTzŃ7 ŘşĆĚ”Îe…E˛…GÔü.3~w5E`)¨ Hщᱯ Uç–‹’V*y*”‚¦É!}>UéŠĐxŔT‚° 6ýŚď u}Ďá‚Ž;Î<ŽŠx"Fá1s­@@łl9J@l¦IÁ·¨ž=/»űI–{ďáŘL}ą^+$±ŹI—Yćo+§üöâYN32ěY ŢQ—âÄŤË2ő×/GÇňÔßíÇőv‘żĎßzĆđ-\Tx‚°"~:{9߯ĺýݱűLźByęš©xl˛¦q=•¸˙+->=GŠřüÇGɦŤY”ţŔPÔŃĽáę”›°Áť]39újúEĐ掤ąĽÉ/sĹ$Eřtć ŽN—Ľ5Şu; µ-ăńTöŽ˛öőÂ…ĄťĘY‡ĐĂü•ĂW)&ş<†ă‹ńŽ·ŽňćPç‹áđ˘qÉŕNáÓ˘ăöp |~¶…2<<Ă´¸ dÜ­Z‹Ő8’Æ Ną˛ân UozJĄµ˘CU+Ű÷ç¦ý˝T04ŰN ÎüąďdŕŹüŚ\ęIϵ&ű¨Ƈ^Ő}żÍţL¤ˇ!]śZ¸`ĎP¸ł˙.çbźń©čF—JKŹ…(7EşC$–‚AD¡[CúđéRKř˝bĘŮ'•Ł­çY0sEGČ°G«U•:°©ćm“6ńEťE‰*}«l,wĹÔ—†@ŽŚSξ܇xčAŞ[JË“Ú×2)Ĺľżi10›łdđ=¤73ęÇ—´Ő°Nó»|5|ËćąNH%zTď ;˙,E›¶Á™ ď‰âM3§´Ň1î3-‚ř4ćuĆM:Ç0HĂ$˙šŐ, 1dg©ú>̬“˛ĂÄx¨Ŕa:#°FÎVťď;v- DŘŕýĘ´‘­j6Ş6Á[(›atzÝÝććá…t€“B ŮřGąŤ1U:ąŮ‰ł˙^ĆjEâ uE«mK‘¬=XqgÔŚ1—éŃRIۢĆâ©ăŇ!i#lŁĹS·ĺ!RäĄ~ŠĄČyqäęhTŹÁŠěů®]ö=”띥)%/QŔŮŹl\P&ŤG ç—ĹŞÝçăčşĂ/q˛h(ů Ç`ŢB›w{‰­ąN`í:˘vŢnN Ţp|un©U Ě•‹X 1vvŇVlťôQ+Ę'UzŔpçh(ďÁřÎiž×–ĂĽÓNv«;@´-&ŐĂś5Ťí rúˇ#MÉć‡Ö*3›«/“j”×ţŹ^ŘĚxŠĘ;iŞ› €Ľ%üÄL{UŰŚçí”ß0÷ÓK-·"Iüő‹g22\&`i°a.ÓEuâ&]¬ ›˙ő…«w<¤ŔXV#?OŰBg Gf÷•nöĄň©Lă˘cµ)˛¦<ŹU ˝c«ŹźĎ_Âź ÚFsFŻV*'4âüȡ5)Ë'šÓ42]“űsl&ŢŽńŹă Đ@ąnd濆"ťp ®¶‘ˇîF“®lđG â5¬7«é/ü˛NÚ‘Nű¸îręz_<®'Űńq̵ó§2c>ďt‚¤!ôď“ÉÄŽ%×÷ÝřlőřF[P˙ řé&˛S…›W>^Cńů=­Ž*©?Ťý°>ÝÜ‹ZűŇ;R™67"Ý–IÁ¨á+«ë†0G x`{ŰŢsE^"d·=şs.ňRĆJY0ml—w5ĄW˘RĎśî—@Át®&<’8-dY¸żď}ä (ÉtĐĹ´Nˇ=9Ö«üŢ‘mĂżşďq=ŃŽbŮoĆb¶d ¸*F˘şąsÝŞĐС( ů(±ŮS_‰’ž…`W"MüÝ:h޵iëßoŽżč QafOŠ§2zD߶Y§•UýiKµ ÖÇÄăéjöѨÉg‘ĹUŹębaäő-d*–;]ÁźT,yTs(‡r'ź៊? ©aÍ”ął/H´ZhĐ´ŕŻ_Ôýgů[Ř%{B®E ßߤ/žýMBédz›nçóbyIXťbÄĎHšűtWŹPâ©á÷Sj“ĆÉď›*WŢ-ˇ‘˙ x;uKÜxoîţÁÖĎa†ă^nHziĆž¸ŇßX™Ł§?oŕ›Ń2 yôÜĐ U „?ćŰ&ÁµľîŘŞŰĆ—Ĺ­NyÖŮ@·tŘçč}Ă-†Ű&4ŽžľČ6źđs®ľ(Č»&a lt VĄ`ę5˝>f»Ű@9ÉŽWĐ“P3Näµ;^ż–lôĄ©üsKv_·Żţ R-×G‡úG’(1Â*:2‰«SŔ’*  Ľ`9ŕőÝ•ˇő÷íkµERŻ¤±qČ= ®°ętTëb#vĂ檱''.BíE+„ŁŢĺÝčD¶RÇńaépŮqŠAĎÍpě]F®’xZHŔ&Ě5ř™5yE—×8ęĹ:7.˝qä5íBÓäT!΂tęlb”Ţ.ë äťUŐHŕpqôcżłŃPˇŘGůótp´F^ŹöO†ën[\ŮëdlşlrěÍň˝şQç—Ź_µÝ;âkě)Śů'Ző®‰1Ćr–›üşą“ů ÇÝĎĘxô«ž‘A$-#ä‚ľ-é $ń7řôűŻâk€NŕŐ!Q(NÍ)Ą•®5?WOżŔ 8˛L)ŽőjTĎŕŽ(č”ZÓ^¨Ó(>ëp‡ł‰ ·bĄ_e?ÎţNâ¤Y0ŘXÖÍ…Ď%nęś7eüĄ˘ůźYeďl]¤4UĽ—ÚĄĄ8ß;"†#ÄşGⲜ…XÚ8Śż'˝ô¬ßč*‹čNK.ďŘďkčŕBĎÖ|%ř…wăAO™Áa9ŐĎö=«°şF)1˘_ö8±e¨“«pR-J˝ű€)@XvĘĆýô>ź‘ :ą^jáY3#¬m¶áZŇ°ťŔôąĽ)â~šÁ(†[Ůâ UŁŮĚ(Ä›Xwŕ ¨(t»<0}ez]ˇŠrúőż‚s4ÉV€oś˙T§8G‡@%lŐÄéÄ–s§M ŽEo€'Ď×*<„ŇkËĂh…-›*H*@ÖgruFłžˇ¦%Ż1nC:­ţšHËH‘qĂ|Ą8oŚFŕ äü}ĐđۨĦ6ůr˙-Ń~tš`„] HyQoŰ”b ¸#›ąCw^·ńŠI]žPŽŕ1ú‚Žď>ę`â …<Ëŕ* Űß×/*bÔŤ${펾ÁtËľ†ů §’¶ŁŠ {0şű! (™Ś&Eµ_1}îÚÜłT’HaWÖđך…Ruµ"jí0t˙ţÇ„v)$h 7µŚÄOBćlJ;f8ŞoŽĚ©pŘiĘ$y;ˇ»Ľ GÉ«ÚYT‚Mt®8ĽËÜö»Ž0GĚ”1š>lÝ,·™äRi9ŐLĚ&|NáéëREÁU,Ŕ‘1ăX˛ę™čł…ĄŰü„z qfü˘JddŠé¤ÜPÔÁbvďE)±_®W®3ľŤ ,˘č pZ¶LtňčĘcÇ-ččÂřJţ×Ý=$!TH],Wăr±ŰzŻé;Á™¨6ňâţ.Z?üű¦l~ˇđs°×ăă3˘®ćşčbKŐş€0´EřůµT}-×Ě ›dóíűÂXHg ¶Ym‰·˛®h"ţ.‡~0\\)ĂÉĘ3ŞSžµ~C¸Î#ĄÖ'bŮř˙9lDËĽ‚xÝ’Áů©˝f! \ř­yžB@uSkII·ÂÍaďŻ+±H'±(ŐU°ť\*,UtÜ9<ůŚcň•śCîrh(žŃmy„´A‹­ŢSŤ‘;±ĐZG€K—‰ ÉĚşě~še8Ů>śˇaxÔ šnXR˙™?&‰AB?w† 3îĽű YžUNM*4]ţ”rÄ.*~wMĐ&ç *·8 zăÉv]ĺ=Ç—%î …1±rJ‰ŰNTuŘZ[P…6şÎ|Ľň21haä.Á®öš|í?…l"'&ßĘQ'»#‰ŞŁ*'Pw/ŮŹ…Ž/VWP‚BÇ'ŇŹ»o‰w˛—s‘;&ÖŐ$ëŻ] ‘×ő}Ó¶Ô§¦Ř%©k÷ŠKľĺçFĎđ±JÂújŹEmîĄsš-ącPB­ÜAÓn1ĐŻě4Ő›¸1mZ.ÜL?íŕg^ťńŃÄgÚß—sĆŃ;as´~tnľßF %¸ĄÝž.U•p9ę˛F/ŐwVt Ć×n҇yÂŐţü5ŽÝήáRśYś:Ľź_Íohéź#ß‘ä°Qb¨Ňc4ő©šÉ^źl"` Ł!őś¨łëĚĽ„}ňě;GÇŠ§ Ŕwć){*Ň“á·Î„.Đ©HĎOGs\»µ}“¦ďlĘř­ŚăMs“6Hq)ĺŻäŤv4`ÎWwőźćń‚^,Éłň—9˙‡a"dҶęÖÍWÓě®ţ}WŤh áő9‘ůĆZ~gZ2Ç{ ‘RÓZÓÜ=ÓÜ›=§w#š©–Ď ÎYjó=TöŚękçÝ.-˙‹ö3GŞY žIyôOkţX|ň$’{°w9ôŠuúLę”Ř@püŕ]“+'•šŘ_Ě•Ąý٢#ŰŔć©dîo‘·˙<]‰n«ŘĽ"ܸ!ľ#§/ Ę"C!ńžęĚÍpeeŻ÷Ĺ]¨ÉsOszµŁÂÝSOb‰2üŹŇ0NxO9(»lyvţżČxšűť(–ź[ŔŘOT#˙1…J¨ú×Ç> ˘Ş(ÄO®ţ#thVuő27¦]‘ä±5üfCO˘µF€Á‹ŃgÚłŔ˝kBřOşë(Të‚š'> æ ś”Ŕ1Ňî„„\úˇ/  ßJS¤Ŕű2źá&&4ÇŢ=ÜvĚâ?`Atłż\9Ýn~C50–dŁłď łhcĹp ¦1ΙŘ&ŻLđ‰Äb+ŢCd# m1›TËÉěgČq-w/ ĎѷҲI«č& #»‰Má¸w3ŐÂhE!ęS°sĎR\QÜ ŠR[60Ô˘IŢmç5ŠŇ~žC"ż» _ţëo92ÜĐ>o cx–© WžŰ›ŹŐ jŢĂ~kw$čU–ęÉ§ë ąt]ÝćF%F'ń±´çuyÖÄWw©5f_ËkÓ%FžÔ«“@ű•Ő2řy;ą“zűqőKňŞ„Öúe¸K4F:Ö UĆJŞŻB 8,GŻ4.3m6Ü°ůÜ©ýDË9ˇČâ‹‹ĎPiČĂÝPS ¸ŽŤăZđ´S&ÍśfĘKi§˘]çÝ?[Ţ{ÉSú¨¬Ä 5öęB;Ű2S˝—íĺŢ.ŮuF s^âÓQÁ?&YV:Uąt¨Óö*ţÜ󼆹뎓ň ĚyżÉ©¶dąß üW0NŻ3M\˘ţÍ–K™îł°­¨O®•ţĽűş¨qÚ´ăQ¨Bjô'ç—ô„ű?őŽÝ3&p¦Ď•XrěĆTővUSGę­ŮůčÉú ‘ë.7~g+YyZúg¶ęq¨cDVŕćÇ‚ě)j‚GęwÁjUŘ»VäňŤÍć©o%?Ývó÷ŚĘŻë=’Ě8ž±|+ĆE&1%Eęńď8óĄ$…5bvîőp[΀IˇçÚcÍřbĹ‘…GŕŤi.|Ň”•hÂ5 YŰ8ĚTôŹ–n™?)J(ŞrôĂQĎŘĐěW(&ůͧŃaf“î—Ç.7űŹľöY=Ζ8ęRń3źË¶Ú7XŞd‰§JhtŚxĽ–¤mŇV·f¶Ąém6ś[˛»’ŃçÜÔ"e[˘pAČLů¸ţĹű ˛°/ş>K§ž;tź%=‚}gËľÔňC$ÚJSmŚĹ+Żś˙pťŠŐIW**”BŔ—Švµo<+DüŔDĎO™eĽśË’Đžă©É󕆷î HŐÉżŔ˘Ă©bEZ×=[Ř;Ü0ŃY«R°ęa»-ń’ňÎLWׯöáu‘I 9<¸łë0&÷ëĹ1[B8n™ źgő|zB— UŔµ”Ć5$‘ý2_Ö|ĐgĎžhu±ŁßoEu ĆöŔŕ¬qů3ŤŘ×-çű¨$ Ă2äZü6nRßíş¤°áwş:ĹŞä$5´üĄ`ŢtĺëšjŔÓŰ-ż•qŃFĆÍÁőS˝=ř¬ű–.Uč~[mR°´9Ľ(dn$m (ŕQ9łßëťěm1Ä(*4lJČwlĂÎ5˙â3F——3,szMjWů¨ť§±cnŃbęR.k–‹ä*—A'Yî#%qę*ôČ·ńMTiGp4iË{ó¤đŔ– q‰űy’‚@Ër+yř"ŇşQ×ýďÜć&& –2“ ťÝXŕ txJ-Ž|I{á<Ů€0dĘnçq6uóű›YŔ=,tđď^ÇŐ*ń5ńcŃ­ôŤ]-'cöWt=YłůC+ŃrXąwpIAH$݉oĚtą»ŰŐŠÇNAiäH7#-î@ň†ĽkźxSxJiŘ©÷«BŁţ5QËÝÂ̲F\Űç5»ČÖĚé)ńźóä‘›yţ}—ŕňXŠ#˲(oĹÔăZ™ŔÔ64#ah7kť2=Şą!Ü«îeůO™yÇLđiłÝĸ„îeµ. ­ąż† Öh1oĽ`Ákß Q˙\ĽŮÇiŢ ?ÚU-­X—‹ę<ëáĆ5Éń~pt“˛mřŞţXŞpF©~qtÖČć`6uW™€Đ¬«•ńŞzŕ÷9đâlŁg)<«s8Üą1¬j‡)ú jÜagű˛ťł›¬ ‹qęG48Ô‹ř–3FÄOÉăĐQńÇŐc¤¦«ŕ´BţŚŮ1ĚéÇ=÷ ą€ĎĚT|˘‡bv qűµÔőW7iäTŁFË‹UŤN~”ŢЧW·ŮÜ°DX´”MŢ÷kč“ÁŻ Ë6(Ź­ä˛ýĹ5 aÎX/€zę[ěTCĐ4ř”^ Cd›§qŔ„™Ćh«˘GXá)‰ěH¸bnń!Jwź˘O·ë•ăŮíđŐ;ŐŢS\RădqȢhpVx˛-ŹŹß\«ßYoćMńD yĘ}L"Č˝żŠŇ‰{:âA>Îń†*ž":ˇŽ¬óŘD ¶7_ęä”pĎ!'0µŠĺÝE(ľçT’‰f?Á‡4%ZměB…řŻZpÄQ*°'4[5÷ëĂô]©äť1[Ţ–ĺÁÖŞýçJu"3];7çínÜvÍ*ŮNX\ćĄŘö^Ia‰IvÝŢ3LWĎs;‹äÇw€m‚yqLżÄE x§ ”–HĽVđž+9ľtT6’dzy9˛śýÂĘÎłř%ă‚éjK@­©X˝yQ" ?skŹkÔĘĹ´%Ť¶Ë++™ŃçB1–…‹xN ‰ ˘ĺ…fą]NőÔň4ŮđÓýcÍňG0dRĆU ső<•Öă˙KíLa™Î§éd˛c´&V(+Żi »ÄtŻX›© s„™–Eř6ó|AŰ ę9Śó<$dóČ/"ďŻ]ÎÓ(ŁŐ•ćŹĘ ‹ěĎâ· ¤˝Í¬¨2?óÁRoiă+ұ_şYúŰ“?“X`$lęęk‰©h;ź37 ˘.*ž’IÎÇ~s zu+Jи¦-¬–0±2Y°f˛ůďL FŤmµ® °fîŠÍ­F§XĘŻDďVx—qŘ„.M€ârJĘfhĆ#dŤp¶üxun’EŚ¦±~—»ńNĘŘ?p?S¤Őř\. ´Oáë‚Cbµű{[ŮFÝ Ř˘m†ýŢÓŘ6Q˘´Ö»¨KĹ}Çjz?3cZ‡°ë«W¬>ňl~ösĐö!Aµ.0|:P?&[řN/Ţ.)×­łľ8Z§¶ă)Ťłš¬ţs>,‹±ÖŹ@dŰ%oš`Ů’dŕĺőîÇU6v ¶ďvDňZ_Ë"%ŞVčo˘"Kb¤ŠČŠa´58Üó†@ö“ÎO řĺ“)ů!ńĎj ucé[ÚęŔ9ŠŁ»Ő цáyCS›±ÚG 硓 wa95EdŁ&ÁJ›‘ş2ôVářk“Ł–ý_°Ńîóoúl'Ë.'¨ťE #Z\(zMËŔ¤J«B˝Ťf;K’€˙š^žÓ_Q8ůŁó±lîçn=Ž¦%YŞÉ”ë#­˙glkÂß÷-ĹőĂ(’÷ű)5|÷”őt{s{‡Ď‘Ćl÷C˝¬Ç°†EČä¬ţÄ˝\L ťX¨µŽĄ GńwćĂńyCü.ÓâŻňP +ňEÍ?é7ʢ¬/căE¬&_–eD2ř‘™TÍŤk­óă{áƦŢĄ%®”cěŞKŔ趫“ă„°ľ Á¸Á4ĐRk,­C`AÉVŔ !ş_S†Né¬üâQ(e1DÖ»ĄĆZ˝aŕi µÚI3ΡŻf=‰÷…\×qPäë-é§Éj}š{ś‹·O‰đčăłlF]Őľ­ Q1Íw ~ňÔ{˘Ů%âÖ43łä%½\„gÁ§‹Ż˛Ěgdë@z„NRpQkĂo¨ź%łof{G91™îó?r)8şÇxâ“Ô(i;Î˙ucîŇdz©¤üúˇVőc\I÷MţE±x„ÎŰa†Â;şçP˙ 4,ߪ‡­,AÝ"^O•íŔɆ×=\€üóŽĹŚ¦EŽTî0ňÉ1¦  €Őą)HU?˙XżŐ*ř)bČ)ĹŔ źzg,îG 먠FbęKŠl¶ČÜŞň‡š’Ëš˛}…O7 “fçĐuˇqÄ,;ť_1Q‹– ‚ˇ=-B3HßrĂe>k^čôŠL÷ăŕűa´ŕJöČÉúLɸ*QŚŇrô€Ň—lj“p©Ůł+B;=#•®ţ!÷Jó Ĺí c˘äMć˘,Ő‡,*\jA`Ć.ŰC}ʇYAI™,ŚŃ¦`PĎ2ţzźe3|˙‰»łŁečÔî(É:{ď7é ěiäp˘Ť3‹ńUů*ę±StŚë;ň=ăh2“…Móh!Á—üp˝6ź-g\qŚB:e(öŐ0µŻC‹Ł“¦ Ţ÷JĘ9"¤j&kΑś‰E|Ř˙“<[‡î‰+Úi±T^ŁaÎ#“˘ş Ť”bOÁĄ×ˇj]˝#đ][Ó3 TÚŇ5Ż}»kďč=”H5ĚÜ„ ŁxD±ąťóú7ˇżŘ7-݆•ăä„Ä Ś°6„Ţq Öy¬ÓŤT±Áą•rY“tćĎ…ŃÖQ$Ű×eŁËĺ<Âę/řÂĂ™ ŤŮvý-ݲ†G4–^É"–FŢ^ Ś{Ľ% -Đ,ÔX%Üů4Ŕ| i6BŢ !M>˘4đę–‚k}›pĹýżŰoÎţĂWdIŽšTHé'xóR«B ÉgxxGB—˙Ůę­mËo“ 'ů«Aë1µ 4a;’ăJ:—_J% Ź2x;(ËUH`ľĎ¸„ĐwçĽÍź’B¸ĆČÔŁ 3Éě"ňÖVŮtM¤K0A~ňŤäîł14mȇĚpĹzlߦ'dL/ůßHÜŹš@k7P©z±eŕôZŢű_µQ‘ ÄÓpřĆůNPČyĂ뉡NŮz?ĄUt=ŻłÁjëkh?Aű|űW!#¤©ÝžŰ5Đ„»·Â\Nd©iT_s: 5çJËő+yH ±š8NWt™.˛q¤vevlW§ĄÉCŰšńâśM^DEĚĘMBŁ.$tŮP.6é-eqţ‚^çŻ ôˤ˙r[ä@ žŔ%;…ö0÷C-LV\ń©#Á8.Tuď€:#đ‚żDúúî’ÚţŰC%×Ç…÷ĺšdş˙ĆǻѳK#ÄKăO d.ť‹ď*Ú\ďvV鏥gZ¸¦Ń >TzĄT)~Ém†d``‹ŰˇÖ”Ëhé¨ŰŔć3E+„o5śŮŘěeköňÝ™:°Ł1‰ 15<Ž@•Ń J¦Pď)öËgŔLńE5+Y2Ł¤6"ąiŘ‘ß '’C!J•Z¸ž©@&KÁѢbÇő‡ cLź î¬4—ţrHü^×@Ą>ö?kť: Ľ©}Óc8hş—ť- Á¦ Y,V~HśäbČă•C¬gE6ů‰Čmf‚ciq§Ç/źŇ0žĎĹ+«TGşÓÚF,µj7ĄˇP»Ö#âJ>LíŘ,“e= ®΂Ľ„Š;%ÝxDBx!]ř÷8ŻÎ†’Ç•ţxlCńK±GäoQ»h)RK经هʶ ‘)Él0¬ç<&zŇRŐĎ Z– e“ăJóÂG˝E¦QĆCi!V ÔŹ>&Ó<±(0řnMô HíŘ”,űÓ¨s?A϶ŢQ żöżÄ˝]k aż•Ą˘ŇžˇŽżf(Ś8łŕG¬éúňŃo ČIeŠ©Vý×NzÂ1o‡ţH@;Öz¸Nč!.Ž¤ěPáŠs7k:Iž˛Ů Ôľ'Y˙–/QSUŽ¦1Ś)OÍQsµMDë}Čvşţ+‚«‚ źŔţbVE]-Ř_®…¨ă濤Cťš†J¶ ’lhn•Jžľä|‘ô|ŹŢd,}Şł4&ŢEĂ€ÜŮhóĂx9Žč řŤyqiŤź”0_ßÉ9Ö<şDÁüÂX-ŻZ´ň|gÎ%rĐçś~‡€VD2ĂeČŁK–SB° M¨?ż5ŢÜzrND¬«CŁxŠ˙3Á2$?y@út%3°áNT?۵řÄ9úťpd’Â÷ąç±€*ě‚Fk!dĆ1z-ů–‹S•ŚÂftŰCŠ„HÉáÂ=zŢWĄikŇ®Ç b8ă€ęŚ×÷F¶YŽhȢ>0ă\äŇrćłnÎbza–Ň?ÁHbԀݼ–f݇­Ŕk¬l"¦ĐN‰sÎaKűšŢ"DJc»Ük;ÚT¬OĄ5GéFW˘Žµ`ŘQçľâ ˛Â¬>őŠ†›bÖ*ŚÉ¬0´ uŻS—#»×đđ5d>ĎöÉ÷f`7ý)'€09!ĆźÝlŢüˇ§Á˝ šOqµÚćE€Ą‚ĺ!xĽTŇŚ}Ś•µneé©á^ÁŔe«K:$:™ )—¸d+3fÝÇ)Ł¬śr¨âĺ±e#%‡BS` ¸­aül“$©ü$7ţFNN€đ ÷ŇIPé H›UýËĆ(JâPZ‚ ŽžŤˇzXě…wS©Ó0ç`S4±e%^t$Ż‡üöť¨n´Ä'áŮ^Bb&ęĂ9r°ň­}ŽkĎß®ĄzD“˛«űőž˙OôxlsŹ0ńŁĆë¤ŰďţCôQŠ/ěŤ{îŻŘ8´:yň,,ĺF_‹j´&řŹ70"ľäľH´nüRX\'8FPĄŔ3ÝľŚçć ߻•;žKëUĎŃmŐkUxGµ*ęĐ|Ť´ý V~ĐsQűľősąSŕ,Ze)‹đ«×)Nx6¸ćÚé’¶sĺGuî0‰qŕŞsŰŮ8~ď“šîHĂ<Űůţч2P6·á Sô}°Ţ dţź¶Ă+ľh›Á \üş÷HśiNť“%cU–j<şV!oÜĽ}ćLßď„Ř›ňŐçĚű;|W 0Ť"±$ÜăIh×ČČwO\—á„Ąb\“v{>õĎ[0UGĆşîgBą ßÜ˙Ƹ2ŠTwmĘ}Üx÷]NŇŚb±ňôő(ĐűôdFPŁ9  łŠ`PgĺIîâ,UŢŻN}‰Ŕ–ôar¤m‡řÔčAYí6ńkýľŹeD}Á]Í|éU%ĄA€¬ŞĘ8η«aß&MĆň%`űn“k‚¤Ö y=BŘ<}]OĹTrŇź´[ýŕžńŘŞâŐ?„bŁŕ€Żô‰)vnoZť7ľE'ăŃR0b\C•.g:Ďm^\ŰŻL>ś#µť–_ÓŘĹ3ËE˛Ť›PO“ôc€Y®JżA6ĆÇ„ÇxJíânDŃQo€_aŤŻS˝*!*5T'0AŃN>,Z€ř ¤š-=đC DłŇśĐúŕţŕďĂ$ě] ×Ń*WÚ¬b şFĐtV‘čb¨–(řź]¦“ńń©p¤~šf—˛dÎßńą:©dj…ąF#xĎ1WĘÇD‰¸ń”ĐâǨI˛Á:oWźÍCS­±ćć:â1‘"R^„04TÓb„Ü VĚ*3jü‘b›ŘÚe‚¸2kÔ#2ěBŘŐ?y#)çŕşĹŐ÷ݶŢ%íŃÉ9áäW°ýG\¸Š[ď±M¤(*!ź¦ŃU´ű߀BÜ­f´*+;dYćĘ|3çd€y(łün߶íŔşÉLęďA6‹—ś‡٤]ż|żď*žJ$RHÜs Öc˝V˛ÍđŔĂxŁ“ď­5ł5ÎéPbłžšˇ´]ÇŮϻݴ‘ďŃß—t™Ż6“Ş>Ý1D*ůâĂ˝„ĺ$’Úţ´Ä\f9‰őI ‘ćZűM¶IÁa=Űó™­ µ\NŠBŹÎ*zr[¶Çň?–ÚäŁ4 ¦š_™'~  ø 8ŕ—ޤÇ!łTéŤl0ś5§ó?c5'n‡Ů ŰúE\é|ˇňRV[‹^÷üó™M§Q[×Ń:vµx.ů[ÉĐMKĺęčF·Ž(Ú\汕˝·-<¦-P¸(efä·Lďc°5ŻYĹ=>€ľ”zz#f9şg”Ţş* ·tEpI[Nů`LúÎĂ㔵g9¬N»:K̶ĘZłVŁĆ¨]¨Řkc®IK\«­'¸xSąJňRŠÓţě˛9^¨trüéc‚Ńo´^ôőXťyÚ*uuĘ©ŰşfŻŁË>F‚Ŕş™@’Ń+ZM)Ú™5ß3Gľ G–Ş.p´ĺ>˘˛âí¦E¤‰…ˇ¬,ë¨f}ĚÓ]°Š6Üćźupä˘Đ Q<S× .ČĽóy0ż°ńźA,/‘LÂS™73µąPA¤gĹD‚'‚ «Ś9„^ń >‘\ë¦ ˇŚ05Ť“˝Ż¦4RwA—§®’˘9¸“Đí¬ńžH¶Z]#›6…ÜÚAL‰Ţ}ŃŘ7šÍbmĆ”á9wÖ#Ë”%^źÇ°Ŕh)Qr¸Éąx„óEUEZ”GÇľO‡Ű ß+ćrţE„r˛DăÂlŁuÎ!ËďÎ×»4ŔoL¶ADňEČ?1;\¸€ús Ě Ôk‰ÓűŞDOÍ ‡;†OôčU¸ŮfŢůTct:zŚŕîď/M”…•Â¦[¤ĂŮ4e´©(G.UŞ)EtŘmҨV$ÎýEzËëYŮÓ’NÜŁOj›ş6Âő„—q®IÚČ)$źBEŃEŚ·˙U͛ʀT‹a[ç¬D†ôFśŰVú°y•őWCáˤgłxp9Xˇ¬(¨µLz{ňňů Ňä˛9Ęş´eé|’‰~5=zŽŢ`… Ş{é ?ă›—­«:€°őźŻ˝ëą(°–¨fU>ră=÷žIÄ®)# C~B”­d |a{K®`í”»'ÝzĆó‡YžIŁ:Ű*仮͹®±ÜPA¤Ż‚ĺ Ŕ»ŕ«đŠĹG¨ÍĘK“»ŞŢ8Hä óż0pŃ/ČÁPŞŁχ"$ •r ~ˇ„$(ÖżÖÖ‡@¸îĐ’î_ ¸Ľöš".}˙ŘĚŮÂŁFŹkđ•„Ěôń&ꉯCyżRY¨¸mRčc©śçkŐöS­±ĹĂf^|Ţ^ŘŮ8lPĂ«ŃGŞÄ±8TŚĘç>m!”awC÷`ß=‰p˘PÔ›ŻkRĄj‘5x;ص>é§p3ý=µ?GŁăq}ŹµŔľňďäsđ¸ˇE"é†+Z­IVŻ×¬f‹Ďşp°W÷QÎ,VTHpĆü-Lhc鄶^h®ćVjÉ'É&uc_u±ÇN¤-C˙SłĚÄ:iđch¬Ę„ľ?yLG‰Ü#uÂŽQř2]¶‰ťźĄVÂ&¬AC.g:űűY¶Ó94‚”LśŇZô»0óú<Ś2Ź ű PÚ¶Ń%pđ_\¨°çL†¬YK)*´Í‹nw-9&fťţfTɗÚB¦ÉË*f–@’śŰ[Yđ”ő0ŇťŰŃí+ôƶ~śűhC·•ÝU…ë‰ç¸˙-0XË ¶Ômĺ îꛨ0TśLÖ†2,3ň4W´ýĚ>fsńÖáĆ{ílŇ}kĘk[¤V˙Q>‘LäZ6%–~Ś˘_\pmŃ˝pQĹgçŰ>bźĆ8Â<X‹ú8®ěí a¶Őľ.ÔôÉ°/ ďřJ"±ß1Nűűqy çl÷ócź.Ňv—D’6?–Á¦!G¶!ö)™aęodx·@H U;/dK1Ž8[•ÇěŻ'̦pÔRčîřTě´đ‚53ű„÷%­Ö›čĺu®'W[ p„ ˝«°|xť-CEŢÔČĚg™P ýš^yÜmWҤçvä„].»ÄAEŰGr5'Dť|–ݢ|EŃšX6ŔŘÓë”Őq”óśÖYŠżBq…4Ţ ďM^ň°Hm–üúQvÝĚ(ł/Íä,‡j,9/» B±«0,{× de)Š‘‡?®TzŻD8Ŕž-T`Ě쉭$»ä9|űîO.@XxżţhÎzy'´ž“_µÔ/T.…Y»ţrnzśtż Łú§»l{Ż”b÷îů~L15\)EŮ}®o•ř]U`Öšű3KߎŠź[µřúp@S׋މDŹ¨ęr>§“ صáĎ˙}噫Ć1EÇ A/lYRY~ÍŠ-u iF‚7!`ař‘"IŘĎ! ś–8ŁÝŃeĽź‹ő=4Nľä6‡Č•ő*‹ó9€©(éaŽŔ×Ć+C§Ü†ě-TŽ­[CEOJ!żBBžň•€ <¨+™˙ł&…ü98E R÷|8¸Ő[1şsmĘŐş¬ÉÄŽ]X§ň+•„ňTÄCŐ(9§+”ÂlÝŁ_ĂGfÁ:}˙ÉŽźŽ&űŢ«Y´_»ă3dqFó¶Ř¬stŚ‰Řs9„3ś} <ç*r°·Ú–ýki×ÎŘB[Ă­‘§8 îÇWĽ)-†•éFZIu OöôŃń`=Bnţ‚ă,.ž0ŽX”’đ/Sâűŕ+~­•n±tW•AęA‹Ęí6RĘe«ŰQ8^Ď^O#TÁ‡4\ŻÂéŰ7ł§ hŻ®(çú¸5űÚ. ­´¬ĎĽ,űÂÉhq®˛ý0‰tüĺĄKG«±2&Ü®ő"y2Â}lŤěě[ZwČGűE çn×€lW&†ő_|ägőÄᱞ¤Ă?Ľ«1 ľĺM/1›řQ…ň©evôťűťŹŔ[ˇě;M/ѱ \­’Ń’ÝJj0Es©\—+WşM:‘-™ÝQkć×ÇT.ÂîC€ř @söUČ˨WRŰôůZëLí,2+Ő/ü¦Ý.ežÓ©ÁáŢŹ}uFę9Š_kŇ 4¨µ nĂ»XŽ"yř/jn5‚Zm‰–­ *ĺĄ]ůútŠňĐ4¶[Ľ9úwî0bčň„3íZ†”^U׸ďšÓ3ÇEB”[ßvĘ:‚UĎä×Ű­ř{$Ý‹Çď´‹?ÜuňÁěÉMŘ}4Ç%-†Â÷‰*έňVEq˙Ç˙&őGŤW±ăŇ‚] n«śú/Ź?üáąFh ¨ĺbFZŁ(ä %ďÜ.™·"HLT¶:” VŽ+AGÝÉ0úVţ}ěB4ôSň%d.UNPŁň÷Ě3±C™›•'*nĚĺ^úŘôú”z“ĘcÜm‚čř.š1*Ô¦ő˙ÔŞx»Bš’×d"/9Ł˙Űç´bE‹Żók¨ł!+—Tâ[ Éę„ âNčé»9ü0f%‡FW©<`éÜ„X‡ú¤és%’,:đŹą‚ ţ…˝hlÓĚÁĆĹ2Şl™-Ř˝Áž (­,ÄŽÍŤwżt`µ(äČިńäř†VV'Üéfţb3ďŃ{”`®t—·$V}ÇÚ΄ çíwy- r„Éźcҧ @ľ¸ÚµÚšÓdCJe˘ÜEI÷O<·‘ŰŁ®c”¦+.ß‹ŞkO̱.¬V˛ţ7\˛=«řŔĘסŮÁćöbÎÜ7§’źOeÄM~ ťš(ăËBČÖčS=@Đߊ«YÉpş’ é%–€ů  É 7 DIůEďąáV…öJŔgâEwßvIđý®Ú:–[Eč3»éŃ<Ĺ @αGĽ·–ÚčÚÍBm˛–foýGů+Šý ră]í)É_W÷Ä‘0Îĺa¸§X;1QÁűű¸ÂĽ”śfO: R'AâÜÍDy*?ÝľęöÚä›Ć–Č*oM ŢůVh¦ “6gŹô8‰~‡{ś2|^?íľ"ŹA okWýirO©“Ą,z© E[]ĺít˛ ¨ţÎüĄC şÝąq:K6Dŕa îW7SČwÚǤđć±íDäJ¸zŹˇ#n"Ň>sf pÜJ’Äe=°LmBdČŤ€•¸ĺ/*.¸o˛ç¬Á%5ŽâyŕµZbss™Ĺ».v®ü´N )!łŘ¬#„:O“ĺçt&HF˛OÁZĄ|o_¬SE­«pÝČ<ŤD:=Ź§Ę®®–Ől,Ţę^tź¶r§FUKĆ ď/"Ő%–X)°Á^ů16E]€ÉhbJQáúmoőŚ­÷ ąYŐbz_[ç}UăK!ňB(—‘ŹŽß†Q¶ř>µ®¬e1ooÉ R+`‡íxCŻŐ<żât?ůŔÄńańoŃ%Ŕ/˘‘®ňaiěőmqŻŹŞś7sžÜqFĂoRď}Ŕ2>Ë®^ňy„LrFľR6;‘¦â·ľ} Ôtůt 9¬żË›j€@VrÖ¨GŐżwĐO}óęĐN剭G‘nIĚÚŐe32jQv÷RÓâąő»šÓťSj€ăĐ•vlęümit<™9‚µ Ä&îĽR1Ó©¸V…ÄÂ6Ű‹†ţ0uŞ‚5a0ÉX+µ…ýöFB×’¤UB¤ÇAÜBU›Á^ÜâÁ¶ř>…ęßŮŻÚ*}džÉĽs †СĽcd€P*#!-ć ÉŁŃž˘.•—ĄŃYX^ }oáŔ«XNzřkç2«Ł:·-¤WB"ÇcÓBgĘ›J“$ĂŮŞ±îD\ńÓuâµ|sv&7Ŕ}Dş­š @K/)R÷ĹwjáńQ§<ÍNÎNdˇgÓd€5îH¬~ĂaIŮ«şĄ“ şÄF˘»a’ÚU«Ą'bŻ‹ŕ\/*¤Ä;?Ż´ă˙‰Ö/łóI&sés–¨÷.âjIN#MÓŠštŠÜđŰč·ËEÓ Ż…ȇ~S {—ÜŤFąÚĆqX •áąčżM5X#ŔÓZ¬)ŕőĐm×Gú3¦LŮ ¦—OńŔ‡)9<ĚQ^‘ÎE‰Gď.ˇJšóŠXsđgťy+š˛Vşu0 ·¨Iɦ-Yźěóp­8;°ń’á2‘Éý*~Ś˙•>ldďŕ¬3±GÚ&™I÷˙ą.Ę€xPß~@\´w©Ş š°Śř&Ă\\€ö­Ř—CÜŢŢnřuG{§H·Ü`DNŘ‚·Č€hbĂ”'ŹXßĎĽ 8±ŁÚărdBz!Őy/źÓ'ö,ăÔ•^ąä‚%M=Š…Ŕ¤&ús1ş`RA@Žü›Ëo|]Qh$XŻůşgqVđ9‹Ç\\é4 ĘH üL@iýź‰RľJ&07©_ź˙€)äßW8'ÎMíw‚$*şĘU7úďÎą}ďéóbHąż7¤šř^F¨n…hKöŔŔöß›”AĚ6PSďŻULËČŰ[ňµöםŔÉQ ´xť†Źń•ĺ˝éţé IËa Éš+‚0ѵáK) jRśÔWo-LÜ(oăY/năË`NŹŻ_ kŢř#‰Uü\Eń,úÓ˛xŢŽiR»}öaújV;íÜéÂ=ϡt¨ľ‡î;k4ů }MˇLpŃ&2‚7¶Ë-žĄRî‚tŚă,D#Ţ3 w€@…í[îŃOJ—­«`ă& xŮiµEăž:gV’ uö!ݟܢQgiŘSűvŃô˙]!Ď*ó«CřÍZnM 42´+PŤÁţ<Ł.ľŐ”=Ę<彩$@=çÁ*Ě÷aŃý˝ą@ Ă,,ŹĚ’î«ŤĹ©+!Q‚7BÄşsjŽąÔ\ŠĚÖ0?±LÁtב¨I!+ňVŻđ‹â,™S3˝Đ˝ž©yŘŇł@^‚÷ؼ͉7dVx&?BńÚö5^5ę’ă|šä®”Ő”n:Wźn<şu śexh®·ą)«°;/Ú÷vÔ · ZŞńĐşĆ|÷˛čwmAö”˝¶č]“FŁ•‡0çCč•pf۲ŕlsAÝĂ­°÷(ďAöÂŰŢł>öĄwFOdřŞv~“vZ+# ĘX9˙źăŘʡßQ»zţîPĆnŇ Y 9‹fLYÝGzdBŔÝWS«ÖŐšî¤'Šxa¤%ghG“:iÄĆ[=o‚ź2Ű·ĂÍŻ˙L\¤\şé×˙ôBÉRŘÄqî÷•NŚŹ>Ŕ'ś®Ó¬jAy Óš@-ŁŮŽrĘşĘQ$Ŭw…Ňٵ‹żúŘ3´ŚŃĚyĂă'H_=gż^Dęű™°hOÄ·J†QćÚ„ďŕ&Đ|yAś×r$·úĵÜ(XBťhHvőÚüü x0A«•§¨qA]ÚŁĽ9#2Ä˝_ #qxZI*Ź ĽŘś$ŰŤ¶¬|Ě·[Rßt'˘×–ŐýWćkěÓ ‰‹łIˇI† m!› Ő2ff"˛ÔQxCS´‘[N붭{¬¨çŇyęúqOGRÎPh˘îŹŽzo7-ˇ°®‚ä­…<çNsL(hƤYTń×9s+NŦ[°˝Š$ w e‰ łÉ:´/‹,žúA縄ţ~^o¦Ť-h˙żŮ¸2hYŞ´cQ˝Ń4µ%Ů˝%WJłUĹ0‹ÇĂďf ݉żiQ‘˝s©Éu'kĎŃńÝp!Cź¬¬_NĹX‚XśëŞ >´Öąęúši b~úúI#qŐ,p¦|591ÜGʦ$˙{޵Ńcýr Ó’Pţ/QîŤ[+X7Üo0űZ/`őú‡-ٵ=%×ÉŃ´¶,fË™ŤŻNć p«q€´Ź}gšĹ ÎżB8/Ö48sŮXŮÜŤŠÄŤú ů˛(G©ˇ>átp§‡EaŻZ’EŞüLş‹:¶!=%˝óťBP3Y`ń3 ŕ˙  @ÇÖŤ €±Śľ·¦ÉŇSŕ˘Ń‚’Ě…urŐ¦i5Đeí›^˝ţő¸°oÓ©7'â¦YXDťĐxvlSgöZéý Ă8°EDĺŻ-wĚŇ/5Ëĺ±­Ř Q†MvŚjläĆĘĎ@[…3§AŤˇ]ݡądĐÖÉ1űOę8“ΓÂÉ}śiML Ĺč‰yU{6DąúňĐŘg Ž§!…OL ß3ť±6ó3qOĘóú<Ż•ZĆ*_QĹ Ĺ@hUŁ­Pś,l /`ąÎŕĚ^ĄŔć ˝™Ëť{,Żąę:1*«€ŽtNźÚŐżĺý|IźMř /Źgë#´4ôŐwţ¦"dÖ‚÷]ÚîŰ:l× W–dŘłIżúbq–EN2¨lrę%O˝+ŮkTk_Sjç¸ßĺwËPł:dă‰ŘVřÁĆ7ź^©–I„<ý\† ۲3ďü˙żŻ"vgź…ń©·WąUĺo—˛+ś0˛IQe\Q•ÖÂbrŔĆŃŔYíĐŕAřqsc‚çů@;=IncßôAŠAÁbv óü‰0°ˇ‚$Q"ú‰Dü‡U0űrj(T„ťiŔ=’ßZ= &ĂIň·ˇş¤ł5}$ł7‘”Ô[2ăíEĂĐâęż©ŽČ Čľ ŻÓ˙)°.ÂąpęŠ!ôďpŹĽţfů*Ż©łůŔ#^_.“B˛€ˇ,EŞ ťđŞúőŤŮ×ËQ7?FŻďÜŢLťép“Ě{fŐµwv‚ŕGşÍęűŃiô ‹Őŕg©ę0-˘°Šô .'g™*y<Ł\hk6Ť:dS Čp"lô ¨ˇ”Ę|ĽCî~ąF ôŞą¸·EQvČ@z«âMh¶ţ–b˛¶MÉKvgšąOöe\!︆ÝŞ&ŕ†‚ykf7~Á¤h_i9ă™bÂíÍPp?,˝ëAB–O•—GÚŽ´Sp»Éʔ׏w¤ĂŕúĘ ,vĺ2 Ť}$}#¦Č›đ˙‚lZ={¬łxEĄµßËŽĹR9>'¸ę#q*ßĂÖËŢÜţÉż‰ČfiĎkEL ˘śXÎ%®§mµ}oć€Q=–čLś¤ca˝ÎÇě׶Ö{škMnÖâ2Ů,˙ ±G!÷ ¤%jť…–9ŻpĘ\›ő0÷ 6f6˝O€šľ’“e `jŤ+™Ű3¶çî˘ě–JídȨ›sÝc6ÝăŘř(É·) Ď4H‘˙ĎhÓŐ@®¸•G™qYPŻŹ´ýkŰq-ŘŢ )eÉÎŔqWwÉë@Ź®’+;ö±s' ©}·HŻNßăĚô¦čëľËůúë˛vzŔ!DyÂwŞRĽ2^CÓ#iŠÂf“W°Ľ\6ůşĎŤŁŢY s9ˇ É ¨A;NăDJŘ{ŘĄRçé)ZýşÁ&Őîn7¶„z‰´µŘ/®Ň:[ń§şí‡¬SĘO<ă`ĺÖT}…j¶¦ţ‚–ú…2ÉᲕ+ë‹@Ě—kQŞ‘e3Pn*®@éO7!v¶i KÔ>' X–™YÓ÷FËŕ(4®¤:ŔÉś­2zckŤ#ć>˙ńv§˛µ÷»Đě“Ćă`ą<ťTů®Čů‡ ΰŽíöµa˙Ŕř†§¤Úy‚ů‰SPđüŁzO—xř1®M}b3§ÍĐŹ˙˙ŕs)ż%Ż SşÖŃHBž`OgýľËŘP˘c˝”®~ëÉjÄ Î !mY¶˛ZgSÚňx~㶔PĘ€Ą 5÷MJ˝ŕsÁČŁÉ)ŠýEĐ—j§«–j€n”¦čłÂ+ ł1h¦h›˙…ńŇR\T±6©b”¨słuäřŐ·Źî™ď~ Ň*ĺďňđ”®é”Ő„§”žäď4ÉËnŚc«3 o…Ő–9®ÚĆŐ›Rr~ĐŔíB|„Őĺ3;i©ö^Š­› `1‹{öôß<ă$8Çe„«łľUFŞ[¬>bo.ĘĂ?Ţo7 s#¸ü´_âă˙Ďr‹Ź3ňćŢŚÔČŞásE-Π#|·^Ě˙N°ŃÎĐţ<ď¦"śnŔîŇ’±aĐ]Ţ“›>•<´ (G·Ţ*0L…čÇô7ß1ŤqR‰ű}¨f#úÚŰ>ćbç ц¸Ś(şŃTLU¶Ł‡Ö—‘{cÍ'üÖF_,Cí\éčJČÝ“Ő“·Í¸ąSŁcSËÄP†+yᝌ,ůťˇŕ ÷<Đ1v/© ńkęČ[zVęßčÇż“îřüáś™Á Vď»Őĺ*ĂžZgGĂ´†8I Gőjcp)Ą©Xy^[ O€EŢ!Ĺ·ZlRsPŻă;&ÄőĂ{_ŇKĂ_ʆźů/˘˘ÇPüÁBŢ­ ÍâoV>Ôó1;$dćó©*–s§‰ŘŇćeŽVU§ďEx3}ďâ ţµ–ÂűD«WĐWŤRÄ´š„ůGŐÁĎĺ]îV…ťI@—ŤÉŇ85đÜĄÉ|ŚuipĐ>ËmTbLG7 őÇ'§Ň ĺ-/!ŔCĘ„bż8ë…Éo¬´we%žvTÜ9H®ył°©(ÉJ śýćŔ§Âhaž·Xţ Ź™ĂD’“ádQgz•Ü‹wŹyaj}çţpră $ó™/#Ć)Â&rOäŤÇš/]ĺčŕő†ĂI2’Ľ¤żxŮÔă9ší#™_ĎÔ|"ś–BÍüě**ł\‰Ł•SS? 3ń ŔĘüF 1ÇăSn±7UWGÍ:ś¶äałÂCr";p)Ź|ŻëčÎÚĽW)źł…&Ü@˘îÇ+dp´Źx5 Ě·»ÖđŻŢ˙ýá›.`ţ@«§˘•óHü]†Y>έŤk(¦PAé{”H’ !…U`!¨ö; ĎŢR˘ G ‹Í–í5I™Űb‘ż¸ĚšěáŢ;KCŕDLŚü7\f űjJŔŻűs"ażoů36`Oµ˘Ě`Ř:Ŕ |ě„ľ1L$|-RÖ/3őĂ4 $؉}phaî´u Í9m>nt®× ëÜoNŚE>ŰXŠbKâä‰5.Ę—ŠÄIPÜ—GíödŽXró4učí˘üuÉË ł›4š˦ńv§Mü*•LrDGń%Ň–ëiNÁÍLŤzî—sMÓdž6OžŞÖMĽ{‡…˘,r4‰ŞPÍ›Qö±4C{ŠdC®î "VŃ÷â±ÔbŘz±x÷7Č㥱ëóĘMPĹĄ”†fűďż-i¶+™Še AŢSô"';#&Fĺ»›;`OS˛/“–¬H1k+ś_ŇăĎ›*„ßşfŠ3Żśç{Ľ#¨•Ű] RŻOŮęxĽ šÍŐIëĺôˇ™”Öoq!Vî03›µRQ1pŕ€űjJʵPHśCĺ˙şť@MÖą?Oú!ˇźTmj馶'čcü±ëńë'Čk Ąż—Ą¸ŮĹűăą®ŕyĺ¦Nl?#şßTťŞ8¬˝¸iěňqM–´Ť1ö{|f{?Ůą€¨ćv ™‡bŠŻ‚¬gŃ‚Q35i§Ő”ŞAkřI‚[$C™ ˛aŰ>̇ÁęS¸eŐ4Wmq;n¬Á @řť[ÜPiČ-*T$š¦Ü•SŠIjá{!ěÜ­#šü†15Ęaź?CIIf@± µÁ@qźEš“ő› !|T˝ĆţUl4­t„~Xüł‚˛rćüuî ¶¶ą‚D[Ňá Ü°âš×ě~ŔNT~(7ÝYşäXi$Źß㎮Ôć‰rM¨‰"¦ ZG/«9fţ±§®XšŐ Ť;)*dżęSTúł34]Ä‘žµ‚v~Pľˇrz'Ě ř¬ ŽhőÜwĹtťŕ!S‘ýf-䏵p¸pHNŞťChéď™ß Ęđ»•y~ŁťŻAbőŃąsăëłŕŹŹ))W‹Ű<ˇŕµ(l¬ $ġöąĐwW]H!m+J˙°(ŇĹ$±‡ľDđÝ›ę©0;Olĺf´ÚxÂČ#noW>ę~ąPF0;`ôP€řłî=ě h1I†#p$'Ů/g¸Ű;ĐFŻ ¤›/6 ŁÄńô‘2´qŘ·t »é‡5Ľ˘§výi=5®)¸’¨4ꍚ”|±Öť#ř Á6IzÖŘ!·ĂM$¦ŠéÍi˛ĺÇN!MËż=Űk%˛ŐëńliĎ\‹ÜŮUĹV{Ż¦ÍMh_6ŐÚ–Pý: Ëžëřx^s»¦Ű+Oš˝Fúô.eE†?(R“ĽÎË,Úm;žŘ¬\x$®\vúZČęÍůţ &ČŹňŮţďxďUzxđ_±Ă&^T˙/ŕkÓŘÂńä<,ôÉX;Š?…v%8B=ej,)‚)ÚÉL䱿  $ů6ˡď2Č»“Ť î ČÍvGżzniX N|Bۢ‹÷ “÷B÷6áť"EÄG‡ggáv)ř„}Ýyř _´q®‰şűÂ˙ÝöUqCĐ—K‘Ő™Ń˙ÇÚ_đx6P@oôß~˘Şş€xÁśý÷š%ŔoíČőq›µFĎt‘8•Á¦ć×VGřAŹů7ă3„ţ9.u—…Ą3&>˘ioľ$u7ţŔ7"×݉+¬Ŕ Đă2DLěúIÍ$ŕŕSŃńNgY·UN)ăÜŻę#ťÜRŢ3R~vCKš@ŁJkFě‘$ˇĽ Ľx•#P .Š(űrîÇ)ÔŐJ=ĚŃöN ]ޤ¨óÜŞŠt+Bł¤›8 »sĎ•‘ÁEYuQrdąąŤĘPçfjVOŞ4Ň2:qa,Ň.‰s"¶t|?°ĺăÖ%ŕ†©Ř8»QšđçłżRÉ«üˇş2iÄ8¸ŘRw˘âyŹĂś‡¸č§Ço3_ÜX]™Ŕ»ŹůĘńÄ”p!GF׶”ĄćÚ˝W‹1^@ë}»§-ĺ“Ieý†ţliÔy÷:™‚\<…g€}Źd†Q Hí^=¤"ÍÝä‹—kŽ­†Ł1ú®.Ü·CO©ŇŞm†iĐȧĹzĂBđE’Bńť(R†ZŹ=h:Q 7ů|"< {9©śąćó\•ŕm+îC¤ Ă©‡!ŻDOř@Y 7ÔŔŇ·4ŘçAčPmCš Rµµ’!ç«Ć]saĆĂ(h šm+ěiâ·LĘÎÇó°Ţß8ŢŢÄrsóń¶©ő5<-6@"ŻÖCĐ®’iŘçů6™zhG׏ŚýÝ[˙@uĐÓ,?˘€jśŠ)<ÖóŽV±Ôń¦Ä–·2%:U dÖ–ćŰű~t#‹I%J˘°®u ĂAű6_I 52Ôáâ|őÆryÓč°¦¨Î>’Ęű‰vý<~ Ĺrť]Ţĺ t‚#„b(8ѤLŰMčlFŘs˛'ăc7|}éC0ŢŃýĺß~2´ů±kĆíKuWŻ2W„™˘Č-N—­ŤáÇ=ÚÓÚĹé­CĂŻ9ßG8µŃŐÎLFc$'OQ´ő>‚Cž2ÔŃwé¶*-Ö¦ě§N›ŚĐ˝á"ô=v3˛Ďy–AăAaˇJă!˝ţ{ř–<óYňf‹´\KÚß÷'·{$ă¸}gÁ \P#¶ů)gş®P46„öÄęÇËĺzŔ'¬ÄW1ăVĹ<˙ŇÔ/%Xć Ő“cňKŚ´ ăČvÇźč´z_‹`.ř.ýő#z*á\ůF7yí>s{Q˛‹Hň‡VÁśË{Ě;#ç<7»„ŠŢnbłŃ"¤ę\ę.ĂAĽgv‚ŕ†‡őÎ4Ί]|–λ3Ôe˛hy´)Da„NŕŻŢ5ä<…TÓDÁ¤łóçjŔšČ¶lÓ;AöŁ¸—DŃe˙ŽŐ‚—I™©©Şţzč—őť2>|롬.ž“ł<…)HStQzE4Ł«˙NŃ„ś„Óß?˛PRí ]űă"ř´…«ŻQâ×hĽŞLâ“­„~ö[iqQmgÖXkôÚ¨RŮ ës)ŽĚDSđŇźČKéŹńăk–ř†lš1n5~€B8µ%ÝĘžG:ޱµ8ôę‘ů_¬Äu6ŃĐşěhC°NNł÷ĺťx˝ H’JĹËŃr@˝T›CńÓ¸ŹUň‰•ÎY®ęě,şÜß—ĄiEmžąű±Uşf,]™Ă\Ýőxç&äž|qŕh˙tü0 b0÷Qß7BÝówéĽFg‚€µ ý'ě<) Ó¶vhIXdkČřÂĆůŢcIëŚT˘Űý€ü$JĎÍ7.}ôë‚guŮňíĄc‚€tŤĄP<Ő9 ´}sťÓW& D]“&«ЬŔNlI’®Ú’˘â ŁÉ¶–šúîěĂçÖsŢ3g­ĹČA®˛05 ă1ż’ Ŕ9ۆé(jÚ"č3Šj]oĎ)fDÉ'{x‡/dÓÉ_%ťFţšÎ Z[î<Śî¦%JŠÔ5e>׿QUóĺ;é‚Ş2jÖŞ—üoćoĺ'Ńíz©“>A:ĚÎů¶¦[sÚ=śöö<Îçňé´Ű8§Q+t<şzĄműěśţÍ*Ĺ·iŠTWCĹ@%ąľwé!}Ҷ  `¨¨Źś±=^=6ýKZĂ˝XÝ8Ž˛Ď†A=JŃľ˙”m“Ţ,x&j†ľ˙ÆőĐ'Ă);VMMŰ}‘8@Ž9ŘTRáťĺąbpłtpy‘Ž÷¸kęq¶<[MMł~\R–,bHfŕ§Rô^¨»0´ő'GĐËŢś\Ą‰E âŁŹp€¤PĽ®­2p»jĺünGŽ¬a>űIükmçÎUžŚô;,űĽu”Ďţ¸ß6÷•żôń÷ůFę˘D„fR?ĺë<ě éřń«—ŃÎęh÷ŁW}o_őd(zŢ9ILč°á[©XgÖZýáŰ$lÄůH»ŤHÖĄřM°x{S=#tÍÓ˙‘NŹ`™§żfůŻČ!ńá¦ĚíÖdç—`¸éqm÷ľçĆJu«2¸nTŤBô>ÜKB'ćx˙Dy)W1–Č+UßçµÄą—´ď˙˝š˛iCî”G4RU9Í’„+0XĚj~qĹ#,FÝńíkéc7{GvHţŰvôm_‰:Şé p%ŕ⢚—Ŕ~Jq—V>yëZäťPĘoş fá1quĹ3Äáç´c!Uč3¤/YyB)“!Q0ă\Żđ@·Ažb—‘Ţ—Ň[¤ł±-Či·§—y.w,G.ŻxöĐâŕyîiłý ÁĚ7˘äĂá?s¶¬çîk{Ľ&˘bů Ţ Ă?c?ôyTčC˛ř·{>,0ż©Ç|äQ„mŻ4˙Ś<ón3U‘ă,Ň72Ć/ČBžçEâh°ąîŰoQ./çY©´â x“€żJ)Őů˝Úýéě´ßbtŠí >Ěđ Öµ§ĄĽ—!Ą(#î°˘ÓŇÓö«—ßŔ§3BA8”J˝Î[h7”Kőš—WDýüĆŽy©™ÂîĂÔR*×UŔ»AÓŰž{đ“f­¶gżuđ–6Ş{OhM^Ăűµć?ŇϨJśnébK=>|ţúĹ»8y|Ş2>´a«ÔŽL†d±f"HĆĄż‡(x_ŃÎŮJŻřëĹŁéČ;ćBŚ:Ô/ăýú‰ÜˇŰ#VÖO|ë¸Y„‹ô $hĘKŮČLÜ:Řř‰Ë¦á:öKOLᙜă„ĐÔuGLojJzoČ䡱çZ4Aŕ8÷HZuh!ô2^ð˺˘¤ ż 74ĺţ‰ł+ÖÓ ˘§rĚ…3řmńô ĚWó}H4*$5ë°5Ř ńĎę'¶eSÄ:ĚŤŰłĘxJQ®0÷%~†ć ŕŇdwť XŤ§jוB„ŠÄ¸ÖL»ë=;őx›h ż=ý˛öŮ’ŔFvfÖ<MuÎ^3—ťľu‰Í™ćOĂęÇ ¶ß"¶µůÍ˝=ÄÎ9V8C$qŞřĺdÍXx€:S'FŻô*ę­•şů-§pˇR´ÁpŐKW­I(Ąť]§'F x˙•ř˘´Ŕ2wżĂ˝(šÎŹůx''ůé€ĆhĽă/ÖÖÎľČ!ĺ D;1¤'ĐQ—öwąy®â)xţôćE´ü`šşŞMNČ ń>1áqŹ$zŮuÓixë# /Hâ=€· žm¨Hö!+ĄjhŽT¬>ŽäaIŘ(‚ޡ¶ÂpŚmđž?a9Q‘ŹP…őXŘÉ BéNŠ¶˝őôý†ĎîÍ@ąp› “_¦»±eš%”ËŔ`7 ŮŇxĘ´˝“VÂ1˙hŤĆrÉpX%y÷óđRjë(Úżá\v˙ą‹; ťÇq»Đf,‚~o_|MÓĂŤŃý„ň$r•ˇp©@ń9Ď…jeÚĐM×} ĺ¨ĆŚ“6ÎtH)7fƆŤ~żýw˘˙OUQŢżůč˛ď”%–nX”ŔĆëh4넲.Ć*[łyvßşăŘŰâOćl!W =żÄtĐ,+rę‘´®ŘÚ “ĺ×r59kł{ˇgđZF˛FŤC(+Ég2Ĺ©_±Ăă,Ŕ0±áĚmąY‹*ËEGhŢîBGZŻĐúčS͉Ʈ®ÔÜů«eą ÇśˇE<’Ąf 7—ş®˛%íĐĐŠr3%(I¶déľ*BĘ#ťŤŰ\í č}âÇĺŰŃ{î ňvô ďDIeY„–OŘ^çćăĺř¤@GÇąř1ťÓFŇ’VSű©†"7X…A3ˇXÚD^ń\hćeg0iěÁé¬ĺd·ń;âUşD\Ő©ˇ(ióá›úÔÚ(ůČ|ć×F°Q|ĚÚbŞ'ćv· †ł%ÇH TîEF}ŤÂ.©ş öcĚ—~»×©÷”±zľhł€ó-ケ)8`w óű-ŠÁŚ{jE"`D_ËYTuaI>C¦8™+ÝEžÂ«őĽävŚ>4Ú ‹ë~˘Y÷ŕÂGˇĽituÂ0hą,µźT\Ć3ą‹OŔ "ÔżFµ?®& ľ˝>Ýą…ďÓ_ś°ŽŠ ĄP˔ڋ° )qëđ=‰˙•-J©!‰‚zufŞ+DŘ9aęwf…Ä,”W3‘ý+„ŔI2¤KPtâ°Ě-Gű“ôđ¸CýÉ&ó +KŁsKmf6ÜÇĎ„pBÎ32đ„Ţ«nĂO.=ţý<4š„ŘČůúĹź ¬‹…ó×ůhőŮOşkÔ+ż˛u®ˇ<Ě–ďĂ}Ý @˙{«şŇîúŽ)ňČ\Ă…9ľ/§ÜŠ/l”Ďé=Łá6äďţ–“’MłTi•$ń0’6eG-az†"‚s(Ů{źŘ÷RłÓ˛é r5ş+ţ2ÇĐ-?ŁQ»˝:ČD—¤Ô} @âa§sW˝`ĐcFűB†ËëŘB҇J.]7=—@p:gŰj'Ŕ,Âźč‹R’‘B|ô(%ý˝g˙Ë+oűb€Ť®™7W‚dVĄ¦‘Ż>Ü5­ ¬ßM$E ű˝ęd&ür2ź"IHľPÇzö;¶ÎŇŚ…­cąéčnőď •őîo]B{̨ŐřöĐŹzĺé˝ßż\Jł“ČŰ÷Čv^¨KPÔ6~…ŚcöřĂuŁŤ¶Ĺ€ÚPIÓŞ˘•«űĄ{ŹúĽÚ·®’aÎ|Zćţ®úFÚ?4m+@Y˝hŚ3¬úŞ0çmś‰élhrŚ»·çoĐó ţ‘=¬ą%:Ľ heţޡiJ(*BZśâ3żÖĹ®Y­5m; d˘,*Ŕ«îÍËČŐ„~.ł2^Xbăy”~§)0ýá÷Ł#pJ +YţżÇ§Úpëô,W)á•Ş˛řzűNf±ĽŘű7Ŕ{»Á(yY škMÝ)Ó%Ţë4kŽs §ë‘ęâž źKŘô$Ă"n­˛Qr˘dĎ>˛˝ÔD †"ľDř 7µÍŤăÍřî¤Ä$˝ /Xř® ;:y^´7‚"%íŽú3 ‡5=?˛[”F¸ăFëÓ¶0Q&zý#ZßyeIĘ_Űtóy “ŔGźµÔÔÉ–üHĄ5$dÍ«ˇ^¬™j:‹N[3“މçÜZÇ%„.Łě ´ż˛ibvS97qAPUhrĆ}µ ‡JY–Ć?- Oç´ă—fz’,ĸŔA3V»z6Żł ĂŽĆ䚉·×vsňfđY{TLec%Öú—Ń ŬŢäŐřř·Ťy3Ł«vÂűáB)úŰĎF=óžĂ› …?ŰĄ¨ou®Šűj6ójÓĚtlŇ%źpr®ŽkŇ\ P=Ë<@ľáλŹ#O †R0Vű&‘ĄI”öôÖ¤ĆëăÝîÚ«2Ąv]Ă[sR"w‹ĚŔ9$=írن¬Ň]Ş ţ„tg'—şüńőXOrµ3B˝8Ś=ůź´m€˛¶ ó¦ P—µBť űćU°~Gáý§“˛Fη€ĺ<Ý’M¤Cň „|0·…eŇLX©ýúƵtv!ţ.¬ňx»ďęA†-ÜŘ&ŔV÷`sf@ě¨ńMÍ!F'I–zGíŕń'Ýíjôů-ŢŻHÚ*un­9¸‹ô#ĺ"Ń2ŇĘK‡>‹ŞYvCsh_m$¬ž‘×"úPŰłÁHnŮČ{ÇD—^ý_$‡ÁűŤ©ů\‰·©ŠŚ¬Ď’ű*Ë$ĆĄ±ž™cCŘĆ˙ý‹OŠęţ´ouć†ňn˘"ŚiŰiІ¨uĽ× BĎşU™¬/Ś N\Í:n°Ţ@ `ą4h+ݤWĺž Wő•Š¤¶&=n¬ ĹLHh˘™‰Ľ|?aŠG–ôüĐD![śU_\Ř!ŢôžtÝ<ĽâM ]É«ŇŞ4+·ĹFĐĺµFÜŕöÓë‚D+Wßă.“kśĄbRĎjžXXÇťkĺ śHmk á´ö-^ł©Íń¶Q¬Öł5”46äQ¸TńžmŰs1Ż")I˝"łS`΂ŚmI?ŕ´ó vĽäî…]ýB)(‚,!Ţ®7Łn)r`ÁŕťŕŹ/Ź źŐŘ#xő±r§>ŇĂ_°(Č›„K:ĎýŠ«ĐÉjÎĽxA‡<ĺŢC/(ôGú7Ľ{Ă \!Ő·§‡¬AµĚ˝Wíkřz9ůUčcĎóč˛ď…ľ…䎥š†m*o±¬B¨ŃŚNcGŁ'ý %ążń„Gôž ¨WëŃL»úŰäw|ŕ†HQN7ŕlXXi—ű-řz’Íp•Yzv0ůŁ.u­¬®ßVDsĎ7ž_Źn?ed–xilă¤T\0¨ŹŠ_ĘĽKŽ§Svµ?JŽ˙ OGŠé‚Ż˙¸ľÍÔëËóţU˘)çrj®~Šyý‹“ňľ€öJçۉ_ĚP`űS<_˘L˲śJN.c™ďZѱ·××>Gś¬úľ{S< 0ržn# ł_^őÇ_txXÖ¶6-µ7Űžť×Öčąž[]áŚl‚q ąšË$öíľĎ´µm`L a ł QÂč‘gö7y–=¨…őC † ›POh¸ˇígϲ`ĐIP/łÝí{F…5׉‹âFpŹlŔ±¬›`žh¦Ĺę¦_äô2÷ănAď4äzć|<–¨;NmçOq B«–`:ćDZţ-ËOq IÍ#§Ó›ößúq›Íx ď„Â,Š')ŕ «9Syá ü› ~Šě7ó˘@đá^©žU[̨÷z›ôŔ)ewzf"Ŕ“í†&ů÷¶ńřFůŻ·Żä%hÓwÍj¨\g9`ÖŠšž‹ŰőăÔ–!CQg÷H>ĹîÚ?Xí Z±űŃÍ“‚‹x9é/LDě·Ă×E>™§<Ž&Iť cĽ…rŞĘůűě5“ËŘ ÷ŠýźD—í]éÇ…˛I€éWäp€Y â˝Čý¬+ó¤ĘŤ›Ź.Ţw’Oš=ł›x§áˇů×6 Źľ{Őm‰qëśřđµjŰy€şżťkŔ_séąůł8Ćx %ţÎÝ:r^ě1&MśÂŘ˙üv’úQŢu5Âq÷%aË·;áPĘ€AśĎ˾߲ę€ö70F”Ë$goo€ěukEBŔ,اq•_ç„~ĺb®7Zĺch3yµ:·s«§â O)Lc¤¸NdŞf'#$U$Kˇl™ÔźIčnÓĘÔ§‚ }sCłáOć~ő±u¶l:‚EĂ8čH¤¦§™ˇ–yâ ĄäżRX\š0ZħF_ťĐ%Śz$ńZá°xŃ‚őeĐ»ÎH_±Ĺl뀕•ÝÔgĘ&ąd˝Â†ßĽŰsD"YŤÉ´ô_6kŕ?ŔW%á_ԙȣ%¦(U`ŠÜ@÷±Ńő;ż îß đdşŞ#ľŇO/ą8ëٶ‡˛uB^"łq Ťł×=s×jĚ>T«  ˙¸űÜ÷Ky^čön0fyné˝^• <0ätšŹŕy.Ť %–‘(&«*€Ŕ˘·ĺŐĹC‚%{Ö˙L(hňOXĘ0( H)č Z,áEză sb2Kí”5ďĐa¨“kµ 2ßĘTU—âE4b3Ë@)ćT˙;a®Sí™W˘ HO`#ʲ®Äo ĐR÷|ďÇőxß_-u¬ ć˝űSK-jň¦V+z.Nş¨µă·=>ńěsG”ćéĹÇaßO=°ÔWĺŐ˝Ő?ŕĄ@â­iŁx}$˝w\ßUzĆźÔśuoeđ·C;&;·őäËAB]čŔĘő­ďÜE­ń­}?¤{žÂ(Ŕo Ť†ěˇšë†ąr@łČŰăÔŁ,żŚ§ý÷0>\ŮHÔKńšČ.SÎ)ˇčRKŚłK3IaĚ@Śs/wB0b˝ĺ Á‘ľq „e@X­UHaýIC´ĽĄ.͇6§ň~JŰW)ĄÖW%!Mxýv¸Ą ¬0–Ćü‘xŮI÷ĐcCĽm¦Úö´NÉź­~^LąŮD`Rb¬ä˘’B›~i¤üáU˝^7Dĺéۦöĺ—Đ’2(N(DUÁO` ©+dgšTťTOWJÖ1äC­Ď^E©éĐ(©;Ńű%›@ý“ŮítżÜ­FM%RůóçîEťtü˘Ěç×é äEKĽh7 d«ŻĎY-;řcyvZyęEużjŻ!1Sí#s#č¸%*d`)ŁQôóV‘}©k‘YÓ_Lňö[(łžÚ®î»)r¬'˙trśMX¤ĚŐvW•´/ ă2Í­h+÷gçŇŘłĆ÷Ą…éč©>ýy´m/ŢĽI>ěÁ´ßőŁgS‡ö<ţqf¬“ň2$ÁŃ„č^‘ů§WňSŹńˡŕăÇ™ ézăc°u*âÉN,ZÜýĄ÷#ĆĐ•[ą&ůËĽ+Ořň¬)cîw0{R_ŞĂľ®>cŰY=Ő˝ßxťß< DF×"ł)fZ•Î27ó­_żş;iFLĺ¦'źę‚µ·ÓŰH=OţcEÄs(5%S) ÄűóŃČ3„ň™HrđPň5 m3Hć\ą¶!W‘Ź{ÍHG/˛ŇÎ,ôĚYT–EAP¨J ڽߵ`$¸¬c őQÁi˝äAë‚ôŤ:P/ť Ł]a~Fđľgü÷~uu÷jRTŽ›ž~€{ ˇl?tP(ąjß:”q• —Ôůçi=[P¨Ť Ű'gŕ‡‘Ą}çAÁ‚"Ń°¶¸Ř[9Híś—+Í&gµŞŚ$Â8U8L20ĄŮ«$x5Łw±Ŕ6|NŞţž*D$mŁŠ*áŕ  Ŕ>–ó^f—ZŤ#łŔž—K‚évŹ!ŮŰęťŰ»×†÷ßg°"k·ČĹĄ`|LĆ #MAł2CuT¤ő¦‘TĹAĂvľ#x±Ă`H—A[˙^î͉a"CJüžFŕ"x}q5‘9jwtŕś×ą› ¦!NĆĚő·‰(¶Ů|ú]Yţ=6®qwk•mĹ ĽśËČ -Aę7Ý©ýĄtŽC#[ Śô+¨ôk°JËď_i•^}!@‹đí.s[°·ëŐŃź-) C6DˇDęrúŢ#…ĆÝŠĄ>ţ(é‡Gl¨O”ń÷–Ře€l.d#wIÖ©$Ěi|ëÜH1/Í%Ä›ŃYý‘„E­FýŚőż”XŤĺ5zćŔőß‘ąÝ[‚čc-á‘_iĹa6Č ä0ţV™1™çţîĎáo˝ä> žS´Ŕ”}ĂÁ|‡7|W†Ö›%?1_Z›•×'5°ď!ç|0o… QSŞóOŻŤ§¨Mµh}MŇ٨!‚ĹÝ4ę÷»»ŘÓJYĐŻ÷Să(HüTŚčś:ĺ˛Ţ·ąâQTçź("ş4ĎJ'5eź j«’ŻŤ¤ Ť¸° YÓ°Ůön˙§›6žuDp9f‡îE˘Źrôܸ×Í%OöHÝ.aÚ ‰ŘÉš„'ü(Ň8|™L¸ţićó˘GÜÔ«u~=2ű»äG‚\GVÔć Á‚7اŚ ”·ŞfŠ+Ĺăľ· şä[5ÎŚď©ÂŃÎMŔľiˇĎ!Á„Čdc–ĐĹQýĘiç€wo·×>ŇNă·Ż]ŁÁę®bF‹ýÄě{˙!¸+ő‰`ň·0Xc‡ŐT‘›\÷Ń­h°nr~U›Ó ’N˝čÎâUőMY5°kyš¨©zUŇAäđ˘†ŕřOoŃR¶~ŽU=νx°č—2±€k<1kĹź'X…•'E31ţŔě W[x|@0ÁJL‘j7Ł«H€ńJ^ş‘¬żuź†›ž„k0ň»Ęď©eÜIÎAáE¬ i·ü©+Ţ~ĄcĄß‡hdŻťîBŐc©-~J虎 „[G“jÇElR đ‚*“§Ł2°ŠĄőĘźţ#ńŁ4Vws˝Ĺîn¨! '1ť‹,× ¶§ä¦=UQ%)PŞĄýĄyDân•eôr7}3 ˝Xźěýnă}íŰĐţúĹŇ™^§ŕ”¬D (íĂ4±ń˛bĂ  ¸.ż>SqN(bP}Ďř]˘)Ń#ŠLľîÉ`b0ŔŮW~<—ę¨ń‰w`IÁ1úóhr‹Ěáýyo¦t•xţ3¨u}Ö{ą -ŤMńrĹĘ޵ŔX\1uĘa´BE2>Z`¬}x°päĄÔ˘(îx†p®~€đŤá—ýŮ×Őý3 jĎ~żĹo¶µI¸ÚJ‰GíôŤ*jWŚßÇ–fŻ09ž-Wę&Ô¬´SÄJMŐ@ dćOčś ŮDi€Ž!;@ZYŠC‰Ň›3 ŕLSbkň^ŮâUv‚, `wjďTqqFU^×f†˝žÁśä)!ţ»1ďÇź Ě-©Ž±ôŔ˛:™9{ÂŃčĄ^áĂőś.Ę´43uúíC-͵HÇ’üŇĐy–Ć«ČMJ ÇęĺâDo˛‡ xî]Ą>őŞ!e0˝ěęÔY/5-őҔפáŃ@7Ő_|†ÉÎyŚěÉçŤůca¶OBeĽ\Ő„Í6-‡Fët–O¸Ó§fµ‰ĘĂ=é~%˘Ň}vb€>jZÓ ”©ŮÔžŁ*±kšűŻ~(˘‚„ŕ ÜĎSűáhÜ7Ż.NÓD 4Ó4ď˛ruW'CŐ§±U:Ú‡¬¦:‹ŘůđZđ oq»S˘¶rí-íFó|[Ó“ťZ>D¨}1)–yŞÁâ¦aP›Ô:=› ý©Ö<|DŹčˇGe%>WŁ >2FĽÇ<$ŘE"ő­3Wđ=ËćPqŇýŹVkµF+Ô";3$'ŻBö˛ÓŘ·9 m©şő–Ą ĘUŁľ°$bFăî[ÉĽđťžVź#N1őSÂňó!1řo÷ü‚táÖO´y“ÖH€µ\Ď@Â-Ă°€ ęC!ŕţÂ۶…[űÓłî×+éî‘L}™:©ḉ˝*“‡ňŃ“ßßTž©ţµóčţ8Ąs†IJBŔeGÇrzVĆ… ąÖv+~÷bꢄ®k†S!x.3Cµî30+öµZS©Ü·}˘Rcé}é—`×ĘŚGůO‚Ö]ÂÖŘĐčh!VpŞýˇ™}¶K]Cŕb ç5Ş«ĐŐ7-Ł=Z´gCČQ¶ĄW6euč°ĺ•oÚŰy§<gS\ݤťőgć9§ Op4yŻh’Ŕ€ŘÜ<:Żs%b¶îÖ{bUµë”kÎS‚! yÝÓ˝Éý©p„ĎéĆYš…ń`MĄiĽj „©a•[c 3SËkSÍ_:—7¶ąřČ>Č´˛ux÷hžz~ý$ˇ\«Óa/ł1,PwR¬Čęą3„–¦…Fő®ž ©‹ŁĚbsć×Iuđyń‡é˘¤,~–|ÚlÄˇŞ ±śřèHďĂ&aŤ)K$QŇÔÂĹQ˙ ®X˙9`ťëěý<䧆ŚN÷šŞGĂTu‘ÓIÔŤ4š42-µ˙TUÁW"§âTĘÖÂëŇT˘ďkKfÉr›IšĂy€áüĄy»cś)9– bÍ .ăeZ¦3C\đČĹ  0\ä¤:$óŐŃŕáYÜ•[»|G;véz˘ä#ŻwŹcłün ©2¦jĐ(Ů+ÝdTŮüŠq¦ž78h%˙o˘—)źµĄ×˛›®«SÂr0š…1•ëB•e闪ת˘MĎŞwźÔT;â-ş‰˝˝§.î•íl¨ý#˙ďaÂá©–~§”Ýĺvŕč7âŮ&˝üÎőTeW=tMqj WóBÔ'’&ŮŰhţRK]ł"ŻŞć8žÎčAĺköÁmßů˛Ň ¶ş]Š®‰Z_[Šäź!‡šI7ŹÁ4myD Ť×nĚDžŞľQv^qŞ€©{ŤLý”7p–2.C%ş&ý rṳ̈™gL›läd;KÎůpkx«%ńpî­słE#kŞY¶ď+RO1ZŻlŤ8Ĺüf©—hTĺ™~ää…p—ăße°·Ý"XRIţ řÎŹh2Ë#Ľcx‡A9bń†–pŕ=ĺç*]Ńa6R‚¬‰^ ,Uz Ö7źßpSřpżw3ô÷,[Ţ»q>”Î$ ­CµnMCVŇíuâ ĚKľ­˛jBŁ°Äč” @u39úĐńí‹dUJfy±µ°ť@Ď Ň±^ąžć˛ÚÎyŘĐÄÂŢęůó8elhިŐz°˘+ů–ŃŰůŁ…u2+§áFp§Ď/ ̨-ő1‚ěĄÇ©Í`¤)ŔđeŔďÉxV»dć]ë9P’żk~+ ę1š”ÓL­v;_Ăř˙ÝxÓĂ•übľM={X¸ŕ3ü†Ě楫‰×>ÖŻBĘôÖüĎXŵ´°™ü€‹?˛&0–E¶®†M4ťŤrSdc@ţa¶Ţ„v‘k@đµ>©˘ő /.ŹSe˝Źç°ÚónzÝbőđüGY–5ŻÄ "Ř;xŽ”˛żäŔnť‡Ü¬;˝”‰·މۚ°ĹšVZëȱť ›ž1€ß%D ř0¶yů[ďŽě˝KM[±–ě5c5)‘öř3+6ŃŐá+z ŽüĹĺëvĄ]ĺjćě;#qvŠ6d¨<˘ĽőĄnqßł(fzCĘSBeŰp‹ü㽉{µYRÔ\­yŞš¬»^ÄĄ,4M=ŞMn:H|mîm0É´GĂĹLńĹř‡­a†@ä»˙ś‰ľ‚ÉsÂS,şbđĄ%RŤF˘Ź7I¬~•Ŕö2Aâ’đ?ůÓYťKÍ°Ť“Ô;é˘ř!ć¤ĎąňFĺF˙X;‰?=küa𛥦‰\ŮüĺQ¬O]˛±ňüPĄź©€ŔÇ<ÚÂ> Š«hą¶.‡DegŰŢGëÎJFl)żňEdÖ ±Ž+‚ż7– ]Ţßď]î[y/íR ŠA?"X˝u5ľ_UŇEXăŚ&¸… ëďn `Ă{ŔČßÔű鄤{› Ć~c®”e“¶;ČŚ(†Í6棩.&*ŰŇŚsăUƤhoÉ°zÇu©Ůg;ÔŞt.¬ĽÖ‡.wĆţ¬ H™Ý"nDIb®`1˙Ŕćökq´bŕűkş@{¨Mü˘EÍa^ '›˛ŘóŐ ¸JĐ^/‘…«,XצŮx¶ÜvłŇ4] ţ!Öxz&çŕ÷$üQ;'x÷})j·dÖ>9Nâcb5ôuꛂ°V*b€ý\ď(ěcűťÂâÍ„A@R{¦:‹{ó•Ô¦jh%¦§őćKHőPs´¨ń»Ąv˘ůUc5µ‰~‘XŇ`ŰË,ěÄKµŰŽ\DĆţ8˛6Źt+*®­ăŠgťŮ_ŹőD5Ą=†-(¦ą j;±Ľńń.šz±ş÷í6×R¨´C)WHńŔçĄqŰ<×GârloxlQ1QíčYB\—Z`ÜŚ°_ĚĄpnäćđźĐ`}Ž‰śëq°×Î8ťĺ đů=Ď °˝ŐĆ°ŕ¬ÓäHA%„g`}šxÉ‚B4püt)~#Ć羚Į€"6@j¤ŔŠŃ:nŞ}Îă0­’§¶°Ž_•hˇ ôQbu|) Üě„\[aPJżŕ"[Ó+ây„ĄH ËÄý« ËŰY ë‹ë#I&bŐĺޢŮIÉŐFHVî;÷Ó–Qy‚7ůG˙)>DqOwďR3ýÔaťń›ˇXîŠjÁöT)”Č«3Ó©órĘÚ óë0@—8x …3Ľ¨]`—×a6ćŹ|Bť)vhlv«.Á‰>"ĽP÷ź–|^Ż°ÇI©ćG¤ëšŮ1+‹|đM– qôąřÔ&`‰žkC€’f`OŇă:‘Z9~ń¨—:/_°é–q‚\‹A‹úDźt łŇo †€5™Ĺ%-#jhÓ}eńŹ igˇ%¦aŁÖ¶ŠsłŐnâ=˛Ř˝ `»F\9=h»‰eŕ€”†ÉFÉś’·ö(Ü­)6ź§Ëźřo9Eój#FşP ŔěÁH¶'ţ“ÔšĚ2š¨36Čď;Í'ăß{ŕußé )Ćk<2Ć_•‡u>ĹŐX|w›yfťF^]nŐsĚ„ŢHeď|öK$Ň­·éŽś"ęˇ.ź°DĹFCôV%n+wFꦕ˘ť{ůË- z…b&(—orďB Ą,ŽF©Ű+Łăx˙ąůp«W7Ćü˛ńNĽ•„^†›ŤşI'ń€ĄP Íź;ci(,8ŚsŠćEkŢŰGEŔŻCčĄ^xc‹—h•HŘ8ö+eŘ‘<±ş±b}h‰les6 sî@›čďbĎs|l‘J;"ŚmWLµwC`aVŤĂÖaj©eíRó)ĎßyâWCuqŮ&ɡfcrÜźÄůŰÉ%DźX±] Oé4óŞĚ!CµÚIđŃĘkń˙Yă*µă2ÁpE%"ßđ Í’WżăůmÁ‡6Ć„˛JŇ+SęU˘0=–5éh;˙HS-䪅+Č;Ľ EÉs'ě7¤ĹŇďTµÎóÁéđ#88ß5oľ¬`‘ü`W|"ř…¦Âd{UM¨,!0uiřˇľ˛Ř%6YQŘţőúŠÄö€$g}˘Ü‘ńö9_×»`űĆ`H!Ű+KrR{)üŮÉŠ^=CžcgŮ}wüh"oN”KČ÷äÎrDbČC FšŕŰŠŘĎ]21HfěGO_Î{ 6Y“»kú”4_D¸?kaHűvÓ ¦ňđŤÂÄĘ…žÖ¦žc\Ý._,Ë…ÝŤv®$Ł˛CŁÝ¸m.ăľë+}¦ !ŮčZű“/ť’oőĐÂ7UXż˝˝©ťBq‘ˇuq97]ť5X™]sNŐÂÓP+§Ĺ †d4©ĹşLŁ®N©rF’čWú‹¸6Ąp"âÖ5qÄ?7aŞĽ\™übłŰäLHşS5(Vv«• ľý.»uµ”µcĆ řč8“O/Ź'Ź1ťÔł¤‘€;‹ŽđÉw¬=éşqŹA˘Ë§–¦úŚ3*3ę™cĆ ŹGăďˇ)]Ş'ofžm'ĐłşżŽM¬‰MŽSKa@™ÇţśĘä«*iĘčáďŰÇ͢XŮ«^˙=kRMpňĆýH$Ĺx8qAĄ¸ëcŞĹůň%bÔ~$,»‰3ďĐiF•'?ü ů—P¨›Ç‡KŹ”C;&0%ĘxȧŰÄó”ÓyČ˙ĐDIömGÔžl€—|<ŘT\đ˘uÝ˝ŇlöIh(íľu ç|Á;Éj¸đ 3´ĚćB<\ŹÎ™ßhCüédüńŘ@ edM±…šÂkŰgO]öY¨ žlŔ9ą­ßĂSšVÚĽ+y«űuăŠa΋\WžĐ{±e¬Ľ˙au[¬‚u#ť]ř<”ňµYĹI­)ŞĂrć´ë7 Žbş­cV˛UUúXVläUˇ3Źk%ń©âÇ‘Ë…6kjsA§´î&ďDó.nU7aŢúÁW }7­Íćé˘YŤ<­úVTÁţ)Ĺć@hÇ5Z21§”´âÜÁňbđEz_ën~Ö8T0ˇóčńő>Ic ŕČýö /—ĺxŐxv–ń™Ů€ç#žËŰ%lq6đSłöÖŰŮSÎä&¤ÚČŘ´÷^Kˇâęť(™O­‰ęÖä4a¶˙Ý37¶ĐÝE˙ČCÁiţ Y4ă9đä1Îývąŕz9fŚĐo|ů%Şv uąô"ńy%ÇÜ"?&Q¤ŁÁehK@°F:«Xve˙Đôú^ý˙üNŽ‘Ű âůçWD°şśqşr´oÝçzÉíÄěň}5}C ŰşzSÍJ.izÂ˙¨_ČHÎŐR·ńż*N7ěŠÇ3CŻ˘ ´ę»ÝµűŐ^‘D»…qżEŻĐtwÎz$U›ÉŰŠV:hě Šç\ýŇ»YĆĺJ=qčĄ}bżv“5ˇ„—*ćÓ"«R`˙­š'Ýć¦"âílé9ÓI{Ż—x#ţA¦öŐ¦ú†YR,žpűŔQ…$}2AÇ‚^ňV"»{­%I-Ó čS )M©©Č"YîТíĄUú‚ţâŔ‘M™‰ľ:ĺřŐú¨ ŠÉÂM¶Ţ>©1ňŇ ŰnĽ6÷­žÇßÄX}ż#­bÍ“őđç_ĹeY>…pNdi+3 0¬™}ľ]%Ě2»…°('žAw E'ƶŔD^.ţ›„¬~đ¤Őo‹—%7HfI´đüşé{Á˝4ë“ű‘…/A°Ź`’h±dĘt˝ ‹˝qvŕEđzám ufaJôY¦R^LÚ2ž…ޱłg¸[ďT®=Ôľc7•)O_’ H»tŰ]ÔšHńńµ´ ¨[î7„'öÉCru”ă 0Ź…żb徎A÷™˘ŻéÎăęBĐahľĄ;WĄl7wµ¨ T4ÎîŹRĚ©ž`¬= šńEňhG"Zű»ÔŤ-ďWiěďFQ ŞAsńSV¦ŢžPRÝ÷CĄŢDöĘč@šŃ“˝ě¸|´˘vô”żX§¤hJ¶z±)cpnĎ‹{gT8D}áHR ?ŘdGA“™"%mkŔ~şáÝĐKÔ·śqŤDĂl’Úi'ÔŞĂ!Ń51ýK5ăöFŠ«Kt7Fíp_Ő/“Éfî“Ć-¬‡=` 9Ř[h…©ţÓ¶ś¬îľęT>÷‘OVc§DŠUpsÓÁ Č)čâzÍĹäFW…k ĘQ®± ç´ŐJęŶ÷z¶5E7hľZp ă‚„ÚZ`¦y¨ţɸ.—vľśú\kÄHüxvłXňÚ׾›RK ëŐŚęŹK¬»ĂŐ=’ ­W‡©ţcŽĺč·=łĽ‹ů»˛joÔ®"ăpqm'ÜőzÁňý7€­X w+# ”Íbńęěčľ2´ h~›ÄhtWŕ[Ł OšŔ¦,ŕŽ/ęĺ˛đhwĎŇV$řć]îJI đB1ŤÄ 0qý…ř¶Ń”ę®Ő…ěżËV?ň…ö}ϿŒ龿 ří€ĚÉčűŻ›˝¦Ľ~Í9©Ľś» ˝yAf )îóĄć±•7˛¶ 0$”ć=zp8‡ŚĘňug/˛•¸ S­YW4Źš<ŚŚĐÂîăăä˛ÁźEş`Ż´ľš=cş™[üĐ…Ŕ ĄľsŻšD6°Đ ł–Xl X{đLWÂĹU%GpĽlĚ;‚O\ŠĐ%ŠöuĽýŕ®É6„öb"R?q»č¤ ú˙DezVňś 竧±ć6»KEbsxw’»ĐF¶đqŶśZö‚•ŁÜS¬;Č˝†.<·˙=•:'¨ŁĂlľČ›ô[µ§;z¶p:üdČŢôdÓňńŢľI#Y>˙sŻ(ĐęĹ›WĐ1•˝“±7Çä+¤@Ë=¸ „ö{=}°–U—Ż} {ôh}:{´ĺĹćçSÄç\Xé(Ď[G3 ŇlâÔŁDŽ˝käűé›»ţŚ1ΕfIZĺą7‡/©t]ů—¤4&ŕEVĄ uş®4ň«.űĚÔk—a vE›*‡BßŢť) E7YKŁ¨éâ 5˝I¶Eśěěo)•@FÓj:ďč–ţżó,PˇH¦ĎĽSňĄ>řEčWc łĄLóŮ“ĘšŚŁŕ‘g— Ŕ;^\TQű’(…ÉśŁŰdúĽ3†.:›Şka‚ÂNz=X8©n`&‘) LO;ŽhzŐrá” WE;„<âšuŔ>“ŻŽbćţ7 ±Jw°ĺ¦×=2%wí|Y°rŇ@5f ™ęD;sÚ ‘łEA˙túdč»dÚ2ÂÁźR€čąÍÔťý~™ýzuIî®Ń9xť Řöz <ýOQÜWÍ :®‘5ëďČߥyişłjWĐęŔŢů5·Iř8ŔQÝ}ľ °<ëĆcÇâwKĂĘĎŹŁŹ‹äu÷„6–n6¬ćÓŠŔ;m‡f GÜM/%ă,śÓťĺaÓ9*h–pć1‹źg”‡/0´şČIČŔjŕ†„}?Ł ‚ĆŐ ©ňrË›yÚpî$\J¦úËŇy)ę±jÓYáSjţÉámýýż¤§zcKIq|,‹aL‡˙[zhŇ„*ŠéT<7Ş˙“N0 ±JÖ°Ńć+€—É»ťćiÝđFlí;|n)ä¶đFű)€ňš¬ęsG=đkÁ]źNÄ)´Ŕ,řf1vě‘SŐřćo*h¤˘üĎ'¦®>~W´ŠđR”q´Ľ†§úSĹZd¸<ŮgRźLU© žšgČüwď‹+hÖţ T,fŹb‹ÝIŘéĄ'Đ_4^Ő¤“mčnÜWpÍĐG1’­`Îȧ'ß9€¤°ą[Ȟʜę˝s!¦Şá–róű¬$.”ęZz‚ţál__sŐ™_Ůţ˙ĄďźPPŰĂŮľŽŰ˝wă÷1ć3…{đžĹĐ„F“su\ńĹżĎĘ4–ö,ěŽ}ŚĐ §ŽĽĂ&…ŤŘZŔÚ)ů(>’,ľ´}š9Ń.îî‘Ą}˝Ąt#˘÷]ŽŞ-ĚwÁNµmĄďâ~—iĄ-dV3Ô{÷\& ;Ç‚/±{ÝJű÷NĘӢϑ úÍ/ÇÂů&pżPĺÔg!fśz‹t×ćŢnş€€l$č Ä+ĽŇĐ6éŔJľc´‹Ë¤ #0˛ý7ŃĂR°BN~đ·˙_X: E|ÄŔîÓŁ¬“âÖîŕܢ“oOoüÂuĺXĄţ>â3qűzCߪ»ĺ$‘ĐŽžÇ‰('_ˇ©ÉZdaůC,y’źç;‰ýŽ’Îí#ăĽtŽ_Tř9:0% @rÝŔ€c]çqŠ”Síp¬ĎŘ%ÎdË,tFŻ:śżëD˛Q7Żt\ťĐ‘”żSŚVµn@Ô涼ҫK¬F+ÂXjݸŁŽ^AÚ[łnQd Źg­ď…çÝâ·Ů§\ńFµĎJ§>x`™I±G2ußŘĘS7ŤJˇ-ß_é´ČĘ˝Ë+¬N´VxMQłupĹËA>şn[ś}íQdŚâRűĎ´P€‘ĆĎŇÉ ŇQ¶ÚOA+˛!OąŔçnĐ1¦.xř¸b­ëˇ“ďr9Ł0÷7 ~V9HS„ţRř)yăEć„$lćŁi%v/"ÜőXăzUĘĺí:JpĹ8Žý?lVoá¨âŁĎč­oPSc‹%‰šĹ‡pc]%ŞU_É$…ĺdqÝí‡ëĺš«Z¬):–ŇĘÔjśďc°ăB¶®ZĆSU­[™°˛týH|W¶5(ő+EPbĐ!NééN;đYňÔÄ0%'V@/7O#jçŠĆ¶ =@Í;ň„KÉuż«P2čN­ŐęDĆĹ ÷Ů”„´G¨GhS«éíßЬă/“Ý—@ű˘„}•ËÄzľS/ Š–ň#AŽâńó"ŇÝFć°±.ęďÓsKŘăEСO¨HůŐľX9ű/nÜ"ĆŻë˙Q‚mxń›ä@ ‘^fÔÁ´ä :főÝ=ěQăůŮxyE<ďyIĹNË»žŻÔăr˙ĺ}ň±©gR†b’lzk+Ţż±Á Lü‚8őh‚uŘŹ„"1u\oSöă[nU¸ 8&.†â~÷Bp¦ąm„*©>śĂŹÚF˘‰Â«ŘăV_” @ĺâşVN¦† făŇčPłX˛Ő«»2 霪{Ks°!čŕçĎdŮ—¶p0śW Ě»ľĂ}rه<Ť§6XýŠ06†3G+zä:č©:Ő’h)ÜPd4†€Z°ű(7pĘí“ĆѬÜTŽ§pÓ¸â%mŮý‘ÁňwŢ›á×äz° R„‰ąžŹ4T~“öż•_ShKÂĺä6µ­óť7K%DwxâÓgµ2ĄOM ˙ł~éĎ‚Ň[á &¸Ůş“á~ę­GškŻ°h“KW˘EoN‡kô–öB”ýtBVZ­6 B§µéżR—­čŻ©R»í€ĽĽ˛W/÷˘G’,ă˘V(ĺwńh‡żL˝_môÝúĆ(QČŕ]LŹżTˇŹÂͬŰçđZEĄ9]ţţ(?ˇĆąŻťşęő{§Ő4;T2řń¶;ż©_•˝x˛— Ě ĚcÎď%če·hWtD“§ Nlpé€:ź%wZ_p!ó hŐŮś;Ő§°Ç·Ňú[Č´ňmxBŔ Q¸«ů;Ż1< é»mÂÁ.8M:st˙`DäĐF·QßDxňbĺED35Â˙[QřqŁnČFźĄˇ‹F°Wđ‹BuöčŁŔa¶#’Âi2ç€Ěxűě°¶ą™Křt«ń+ô¦óüăäâk=8ěĽt!ąCÖ,ź~($ŁýŕT»j[†6käĹŢń}ŤÄó´XTôéÇ«ÁS·E:ę—E%lĚoř€i!#2©?ůÄ\̵ř‹Vůläjń_cÚhiĚĺé;lP(ˇ‹GÂ&7 °ýý·•2żÚü.Ąs'SśÜŃ϶ăúő«©9žíPÍG1´ć[ ŚŻËë- @.ͤ^רĂÂ(íq/H±JTŰ"Ć˙7q‹cÍÖÖDp…Eş^ę‚ň4üaÉШlÁ%çřĎ9iÉVT'y˘×XćÁ«;×ówńK 1I+Č\zt‘Ř{ľä›"[xţb«A¨_…úČÜ0bŠwjé"Ćo«S˝,=dM±Ň!=ÇávGÜ&BŚDEň¤ LôćiďĆ7][ü'0gŕeőćv|ňp(ź"ř€FŔs¦ŻŐ¨ɦvŁçŇŚ&Đć°Â¨d‡‹ČçőżŞą‹ĺŇ5eHŻŁlq86Č9˝`PéMűDjĂ=‹ôÄz @^×1öŃĆ(Ď–čbŁ¸ń‡™ ¤ýd°dçMRâęM<‚‘şU(k’:Đ_ NWĄۢ'˝Cň{÷WÉuŻ)N1ÜŔń}ĺ®;ŽĄ°óćă€{\fĘÓ_Ô™˛¬+őŔŞ×µĹZĆä~PJ} &ůbZĐXž.Gü`’Îň“!›ŞŠß×l/ĘVúiT/’ń=µfćń 7‹Ż‰Č,Ęéô"ľ%Ë^°2$_QSąŞúé¨6‡bŤWŃĎó\®ż\L‰7Ő—'ł÷P—ZenŞ®áqXňHćĐâ{uşNß»]ŻÜęD´4đ Żď±ëř57ˇÔ5S\ÔŔH30ŇÉXMČ[ĚU ^vá¸Jő˘E1+śÄxöwéab‡GĂcÝeBŐ ŤďxˇöciŠÍ,ĺäjć„»Ŕ }_·słž@°w! ‰ÔyłČ-ôě'ÚéŘ9<$F›ŐD-ÓÍ|F$:BH9UZiĘ›ŮF˝ÚŃŤ4ß15Ť2FŤŚ_Ĭ]`:•~§wţÖeţ a Ď[eÄó ¶Ćnöč"ŚjŇ2…đfúć¸ůňPÝR®Ţß1á-—˙hČWÚ«ś ş˛ň÷:ľ•BEšňd+[Űa×Ksn®¤V`7ŐäVúŤŞŘrü‘Qň§}J…F­DĆ3‡÷Ö)Hg0Úĺ ˝ąKËÄ Rż:•Ô‚ăh¨˘ĂĆç>XŹ ź™oBš&@yk‡Uĺ{“>¨†m^X’áŚZ<ĎŢáĆTßpanŰGEŕHôőN+ťyô͆ˮëOŮľ)ţ±ő&xbę®.'ÍzD\WlN íď ôÚi2–úvAl Żź%©ŐëE“śÎSY°Ě[Şç·–Fž-ëE‹ělÝřJ¤˙»´¸§©–á)ł6‘z§[e·2çNÔJuŔ™(úÔ(sňĽ×/ăQŠ¨˝SÚ/??P#ßë‚Îu¤8ÇkăKXGąĹ4d[rÉ=ˇŻLÓ3Şlq7˘Ť«ňS×Ŕ‘¨Z –Ůąămł‰ĽÝľ&źç¨.ˇČ,·‘QUďĚř9Eq’đXŠQg+•u=9a7Őę´¦ŐiU±çs˝_Ţ$tZ>ír·ďÂĂÓwôSě–óÍ&ĐôKähźKô\ő€v>ëÁÖjČÝ}úë÷\’ÉďmÁâ˛aĚĹň#NbŤÎďÓůB«łŤRíş^‚F_Ĺ4ćÍ‘źP*ĽĄOxÉEŞ'+zĂš$/ĐÔtQX± ¨ˇzOX3„,jĺřŰü$)Á*fwĆŽĐW7Ži™í—?ĎľĄ›Ő‘T«¤˛#˛µś”~â,’ ¡·P1°AŢň_/^bžÎľUĹĺĐ×YŔTÖŕ¶(¶.´ËŚm éśjů,Véšßçü{=Pr—|ĹÜXĽ(őľEwjŕ·±˛ýĚiÉ÷ěÖjĎťŻ•f*Éď‚Ǥ%łŽřýű}őÖĐ{pÍ.#wđhkĽůŚČł·‡>ČJ|.ŚĺĹ+gćçaŞ,ŠČ&oíˇ/± n«@Ý×Ufř„î(×l(µE6Ą~Y˘)«Ţq¨ |; Şĺ —üKźB}‘ĺ_˙íKnËíYBGmŘÔ ,«•#¶QÇď¤VI ™@C·xn’ÂWşuÖˇkÇ@N[Ę'µ39µlrÓCĺ9•Ż‹1ý°iëpîE÷2č´ůÁ’Ňâd#ľŹ„ĹsVp#nžŐv¶_Ş7ś¶Ú żŇ’5ۉ]`TAµm‰ł!Ęx!ěâíABEeÖWuéHmÂPŤt4âËŃÉŐę&˘_ ‡Ł/%ň„€_Nó!çĐH0G‹Śí˙łeLĄôbpü˝ÚcqŘËŽ‹¤(óÇ_¶¦°AĆőĐţ ěn˙iŮ+ĺ{éňÄSfDîiq5MÄ ?ńh[%h*M^áă@Ý´Í~C“,á ůĄ‡í1O—őá;آ©6ěĺÂ3m3©([<ÉH ›:Wi§Äě«–ęvQúҤa‡‰Ŕ˛I"bőx'A€ź^}=I}¤»F‚]WđyĚ)ŐĐĹCÇÎS°ßâ©·SËŃÚe%I´/Ň OČôvŹJs1•`ĂšćĽîUžźĄFŠŞ[‡¦ó!@wâ‰yI¨…-fěsłÜUâQ+qD´†w8NŰ0´áoš˙h5›`1ýĺţ›g yńhk âMLéÉJaéZ[Đ‘~VvŹ“5’Úfďٶ˙ˇ ľcŕ–7ČÉÉz ˇ„[›Ď Ó–«S0kňßd)¬ş‘6„Ą´zPE#g荟5g:ů uĹg§“Ż„RĐ2ťr“IbđÇFJRX,nBa»|jW‰×™ąż©;Ą9^ĹŠ^Ůp_üŞ„6Őů1>ňŞoGÂ
Ôů®Ę®ě‚Č|Ä+‡Ó:ô/wMŚ$ěš%˙L$vČçŔ™Üń†~ďZ…űS´n¤ú[ż\gŁ·Ř+_n©–>xI-„\Lç¨wŚVŇJˇŤ Ó™ČÂçŮO],rŕK,Čż-zqȢ˛ĆzX3ʬ&-4Şk 9Óef©^©^ď Â8MşvŮ`,Ń·ď,ŽmĽˇ Ç_ÜŞaĺpđT‰O‡©ä—y9t}‰ţŚFÖźµCOľG˙@„}QĽ=˙"ĽAŃ'çํřµŮň?6mŃ$h[CR´ ŁíëĂ@r›˘BRYŁ… sw–ž"ĽLY0ZĘ©9Š÷ęb”*ŕ{(npć‘Ń5‡¸yQ\ÓćÔŻÍ;S«´Â/ńQrÇnüvŔ睼§”Ĺ®×â@g&©é!“šUu1>‡úvČücNa~ôÖĽńűGĆÓ˛˛ÖŐÍáŞďĆ·“:Úć\˝_8e<|%:÷KŚĄŘp› †ßä•ş1ZżŔĄŚô…†…Ŕ1ĹÚpá“hYt8u€Ď_Ó‚3Ť Č<9šóC ďąîTĚ$vĆÔ$V7UŁ…rW˙fŇdüdoÖ‡,1ŐŰF‘ŻňrkPtBĚźk(˙Ülűxő>6 I`YwwŽ˝y0CŔŐŢ& 3tç9>…Î×É꯮’©a5F)%# 5l«¬pRcÉ“ˇ,|lŐ[îĘÄxúlóřzâ)f۶ß~Ü‘ľÖd¦‚rwĺ4ëŃůJć`K‰˙ LXOŔJ€·:›źZ/”®ŔŽ±É)7¦˛3Ô`UÉÔA§ ˇˇŞ(ě® †(wŠf[{üJ­[“‡:¤9ÓëĚyµ¸Wó›äQéÔ(ÎGÖż Ż¦łľ°·<Ă ’”ŘĆż ¸d‘×/Ę{Uˇ˙aĄÍ)O2„Ś@ńB*z‡ĆŤžUËľ jÝť/Ě´Î(=Oq]‰6™Ý¸”ţ¶b jaçLhŁĹ&±F–±!Š'Žśđ\śď>vt8úň’Eń)0®ć|šÁřvˇ5$˝Xßęsňs<Ř‚ůę@?UŐ§Ňúł°$Rq¬¸ 4 Ď‹`Ž=řy˛čŮÂŐĄCýŤn@ą·Fş{Sd*ź¬5=! ‡·ťµ’)9¶¤÷ĄÇjIŃŤKuáĎ(±B˙ŽV€’RRźő<^ŻŁa @E+„ĂéŘXT··‰1^~06đ[ü J` ¤ŕgŠ '"Ĺó›Í´VÉÍ+ G…s6‘Ľ}P+đ‹ćËS÷®Kk¦Ú‘ ÷ôkĹPóţ•R<äÔ#ťó“ިăůţZ‹ŰŢéýt/r Ŕ}eä ą™ ü¬ĘĄ-Ĺb8ŕŃĂËĂ8Ë”~nabÇ#91^A·2Ő¤M€µn2ŢŁ+<Áo™ó*YçĽQ™­ť$wőú7Îu>vjëq)2ůP§d6Ďz®vhM:¬j޵»©ŇŁĘňřŚń†5Ú/‹ Ń7Č?.RXNÜë—Ö¸;ź`˝Ë|`ÚÔ)ąbď늴 řŚÉ)Ą­đë4pHgk‰=l·»yhwOšb „ţŹjđ=&–…çÁ¤ äęG$ôö¬ťýńZčňjo‘·T4QqY49i׹é&źEnLŢÓ©Y!7Ő$Ř-Ęvüŕ•Yĺý%„ăćö'lÁߍsň::…)*®Ę‚Ę`ŕ~?—†ş&pl´^¨RCĐۨüR]´¦´`ű‘+˙j 2&c ŞŔĐQćÜv”:¶îµĄÁ"Q]€Úc«yÚhV’ ŻpîŕÔđĆlź?ĽJ n­=K¦%gu x%şQ5ΨżbŇ‹šşM Ěj®„ú( ZxÝexေM€¬Âí¨5ĄőT!ő Ç{’4ť•ěPÍ=D(Z»mí|U] v:GUěTŐ'‚•a>/§Ťě,:Ł=ĹÇsú}ݡ†çÔ üNŔFÖ@7#ÇůřÚ»dŤ}Ę°ö „JŚîn=Ě~HÄ ŔyÝň=ÇŠ'ś*iŮČöé‰ĎaˇWă¸,z˝85čĎř›EóIq4›ző!]Ä\SEcA]h:lm*+)tm^3Â1,ŞóÎđ´>k5S“A[Ţ ÁŻĺÔ¨nżÍýtÔŻłźšm”3Ű<…‘¬ÉŚj:©çŠ„ PžĎ!źĚlž~ 8 ·Ą¦ĹLTH‰«¸}°<(AßČŐŞü‚hĹgĺ¦úgOYÜč:}ĐÉš]Ďj¤«ď:‚”t¬Ü‹}ön¶5—Ţ1Ű“ c؉Y„ĘxµwńfP`<ŠŤ _{"Ýś˘ç @!Ľ\Hˇn…Jź´qę|EńB]JC”^ŘšX×c„łĆíŢÎĽ Ł2ÝřR·’ç5„ĽâĄÉż›ĘÂ}«6Šöuă=|±^b‹űúP˙‹™ţo´ś˙x0Ů\PUá2&„:)Âg×µÝhHĘćeRŽĄ-űö4ě!ü@Ŕž°n±ÄqľMIf{ÁWšX)ÓĎŞŤEµé̡ÁŻáĹ"÷€w·frµRdăő€49$ŔMʡFĘ]W®‡9J•Ż4e}ŮĎSáKţ΄lTůÄg&ifĄJohöŁn)§lí›Ů×jś[‡ŕA\ő8סÉí ëG¦Ľ& şá–R˛×Ą!ČŠxdşŰű†? ;»K5u~ßa®;˘ü•Ă%j†ŁŚĺŮÓ„D úŠ'3ÉÝkÎNYs3ęŚÇ´6˘LYŻBŠ\A–ť!!„%ŃČ „ɉ)/ŕe‘žF; )Ţ%Sđô^MTÓC\Ä©ľĎQ»b?čţě™IλOĘüâc›ÔŇ%‹Ű‰ž~żűb:iĎ'ňp†°HÎćŮ6×eá!±nërq‘,Ř® Ôťiá|'(â}~ érýrÜÍŢţky˝e1~8;ÁôŐ5ąÉ¬‚7ů¸I§ĘÎ-ßX“ KIŁôkK$ď+Ŕ©#ź@+•íjGŹĎމř(ŮÁĎ[iQL‘1'uă{m‚Š¨?˛ye“±l®Taĺvç6ŚC$ćśF:;U‘)SÉ{ŇóĄg;ţ|Š·xüÔ×ĘĘUUźŇaCz^áîI;·M‹¸ş+yŰęP .»_ył¨v†¨;ĄĘo§™ęŚc/ypx ‰K"?Ű,tśd.DTéG˙ eŻÁ†l˙xşßţňĺä× _pDJlŃ"–U™îĹży* ÇÍ÷KjQ Ŧ íÂßDHë[h3j{ČNćáŮ°ě:ëĹԇň6\°Ű…!xV ßű^JĚ>ÚËö„SxôA ŮŤłÎ^+˛ykë*RŔSş2†ž–"jA83®®‡Ľ‹«FŢxiÎĹ?•§ăĂŻ™+‚ :ěQ〽`ŮŰ<ôĄvł>+{ÚsŹŁ°Zăqř:Ľ×ś}Čzh2yö"ÖÖGvíÓ9ÁľQ» Cőë–|yď 8‹6%Č~ůŹBŚ™Úd°€Đ.ŘNÖnŮ[ćcăđÉ„‹(áBXgŢŠŽôJŁpŮôÚĎkׂ•sRŚż0iŢ}oí2t˛5ˇB?=ÉF#ś®žűWŐgţ ĹkçÖˇÖ|nxŚdşŽmbŚŢżVr7mb•¤HyL6ŇŐVŞ©–ŞFŃŠŽ2~Ď`ĺţŃ8ýˇHüXú1P«şě<šŰŹ«łöKiżÉýşC¶ßf稳NóŚl‘ńng`ľ ŕß{NFŠSeq6V5ńÍŰ0LÉ ĆĺUá±TÁë :ŃrŚ›ÇéM­űf0p÷a®ę>ŃÓ]Ç«‚YŁŃ«¬çzɱ!Űo^čv´±ŹăÉ|ĂlS ´"źŁ|ĘđŃN¦ů?É—+.•źßÝZ7»™};4!ZXxth[•*ˇug°)R„m€iééµ]ă+*@Ş9pÝ•ĐYDŔBÇĄi‡†ý÷`5uăĄX´ô6F‘˛5 Á«bŚ$Śj¶“+t>Ł†±¤č<ŮžrFÜ>—Ý:ˇ{Ł¬¦eös›ü×5&i¶4 z{”ÝP'~lÉŚÁgoSżőşĄ™b¤.şVđ­„njFś˙}™s)`\Y_wĄőR_µU70Ű索 -Z„Ýn_w„K4ő‹n-ű{Ç˝®äĐcśIĎ /&SţĘ{ażBÚĘ`~ň˘”˝ńö‘}Źďm´ŰŇx0d·ď•8Ő9ĺ"†šÓŔ †‚ÄľGé–Ć˝‘$T@Źń7á;źEEB§ Ă”řj· {óÝVĽgeýsg'[Ă\źŇÜH¨ČĂëZ ăĹ#×YŞ×‚luúÜ"t[Á}śµW@… Z:.wŻŐŃ‚ŔHż7ÎşÇ×ÁFŁůرnÄc¶á’Žç1ö}úCm®_¤Í§6‚űÉz©‚ćD’ gŁţ0ťGÄ Řš˛ŤW5áT€Ž˙·˛†1ša‘SůR“ąBŻşĄźm×CE&í‹÷ąź+ÁŞ[3=ă®Ń©7¸8°U ě/LĺQ=w´‰Š°ĎÚN>E‹ş8vţ>¤yo>}Rt}52_ş*Vîş\DůhG;°Ć„Q‡:ĐÚI$ĄrĄ\ÄÖŘ:†5©ÔQ€cü/âúWŃD †ý¦bÄS;.źu»›™ă.»j(©†2&8ŇúGÂĐ!Ôó=‡ÚČ)WŻ_ˇ°Ě"şr9 3wš^;Ř‚-@Óm)d7&]‰Ž®Ňb¦m§F y­ŹÍĂbąÎ!2ø2š€,1ÚiˇX]5®Ő ć~›ź¤Ě;*Yă+|”m.§ŇT\Ö BË™äµËŹqF˘{yŁx®"ľĐ*zĽ éŃ»V6Čc Ú5Hü´ˇĽr;8SÁDŹčľg««‡`.´DĽÔ5,śpÎć]ag&Ąí¸Ť¸ĺ„fĚŐÜ6„n6& ĺVD«LýĹüŐ©‘oVšű¬\—ńîéDčÉ[÷ű:HÄ eM}]”›„ŞM}L:×äă™ŕAÍUz6jHI¤űÝĆr§OWiwâŘt놏ČLq`Ť]ÁöýNÝEĄpX­§™°]Č”îrQ53 •N¬W=óvČz¸ZĐ‚¨DRJŕ;퇚˝`•˘Á„šĄÔ 2J_ă]&ĘŽăAM$•î,Ţ]ÖŻ7č ›–G Vś¤Í‹ŔPŚ4x‚äň Ĺż/#EsŐKĺ°qDősh63 d"¢^Đ/‡ĚÁ k? Šp´n­S3;üě%éŞ0ŃÓ}SŁU[DĽÚLJ_Ë»eN˝÷ś‘Ň1±±RÜJo2ýĎÚ–°Ş‘¦G׬ԡqÖP(ŐYÜMîť´fb´ ů´Ăő;^ë@ŇLä4ěV [mÇ›]1Ć#ěđÇUŚÁ殆ĆmÓŇE@s>,™Żč.Bć"cóĂÔˇ łŻH4Ň>/ËZ-kő>„EIÚ ±$?”´Ô?čŢ‘oĐ˝r ¶ţ軍R©s|ç÷´Ś¶É©Í¦~«ŢµZĆĆ9Âřđĺ[ş|ş+ÉÇ~ë“â©o+1< ¦5ô˙_Í=rŤń ŔPťú(”Uz)Ěő˛EÎŮp-s—›”†$u;d±…ę<Ş+¸óÜ€óΤ´EŰ{9 P Ä»QµŽ>wľ§/='_)ˇŃ50ý`iú_öýj¶8‘Ś}:`ËŰďODĹ·}ąúŮ$mKÂŃÖ­Ľ’¤©î¤ü‹Ęç/ůĐÄéĐ·j¦Řş€Ü(Đž‰Ő†ŘĂwnźÂ•Ť< Ý˙E.Ś#KĽ0*© >@ë´"­S»…v-ŠâÝ(渠Ü$z”Mß´etŕ„ET‚iĂ ˙Ă!1!€Ľ'\mÍž‰ ,w@şł<ᛌî˙‰Á’LýŘL|”€gfU¦`‰şrĽó—áÜ«rÝĎmŕmÁęKa¸ '¤ĄVŞż÷=4zŔA˛I…ţVLČ^«/ŤÖh6÷'›z'zy¶R叼‡Šs>Ny”‰›ÖI´ő'ČŠď>‘X=2]¸j\ÁßP·q$.iÖÖö‹i!ÇÖrMY0ţ 3ő @ľ+fü¦ž1–¸>RĽ˙<–ŁÚ#łľülľé#1ĎÁ7-•ˇ§łŕ:Ę=},Km†üź˙!ÜĐjŹs‹Đí~C–5ÉJĆä:ĘtđĎśqÍ_g@28Â:Q{ëŮJpŞęw'2»"„[)D±|ßÁď& kí9üCב‡„lµĺnZŻĎ3mEyĹƵŘôaÇ·zň7üu/") 0ďě8wF5W܆’Ó°Ub÷†fçŮÍ KIܨ ^—Öl ŰÓ7ţ¨—Ö‡‚ýčXq‘1˝ĽP˛,ż.e'˝uOE_ažY®ĚGJĎŔv‚e1˘Đř9„HMňňń"-çaÁŮMŻTŞwëĚJľ#I ôü˝QŃ€;; ZA=|ýŇÜáQÁ‰ćľŞ¸‘T3 źJĚF6 VYUńĄ35ˇqńµŮo!— ׾kîÖŕ=łj4± Żda„Ś˛ÔçÝOt~^2VÉŤI"+"ł(ćÁ—CXĎşß<}ëš}UsřBůPŤÚź+'ŁÂű¨±˙˘ßťł'Ö‘eI‡hüikýÔÔއgC‹•’Go…sđ}÷tµ‰19>7ŰűtnŻ|˘OxËl±ăľ¤yr{ťľŮ¸¦CĎ2tĂ–tĺÎÇ4PÔ30Ä 8wnź×błącî‹z°m„q ýŰZTuJŽ”|‘pŽb›mZÍ8÷vŁjěĚÍ–h9¸Ĺđg'ęöśŽÄň©Ďix*ž¸Ž’€ţĄE‚íľč,öۤićc‡…ĆŠď_•Ż;'GŹKi …řą`Fn;ĄfňúËře˘éśi ÎéŔ%eÁň>­gŻf;@kT·¬x™cß,ńQŻ§ß:+oAňqTŢšůĽŘŮ#j%ŃúŢ7ďůqH[gh[K,bŇ~ĺµřWb§lg7ßĹÍ4+¶îôfzš|ÜěÔkâĐ3‚4űĄ®Ć&] •3‹×îl—TíBmt€ĺ”m)©^K|^5ΰ¬Ĺ‘–&…a:=ŞúÇóžkÖ÷sÝ!6/Ľa§d9ćUÖ´(۱µÁ•ô]›š˙ —[©ŤCŞŘ}h)Ć*?đ>ˇ(Úh+1fě`¦፳¨"F0?żŹôo”ŚoÚ(v˙¤)Ł/Ď® ÉŮNa‰tv!ľŰjj9š}kě.Tt#`pŽŚĽăÎ⌓}O|2,ÁŕŔťĹ°©ÁÜZWě•Éˇ”y‰”\ćŃĹ‚Ť»Ţܵ…Ô50C5› ŻTZNŠŐzŰ]‰H‚]yŹšÂA4ËkÄDKPFúBŕň]XvÇ"wR–Ěn-Ś„˘śÖnÖ‡ Ŕ©…Ăa”´Ľ9Ő…ĂXóp—ĺTŽ¤i =ŔŐŞň ö`a/ËČĄ*żžĎvVµhÝ@˙&ă)B/#ą~qk•…śjÇ ukĎa«Ć©XĐHŰć@dҨŚbš«Pv„.oÄÇ Ç`§jb xÎîLůko'X ¦Č6sŠ Ł˙‚żŤ®]˙ÉĂ6TřŠ} +0EۢţŔťGňC^qN„w¸ŢmČšĆV¦ŢŹ]~ÖTÄť~bńŐda|Ľ\ËÄňě;¬”‹V|CW•ČVźĆ'gRÍ! Eš¬»•ľ‹ËÔč«ŕ–Ł~Ôđ/žŚ@Ę×´GEbkZĄÎŮu‰z_‡·ITdÇlRôj;Ѩ­íxŹŇŤ__/>¤°Áĺ}š'´‹Ś1ýtÔÖÝ7"ŤŠŞŔá]ÂŘ% ÉmiôS؆`Ű!źÖĆşH µ"ĚwFĂŻjš<ďwžË—Ů•ŘŃý—8KM¨ŔË%m#Bq›1˛óq§+' ‰•®ł¦`P:’&J‰ăÁ,].ž»Fřw µ€ÂÎ]Ť©™sö&-Ź‡`˝ŁĘ0Ťż‡SŘȸh ÜZĹ‚ńJPÔiŹšl­<żă§F.‘čňý¬by_ˇŻN Ľ0z`Ą^ň+I3 =ri A´Ę‹Š’¬ř¶ř&łEÇŕ?pńGzńlE{ҢŤVżląo¶/Ť±fÝ‹Ľ{đćŁčÎ߼*Q˙˘XYŇôőłî•Cdm|=ěl3˛śürËľ,v,n]Ý.2ÔJyVţZN} Ű›JłţŤă]±ÁęY<%Ű°?áĆőşŹaŐCĽp4L›… ć›Mˇk+ţ:0¦úđYŞČ;«š$¸wŰř˘„ĐÎO äżâĎ8fś—ÔI Ł–ţ¤Ń°Ę›1VÁŐÉö»&ŐUFşĹ0ÄřHDtX W?”ÔKEcĚBňÇ*t!><" ąo8Á>ňlĂۤXD¬T›ÁĂ+{±GÓ߀8UQ4ß’DľHř;G2V! šáăťí59aúJi‡ŹDßhĄ'ń‘ٵj¸ýĹ řĺďÇWôîź&™—MQí›GZ>D-ţ «.ů˛Ük°Źą“…YEmĽ¦x&đt±­â/|0ČuhŚ/°"Ć<~zţ–…<:4tٝ፼&{™ nĘBŚjCő|áHŁż+×ĺÎ/JÂćea6ÂvűúŽhATůË%S°0>^©<żŕ‡2”áú`vĂŁ°‰,}´Ť2X…űć¤÷ŘßÇ>9µßăáqbŢŻ¦qëŐĽwěNĘä.Ď]¨‡ˇfȦłĺ\jÜ Ż7J•Őr"|=DaăşëÍYŠuŔ¤fľbNæňŃşŽĘnĽđ/ĽA஠ň*¶HćH¤'J" ‰ď·ď\´–f0ř±/B™{\/gJsŢU± ŞZä_llŽŕÔÚţÚ1Š]”hc-uvůů7D,Ü´h'á\’#MO‹/‚ć»Ë% ÷Ç‹eŁ‚ßř‡Ź•OňKźŢ}ÂmvkWzj˘Ý© ©…© ű†^Í•<'xŮGČG\p:çŇ{ǢđCÂa·|§ök°;Ţ„żUxéşE”|,’9*R{ö/ë¬\ÇŠa ¨·— ő3J4xk éFőtT­ ÜÉâŹ^‘AůfĹxľc2ú´ßvšô ”@,W°ć‡– ;nv|FцçUÔϬLRUž…T»=ę~ôłů¶ć†iCl‰Ě”"ˇĺZb°×ýµ»đüDů˙-Ľ´†Ş™nô't&GOö)M˝fźđŃžz~Łô¸îyçÜGńÍ=^¬ű¤WŘ"+^<ŻrĽB :ÂsőzGĄ:?µłÁ&cmŞµÄ `z›3pÓům,džI ž}—Ďíů¤Ĺ cć„uĹt5çˇâťiÂü» OČnË^źvW;¤büšŻůLQtÖ•¸ę')Ä…F„…ÔQ˙đ< ř´ŁÉ3úSw+ezČTňę·?k÷¤/ëí˘ż>Č”šÂGhh |¶Ł#U‹©¨_X˝N/ľ uĄJ]×%÷ÜžqłlU$YČ(‡ő»‹tćuăň¤Uç<ëŇUlCÁĄ[M]t]+u˙Ą$#l4…ěĘŐń2i›“ 5/U+‚nyŃŁŁK5§߇Ŵ4j˙ÂÇp‰öŔB9#¶Č*őŹâŘŘNo¦@`?Ó«G4@Ůvďĺ›í®Ëď:űÔTc"§ť«şçÁŘ»bĆQÓvăĺđŘ üŃ1Ćz¸ÔéúI\NţŤ»TIŔáŢ¨ĺŻ ­>_Z–_5yÝJ"ä¨YÚń±ŮTńÇ’ţpĽSk=dQů·DŰ3$,&}ť_‘Áń‰Î\ňŇ)ţšŰ¦žĎ~k!6~ß=´G=vBĆĽ÷ËÚł[ĆŔ‰oť­ęů %­(9KKĎâ"IĽÔfŮě%oÂŽŃiĎőBUěÍ´Çß y˛ęĚ⡲ŹçRKkm)SéaTMř“ŢźWU•DľUrÚ¨ Z#`Ł|n™) Ą~ ôí[ ŃR§ń·{Ď€ůéaĹç ^/U1ˇĐŧj ›¸“ż:wAĂPÄł¬özl°eńĎ/Ť“…~§@…¤čJŤZ"ť!ˇ^zęrąĺ >kŐDĎŔÜCFĎş÷f—ż©¶c‚\Ľ€żó±6 f/>ŤżťćŘp&Đ ŘBt‹^&ľÜ îłHC‰©„ßÓôЦę­mđÇ&ͱ¶Ä8ńÇř©ç§‹É+“GK˙ÚXĘJty˝×L"óă$NŠBÂ{śá()sŔjŔ1Ö´ˇGş{”Ä žEbśŰ"aHóęŐI7Š&‘ ˘ŁĺÇH^÷óž0S(VA[˘g<ß6Yß®©ěń 5<ň°"JcW±p˝›QĽFÇ—KO t´v_łŠĂuóá é˛ĹU üĐ"ţ@éşë„…ç4u ţ„#Ř© Ń˝żüťµb6Ć‹ë`G.ŠzăůV U7ˇ÷ j>áW»űŚ€ VJ–ňyN‹_†HSĹZóáčĎ5Ę.ľ$vů4Ů Äqä’ÎP lWń¸ĘD†úŻŠÁÍŕs-žłSH…JhźdGŽÄ^Z)Ćá[čroó(`UT{śźL,K\µyălŃň^‰7aľ°ĚĐ6ät ľÇîËÁ‚'šíf©NË®§ZřĘGYv§ťŕé1®°âW©Žgn$ ¦)AćŔŽ%g?Śí~0Ű6nÎ(mÄ˝-±=Ű^yÖ2đ.3„Ĺ,űŐ.sš|ČĂÓ=(([«O]etˇ“¬ŻŻŹüĆÍŮ'´ŇĎţPë¦7đđÉBx°µĽţÔRŻT§9÷f·8ĂiŽËŘrťD‡Sg% ´"­U k´wÁľŚă?70B˝ČMÉ©Đ}ˇ ?H˛pô»˝µŻ†‡ĹęřčÇ;˨ťâĹÚ˘Jđ,!§pŰٱqŕx»*ľVÖ$RŤNnr§×ĘU&ĘWŇ®˛Hʦz,Ż>:")Ţ"ßíHôÉ îçUŔŢRď¤ô]Tpç–Ejr6ÖPĹt,¦0÷ĐT¦ÖBgŘrł/‚Á3[Äycm6ŃĚ2ş±z´źE†š^äŠJ‰Ń[^¦řđíÓŻP=ü—ŔA&R’ÉűöT!Wf×–şWíłŞ–łJs¬Ş`—Ńú÷jř“ôµ°˝˝IDhÔgë ęqË?‡ăĹ- Ť—lâ%ÍĎÁKĹ‘Óh“ZöŘ&ŤÖ®ý‹;”âµbů™A}…Đ=J‚ţZÉĹ i\©ě†Ő@ějňA÷ŔŇc—Ó^ł5ëë'Zs÷°Đ÷ţ"ŁZď©ĂŤguďIY9kÉÚŰcŘźC]¸7>.ŁâüČŁ’ ŮUŤ€TެX.&BŚŇłăőŐ+˙˘őh*JŁ\”D:™!?Ď5ŠřrßYvpš/ďž$Îá§'ţ(f“z7xN!Č5ttŁň Ăş 1Č«a§ÓT)ç,6°‹sY%^±°)ĆčSńÖńdD9ik†#fĂvĎře™Ůq‘·ţŕ‡ˇľ*¶Ů±—şXő!čśś˘Ž{ýŰ˙ÔlŘ<…WµhůŢ2ˇB¦<ţuJĺĺ«ŚĐÍgůUž<ÓÓ5x†ÂਇMĄ{É®ćťŇ„ĽÚ™ѬΠ3¨+ř‰čůůŞ[ CVâ‘ÄŇĽĆ3Śłćë:sŠîť9˛.{–Á/&üă €Gň}ˇ9ßSmĆěi‘AŽjµ&ä-áńÖo2]\ O•[RóâŁĎn09/çS„ ýެćW[g2VmĎJć"ŻţU¨{żŮޤ֠fن_ăł.Öşil¤ľh©§ş>#Γ$ŞŘĎ"ZľŞb˘(ʜךż,şőý—ťšśÔűL˝"0ě…"Dß2㔲[Ľ Ö >ß…&Ą TáČvßXF©Jß:}BĆg':‹ ďĐBĆQsžx^Ŕů5ąoTnVÁłWĽ^e¸z9 /Üîżĺ»s O"o˝Č8ě¤-—5®]€/_wz0â~Ó$ÝOŕ4żŮ{’cŐ ¤aŢÎ<]UčwŃÚsFëÖC  ~ăoT'Ô›ËőŚJJĄş¬gKŘy ń…Żę‘·0>KFĆń˙(#ětĐu 1MťO8jŰ ’ÓA$­ň”ť]đUdP‚ÖŹT€/Ulm‰›×TĚ‚Ô›¬+ÁOÚžňĽ<”s;•đ:Z† §…îŠÂ#3Ă/*$÷fşŃŔ\˛Ôz˘®&ĂĂE˛h±c!L“SS ¶ďU™đIrđšŁz´JčŰ«ł['ĄPě?[Î1Z F Y"ë7nPnpK$Ôb†y ö’!I{Öđx9%Ä“Ć’ě_~LeiY§šţh™ülöî—€˝a’»°‡ľ‚Öh>ÝĚDmsŮ®ÝÓëňđĂ`Tâ‘óU|ćřÚ=®Q>Ay&Ń^kž®Şł0±!›ůÔ§µXÄ!ć‚"8[›*‚i™;8\Š‡¦XÇżĄ°źÉQšv€Ć/7Ä{öÄŹW`°ž C÷tôP‚¨ŚIę.ČHFÍTôV.ę.Č]Şi9˛Ĺ"~ÎçžhŔć<á3p1  ě/Q Ź#Ňó®[°ŤôŹůńĘşJ˛ľa¨` —t3q r™7îÍ_ÎĚ”ęâWÄ*ĐG\ž›nßčjYîDąr°+pçÓö~TŐOÓÄ (®-3fW=6z,*¸ ·0í‰óâZÜĎ.–Ă÷‰52sŻôaąąWś°8Ŕű—#k-$/.ÇňJ‹µ'¦Ć’±ÍófĄŠĽX |ŕeiöíŕza§–KhâűY‚5çÂŮHcŢŠ§C}anwµ;W`"ŢŐ1#ů÷ăę8źAúŘ‘«Ç˝÷:IÝ9(ŕŞnřŰąŠ]˛éüH¸€oŠžĎ?¶ĄZëÂďŽX2ÖĄÁ ?ž$™‡ëäţrD‹•óŠÇ»ŢmB…Lç˛Ä&~‘P‡VqĄŕ]ˇ2žl­ę|Ô•!ŰűŞx;?É2ë‰nÍË}ÎcTG*Vť&ĆÎeú(­_§ł TŢÍŕ¨/•ąµT2éQY:_VŕęÎqOOďł5ü…?\>'÷—|yd€aŹđ°ĐĄÍČ#«čěďܤéşçźuýWeŮwEźť•Ö›‘±ýSęďń‡Ă”Iďt¶Ó÷‹Ű»€aÁU˘Ô§!ĽľŻg„…ÎUvWÚĎęąV7Âňc(*´Rčz}Ćś NT‘»Ŕ˘Wvą+/ű”’@×f¨…/ É7Š†bÖ!ď®·wîdąô/˝°%[‘7€ä’(}ň÷/,¬Zv0Ř:Ý@qF_}+$3EFßa¤Ję4«ŔX-Đ„XpYjŕ‘Őô}NŮ˝éë´›C|rd,ŢÇšĘ(âJěîOĽďÂŔCäč˝üúśG¶ąŢ^Ş-ÔíG¦·q!,F˝*ČwSŢąŕ]ź8Pş"Ě$ç°ÖŽĺC×P‹ë2¤{cŰŰ”]ú ZßY«š`Mw˝śF‹Îlmzé%®±3¦7šµÎww?sČéD>íŮĆš1Z ľ D €n.ü÷”ńťÄűBŇÓ%˘ëîń4% iFŤFG–WpŃţxN~deqoi¶ÉN©>ä “µ¦)é+V•ÔO˛c«Čv]ć­PfŤ´YśrMZďÖ&ČĘŽv¤2äČ®#Ýxzlm\úl…›őD]ĺ\[t Ţâ÷€ë¶©'‚zÇ™§HÓ„!{e¶;ď§Őů_?µ.ńůín{?ű!~ßř˛3­]ĽNBĂPĹÉßÚŇi^ž©™Â;Ŕ;Ť©p¤\·; 6Ţ®˝r: ]קɱĎÁm pDňŤ"€!ÂDnŔ)UuĂŞ!^ňBÁˇÓČî´9 <ŁťĎďm=÷ĺ"†ŤçŘ+x±˘ ÂĂŽ:‰Őě".ĺOS٢Š´Ň­Ç˙ě,Š*Uőűv ÜXĄA8Ućî3¦eM¦ŽK÷ ˙DßQíČÇ”i˝ľęNWuż Ó!M—Ox¶@Äí?CË!§íuié?€śŐCń›ß·P‘+Ş0RhG5äżjăţŃŮ=§>Ĺf ˇÚp>“ĂŤ’—â7řąä÷'9ÉěxţqîOŔ¬‚·Ô=q®@ę­wăÔ®őrŔ Úöż¤×i€Ë€Ě4|ú:{Ń…KqT/7áq“ ‹`›•ö{©ꧺ™ 4PaQo 'ĽHBqňLůͤ,WnĘ`ˇMmŻńD¶ŐÉz–W-˝céIŃ“ÔAÖ ;E1Í)—q–nż ö.ÉŔ˘łt0—F6äŐNő˘éLŃö řç¶U_ ďOí@µnסӻç¬,ú»1‰€PŘ@zš0ňő«MŕtG{p·\y!ś{ľô‹ą!ęo‰VÂ*.ŻžŰÇ˙‚ää3ő1Â?rÉKJťÖŕ…VŐd‘Qí…ţf‹ŽĐ Áv€TŰ]ěc­V;´ë®ć Ş]¨Ô”-áZ}„‹•ŚÖ<üđeë;¨cbR;aU¨»-ăÉ°/ůk6ő±VĺĚ:É–â+”(%rÉEŮ~é8şło–5ňÜâ¦ÚřŠ Gzk—7®fÔŹ‚Ňq›šd:ć´Vv9• @Q:ČTU~ ›đ˘¸Ć×ňéwĐVĆpÂZópŰFŘÉk[ϵţô–ę˘I˙ůďëžU<‹ÖFďůdţĄ·U[ËĐŐđí¦°Őx/ba0Ť,ďQ¬»§äâÓg;M+Ç[ÝVoR0Y©Ć/™„éz Ęň‚ş˙•ĎçB…® %.d?ę2k˙O 1T›4rÄ 3ĂcěŔŇI‡”•EëŻĺ„~w ž/ 3’ćc=#‹üVŇyőRźG•Ń«Ô»á¤*ă.˝†Ć}ôÝF 0ÔVíFˇÎ_ĺ4těvK‡Gă!Źőm©[¸ů—3@o)˘rëG±€ĐkľęĽ"aÝÖ ăćšó]ż]Ô᳼‰ÜĄ ß…ë.ŘK ÷ňŘäQ`t6^ý2?®Ęf Ϣ'ć(en”ć8WŚýöŰ*”‘‘€íŁŻC“iUžJt’`\»¦!€ÂšŹĽŻÉ%©Ě­‹ #µZüKŻô\|6­Qł 7»®»ŹĄ‚í=2?ÄŠ÷ŽŞ őhŮtĂĂgË Âś±Ř·?ŞÁľK;&1Ó(Ž÷‡ś÷a—>çĺäq ‚*¬mFľ~r+ť ĚĘ­ÎçX^=‹Ť»ÎĽëŁŔżíËý|“qřŇÉ@Ź` „źžnZu[¸‚Xě &—gćˇîľ! á¶-ź: vy?v™ë(ŃmS{î‹~]«"oßeŰ©yîö'kH§ň¸`S¤…ôěĹ×ŢFci,dÜd@Âşś7ĺnŔĺ;ĐP‹#v‡>#l´]îěáÔm`U(ĐKxĺ–„žŐ-n=Š‡ě'ĄJĄCă ćéďŘpőhAZŔOĆćă•ËúädizžR˲•‰îF@W®’E Ę™$§w Fyԓʦ8öU˛Ä'źÔp0LĂVŹĚ™‹TđËCŹ\*c( Őu°ˇÔ뚆Š‹ĽŮě¶5Śyí4÷Ë6#ě(2éĄĐ’;íÜVY†(É©ÚŐE[ZTÎĺČŽI«T•)îN˘ąŠp!dK$‡ţéc+™V Ěj{ç·ušA!ŠłQÉůˇ·úo™ťTud ¶ÂuuYýFP€z­g’2şđ7ű…˙ű¤ŘećŔbÍGÚźćßLo=ę|čđ˛Ö": !kôÄ y-ŤÄ>ŘĐOŞ…ĹŃńžÍŘďťkG =$*L>öYGŢ›îůerw—–$[“˝ykťĂľ®7ŃŇ |5öĘůĘĚ{¤T ¤CîRś×˛­Ą54yjżô‚Q“í˘éň‰–őP‡˙›Ł´÷äź&µ‚ Ţź˝ř®xgjŞ%©¤ÖL¤s9Aß ú#ĺ÷vöđžsr9‚QÇSÍÚh^"˙e.Čj\(´˛ĐƢ®Ý–R㬾»ţ&Ř—ľ°Ŕ/O¬Mľţâő…Em°ăśĺ ĎO áT˛ Ç0pC(›Bśfá ҉ůĐMv;xŹl˝ ±7ľ$)˝ŐpgćS…™.5e‘÷¤ŢWtÜY ĆŰ[DŢu‹†Á@ÁqykŰžŁÂć­˝ l5oŕÁí­‰O*ĘŞy¬"R‹¸˙çéQýëĽwýž‘lž=ŕA.ĄÔ˝“ц1Ţ3 ®~Üăčpdt=5f?ó;a­±˝ó 4‰Öđů#» ;2„6 ó›7|¶WÓŢđŔ˝ryĄĺÚöQő5D <ź0§WĆ^ĄŃ ĐȤ¨ż4=zR¸ň’Ödr>ÓřO™ËĚTvź: ~¸ş»‚˛\[ŇŘ—.—nH•ĚăRWŻnNŕo‘Kľ€ű$ąjWy@LY&ľ q÷&eŔ;:ŮĎč}{>nň©łťX*~ž—\7–˝Bµ¨­ÜĽj÷ň(ŻHu;b#ń đđC˙JXďWżĚîę’ ¬ß ś§‚‹?±<}˘ysSî*I§ČăćŁÇÚeŘťůďŠĹ˙Ĺ~n˘Tó.^µ™ů§&fş‚ň ąť@h™Ę/út°fö'fű…G®FRĆŠü˙}ľ±ÉÂ4¨#SŢ ůĘM\ćá/ hś¦ÜĐ'M´ť1RŚ$ţĐ’ëLÉu=‹;ô‰ř¶]y·żŹ©őJwÚb@aÖ?á’, óZp=‘s…QóĽ:ORě‡Rm00Ż‡”}»IkL{ŐF¦9 Ć6»ŁľT^GE0é§ŰÉM#TĹÔłýU‰Ť[ű®^Řř„ú¬"˙Ëß}žfw4UŰ ă €â’ćO‰§,—ĺĹ‘ŕg­r^:@]\ ¬ ůfŕü"úĄ‰‰x(˝eh¨€Ă…·$ eńmµšXÉf0}ôřĽ_ĄZšűR)–îW5ň¸^ĘĹîiT˘HŐé®^qÝŃh: ő?őűý \ź®1ňĹÝ_ÖU—÷wîά‰{L#bj®Fj–eU*Nóđ®řrîÓľ•ô•&5Ú"§Ú…6ŐóŹTŘĄoÖç#ĂASÍ,+Nľ1-"Ť4´|¤YÉâF L‰˘ź—w¶ěG-ł\sm§ŰžXŮ­@—<˛KôđÖáxµ‹śčÇ[Y@Č<äÇ–x:“CUĂŃ^lí#o¬JŰ7…HsÉ2ž˝ă1™/|®±Š¤Î†ŇŐ¤Ž(zĽ¤KkxZE“ę/Ę:×X ˝pAuUĹ" ¸ČŹ -źŐ›Ą·Ťď*ä’#¨KTřÚśâć_˙nŻe=ST‘Ś7XŐ=qbƧą ŘčXÚPŐ´čbőľ=˙‡=ĽT\nB±ŞoO­.–ďUűńđg†cĹô‹Ao8ĂkH)µ"ËÎÚĚäy‚˝„kEueĐŃ­‹Ŕ›;=–ěď^{;D§{^Ű(°{ m÷]7h¨ş?™®ŔCóť@Ő@üŹgĄđ€†ý2űüKÎu§ú1Š-Ř?•IŻiőÚ•{Tµ2ö–ÁĽ&źa;;E»ŐXa± |{]ĺ}OË̢› ¬jpe5 ‹]dÇ’ňť•6BmTŘ»o}ŤjŁP y9a¨ÄŢB‡ĹE¸#cPîĄb¦¨´ĂH˝Ő¨ý7ÁŁR6y7÷Ôă÷Ťv}ú˛[VŚ’>jëČ{ŹhmXůCNňK«Z%%}8!_†Yö_c·?…ję;·Ń§w¨ŠůÜź˛ZĹ5–\^ŃaßŢÁé#ŃZ°O;ťĘqÖ'V«Ĺ;ŰZż.néTô:Á!ĆĐânj‡ Őt¶wÉ4;Đ:¶¸Znו™U ˇ´űĎň¦3¸őĽ”0ľwť‘Ë2ýÇ4ş‡U°‡rU¬%YG(f0€>¨Ů·Ä2»).Ú@ MŃĘĺb*Ť8´•Hă ˝i ›Â¶Ö͡^Űd|)<­1PvŻÔk¶c©9u:-™˘ąŘ2Bj‹3qÔŘ>‚™ĂZ‰ĎŤ’©Ô»wÁ7h%Ę’~~Z’ęďŘJ{…čťí•äőr ·°ô ŕbwLh`ŽĂ˛Px<\¸ňd/9đ\€Ň}Ě Z•ťłpŞ2§ĂN‚r3 ‘—ĹäÚHGŰ×ÍĐĆN&(Ç‹fXý[»tĘ ľÜ0`Zúc$ő’1”K{řql©Ur őç|°WŇ wú>—Žq0*aˇ’UZśŐ˘5Rń§%)ÓB?]ň'~éiüR$¬h;ËDŃ'{@ˇű(ÁÜ-“i+ä śîŻëŇľ Ö{íŃDpműďoş\6Ę‘a<ňŢ=h­N<˛ śŐóˇÎJL~÷×|Í“Đ~\ …îîÂN5„~Žîů’ďTůž÷îŽF]c‹\˘ÂŐt˙Úe’ŰśÚ*Č€VwB ^ąâ+Ť ů Şź@źľ\ôo.Î|€VVŽD#¤vćf4ńř›‡3řÓ8ô,˝ÔĐÇđ”Ń…»"n%f©@v$[ľ¨Ŕ±U®•H‹÷ů2űv5Â]r;˛µ¨ :ě+Ť ˝÷ĘítäÚ{rµ V‘˙eôĂÔŽŠ- NČU@T1–$JúoČ’ ›­‰A`ë/Ő۸Č~«Ď•˘ă´Z…LŹ4 ¶M~±ň&†ťł„˝Üp—ŢĄPXöX%®€ĂÝÉV-hČÍ’wĚž–¶ŔŮÚůÉGWD A(‡,Ší#^–-úQăB}‰:A™wt¬R¶ĎFďaÉ™é5°×iTíłng¦ľ<űrńĘX鳎â Gâřŕ%9P¬ö­śÍ´J°ů5ŽIÉ6LÎ~ëĆWf;É»+üPžşwUčĹ-ĚT®AW˝ŚK¸q»m§šŮžaĐÜĄ«A2n/¦B·ŕDGÎŔ(‚ ŕ[{‡ŇŰM5č&`«%TG«8ž˙öž©ŞÄdŢÔ˛sg/ŹSy€qßćŤ]RHĽoWeą”ŐGÖ TJĹš±/\Ú-u¤]iű%3wWş“x¨ššŹ›2‹ĚűC”!Ě’»DŐűiřnĹ °SÎ Ů„U˙%ä9–°~÷Őb©208°l»Q„ŮŃš´žVÄNg'šđ~çŘ÷ýYźGG•z‰>7 ]Fc± 9qҶŐMďi ŕ±póž_&Ö!=|‘"îąÖŕiúČ~9ĺxýÎ+ý|Y+Č&íwź¸“ű”ěwn+1 ĺ^¦Â‡ËKíŇN€ýŇ©D~•Kň^W6‡ÔY|Ůőűâô˝‡ęź%FŚŹPŚ§;”<ŽŔ%hM˓׽›$˛""şUć´Ó*Č^(AÓ‰ülôU’mk)IQDućEä1+ą*¶DIëýÁ žßheśĚ·aüďži\, B_CINżv-)ů ž·x#ŇÂĺú„G¬b$Őé¦(Á>Á‘j5_:®É€K$ÉÁóáM=€®łN‡OFšAY­¸Ö]Ő7a@W/Yj)߸ŃL°imiйɓ‚7ż0rCŁN4‰™<;ŁŔÉ#8*je‘öXÎc®őśP)ls  ëńÜjάâ_•Í„ą´ĆAËB’s+´›HjŢA‚勤 „ęŃfŔ<.[ĹYšȨ̈÷7TpŁ´Gf&Ď>ßÉ äńXëkMś(ÜD†ňů•°Sűuă(ČĂ«pyńĐöÎACť>vŮŘ.¬«b¬Öú/쯌 Ďw,×Ĺ°1^˝Žżő“šî˙(®"ţ b IĐ2KßóvÇÖ+ÁµÄşaü«Ę˘DŐçj–IJ…Ă ‘}âb€»Î賉>ńO€j<ŕJ+˝,ć»·sC˙Ŕ©ě•Gr'2׸ Q_ś.Ăze*:dŐüÉČ{g™XűĂóŮ0"WçÄmżo8łČi4áŐ5i—9)kIżŃůđޢ Cŕ<¤ˇeďŢŰtýŢ}kmŃÔ'§ű(íS•y¤đÎB*ř‹ş·°Ďtsďšr¤5UÚQŘ”ÚŰ´%‘ÂN¸V¤cŻ…&dŘ]†©ó”)ś:ąť“ű´VÔ1súčÎQŽ! ¸Ř·-¬źĺ…cÚ(Čň{‹(ďäű}‚ÓŔ5 f%0ĹŰî|Id/ßžµB:ťÎ›!j#ĽĹD˘*ôôB)ăPM.ă¤鯄ú‘QÁ}e’ĽéŢď~†ßD'O ©!KPCš/t#*¨°µ¶šÁjÁO¤ÁSOô‚¤pವ„"r\ľ± äY)¦wá ĎłW•¦zź!ůčĆÍ  ‡MP!Ó ß`"Pb/Żćf.˙Ú>ú*Çk%϶Wăĺ ±§Î>ś ~řŁtzh<,DYU5+ oé@`ÉŰČóĐî3^¸€BÍ2)> Ŕ‹é4jě- opwXżŞ˝đĺ‡ěĆßa’î$\{Cá-:”CCRys§Q@Áü s#âb۶ÜO°ŻČô°lĄŘhx«,U”_)Ź…`¶Fľës"»ch:dŕ’âR˛ŮŰ}ţ{1Ay2Iq‘)&ßoĽ  Őá!ëö9šc;Ű ä«Ç/©›Ál1výőş…p9<€r|dˇ·Ű’ĘĹË#Qúĺ`UââĎ+Ő1ďUâ02cV1-ÜM’|† 1ř=rĐÜU‰lŁnoąˇ6Ú~lžŘóÁ‚Ďů:"&™ pô°©—R•wřŘČ­h2äŠđDiÔĂú¸č6l*Ô´µ9J}i”L¸ąi‰ř†¶¤ËÎăIýť1˘×hcF…Ĺ$ÍÚ¦Ůe-îLrÂYŇ{|"˘v>·łľfŢŽS8¨–µŽç:źg¨’‚YnŔ)Éât¨ ËÖłQc@˘P^źŃŞ`˝@ětůýÚ\c ˛za"ü^ľR®ß=1$'e  ż[yl9ĂëC˛šIÔőÝFEŰ««ŤrůK·cĺZ`6s˙bçmËĘ ÄwT‘v1Ć°á.sř ú ‰Wtl&ş,$urS5´ß‰[Ü”=É®kbÁ=•Ô)/Uµ9HÚĽ‹0e𩳣¤†Ëp-G‡Ťîu–ôěÖŮŹâ2ś†ůˇ…ç5ěXţťâŁxÝŁS„©n éżĺ\QfŃv”EIŽ¬ÁĚ’’G«s }C‹ýę}zű©uß8#ÓM†Zűţ€Y(>yĄťtĄ!_-TSI»Ű‚U ?Ąç6šťËt•ű/¸k¸8QÍ'ÁĎmÉ J~UÜU}˘ł„C2´g&9đşçď1‘˛ż?ĐŰŐ‘SĹë4PKőéFMéţLĺ«ŻŇnzĄ‡ź-žĄˇŃ6°)Ąlš@\wČ,W}5Ćmľ˝Ť‹‡`Üp‘$5Ś[XŽßčqżs8iáXĆsąi ę‡+ąőíRFžÝu×MŰÚ,GaDâÂŃÔ Žń˘tËÄů}•B®3âŹ×{öW´¦ž‡ŔüŞî.F‡­1ĽQ 9źśďËĽń‰sîçŽhP$®'’S’Sh%em3jíhůá‚Ţ;z'™Ěh(ĄuO@>Ö~ÉŚ‹‰I_Πq6nÖywqç?Řőźi3 ąéC„Q‰’VlťN¸—¨)Bź őU­˘.¶Ý2#' Đ„ zÝŤQ§yÔŚ;Ç2-oA P1W4Ŕµ—…cÔ™s]­Fe‰<ť\r˛bčTô;9^›é1%$Ť˙ťNµlyYËS8ż©¤śSŐŻ@ 8TV˝y87 Ęţüă!$ö˘\(Ç’C°yŚŻ?ž“ °´/’M!MĹH·A—ÚŢqÝ’”ó—ŁŻd´Ë“š 3‚ ‚ÁŐľŚJ}Ă×É0¤•{pĚ|'OÚ] é`Ëcň'vąĂě>´‚ÄŇ3ŐdGqFV+8ś™Ş0‚E6BŢâú./áÄÍ2泧u~ 2öAo¨‹5•„t˝9µ€ďŽ«b~Śb“kę“yü Ô‹h1C­wE™”ňľúj3>C}č‘÷§=~0ŇţŰaU«÷ZP=ëŽň¤)—QŽŔ@ůPŕQč}~*Ý.'xHĂcĘ+2˙“ _l7Ő$ÇQl-­U]¨G;°ĘNtÁ-Y—ŕ8áłË‹žń›j?Ű üŽÁedťěŤl?p‡NúŮÚǨ |Q˝bġăŃľ—iŮ·÷tˇc«äóĚ'Čo¨Ć$j2Q—™,§°ŰCßć—ąŞp2HođŕőÖÁ=_ź! €ŔxŚśQ1ŤAG󿪑$ú_Ýĺb™\+ů jčó™=ĽÄöµň$HpŹ(:Ł7mP_xX`•ŔÉ–ICl§·[óĽ‘Cp‡C~qcóŚRo“PeXÖßqns4«ÝzpÔ 8 ˘‚Ü…CśŐ«$‘±Ć3¦sŤÇSőŻŁĐŠôĺ06QYß‹łĐlŚé^ ÜľŔî…PNŕĘ™¬űZŕ˘x!,ĘVµˇkłQÖ •~MwLy˛—Š›ůŃĽO’Ő/b Ńűé˛2'öŃf®PXG?!ůe7Ý/÷ĘF¨#áí@+ô{×Âă3ý#“»ĆYD©„rH,î{5]§8Ä őxŐH•?ŐŕIű‘˙®)_ÍIxstńJÓÎ0­ĐLcY+s:¨”Kđśřiă˙ÍëÂ3_IC 7¬&ä!d ¸ #¦ő~G„w5çFY~ ˛K´&j„«Kß•ăM٨gĹ[ýä—óćöަżĆ´ŔÔlýĂ `ă<›Á^±3áż&*´ěŕđ–ĎbĂ čˇúdşRŮŐjčŮ7ˇ$pĄÇ8‰aGy/bľ q ç†-5eǨ—U˙ł´»P<ěxřÁ[żÖ1ô»{”a ”~.߉&hlŠŐ­ŃQ4>†€ Ő—ľ࿡b‚óĎŚQ 7ľ|ŮŃ%x:§vf5ňłMş!ä/Ϣ\‘ů‚=vężc*;DYžŚBä"éĚEWI} Á"ZŰţĆ+·Ň\6”ş].pL-R7>nĆZä—zŻü”eµŤ’KM„ŕqíľť —⧍„>ÝÝVaă…ťĎrmŕ™n„޲ Ç–}ü Ö]ßőS†ŐfůS*VőŚ*ZŔ[í‹—2%8Í4›ţţE`Ą+%&Ó-q¶ĽËy–ř ·3€aßśVł9ŞżžÝÄgŢł¸­PôtÝßÉ·GkŠě§×đegŻěĐk2|k -q€fĄděm~qA|QőZˇ(“˙ €j!f?ů§Őc‹ďX›ŻDŞrć%Ň?Ş ©@ z]g=Ó…ĹéDřL d3ś”ÁçËQoL!X)M`0ú=ęoäKi?iÇŞĺZŽ7zÓÚkĺű† TDV9ě7zůżh=;=˘ ŁtŰş˝Ô\Őýlš´”ČY¤o¨ŰÎľ T|o‚ç2ń<âř]˘’ůśýź ma«ú^ý3J×ÜŘ"CftzŤżôŢÚ®˛e•í pĂí·ÝŇ”ŘăŃş=ş$qç'+çbH2’Šh`–”îWŽďŁář´ţs'(±F`BÜȵ0” +ŁC–eúBą@‡5Ó|ł^eéŕ'âŤÉĘEŚÎÍFsLkŰfŔoźźŚ&%®K8QĐĎcěMŇróoĘ óô!&ÉťÔ6L†ŻŁ W-X1HŔ‰A˙ č!0:z˙Ă×BňbÂ`‚š;€{ż+‰WRâ4`Ň›ńh`Ó_¶‡„eA€1Á§ź6OÉţ˛mĽ6ۨQ^#tĐäsߥ$­ÚŇBäëČ6óM"¤zUŃŚŁYQż8 g”W#ˇ“Ák š Ř!ćXör{ť¸ł\9dí»"ę­-˝KÉú ™$ÉÖy#e€@qsĺü Ë´Á)lK«ëč*6” "ŕR˛XIÝnżÜ N/ŇúV rňú51ÂtŤpJĘa¤–Ţ+ŠÓŤŔý¤łĄĐ7_# j‘Đ„É覛~Ý/ľäh®^yˇŻú!µBđQ·ţá3ĄŮÖc ÜFµ­ ţěc—-ŞSZě8iâČ~–,u2<ýwńéź{”ŻuDHsý©&3üéGŁ¸0Ő}Žĺ"–n&u+˘*•»Ü;FŮłç"‘ŹCÓĽĺ%ďČx˘ë`iJ‰ŔąL×cHKµ~7Čv'iŇ*@ń*%€řwq)T¸Ż‹T‘ő´/’Zöű¶P˘Ş’+†ă;{ĂŢ°Tö*¤śGĂQż­DÖ‹y©ŰAЦĐóóylýłB1Ü=řüÎb®4[‘Ú†S° @k•ĆŚIlÝńĺÖâť“‚†#Kô,%UůRŰČď ł ČtQž¨¸LŐă8îpĄiK[»QYÓ PM''SżşŽ:ög€'rşůłuĘ SŹĎۉš*ť ; ™FťÍZ¶˙ş˘Ü=Ď~şÔŠś´BÜ$_×HBÄČtxńů …¨2s3d§NÖkńj}j:1dDĚ_dĆ˙' ső»ĺ¸^„*»5ăź±`G'·yA0OÁÇ,O“ÁEü,Hr{_¤9dDË–iŤ‰ďÓ!Mrľ‡ ˇe*ď#gFëZ_g±Lh•§żf÷ĎD›aű˙NµO„ľˇ{\UY_ÓÂđ}Ţů'ţśĽV)ř+±l2ďĆ8ÖÚ ó€˙ż2+”yęÇe`Š©µHěoĽódă·÷;¬ĎŠŕ855ŻĘ}µ]g´›‡‚şäłił^MĎ’ă®CdŕW ˛qś­¬`µĎî# ĚÓ9’ők:J˙ő˛˙rźŘ;ÄA0J»š/!Ŕ¤Éc‚řŔHIňˇ™ň ¦U–g>“ńé<÷ÁA }UYĄAmrĽjŹW*ŢJ}cż‘ć·fźxzT é VÍŢóŻÁŕ¶v=6%Ňü·†klĂűN-űi·૽ҞÎ<Ąśw¸~ŁZëŚĐżńđűgtPś¨¦+ëA÷:A‹÷Ą÷žßŰ‹/˛úźcˇî.ţ–füČú’—ä>Ŕ Ö’=vŽ˙RNŤígă_/1źĂ",rîm‘c¬4&ł; ݡ´ögâ•1ŞÉíB[Ś€Ĺ¤CÝ*!őÖ< ě e‹R‚ĽĎęjĺ&@Pűż€ýĎaóN˛ĽDŽtí•EÓÚ*‘çKş8íšżk?Y~*LB)Yë#-ž¶F!r^®ÄuµĹÁC¨Ń™žčH(q‰ólĺ YčĹiť#aÓÚ™¦HpMş=PľŕąiŮ hŃÚwÎl{ҧHťđMn8=Bµź˝!6O%j˙§ÎSĐy¤˙¦QŤL,,NĆÖ!·ăČú ý@öíŃđIJ¸dxE=Kĺ$ߍ<ŢlnwŹ5ăe9~R€*·ťÇ ahfĹ”#Ó[͟đtšŇJÉ@×顑ë°{ŔžßŔóúî6pvá…Dqé˝ŇaY{bgE‘î??lńc´PHÓáSn^Ă9O‘k#áZĆŻł¤ˇÄmó"“Ę}ܱ %í‰?ČF9Ú/ŚÄ–ŁŽˇd°CžťRĘM!GŇY^˝ËžŞ>BŚo‡'+Ce§UZ. ĎŘO#1yšßRďD_°/ô’®v bŹŮŮŔ€ĄF>tZ¨śî–YU@‹ÚDkoś’6źŽr”ŢaŮŐÎćř¦‚˝ş»ů ř«ŠC!/<ÚŢŁ¬Żâä থćZ›÷(ĄT]žń˙٧qB6tîÂⅹǖ—ş%W§{’Ś¤ŁîTsďdaA ż^\îiś[­080úb#Ôá.!‰uëZ«€ ÔţóETJżRˇ2ŞÉŤÍ9A®0:5ĚĹýYz›#Ď6ék*Ş4^–ŠÂŻÍďć%x#Ýq—y ŘfůQ¸Ó’ž`ă Ě„C_ę_±cĽĚ>ŤÁƤŐňŹOóhň a5ŮČŕëÎýřGăj0Ę®väłßihâż^]m ćeŞÔkŹAýyy˛ÁgÜηş¦žťŮ€íä(ŐëČ?L••Ś$p.’©ăčĆDZæ3Ô#ď¤s‰­Q¦J¨*yÂ.řBRm©­ěy&¤.‚VąNćGMŇ(e׶: GJY‡ťôqžůAf*#5`l.°-Ňđ{Ăk(Úš›˛vÜ0nˇ›‹ żĐÜgËqb!Ć ®OÜ$Vü­|ﾯö˛ź÷Ţ!UPěřŔ˛B•ž»ĎiÍľ,ˇ$qłĚíßÎîĎp VôË{´łć×`Żh.e°Ż4ĹlL"ů Ü@Ł¶ŽČ,ÁßPňŚ\ľqěńóţauťů<0H”Ő¸‡‹ˇLTý[Ô .ăxOťĆ§ÓŘęGřú¦V ć‚đŻçZlË·3Hű8´’Ŕ«Kmć?ÎnGUâä˛Ôűx§ź_ yß@­îXĘÝĎ›‡WAËŠđÓ_4‚m¤&Zň.a0Ia—Mţz\ĂNé·ú|Ýľ„Ç„ěşěł‘bVúĆ˽΢#4= ÎęĐ›‘]mp@í9­=0eĘÖŔ€Âé© ío°Í`oEÜšj¶m¶šn‰ľrÄ čę»s@X¦ ŰA]ŠóÉĐĺěś3‡đTŚť¸mv‡ŹÔáUŰßĎŢęă¶rŐ‰žK4‡'̇±–—/­vma°4‹!I^g0ŽHŢcyěíˇT“÷5eŠwˇIĘîóô*Ň {ÎZŇ—úĐş«%íóὄ®u®(Ż>jhqk¤Đ/€_1%G«gń‹°†=|ŰKŐ“!npF¬­í0y”—Ńbŕ´ožěř5LEü짯QöŇ:„ĺą…ś4%ČÚ*ĺíć2dExDë^AÜ´™;ęÂLóRP \*4 >$W‘㡶ń‘Š˘§ÔjđwktćB~’ĂóűD8˘C·%źĽusÔ÷—éćér±ş j N…=‚0GŐ÷)°r8hřĄ§sĚ’J•DÓ €ŕďQ\!ą…(öž$Eß ¤ Ź“&çĺ 9×`ZŻěĘŤ¨—1ň˝ÝV1¤•LCÁ0ýˇ¤.±b±oaP˛ŁíŮ4+Ň°Ů ¸w„SőŤ‘4 Śô®ěn$ž•[;̡ $D™vŰX”3lŘG?‹ÂĄ^Ű[ĐsëűÇÉŁűLŤŢŤ% OpşÎ™ý·căŇ#Ń;_BRnr띸ÔYńq|ˇs»ëH6úV«Ť`+Űj÷f)ŻAŻ1çŤÜהּFąÔ‰>ɢ©‚ëáťë^•ř«Nś©ý…%t›ĐZpĽboŕ$ôŞOźĂĂXhh)˙^ŹŚ°\lĘ`` JŚ“Ź•ý%k¤´ĺM¦¨i@+ąZýüAL‚§6ŁŮ†‡®& ih ÇŕĘ]KŔwÍbsĆC1ÔD_âÇN 3 ÍďîéŃâ^Ó-é&půÜdxąúiÂ?h›’ďŰĆ’ÚŔ °•şôdxĹşäv¶üő±”x°ÇČÂŘ~ţRkJv±Ć@dPÂŢé™`^÷ ×Ř~Úzq™k‹憨^ýŽ»Şěń'ŮČ(_00ˇ×Ś˙€L&ŹěGűsĐ>,Ŕ3-váçą„Ż¶ČY6ÝkĄL˘A}ÍT¦uĹëšôĆÎ_KÎYäL‘c SLOÂ}‘YO0ÖłxĚôŽ_Ěň˝µŞn„=Ésżj)\Ńľ|Ş2}‡V­;*lZ ÚwMźłĺ%SĚ.ŠFSž…2X‘Ë "@H•X]ľíUOÍsŕ^¬kY‘ßŇ„Qó eÚő,6*Äă21Ł|--&dW¤î ¨ŞŇÚ"•¸ŞÚÄaí‚·Z—µAâż[ĺ÷UhCľ+ÓŃ?În>ĆgsňŽHřI<˛) Ś6íkNwů6~Ĺ+öb a *­EüîTÖĄ-4b6’.hĄ§y¬řVzG©Î]Hüw€W-ä]ŽC´ŮšOFĎ7†Ę¬ĺ¤żëp'ŕ“,$îÔŹđżfJ5™Ä_Z….=ą]*;SŰqšîÓh !t`Ş`Pď\îĆĐĆîČ·7™Ë…ýýĹÄxv4-Í# T$»·•q@¦UˇÇ}¦µÜWöůCbţ9VŕżŐAHĘŠâhŰź>VaĹaqĐvb/»9ĺ-+†Âł…ł"=i•#ą¶+*^"I;kÎĆňĎ#”Č—l‚oiÓe‹“ňš-ŤĽ.\–hIŢYš¸ ÄćˇýţĹFcŽüOšmçú `ż9ÄĄŮ |𲟂…âx몀9Ôr܇-Dš…$šKłŽß™=kXQ—Ó_«aŞćë—ŰŇ”›ě`JR_:öíôŘĹŤ;ĄĆCńÚŁěČPNßÎ˙řW¶µÂ3§1<Â~LD BRôlň»š¨ÍV’µqF~ÇCďé!ŕ,~DČĄâ°ô;/¸IQŃ÷é†!Ńť2eA_ý9Ns‡ľXLL|îÁkZjÄűŐfŇ@7űžú`§…É(&Ř|Ú’e¬Ąđáí ńŐŇMůâøκ ŹJ¦|ŮÍKW—9“ čËKž0ů–ćę0Ů~«QkĽ’% Ě$}$x5G TŐhg=)DúHkšĄżEŽěĂ}?¬'(}șťÇ7q>Ál"—‹db=x˘ż©Óš`I“Ůî·g>žë(WtF*Ôcđ(ŢIě0ý!‹@’T[ŽťtĽlŚ‰¦‡pQ2ŕÝdÉ×sj>Ń݆T7$=›ĚĹzTjŠ~=ŽĚ;_‚®8’í ±źë ?nÜÁĆ †=˘|‘ŽôĚ瞬:b¨á_–*ZŤč‹on/0öĐ°â+°‘Ꮝ\űřn'ăŻĚŁgWî›ú zpWŰĽ7đ¦žŕc#ÁÄ T˙ţQ–ńařö[ Jo¨>zŽćj0Úú¬—6U ‹•řşN˘řČÚ.+#ľjSíäŕUŐ’š~L6ußeŐ°ĆFrńŃęëęÖq!;–Áł$#Ţcµ]ĄČĂĘ·®ÎÄíÚ›­ÂĽ¤ąňí-ň¸Ý/‡· R'•čV`,šţťČÝÝ7•oő#ęĹ_¨‡;«7-qAߎGi¤°ŃeKľ(z‡/µAą\*Ä`rĽ‰>„ŕ G^óöÉ›QHź±r–’áv0ôki™šI|Wĺ©Žßsăć9Ś˝Łá/âާÓ|Č‚NŚ;3ĹK:A¦ŚO˝ÔĘŚł„Čpś;|SY·‰en߶z1oű™P˘ć¬š )â<ĆéRÁěxě@a‘řŃ”¬ qťá0kÄpJ“zj"ăŕF˛B˛QÇËő.(Ʊ›u’’¤2–¸w/O‹m†Omý€Ŕ%—1 ŐIDAŮŔs%t‚|â FŐô×{U¶$ Gx†Ţńß,ëŐ‹AI‘ĺj©Qňý´†Ép™śg)Ű/ z‚ĘđĐ Úq‡°HÜ_ť.ęz±€ßCrůAş[Ů8¨'­ ̜ƷrwtFj(©űd¸ËŽW\Ü;Ţ«O ÄmĆÇK;UŔ3z­k¤TSˇI ŕŮ?Ě™'ŮĹ9‹ď7F@AŹůúĎ^¤:×[óNžěiśÂ}8őÜd¨yÔ>Häby>zMo*Dż7N`včÄ/qDwĂĐńăe3Ř+0äî¤GŇT·Ě& ÝK´.ńýř”C–¤Ť¬ß´#vÚšIĆŃNdV»{ ÚŰáD0Ó Ý«Vk´°_>%]×ĺ–žđÄ^qĎvIC“3hŻ‘w%Tč÷sé!žŽĐŤňy Ź‚ďm;šzÇ´ÍŕŐ)‡D’3™yB€Î|?öŠ±îv™i†ĘJ~vfš{•Ă ˝BŹś¤}It¤çh¨~i¬śĎÖ <Ce†$E@ĹĐ8F*T^;‚ÝŘYľ :\_g°éXŻ• ]®"c±I^ô0( `AÝ@ZýřÍńż×'^.\-SăŽĎŠ™ÖęE‡f·/?Ž×{y8mô٬ŔeÔĺ9Ż·Č·ö¦řüľbô‰ĽyüCČ€Uvkŕ"–?Ĺ‹1vt¶N«lvťeÓăŇ˝w퓢÷'‘ú“웊Otl"…ě+úýĆ Qň@PŁÎI›…LłŐ%7č¦\ ŕ].(ߤZhÂbfe|ŕ żÎŇ,Z´ÖH ‰(ÚAŹĐoŮŔx[pŻ´›úĺgćĆlź?+G^}çÉFˇ`ň˝÷ěŐNjú×GíQé>|Ž ąűćdłĐ;ţdŁˇLěĎ=ăzgąŻTąçy†ćĹ\돜Śź6í’ü7R¨A ú¸=f–Çut_Açf˙aÎ(r ÝXfx]ő‰]Ť¨fř.«S› žşľěŮ`ؤřĺÇ‹—g©t€żďt8žO—•łZboé*Ú}^Ľđ€Ŕ˘ű^ŘaÚĹfűÝ×3éîZt{%Ů[ö,#XP—+łN/IĂŕSć=&őÁ]sš,ŰÍ“v]“˙ń„şśÎ-Dśi‹šŮËÚ-H6Fúr;2dsÝşPZ2oxW)SĆâh‚Cqa~^ĺęCí… złyŐD?rr}a˝`´jŞ :ď&Ě>îp§Â®Î¦FńŠ"F>ŐwŁ¨BČR¤­m4 ˝µ‰±5.˛FŰr -ĂÓp ‘•„VÄKH";”roq@D¦HuwKQĘ.ýeČy’x řĐeś >Fł\ô/ Ä÷“ýë«1íËęÔ°°˙mÇÖ]Čü,Kŕ–5;şř–#ô6’2đ˙ś;ŽČw-¸ĺ[”O1Á4±Z~ŤIW*KEf ^ĎάąŇÎJł·ábŃęń ľ{[áIrť—đ ŚaĂâďuĘĆČ-;ŰĹFŤ`č>ýż&˛ű<ń¨ćŇ“ncźA±ĐˇíU÷¦RÚ^`RAĂý}S—Źň;‘ŕD€-(Q«]ÎZ” %É}ˇę™EđË=02ú­ÁܤĽŻĘSÖČv„Ä×c/Űeq»đ?6EZjćFa: ÄŹ0E‘VÇn-ILďa±á„«oëm˙„ 'Eť‘˘Ţ} YSáŠ\ůŮ "á&č·ţÄ˝oTć!ˇ‹ ąHŚçaŔB ‡q™‰Ę('ă‘Đ|QkăKĆú†/Ăĺđ…q·z,–αó íybh ńOAćXÎO8±źĹ‘·ü»K6©óoržBŃ­ĐâFkG4ŠzµĚjęŃ—…jTá…h ¬™úEÎô‰ú°ĆržR±ďĐ'1n_ź Ëk¶ż EZ«=ń@cŤťüŽ+â|Í <Ů•Ć}ž„ú ĆÄ 8ç|ěâAXč҉XVŇcě>Qůĺ'›Ô€Št‹[👆±~Ô1g(×ćađżć%Ó)QČŇÜ›Ěn¬h*ŕ”xŔ)îŚO}* }ˇC>uJWŘŻĚ <ü_voniwTBĚP ¦ćŤşVĽA7^g.`g)ś˛¨2Ô޲RÁ»P(Ű_/¦Y˘“˘V±č`ŻőšfâĘýdoŁO”źŘS&N@OŇ°ăőí{¦…ס Ajxç^"ĚĄâť·ăO7óđź÷¤ďúŇ0µ÷őˇ)“ô7_áA n ôŻčçŘ.ˇ —a‰†pę…ôQsą/óa(Ú̬©4óU㪺Ąń»@ŚĚhWßř%|ŢÄQs† Îř(6RźÔË0)şkőÁdççčS*ˇşî”ĄrK€#óN“¸ P$_jµŹżä×H¦L÷9€Üu±›N8ˇr+°›¦˙"?ë0v 4eäʸCÜpU6C¤—'屝´o«jV‡›´č€ÇŇVY# [í-żił_ŐvbűÝ!`ôiľ’5üĺ2ŘFđA««{vň‚×[]g–­čÂłtm¨3§‡ó‘‘úç]±q#ůź`d{ó×ú‚ŘçůµŻpĆO‰!läPzOĂ."…L©$4ôŕBÍ;KĄ˛Ś1Ł@&ď6qh'łoqcą» S:ŕVΞ©±Ů5đU®]‘÷,ýŮŻ&f!öŠ×ë]ŽÎi/Ăą¶±TvšsL8˘\Př’MYňÔ¨<^żJ+'úW‹ŁfşĘđ+CR9ŐS@ÜU¬)Ţ-éA‘ ŽKfG?SE*N.$¸8Á~ˇŘ{ĐăsmÜ°řĹqÇONÉ#çXüß‘°ĎŮn±ŤŁ4âJ´ßf— Ŕ) J«r‡Ş#»‰‡rYó#Ĺv­?ž   ”•v–1ŃO2ULu­ĎÜŠ¬ž`yóC7űyăÖZ”-ŕŮnc ‰4Ĺťý"•¦5âÓzŤm1–©dkłzSę‹ćÜť4“»´lâĆ[_–bF-ś÷Ľŕł]Čk ź]ŞLXĄŔ{pŚß}ă§!`XßojżĚ©+¬{-†ĺt–ťÝ›ţŁÇĐ#—Y%|‚Zý§śOEť"â}Ü •&fýÎ4 M&ޡ©°< qŮsű˝€Í5XgŢ•#N9ŻŘ¨aclZ ŔŹ„S›¨ŤlôeÚSJ–Nš˙§ů^-ěămŠnáÚ¨]nůć䞼«5ĚĄJ2Ú§ý/?żÎ±‹±:I›Pb&;ř±Hµîů”őU˛¨âA×f&mŢ_‹YS˛ęÄ„ŻýŢl«äôövmąâŇ´]¸÷bdśřŕ0×61¤ëĚE­P†č÷3–µj pźRâ@×j» _0ŰTłîpÚČźPd^ČďJÜ?÷@ńPćÍé*š˙MuHŹ5ľ¬těaŔťnÓnkŤ žŰEeçŘňBŞĎčREŻť¨%ď[ôR”aZ`.eÎs5×`$0žěaŠ€Z»<|Q©3÷fE˘ÖŚ›5ë3‹ýn¶ĽA`®•%0żšĘ€ôţ«oźvÉ@I2Ŕ;Ë–«dőäüÜ"ý)ětŤVe9ńT0ßÚ*°#'„"vnwŕw’N’ýÖauDj=ťzÝ­ř–ßBţ´Î2hcV‚‰¨ Ó´ŔDŰ•Ę!ć@‚’,T:î$őW¬jB*ä,\NŃLśŤ¨­y\wň·¶„rě÷×n?ˇkiÖë°ĂÜ,ĹĆ•çŘWĂ+ú˛”+űNR¨^04Ç V›c‹Ż»îÇ)6{źtž=5Âď,-GđĆwTď" ň ]‡F{ŁĎu}2`ĚU+$ś@nţOWÜź śĚ€´dŘŹš+¨ýy0ĐD΀·„pŘł®1ÄwÁžÂáŔâ<ŘŮbC,˛-ţ:šSĹ_ĽşP•r‹®Şĺä}P čÖ\Đ˝¶ŠÇßQÜg.GÓŽP5¸ş¬±mČş˝đî˝ö{BD’ôŃî„aWöÖ ~Żů?‹ŰH]<ťG†KĄGăAţŃśč KŞŁ¦|FéLl’qńĺ ĺ&ĺ!ü1KiŤ<Ź J´-‹Bв$ŚÁ(÷z÷ý+vO[+˘uť&Úq`ŰÎ}ň θUxVĆ·îĂaôŕˇF3JX몠‘oŞýz/áH«ęÚ2ŇÇîO˙Ľ‹aŚu) ®vM÷ÖüB>_ŔžĆµ@5 < _YŐ$Ů~yá{{é\éź+ uq­:ű`!čí×zEřŠ% aťHbf~n€ąśp•Ă‘„<˝/L=ý?Şx»;6ÚZ„şü±Ţ`ĽSň^ÖQ’Ezv˛ßÇ·tVK;Âç÷Ş żťLŚeýAXËš±NwÓ¸ű_mâŤćĘ5źŔEôžM¶.m–ٲÍßů5 ˛üČŻĘ`áh=$ŕ‰uČâ\÷MH…’´_yß΀™ľ=#d(|röúräjĚÉYRĄ0żRJýÉö$5c1Láđë9đV+Z!ßq-CUϨĄŁš62Ęđ«a”/Ě’™ ¤d´±Q~ ‘—[e5 d¶ó ,ŕôĚc ]cŹ˛G—Ěžę—ôR÷«&ziX,p’ťŻaó5Px‚X_B‚ĆôfË{ĺ`Ôsj‰ ĂźdCGĆTó”ĺ|GČYĐ•Ővi:Ů4Y-řR>2\ˇ¤6RXĄ ĐlŇîźĘi—WŁ–M$v×Nđ~¤^˛ű!ĘşÜeëçÓ·[>[„ďIîK(Őńëź˝ă3Âlß·ĺ+t¬ëľX=>tµś?|`©±k[= Ľ/Ćíĺ0]¶őŃ]’eµ‘ŐŐ˝uîżŘŇCź‡•ÄܨU° €´jąÝôďl×1}ç!¶´ď|đ8 1[†ę˛‡˙Bqż |J+TŘş…ą##łZŔŠdČ‹Ľe0ą°KMěQ­çhĘ_ŠÄÖq÷[உ QAú®rúíżżĐ’aŘŞňă’ÜüĐ!,ÇžÄ糨ńÓEř/gŁ©Ö¸óăĆu`i}u‘Ô›á;‹Ţ+n,ýßÍň«źá ţ.N0ŰÇ0Ń4ęJâÉq9'€ęźŠ q“]7-(—Wťó†íVnE>~ŹŘ.żŚ‡GDŠvhD%ͤA±äöc§&bŮ6íĽŘ3 8g"`yĚfDď[Ű tČ5ĽfJ+FťŃx ŘôNrlŇŕTŠěî,e…EEÚô´m€ŕ^*bŠ&µń˝»’ó4p§’Í}»"EZrˇ5_•Á\LD?łń˙ě/Cš1gřĐfď"PlćjÓ”?hűVH,VČ»8$Ł‰Š1— c<č§řŽ«ÂËÝ‹q˙`A“_m±w‘ň]_GťSK+‰™ůg4_öiç ő8V0ŔŃŹĎ·É””ăj‡s„śsóa\'xť¬Z¦TX…lQ– Đ6pxT±ČËáÖą©ßż;N,Ş"÷h¬,?÷µáK™Í=ǦťÄˇtšř„ź÷í ôÎòX:1 ‹čNKúw˛a[76€ŢIŤg=ť×@eśDÖDܨ¬ˇü&TăŚ-˙®,Ó˛űĐs×cFś ţp-xł™¦źugBHědAÂwxŐ%ŰúH’{ pÓÂĹ{Sž¸6‡>Ě´M˘ŕ"Ô Ş.UTˇ†Ź˙ĂUBa7ŔÚs°–eQ°Bh'h :ëŹ97éű•]çíŮ ďę¨0;ęŇŠYnĄ/îĐ2MŕŐCG0‘¦ÄiΖK¤±‰„«C¨ńéY‘+f –ÁvÂ@OŔCv–]HÁÇŠ‚×4ů˙eţ+3?DłX»ShÁ<÷2öYm/U8jŃâČďýöźĄ6…°™•ýĎŻ ÎŚͧ箶×>ÝOµmÇ^ľ iý˰M-ŢJÔ‚±ü¬g Ľ`ëecâ że]ŕččĺ ČOŹRĆg69„ä©Ů—Őf–ÁŁpÄYńŮĄłżC€1řĚńÜ5|$ç&®Ve‘s ˇö†a=:aRM8ú ®˝ŁŰé†ä°˙)käF`SĽ”{Ěaü}ťuŤ\Ä51j¨éHe»&j”ˡcIgŢČüË!_§'Ó÷­˘Ż4BRÖŚHżôwŕ_,™‹@`śbß’^ę"6ß<Ô Ó~řúpÁ?>ţ™.µčT"r0Ý}D{Ě2Ůó„líňş,{"Ýôýv#X3%uâ űż,©ĺaóýČ÷čç{?„UîoAƧ¶€ˇDúP€ś˘OËvžĂÓ€xÎfâ)Ŕ9ě6 –#Üń_\~Ă6Š#SęäŃ#254ßůă± ř‰Ôůe(ą¬ ńzô"\Ὺ6ľ:čŞÉ´<âłô»“?Q)ú"Č$†¨]ZOrDŘÓ`ÜŻejxČĄXć¶h uŁp‰Ś`BÁ¶#üGZ* !hę8ó IĚ·°Đµ/ËŰĎK×ďd-ľ \OT-I‚5® Zh˘žˇZ-˙ú\jżN=ŢÂ7M&‚ÓTŻ2mxźi÷ZŐÜĐn$N{FŁí H#˝'í¶™b$“—ë@cô»źĽ”gZÄť3ç­U‰”őżµHŻ¬řŻň ť“đąÝµ÷~2mÝ׶Ý"<;·Đ˝k"Yŕ&Z𳎳‘La<8¸ĎľŮ||áě-k¤˙‡´ÂqöľO‰Á)‡Ú fB gÎAl#8Řy7}zĽ1dečOŠMsjlš9Ń^oů^®«»ú±0zÚW©Vłó«nYSŇŕ±FxŔţ%&ç{Ě€2 “ ŞĂ@m¦ă1>Wů° és€j ą!Ýɶٺö—ę#T°Şĺ‹‚ëŢ „źsyŹŇő9!wM$™ÇÍ‹T,÷LA°­Ô+ч2ÎMŞ?Z"+câ =ÎmŇV×|“h¶@x0SĹ s@jŤNÖMă}»´ ?čçÂý€äôĘÂ|¶>lč_©§8˘÷‘›Ú›ę=äĹ" ‘(¸ŁJęĘK˝î  ŻKő”.őÎÇŢ<ß·´ QĽLU ˙úIFd*®äbÔç›]Ä:ĐÍë:UŞľ_HĺŔBkĎKO#kT¶ąt*¨ÇďMóëT9×'ń‘Ç Öf¶Ž4ňJG§=úlą„ň2Xďţmc’.ś±4ůů8ĺ-Ö†Oó{XçćŤRŁ{+0ĘrÚˇçţ§ŐZj=a–I-‘ň6ZqTŽGW–’z]îš!»c •đţ‹ůŹ'k)”G (eL vˇžřu@¶]™nĎ&Twű‚Úĺr{¦˝ËPęç;çź6ú5k+ÄăŇžµW[­`» ¸= ©…Băl˝B(GFß”p.ă,č°SgR§@r´líç>[;nś¶ťwĄ›Rđđő–ďtČ3öÔD}ĘŮ/#RN6‚ B˘4a¦Ő°Öý›űDdĺ<Űr_†ĘžU‘ŢŐcÜP;BCÓ X#RÖEo‡cKŘľ’˝č »8§@ĄűA=§Ç Ëýl•[ńüúŇ˝ö×ý–y.ęîž0gÖbÍ8Ç˙‚Ž+â_x#˝iýÍEn[F`H÷§řa”6­6 š4aH/ůţ”LK*ź“Ýôĺ‰ëşÉĄĽÔĂ4.O˝ Ź.™„8č¦&?çl*˙ŢĽ•fřg˛¶Ş{ő–‚ę:Ú˘ý§`˙Ë{ň™ţäŁ98ŮĐŠ±IĆhŚŇ¦lg“WçgÓ8h(ÓßjpXÎż,@•RÚT"Šš\¦f%#`HCń2Ěźqrö_±sť0i&,ál3–SűrE6†Ű—‰˛ăV‚@!„ĺŮ3k-j™mfć'˝~~‡nŹŕ% 3[»6­m.ßJś;ţ«…•d}®ŁmW™ŇłÍ´ŞihţŐeHgĹę\ü{Vgç“ůÎ_Ý•ŔŘH ćL‹“\ Î9jáŕŽĎ®ňbkŻĆĄČy&gýŞˇ‡‰P|ëńcĚ˙ńňč§Éź÷»d™ÎđL`+ß\íńŤ`¤|Óź’?\ź%ŚP¸&Ý:J ÷n9űéM;*y‘1c¬±ÖÇál~9.Zx/§d”qp;ŢóűŔ©ÍĂžPă•ô_Ç‘ńÓŮĹÔD˛ÂÉ{6E1vte'áΤú iĹ›¨ őáÁscŻ÷ĂnpO­"OŽľ±Mý¬eK–Ť‘–.:Ź}QËřçň˝ ŰÁ$µ6rĹD—ŐÉ“ř?wöLŹ/šdˇ‡“s®Ďőá6|á7RĽ}*yn'{¬‘{íO‘H¬®BĐÜóŇ+éNX6BćŘĎýJŽ]Ĺ1'Žń0ŐT4˘©ĚśäëžâĽ8Mű ŠŤ†x g®ľć<5zŕ°¸@<•)Ţ1ńýë©°ükukĐ·ě yć°i@ěnÂq"¦2Ĺ`«â !}ił×«qZ4]¦ÍÝ­—AE_Š#ôm‡LL¶`…ľY†@9ď+´3䳎o´lh[%»‚ť® ü°.hő ‡fR;ŕ2B(ćch;Në^ᦪ~pHó3Ř$Ym-%őÍPSáţ7ŹÄuQ÷3Ář»bNlZuxřşť)÷ ‰±SŰ—ýä‹ImˇŐI<®“)f;ŐŇm%ŹŔߧţd,p•Ęşt†ŁyÜ~tôŤWô•ňj˝mS¸O—ÂŕŕPÎôúJöX^;řdtůë|%l<‹í™śz*‡ôr{Ű&€7B†ó”JÔ1™” 8Řęhřd+ĹrťÓTŰËŕ„°ĐnbűP„P ­ŁöD’‰(ÇDööťÁK¸'ÔÝÎR‡ę÷Ö§űg‹Ďź !h)/'âČŠ‰QâĆD9.ĂB?2ŤÄ>ů&KΚ›`8Ú€č uÇ}Ŕ‡®úöŽą +Ńr}wŘĚßjűźzÉë¸Ř„Nkz‘ÖôŐzŻMKr DÓk˝ ·Ź«üMáÎö[qÇě˝fémp^|o€c©pîÚĽćłxNdá-jÍš_ń\"ÔšŚťČóęćSE˝®Č8ř »ŚWQĽägkÍü}őV8«5,,/*WGqůKÇ7*śz¨]ě’psą¸ŽŃ¦]|óŠ t.Ş%ü3‚YVyŻ!IdŇ!ľ¨ç " Ŕ.«+&Gćŕ§z×ém'É´( DĽŰ衹TÎě}„ŹRĹwŞ…Ü’”zA,‰_Ńłé|MĄ_ăx¨—·¸Ĺ¬çJY•h ±oó(dÁtŔ*sů<Ł“eu3ç:…E^<ě"ü¤ëź$ÔăE¦Ö˛ô~¤D­óÇ[mâ/ę.čÁÂ{=ËÖ\ îxL~xq™ń»íś(řüägˇľÂUďçÚľgJ84űôůQB§÷3€ři@°Rř4Gá Ą+CŠla©X7“gÔ+A´L™(/‘ ­_ˇĆß{rű°Ş{ş~e1łÉ)HĎÜEĐŠć-zĚî_zĂöŰaú7a:ż“5·pí¬űÍË˙s´yĎś?ł×Ýă}7ĐÓ›}$»wLµďđ'§RĄ_ç/W5'Lĺ nýýß/ˇ¦ď°^Č>Gh'ˇđ C_‘ ©— 䬑)LOMQďÁE}ÎXS'FJíú‰bĘ;CJćóš˝q_ ß„éĂú¶g¬I.ç,Ăž ˙ŁÖ®r°1Áşm°IĄ\ˇş— Ö·jôł€°ô`™”ĘúŁ<37°·ÓB‚/ _ÚŁS¶Z^şPÁ‡˛ěq®š9ş!#TŘiÄĆÇÔěmÓ©k•>°Ö–wÜ5čśŃ&@Ô†ë¶ä°‰_ŃhÁguźÉ±H>PÝń6ňxCĽ’Ńř='q­sÉB!5ÔÉ% ů‚ąaDÚnmň‹*14Řó,䝏h—ÓÝp-¬]ޤ&QN^„·÷óžEâWětĽ!îMň¬Ż¨TŔáŔě-Ąb€ Ő!¤z§pĎŮK·µŮF¶ć![~ݶ¶ĘX„D›Aµ/nťßÜOÎ#YXšJÖlx‹ A1cŁÎ> RpP  ęˇËŕ…`.ţ ł4AŐśzĂ[4şkUóÂF\Hzá!‚»¦[ß­ÔK$x3É*R÷/bąÍýÖ5ć@ů%”ě® j‘Y‘Xě)ľŤ‚(ů×ÂóŔQŢ«hÇŢf7ˇwˇ_—Ž}N.­ŠŚą8Ż[9ęýRL§s-`‡-?SQĎÔk_V-»- Ťî:Dq{~¶=Ř —7lÍ|Şúnş$S•Ű8X´Ř*¦kp5 Ü1Ô$ţTgűŤ±™ Gxr¤3ER…ćĎöü)·;îăKŇÂ|’#ą»h4šV7=žô§23äŔHm-uꢨU˙ń¤ŤŇÇD‡ź|YĘ*wAÜś­uÁ!Ç|6b¸P\aý´’K_ĂzÜ5tjJAw÷@vř{«ço¶”őÜţa^·íVU¸Śň•ŚCąůgÜŔ™ŢdĄeđXÜâzEa0?î¦÷đŽ˙ÎŰÍ-±rlZ^ßó,ý0ŚH n˙äx¸…~~Óz}ířF… ¸lŔţöuŰ<Ůn á… ‡EŔ×G”­ě‹µć…Ż9÷OÍŽ4Ş1č!¤ă,yÎy!ĘßçVů‘;¨@HÜAvr4LŃň&€(:ý‚aL©˝Ý°SţçHäm|·:€âŠß¤ŘA‡3’ĚJ–ć•…47@| ĐŇ?¶?#$"ĄŇééâ¦Ä&Čá¤ËJŻhg»Ż÷őnä<>˝ôH,ŻmX¸•ş%%ü9„qTűŞÍÚ˙}ťhĆ9Îí‰m;Ń1ˇśŔđŤş%=Ę˙ť:Ť^ĽdoĂť=ҾƄĎm!¨M·«ä"öv4,Ľ'\ůd…ăV6ۧVY걢v: rkĽ7śplÚhé­O}5íT¬Ůü¦öޱsa'˛AÎ|"5>!qŮä/K#D9…§=Xw{xěTąç—‹=<ËB>=9¸Ďé˙U="zcÀɞV2ö&ëńđÄäŢě řD˙ęšQŇś&PüăABÓĂhaV8Ţ=§©Ä‡[¤ĂĺÎŐŚ82±çÜS6­ŇƢyžĎOčŹP—f÷ČŘ=˙_ę¸Ç¦[.{lú8Íżb®ĺO7.A˘>ÎS4Ѧž4=˛Ţn*QJćSyJayžáÓŤUÄ…Y8-ÜĚ<Ǣă–ÚLë±%µŘ(‹ŃňÝ@w,?;/ĘkŞ'‰lvxÁ··xŰĎĚ,ˇ˙bŢG/“ĚK«qDQĐ6 _]Űm®Ó ¸ü>–pĆ—[Ç0ĺ‚9đ” /'Ká|=Ç_ĺ/řH ¨Ś{ž._ ŰcpmhÄaéҦp°ß& |LeK:§yÁ{%ă&…‹fNk}0`(}v꬏1¦)`]żc•lp+sçŇä‡^żG›e4Ö™sÖN¨ä”ŤAI'ő'›Îň°Sz*÷DtCH,KČŔ†Őí 9, :Ő`–îčX–ˇWŁ‚n ĎFä-Wš őćfPüüŻ/¦eá<6źrV¦zńKďĺí÷d©ä2 =ÇTOŹŇňwcz}0žcĄ7őţ‚u¶řżâÖ(?5+X˝’(7bbÔNY0ňŘŐüřp¨żůWGXĂ}›Ŕ§br!Ż5ÔňmdťśŽ+q®ŚOľĎ*¦e§~ńLúí5>ëH7ěĆĹŐ˛_×=Bĺ«ľ6_ëxáw­ś6<÷>‡Áx—kâv˙ŞóE« ­llÖHâ^ÁorFŚ3fäP˛ă1öBČÔ\ëąJ€ßBÓ TÓµ}öLłđ[úűÎŻ)”Ńű=Bđ¸a}o&Ôó*äPÁQx«¤üÓú+*S •“Č :›˘9ତbö‹ë@V¦| ą#ąň扅EM×ÉÝMüË>Pq¸fî7đŮO(|–Ľ„ş‡ýŇ}îś´ë'Z8(şyÖXBa`ěSP^ęç~ĺňrŞhK/Ú`P/ąˇ`ĺĽm&áK='đ§ç(^M*wç|b–!®áx 3eäsŚš}Ó4ÁôĆ‚mÖ?…k˘Ň·ÇPěŻuC=ÄâW´ĹŚ?Ą e@ĄmÔâĆĆ°ÖÇÇ1‚Ů…Mó.âÄÚ™Y¶tŇĘç$ń,sˇ3‚ŽV]+ŁI0ľSÖ·ĆŚ%KÔXÓ ăYŚF±»}¸„őZ.±˛|ĺöTYÉ^â”V›: +•4ťŐű™))솞ćZŹ5—đá ĄX··5ßž˘×ćŢĹÜ"´Z^/(!Ś(˘LČ´ŤöŤ™x‘ľ˘ĆňrŁ_„vX¨B&)( \Ź–Âěž8Î[ÖđAŤńňzěsŻVŁK?,šőČĆóËO¬^ě 4J’GuçĐś«E»÷Żé­ő %śî|ŘsúÉFá÷ćţÖÍŽ’‘‹%YólČČ0E‰© 2q”¤) Ňăq1Í97ěrý-“äĐ­$ˇâŔ¦ßľKŠhŠŘ$ÄŮ–Żíü:Č$†ŐcŻ箩Ńq•qÓ‘wS° 2Y‰íckď!·˝üŽ Ź ŁŐ“˙zn şż ®Á…S»5Ľ,[ŐÓ×Ň۵ěea‡ýŕ‹Âł÷ŐÇč¸^ĎăćőbÓ0A‹ŤQeť8W°Ń1Bęľl(ĘůéuKů»‰cDřNBŠö&+ŤŘk¤h,Ä.ŔŢ aŮŹbuď뇣ťp( ŕ“󄢄6¶W{‰ë~Ô7ńXłű†­SŁÚuN±Ú˝ŤěQ3$ŘG$ş·3˘%TIëH›θqµÁq"°őż”äCÜ S~·v)µŻP˝—wu­¤×ą§HBâ¨zâÔ¸m»°żň DćśĂ±]q}M/bg ^Ą7ă´ĄL42( ZŽĆŇ f[›ÔgE*’ôţ®šn÷üçâZË {˝]/u˘+-vłłŞ/‡ßYµôĘPţzxŐ|U ?Ă˝`> 뼌‹ËD§çľLM"©ą¨dÇË^ń 0”o­×ăĘ#E&ž oyGý27 łgîU«>ůŕ<Č›ňç€\±°¬ #é— Ä÷…Ąá“ă2›ăQ@YZlme4/R/lmer.R0000644000176200001440000032145315221061066012405 0ustar liggesusers## NB: doc in ../man/*.Rd ***not*** auto generated ## FIXME: need to document S3 methods better (can we pull from r-forge version?) ##' Fit a linear mixed model (LMM) lmer <- function(formula, data=NULL, REML = TRUE, control = lmerControl(), start = NULL , verbose = 0L , subset, weights, na.action, offset , contrasts = NULL , devFunOnly=FALSE ) ## , ...) { mc <- mcout <- match.call() missCtrl <- missing(control) ## see functions in modular.R for the body .. if (!missCtrl && !inherits(control, "lmerControl")) { if(!is.list(control)) stop("'control' is not a list; use lmerControl()") ## back-compatibility kluge warning("passing control as list is deprecated: please use lmerControl() instead", immediate.=TRUE) control <- do.call(lmerControl, control) } ## if (!is.null(list(...)[["family"]])) { ## warning("calling lmer with 'family' is deprecated; please use glmer() instead") ## mc[[1]] <- quote(lme4::glmer) ## if(missCtrl) mc$control <- glmerControl() ## return(eval(mc, parent.frame(1L))) ## } mc$control <- control ## update for back-compatibility kluge ## https://github.com/lme4/lme4/issues/50 ## parse data and formula mc[[1]] <- quote(lme4::lFormula) lmod <- eval(mc, parent.frame(1L)) mcout$formula <- lmod$formula lmod$formula <- NULL if (is.matrix(y <- model.response(lmod$fr)) && ncol(y) > 1) { stop("can't handle matrix-valued responses: consider using refit()") } ## create deviance function for covariance parameters lmod.. <- list(start=start, verbose=verbose, control=control) devfun <- do.call(mkLmerDevfun, c(lmod, lmod..)) if (devFunOnly) return(devfun) rho <- environment(devfun) nobs <- nrow(lmod$fr) npar <- length(rho$lower) calc.derivs <- control$calc.derivs %||% (nobs < control$checkConv$check.conv.nobsmax && npar < control$checkConv$check.conv.nparmax) if (identical(control$optimizer, "none")) stop("deprecated use of optimizer==\"none\"; use NULL instead") ## optimize deviance function over covariance parameters opt <- if (length(control$optimizer)==0) { s <- getStart(start, rho, 0L) list(par=s,fval=devfun(s), conv=1000,message="no optimization") } else { optimizeLmer(devfun, optimizer = control$optimizer, restart_edge = control$restart_edge, boundary.tol = control$boundary.tol, control = control$optCtrl, verbose=verbose, start=start, calc.derivs=calc.derivs, force.calc.derivs=control$calc.derivs %||% FALSE, use.last.params=control$use.last.params) } cc <- checkConv(attr(opt,"derivs"), opt$par, ctrl = control$checkConv, lbound = rho$lower, ubound = rho$upper, nobs = nobs, ndim = npar) mkMerMod(rho, opt, lmod$reTrms, fr = lmod$fr, mc = mcout, lme4conv=cc) ## prepare output }## { lmer } ##' Fit a generalized linear mixed model (GLMM) glmer <- function(formula, data=NULL , family = gaussian , control = glmerControl() , start = NULL , verbose = 0L , nAGQ = 1L , subset, weights, na.action, offset, contrasts = NULL , mustart, etastart , devFunOnly = FALSE) { if (!inherits(control, "glmerControl")) { if(!is.list(control)) stop("'control' is not a list; use glmerControl()") ## back-compatibility kluge if (class(control)[1]=="lmerControl") { warning("please use glmerControl() instead of lmerControl()", immediate.=TRUE) control <- ## unpack sub-lists c(control[!names(control) %in% c("checkConv","checkControl")], control$checkControl,control$checkConv) control["restart_edge"] <- NULL ## not implemented for glmer } else { msg <- "Use control=glmerControl(..) instead of passing a list" if(length(cl <- class(control))) { msg <- paste(msg, "of class", dQuote(cl[1])) } warning(msg, immediate.=TRUE) } control <- do.call(glmerControl, control) } mc <- mcout <- match.call() ## family-checking code duplicated here and in glFormula (for now) since ## we really need to redirect at this point; eventually deprecate formally ## and clean up if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame(2)) if( is.function(family)) family <- family() if (isTRUE(all.equal(family, gaussian()))) { ## redirect to lmer (with warning) warning("calling glmer() with family=gaussian (identity link) as a shortcut to lmer() is deprecated;", " please call lmer() directly") mc[[1]] <- quote(lme4::lmer) mc["family"] <- NULL # to avoid an infinite loop return(eval(mc, parent.frame())) } ## see https://github.com/lme4/lme4/issues/50 ## parse the formula and data mc[[1]] <- quote(lme4::glFormula) glmod <- eval(mc, parent.frame(1L)) mcout$formula <- glmod$formula glmod$formula <- NULL if (is.matrix(y <- model.response(glmod$fr)) && ((family$family != "binomial" && ncol(y) > 1) || (ncol(y) >2))) { stop("can't handle matrix-valued responses: consider using refit()") } ## create deviance function for covariance parameters nAGQinit <- if (control$nAGQ0initStep) 0L else nAGQ glmod.. <- list(nAGQ=nAGQinit, verbose=verbose, control=control) devfun <- do.call(mkGlmerDevfun, c(glmod, glmod..)) if (devFunOnly && nAGQ == 0L) return(devfun) rho <- environment(devfun) if (nAGQinit == 0L) { start0 <- if (nAGQ > 0L && is.list(start) && !is.null(names(start))) start[!names(start) %in% c("fixef", "beta")] else start ## optimize deviance function over covariance parameters ## FIXME: allow calc.derivs, use.last.params, etc. if nAGQ=0 opt <- optimizeGlmer(devfun, optimizer = control$optimizer[[1]], ## DON'T try fancy edge tricks unless nAGQ=0 explicitly set restart_edge=if (nAGQ==0) control$restart_edge else FALSE, boundary.tol=if (nAGQ==0) control$boundary.tol else 0, control = control$optCtrl, start = start0, nAGQ = 0, verbose=verbose, calc.derivs=FALSE) if (nAGQ > 0L) { ## update deviance function to include fixed effects devfun <- updateGlmerDevfun(devfun, glmod$reTrms, nAGQ = nAGQ) if (devFunOnly) return(devfun) start <- updateStart(start, opt$par) } } nobs <- nrow(glmod$fr) npar <- length(rho$lower) calc.derivs <- control$calc.derivs %||% (nobs < control$checkConv$check.conv.nobsmax && npar < control$checkConv$check.conv.nparmax) if (nAGQ > 0L) ## optimize deviance function over covariance parameters and ## fixed effects opt <- optimizeGlmer(devfun, optimizer = control$optimizer[[2]], restart_edge=control$restart_edge, boundary.tol=control$boundary.tol, control = control$optCtrl, start=start, nAGQ=nAGQ, verbose = verbose, calc.derivs=calc.derivs, use.last.params=control$use.last.params) cc <- if (!calc.derivs) NULL else { if (verbose > 10) cat("checking convergence\n") checkConv(attr(opt,"derivs"),opt$par, ctrl = control$checkConv, lbound = rho$lower, ubound = rho$upper, nobs = nobs, ndim = npar) } ## prepare output mkMerMod(rho, opt, glmod$reTrms, fr = glmod$fr, mc = mcout, lme4conv=cc) }## {glmer} ##' Fit a nonlinear mixed-effects model nlmer <- function(formula, data=NULL, control = nlmerControl(), start = NULL, verbose = 0L, nAGQ = 1L, subset, weights, na.action, offset, contrasts = NULL, devFunOnly = FALSE) { vals <- nlformula(mc <- match.call()) p <- ncol(X <- vals$X) if ((rankX <- rankMatrix(X)) < p) stop(gettextf("rank of X = %d < ncol(X) = %d", rankX, p)) rho <- list2env(list(verbose=verbose, tolPwrss=0.001, # this is reset to the tolPwrss argument's value later resp=vals$respMod), parent=parent.frame()) rho$pp <- do.call(merPredD$new, c(vals$reTrms[c("Zt","theta","Lambdat","Lind")], list(X=X, n=length(vals$respMod$mu), Xwts=vals$respMod$sqrtXwt, beta0=qr.coef(qr(X), unlist(lapply(vals$pnames, get, envir = vals$respMod$nlenv)))))) rho$mkPar <- mkMkPar(vals$reTrms$reCovs) rho$mkTheta <- mkMkTheta(vals$reTrms$reCovs) rho$u0 <- rho$pp$u0 rho$beta0 <- rho$pp$beta0 ## deviance as a function of theta only : devfun <- mkdevfun(rho, 0L, verbose=verbose, control=control) if (devFunOnly && !nAGQ) return(devfun) devfun(rho$mkPar(rho$pp$theta)) # initial coarse evaluation to get u0 and beta0 rho$u0 <- rho$pp$u0 rho$beta0 <- rho$pp$beta0 rho$tolPwrss <- control$tolPwrss # Reset control parameter (the initial optimization is coarse) rho$nAGQ <- nAGQ ## set lower and upper bounds: if user-specified, select ## only the ones corresponding to random effects lower <- vals$reTrms$lower if (!is.null(lwr <- control$optCtrl$lower)) { lower <- lwr[seq_along(lower)] control$optCtrl$lower <- NULL } upper <- vals$reTrms$upper if (!is.null(upr <- control$optCtrl$upper)) { upper <- upr[seq_along(upper)] control$optCtrl$upper <- NULL } opt <- optwrap(control$optimizer[[1]], devfun, rho$mkPar(rho$pp$theta), lower=lower, upper=upper, control=control$optCtrl, adj=FALSE) if (nAGQ > 0L) { ## set lower/upper to values already harvested from control$optCtrl$upper lower <- lwr %||% c(lower, rep.int(-Inf, length(rho$pp$beta0))) upper <- upr %||% c(upper, rep.int( Inf, length(rho$pp$beta0))) rho$dpars <- seq_len(length(lower) - length(rho$pp$beta0)) rho$u0 <- rho$pp$u0 rho$beta0 <- pmin(upper[-rho$dpars], pmax(rho$pp$beta0, lower[-rho$dpars])) if (nAGQ > 1L) { if (length(vals$reTrms$flist) != 1L || length(vals$reTrms$cnms[[1]]) != 1L) stop("nAGQ > 1 is only available for models with a single, scalar random-effects term") rho$fac <- vals$reTrms$flist[[1]] } devfun <- mkdevfun(rho, nAGQ, verbose=verbose, control=control) if (devFunOnly) return(devfun) opt <- optwrap(control$optimizer[[2]], devfun, par = c(rho$mkPar(rho$pp$theta), rho$beta0), lower = lower, upper = upper, control = control$optCtrl, adj = TRUE, verbose=verbose) } mkMerMod(environment(devfun), opt, vals$reTrms, fr = vals$frame, mc = mc) }## {nlmer} ## R 3.1.0 devel [2013-08-05]: This does not help yet if(getRversion() >= "3.1.0") utils::suppressForeignCheck("nlmerAGQ") if(getRversion() < "3.1.0") dontCheck <- identity ## *not* exported (had help page till early 2018) ## -> issue #92: -> also look at devfun2() in ./profile.R (which returns class!) ##' Create a deviance evaluation function from a predictor and a response module ##' @param rho an `environment` already containing `verbose` and tolPwrss ##' @param nAGQ for glmer/nlmer: #{AGQ steps}; 0 <==> Laplace ##' @param maxit maximal number of PIRLS iterations ##' @param verbose integer specifying if outputs should be produced ##' @param control a list as from lmerControl() etc mkdevfun <- function(rho, nAGQ=1L, maxit = if(extends(rho.cld, "nlsResp")) 300L else 100L, verbose=0, control=list()) { ## FIXME: should nAGQ be automatically embedded in rho? stopifnot(is.environment(rho), ## class definition, compute and save : extends(rho.cld <- getClass(class(rho$resp)), "lmResp")) ## silence R CMD check warnings *locally* in this function ## (clearly preferred to using globalVariables() !] fac <- pp <- resp <- lp0 <- compDev <- dpars <- baseOffset <- tolPwrss <- pwrssUpdate <- ## <-- even though it's a function below GQmat <- nlmerAGQ <- mkTheta <- NULL ## The deviance function (to be returned, with 'rho' as its environment): ff <- if (extends(rho.cld, "lmerResp")) { rho$lmer_Deviance <- lmer_Deviance function(par) .Call(lmer_Deviance, pp$ptr(), resp$ptr(), mkTheta(as.double(par))) } else if (extends(rho.cld, "glmResp")) { ## control values will override rho values *if present* if (!is.null(tp <- control$tolPwrss)) rho$tolPwrss <- tp if (!is.null(cd <- control$ compDev)) rho$compDev <- cd if (nAGQ == 0L) function(par) { resp$updateMu(lp0) pp$setTheta(mkTheta(as.double(par))) p <- pwrssUpdate(pp, resp, tol=tolPwrss, GQmat=GHrule(0L), compDev=compDev, maxit=maxit, verbose=verbose) resp$updateWts() p } else ## nAGQ > 0 function(pars) { ## pp$setDelu(rep(0, length(pp$delu))) resp$setOffset(baseOffset) resp$updateMu(lp0) pp$setTheta(mkTheta(as.double(pars[dpars]))) spars <- as.double(pars[-dpars]) offset <- if (length(spars)==0) baseOffset else baseOffset + pp$X %*% spars resp$setOffset(offset) p <- pwrssUpdate(pp, resp, tol=tolPwrss, GQmat=GQmat, compDev=compDev, grpFac=fac, maxit=maxit, verbose=verbose) resp$updateWts() p } } else if (extends(rho.cld, "nlsResp")) { if (nAGQ <= 1L) { rho$nlmerLaplace <- nlmerLaplace rho$tolPwrss <- control$tolPwrss rho$maxit <- maxit switch(nAGQ + 1L, function(par) .Call(nlmerLaplace, pp$ptr(), resp$ptr(), as.double(par), as.double(u0), as.double(beta0), verbose, FALSE, tolPwrss, maxit), function(pars) .Call(nlmerLaplace, pp$ptr(), resp$ptr(), as.double(pars[dpars]), as.double(u0), as.double(pars[-dpars]), verbose, TRUE, tolPwrss, maxit)) } else { stop("nAGQ > 1 not yet implemented for nlmer models") rho$nlmerAGQ <- nlmerAGQ rho$GQmat <- GHrule(nAGQ) ## function(pars) { ## .Call(nlmerAGQ, ## <- dontCheck(nlmerAGQ) should work according to docs but does not ## pp$ptr(), resp$ptr(), fac, GQmat, pars[dpars], ## u0, pars[-dpars], tolPwrss) ##} } } else stop("code not yet written") environment(ff) <- rho ff } ## Determine a step factor that will reduce the pwrss ## ## The penalized, weighted residual sum of squares (pwrss) is the sum ## of the weighted residual sum of squares from the resp module and ## the squared length of u from the predictor module. The predictor module ## contains a base value and an increment for the coefficients. ## @title Determine a step factor ## @param pp predictor module ## @param resp response module ## @param verbose logical value determining verbose output ## @return NULL if successful ## @note Typically all this is done in the C++ code. ## The R code is for debugging and comparisons of ## results. ## stepFac <- function(pp, resp, verbose, maxSteps = 10) { ## stopifnot(is.numeric(maxSteps), maxSteps >= 2) ## pwrss0 <- resp$wrss() + pp$sqrL(0) ## for (fac in 2^(-(0:maxSteps))) { ## wrss <- resp$updateMu(pp$linPred(fac)) ## pwrss1 <- wrss + pp$sqrL(fac) ## if (verbose > 3L) ## cat(sprintf("pwrss0=%10g, diff=%10g, fac=%6.4f\n", ## pwrss0, pwrss0 - pwrss1, fac)) ## if (pwrss1 <= pwrss0) { ## pp$installPars(fac) ## return(NULL) ## } ## } ## stop("step factor reduced below ",signif(2^(-maxSteps),2)," without reducing pwrss") ## } RglmerWrkIter <- function(pp, resp, uOnly=FALSE) { pp$updateXwts(resp$sqrtWrkWt()) pp$updateDecomp() pp$updateRes(resp$wtWrkResp()) if (uOnly) pp$solveU() else pp$solve() resp$updateMu(pp$linPred(1)) # full increment resp$resDev() + pp$sqrL(1) } ##' @param pp pred module ##' @param resp resp module ##' @param tol numeric tolerance ##' @param GQmat matrix of Gauss-Hermite quad info ##' @param compDev compute in C++ (as opposed to doing as much as possible in R) ##' @param grpFac grouping factor (normally found in environment ..) ##' @param verbose verbosity, of course glmerPwrssUpdate <- function(pp, resp, tol, GQmat, compDev=TRUE, grpFac=NULL, maxit = 70L, verbose=0) { nAGQ <- nrow(GQmat) if (compDev) { if (nAGQ < 2L) return(.Call(glmerLaplace, pp$ptr(), resp$ptr(), nAGQ, tol, as.integer(maxit), verbose)) return(.Call(glmerAGQ, pp$ptr(), resp$ptr(), tol, as.integer(maxit), GQmat, grpFac, verbose)) } ### does this show anywhere ??? [i.e. is it ever used in our checks/examples/scripts/vignettes ? ### message("glmerPwrssUpdate(*, compDev=FALSE) --> using more R, no direct .Call() to C.") # [DBG] only oldpdev <- .Machine$double.xmax uOnly <- nAGQ != 0L i <- 0 repeat { ## oldu <- pp$delu ## olddelb <- pp$delb pdev <- RglmerWrkIter(pp, resp, uOnly=uOnly) if (verbose > 2) cat(i,": ",pdev,"\n",sep="") ## check convergence first so small increases don't trigger errors if (is.na(pdev)) stop("encountered NA in PWRSS update") if (abs((oldpdev - pdev) / pdev) < tol) break ## if (pdev > oldpdev) { ## ## try step-halving ## k <- 0 ## while (k < 10 && pdev > oldpdev) { ## pp$setDelu((oldu + pp$delu)/2.) ## if (!uOnly) pp$setDelb((olddelb + pp$delb)/2.) ## pdev <- RglmerWrkIter(pp, resp, uOnly=uOnly) ## k <- k+1 ## } ## } if (pdev > oldpdev) stop("PIRLS update failed") oldpdev <- pdev i <- i+1 } resp$Laplace(pp$ldL2(), 0., pp$sqrL(1)) ## FIXME: should 0. be pp$ldRX2 ? } ## create a deviance evaluation function that uses the sigma parameters ## df2 <- function(dd) { ## stopifnot(is.function(dd), ## length(formals(dd)) == 1L, ## is((rem <- (rho <- environment(dd))$rem), "Rcpp_reModule"), ## is((fem <- rho$fem), "Rcpp_deFeMod"), ## is((resp <- rho$resp), "Rcpp_lmerResp"), ## all((lower <- rem$lower) == 0)) ## Lind <- rem$Lind ## n <- length(resp$y) ## function(pars) { ## sigma <- pars[1] ## sigsq <- sigma * sigma ## sigmas <- pars[-1] ## theta <- sigmas/sigma ## rem$theta <- theta ## resp$updateMu(numeric(n)) ## solveBetaU(rem, fem, resp$sqrtXwt, resp$wtres) ## resp$updateMu(rem$linPred1(1) + fem$linPred1(1)) ## n * log(2*pi*sigsq) + (resp$wrss + rem$sqrLenU)/sigsq + rem$ldL2 ## } ## } ## bootMer() ---> now in ./bootMer.R ## Methods for the merMod class ## Anova for merMod objects ## ## @title anova() for merMod objects ## @param a merMod object ## @param ... further such objects ## @param refit should objects be refitted with ML (if applicable) ## @return an "anova" data frame; the traditional (S3) result of anova() anovaLmer <- function(object, ..., refit = TRUE, model.names=NULL) { mCall <- match.call(expand.dots = TRUE) dots <- list(...) .sapply <- function(L, FUN, ...) unlist(lapply(L, FUN, ...)) modp <- (as.logical(vapply(dots, is, NA, "merMod")) | as.logical(vapply(dots, is, NA, "lm"))) if (any(modp)) { ## multiple models - form table ## opts <- dots[!modp] mods <- c(list(object), dots[modp]) nobs.vec <- vapply(mods, nobs, 1L) if (var(nobs.vec) > 0) stop("models were not all fitted to the same size of dataset") ## model names if (is.null(mNms <- model.names)) mNms <- vapply(as.list(mCall)[c(FALSE, TRUE, modp)], deparse1, "") ## HACK to try to identify model names in situations such as ## 'do.call(anova,list(model1,model2))' where the model names ## are lost in the call stack ... this doesn't quite work but might ## be useful for future attempts? ## maxdepth <- -2 ## depth <- -1 ## while (depth >= maxdepth & ## all(grepl("S4 object of class structure",mNms))) { ## xCall <- match.call(call=sys.call(depth)) ## mNms <- .sapply(as.list(xCall)[c(FALSE, TRUE, modp)], deparse) ## depth <- depth-1 ## } ## if (depth < maxdepth) { if (any(substr(mNms, 1,4) == "new(") || any(duplicated(mNms)) || ## <- only if S4 objects are *not* properly deparsed max(nchar(mNms)) > 200) { warning("failed to find model names, assigning generic names") mNms <- paste0("MODEL",seq_along(mNms)) } if (length(mNms) != length(mods)) stop("model names vector and model list have different lengths") names(mods) <- sub("@env$", '', mNms) # <- hack models.reml <- vapply(mods, function(x) is(x,"merMod") && isREML(x), NA) models.GHQ <- vapply(mods, function(x) is(x,"glmerMod") && getME(x,"devcomp")$dims[["nAGQ"]]>1 , NA) if (any(models.GHQ) && any(vapply(mods, function(x) is(x,"glm"), NA))) stop("GLMMs with nAGQ>1 have log-likelihoods incommensurate with glm() objects") if (refit) { ## message only if at least one models is REML: if (any(models.reml)) message("refitting model(s) with ML (instead of REML)") mods[models.reml] <- lapply(mods[models.reml], refitML) } else { ## check that models are consistent (all REML or all ML) if(any(models.reml) && any(!models.reml)) warning("some models fit with REML = TRUE, some not") } ## devs <- sapply(mods, deviance) llks <- lapply(mods, logLik) ## Order models by increasing degrees of freedom: ii <- order(npar <- vapply(llks, attr, FUN.VALUE=numeric(1), "df")) mods <- mods[ii] llks <- llks[ii] npar <- npar [ii] calls <- lapply(mods, getCall) data <- lapply(calls, `[[`, "data") if(!all(vapply(data, identical, NA, data[[1]]))) stop("all models must be fit to the same data object") header <- paste("Data:", abbrDeparse(data[[1]])) subset <- lapply(calls, `[[`, "subset") if(!all(vapply(subset, identical, NA, subset[[1]]))) stop("all models must use the same subset") if (!is.null(subset[[1]])) header <- c(header, paste("Subset:", abbrDeparse(subset[[1]]))) llk <- unlist(llks) chisq <- 2 * pmax(0, c(NA_real_, diff(llk))) dfChisq <- c(NA_integer_, diff(npar)) val <- data.frame(npar = npar, ## afraid to swap in vapply here; wondering ## why .sapply was needed in the first place ... AIC = .sapply(llks, AIC), # FIXME? vapply() BIC = .sapply(llks, BIC), # " " logLik = llk, "-2*log(L)" = -2*llk, Chisq = chisq, Df = dfChisq, "Pr(>Chisq)" = ifelse(dfChisq==0,NA_integer_,pchisq(chisq, dfChisq, lower.tail = FALSE)), row.names = names(mods), check.names = FALSE) class(val) <- c("anova", class(val)) forms <- lapply(lapply(calls, `[[`, "formula"), deparse1) structure(val, heading = c(header, "Models:", paste(rep.int(names(mods), lengths(forms)), unlist(forms), sep = ": "))) } else { ## ------ single model --------------------- if (length(dots)>0) { warnmsg <- "additional arguments ignored" nd <- names(dots) nd <- nd[nzchar(nd)] if (length(nd)>0) { warnmsg <- paste0(warnmsg,": ", paste(sQuote(nd),collapse=", ")) } warning(warnmsg) } dc <- getME(object, "devcomp") X <- getME(object, "X") stopifnot(length(asgn <- attr(X, "assign")) == dc$dims[["p"]]) ss <- as.vector(object@pp$RX() %*% object@beta)^2 names(ss) <- colnames(X) terms <- terms(object) nmeffects <- attr(terms, "term.labels")[unique(asgn)] if ("(Intercept)" %in% names(ss)) nmeffects <- c("(Intercept)", nmeffects) ss <- unlist(lapply(split(ss, asgn), sum)) stopifnot(length(ss) == length(nmeffects)) df <- lengths(split(asgn, asgn)) ## dfr <- unlist(lapply(split(dfr, asgn), function(x) x[1])) ms <- ss/df f <- ms/(sigma(object)^2) ## No longer provide p-values, but still the F statistic (may not be F distributed): ## ## P <- pf(f, df, dfr, lower.tail = FALSE) ## table <- data.frame(df, ss, ms, dfr, f, P) table <- data.frame(df, ss, ms, f) dimnames(table) <- list(nmeffects, ## c("npar", "Sum Sq", "Mean Sq", "Denom", "F value", "Pr(>F)")) c("npar", "Sum Sq", "Mean Sq", "F value")) if ("(Intercept)" %in% nmeffects) table <- table[-match("(Intercept)", nmeffects), ] structure(table, heading = "Analysis of Variance Table", class = c("anova", "data.frame")) } }## {anovaLmer} ##' @importFrom stats anova ##' @S3method anova merMod anova.merMod <- anovaLmer ##' @S3method as.function merMod as.function.merMod <- function(x, ...) { reCovs <- getReCovs(x) rho <- list2env(list(resp = x@resp$copy(), pp = x@pp$copy(), lower = getLower(x), upper = getUpper(x), mkPar = mkMkPar(reCovs), mkTheta = mkMkTheta(reCovs)), parent=as.environment("package:lme4")) ## FIXME: extract verbose [, maxit] and control mkdevfun(rho, getME(x, "devcomp")$dims[["nAGQ"]], ...) } ## coef() method for all kinds of "mer", "*merMod", ... objects ## ------ should work with fixef() + ranef() alone coefMer <- function(object, ...) { if(...length()) warning('arguments named ', paste(sQuote(...names()), collapse = ", "), ' ignored') fef <- data.frame(rbind(fixef(object)), check.names = FALSE) ref <- ranef(object, condVar = FALSE) ## check for variables in RE but missing from FE, fill in zeros in FE accordingly refnames <- unlist(lapply(ref,colnames)) nmiss <- length(missnames <- setdiff(refnames,names(fef))) if (nmiss > 0) { fillvars <- setNames(data.frame(rbind(rep(0,nmiss))),missnames) fef <- cbind(fillvars,fef) } val <- lapply(ref, function(x) fef[rep.int(1L, nrow(x)),,drop = FALSE]) for (i in seq_along(val)) { refi <- ref[[i]] row.names(val[[i]]) <- row.names(refi) nmsi <- colnames(refi) if (!all(nmsi %in% names(fef))) stop("unable to align random and fixed effects") for (nm in nmsi) val[[i]][[nm]] <- val[[i]][[nm]] + refi[,nm] } class(val) <- "coef.mer" val } ## {coefMer} ##' @importFrom stats coef ##' @S3method coef merMod coef.merMod <- coefMer ## FIXME: should these values (i.e. ML criterion for REML models ## and vice versa) be computed and stored in the object in the first place? ##' @importFrom stats deviance ##' @S3method deviance merMod deviance.merMod <- function(object, REML = NULL, ...) { ## type = c("conditional", "unconditional", "penalized"), ## relative = TRUE, ...) { if (isGLMM(object)) { return(sum(residuals(object,type="deviance")^2)) ## ------------------------------------------------------------ ## proposed change to deviance function for GLMMs ## ------------------------------------------------------------ ## @param type Type of deviance (can be unconditional, ## penalized, conditional) ## @param relative Should deviance be shifted relative to a ## saturated model? (only available with type == penalized or ## conditional) ## ------------------------------------------------------------ ## ans <- switch(type[1], ## unconditional = { ## if (relative) { ## stop("unconditional and relative deviance is undefined") ## } ## c(-2 * logLik(object)) ## }, ## penalized = { ## sqrL <- object@pp$sqrL(1) ## if (relative) { ## object@resp$resDev() + sqrL ## } else { ## useSc <- unname(getME(gm1, "devcomp")$dims[["useSc"]]) ## qLog2Pi <- unname(getME(object, "q")) * log(2 * pi) ## object@resp$aic() - (2 * useSc) + sqrL + qLog2Pi ## } ## }, ## conditional = { ## if (relative) { ## object@resp$resDev() ## } else { ## useSc <- unname(getME(gm1, "devcomp")$dims[["useSc"]]) ## object@resp$aic() - (2 * useSc) ## } ## }) ## return(ans) } if (isREML(object) && is.null(REML)) { warning("deviance() is deprecated for REML fits; use REMLcrit for the REML criterion or deviance(.,REML=FALSE) for deviance calculated at the REML fit") return(devCrit(object, REML=TRUE)) } devCrit(object, REML=FALSE) } REMLcrit <- function(object) { devCrit(object, REML=TRUE) } ## original deviance.merMod -- now wrapped by REMLcrit ## REML=NULL: ## if REML fit return REML criterion ## if ML fit, return deviance ## REML=TRUE: ## if not LMM, stop. ## if ML fit, compute and return REML criterion ## if REML fit, return REML criterion ## REML=FALSE: ## if ML fit, return deviance ## if REML fit, compute and return deviance devCrit <- function(object, REML = NULL) { ## cf. (1) lmerResp::Laplace in respModule.cpp ## (2) section 5.6 of lMMwR, listing lines 34-42 if (isTRUE(REML) && !isLMM(object)) stop("can't compute REML deviance for a non-LMM") cmp <- object@devcomp$cmp if (is.null(REML) || is.na(REML[1])) REML <- isREML(object) if (REML) { if (isREML(object)) { cmp[["REML"]] } else { ## adjust ML results to REML lnum <- log(2*pi*cmp[["pwrss"]]) n <- object@devcomp$dims[["n"]] nmp <- n - length(object@beta) ldW <- sum(log(weights(object, method = "prior"))) - ldW + cmp[["ldL2"]] + cmp[["ldRX2"]] + nmp*(1 + lnum - log(nmp)) } } else { if (!isREML(object)) { cmp[["dev"]] } else { ## adjust REML results to ML n <- object@devcomp$dims[["n"]] lnum <- log(2*pi*cmp[["pwrss"]]) ldW <- sum(log(weights(object, method = "prior"))) - ldW + cmp[["ldL2"]] + n*(1 + lnum - log(n)) } } } ## copied from stats:::safe_pchisq safe_pchisq <- function (q, df, ...) { df[df <= 0] <- NA pchisq(q = q, df = df, ...) } ##' @importFrom stats drop1 ##' @S3method drop1 merMod drop1.merMod <- function(object, scope, scale = 0, test = c("none", "Chisq", "user"), k = 2, trace = FALSE, sumFun=NULL, ...) { evalhack <- "formulaenv" test <- match.arg(test) if ((test=="user" && is.null(sumFun)) || ((test!="user" && !is.null(sumFun)))) stop(sQuote("sumFun"),' must be specified if (and only if) test=="user"') tl <- attr(terms(object), "term.labels") if(missing(scope)) scope <- drop.scope(object) else { if(!is.character(scope)) { scope <- attr(terms(getFixedFormula(update.formula(object, scope))), "term.labels") } if(!all(match(scope, tl, 0L) > 0L)) stop("scope is not a subset of term labels") } ns <- length(scope) if (is.null(sumFun)) { sumFun <- function(x,scale,k,...) setNames(extractAIC(x,scale,k,...),c("df","AIC")) } ss <- sumFun(object, scale=scale, k=k, ...) ans <- matrix(nrow = ns + 1L, ncol = length(ss), dimnames = list(c("", scope), names(ss))) ans[1, ] <- ss n0 <- nobs(object, use.fallback = TRUE) env <- environment(formula(object)) # perhaps here is where trouble begins?? for(i in seq_along(scope)) { ## was seq(ns), failed on empty scope tt <- scope[i] if(trace > 1) { cat("trying -", tt, "\n", sep='') flush.console() } ## FIXME: make this more robust, somehow? ## three choices explored so far: ## (1) evaluate nfit in parent frame: tests in inst/tests/test-formulaEval.R ## will fail on lapply(m_data_List,drop1) ## (formula environment contains r,x,y,z but not d) ## (2) evaluate nfit in frame of formula: tests will fail when data specified and formula is character ## (3) update with data=NULL: fails when ... ## if (evalhack %in% c("parent","formulaenv")) { nfit <- update(object, as.formula(paste("~ . -", tt)), evaluate = FALSE) ## nfit <- eval(nfit, envir = env) # was eval.parent(nfit) if (evalhack=="parent") { nfit <- eval.parent(nfit) } else if (evalhack=="formulaenv") { nfit <- eval(nfit,envir=env) } } else { nfit <- update(object, as.formula(paste("~ . -", tt)),data=NULL, evaluate = FALSE) nfit <- eval(nfit,envir=env) } if (test=="user") { ans[i+1, ] <- sumFun(object, nfit, scale=scale, k=k, ...) } else { ans[i+1, ] <- sumFun(nfit, scale, k = k, ...) } nnew <- nobs(nfit, use.fallback = TRUE) if(all(is.finite(c(n0, nnew))) && nnew != n0) stop("number of rows in use has changed: remove missing values?") } if (test=="user") { aod <- as.data.frame(ans) } else { dfs <- ans[1L, 1L] - ans[, 1L] dfs[1L] <- NA aod <- data.frame(npar = dfs, AIC = ans[,2]) if(test == "Chisq") { ## reconstruct deviance from AIC (ugh) dev <- ans[, 2L] - k*ans[, 1L] dev <- dev - dev[1L] ; dev[1L] <- NA nas <- !is.na(dev) P <- dev P[nas] <- safe_pchisq(dev[nas], dfs[nas], lower.tail = FALSE) aod[, c("LRT", "Pr(Chi)")] <- list(dev, P) } else if (test == "F") { ## FIXME: allow this if denominator df are specified externally? stop("F test STUB -- unfinished maybe forever") dev <- ans[, 2L] - k*ans[, 1L] dev <- dev - dev[1L] ; dev[1L] <- NA nas <- !is.na(dev) P <- dev P[nas] <- safe_pchisq(dev[nas], dfs[nas], lower.tail = FALSE) aod[, c("LRT", "Pr(F)")] <- list(dev, P) } } head <- c("Single term deletions", "\nModel:", deparse(formula(object)), if(scale > 0) paste("\nscale: ", format(scale), "\n")) if (!is.null(method <- attr(ss,"method"))) { head <- c(head,"Method: ",method,"\n") } structure(aod, heading = head, class = c("anova", "data.frame")) } ##' @importFrom stats extractAIC ##' @S3method extractAIC merMod extractAIC.merMod <- function(fit, scale = 0, k = 2, ...) { L <- logLik(refitML(fit)) edf <- attr(L,"df") c(edf,-2*L + k*edf) } ##' @importFrom stats family ##' @S3method family merMod family.merMod <- function(object, ...) family(object@resp, ...) ##' @S3method family glmResp family.glmResp <- function(object, ...) { # regenerate initialize # expression if necessary ## FIXME: may fail with user-specified/custom family? ## should be obsolete if(is.null(object$family$initialize)) return(do.call(object$family$family, list(link=object$family$link))) object$family } ##' @S3method family lmResp family.lmResp <- function(object, ...) gaussian() ##' @S3method family nlsResp family.nlsResp <- function(object, ...) gaussian() ##' @importFrom stats fitted ##' @S3method fitted merMod fitted.merMod <- function(object, ...) { xx <- object@resp$mu if (length(xx)==0) { ## handle 'fake' objects created by simulate() xx <- rep(NA_real_,nrow(model.frame(object))) } nm <- rownames(model.frame(object)) %||% seq_along(xx) names(xx) <- nm if (!is.null(fit.na.action <- attr(model.frame(object),"na.action"))) napredict(fit.na.action, xx) else xx } ##' Extract the fixed-effects estimates ##' ##' Extract the estimates of the fixed-effects parameters from a fitted model. ##' @name fixef ##' @title Extract fixed-effects estimates ##' @aliases fixef fixed.effects fixef.merMod ##' @docType methods ##' @param object any fitted model object from which fixed effects estimates can ##' be extracted. ##' @param noScale logical; if TRUE, returns the non-scaled parameters ##' @param \dots optional additional arguments. Currently none are used in any ##' methods. ##' @return a named, numeric vector of fixed-effects estimates. ##' @keywords models ##' @examples ##' fixef(lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)) ##' @importFrom nlme fixef ##' @export fixef ##' @method fixef merMod ##' @export fixef.merMod <- function(object, add.dropped = FALSE, noScale = NULL, ...) { X <- getME(object,"X") ff <- structure(object@beta, names = dimnames(X)[[2]]) if(is.null(noScale) || (!is.null(noScale) && !noScale)){ if (!is.null(sc <- attr(X, "scaled:scale"))) { ce <- attr(X, "scaled:center") ## modifying intercept if ("(Intercept)" %in% names(ff)) { intercept_shift <- sum((ff[names(sc)] * ce[names(sc)]) / sc[names(sc)]) ff[["(Intercept)"]] <- ff[["(Intercept)"]] - intercept_shift } # modifying beta coefficients ff[names(sc)] <- ff[names(sc)] / sc[names(sc)] } } if (add.dropped) { if (!is.null(dd <- attr(X,"col.dropped"))) { ## restore positions dropped for rank deficiency vv <- numeric(length(ff)+length(dd)) all.pos <- seq_along(vv) kept.pos <- all.pos[-dd] vv[kept.pos] <- ff names(vv)[kept.pos] <- names(ff) vv[dd] <- NA names(vv)[dd] <- names(dd) ff <- vv } } return(ff) } getFixedFormula <- function(form) { RHSForm(form) <- reformulas::nobars(RHSForm(form)) form } ##' @importFrom stats formula ##' @S3method formula merMod formula.merMod <- function(x, fixed.only=FALSE, random.only=FALSE, ...) { if (missing(fixed.only) && random.only) fixed.only <- FALSE if (fixed.only && random.only) stop("can't specify 'only fixed' and 'only random' terms") if (is.null(form <- attr(x@frame,"formula"))) { if (!grepl("lmer$",deparse(getCall(x)[[1]]))) stop("can't find formula stored in model frame or call") form <- as.formula(formula(getCall(x),...)) } if (fixed.only) { form <- getFixedFormula(form) } if (random.only) { ## from predict.R form <- lme4_reOnly(form, response=TRUE) } form } ##' @S3method isREML merMod isREML.merMod <- function(x, ...) as.logical(x@devcomp$dims[["REML"]]) ##' @S3method isGLMM merMod isGLMM.merMod <- function(x,...) { as.logical(x@devcomp$dims[["GLMM"]]) ## or: is(x@resp,"glmResp") } ##' @S3method isNLMM merMod isNLMM.merMod <- function(x,...) { as.logical(x@devcomp$dims[["NLMM"]]) ## or: is(x@resp,"nlsResp") } ##' @S3method isLMM merMod isLMM.merMod <- function(x,...) { !isGLMM(x) && !isNLMM(x) ## or: is(x@resp,"lmerResp") ? } npar.merMod <- function(object) { n <- length(object@beta) + getParLength(object) + object@devcomp[["dims"]][["useSc"]] ## FIXME: this is a bit of a hack: a user *might* have specified ## negative binomial family with a known theta, in which case we ## shouldn't count it as extra. Either glmer.nb needs to set a ## flag somewhere, or we need class 'nbglmerMod' to extend 'glmerMod' ... ## We do *not* want to use the 'useSc' slot (as above), because ## although theta is in some sense a scale parameter, it's not ## one in the formal sense (and isn't stored in the 'sigma' slot) if (grepl("Negative Binomial",family(object)$family)) { n <- n+1 } return(n) ## TODO: how do we feel about counting the scale parameter ??? } ##' @importFrom stats logLik ##' @S3method logLik merMod logLik.merMod <- function(object, REML = NULL, ...) { if (is.null(REML) || is.na(REML[1])) REML <- isREML(object) val <- -devCrit(object, REML = REML)/2 ## dc <- object@devcomp nobs <- nobs.merMod(object) structure(val, nobs = nobs, nall = nobs, df = npar.merMod(object), ## length(object@beta) + length(object@theta) + dc$dims[["useSc"]], class = "logLik") } ##' @importFrom stats df.residual ##' @S3method df.residual merMod ## TODO: not clear whether the residual df should be based ## on p=length(beta) or p=length(c(theta,beta)) ... but ## this is just to allow things like aods3::gof to work ... ## df.residual.merMod <- function(object, ...) { nobs(object)-npar.merMod(object) } ##' @importFrom stats logLik ##' @S3method model.frame merMod model.frame.merMod <- function(formula, fixed.only=FALSE, ...) { fr <- formula@frame if (fixed.only) { vars <- attr(terms(fr),"varnames.fixed") if (is.null(vars)) { ## back-compatibility: saved objects pre 1.1-15 ff <- formula(formula,fixed.only=TRUE) ## thanks to Thomas Leeper and Roman Lustrik, Stack Overflow ## https://stackoverflow.com/questions/18017765/extract-variables-in-formula-from-a-data-frame vars <- rownames(attr(terms.formula(ff), "factors")) } vars <- gsub("`","",vars) ## weirdness in deparsing variable names with spaces fr <- fr[vars] } fr } ##' @importFrom stats model.matrix ##' @S3method model.matrix merMod ##' @param noScale logical; if TRUE, returns the non-scaled parameters model.matrix.merMod <- function(object, type = c("fixed", "random", "randomListRaw"), noScale = NULL,...) { X <- object@pp$X # Re-scales back the model matrix on command if (!is.null(sc <- attr(object@pp$X, "scaled:scale"))){ if((is.null(noScale)) || (!is.null(noScale) && !noScale)){ unscale_cols <- setdiff(colnames(X), "(Intercept)") ce <- attr(object@pp$X, "scaled:center") X[, unscale_cols] <- sweep(X[, unscale_cols], 2, sc, `*`) X[, unscale_cols] <- sweep(X[, unscale_cols], 2, ce, `+`) } } switch(type[1], "fixed" = X, "random" = getME(object, "Z"), "randomListRaw" = mmList(object)) } ##' Dummy variables (experimental) ##' ##' Largely a wrapper for \code{model.matrix} that ##' accepts a factor, \code{f}, and returns a dummy ##' matrix with \code{nlevels(f)-1} columns. dummy <- function(f, levelsToKeep){ f <- as.factor(f) if (all(is.na(f))) return(rep(NA_real_, length(f))) mm <- model.matrix(~ 0 + f) colnames(mm) <- levels(f) # sort out levels to keep missingLevels <- missing(levelsToKeep) if(missingLevels) levelsToKeep <- levels(f)[-1] if(!any(levels(f) %in% levelsToKeep)) stop("at least some of the levels in f ", "must also be present in levelsToKeep") if(!all(levelsToKeep %in% levels(f))) stop("all of the levelsToKeep must be levels of f") mm <- mm[, levelsToKeep, drop=FALSE] ## # communicate that some usages are unlikely ## # to help with readibility, which is the ## # whole purpose of dummy() ## if((!missingLevels)&&(ncol(mm) > 1)) ## message("note from dummy: explicitly specifying more than one ", ## "level to keep may do little to improve readibility") return(mm) } ##' @importFrom stats nobs ##' @S3method nobs merMod nobs.merMod <- function(object, ...) nrow(object@frame) ## used in summary.merMod(): ngrps <- function(object, ...) UseMethod("ngrps") ngrps.default <- function(object, ...) stop("Cannot extract the number of groups from this object") ngrps.merMod <- function(object, ...) vapply(object@flist, nlevels, 1) ngrps.factor <- function(object, ...) nlevels(object) ##' @importFrom nlme ranef ##' @export ranef NULL ##' Extract the modes of the random effects ##' ##' A generic function to extract the conditional modes of the random effects ##' from a fitted model object. For linear mixed models the conditional modes ##' of the random effects are also the conditional means. ##' ##' If grouping factor i has k levels and j random effects per level the ith ##' component of the list returned by \code{ranef} is a data frame with k rows ##' and j columns. If \code{condVar} is \code{TRUE} the \code{"postVar"} ##' attribute is an array of dimension j by j by k. The kth face of this array ##' is a positive definite symmetric j by j matrix. If there is only one ##' grouping factor in the model the variance-covariance matrix for the entire ##' random effects vector, conditional on the estimates of the model parameters ##' and on the data will be block diagonal and this j by j matrix is the kth ##' diagonal block. With multiple grouping factors the faces of the ##' \code{"postVar"} attributes are still the diagonal blocks of this ##' conditional variance-covariance matrix but the matrix itself is no longer ##' block diagonal. ##' @name ranef ##' @aliases ranef ranef.merMod ##' @param object an object of a class of fitted models with random effects, ##' typically an \code{"\linkS4class{merMod}"} object. ##' @param condVar an optional logical argument indicating if the conditional ##' variance-covariance matrices of the random effects should be added as an attribute. ##' @param postVar a (deprecated) synonym for \code{condVar} ##' @param drop an optional logical argument indicating components of the return ##' value that would be data frames with a single column, usually a column ##' called \sQuote{\code{(Intercept)}}, should be returned as named vectors. ##' @param whichel an optional character vector of names of grouping factors for ##' which the random effects should be returned. Defaults to all the grouping ##' factors. ##' @param \dots some methods for this generic function require additional ##' arguments. ##' @return A list of data frames, one for each grouping factor for the random ##' effects. The number of rows in the data frame is the number of levels of ##' the grouping factor. The number of columns is the dimension of the random ##' effect associated with each level of the factor. ##' ##' If \code{condVar} is \code{TRUE} each of the data frames has an attribute ##' called \code{"postVar"} which is a three-dimensional array with symmetric ##' faces. ##' ##' When \code{drop} is \code{TRUE} any components that would be data frames of ##' a single column are converted to named numeric vectors. ##' @note To produce a \dQuote{caterpillar plot} of the random effects apply ##' \code{\link[lattice:xyplot]{dotplot}} to the result of a call to ##' \code{ranef} with \code{condVar = TRUE}. ##' @examples ##' fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ##' fm2 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy) ##' fm3 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin) ##' ranef(fm1) ##' str(rr1 <- ranef(fm1, condVar = TRUE)) ##' dotplot(rr1) ## default ##' ## specify free scales in order to make Day effects more visible ##' dotplot(rr1,scales = list(x = list(relation = 'free')))[["Subject"]] ##' str(ranef(fm2, condVar = TRUE)) ##' op <- options(digits = 4) ##' ranef(fm3, drop = TRUE) ##' options(op) ##' @keywords models methods ##' @method ranef merMod ##' @export ranef.merMod <- function(object, condVar = TRUE, drop = FALSE, whichel = names(ans), postVar = FALSE, ...) { if (length(L <- list(...))>0) { warning(paste("additional arguments to ranef.merMod ignored:", paste(names(L),collapse=", "))) } if (!missing(postVar) && missing(condVar)) { warning(sQuote("postVar")," is deprecated: please use ", sQuote("condVar")," instead") condVar <- postVar } ans <- object@pp$b(1) ## not always == c(matrix(unlist(getME(object,"b")))) if (!is.null(fl <- object@flist)) { ## evaluate the list of matrices levs <- lapply(fl, levels) asgn <- attr(fl, "assign") cnms <- object@cnms nc <- lengths(cnms) ## number of terms ## nb <- nc * lengths(levs)[asgn] ## number of cond modes per term nb <- diff(object@Gp) ## differencing group index is more robust nbseq <- rep.int(seq_along(nb), nb) ml <- split(ans, nbseq) for (i in seq_along(ml)) ml[[i]] <- matrix(ml[[i]], ncol = nc[i], byrow = TRUE, dimnames = list(NULL, cnms[[i]])) ## create a list of data frames corresponding to factors ans <- lapply(seq_along(fl), function(i) { m <- ml[asgn == i] b2 <- vapply(m,nrow,numeric(1)) ub2 <- unique(b2) if (length(ub2)>1) stop("differing numbers of b per group") ## if number of sets of modes != number of levels (e.g. Gaussian process/phyloglmm), ## generate numeric sequence for names rnms <- if (ub2==length(levs[[i]])) levs[[i]] else seq(ub2) data.frame(do.call(cbind, m), row.names = rnms, check.names = FALSE) }) names(ans) <- names(fl) # process whichel stopifnot(is(whichel, "character")) whchL <- names(ans) %in% whichel ans <- ans[whchL] if (condVar) { sigsqr <- sigma(object)^2 rp <- rePos$new(object) if(any(lengths(rp$terms) > 1L)) { ## use R machinery here ... vv <- arrange.condVar(object,condVar(object, scaled=TRUE)) } else { vv <- .Call(merPredDcondVar, object@pp$ptr(), as.environment(rp)) vv <- lapply(vv, "*", sigsqr) } for (i in names(ans)) { attr(ans[[i]], "postVar") <- vv[[i]] } } if (drop) ans <- lapply(ans, function(el) { if (ncol(el) > 1) return(el) pv <- drop(attr(el, "postVar")) el <- drop(as.matrix(el)) if (!is.null(pv)) attr(el, "postVar") <- pv el }) class(ans) <- "ranef.mer" } ans }## ranef.merMod print.ranef.mer <- function(x, ...) { print(unclass(x), ...) if(any(has.pv <- vapply(x, function(el) !is.null(attr(el, "postVar")), NA))) cat('with conditional variances for', paste(dQuote(names(x)[has.pv]), sep=", "), "\n") invisible(x) } ## try to redo refit by calling modular structure ... refit2.merMod <- function(object, newresp=NULL) { ## the idea is to steal as much structure as we can from the ## previous fit, including ## * starting parameter values ## * random-effects structure ## * fixed-effects structure ## * model frame ## and jump into the modular structure at an appropriate place; ## essentially, this should merge with a smart-as-possible ## version of 'update' ... } ## FIXME DRY: much of copy'n'paste from lmer() etc .. ==> become more modular (?) refit.merMod <- function(object, newresp = NULL, newweights = NULL, ## formula=NULL, weights=NULL, rename.response = FALSE, maxit = 100L, ...) { if (isNLMM(object)) stop(gettextf("'%s' does not yet support nonlinear mixed models; try '%s' instead", "refit.merMod", "update.merMod"), domain = NA) haveGLMM <- isGLMM(object) l... <- list(...) ctrl.arg <- NULL if("control" %in% names(l...)) ctrl.arg <- l...$control if(!all(names(l...) %in% c("control", "verbose"))) { warning("additional arguments to refit.merMod ignored") } ## TODO: not clear whether we should reset the names ## to the new response variable. Maybe not. ## retrieve name before it gets mangled by operations on newresp newrespSub <- substitute(newresp) ## for backward compatibility/functioning of refit(fit,simulate(fit)) if (is.list(newresp)) { if (length(newresp)==1) { na.action <- attr(newresp,"na.action") newresp <- newresp[[1]] attr(newresp,"na.action") <- na.action } else { stop("refit not implemented for 'newresp' lists of length > 1: ", "consider ", sQuote("lapply(object,refit)")) } } ## oldresp <- object@resp$y # need to set this before deep copy, ## # otherwise it gets reset with the call ## # to setResp below ## somewhat repeated from profile.merMod, but sufficiently ## different that refactoring is slightly non-trivial ## "three minutes' thought would suffice ..." control <- if (!is.null(ctrl.arg)) { if (length(ctrl.arg$optCtrl) == 0) { ## use object's version: obj.control <- object@optinfo$control ignore.pars <- c("xst", "xt") if (any(ign <- names(obj.control) %in% ignore.pars)) obj.control <- obj.control[!ign] ctrl.arg$optCtrl <- obj.control } ctrl.arg } else if (haveGLMM) glmerControl() else lmerControl() if (object@optinfo$optimizer == "optimx") { control$optCtrl <- object@optinfo$control } ## we need this stuff defined before we call .glmerLaplace below ... pp <- object@pp$copy() dc <- object@devcomp nAGQ <- if (haveGLMM) dc$dims[["nAGQ"]] ## nth <- dc$dims[["nth"]] verbose <- l...$verbose; if (is.null(verbose)) verbose <- 0L if (!is.null(newresp)) { ## update call and model frame with new response rcol <- attr(attr(model.frame(object), "terms"), "response") if (rename.response) { attr(object@frame,"formula")[[2]] <- object@call$formula[[2]] <- newrespSub names(object@frame)[rcol] <- deparse(newrespSub) } if (!is.null(na.act <- attr(object@frame,"na.action")) && is.null(attr(newresp,"na.action"))) { ## will only get here if na.action is 'na.omit' or 'na.exclude' ## *and* newresp does not have an 'na.action' attribute ## indicating that NAs have already been filtered newresp <- if (is.matrix(newresp)) newresp[-na.act, ] else newresp[-na.act] } object@frame[[rcol]] <- newresp } if (!is.null(newweights)) { ## DRY ... if (!is.null(na.act <- attr(object@frame,"na.action")) && is.null(attr(newweights, "na.action"))) { newweights <- newweights[-na.act] } object@frame[["(weights)"]] <- newweights oc <- attr(attr(object@frame, "terms"), "dataClasses") attr(attr(object@frame, "terms"), "dataClasses") <- c(oc, `(weights)` = "numeric") object@call$weights <- substitute(newweights) ## try to make sure new weights are findable later assign(deparse(substitute(newweights)), newweights, environment(formula(object))) } rr <- if (!haveGLMM) mkRespMod(model.frame(object), REML = object@resp$REML) else mkRespMod(model.frame(object), family = family(object)) if(!is.null(newresp)) { if(family(object)$family == "binomial") { ## re-do conversion of two-column matrix and factor ## responses to proportion/weights format if (is.matrix(newresp) && ncol(newresp) == 2) { ntot <- rowSums(newresp) ## FIXME: test what happens for (0,0) rows newresp <- newresp[,1]/ntot rr$setWeights(ntot) } if (is.factor(newresp)) { ## FIXME: would be better to do this consistently with ## whatever machinery is used in glm/glm.fit/glmer ?? newresp <- as.numeric(newresp)-1 } } ## if (haveGLMM && rr$family$family=="binomial") { ## } stopifnot(length(newresp <- as.numeric(as.vector(newresp))) == length(rr$y)) } if (haveGLMM) { GQmat <- GHrule(nAGQ) if (nAGQ <= 1) { glmerPwrssUpdate(pp,rr, control$tolPwrss, GQmat, maxit=maxit) } else { glmerPwrssUpdate(pp,rr, control$tolPwrss, GQmat, maxit=maxit, grpFac = object@flist[[1]]) } } reCovs <- getReCovs(object) devlist <- c(list(pp = pp, resp = rr, mkPar = mkMkPar(reCovs), mkTheta = mkMkTheta(reCovs)), if (haveGLMM) { baseOffset <- forceCopy(object@resp$offset) list(tolPwrss= dc$cmp [["tolPwrss"]], compDev = dc$dims[["compDev"]], nAGQ = nAGQ, lp0 = pp$linPred(1), ## object@resp$eta - baseOffset, baseOffset = baseOffset, pwrssUpdate = glmerPwrssUpdate, ## save GQmat in the object and use that instead of nAGQ GQmat = GHrule(nAGQ), fac = object@flist[[1]], verbose=verbose, dpars=seq_len(getParLength(object))) } ) rho <- list2env(devlist) ff <- mkdevfun(rho, nAGQ=nAGQ, maxit=maxit, verbose=verbose) ## xst <- rep.int(0.1, nth) x0 <- rho$mkPar(rho$pp$theta) lower <- getLower(object) upper <- getUpper(object) if (haveGLMM && nAGQ > 0L) { ## xst <- c(xst, sqrt(diag(pp$unsc()))) n_beta <- length(fixef(object)) x0 <- c(x0, unname(fixef(object))) lower <- c(lower, rep(-Inf, n_beta)) upper <- c(upper, rep( Inf, n_beta)) } ## control <- c(control,list(xst=0.2*xst, xt=xst*0.0001)) ## FIX ME: allow use.last.params to be passed through calc.derivs <- !is.null(object@optinfo$derivs) ## if (haveGLMM) { ## rho$resp$updateWts() ## rho$pp$updateDecomp() ## rho$lp0 <- rho$pp$linPred(1) ## } optimizer <- object@optinfo$optimizer if (!is.null(newopt <- ctrl.arg$optimizer)) { ## we might end up with a length-2 optimizer vector ... ## use the *last* element optimizer <- newopt[length(newopt)] } opt <- optwrap(optimizer, ff, x0, lower=lower, upper=upper, control=control$optCtrl, calc.derivs=calc.derivs) cc <- checkConv(attr(opt,"derivs"),opt$par, ## FIXME: was there a reason that ctrl was passed ## via the call slot? it was causing problems ## when optTheta called refit (github issue #173) # ctrl = eval(object@call$control)$checkConv, ctrl = control$checkConv, lbound=lower, ubound=upper) if (haveGLMM) rr$setOffset(baseOffset) mkMerMod(environment(ff), opt, list(flist=object@flist, cnms=object@cnms, Gp=object@Gp, lower=getLower(object), upper=getUpper(object), reCovs=reCovs), object@frame, getCall(object), cc) } refitML.merMod <- function (x, optimizer="bobyqa", ...) { ## FIXME: optimizer is set to 'bobyqa' for back-compatibility, but that's not ## consistent with lmer (default NM). Should be based on internally stored 'optimizer' value if (!isREML(x)) return(x) stopifnot(is(rr <- x@resp, "lmerResp")) reCovs <- getReCovs(x) rho <- new.env(parent=parent.env(environment())) rho$resp <- new(class(rr), y=rr$y, offset=rr$offset, weights=rr$weights, REML=0L) xpp <- x@pp$copy() rho$pp <- new(class(xpp), X=xpp$X, Zt=xpp$Zt, Lambdat=xpp$Lambdat, Lind=xpp$Lind, theta=xpp$theta, n=nrow(xpp$X)) rho$mkPar <- mkMkPar(reCovs) rho$mkTheta <- mkMkTheta(reCovs) devfun <- mkdevfun(rho, 0L) # FIXME? also pass {verbose, maxit, control} opt <- ## "smart" calc.derivs rules if(optimizer == "bobyqa" && !any("calc.derivs" == ...names())) optwrap(optimizer, devfun, rho$mkPar(rho$pp$theta), lower=getLower(x), upper=getUpper(x), calc.derivs=TRUE, ...) else optwrap(optimizer, devfun, rho$mkPar(rho$pp$theta), lower=getLower(x), upper=getUpper(x), ...) ## FIXME: Should be able to call mkMerMod() here, and be done n <- length(rr$y) pp <- rho$pp p <- ncol(pp$X) dims <- c(N=n, n=n, p=p, nmp=n-p, q=nrow(pp$Zt), nth=length(pp$theta), useSc=1L, reTrms=length(x@cnms), spFe=0L, REML=0L, GLMM=0L, NLMM=0L)#, nAGQ=NA_integer_) wrss <- rho$resp$wrss() ussq <- pp$sqrL(1) pwrss <- wrss + ussq cmp <- c(ldL2=pp$ldL2(), ldRX2=pp$ldRX2(), wrss=wrss, ussq=ussq, pwrss=pwrss, drsum=NA_real_, dev=opt$fval, REML=NA, sigmaML=sqrt(pwrss/n), sigmaREML=sqrt(pwrss/(n-p))) ## modify the call to have REML=FALSE. (without evaluating the call!) cl <- x@call cl[["REML"]] <- FALSE ans <- new("lmerMod", call = cl, frame=x@frame, flist=x@flist, cnms=x@cnms, theta=pp$theta, beta=pp$delb, u=pp$delu, optinfo = .optinfo(opt), lower=getLower(x), devcomp=list(cmp=cmp, dims=dims), pp=pp, resp=rho$resp, Gp=x@Gp) attr(ans, "upper") <- getUpper(x) attr(ans, "reCovs") <- upReCovs(reCovs, rho$pp$theta) ans } ##' residuals of merMod objects --> ../man/residuals.merMod.Rd ##' @param object a fitted [g]lmer (\code{merMod}) object ##' @param type type of residuals ##' @param scaled scale residuals by residual standard deviation (=scale parameter)? ##' @param \dots additional arguments (ignored: for method compatibility) residuals.merMod <- function(object, type = if(isGLMM(object)) "deviance" else "response", scaled = FALSE, ...) { r <- residuals(object@resp, type,...) fr <- model.frame(object) if (is.null(nm <- rownames(fr))) nm <- seq_along(r) names(r) <- nm if (scaled) r <- r/sigma(object) if (!is.null(na.action <- attr(fr, "na.action"))) naresid(na.action, r) else r } ##' @rdname residuals.merMod ##' @S3method residuals lmResp ##' @method residuals lmResp residuals.lmResp <- function(object, type = c("working", "response", "deviance", "pearson", "partial"), ...) { y <- object$y r <- object$wtres mu <- object$mu switch(match.arg(type), working =, response = y-mu, deviance =, pearson = r, partial = stop(gettextf("partial residuals are not implemented yet"), call. = FALSE) ) } ##' @rdname residuals.merMod ##' @S3method residuals glmResp ##' @method residuals glmResp residuals.glmResp <- function(object, type = c("deviance", "pearson", "working", "response", "partial"), ...) { type <- match.arg(type) y <- object$y mu <- object$mu switch(type, deviance = { ## protect against slightly negative resids ## (GH 812) d.res <- sqrt(pmax(0,object$devResid())) ifelse(y > mu, d.res, -d.res) }, pearson = object$wtres, working = object$wrkResids(), response = y - mu, partial = stop(gettextf("partial residuals are not implemented yet"), call. = FALSE) ) } hatvalues.merMod <- function(model, fullHatMatrix = FALSE, ...) { if(isGLMM(model)) warning("the hat matrix may not make sense for GLMMs") ## FIXME: add restriction for NLMMs? ## prior weights, W ^ {1/2} : ## weights() will restore NA values if na.action = na.exclude, ## need to drop them for now and restore at the end sqrtW <- Diagonal(x = na.omit(sqrt(weights(model, type = "prior")))) vList <- getME(model, c("L", "Lambdat", "Zt", "RX", "X", "RZX")) ## CL:= right factor of the random-effects component of the hat matrix (64) CL <- with(vList, solve(L, solve(L, Lambdat %*% Zt %*% sqrtW, system = "P"), system = "L")) ## restore dimnames (needed since Matrix 1.5.2) dimnames(CL) <- dimnames(vList$Zt) ## CR:= right factor of the fixed-effects component of the hat matrix (65) ## {MM (FIXME Matrix): t(.) %*% here faster than crossprod()} CR <- with(vList, solve(t(RX), ## colScale(t(X), sqrtW) - crossprod(RZX, CL) t(X) %*% sqrtW - crossprod(RZX, CL)) ) res <- if(fullHatMatrix) { ## H = (C_L^T C_L + C_R^T C_R) (63) crossprod(CL) + crossprod(CR) } else { ## diagonal of the hat matrix, diag(H) : colSums(CR^2) + colSums(CL^2) } napredict(attr(model.frame(model),"na.action"), res) } ###----- Printing etc ---------------------------- ## lme4.0, for GLMM had ## 'Generalized linear mixed model fit by the Laplace approximation' ## 'Generalized linear mixed model fit by the adaptive Gaussian Hermite approximation' ## so did *not* mention "maximum likelihood" at all in the GLMM case methTitle <- function(dims) { # dims == object@devcomp$dims GLMM <- dims[["GLMM"]] kind <- switch(1L + GLMM * 2L + dims[["NLMM"]], "Linear", "Nonlinear", "Generalized linear", "Generalized nonlinear") paste(kind, "mixed model fit by", if(dims[["REML"]]) "REML" else paste("maximum likelihood", if(GLMM) { ## TODO? Use shorter wording here, for (new) 'long = FALSE' argument if((nAGQ <- dims[["nAGQ"]]) == 1) "(Laplace Approximation)" else sprintf("(Adaptive Gauss-Hermite Quadrature, nAGQ = %d)", nAGQ) })) } cat.f <- function(...) cat(..., fill = TRUE) famlink <- function(object, resp = object@resp) { if(is(resp, "glmResp")) resp$family[c("family", "link")] else list(family = NULL, link = NULL) } ##' @title print method title ##' @param mtit the result of methTitle(obj) ##' @param class typically class(obj) .prt.methTit <- function(mtit, class) { if(nchar(mtit) + 5 + nchar(class) > (w <- getOption("width"))) { ## wrap around mtit <- strwrap(mtit, width = w - 2, exdent = 2) cat(mtit, " [",class,"]", sep = "", fill = TRUE) } else ## previous: simple one-liner cat(sprintf("%s ['%s']\n", mtit, class)) } .prt.family <- function(famL) { if (!is.null(f <- famL$family)) { cat.f(" Family:", f, if(!is.null(ll <- famL$link)) paste(" (", ll, ")")) } } .prt.resids <- function(resids, digits, title = "Scaled residuals:", ...) { cat(title,"\n") ## FIXME: need testing code rq <- setNames(zapsmall(quantile(resids, na.rm=TRUE), digits + 1L), c("Min", "1Q", "Median", "3Q", "Max")) print(rq, digits = digits, ...) cat("\n") } .prt.call <- function(call, long = TRUE) { if (!is.null(cc <- call$formula)) cat.f("Formula:", deparse(cc)) if (!is.null(cc <- call$data)) cat.f(" Data:", deparse(cc)) if (!is.null(cc <- call$weights)) cat.f("Weights:", deparse(cc)) if (!is.null(cc <- call$offset)) cat.f(" Offset:", deparse(cc)) if (long && length(cc <- call$control) && !identical((dc <- deparse(cc)), "lmerControl()")) ## && !identical(eval(cc), lmerControl())) cat.f("Control:", dc) if (!is.null(cc <- call$subset)) cat.f(" Subset:", deparse(cc)) } ##' @title Extract Log Likelihood, AIC, and related statics from a Fitted LMM ##' @param object a LMM model fit ##' @param devianceFUN the function to be used for computing the deviance; should not be changed for \pkg{lme4} created objects. ##' @param chkREML optional logical indicating \code{object} maybe a REML fit. ##' @param devcomp ##' @return a list with components \item{logLik} and \code{AICtab} where the first is \code{\link{logLik(object)}} and \code{AICtab} is a "table" of AIC, BIC, logLik, deviance, df.residual() values. llikAIC <- function(object, devianceFUN = devCrit, chkREML = TRUE, devcomp = object@devcomp) { llik <- logLik(object) # returns NA for a REML fit - maybe change? AICstats <- { if(chkREML && devcomp$dims[["REML"]]) devcomp$cmp["REML"] # *no* likelihood stats here else { c(AIC = AIC(llik), BIC = BIC(llik), logLik = c(llik), `-2*log(L)` = devianceFUN(object), df.resid = df.residual(object)) } } list(logLik = llik, AICtab = AICstats) } .prt.aictab <- function(aictab, digits = 1) { t.4 <- round(aictab, digits) if (length(aictab) == 1 && names(aictab) == "REML") cat.f("REML criterion at convergence:", t.4) else { ## slight hack to get residual df formatted as an integer t.4F <- format(t.4) t.4F["df.resid"] <- format(t.4["df.resid"]) print(t.4F, quote = FALSE) } } .prt.VC <- function(varcor, digits, comp = "Std.Dev.", formatter = format, ...) { # '...' *only* passed to print() cat("Random effects:\n") fVC <- formatVC(varcor, digits=digits, formatter=formatter, comp=comp) print(fVC, quote = FALSE, digits = digits, ...) } .prt.grps <- function(ngrps, nobs) { cat(sprintf("Number of obs: %d, groups: ", nobs), paste(paste(names(ngrps), ngrps, sep = ", "), collapse = "; "), fill = TRUE) } ## FIXME: print header ("Warnings:\n") ? ## change position in output? comes at the very end, could get lost ... .prt.warn <- function(optinfo, summary=FALSE, ...) { if(length(optinfo) == 0) return() # currently, e.g., from refitML() ## check all warning slots: print numbers of warnings (if any) cc <- optinfo$conv$opt msgs <- unlist(optinfo$conv$lme4$messages) ## can't put nmsgs/nwarnings compactly into || expression ## because of short-circuiting nmsgs <- length(msgs) warnings <- optinfo$warnings nwarnings <- length(warnings) if (cc > 0 || nmsgs > 0 || nwarnings > 0) { m <- if (cc==0) { "(OK)" } else if (!is.null(optinfo$message)) { sprintf("(%s)",optinfo$message) } else "" convmsg <- sprintf("optimizer (%s) convergence code: %d %s", optinfo$optimizer, cc, m) if (summary) { cat(convmsg,sprintf("; %d optimizer warnings; %d lme4 warnings", nwarnings,nmsgs),"\n") } else { cat(convmsg, msgs, unlist(warnings), sep="\n") cat("\n") } } } ## options(lme4.summary.cor.max = 20) --> ./hooks.R ## ~~~~~~~~ ## was .summary.cor.max <- 20 a lme4-namespace hidden global variable ## This is modeled a bit after print.summary.lm : ## Prints *both* 'mer' and 'merenv' - as it uses summary(x) mainly ##' @S3method print summary.merMod print.summary.merMod <- function(x, digits = max(3, getOption("digits") - 3), correlation = NULL, symbolic.cor = FALSE, signif.stars = getOption("show.signif.stars"), ranef.comp = c("Variance", "Std.Dev."), ranef.corr = any(ranef.comp == "Std.Dev."), show.resids = TRUE, ...) { .prt.methTit(x$methTitle, x$objClass) .prt.family(x) .prt.call(x$call); cat("\n") .prt.aictab(x$AICtab); cat("\n") if (show.resids) ## need residuals.merMod() rather than residuals(): ## summary.merMod has no residuals method .prt.resids(x$residuals, digits = digits) .prt.VC(x$varcor, digits = digits, useScale = x$useScale, comp = ranef.comp, corr = ranef.corr, ...) .prt.grps(x$ngrps, nobs = x$devcomp$dims[["n"]]) p <- nrow(x$coefficients) if (p > 0) { cat("\nFixed effects:\n") printCoefmat(x$coefficients, # too radical: zap.ind = 3, #, tst.ind = 4 digits = digits, signif.stars = signif.stars) ## do not show correlation when summary(*, correlation=FALSE) was used: hasCor <- !is.null(VC <- x$vcov) && !is.null(VC@factors$correlation) ## FIXME: don't understand the logic here. We can easily ## defend against the problem of missing pre-computed correlation ## function by reconstituting it if necessary ## (e.g. if using merDeriv::vcov.lmerMod), as in commented code below. ## However, we currently have a test (using fit_agridat_archbold, ## see test-methods.R) that fails if we 'fix' this problem ... ## ## if (hasCor && is.null(VC@factors$correlation)) { ## ## defend against merDeriv definition of vcov.lmerMod; reconstruct ## cc <- cov2cor(VC) ## dimnames(cc) <- dimnames(VC) ## Matrix 1.5.2 bug ## VC@factors <- c(VC@factors, list(correlation = cc)) ## } if(is.null(correlation)) { # default cor.max <- getOption("lme4.summary.cor.max") correlation <- hasCor && (isTRUE(x$corrSet) || p <= cor.max) if(!correlation && p > cor.max && is.na(x$corrSet)) { nam <- deparse(substitute(x)) if(length(nam) > 1 || nchar(nam) >= 32) nam <- "...." message(sprintf(paste( "\nCorrelation matrix not shown by default, as p = %d > %d.", "Use print(%s, correlation=TRUE) or", " vcov(%s) if you need it\n", sep = "\n"), p, cor.max, nam, nam)) } } else if(!is.logical(correlation)) stop("'correlation' must be NULL or logical") if(correlation) { if(is.null(VC)) VC <- vcov(x, correlation = TRUE) corF <- VC@factors$correlation if (is.null(corF)) { # can this still happen? message("\nCorrelation of fixed effects could have been required in summary()") corF <- cov2cor(VC) } p <- ncol(corF) if (p > 1) { rn <- rownames(x$coefficients) rns <- abbreviate(rn, minlength = 11) cat("\nCorrelation of Fixed Effects:\n") if (is.logical(symbolic.cor) && symbolic.cor) { corf <- as(corF, "matrix") dimnames(corf) <- list(rns, abbreviate(rn, minlength = 1, strict = TRUE)) print(symnum(corf)) } else { corf <- matrix(format(round(corF@x, 3), nsmall = 3), ncol = p, dimnames = list(rns, abbreviate(rn, minlength = 6))) corf[!lower.tri(corf)] <- "" print(corf[-1, -p, drop = FALSE], quote = FALSE) } ## !symbolic.cor } ## if (p > 1) } ## if (correlation) } ## if (p>0) if(length(x$fitMsgs) && any(nchar(x$fitMsgs) > 0)) { cat("fit warnings:\n"); writeLines(x$fitMsgs) } .prt.warn(x$optinfo,summary=FALSE) invisible(x) }## print.summary.merMod ##' @S3method print merMod print.merMod <- function(x, digits = max(3, getOption("digits") - 3), correlation = NULL, symbolic.cor = FALSE, signif.stars = getOption("show.signif.stars"), ranef.comp = "Std.Dev.", ranef.corr = any(ranef.comp == "Std.Dev."), ...) { dims <- x@devcomp$dims .prt.methTit(methTitle(dims), class(x)) .prt.family(famlink(x, resp = x@resp)) .prt.call(x@call, long = FALSE) ## useScale <- as.logical(dims[["useSc"]]) llAIC <- llikAIC(x) .prt.aictab(llAIC$AICtab, 4) varcor <- VarCorr(x) .prt.VC(varcor, digits = digits, comp = ranef.comp, corr = ranef.corr, ...) ngrps <- vapply(x@flist, nlevels, 0L) .prt.grps(ngrps, nobs = dims[["n"]]) if(length(cf <- fixef(x)) > 0) { cat("Fixed Effects:\n") print.default(format(cf, digits = digits), print.gap = 2L, quote = FALSE, ...) } else cat("No fixed effect coefficients\n") fitMsgs <- .merMod.msgs(x) if(any(nchar(fitMsgs) > 0)) { cat("fit warnings:\n"); writeLines(fitMsgs) } .prt.warn(x@optinfo,summary=TRUE) invisible(x) } ##' @exportMethod show setMethod("show", "merMod", function(object) print.merMod(object)) ##' Return the deviance component list devcomp <- function(x) { .Deprecated("getME(., \"devcomp\")") stopifnot(is(x, "merMod")) x@devcomp } ##' @exportMethod getL setMethod("getL", "merMod", function(x) { .Deprecated("getME(., \"L\")") getME(x, "L") }) ##' used by tnames mkPfun <- function(diag.only = FALSE, old = TRUE, prefix = NULL){ local({ function(g,e) { mm <- outer(e,e,paste,sep = ".") if(old) { diag(mm) <- e } else { mm[] <- paste(mm,g,sep = "|") if (!is.null(prefix)) mm[] <- paste(prefix[2],mm,sep = "_") diag(mm) <- paste(e,g,sep = "|") if (!is.null(prefix)) diag(mm) <- paste(prefix[1],diag(mm),sep = "_") } mm <- if (diag.only) diag(mm) else mm[lower.tri(mm,diag = TRUE)] if(old) paste(g,mm,sep = ".") else mm } }) } ## -> ../man/getME.Rd getME <- function(object, name, ...) UseMethod("getME") ##' Extract or Get Generalized Components from a Fitted Mixed Effects Model getME.merMod <- function(object, name = c("X", "Z","Zt", "Ztlist", "mmList", "y", "mu", "u", "b", "Gp", "Tp", "L", "Lambda", "Lambdat", "Lind", "Tlist", "A", "RX", "RZX", "sigma", "flist", "fixef", "beta", "theta", "ST", "par", "REML", "is_REML", "n_rtrms", "n_rfacs", "N", "n", "p", "q", "npar", "p_i", "l_i", "q_i", "k", "m_i", "m", "cnms", "devcomp", "offset", "lower", "devfun", "devarg", "glmer.nb.theta" ), ...) { if(missing(name)) stop("'name' must not be missing") ## Deal with multiple names -- "FIXME" is inefficiently redoing things if (length(name <- as.character(name)) > 1) { names(name) <- name return(lapply(name, getME, object = object)) } if(name == "ALL") ## recursively get all provided components return(sapply(eval(formals()$name), getME.merMod, object=object, simplify=FALSE)) stopifnot(is(object,"merMod")) name <- match.arg(name) rsp <- object@resp PR <- object@pp dc <- object@devcomp th <- object@theta cnms <- object@cnms dims <- dc $ dims Tpfun <- function(cnms) { ltsize <- function(n) n*(n+1)/2 # lower triangle size cLen <- cumsum(ltsize(lengths(cnms))) setNames(c(0, cLen), c("beg__", names(cnms))) ## such that diff( Tp ) is well-named } ## mmList. <- mmList(object) if(any(name == c("p_i", "q_i", "m_i"))) p_i <- vapply(mmList(object), ncol, 1L) if(any(name == c("l_i", "q_i"))) l_i <- vapply(object@flist, nlevels, 1L) switch(name, "X" = PR$X, ## ok ? - check -- use model.matrix() method instead? "Z" = t(PR$Zt), "Zt" = PR$Zt, "Ztlist" = { getInds <- function(i) { n <- diff(object@Gp)[i] ## number of elements in this block nt <- length(cnms[[i]]) ## number of REs inds <- lapply(seq(nt), seq, to = n, by = nt) ## pull out individual RE indices inds <- lapply(inds,function(x) x + object@Gp[i]) ## add group offset } inds <- do.call(c,lapply(seq_along(cnms),getInds)) setNames(lapply(inds,function(i) PR$Zt[i,]), unlist(getVCNames(object)$vcomp, FALSE, FALSE)) }, "mmList" = mmList.merMod(object), "y" = rsp$y, "mu" = rsp$mu, "u" = object@u, "b" = crossprod(PR$Lambdat, object@u), # == Lambda %*% u "L" = PR$ L(), "Lambda" = t(PR$ Lambdat), "Lambdat" = PR$ Lambdat, "A" = PR$Lambdat %*% PR$Zt, "Lind" = PR$ Lind, "RX" = structure(PR$RX(), dimnames = list(colnames(PR$X), colnames(PR$X))), ## maybe add names elsewhere? "RZX" = structure(PR$RZX, dimnames = list(NULL, colnames(PR$X))), ## maybe add names elsewhere? "sigma" = sigma(object), "Gp" = object@Gp, "Tp" = Tpfun(cnms), # "term-wise theta pointer" "flist" = object@flist, "fixef" = fixef(object), "beta" = object@beta, "theta" = setNames(th, getThetaNames(object)), "par" = setNames(object@optinfo$val[seq_len(getParLength(object))], getParNames(object)), "ST" = setNames(vec2STlist(object@theta, n = lengths(cnms)), names(cnms)), ## FIXME: check for flexSigma? "Tlist" = setNames(lapply(getReCovs(object), getLambda), names(object@cnms)), "REML" = dims[["REML"]], "is_REML" = isREML(object), ## number of random-effects terms "n_rtrms" = length(cnms), ## number of random-effects grouping factors "n_rfacs" = length(object@flist), "N" = dims[["N"]], "n" = dims[["n"]], "p" = dims[["p"]], "q" = dims[["q"]], "npar" = as.list(dims)[["npar"]] %||% length(getLower(object)), "p_i" = p_i, "l_i" = l_i, "q_i" = p_i * l_i, "k" = length(cnms), "m_i" = choose(p_i + 1, 2), "m" = dims[["nth"]], "cnms" = cnms, "devcomp" = dc, "offset" = rsp$offset, "lower" = setNames(getLower(object), getParNames(object)), "devfun" = { verbose <- getCall(object)$verbose; if (is.null(verbose)) verbose <- 0L reCovs <- getReCovs(object) if (isGLMM(object)) { reTrms <- getME(object,c("Zt","theta","Lambdat","Lind","flist","cnms")) reTrms$lower <- getLower(object) reTrms$upper <- getUpper(object) reTrms$reCovs <- reCovs mkGlmerDevfun(object@frame, X=getME(object, "X"), reTrms=reTrms, family=family(object), nAGQ=object@devcomp$dims[["nAGQ"]], verbose=verbose, control=glmerControl( compDev=as.logical(object@devcomp$dims[["compDev"]]), tolPwrss=object@devcomp$cmp[["tolPwrss"]])) } else { ## copied from refit ... DRY ... devlist <- list(pp=PR, resp=rsp, lower = getLower(object), upper = getUpper(object), mkPar = mkMkPar(reCovs), mkTheta = mkMkTheta(reCovs)) mkdevfun(rho=list2env(devlist), ## FIXME: fragile ... // also pass 'maxit' ? verbose=verbose, control=object@optinfo$control) } }, "devarg" = { nm <- getParNames(object) if (!isLMM(object)) nm <- c(nm, names(fixef(object))) setNames(object@optinfo$val, nm) }, ## FIXME: current version gives lower bounds for theta parameters only: ## -- these must be extended for [GN]LMMs -- give extended value including -Inf values for beta values? "glmer.nb.theta" = if(isGLMM(object) && isNBfamily(rsp$family$family)) getNBdisp(object) else NA_real_, "..foo.." = # placeholder! stop(gettextf("'%s' is not implemented yet", sprintf("getME(*, \"%s\")", name))), ## otherwise stop(sprintf("Mixed-Effects extraction of '%s' is not available for class \"%s\"", name, class(object)))) }## {getME} ##' @importMethodsFrom Matrix t %*% crossprod diag tcrossprod ##' @importClassesFrom Matrix dgCMatrix dpoMatrix corMatrix NULL ## Extract the conditional variance-covariance matrix of the fixed-effects ## parameters vcov.merMod <- function(object, correlation = TRUE, sigm = sigma(object), use.hessian = NULL, full = FALSE, noScale = NULL, ...) { ## FIXME: warn/message if GLMM (RX-computation is approximate), ## if other vars are specified? if (full) return(vcov_full(object, sigm)) hess.avail <- ## (1) numerical Hessian computed? (!is.null(h <- object@optinfo$derivs$Hessian) && ## (2) does Hessian include fixed-effect parameters? nrow(h) > (ntheta <- length(object@theta))) if (is.null(use.hessian)) use.hessian <- hess.avail if (use.hessian && !hess.avail) stop(shQuote("use.hessian"), "=TRUE specified, ", "but Hessian is unavailable") calc.vcov.hess <- function(h) { ## invert 2*Hessian, catching errors and forcing symmetric result ## ~= forceSymmetric(solve(h/2)[i,i]) : solve(h/2) = 2*solve(h) h <- tryCatch(solve(h), error=function(e) matrix(NA_real_,nrow=nrow(h),ncol=ncol(h))) i <- -seq_len(ntheta) ## drop var-cov parameters h <- h[i,i] forceSymmetric(h + t(h)) } ## alternately: calculate var-cov from implicit (RX) information ## provided by fit (always the case for lmerMods) V <- sigm^2 * object@pp$unsc() if (hess.avail) { V.hess <- calc.vcov.hess(h) bad.V.hess <- any(is.na(V.hess)) if (!bad.V.hess) { ## another 'bad var-cov' check: positive definite? e.hess <- eigen(V.hess,symmetric = TRUE,only.values = TRUE)$values if (min(e.hess) <= 0) bad.V.hess <- TRUE } } if (!use.hessian && hess.avail) { ## if hessian is available, go ahead and check ## for similarity with the RX-based estimate var.hess.tol <- 1e-4 # FIXME: should var.hess.tol be user controlled? if (!bad.V.hess && any(abs(V-V.hess) > var.hess.tol * V.hess)) warning("variance-covariance matrix computed ", "from finite-difference Hessian\nand ", "from RX differ by >",var.hess.tol,": ", "consider ",shQuote("use.hessian=TRUE")) } if (use.hessian) { if (!bad.V.hess) { V <- V.hess } else { warning("variance-covariance matrix computed ", "from finite-difference Hessian is\n", "not positive definite or contains NA values: falling back to ", "var-cov estimated from RX") } } ## FIXME: try to catch non-PD matrices rr <- tryCatch(as(V, "dpoMatrix"), error = function(e)e) if (inherits(rr, "error")) { warning(gettextf("Computed variance-covariance matrix problem: %s;\nreturning NA matrix", rr$message), domain = NA) rr <- matrix(NA_real_,nrow(V),ncol(V)) } nmsX <- colnames(object@pp$X) dimnames(rr) <- list(nmsX,nmsX) if(correlation) rr@factors$correlation <- if(!is.na(sigm)) as(rr, "corMatrix") else rr # (is NA anyway) ## If auto-scaling is enabled if(is.null(noScale) || (!is.null(noScale) && !noScale)){ if (!is.null(sc <- attr(object@pp$X, "scaled:scale"))) { ce <- attr(object@pp$X, "scaled:center") rr <- scale_vcov(rr, sc, ce) } } rr } vcov_full <- function(object, s = sigma(object)) { L <- getME(object, "L") RX <- getME(object, "RX") RZX <- getME(object, "RZX") Lambdat <- getME(object, "Lambdat") RXtinv <- solve(t(RX)) LinvLambdat <- solve(L, Lambdat, system = "L") Minv <- s * rbind( cbind(LinvLambdat, Matrix(0, nrow = nrow(L), ncol = ncol(RX))), cbind(-RXtinv %*% t(RZX) %*% LinvLambdat, RXtinv) ) Cmat <- crossprod(Minv) ## do we have machinery elsewhere for this (names for b-vector) ? ## should this be extracted into a utility f'n (e.g. for getME(., "b") ? fix_nms <- colnames(object@pp$X) rr <- ranef(object, condVar = FALSE) gnms <- function(x) c(outer(colnames(x), rownames(x), function(x,y) paste(y, x, sep = "."))) rnms <- lapply(rr, gnms) re_nms <- unlist(Map(function(n, r) paste(n, r, sep = "."), names(rr), rnms)) all_nms <- unname(c(re_nms, fix_nms)) dimnames(Cmat) <- list(all_nms, all_nms) return(Cmat) } ##' @importFrom stats vcov ##' @S3method vcov summary.merMod vcov.summary.merMod <- function(object, ...) { if(is.null(object$vcov)) stop("logic error in summary of merMod object") object$vcov } if(FALSE)## *NOWHERE* used _FIXME_ ?? ## Compute standard errors of fixed effects from an merMod object ## ## @title Standard errors of fixed effects ## @param object "merMod" object, ## @param ... additional, optional arguments. None are used at present. ## @return numeric vector of length length(fixef(.)) unscaledVar <- function(object, ...) { stopifnot(is(object, "merMod")) sigma(object) * diag(object@pp$unsc()) } ##' @S3method summary merMod summary.merMod <- function(object, correlation = (p <= getOption("lme4.summary.cor.max")), use.hessian = NULL, ...) { if (...length() > 0) { ## FIXME: need testing code warning("additional arguments ignored") } ## se.calc: hess.avail <- (!is.null(h <- object@optinfo$derivs$Hessian) && nrow(h) > length(object@theta)) if (is.null(use.hessian)) use.hessian <- hess.avail if (use.hessian && !hess.avail) stop("'use.hessian=TRUE' specified, but Hessian is unavailable") resp <- object@resp devC <- object@devcomp dd <- devC$dims ## cmp <- devC$cmp useSc <- as.logical(dd[["useSc"]]) sig <- sigma(object) ## REML <- isREML(object) famL <- famlink(resp = resp) p <- length(coefs <- fixef(object)) ## protect against merDeriv's vcov.glmerMod(), which only ## handles binomial and Poisson values if (is(object, "glmerMod") && !family(object)$family %in% c("binomial", "poisson")) { vcov <- vcov.merMod } vc <- vcov(object, use.hessian = use.hessian) stdError <- sqrt(diag(vc)) coefs <- cbind("Estimate" = coefs, "Std. Error" = stdError) if (p > 0) { coefs <- cbind(coefs, (cf3 <- coefs[,1]/coefs[,2]), deparse.level = 0) colnames(coefs)[3] <- paste(if(useSc) "t" else "z", "value") if (isGLMM(object)) # FIXME: if "t" above, cannot have "z" here coefs <- cbind(coefs, "Pr(>|z|)" = 2*pnorm(abs(cf3), lower.tail = FALSE)) } llAIC <- llikAIC(object) ## FIXME: You can't count on object@re@flist, ## nor compute VarCorr() unless is(re, "reTrms"): varcor <- VarCorr(object) # use S3 class for now structure(list(methTitle = methTitle(dd), objClass = class(object), devcomp = devC, isLmer = is(resp, "lmerResp"), useScale = useSc, logLik = llAIC[["logLik"]], family = famL$family, link = famL$link, ngrps = ngrps(object), coefficients = coefs, sigma = sig, ## explicitly call method to avoid getting m ## messed up by merDeriv's vcov method ## (which doesn't assign a VC attribute) vcov = vcov.merMod(object, correlation = correlation, sigm = sig), varcor = varcor, # and use formatVC(.) for printing. AICtab = llAIC[["AICtab"]], call = object@call, residuals = residuals(object,"pearson",scaled = TRUE), fitMsgs = .merMod.msgs(object), optinfo = object@optinfo, ## put corrSet **last** so we don't mess up people relying on numeric indexing ## of elements (!!) corrSet = if(!missing(correlation)) correlation else NA # TRUE/FALSE (when set) / NA ), class = "summary.merMod") } ## TODO: refactor? Why the hell do we need a summary method for summary.merMod? ##' @S3method summary summary.merMod summary.summary.merMod <- function(object, varcov = TRUE, ...) { if(varcov && is.null(object$vcov)) object$vcov <- vcov.merMod(object, correlation = TRUE, sigm = object$sigma) object } ##' @importFrom stats weights ##' @S3method weights merMod weights.merMod <- function(object, type = c("prior","working"), ...) { type <- match.arg(type) res <- if (type == "prior") object@resp$weights else object@pp$Xwts^2 res <- napredict(na.action(object), res) ## the working weights available through pp$Xwts should be ## equivalent to: ## object@resp$weights*(object@resp$muEta()^2)/object@resp$variance() ## however, the unit tests in tests/glmmWeights.R suggest that this ## equivalence is approximate. this may be fine, however, if the ## discrepancy is due to another instance of the general problem of ## reference class fields not being updated at the optimum, then this ## could cause real problems. see for example: ## https://github.com/lme4/lme4/issues/166 return(res) } ## utility function: x is a ranef.mer object, nx is the name of an element asDf0 <- function(x,nx,id=FALSE) { xt <- x[[nx]] ss <- stack(xt) ss$ind <- factor(as.character(ss$ind), levels = colnames(xt)) ss$.nn <- rep.int(reorder(factor(rownames(xt)), xt[[1]], FUN = mean,sort = sort), ncol(xt)) ## allow 'postVar' *or* 'condVar' names pv <- attr(xt,"postVar") if (is.null(pv)) { pv <- attr(xt,"condVar") } if (!is.null(pv)) { tmpfun <- function(pvi) { unlist(lapply(1:nrow(pvi), function(i) sqrt(pvi[i, i, ]))) } if (!is.list(pv)) { ss$se <- tmpfun(pv) } else { ## rely on ordering when unpacking! ss$se <- unlist(lapply(pv,tmpfun)) } } if (id) ss$id <- nx return(ss) } ## convert ranef object to a long-format data frame, e.g. suitable ## for ggplot2 (or homemade lattice plots) ## FIXME: have some gymnastics to do if terms, levels are different ## for different grouping variables - want to maintain ordering ## but still allow rbind()ing as.data.frame.ranef.mer <- function(x, ...) { xL <- lapply(names(x), asDf0, x=x, id=TRUE) ## combine xD <- do.call(rbind,xL) ## rename ... oldnames <- c("values", "ind", ".nn", "se", "id") newnames <- c("condval","term","grp", "condsd","grpvar") names(xD) <- newnames[match(names(xD),oldnames)] ## reorder ... neworder <- c("grpvar","term","grp","condval") if ("condsd" %in% names(xD)) neworder <- c(neworder,"condsd") xD[neworder] } dim.merMod <- function(x) { getME(x, c("n", "p", "q", "p_i", "l_i", "q_i", "k", "m_i", "m")) } ## Internal utility, only used in optwrap() : ##' @title Get the optimizer function and check it minimally ##' @param optimizer character string ( = function name) *or* function getOptfun <- function(optimizer) { if (((is.character(optimizer) && optimizer == "optimx") || deparse(substitute(optimizer)) == "optimx")) { if (!requireNamespace("optimx")) { stop(shQuote("optimx")," package must be installed order to ", "use ",shQuote('optimizer="optimx"')) } optfun <- optimx::optimx } else if (is.character(optimizer)) { optfun <- tryCatch(get(optimizer), error = function(e) NULL) } else optfun <- optimizer if (is.null(optfun)) stop("couldn't find optimizer function ",optimizer) if (!is.function(optfun)) stop("non-function specified as optimizer") needArgs <- c("fn","par","lower","control") if (anyNA(match(needArgs, names(formals(optfun))))) stop("optimizer function must use (at least) formal parameters ", paste(sQuote(needArgs), collapse = ", ")) optfun } optwrap <- function(optimizer, fn, par, lower = -Inf, upper = Inf, control = list(), adj = FALSE, calc.derivs = TRUE, force.calc.derivs = FALSE, use.last.params = FALSE, verbose = 0L) { ## calc.derivs may be passed as NULL by some upstream pkgs ... calc.derivs <- calc.derivs %||% TRUE ## control must be specified if adj==TRUE; ## otherwise this is a fairly simple wrapper optfun <- getOptfun(optimizer) optName <- if(is.character(optimizer)) optimizer else ## "good try": deparse(substitute(optimizer))[[1L]] lower <- rep_len(lower, length(par)) upper <- rep_len(upper, length(par)) if (adj) ## control parameter tweaks: only for second round in nlmer, glmer switch(optName, "bobyqa" = { if(!is.numeric(control$rhobeg)) control$rhobeg <- 0.0002 if(!is.numeric(control$rhoend)) control$rhoend <- 2e-7 }, "Nelder_Mead" = { if (is.null(control$xst)) { betaSD <- sqrt(diag(environment(fn)$pp$unsc())) xst0 <- rep(0.1, length(par) - length(betaSD)) xst1 <- pmin(betaSD, 10) control$xst <- 0.2 * c(xst0, xst1) } if (is.null(control$xt)) control$xt <- control$xst*5e-4 }) switch(optName, "bobyqa" = { if(all(par == 0)) par[] <- 0.001 ## minor kludge if(!is.numeric(control$iprint)) control$iprint <- min(verbose, 3L) }, "Nelder_Mead" = control$verbose <- verbose, "nloptwrap" = control$print_level <- min(as.numeric(verbose),3L), ## otherwise: if(verbose) warning(gettextf( "'verbose' not yet passed to optimizer '%s'; consider fixing optwrap()", optName), domain = NA) ) arglist <- list(fn = fn, par = par, lower = lower, upper = upper, control = control) ## optimx: must pass method in control (?) because 'method' was previously ## used in lme4 to specify REML vs ML if (optName == "optimx") { if (is.null(method <- control$method)) stop("must specify 'method' explicitly for optimx") arglist$control$method <- NULL arglist <- c(arglist, list(method = method)) } ## FIXME: test! effects of multiple warnings?? ## may not need to catch warnings after all?? curWarnings <- list() opt <- withCallingHandlers(do.call(optfun, arglist), warning = function(w) { curWarnings <<- append(curWarnings,list(w$message)) }) ## cat("***",unlist(tail(curWarnings,1))) ## FIXME: set code to warn on convergence !=0 ## post-fit tweaking if (optName == "bobyqa") { opt$convergence <- opt$ierr } else if (optName == "Nelder_Mead") { ## fix-up: Nelder_Mead treats running out of iterations as "convergence" (!?) if (opt$NM.result==4) opt$convergence <- 4 } else if (optName == "optimx") { opt <- list(par = coef(opt)[1,], fvalues = opt$value[1], method = method, conv = opt$convcode[1], feval = opt$fevals + opt$gevals, message = attr(opt,"details")[,"message"][[1]]) } if ((optconv <- getConv(opt)) != 0) { wmsg <- paste("convergence code",optconv,"from",optName) if (!is.null(getMsg(opt))) wmsg <- paste0(wmsg,": ",getMsg(opt)) warning(wmsg) curWarnings <<- append(curWarnings,list(wmsg)) } ## pp_before <- environment(fn)$pp ## save(pp_before,file="pp_before.RData") singular <- min(opt$par - lower, upper - opt$par) < getSingTol() if (force.calc.derivs || (calc.derivs && !singular)){ if (use.last.params) { ## +0 tricks R into doing a deep copy ... ## otherwise element of ref class changes! ## FIXME:: clunky!! orig_pars <- opt$par orig_theta <- environment(fn)$pp$theta+0 orig_pars[seq_along(orig_theta)] <- orig_theta } if (verbose > 10) cat("computing derivatives\n") derivs <- deriv12(fn, opt$par, fx = opt$value) if (use.last.params) { ## run one more evaluation of the function at the optimized ## value, to reset the internal/environment variables in devfun ... fn(orig_pars) } } else derivs <- NULL if (!use.last.params) { ## run one more evaluation of the function at the optimized ## value, to reset the internal/environment variables in devfun ... fn(opt$par) } structure(opt, ## store all auxiliary information optimizer = optimizer, control = control, warnings = curWarnings, derivs = derivs) } lme4/R/modular.R0000644000176200001440000012244015225714450013112 0ustar liggesusers#### --> ../man/modular.Rd #### ================== ### Small utilities to be used in lFormula(), glFormula(), and mkFormula() doCheck <- function(x) { is.character(x) && !any(x == "ignore") } RHSForm <- function(form,as.form=FALSE) { rhsf <- form[[length(form)]] if (as.form) reformulate(deparse(rhsf)) else rhsf } `RHSForm<-` <- function(formula,value) { formula[[length(formula)]] <- value formula } ##' Original formula, minus response ( = '~ ') : noLHSform <- function(formula) { if (length(formula)==2) formula else formula[-2] } ##' @param cstr name of control being set ##' @param val value of control being set checkCtrlLevels <- function(cstr, val, smallOK=FALSE) { bvals <- c("message","warning","stop","ignore") if (smallOK) bvals <- outer(bvals, c("","Small"), paste0) if (!is.null(val) && !val %in% bvals) stop("invalid control level ",sQuote(val)," in ",cstr,": valid options are {", paste(sapply(bvals,sQuote),collapse=","),"}") invisible(NULL) } ## general identifiability checker, used both in checkZdim and checkZrank wmsg <- function(n, cmp.val, allow.n, msg1="", msg2="", msg3="") { if (allow.n) { ## allow n == cmp.val unident <- n < cmp.val cmp <- "<" rstr <- "" } else { unident <- n <= cmp.val cmp <- "<=" rstr <- " and the residual variance (or scale parameter)" } ## %s without spaces intentional (don't want an extra space if the ## message component is empty) wstr <- sprintf("%s (=%d) %s %s (=%d)%s; the random-effects parameters%s are probably unidentifiable", msg1, n, cmp,msg2, cmp.val,msg3, rstr) list(unident=unident, wstr=wstr) } ##' For each r.e. term, test if Z has more columns than rows to detect ##' unidentifiability: ##' @title ##' @param Ztlist list of Zt matrices - one for each r.e. term ##' @param n no. observations ##' @param ctrl ##' @param allow.n allow as many random-effects as there are observations ##' for each term? ##' @return possibly empty character string with warning messages checkZdims <- function(Ztlist, n, ctrl, allow.n=FALSE) { stopifnot(is.list(Ztlist), is.numeric(n)) cstr <- "check.nobs.vs.nRE" checkCtrlLevels(cstr, cc <- ctrl[[cstr]]) term.names <- names(Ztlist) rows <- vapply(Ztlist, nrow, 1L) cols <- vapply(Ztlist, ncol, 1L) stopifnot(all(cols == n)) if (doCheck(cc)) { unique(unlist(lapply(seq_along(Ztlist), function(i) { ww <- wmsg(cols[i], rows[i], allow.n, "number of observations", "number of random effects", sprintf(" for term (%s)", term.names[i])) if(ww$unident) { switch(cc, "warning" = warning(ww$wstr, call.=FALSE), "stop" = stop (ww$wstr, call.=FALSE), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) ww$wstr } else character() }))) ## -> possibly empty vector of error messages } else character() } ##' @importFrom Matrix rankMatrix checkZrank <- function(Zt, n, ctrl, nonSmall = 1e6, allow.n=FALSE) { stopifnot(is.list(ctrl), is.numeric(n), is.numeric(nonSmall)) cstr <- "check.nobs.vs.rankZ" if (doCheck(cc <- ctrl[[cstr]])) { ## not NULL or "ignore" checkCtrlLevels(cstr, cc, smallOK=TRUE) d <- dim(Zt) doTr <- d[1L] < d[2L] # Zt is "wide" => qr needs transpose(Zt) if(!(grepl("Small",cc) && prod(d) > nonSmall)) { rankZ <- rankMatrix(if(doTr) t(Zt) else Zt, method="qr") ww <- wmsg(n, rankZ, allow.n, "number of observations", "rank(Z)") if(is.na(rankZ)) { cc <- "stop" ww <- list(unident = TRUE, wstr = sub("^.*;", "rank(Z) is NA: invalid random effect factors?", ww$wstr)) } if (ww$unident) { switch(cc, "warningSmall" =, "warning" = warning(ww$wstr,call.=FALSE), "stopSmall" =, "stop" = stop(ww$wstr,call.=FALSE), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) ww$wstr } else character() } else character() } else character() } ## check scale of non-dummy columns of X, both ## against each other and against 1 (implicit scale of theta parameters)? ## (shouldn't matter for lmer models?) ## TODO: check for badly centred models? ## TODO: check scale of Z columns? ## What should the rules be? try to find problematic columns ## and rescale them? scale+center? Just scale or scale+center ## all numeric columns? ## checkScaleX <- function(X, kind="warning", tol=1e3) { ## cstr <- "check.scaleX" kinds <- eval(formals(lmerControl)[["check.scaleX"]]) if (!kind %in% kinds) stop(gettextf("unknown check-scale option: %s",kind)) if (is.null(kind) || kind == "ignore") return(X) ## else : cont.cols <- apply(X,2,function(z) !all(z %in% c(0,1))) col.sd <- apply(X[,cont.cols, drop=FALSE], 2L, sd) sdcomp <- outer(col.sd,col.sd,"/") logcomp <- abs(log(sdcomp[lower.tri(sdcomp)])) logsd <- abs(log(col.sd)) if (any(c(logcomp,logsd) > log(tol))) { wmsg <- "Some predictor variables are on very different scales:" if (kind %in% c("warning","stop")) { msg2 <- "\nYou may also use (g)lmerControl(autoscale = TRUE) to improve numerical stability." wmsg <- paste(wmsg, "consider rescaling.", msg2) switch(kind, "warning" = warning(wmsg, call.=FALSE), "stop" = stop(wmsg, call.=FALSE)) } else { wmsg <- paste(wmsg, "auto-rescaled (results NOT adjusted)") ## mimic scale() because we don't want to make a copy in ## order to retrieve the center/scale X[,cont.cols] <- sweep(X[,cont.cols,drop=FALSE],2,col.sd,"/") attr(X,"scaled:scale") <- setNames(col.sd,colnames(X)[cont.cols]) if (kind == "warn+rescale") warning(wmsg, call.=FALSE) } } else wmsg <- character() structure(X, msgScaleX = wmsg) } ##' @title Check that grouping factors have at least 2 and 1 sampled level" switch(cc, "warning" = warning(wstr,call.=FALSE), "stop" = stop(wstr,call.=FALSE), ## FIXME: should never get here since we have checkCtrLevels test above? stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } else wstr <- character() ## Part 2 ---------------- cstr <- "check.nobs.vs.nlev" checkCtrlLevels(cstr, cc <- ctrl[[cstr]]) if (doCheck(cc) && any(if(allow.n) nlevelVec > n else nlevelVec >= n)) { ## figure out which factors are the problem? w <- if (allow.n) which(nlevelVec>n) else which(nlevelVec>=n) bad_facs <- names(nlevelVec)[w] wst2 <- gettextf( "number of levels of each grouping factor must be %s number of observations", if(allow.n) "<=" else "<") wst2 <- paste0(wst2," (problems: ",paste(bad_facs,collapse=", "),")") switch(cc, "warning" = warning(wst2, call.=FALSE), "stop" = stop(wst2, call.=FALSE) ## shouldn't reach here ) } else wst2 <- character() ## Part 3 ---------------- cstr <- "check.nlev.gtreq.5" checkCtrlLevels(cstr, cc <- ctrl[[cstr]]) if (doCheck(cc) && any(nlevelVec < 5)) { wst3 <- "grouping factors with < 5 sampled levels may give unreliable estimates" switch(cc, "warning" = warning(wst3, call.=FALSE), "stop" = stop (wst3, call.=FALSE), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } else wst3 <- character() ## return: c(wstr, wst2, wst3) ## possibly == character(0) } ##' Coefficients (columns) are dropped from a design matrix to ##' ensure that it has full rank. ##' ##' 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. ##' ##' (Note: I have lifted this function from the ordinal (soon Rufus) ##' package and modified it slightly./rhbc) ##' ##' @title Ensure full rank design matrix ##' @param 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. ##' @param silent should a message not be issued if X is column rank ##' deficient? ##' @return The design matrix \code{X} without redundant columns. ##' @seealso \code{\link{qr}} and \code{\link{lm}} ##' @importFrom Matrix rankMatrix ##' @author Rune Haubo Bojesen Christensen (drop.coef()); Martin Maechler chkRank.drop.cols <- function(X, kind, tol = 1e-7, method = "qr") { ## Test and match arguments: stopifnot(is.matrix(X)) # i.e., *not* sparse kinds <- eval(formals(lmerControl)[["check.rankX"]]) if (!kind %in% kinds) stop(gettextf("undefined option for 'kind': %s", kind)) ## c("message+drop.cols", "ignore", ## "silent.drop.cols", "warn+drop.cols", "stop.deficient"), if(kind == "ignore") return(X) ## else : p <- ncol(X) if (kind == "stop.deficient") { if ((rX <- rankMatrix(X, tol=tol, method=method)) < p) stop(gettextf(sub("\n +", "\n", "the fixed-effects model matrix is column rank deficient (rank(X) = %d < %d = p); the fixed effects will be jointly unidentifiable"), rX, p), call. = FALSE) } else { ## kind is one of "message+drop.cols", "silent.drop.cols", "warn+drop.cols" ## --> consider to drop extraneous columns: "drop.cols": ## Perform the qr-decomposition of X using LINPACK method, ## as we need the "good" pivots (and the same as lm()): ## this rankMatrix(X, method="qrLINPACK"): FIXME? rankMatrix(X, method= "qr.R") qr.X <- qr(X, tol = tol, LAPACK = FALSE) rnkX <- qr.X$rank if (rnkX == p) return(X) ## return X if X has full column rank ## else: ## message about no. dropped columns: msg <- sprintf(ngettext(p - rnkX, "fixed-effect model matrix is rank deficient so dropping %d column / coefficient", "fixed-effect model matrix is rank deficient so dropping %d columns / coefficients"), p - rnkX) if (kind != "silent.drop.cols") (if(kind == "warn+drop.cols") warning else message)(msg, domain = NA) ## Save properties of X contr <- attr(X, "contrasts") asgn <- attr(X, "assign") ## Return the columns correponding to the first qr.x$rank pivot ## elements of X: keep <- qr.X$pivot[seq_len(rnkX)] dropped.names <- colnames(X[,-keep,drop=FALSE]) X <- X[, keep, drop = FALSE] if (rankMatrix(X, tol=tol, method=method) < ncol(X)) stop(gettextf("Dropping columns failed to produce full column rank design matrix"), call. = FALSE) ## Re-assign relevant attributes: if(!is.null(contr)) attr(X, "contrasts") <- contr if(!is.null(asgn)) attr(X, "assign") <- asgn[keep] attr(X, "msgRankdrop") <- msg attr(X, "col.dropped") <- setNames(qr.X$pivot[(rnkX+1L):p], dropped.names) } X } # check that response is not constant checkResponse <- function(y, ctrl) { stopifnot(is.list(ctrl)) cstr <- "check.response.not.const" checkCtrlLevels(cstr, cc <- ctrl[[cstr]]) if (doCheck(cc) && length(unique(y)) < 2L) { wstr <- "Response is constant" switch(cc, "warning" = warning(wstr, call.=FALSE), "stop" = stop(wstr, call.=FALSE), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } else character() } ##' Extract all warning msgs from a merMod object .merMod.msgs <- function(x) { ## currently only those found with 'X' : aX <- attributes(x@pp$X) wmsgs <- grep("^msg", names(aX)) if(any(has.msg <- nchar(Xwmsgs <- unlist(aX[wmsgs])) > 0)) Xwmsgs[has.msg] else character() } ## NA predict and restore rownames of original data if necessary ## napredictx <- function(x,...) { ## res <- napredict(x) ## } ##' @rdname modular ##' Internal workhorse shared by lFormula() and glFormula(). ##' Handles formula checking, model-frame construction, random-effects setup, ##' and fixed-effects matrix building -- all of which is identical between the ##' two public functions. ##' ##' @param formula raw model formula from the caller (processed internally ##' via \code{checkFormulaData} and \code{as.formula}) ##' @param mc raw \code{match.call()} result from the caller, ##' used to construct the \code{stats::model.frame} call ##' @param data the \code{data} argument from the caller ##' @param contrasts optional contrasts argument ##' @param control the checkControl sub-list ##' @param isGLMM logical: if \code{TRUE}, include \code{mustart} and ##' \code{etastart} in the model.frame call (glmer-specific) ##' @param allow.n passed to checkNlevels, checkZdims, checkZrank; ##' FALSE for lmer (default), TRUE for glmer ##' @param check_zero_rows if TRUE, stop on empty model frame (lmer mode) ##' @param check_na_Zt if TRUE, stop on NA in Z matrix (lmer mode) ##' @param set_varnames_fixed if TRUE, set varnames.fixed attribute (lmer mode) ##' @param parent_env parent.frame() captured by the calling function ##' @return list(fr, X, reTrms, formula, wmsgs) -- callers (lFormula/glFormula) ##' append their own specific elements (REML or family) to this result mkFormula <- function(formula, mc, data, contrasts, control, isGLMM = FALSE, allow.n = FALSE, check_zero_rows = FALSE, check_na_Zt = FALSE, set_varnames_fixed = FALSE, parent_env = parent.frame()) { ## --- common setup: formula checking and mf construction --- cstr <- "check.formula.LHS" checkCtrlLevels(cstr, control[[cstr]]) denv <- checkFormulaData(formula, data, checkLHS = control$check.formula.LHS == "stop", calling_env = parent_env) formula <- as.formula(formula, env = denv) if (getDoublevertDefault() == "split") RHSForm(formula) <- reformulas::expandDoubleVerts(RHSForm(formula)) match_vars <- c("data", "subset", "weights", "na.action", "offset") if (isGLMM) match_vars <- c(match_vars, "mustart", "etastart") m <- match(match_vars, names(mc), 0L) mf <- mc[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- quote(stats::model.frame) ## --- end common setup --- ## substitute special(x | f) with (x | f) fr.form. <- noSpecials(formula, specials = lme4_specials, delete = FALSE) ## substitute (x | f) and (x || f) with (x + f) fr.form <- sub_specials(fr.form., specials = c("|", "||"), keep_args = c(2L, 2L)) environment(fr.form.) <- environment(fr.form) <- environment(formula) ## model.frame.default resolves 'weights'/'offset' (and other extras) ## by evaluating them with 'data' searched first and environment(formula) ## as a fallback -- *not* the frame from which [g]lFormula was called ## (see the 'extras' handling in stats:::model.frame.default). So, to ## allow 'weights'/'offset' expressions that aren't columns of 'data' to ## be looked up in the caller's frame as a fallback, temporarily assign ## their values (evaluated the same way, but with the caller's frame ## substituted for environment(formula) as the fallback) into the ## formula's environment, restoring its previous state on exit so ## nothing is permanently added to (or overwritten in) that environment. formula_env <- environment(fr.form) existed <- logical(0) old <- list() for (i in c("weights", "offset")) { if (!is.null(mc[[i]])) { ## Checking for a pre-existing binding can force an unrelated ## promise (e.g. a same-named formal argument of a caller whose ## own frame happens to be environment(formula), as when a ## wrapper builds its formula via as.formula() without setting ## env= explicitly). Treat a failure to resolve it the same as ## "no pre-existing value to preserve" rather than propagating ## the error. existed[i] <- tryCatch( exists(i, envir = formula_env, inherits = FALSE) && !is.function(get(i, envir = formula_env, inherits = FALSE)), error = function(e) FALSE) if (existed[i]) old[[i]] <- get(i, envir = formula_env, inherits = FALSE) assign(i, eval(mc[[i]], data, parent_env), envir = formula_env) } } if (length(existed) > 0L) { on.exit( for (nm in names(existed)) { if (existed[[nm]]) { assign(nm, old[[nm]], envir = formula_env) } ## else: leave the value we just assigned in place, rather than ## rm()-ing it -- restores pre-2.0-2 behaviour where a real ## weights/offset value assigned here persists in the formula's ## environment. Several downstream packages (mermboost, and ## emmeans's recover_data.call() as used by glmmSeq) rely on ## being able to find it there after the fact. }, add = TRUE ) } mf$formula <- fr.form fr <- eval(mf, parent_env) if (check_zero_rows && nrow(fr) == 0L) stop("0 (non-NA) cases") ## convert character vectors to factor (defensive) fr <- factorize(fr.form, fr, char.only = TRUE) ## store full, original formula & offset attr(fr, "formula") <- formula attr(fr, "offset") <- mf$offset n <- nrow(fr) ## random effects and terms modules ## get list of calls whose first argument is a call to '|' ## x | f -> us(x | f) ## nonspecial(x | f) -> us(x | f) ## special(x | f) -> special(x | f) bb1 <- findbars_x(formula, specials = lme4_specials, default.special = "us", target = "|", expand_doublevert_method = getDoublevertDefault()) bb0 <- lapply(bb1, `[[`, 2L) reTrms <- reformulas::mkReTrms(bb0, fr, calc.lambdat = FALSE) bb1 <- bb1[reTrms$ord] # reorder to match mkReTrms internal ordering reTrms <- upReTrms(reTrms, bb1) # local calc.lambdat=TRUE step ## If there is a covariance structure; ignore the check nobs.vs.nRE if (.anyStructured(reTrms$reCovs)) control$check.nobs.vs.nRE <- "ignore" wmsgNlev <- checkNlevels(reTrms$flist, n = n, control, allow.n = allow.n) wmsgZdims <- checkZdims(reTrms$Ztlist, n = n, control, allow.n = allow.n) if (check_na_Zt && anyNA(reTrms$Zt)) { stop("NA in Z (random-effects model matrix): ", "please use ", shQuote("na.action='na.omit'"), " or ", shQuote("na.action='na.exclude'")) } wmsgZrank <- checkZrank(reTrms$Zt, n = n, control, nonSmall = 1e6, allow.n = allow.n) ## fixed-effects model matrix X - remove random effect parts from formula: fixedform <- fr.form. RHSForm(fixedform) <- reformulas::nobars(RHSForm(fixedform)) mf$formula <- fixedform ## re-evaluate model frame to extract predvars component fixedfr <- eval(mf, parent_env) attr(attr(fr, "terms"), "predvars.fixed") <- attr(attr(fixedfr, "terms"), "predvars") ## so we don't have to fart around retrieving which vars we need ## in model.frame(.,fixed.only=TRUE) if (set_varnames_fixed) attr(attr(fr, "terms"), "varnames.fixed") <- names(fixedfr) ## ran-effects model frame (for predvars) ## important to COPY formula (and its environment)? ranform <- fr.form. RHSForm(ranform) <- reformulas::subbars( RHSForm(noSpecials(lme4_reOnly(ranform), delete = FALSE, specials = lme4_specials)) ) mf$formula <- ranform ranfr <- eval(mf, parent_env) attr(attr(fr, "terms"), "predvars.random") <- attr(terms(ranfr), "predvars") ## FIXME: shouldn't we have this already in the full-frame predvars? X <- model.matrix(fixedform, fr, contrasts)#, sparse = FALSE, row.names = FALSE) ## sparseX not yet ## Scaling (if autoscale is on...) if (!is.null(control$autoscale) && control$autoscale) { if ("(Intercept)" %in% colnames(X)) { X_scaled <- scale(X[, -1]) X[, -1] <- X_scaled } else { X_scaled <- scale(X) X <- X_scaled } attr(X, "scaled:center") <- attr(X_scaled, "scaled:center") attr(X, "scaled:scale") <- attr(X_scaled, "scaled:scale") } ## backward compatibility (keep no longer than ~2015): if (is.null(rankX.chk <- control[["check.rankX"]])) rankX.chk <- eval(formals(lmerControl)[["check.rankX"]])[[1]] X <- chkRank.drop.cols(X, kind = rankX.chk, tol = 1e-7) if (is.null(scaleX.chk <- control[["check.scaleX"]])) scaleX.chk <- eval(formals(lmerControl)[["check.scaleX"]])[[1]] X <- checkScaleX(X, kind = scaleX.chk) list(fr = fr, X = X, reTrms = reTrms, formula = formula, wmsgs = c(Nlev = wmsgNlev, Zdims = wmsgZdims, Zrank = wmsgZrank)) } ##' @rdname modular ##' @param control a list giving (for \code{[g]lFormula}) all options (see \code{\link{lmerControl}} for running the model; ##' (for \code{mkLmerDevfun,mkGlmerDevfun}) options for inner optimization step; ##' (for \code{optimizeLmer} and \code{optimize[Glmer}) control parameters for nonlinear optimizer (typically inherited from the \dots argument to \code{lmerControl}) ##' @return \bold{lFormula, glFormula}: A list containing components, ##' \item{fr}{model frame} ##' \item{X}{fixed-effect design matrix} ##' \item{reTrms}{list containing information on random effects structure: result of \code{\link{mkReTrms}}} ##' \item{REML}{(lFormula only): logical flag: use restricted maximum likelihood? (Copy of argument.)} ##' @export lFormula <- function(formula, data=NULL, REML = TRUE, subset, weights, na.action, offset, contrasts = NULL, control=lmerControl(), ...) { control <- control$checkControl ## this is all we really need mc <- match.call() dontChk <- c("start", "verbose", "devFunOnly") dots <- list(...) do.call(checkArgs, c(list("lmer"), dots[!names(dots) %in% dontChk])) if (!is.null(dots[["family"]])) { ## lmer(...,family=...); warning issued within checkArgs mc[[1]] <- quote(lme4::glFormula) if (missing(control)) mc[["control"]] <- glmerControl() return(eval(mc, parent.frame())) } res <- mkFormula(formula, mc, data, contrasts, control, isGLMM = FALSE, allow.n = FALSE, check_zero_rows = TRUE, check_na_Zt = TRUE, set_varnames_fixed = TRUE, parent_env = parent.frame()) c(res, list(REML = REML)) } ## utility f'n for checking starting values getStart <- function(start, rho, nAGQ) { ## default values par <- par0 <- (rho$mkPar %||% identity)(rho$pp$theta) fixef <- fixef0 <- rho$pp$delb if (is.null(start)) NULL # do nothing else if (is.numeric(start)) par <- start else if (is.list(start)) { if (length(start) > 0L && is.null(names(start))) stop(gettextf("'%s' does not have names", "start"), domain = NA) valid <- c(c("par", "theta"), if (nAGQ > 0L) c("fixef", "beta")) invalid <- setdiff(names(start), valid) if (length(invalid) > 0L) stop(gettextf("'%s' has invalid names %s", "start", deparse(invalid)), domain = NA) if (!all(vapply(start, is.numeric, FALSE))) stop(gettextf("'%s' has non-numeric components", "start"), domain = NA) npar <- is.null(start$par) ntheta <- is.null(start$theta) nfixef <- is.null(start$fixef) nbeta <- is.null(start$beta) if (!(npar && ntheta)) { if (!(npar || ntheta)) message(gettextf("ignoring %s", "start$theta"), domain = NA) par <- if (npar) start$theta else start$par } if (!(nfixef && nbeta)) { if (!(nfixef || nbeta)) message(gettextf("ignoring %s", "start$beta"), domain = NA) fixef <- if (nfixef) start$beta else if (length(start$fixef) > length(fixef) && !is.null(nms <- names(start$fixef)) && ncol(rho$pp$X) == length(fixef) && # ever FALSE? !is.null(nms. <- colnames(rho$pp$X)) && # ever FALSE? all(m <- match(nms., nms, 0L))) start$fixef[m] else start$fixef } } else stop(gettextf("'%s' is not NULL, a numeric vector, or a list", "start"), domain = NA) if (length(par) != length(par0)) stop(gettextf("starting value of '%s' has length not equal to %.0f", "par", length(par0)), domain = NA) if (length(fixef) != length(fixef0)) stop(gettextf("starting value of '%s' has length not equal to %.0f", "fixef", length(fixef0)), domain = NA) if (nAGQ > 0L) c(par, fixef) else par } updateStart <- function(start, par) { if (is.null(start)) start else if (is.numeric(start)) par else if (is.list(start)) { if (!is.null(start[["par"]])) start[["par"]] <- par if (!is.null(start[["theta"]])) start[["theta"]] <- par start } else stop(gettextf("'%s' is not NULL, a numeric vector, or a list", "start"), domain = NA) } ##' @rdname modular ##' @param fr A model frame containing the variables needed to create an ##' \code{\link{lmerResp}} or \code{\link{glmResp}} instance ##' @param X fixed-effects design matrix ##' @param reTrms information on random effects structure (see \code{\link{mkReTrms}}) ##' @param REML (logical) fit restricted maximum likelihood model? ##' @param start starting values ##' @param verbose print output? ##' @return \bold{mkLmerDevfun, mkGlmerDevfun}: A function to calculate deviance ##' (or restricted deviance) as a function of the theta (random-effect) parameters ##' (for GlmerDevfun, of beta (fixed-effect) parameters as well). These deviance ##' functions have an environment containing objects required for their evaluation. ##' CAUTION: The output object of \code{mk(Gl|L)merDevfun} is an \code{\link{environment}} ##' containing reference class objects (see \code{\link{ReferenceClasses}}, \code{\link{merPredD-class}}, ##' \code{\link{lmResp-class}}), which behave in ways that may surprise many users. For example, if the ##' output of \code{mk(Gl|L)merDevfun} is naively copied, then modifications to the original will ##' also appear in the copy (and vice versa). To avoid this behavior one must make a deep copy ##' (see \code{\link{ReferenceClasses}} for details). ##' \cr ##' \cr ##' @export mkLmerDevfun <- function(fr, X, reTrms, REML = TRUE, start = NULL, verbose = 0, control = lmerControl(), ...) { ## FIXME: make sure verbose gets handled properly #if (missing(fr)) { ## reconstitute frame #} ## pull necessary arguments for making the model frame out of ... p <- ncol(X) # maybe also do rank check on X here?? rho <- new.env(parent=parent.env(environment())) rho$pp <- do.call(merPredD$new, c(reTrms[c("Zt","theta","Lambdat","Lind")], n=nrow(X), list(X=X))) REMLpass <- if(REML) p else 0L rho$resp <- if(missing(fr)) mkRespMod( REML = REMLpass, ...) else mkRespMod(fr, REML = REMLpass) ## FIXME / note: REML does double duty as rank of X and a flag for using ## REML maybe this should be mentioned in the help file for ## mkRespMod?? currently that help file says REML is logical. a ## consequence of this double duty is that it is impossible to fit ## a model with no fixed effects using REML (MM: ==> FIXME) ## devfun <- mkdevfun(rho, 0L, verbose=verbose, control=control) ## prevent R CMD check false pos. warnings (in this function only): pp <- resp <- mkTheta <- NULL rho$lmer_Deviance <- lmer_Deviance rho$mkPar <- mkMkPar(reTrms$reCovs) rho$mkTheta <- mkMkTheta(reTrms$reCovs) devfun <- function(par) .Call(lmer_Deviance, pp$ptr(), resp$ptr(), mkTheta(as.double(par))) environment(devfun) <- rho # if all random effects are of the form 1|f and starting values not # otherwise provided (and response variable is present, i.e. not doing # a simulation) then compute starting values if (is.null(start) && all(reTrms$cnms == "(Intercept)") && length(reTrms$flist) == length(reTrms$lower) && !is.null(y <- model.response(fr))) { v <- sapply(reTrms$flist, function(f) var(ave(y, f))) v.e <- var(y) - sum(v) if (!is.na(v.e) && v.e > 0) { v.rel <- v / v.e if (all(v.rel >= reTrms$lower^2)) rho$pp$setTheta(sqrt(v.rel)) } } ## theta <- getStart(start, rho$pp) ## ^^^^^ unused / obfuscation? should the above be rho$pp$setTheta(.) ? ## MM: commenting it did not break any of our checks if (length(rho$resp$y) > 0) ## only if non-trivial y devfun(rho$mkPar(rho$pp$theta)) # one evaluation to ensure all values are set rho$lower <- reTrms$lower # to be more consistent with mkGlmerDevfun rho$upper <- reTrms$upper %||% rep(Inf, length(reTrms$lower)) devfun # this should pass the rho environment implicitly } ##' @param devfun a deviance function, as generated by \code{\link{mkLmerDevfun}} ##' @return \bold{optimizeLmer}: Results of an optimization. optimizeLmer <- function(devfun, optimizer= formals(lmerControl)$optimizer, restart_edge= formals(lmerControl)$restart_edge, boundary.tol = formals(lmerControl)$boundary.tol, start = NULL, verbose = 0L, control = list(), ...) { verbose <- as.integer(verbose) rho <- environment(devfun) start <- getStart(start, rho, 0L) lower <- rho$lower upper <- rho$upper %||% rep(Inf, length(rho$lower)) opt <- optwrap(optimizer, devfun, start, lower=lower, upper=upper, control=control, adj=FALSE, verbose=verbose, ...) if (restart_edge) { ## FIXME: should we be looking at rho$pp$theta or opt$par ## at this point??? in koller example (for getData(13)) we have ## rho$pp$theta=0, opt$par=0.08 par0 <- rho$mkPar(rho$pp$theta) if (length(wl <- which(par0 == lower)) > 0L | length(wu <- which(par0 == upper)) > 0L) { ## *don't* use numDeriv -- cruder but fewer dependencies, no worries ## about keeping to the interior of the allowed space ## ## Removing the following line (hence *not* replacing 'par0' ## with a copy) breaks several tests in ../tests/boundary.R ## and ../tests/lmer-1.R. OMG ... par0 <- par0 + 0 ## [ same is seen in 'check.boundary' ] ## d0 <- devfun(par0) btol <- 1e-5 ## FIXME: make user-settable? bgrad <- mapply(function(i, bval, btol) { par <- par0 par[i] <- bval + btol (devfun(par) - d0)/btol }, i = c(wl, wu), bval = c(lower[wl], upper[wu]), btol = rep(c(btol, -btol), c(length(wl), length(wu)))) ## what do I need to do to reset rho$pp$theta to original value??? devfun(par0) ## reset rho$pp$theta after tests ## FIXME: allow user to specify ALWAYS restart if on boundary? if (any(is.na(bgrad))) { warning("some gradient components are NA near boundaries, skipping boundary check") return(opt) } else { if (any(bgrad < 0)) { if (verbose) message("some theta parameters on the boundary, restarting") opt <- optwrap(optimizer, devfun, opt$par, lower=lower, upper=upper, control=control, adj=FALSE, verbose=verbose, ...) } } ## bgrad not NA } } ## if restart.edge if (boundary.tol > 0) check.boundary(rho, opt, devfun, boundary.tol) else opt } ##' @rdname modular ##' @inheritParams glmer ##' @export glFormula <- function(formula, data=NULL, family = gaussian, subset, weights, na.action, offset, contrasts = NULL, start, mustart, etastart, control = glmerControl(), ...) { control <- control$checkControl ## this is all we really need mc <- match.call() ## extract family, call lmer for gaussian if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame(2)) if (is.function(family)) family <- family() if (isTRUE(all.equal(family, gaussian()))) { mc[[1]] <- quote(lme4::lFormula) mc["family"] <- NULL # to avoid an infinite loop return(eval(mc, parent.frame())) } if (family$family %in% c("quasibinomial", "quasipoisson", "quasi")) stop('"quasi" families cannot be used in glmer') dontChk <- c("verbose", "devFunOnly", "optimizer", "nAGQ") dots <- list(...) do.call(checkArgs, c(list("glmer"), dots[!names(dots) %in% dontChk])) ## FIXME: adjust test for families with estimated scale parameter: ## useSc is not defined yet/not defined properly? ## if (useSc && maxlevels == n) ## stop("number of levels of each grouping factor must be", ## "greater than number of obs") ## TODO: allow.n = !useSc res <- mkFormula(formula, mc, data, contrasts, control, isGLMM = TRUE, allow.n = TRUE, check_zero_rows = FALSE, check_na_Zt = FALSE, set_varnames_fixed = FALSE, parent_env = parent.frame()) ## attach starting coefficients to model frame so we can ## pass them through to mkRespMod -> family()$initialize ... if (!missing(start) && is.list(start)) { fixef <- start$fixef %||% start$beta attr(res$fr, "start") <- fixef } c(res, list(family = family)) } ##' @rdname modular ##' @export mkGlmerDevfun <- function(fr, X, reTrms, family, nAGQ = if (control$nAGQ0initStep) 0L else 1L, verbose = 0L, maxit = 100L, control = glmerControl(), ...) { stopifnot(length(nAGQ <- as.integer(nAGQ)) == 1L, 0L <= nAGQ, nAGQ <= 100L) verbose <- as.integer(verbose) maxit <- as.integer(maxit) rho <- list2env(list(verbose=verbose, maxit=maxit, tolPwrss= control$tolPwrss, compDev = control$compDev), parent = parent.frame()) rho$pp <- do.call(merPredD$new, c(reTrms[c("Zt","theta","Lambdat","Lind")], n=nrow(X), list(X=X))) rho$resp <- if (missing(fr)) mkRespMod(family=family, ...) else mkRespMod(fr, family=family) rho$mkPar <- mkMkPar(reTrms$reCovs) rho$mkTheta <- mkMkTheta(reTrms$reCovs) ## allow trivial y if (length(y <- rho$resp$y) > 0) { checkResponse(y, control$checkControl) rho$verbose <- as.integer(verbose) ## initialize (from mustart) .Call(glmerLaplace, rho$pp$ptr(), rho$resp$ptr(), nAGQ > 0L, control$tolPwrss, maxit, verbose) rho$lp0 <- rho$pp$linPred(1) # each pwrss opt begins at this eta rho$pwrssUpdate <- glmerPwrssUpdate } devfun <- mkdevfun(rho, 0L, maxit=maxit, verbose=verbose, control=control) if (nAGQ > 0L) updateGlmerDevfun(devfun, reTrms, nAGQ = nAGQ) else { rho$nAGQ <- 0L rho$lower <- reTrms$lower rho$upper <- reTrms$upper %||% rep(Inf, length(reTrms$lower)) devfun } } ##' @rdname modular ##' @param nAGQ number of Gauss-Hermite quadrature points ##' @param stage optimization stage (1: nAGQ=0, optimize over theta only; 2: nAGQ possibly >0, optimize over theta and beta) ##' @export optimizeGlmer <- function(devfun, optimizer = if (nAGQ > 0L) "Nelder_Mead" else "bobyqa", restart_edge=FALSE, boundary.tol = formals(glmerControl)$boundary.tol, verbose = 0L, control = list(), nAGQ = if (missing(stage) || stage == 1L) 0L else 1L, stage, start = NULL, ...) { ## FIXME: deprecate 'stage' ... ? if (!missing(stage) && (nAGQ > 0L) != (stage != 1L)) stop(gettextf("incompatible '%s' and '%s'", "nAGQ", "stage"), domain = NA) verbose <- as.integer(verbose) rho <- environment(devfun) start <- getStart(start, rho, nAGQ) lower <- rho$lower upper <- rho$upper %||% rep(Inf, length(rho$lower)) opt <- optwrap(optimizer, devfun, start, lower=lower, upper=upper, control=control, adj=nAGQ > 0L, verbose=verbose, ...) if (nAGQ > 0L) rho$resp$setOffset(rho$baseOffset) if (restart_edge) ## FIXME: implement this ... stop("restart_edge not implemented for optimizeGlmer yet") if (boundary.tol > 0) { opt <- check.boundary(rho, opt, devfun, boundary.tol) if (nAGQ > 0L) rho$resp$setOffset(rho$baseOffset) } opt } check.boundary <- function(rho,opt,devfun,boundary.tol) { par0 <- opt$par lower <- rho$lower upper <- rho$upper %||% rep(Inf, length(rho$lower)) dl <- par0 - lower du <- upper - par0 if (!is.null(rho$dpars)) { dl <- dl[rho$dpars] du <- du[rho$dpars] } if (length(wl <- which(0 < dl & dl < boundary.tol)) > 0L | length(wu <- which(0 < du & du < boundary.tol)) > 0L) { ## try sucessive "close-to-edge parameters" to see ## if we can improve by setting them equal to the boundary for (i in wl) { par <- par0 par[i] <- lower[i] if (devfun(par) < opt$fval) par0[i] <- par[i] } for (i in wu) { par <- par0 par[i] <- upper[i] if (devfun(par) < opt$fval) par0[i] <- par[i] } opt$par <- par0 opt$fval <- devfun(par0) ## re-run to reset (whether successful or not) ## FIXME: derivatives, Hessian etc. (and any other ## opt messages) *not* recomputed } return(opt) } ## only do this function if nAGQ > 0L ##' @rdname modular ##' @export updateGlmerDevfun <- function(devfun, reTrms, nAGQ = 1L){ stopifnot(length(nAGQ <- as.integer(nAGQ)) == 1L, 0L <= nAGQ, nAGQ <= 100L) if (nAGQ > 1L) { if (length(reTrms$flist) != 1L || length(reTrms$cnms[[1]]) != 1L) stop("nAGQ > 1 is only available for models with a single, scalar random-effects term") } rho <- environment(devfun) rho$nAGQ <- nAGQ rho$lower <- c(reTrms$lower, rep(-Inf, length(rho$pp$beta0))) rho$upper <- c(reTrms$upper %||% rep(Inf, length(reTrms$lower)), rep( Inf, length(rho$pp$beta0))) rho$lp0 <- rho$pp$linPred(1) rho$dpars <- seq_along(reTrms$lower) rho$baseOffset <- forceCopy(rho$resp$offset) # forcing a copy (!) rho$GQmat <- GHrule(nAGQ) rho$fac <- reTrms$flist[[1]] mkdevfun(rho, nAGQ) # does this attach rho to devfun?? } lme4/R/vcconv.R0000644000176200001440000001715715134016345012752 0ustar liggesusers## These files are not currently exported; we are still trying to figure ## out the most appropriate user interface/naming convention/etc ## These functions will become more important, and need to be ## modified/augmented, if we start allowing for varying V-C structures ## (e.g. diagonal matrices, compound symmetry ...) ## In principle we might want to extract or input information: ## 1. as variance-covariance matrices ## 2. as Cholesky factors ## 3. as 'sdcorr' matrices (std dev on diagonal, correlations off diagonal) ## and we might want the structure to be: ## 1. a concatenated vector representing the lower triangles ## (with an attribute carrying the information about group sizes) ## 2. a list of lower-triangle vectors ## 3. a list of matrices ## 4. a block-diagonal matrix ## If we are trying to convert to and from theta vectors, we also ## have to consider whether we are returning scaled Cholesky factors/ ## var-cov matrices or unscaled ones. For the code below I have ## chosen to allow the residual variance etc. to be appended as ## the last element of a variance-covariance vector. (This last ## part is a little less generic than the rest of it.) ##' List of matrices to concatenated vector ##' ##' Convert list of matrices to concatenated vector of lower triangles ##' with an attribute that gives the dimension of each matrix in the ##' original list. This attribute may be used to reconstruct the ##' matrices. ##' ##' @param L list of symmetric, upper-triangular, or lower-triangular ##' square matrices ##' @return A concatenation of the elements in one triangle of each ##' matrix. An attribute \code{"clen"} gives the dimension of each ##' matrix. mlist2vec <- function(L) { if(is.atomic(L)) L <- list(L) n <- vapply(L, nrow, 1L) ## allow for EITHER upper- or lower-triangular input; ## in either case, read off in "lower-triangular" order ## (column-wise) ff <- function(x) { if (all(na.omit(x[iu <- upper.tri(x)] == 0))) t(x[!iu]) else t(x)[!iu] } structure(unlist(lapply(L,ff)), clen = n) } ## Compute dimensions of a square matrix from the size ## of the lower triangle (length as a vector) get_clen <- function(v,n=NULL) { if (is.null(n)) { if (is.null(n <- attr(v,"clen"))) { ## single component n <- (sqrt(8*length(v)+1)-1)/2 } } n } ##' Concatenated vector to list of matrices ##' ##' Convert concatenated vector to list of matrices (lower triangle or ##' symmetric). These matrices could represent Cholesky factors, ##' covariance matrices, or correlation matrices (with standard ##' deviations on the diagonal). ##' ##' @param v concatenated vector ##' @param n FIXME: this has something to do with the dimension of ##' associated matrices. ##' @param symm Return symmetric matrix if \code{TRUE} or ##' lower-triangular if \code{FALSE} ##' @return List of matrices vec2mlist <- function(v,n=NULL,symm=TRUE) { n <- get_clen(v,n) s <- split(v,rep.int(seq_along(n),n*(n+1)/2)) m <- mapply(function(x,n0) { m0 <- diag(nrow=n0) m0[lower.tri(m0,diag=TRUE)] <- x if (symm) m0[upper.tri(m0)] <- t(m0)[upper.tri(m0)] m0 },s,n,SIMPLIFY=FALSE) m } ## Convert concatenated vector to list of ST matrices vec2STlist <- function(v, n = NULL){ ch <- vec2mlist(v, n, FALSE) # cholesky sdiag <- function(x) { ## 'safe' diag() if (length(x)==1) matrix(x,1,1) else diag(x) } lapply(ch, function(L) { ST <- L%*%sdiag(1/sdiag(L)) diag(ST) <- diag(L) ST }) } ##' Standard deviation-correlation matrix to covariance matrix ##' ##' convert 'sdcor' format -- diagonal = std dev, off-diag=cor to and ##' from variance-covariance matrix ##' ##' @param m Standard deviation-correlation matrix ##' @return Covariance matrix sdcor2cov <- function(m) { sd <- diag(m) diag(m) <- 1 m * outer(sd,sd) } ##' Covariance matrix to standard deviation-correlation matrix ##' ##' convert cov to sdcor ##' ##' @param V Covariance matrix ##' @return Standard deviation-correlation matrix cov2sdcor <- function(V) { ## "own version" of cov2cor(): 1. no warning for NA; 2. diagonal = sd(.) p <- (d <- dim(V))[1L] if (!is.numeric(V) || length(d) != 2L || p != d[2L]) stop("'V' is not a square numeric matrix") sd <- sqrt(diag(V)) Is <- 1/sd r <- V r[] <- Is * V * rep(Is, each = p) diag(r) <- sd if (any(is.na(r))) { warning("NA values in sdcor matrix converted to 0") r[is.na(r)] <- 0 } r } ## dmult <- function(m,s) { ## diag(m) <- diag(m)*s ## m ## } ## attempt to compute Cholesky, allow for positive semi-definite cases ## (hackish) safe_chol <- function(m) { if (any(is.na(m)) || all(m==0)) return(m) if (nrow(m)==1) return(sqrt(m)) if (.isDiagonal.sq.matrix(m)) return(diag(sqrt(diag(m)))) ## attempt regular Chol. decomp if (!is.null(cc <- tryCatch(chol(m), error=function(e) NULL))) return(cc) ## ... pivot if necessary ... cc <- suppressWarnings(chol(m,pivot=TRUE)) oo <- order(attr(cc,"pivot")) cc[,oo] ## FIXME: pivot is here to deal with semidefinite cases, ## but results might be returned in a strange format: TEST } ##' Variance-covariance to relative covariance factor ##' ##' from var-cov to scaled Cholesky: ##' ##' @param v Vector of elements from the lower triangle of a ##' variance-covariance matrix. ##' @param n FIXME: see "@param n" above ##' @param s Scale parameter ##' @return Vector of elements from the lower triangle of a relative ##' covariance factor. Vv_to_Cv <- function(v,n=NULL,s=1) { if (!missing(s)) { v <- v[-length(v)] } r <- mlist2vec(lapply(vec2mlist(v,n,symm=TRUE), function(m) t(safe_chol(m/s^2)))) attr(r,"clen") <- get_clen(v,n) r } ##' Standard-deviation-correlation to relative covariance factor ##' ##' from sd-cor to scaled Cholesky ##' ##' @param v Vector of elements from the lower triangle of a ##' standard-deviation-correlation matrix. ##' @param n FIXME: see "@param n" above ##' @param s Scale parameter ##' @return Vector of elements from the lower triangle of a relative ##' covariance factor. Sv_to_Cv <- function(v,n=NULL,s=1) { if (!missing(s)) { v <- v[-length(v)] } r <- mlist2vec(lapply(vec2mlist(v,n,symm=TRUE), function(m) t(safe_chol(sdcor2cov(m)/s^2)))) attr(r,"clen") <- get_clen(v,n) r } ##' Relative covariance factor to variance-covariance ##' ##' from unscaled Cholesky vector to (possibly scaled) ##' variance-covariance vector ##' ##' @param v Vector of elements from the lower triangle of a ##' relative covariance factor. ##' @param n FIXME: see "@param n" above ##' @param s Scale parameter ##' @return Vector of elements from the lower triangle of a ##' variance-covariance matrix. Cv_to_Vv <- function(v,n=NULL,s=1) { r <- mlist2vec(lapply(vec2mlist(v,n,symm=FALSE), function(m) tcrossprod(m)*s^2)) if (!missing(s)) r <- c(r,s^2) attr(r,"clen") <- get_clen(v,n) r } ##' Relative covariance factor to standard-deviation-correlation ##' ##' from unscaled Chol to sd-cor vector ##' ##' @param v Vector of elements from the lower triangle of a ##' relative covariance factor. ##' @param n FIXME: see "@param n" above ##' @param s Scale parameter ##' @return Vector of elements from the lower triangle of a ##' standard-deviation-correlation matrix. Cv_to_Sv <- function(v,n=NULL,s=1) { r <- mlist2vec(lapply(vec2mlist(v,n,symm=FALSE), function(m) cov2sdcor(tcrossprod(m)*s^2))) if (!missing(s)) r <- c(r,s) attr(r,"clen") <- get_clen(v,n) r } ## tests --> ../inst/tests/test-utils.R lme4/R/AllGeneric.R0000644000176200001440000000412115036542626013453 0ustar liggesusers## utilities, these *exported*: ##' @export getL setGeneric("getL", function(x) standardGeneric("getL")) fixed.effects <- function(object, ...) { ## fixed.effects was an alternative name for fixef .Deprecated("fixef") mCall = match.call() mCall[[1]] = as.name("fixef") eval(mCall, parent.frame()) } random.effects <- function(object, ...) { ## random.effects was an alternative name for ranef .Deprecated("ranef") mCall = match.call() mCall[[1]] = as.name("ranef") eval(mCall, parent.frame()) } ## Create a Markov chain Monte Carlo sample from the posterior ## distribution of the parameters ## ## ## @title Create an MCMC sample ## @param object a fitted model object ## @param n number of samples to generate. Defaults to 1; for real use values of 200-1000 are more typical ## @param verbose should verbose output be given? ## @param ... additional, optional arguments (not used) ## @return a Markov chain Monte Carlo sample as a matrix mcmcsamp <- function(object, n = 1L, verbose = FALSE, ...) UseMethod("mcmcsamp") if(getRversion() < "3.3") { sigma <- function(object, ...) UseMethod("sigma") } isREML <- function(x, ...) UseMethod("isREML") isLMM <- function(x, ...) UseMethod("isLMM") isGLMM <- function(x, ...) UseMethod("isGLMM") isNLMM <- function(x, ...) UseMethod("isNLMM") ##' Refit a model using the maximum likelihood criterion ##' ##' This function is primarily used to get a maximum likelihood fit of ##' a linear mixed-effects model for an \code{\link{anova}} comparison. ##' ##' @title Refit a model by maximum likelihood criterion ##' @param x a fitted model, usually of class \code{"\linkS4class{lmerMod}"}, ##' to be refit according to the maximum likelihood criterion ##' @param ... optional additional parameters. None are used at present. ##' @return an object like \code{x} but fit by maximum likelihood ##' @export refitML <- function(x, ...) UseMethod("refitML") refit <- function(object, newresp, ...) UseMethod("refit") if (FALSE) { setGeneric("HPDinterval", function(object, prob = 0.95, ...) standardGeneric("HPDinterval")) } lme4/R/predict.R0000644000176200001440000013525515225714450013111 0ustar liggesusers##' test for no-random-effect specification: TRUE if NA or ~0, other ##' possibilities are NULL or a non-trivial formula isRE <- function(re.form) { isForm <- inherits(re.form, "formula") (is.null(re.form) || isForm || !is.na(re.form)) && (!isForm || length(re.form) != 2L || !identical(re.form[[2L]], 0)) } if(FALSE) { isRE(NA) ## FALSE isRE(~0) ## " isRE(~y+x) ## TRUE isRE(NULL) ## " isRE(~0+x) ## " } ## for now, copied from reformulas: ## 'specials'/'default.special' need to be passed through, ## can't be easily hacked safe_length <- function(x) length(unclass(x)) my_reOnly <- function(f, response=FALSE, bracket=TRUE, doublevert_split = TRUE, specials=character(0), default.special = NULL) { ee <- environment(f) flen <- safe_length(f) f2 <- f[[2]] if (bracket) { xdv <- if (doublevert_split) "split" else "diag_special" fb <- findbars_x(f, expand_doublevert_method = xdv, specials = specials, default.special = default.special) f <- lapply(fb, reformulas::makeOp, quote(`(`)) ## bracket-protect terms } f <- reformulas::sumTerms(f) if (response && flen==3) { form <- reformulas::makeOp(f2, f, quote(`~`)) } else { form <- reformulas::makeOp(f, quote(`~`)) } ## form may be a 'language' object by now ... form <- as.formula(form) environment(form) <- ee return(form) } ##' Random Effects formula only ##' wrapper for reformulas (next version should handle environment protection properly ... ##' lme4_reOnly <- function(form, ...) { my_reOnly(form, ..., specials = lme4_specials, doublevert_split = (getDoublevertDefault()=="split")) } ## '...' may contain fixed.only=TRUE, random.only=TRUE, .. get.orig.levs <- function(object, FUN=levels, newdata=NULL, sparse = FALSE, ...) { Terms <- terms(object, data = newdata, ...) mf <- model.frame(object, ...) isFac <- vapply(mf, is.factor, FUN.VALUE=TRUE) ## ignore response variable isFac[attr(Terms,"response")] <- FALSE mf <- mf[isFac] hasSparse <- any(grepl("sparse", names(formals(FUN)))) # check if FUN has sparse argument orig_levs <- if (any(isFac) && hasSparse) lapply(mf, FUN, sparse = sparse) else if(any(isFac) && !hasSparse) lapply(mf, FUN) # else NULL ## if necessary (allow.new.levels ...) add in new levels if (!is.null(newdata)) { for (n in names(mf)) { orig_levs[[n]] <- c(orig_levs[[n]], setdiff(unique(as.character(newdata[[n]])),orig_levs[[n]])) } } ## more clues about factor-ness of terms if(!is.null(orig_levs)) attr(orig_levs,"isFac") <- isFac orig_levs } ##' Force new parameters into a merMod object ##' (should this be an S3 method?): params(object) <- newvalue ##' @param object ##' @param params a list of the form specified by \code{start} in ##' \code{\link{lmer}} or \code{\link{glmer}} (i.e. a list containing ##' theta and/or beta; maybe eventually further parameters ... ##' What updating do we have to do in order to make the resulting object ##' consistent/safe? ##' TODO: What kind of checking of input do we have to do? (Abstract from ##' lmer/glmer code ...) ##' TODO: make sure this gets updated when the parameter structure changes ##' from (theta, beta) to alpha=(theta, beta, phi) ##' @param inplace logical specifying if object should be modified in place; not yet ##' @param subset logical; needs to be true, if only parts of params are to be reset ##' @param requireSigma logical; if TRUE, error if \code{object} has an ##' estimated scale/dispersion parameter and \code{params$sigma} is not ##' specified, rather than silently retaining \code{object}'s existing ##' sigma. Used for "de novo" simulation from a formula (where there is no ##' meaningful existing sigma to fall back on); left \code{FALSE} for ##' \code{predict()}/\code{simulate()} on an already-fitted object, where ##' silently keeping the existing sigma is the correct (and relied-upon, ##' e.g. by \pkg{glmertree}'s internal backfitting) behavior. ##' @examples ##' fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy) ##' fm1M <- setParams(fm1,list(theta=rep(1,3))) ##' getME(fm1M,"theta") ##' getME(fm1,"theta") ## check that original didn't get messed up ##' ## check that @resp and @pp are the only reference class slots ... ##' sapply(slotNames(fm1),function(x) class(slot(fm1,x))) setParams <- function(object, params, inplace=FALSE, subset=FALSE, requireSigma=FALSE) { pNames <- c("beta", "theta", "par") if (object@devcomp$dims[["useSc"]]) { pNames <- c(pNames, "sigma") if (requireSigma && is.null(params$sigma)) { stop("must specify sigma when using a family with an estimated scale/dispersion parameter") } } if (!is.list(params) || length(setdiff(names(params), pNames)) > 0) stop("params should be specifed as a list with elements from ", "{",paste(shQuote(pNames),collapse=", "),"}") if (!subset && (is.null(params$beta) || (is.null(params$theta) && is.null(params$par)))) { warning("some parameters not specified in setParams()") } nbeta <- length(object@pp$beta(1)) ntheta <- length(object@pp$theta) npar <- getParLength(object) lengthTestFun <- function(nm, expected_len) { x <- params[[nm]] if (!is.null(x) && length(x) != expected_len) { stop(sprintf("length mismatch in %s (%d != %d)", nm, length(x), expected_len)) } return(x) } beta <- lengthTestFun("beta", nbeta) if (!is.null(params$theta) && !is.null(params$par)) { stop("should specify exactly one of 'theta' and 'par'") } theta <- lengthTestFun("theta", ntheta) par <- lengthTestFun("par", npar) matchNames <- function(x,tn,vecname="theta") { if (!is.null(pn <- names(x))) { if (!setequal(pn,tn)) { ## pn.not.tn <- setdiff(pn,tn) ## tn.not.pn <- setdiff(tn,pn) ## TO DO: more detail? stop("mismatch between ",shQuote(vecname)," parameter vector names and internal names (", paste(tn,collapse=","),")") } x <- x[tn] ## reorder } ## no longer issue warning if unnamed ... return(x) } theta <- matchNames(theta, getThetaNames(object), "theta") beta <- matchNames(beta,colnames(getME(object,"X")),"beta") sigma <- params$sigma if(inplace) { stop("modification in place (copy=FALSE) not yet implemented") } else { ## copy : newObj <- object ## make a copy of the reference class slots to ## decouple them from the original object newObj@pp <- newObj@pp$copy() newObj@resp <- newObj@resp$copy() if (!is.null(beta)) { newObj@pp$setBeta0(beta) newObj@beta <- beta } if (!is.null(par)) { ## replace NULL theta with computed values theta <- mkMkTheta(getReCovs(object))(par) } if (!is.null(theta)) { ## where does theta live and how do I set it? ## (1) in .@theta ## (2) in .@pp$theta newObj@theta <- theta newObj@pp$setTheta(theta) } if (!is.null(sigma)) { snm <- if (object@devcomp$dims[["REML"]]) "sigmaREML" else "sigmaML" newObj@devcomp[["cmp"]][snm] <- sigma } return(newObj) } } ##' Make new random effect terms from specified object and new data, ##' possibly omitting some random effect terms ##' @param object fitted model object ##' @param newdata (optional) data frame containing new data ##' @param re.form formula specifying random effect terms to include (NULL=all, ~0) ##' @param na.action ##' ##' @note Hidden; _only_ used (twice) in this file mkNewReTrms <- function(object, newdata, re.form=NULL, na.action=na.pass, allow.new.levels=FALSE, sparse = max(lengths(orig.random.levs)) > 100) { ## construct (fixed) model frame in order to find out whether there are ## missing data/what to do about them ## need rfd to inherit appropriate na.action; need grouping ## variables as well as any covariates that are included ## in RE terms ## FIXME: mfnew is new data frame, rfd is processed new data ## why do we need both/what is each doing/how do they differ? ## rfd is *only* used in mkReTrms ## mfnew is *only* used for its na.action attribute (!) [fixed only] ## using model.frame would mess up matrix-valued predictors (GH #201) fixed.na.action <- NULL re.form <- re.form %||% lme4_reOnly(formula(object)) if (is.null(newdata)) { rfd <- mfnew <- model.frame(object) fixed.na.action <- attr(mfnew,"na.action") } else { if (!identical(na.action,na.pass)) { ## only need to re-evaluate for NAs if na.action != na.pass ## drop 1-col matrix columns (e.g. from scale()) before calling model.frame(): ## poly() with pre-specified coefs (stored in predvars) rejects matrix input ## even though it accepted it during initial fitting (GH#948) newdata_mf <- newdata newdata_mf[] <- lapply(newdata_mf, drop) mfnew <- model.frame(delete.response(terms(object, fixed.only=TRUE)), newdata_mf, na.action=na.action) fixed.na.action <- attr(mfnew,"na.action") } ## make sure we pass na.action with new data ## it would be nice to do something more principled like ## rfd <- model.frame(~.,newdata,na.action=na.action) ## but this adds complexities (stored terms, formula, etc.) ## that mess things up later on ... ## rfd <- na.action(get_all_vars(delete.response(terms(object,fixed.only=FALSE)), newdata)) newdata.NA <- newdata if (!is.null(fixed.na.action)) { newdata.NA <- newdata.NA[-fixed.na.action,] } tt <- delete.response(terms(object, random.only=TRUE)) orig.random.levs <- get.orig.levs(object, random.only=TRUE, newdata=newdata.NA) orig.random.cntr <- get.orig.levs(object, random.only=TRUE, FUN=contrasts, sparse=sparse) ## need to let NAs in RE components go through -- they're handled downstream if (inherits(re.form,"formula")) { ## We use the RE terms *from the original model fit* to construct ## the model frame. This is good for preserving predvars information, ## getting interactions constructed correctly, etc etc etc, ## but can fail if a partial RE specification is used and some of the variables ## in the original RE form are missing from 'newdata' ... ## Fill them in as necessary. Filling in NA is OK - these vars won't actually ## be used later ... pv <- attr(tt,"predvars") for (i in 2:(length(pv))) { missvars <- setdiff(all.vars(pv[[i]]), all.vars(re.form)) for (mv in missvars) { newdata.NA[[mv]] <- NA } } } ## see comments about why suppressWarnings() is needed below ... rfd <- suppressWarnings( model.frame(tt, newdata.NA, na.action=na.pass, xlev=orig.random.levs)) ## restore contrasts (why???) ## find *factor* variables involved in terms (left-hand side of RE formula): reset their contrasts ## only interested in components in re.form, not al REs ff <- re.form ## was: formula(object,random.only=TRUE) termvars <- unique(unlist(lapply(reformulas::findbars(ff), function(x) all.vars(x[[2]])))) for (fn in Reduce(intersect, list( names(orig.random.cntr), termvars, names(rfd)))) { ## a non-factor grouping variable *may* sneak in here via simulate(...) if (!is.factor(rfd[[fn]])) rfd[[fn]] <- factor(rfd[[fn]]) contrasts(rfd[[fn]]) <- orig.random.cntr[[fn]] } if (!is.null(fixed.na.action)) attr(rfd,"na.action") <- fixed.na.action ## ## ## need terms to preserve info about spline/orthog polynomial bases ## attr(rfd,"terms") <- terms(object) ## ## ... but variables list messes things up; can we fix it? ## vlist <- lapply(all.vars(terms(object)), as.name) ## attr(attr(rfd,"terms"),"variables") <- as.call(c(quote(list), vlist)) ## ## take out variables that appear *only* in fixed effects ## all.v <- all.vars(delete.response(terms(object,fixed.only=FALSE))) ## ran.v <- vapply(findbars(formula(object)),all.vars,"") ## fix.v <- all.vars(delete.response(terms(object,fixed.only=TRUE))) ## rfd <- model.frame(delete.response(terms(object,fixed.only=FALSE)), ## newdata,na.action=na.action) } if (inherits(re.form, "formula")) { ## DROP values with NAs in fixed effects if (length(fixed.na.action) > 0) { newdata <- newdata[-fixed.na.action,] } ## note: mkReTrms automatically *drops* unused levels bb1 <- findbars_x(re.form, specials = lme4_specials, default.special = "us", target = "|", expand_doublevert_method = getDoublevertDefault()) bb0 <- lapply(bb1, `[[`, 2L) reTrms <- reformulas::mkReTrms(bb0, rfd, calc.lambdat = FALSE) bb1 <- bb1[reTrms$ord] # reorder to match mkReTrms internal ordering reTrms <- upReTrms(reTrms, bb1) # local calc.lambdat=TRUE step ## ReTrms <- reformulas::mkReTrms(reformulas::findbars(re.form[[2]]), rfd) ## update Lambdat (ugh, better way to do this?) reTrms <- within(reTrms,Lambdat@x <- unname(getME(object,"theta")[Lind])) if (!allow.new.levels && any(vapply(reTrms$flist, anyNA, NA))) stop("NAs are not allowed in prediction data", " for grouping variables unless allow.new.levels is TRUE") ns.re <- names(re <- ranef(object, condVar = FALSE)) nRnms <- names(Rcnms <- reTrms$cnms) if (!all(nRnms %in% ns.re)) stop("grouping factors specified in re.form that were not present in original model") new_levels <- lapply(reTrms$flist, function(x) levels(factor(x))) ## fill in/delete levels as appropriate re_x <- Map(function(r,n) levelfun(r,n, allow.new.levels=allow.new.levels), re[names(new_levels)], new_levels) ## pick out random effects values that correspond to ## random effects incorporated in re.form ... ## NB: Need integer indexing, as nRnms can be duplicated: (age|Subj) + (sex|Subj) : hacked_names <- FALSE get_re <- function(rname, cnms) { nms <- names(re[[rname]]) if (identical(cnms,"(Intercept)") && length(nms)==1 && grepl("^s(.*)$",nms)) { ## HACK to allow gamm4 prediction hacked_names <<- TRUE cnms <- nms } miss_names <- setdiff(cnms, nms) if (length(miss_names)>0) { stop("random effects specified in re.form that were not present in original model ", paste(miss_names, collapse=", ")) } t(re_x[[rname]][,cnms]) ## transpose to make sure unlisting works } re_new <- unlist(Map(get_re, nRnms, Rcnms)) ## only issue warning once per prediction ... if (hacked_names) warning("modified RE names for gamm4 prediction") } Zt <- reTrms$Zt attr(Zt, "na.action") <- attr(re_new, "na.action") <- fixed.na.action list(Zt=Zt, b=re_new, Lambdat = reTrms$Lambdat, flist = reTrms$flist) } ##' @param x a random effect (i.e., data frame with rows equal to levels, columns equal to terms ##' @param n vector of new levels levelfun <- function(x, nl.n, allow.new.levels=FALSE) { ## 1. find and deal with new levels new.levels <- setdiff(nl.n, rownames(x)) if (length(new.levels)>0) { if (!allow.new.levels) { max.err.len <- 60 err.str <- paste(new.levels, collapse = ", ") if (nchar(err.str) > max.err.len) { err.str <- substr(err.str, 1, max.err.len) err.str <- gsub(",[^,]*$", ", ...", err.str) } stop("new levels detected in newdata: ", err.str) } ## create an all-zero data frame corresponding to the new set of levels ... nl.n.comb <- union(nl.n, rownames(x)) newx <- as.data.frame(matrix(0, nrow=length(nl.n.comb), ncol=ncol(x), dimnames=list(nl.n.comb, names(x)))) ## then paste in the matching RE values from the original fit/set of levels newx[rownames(x),] <- x x <- newx } ## 2. find and deal with missing old levels ## ... these should have been dropped when making the Z matrices ## etc. in mkReTrms, so we'd better drop them here to match ... if (!all(r.inn <- rownames(x) %in% nl.n)) { x <- x[r.inn,,drop=FALSE] } return(x) } ##' ##' \code{\link{predict}} method for \code{\linkS4class{merMod}} objects ##' ##' @title Predictions from a model at new data values ##' @param object a fitted model object ##' @param newdata data frame for which to evaluate predictions ##' @param newparams new parameters to use in evaluating predictions ##' @param re.form formula for random effects to condition on. If \code{NULL}, ##' include all random effects; if \code{NA} or \code{~0}, ##' include no random effects ##' @param terms a \code{\link{terms}} object - not used at present ##' @param type character string - either \code{"link"}, the default, ##' or \code{"response"} indicating the type of prediction object returned ##' @param allow.new.levels (logical) if FALSE (default), then any new levels ##' (or NA values) detected in \code{newdata} will trigger an error; if TRUE, then ##' the prediction will use the unconditional (population-level) ##' values for data with previously unobserved levels (or \code{NA}s) ##' @param na.action function determining what should be done with missing values for fixed effects in \code{newdata}. The default is to predict \code{NA}: see \code{\link{na.pass}}. ##' @param se.fit A logical value indicating whether the standard errors should be included or not. Default is FALSE. ##' @param ... optional additional parameters. None are used at present. ##' @return a numeric vector of predicted values, unless \code{se.fit=TRUE} (in which case a list with elements \code{fit} (predicted values) and \code{se.fit} is returned) ##' @note There is no option for computing standard errors of predictions because it is difficult to define an efficient method that incorporates uncertainty in the variance parameters; we recommend \code{\link{bootMer}} for this task. ##' @examples ##' (gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 |herd), cbpp, binomial)) ##' str(p0 <- predict(gm1)) # fitted values ##' str(p1 <- predict(gm1,re.form=NA)) # fitted values, unconditional (level-0) ##' newdata <- with(cbpp, expand.grid(period=unique(period), herd=unique(herd))) ##' str(p2 <- predict(gm1,newdata)) # new data, all RE ##' str(p3 <- predict(gm1,newdata,re.form=NA)) # new data, level-0 ##' str(p4 <- predict(gm1,newdata,re.form=~(1|herd))) # explicitly specify RE ##' @method predict merMod ##' @export predict.merMod <- function(object, newdata=NULL, newparams=NULL, re.form=NULL, random.only=FALSE, terms=NULL, type=c("link","response"), allow.new.levels=FALSE, na.action=na.pass, se.fit = FALSE, ...) { ## FIXME: appropriate names for result vector? ## FIXME: make sure behaviour is entirely well-defined for NA in grouping factors ## Dealing with NAs: ## we might need to distinguish among ## (i) NAs in original data and in new data ## (ii) na.action possibilities (exclude, fail, omit, pass) ## (iii) na.action setting in original fit and in predict() ## (iii) NAs in (fixed effect) predictors vs RE grouping variables ## (iv) setting of allow.new.level ## NAs in original data (in the fixed or random effects) ## may lead to a model frame within the ## fitted object that is missing rows; if na.exclude was used, ## these will need to be reconstituted in the prediction. ## ## For the most part, 'na.action's used at the predict stage ## (i.e. for newdata) will work on NAs *in the fixed effects* ## without further intervention; 'na.pass' will automatically ## produce NA values in the output, so 'na.exclude' is not really ## necessary (but might get specified anyway) ## ## In the random effects, NAs in newdata will give a population-level ## prediction if allow.new.levels is TRUE; if it's FALSE they give ## an error (although it could be argued that in that case they ## should follow 'na.action' instead ...) if (any(...names() %in% c("ReForm", "REForm", "REform"))) stop("synonyms 'ReForm', 'REForm', 'REform' are deprecated: please use 're.form' instead") if (...length() > 0) warning("unused arguments ignored") type <- match.arg(type) if (!is.null(terms)) stop("terms functionality for predict not yet implemented") if (!is.null(newparams)) object <- setParams(object,newparams) if (is.null(newdata) && is.null(re.form) && is.null(newparams) && !random.only) { ## raw predict() call, just return fitted values ## (inverse-link if appropriate) if (isLMM(object) || isNLMM(object)) { ## make sure we do *NOT* have NAs in fitted object pred <- na.omit(fitted(object)) } else { ## inverse-link pred <- switch(type,response=object@resp$mu, ## == fitted(object), link=object@resp$eta) eta <- object@resp$eta if (is.null(nm <- rownames(model.frame(object)))) nm <- seq_along(pred) names(pred) <- nm } fit.na.action <- NULL ## flow jumps to end for na.predict } else { ## newdata and/or re.form and/or newparams and/or random.only specified fit.na.action <- attr(object@frame,"na.action") ## original NA action nobs <- if (is.null(newdata)) nrow(object@frame) else nrow(newdata) pred <- rep(0,nobs) if (!random.only) { X <- getME(object, "X") X.col.dropped <- attr(X, "col.dropped") ## modified from predict.glm ... if (is.null(newdata)) { ## Use original model 'X' matrix and offset ## orig. offset: will be zero if there are no matches ... offset <- model.offset(model.frame(object)) if (is.null(offset)) offset <- 0 } else { ## new data specified ## evaluate new fixed effect RHS <- formula(substitute(~R, list(R=RHSForm(formula(object,fixed.only=TRUE))))) ## https://github.com/lme4/lme4/issues/414 ## contrasts are not relevant in random effects; ## model.frame.default warns about dropping contrasts ## if (1) xlev is specified and (2) any factors in ## original data frame had contrasts set ## alternative solution: drop contrasts manually ## (could assign to a new variable newdata2 for safety, ## but I don't think newdata ## is used downstream in this function?) ## isFacND <- which(vapply(newdata, is.factor, FUN.VALUE = TRUE)) ## for (j in isFacND) { ## attr(newdata[[j]], "contrasts") <- NULL ## } orig.fixed.levs <- get.orig.levs(object, fixed.only=TRUE, newdata = newdata) mfnew <- suppressWarnings( model.frame(delete.response(terms(object, fixed.only=TRUE, data = newdata)), newdata, na.action = na.action, xlev = orig.fixed.levs)) X <- model.matrix(RHS, data=mfnew, contrasts.arg=attr(X,"contrasts")) ## hack to remove unused interaction levels? ## X <- X[,colnames(X0)] offset <- 0 # rep(0, nrow(X)) tt <- terms(object, data = newdata) if (!is.null(off.num <- attr(tt, "offset"))) { for (i in off.num) offset <- offset + eval(attr(tt,"variables")[[i + 1]], newdata) } ## FIXME?: simplify(no need for 'mfnew'): can this be different from 'na.action'? fit.na.action <- attr(mfnew,"na.action") ## only need to drop if new data specified ... if(is.numeric(X.col.dropped) && length(X.col.dropped) > 0) X <- X[, -X.col.dropped, drop=FALSE] } pred <- drop(X %*% fixef(object)) ## FIXME:: need to unname() ? ## FIXME: is this redundant?? ## if (!is.null(frOffset <- attr(object@frame,"offset"))) ## offset <- offset + eval(frOffset, newdata) pred <- pred+offset } ## end !(random.only) if (isRE(re.form)) { if (is.null(re.form)) re.form <- lme4_reOnly(formula(object)) # RE formula only rfd <- if (is.null(newdata)) { ## try to retrieve original data ... fall back to model frame if necessary ## FIXME: this doesn't solve the problem if columns of model frame and data ## diverge (e.g. transformed objects [log(x)], offsets [offset(x)] ... will ## fail farther along tryCatch(getData(object), error = function(e) object@frame) } else newdata newRE <- mkNewReTrms(object, rfd, re.form, na.action=na.action, allow.new.levels=allow.new.levels) REvals <- base::drop(as(newRE$b %*% newRE$Zt, "matrix")) ## only needed if called as simulation? NAs sometimes excluded within mkNewReTrms ... if (length(pred) != length(REvals)) { if (!class(fit.na.action) %in% c("omit", "exclude") && length(fit.na.action)>0) { stop("fixed/RE pred length mismatch") } REvals <- REvals[-fit.na.action] } pred <- pred + REvals if (random.only) { fit.na.action <- attr(newRE$Zt,"na.action") } } if (isGLMM(object) && type=="response") { eta <- pred pred <- object@resp$family$linkinv(pred) } } ## newdata/newparams/re.form ## fill in NAs as appropriate: ## if NAs were detected in original model fit, OR in updated model frame construction ## but DON'T double-NA if raw prediction in the first place if (is.null(newdata)) { fit.na.action <- attr(model.frame(object),"na.action") if (!missing(na.action)) { ## hack to override action where explicitly specified if (!is.null(fit.na.action)) class(fit.na.action) <- class(attr(na.action(NA),"na.action")) } } pred <- napredict(fit.na.action, pred) if (!se.fit) return(pred) if (!isLMM(object)) warning("se.fit computation uses an approximation to estimate the sampling distribution of the parameters") Cmat <- vcov_full(object) n_u <- length(getME(object, "u")) n_beta <- length(getME(object, "beta")) ## FIXME: these need to be fixed (????) if(is.null(newdata)) { X <- getME(object, "X") if(is.null(re.form)) { Z <- getME(object, "Z") } else { if(isRE(re.form)) { ## FIXME: newRE is not computed here Z <- t(newRE$Zt) } else { Z <- Matrix(0, nrow = nrow(X), ncol = n_u) } } } else { if(isRE(re.form)) { Z <- t(newRE$Zt) } else { ## this is inefficient and we could just calculate ## X %*% Cmat[X part only] t(X) instead Z <- Matrix(0, nrow = nrow(X), ncol = n_u) } } if(random.only) X <- Matrix(0, nrow = nrow(Z), ncol = n_beta) ZX <- cbind(Z, X) ## Subsetting Cmat if (ncol(ZX) != nrow(Cmat)) { Cmat_names <- rownames(Cmat) ## Subsetting appears to occur in the case we use newRE; Z_factors <- newRE$flist C_factors <- object@flist cnms <- object@cnms fix_nms <- colnames(object@pp$X) ## Cmat is padded with zeros for new levels if(allow.new.levels){ Cmat_mod <- pad_Cmat(Cmat, C_factors, Z_factors, Cmat_names, cnms) Cmat <- Cmat_mod$Cmat Cmat_names <- Cmat_mod$Cmat_names C_factors <- Cmat_mod$C_factors } is_group_term <- !Cmat_names %in% fix_nms ## looking to compute the groups (factor levels) that are actually ## included in the Z matrix keep_idx <- !is_group_term mask <- unlist(lapply( intersect(names(C_factors), names(Z_factors)), function(grp) { level_mask <- levels(C_factors[[grp]]) %in% levels(Z_factors[[grp]]) rep(level_mask, each = length(cnms[[grp]])) } )) keep_idx[seq_along(mask)] <- is_group_term[seq_along(mask)] & mask # For now, don't worry about keeping it as dpoMatrix? Cmat <- Cmat[keep_idx, keep_idx] #Cmat <- as(Cmat[keep_idx, keep_idx], "dpoMatrix") } res <- list(fit = pred, se.fit = sqrt(quad.tdiag(Cmat, ZX)) ) if (isGLMM(object) && type=="response") { ## pred0 (linear predictor) will have been stored previously in this case ... res$se.fit <- res$se.fit*abs(family(object)$mu.eta(eta)) } res } # end {predict.merMod} ## all possible LHS evaluated values ... simulate.formula_lhs_matrix <- simulate.formula_lhs_numeric <- simulate.formula_lhs_integer <- simulate.formula_lhs_factor <- simulate.formula_lhs_logical <- simulate.formula_lhs_ <- function(object, nsim = 1, seed = NULL, newdata, ...) { ## N.B. *must* name all arguments so that 'object' is missing in .simulateFun() .simulateFun(formula=object, nsim=nsim, seed=seed, newdata=newdata, ...) } simulate.merMod <- function(object, nsim = 1, seed = NULL, use.u = FALSE, re.form=NA, newdata=NULL, newparams=NULL, family=NULL, cluster.rand=rnorm, allow.new.levels=FALSE, na.action=na.pass, ...) { ## FIXME: is there a reason this can't be a copy of .simulateFun ... ? mc <- match.call() mc[[1]] <- quote(lme4::.simulateFun) eval(mc, parent.frame(1L)) } .simulateFun <- function(object, nsim = 1, seed = NULL, use.u = FALSE, re.form=NA, newdata=NULL, newparams=NULL, formula=NULL,family=NULL, cluster.rand=rnorm, weights=NULL, offset=NULL, allow.new.levels=FALSE, na.action=na.pass, cond.sim=TRUE, ...) { if (...length() > 0) warning("unused arguments ignored") ## captured before 'object' is (possibly) constructed below, since a ## "fake" object built on the fly from 'formula' has no meaningful ## pre-existing sigma to fall back on (GH #972); a real, already-fitted ## object does, and callers (e.g. glmertree's backfitting) rely on that objectMissing <- missing(object) if (objectMissing && (is.null(formula) || is.null(newdata) || is.null(newparams))) { stop("if ",sQuote("object")," is missing, must specify all of ", sQuote("formula"),", ",sQuote("newdata"),", and ", sQuote("newparams")) } nullWts <- FALSE if (is.null(weights)) { if (is.null(newdata)) { weights <- weights(object) } else { nullWts <- TRUE # this flags that 'weights' wasn't supplied by the user weights <- rep(1,nrow(newdata)) } } if (objectMissing) { ## construct fake-fitted object from data, params ## copied from glm(): DRY; this all stems from the ## original sin of handling family=gaussian as a special ## case if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame()) if (is.function(family)) family <- family() if (is.null(family) || (family$family=="gaussian" && family$link=="identity")) { lmod <- lFormula(formula,newdata, weights=weights, offset=offset, control=lmerControl(check.formula.LHS="ignore")) devfun <- do.call(mkLmerDevfun, lmod) object <- mkMerMod(environment(devfun), ## (real parameters will be filled in later) opt = list(par=NA_real_,fval=NA_real_,conv=NA_integer_), lmod$reTrms, fr = lmod$fr) } else { glmod <- glFormula(formula,newdata,family=family, weights=weights, offset=offset, control=glmerControl(check.formula.LHS="ignore")) devfun <- do.call(mkGlmerDevfun, glmod) object <- mkMerMod(environment(devfun), ## (real parameters will be filled in later) opt = list(par=NA_real_,fval=NA_real_,conv=NA_integer_), glmod$reTrms, fr = glmod$fr) } ## would like to do this: ## so predict() -> fitted() -> set default names will work ## instead we have a special case in fitted() ## object@resp$mu <- rep(NA_real_,nrow(model.frame(object))) } stopifnot((nsim <- as.integer(nsim[1])) > 0, is(object, "merMod")) if (!is.null(newparams)) { object <- setParams(object, newparams, requireSigma = objectMissing) } if (!missing(use.u)) { if (!missing(re.form)) { stop("should specify only one of ",sQuote("use.u"), " and ",sQuote("re.form")) } re.form <- if (use.u) NULL else ~0 } if (is.null(re.form)) { # formula w/o response re.form <- lme4_reOnly(formula(object)) } if(!is.null(seed)) set.seed(seed) if(!exists(".Random.seed", envir = .GlobalEnv)) runif(1) # initialize the RNG if necessary RNGstate <- .Random.seed sigma <- sigma(object) ## OBSOLETE: no longer use X? ## n <- nrow(X <- getME(object, "X")) ## link <- if (isGLMM(object)) "response" ## predictions, conditioned as specified, on link scale ## previously: do **NOT** use na.action as specified here (inherit ## from object instead, for consistency) ## now: use na.omit, because we have to match up ## with whatever is done in mkNewReTrms etapred <- predict(object, newdata=newdata, re.form=re.form, type="link", na.action=na.omit, allow.new.levels=allow.new.levels) n <- length(etapred) ## now add random components: ## only the ones we did *not* condition on ## compre.form <- noLHSform(formula(object)) ## construct RE formula ONLY: leave out fixed terms, ## which might have loose terms like offsets in them ... ##' combine unary or binary operator + arguments (sugar for 'substitute') makeOp <- function(x,y,op=NULL) { if (is.null(op)) { ## unary substitute(OP(X),list(X=x,OP=y)) } else substitute(OP(X,Y), list(X=x,OP=op,Y=y)) } compReForm <- lme4_reOnly(formula(object)) if (isRE(re.form)) { rr <- lme4_reOnly(re.form)[[2]] ## expand RE and strip ~ ftemplate <- substitute(.~.-XX, list(XX=rr)) compReForm <- update.formula(compReForm,ftemplate)[-2] ## update, then delete LHS } ## (1) random effect(s) sim.reff <- if (!is.null(reformulas::findbars(compReForm))) { newRE <- mkNewReTrms(object, newdata, compReForm, na.action=na.action, allow.new.levels=allow.new.levels) ## this *can* justifiably happen, if we are using mkNewReTrms ## in the context of predicting/simulating with a non-trivial ## re.form ... ## paranoia ... ## stopifnot(!is.null(newdata) || ## isTRUE(all.equal(newRE$Lambdat,getME(object,"Lambdat")))) U <- t(newRE$Lambdat %*% newRE$Zt) # == Z Lambda u <- cluster.rand(ncol(U)*nsim) ## UNSCALED random-effects contribution: as(U %*% matrix(u, ncol = nsim), "matrix") } else 0 val <- if (isLMM(object)) { ## result will be matrix n x nsim : etapred + sigma * (sim.reff + ## residual contribution: if (cond.sim) # always rnorm regardless of cluster.rand matrix(rnorm(n * nsim), ncol = nsim) else 0) } else if (isGLMM(object)) { ## GLMM ## n.b. DON'T scale random-effects (???) etasim <- etapred+sim.reff family <- normalizeFamilyName(object@resp$family) musim <- family$linkinv(etasim) #-> family$family == "negative.binomial" if(NB) ## ntot <- length(musim) ## FIXME: or could be dims[["n"]]? ## if (family$family=="binomial" && is.matrix(r <- model.response(object@frame))) { # unless the user passed in new weights, take them from the response matrix # e.g. cbind(incidence, size-incidence) ~ ... if(nullWts) weights <- rowSums(r) } if (is.null(sfun <- simfunList[[family$family]])) { ## family$simulate just won't work ... ## sim funs must be hard-coded, see below stop("simulation not implemented for family ", sQuote(family$family)) } ## don't rely on automatic recycling if (cond.sim) { val <- sfun(object, nsim=1, ftd = rep_len(musim, n*nsim), wts = weights) } else { val <- rep_len(musim, n*nsim) } ## split results into nsims: need special case for binomial matrix/factor responses if (family$family=="binomial" && is.matrix(r <- model.response(object@frame))) { lapply(split(val[[1]], gl(nsim, n, 2 * nsim * n)), matrix, ncol = 2, dimnames = list(NULL, colnames(r))) } else if (family$family=="binomial" && is.factor(val[[1]])) { split(val[[1]], gl(nsim,n)) } else split(val, gl(nsim,n)) } else stop("simulate method for NLMMs not yet implemented") ## from src/library/stats/R/lm.R if(!is.list(val)) { dim(val) <- c(n, nsim) val <- as.data.frame(val) } else class(val) <- "data.frame" names(val) <- paste("sim", seq_len(nsim), sep="_") ## have not yet filled in NAs, so need to use names of fitted ## object NOT including values with NAs f <- fitted(object) nm <- names(f)[!is.na(f)] ## unnamed input, *or* simulation from new data ... if (length(nm) == 0) { nm <- as.character(seq(n)) } else if (!is.null(newdata)) { nm <- rownames(newdata) } row.names(val) <- nm fit.na.action <- attr(model.frame(object), "na.action") if (!missing(na.action) && !is.null(fit.na.action)) { ## retrieve name of na.action type ("omit", "exclude", "pass") class.na.action <- class(attr(na.action(NA), "na.action")) if (!identical(class.na.action, class(fit.na.action))) { ## hack to override action where explicitly specified class(fit.na.action) <- class.na.action } } nafun <- function(x) { x[] <- apply(x, 2L, napredict, omit = fit.na.action); x } val <- if (is.matrix(val[[1]])) { ## have to handle binomial response matrices differently -- ## fill in NAs as appropriate in *both* columns structure(lapply(val, nafun), ## have to put this back into a (weird) data frame again, ## carefully (should do the napredict stuff ## earlier, so we don't have to redo this transformation!) class = "data.frame") } else { as.data.frame(lapply(val, napredict, omit=fit.na.action)) } ## reconstruct names: first get rid of NAs, then refill them ## as appropriate based on fit.na.action (which may be different ## from the original model's na.action spec) nm2 <- if (is.null(newdata)) names(napredict(na.omit(f), omit=fit.na.action)) else rownames(napredict(newdata, omit=fit.na.action)) if (length(nm2) > 0) row.names(val) <- nm2 structure(val, ## as.data.frame(lapply(...)) blows away na.action attribute, ## so we have to re-assign here na.action = fit.na.action, seed = RNGstate) }## .simulateFun() ######################## ## modified from stats/family.R ## TODO: the $simulate methods included with R families by default ## are not sufficiently flexible to be re-used by lme4. ## these are modified by: ## (1) adding a 'ftd' argument for the fitted values ## that defaults to fitted(object), to allow more flexibility ## e.g. in conditioning on or marginalizing over random effects ## (fitted(object) can be produced from predict.merMod() with ## alternative parameters rather than being extracted directly ## from the fitted objects -- this allows simulation with new ## parameters or new predictor variables ## (2) modifying wts from object$prior.weights to weights(object) ## (3) adding wts as an argument ## ## these can be incorporated by overwriting the simulate() ## components, or calling them ## gaussian_simfun <- function(object, nsim, ftd=fitted(object), wts=weights(object)) { if (any(wts != 1)) warning("ignoring prior weights") rnorm(nsim*length(ftd), ftd, sd=sigma(object)) } binomial_simfun <- function(object, nsim, ftd=fitted(object), wts=weights(object)) { n <- length(ftd) ntot <- n*nsim if (any(wts %% 1 != 0)) stop("cannot simulate from non-integer prior.weights") ## Try to figure out if the original data were ## proportions, a factor or a two-column matrix if (!is.null(m <- model.frame(object))) { y <- model.response(m) if(is.factor(y)) { ## ignore weights yy <- factor(levels(y)[1 + rbinom(ntot, size = 1, prob = ftd)], levels = levels(y)) split(yy, rep(seq_len(nsim), each = n)) } else if(is.matrix(y) && ncol(y) == 2) { yy <- vector("list", nsim) for (i in seq_len(nsim)) { Y <- rbinom(n, size = wts, prob = ftd) YY <- cbind(Y, wts - Y) colnames(YY) <- colnames(y) yy[[i]] <- YY } yy } else rbinom(ntot, size = wts, prob = ftd)/wts } else rbinom(ntot, size = wts, prob = ftd)/wts } poisson_simfun <- function(object, nsim, ftd=fitted(object), wts=weights(object)) { ## A Poisson GLM has dispersion fixed at 1, so prior weights ## do not have a simple unambiguous interpretation: ## they might be frequency weights or indicate averages. wts <- weights(object) if (any(wts != 1)) warning("ignoring prior weights") rpois(nsim*length(ftd), ftd) } ##' FIXME: need a gamma.shape.merMod method in order for this to work. ##' (see initial shot at gamma.shape.merMod below) Gamma_simfun <- function(object, nsim, ftd=fitted(object), wts=weights(object)) { if (any(wts != 1)) message("using weights to scale shape parameter") ## used to use gamma.shape(), but sigma() is more general ## (wouldn't work *outside* of the merMod context though) shape <- 1/sigma(object)^2*wts rgamma(nsim*length(ftd), shape = shape, rate = shape/ftd) } gamma.shape.merMod <- function(object, ...) { if(family(object)$family != "Gamma") stop("Can not fit gamma shape parameter because Gamma family not used") y <- getME(object, "y") mu <- getME(object, "mu") w <- weights(object) # Sec 8.3.2 (MN) L <- w*(log(y/mu)-((y-mu)/mu)) dev <- -2*sum(L) # Eqs. between 8.2 & 8.3 (MN) Dbar <- dev/length(y) structure(list(alpha = (6+2*Dbar)/(Dbar*(6+Dbar)), SE = NA), # FIXME: obtain standard error class = "gamma.shape") } inverse.gaussian_simfun <- function(object, nsim, ftd=fitted(object), wts = weights(object)) { if (any(wts != 1)) message("using weights as inverse variances") if (!requireNamespace("statmod")) { stop("The ",sQuote("statmod")," package must be installed ", " in order to simulate inverse-Gaussian distributions") } statmod::rinvgauss(nsim * length(ftd), mean = ftd, shape= wts/sigma(object)) } ## in the original MASS version, .Theta is assigned into the environment ## (triggers a NOTE in R CMD check) ## modified from @aosmith16 GH contribution negative.binomial_simfun <- function (object, nsim, ftd = fitted(object), wts=weights(object)) { if (any(wts != 1)) warning("ignoring prior weights") theta <- getNBdisp(object) rnbinom(nsim * length(ftd), mu = ftd, size = theta) } simfunList <- list(gaussian = gaussian_simfun, binomial = binomial_simfun, poisson = poisson_simfun, Gamma = Gamma_simfun, negative.binomial = negative.binomial_simfun, inverse.gaussian = inverse.gaussian_simfun) lme4/R/error_factory.R0000644000176200001440000000615315036542626014335 0ustar liggesusers#' Catch errors and warnings and store them for subsequent evaluation #' #' Factory modified from a version written by Martin Morgan on Stack Overflow (see below). #' Factory generates a function which is appropriately wrapped by error handlers. #' If there are no errors and no warnings, the result is provided. #' If there are warnings but no errors, the result is provided with a warn attribute set. #' If there are errors, the result retutrns is a list with the elements of warn and err. #' This is a nice way to recover from a problems that may have occurred during loop evaluation or during cluster usage. #' Check the references for additional related functions. #' I have not included the other factory functions included in the original Stack Overflow answer because they did not play well with the return item as an S4 object. #' @export #' @param fun The function to be turned into a factory #' @param debug print debugging statements? #' @param errval the value to be returned from the function if an error is thrown #' @param types which types to catch? #' @return The result of the function given to turn into a factory. If this function was in error "An error as occurred" as a character element. factory-error and factory-warning attributes may also be set as appropriate. #' @references #' \url{http://stackoverflow.com/questions/4948361/how-do-i-save-warnings-and-errors-as-output-from-a-function} #' @author Martin Morgan; Modified by Russell S. Pierce and Ben Bolker #' @examples #' f.log <- factory(log) #' f.log("a") #' f.log.NA <- factory(log,errval=NA) #' f.log.NA("a") #' f.as.numeric <- factory(as.numeric) #' f.as.numeric(c("a","b",1)) factory <- function (fun, debug=FALSE, errval="An error occurred in the factory function", types=c("message","warning","error")) { function(...) { errorOccurred <- FALSE warn <- err <- msg <- NULL res <- withCallingHandlers(tryCatch(fun(...), error = function(e) { if (debug) cat("error: ",conditionMessage(e),"\n") err <<- conditionMessage(e) errorOccurred <<- TRUE NULL }), warning = function(w) { if (!"warning" %in% types) { warning(conditionMessage(w)) } else { warn <<- append(warn, conditionMessage(w)) invokeRestart("muffleWarning") } }, message = function(m) { if (debug) cat("message: ",conditionMessage(m),"\n") if (!"message" %in% types) { message(conditionMessage(m)) } else { msg <<- append(msg, conditionMessage(m)) invokeRestart("muffleMessage") } }) if (errorOccurred) { if (!"error" %in% types) stop(err) res <- errval } setattr <- function(x, attrib, value) { attr(x,attrib) <- value x } attr_fun <- function(x,str,msg) { setattr(x,paste0("factory-",str), if(is.character(msg)) msg else NULL) } res <- attr_fun(res, "message", msg) res <- attr_fun(res, "warning", warn) res <- attr_fun(res, "error", err) return(res) } } lme4/R/plots.R0000644000176200001440000001110215036542626012604 0ustar liggesusers### Plots for the ranef.mer class ---------------------------------------- ##' @importFrom lattice dotplot ##' @S3method dotplot ranef.mer dotplot.ranef.mer <- function(x, data, main = TRUE, transf=I, level = 0.95, ...) { rng <- qnorm((1+level)/2) prepanel.ci <- function(x, y, se, subscripts, ...) { if (is.null(se)) return(list()) x <- as.numeric(x) hw <- rng * as.numeric(se[subscripts]) list(xlim = range(transf(x - hw), transf(x + hw), finite = TRUE)) } panel.ci <- function(x, y, se, subscripts, pch = 16, horizontal = TRUE, col = dot.symbol$col, lty.h = dot.line$lty, lty.v = dot.line$lty, lwd.h = dot.line$lwd, lwd.v = dot.line$lwd, col.line.h = dot.line$col, col.line.v = dot.line$col, levels.fos = unique(y), groups = NULL, ...) { x <- as.numeric(x) y <- as.numeric(y) dot.line <- trellis.par.get("dot.line") dot.symbol <- trellis.par.get("dot.symbol") sup.symbol <- trellis.par.get("superpose.symbol") panel.abline(h = levels.fos, col = col.line.h, lty = lty.h, lwd = lwd.h) panel.abline(v = 0, col = col.line.v, lty = lty.v, lwd = lwd.v) if (!is.null(se)) { se <- as.numeric(se[subscripts]) panel.segments( transf(x - rng * se), y, transf(x + rng * se), y, col = 'black') } panel.xyplot(transf(x), y, pch = pch, col = col, ...) } f <- function(nx, ...) { ss <- asDf0(x,nx) mtit <- if(main) nx dotplot(.nn ~ values | ind, ss, se = ss$se, prepanel = prepanel.ci, panel = panel.ci, xlab = NULL, main = mtit, ...) } setNames(lapply(names(x), f, ...), names(x)) } ##' @importFrom graphics plot ##' @S3method plot ranef.mer plot.ranef.mer <- function(x, y, ...) { lapply(x, function(x) { cn <- lapply(colnames(x), as.name) switch(min(ncol(x), 3), qqmath(eval(substitute(~ x, list(x = cn[[1]]))), x, ...), xyplot(eval(substitute(y ~ x, list(y = cn[[1]], x = cn[[2]]))), x, ...), splom(~ x, ...)) }) } ##' @importFrom lattice qqmath ##' @S3method qqmath ranef.mer qqmath.ranef.mer <- function(x, data, main = TRUE, level = 0.95, ...) { rng <- qnorm((1+level)/2) prepanel.ci <- function(x, y, se, subscripts, ...) { x <- as.numeric(x) se <- as.numeric(se[subscripts]) hw <- rng * se list(xlim = range(x - hw, x + hw, finite = TRUE)) } panel.ci <- function(x, y, se, subscripts, pch = 16, ...) { panel.grid(h = -1,v = -1) panel.abline(v = 0) x <- as.numeric(x) y <- as.numeric(y) se <- as.numeric(se[subscripts]) panel.segments(x - rng * se, y, x + rng * se, y, col = 'black') panel.xyplot(x, y, pch = pch, ...) } f <- function(nx) { xt <- x[[nx]] mtit <- if(main) nx # else NULL if (!is.null(pv <- attr(xt, "postVar"))) { d <- dim(pv) se <- vapply(seq_len(d[1]), function(i) sqrt(pv[i, i, ]), numeric(d[3])) nr <- nrow(xt) nc <- ncol(xt) ord <- unlist(lapply(xt, order)) + rep((0:(nc - 1)) * nr, each = nr) rr <- 1:nr ind <- gl(nc, nr, labels = names(xt)) xyplot(rep(qnorm((rr - 0.5)/nr), nc) ~ unlist(xt)[ord] | ind[ord], se = se[ord], prepanel = prepanel.ci, panel = panel.ci, scales = list(x = list(relation = "free")), ylab = "Standard normal quantiles", xlab = NULL, main = mtit, ...) } else { qqmath(~values|ind, data = stack(xt), scales = list(y = list(relation = "free")), xlab = "Standard normal quantiles", ylab = NULL, main = mtit, ...) } } sapply(names(x), f, simplify = FALSE) } ##' @importFrom graphics plot ##' @S3method plot coef.mer plot.coef.mer <- function(x, y, ...) { ## remove non-varying columns from frames reduced <- lapply(x, function(el) el[, !vapply(el, function(cc) all(cc == cc[1L]), NA)]) plot.ranef.mer(reduced, ...) } ##' @importFrom lattice dotplot ##' @S3method dotplot coef.mer dotplot.coef.mer <- function(x, data, ...) { mc <- match.call() mc[[1]] <- as.name("dotplot.ranef.mer") eval(mc) } lme4/R/checkConv.R0000644000176200001440000002055615142223321013345 0ustar liggesusers### Adapted from Rune Haubo's ordinal code ### extended convergence checking ### http://en.wikipedia.org/wiki/Karush%E2%80%93Kuhn%E2%80%93Tucker_conditions ## global (for use in several functions) help_str <- "\n See ?lme4::convergence and ?lme4::troubleshooting." ##' @param derivs typically the "derivs" attribute of optimizeLmer(); with ##' "gradients" and possibly "Hessian" component ##' @param coefs estimated function value ##' @param ctrl list of lists, each with \code{action} character strings specifying ##' what should happen when a check triggers, and \code{tol} numerical tolerances, ##' as is the result of \code{\link{lmerControl}()$checkConv}. ##' @param lbound vector of lower bounds \emph{for random-effects parameters only} ##' (length is taken to determine number of RE parameters) ##' @param debug useful if some checks are on "ignore", but would "trigger" ##' @param nobs the number of observations from the dataset ##' @param ndim the number of dimensions for the variance-covariance matrix ##' of random effects checkConv <- function(derivs, coefs, ctrl, lbound, ubound, debug = FALSE, nobs = NULL, ndim = NULL) { res <- list() ntheta <- length(lbound) if (missing(ubound)) ubound <- rep(Inf, length(lbound)) ## check singularity first, and unconditionally ## (ignore "ignore") ccl <- ctrl[[cstr <- "check.conv.singular"]] ; checkCtrlLevels(cstr, cc <- ccl[["action"]]) ## similar logic to isSingular, but we don't have the fitted object to test is.singular <- min(coefs - lbound, ubound - coefs) < ccl$tol if (doCheck(cc)) { ## singular fit ## are there other circumstances where we can get a singular fit? if (is.singular) { wstr <- "boundary (singular) fit: see help('isSingular')" res$messages <- c(res$messages,wstr) switch(cc, "message" = message(wstr), "warning" = warning(wstr), "stop" = stop(wstr), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } } ## DON'T check remaining gradient issues if (is.singular) return(res) ## bail out if (is.null(derivs) || (!is.null(nobs) && nobs > ctrl$check.conv.nobsmax) || (!is.null(ndim) && ndim > ctrl$check.conv.nparmax)) { return(NULL) } if (anyNA(derivs$gradient)) return(list(code = -5L, messages = gettextf("Gradient contains NAs"))) ## gradients: ## check absolute gradient (default) ccl <- ctrl[[cstr <- "check.conv.grad"]] ; checkCtrlLevels(cstr, cc <- ccl[["action"]]) wstr <- NULL if (doCheck(cc)) { scgrad <- tryCatch(with(derivs,solve(chol(Hessian),gradient)), error=function(e)e) if (inherits(scgrad, "error") || ## some BLAS versions return NA rather than throwing an error? ## GH #677 any(is.na(scgrad))) { wstr <- "unable to evaluate scaled gradient" res$code <- -1L } else { ## find parallel *minimum* of scaled and absolute gradient ## the logic here is that we can sometimes get large ## *scaled* gradients even when the *absolute* gradient ## is small because the curvature is very flat as well ... mingrad <- pmin(abs(scgrad),abs(derivs$gradient)) maxmingrad <- max(mingrad) if (maxmingrad > ccl$tol) { w <- which.max(maxmingrad) res$code <- -1L wstr <- gettextf("Model failed to converge with max|grad| = %g (tol = %g, component %d)", maxmingrad, ccl$tol,w) wstr <- paste0(wstr, help_str) } } if (!is.null(wstr)) { res$messages <- wstr switch(cc, "warning" = warning(wstr), "stop" = stop(wstr), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } ## note: kktc package uses gmax > kkttol * (1 + abs(fval)) ## where kkttol defaults to 1e-3 and fval is the objective f'n value ## check relative gradient (only if enabled) if (!is.null(ccl$relTol) && (max.rel.grad <- max(abs(derivs$gradient/coefs))) > ccl$relTol) { res$code <- -2L wstr <- gettextf("Model failed to converge with max|relative grad| = %g (tol = %g)", max.rel.grad, ccl$relTol) wstr <- paste0(wstr, help_str) res$messages <- wstr switch(cc, "warning" = warning(wstr), "stop" = stop(wstr), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } } ccl <- ctrl[[cstr <- "check.conv.hess"]] ; checkCtrlLevels(cstr, cc <- ccl[["action"]]) if (doCheck(cc)) { if (length(coefs) > ntheta) { ## GLMM, check for issues with beta parameters H.beta <- derivs$Hessian[-seq(ntheta),-seq(ntheta)] resHess <- checkHess(H.beta, ccl$tol, "fixed-effect") if (any(resHess$code!=0)) { res$code <- resHess$code res$messages <- c(res$messages,resHess$messages) wstr <- paste(resHess$messages,collapse=";") switch(cc, "warning" = warning(wstr), "stop" = stop(wstr), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } } resHess <- checkHess(derivs$Hessian, ccl$tol) if (any(resHess$code != 0)) { res$code <- resHess$code res$messages <- c(res$messages,resHess$messages) wstr <- paste(resHess$messages,collapse=";") switch(cc, "warning" = warning(wstr), "stop" = stop(wstr), stop(gettextf("unknown check level for '%s'", cstr), domain=NA)) } } if (debug && length(res$messages) > 0) { print(res$messages) } res } checkHess <- function(H, tol, hesstype="") { ## FIXME: not sure why we decided to save messages as a list ## rather than as a character vector?? res <- list(code=numeric(0),messages=list()) evd <- tryCatch(eigen(H, symmetric=TRUE, only.values=TRUE)$values, error=function(e)e) if (inherits(evd,"error")) { res$code <- -6L res$messages <- gettextf("Problem with Hessian check (infinite or missing values?)") } else { negative <- sum(evd < -tol) if(negative) { res$code <- -3L res$messages <- gettextf(paste("Model failed to converge:", "degenerate",hesstype,"Hessian with %d negative eigenvalues"), negative) res$messages <- paste0(res$messages, help_str) } else { zero <- sum(abs(evd) < tol) if(zero || inherits(tryCatch(chol(H), error=function(e)e), "error")) { res$code <- -4L res$messages <- paste(hesstype,"Hessian is numerically singular: parameters are not uniquely determined") } else { res$cond.H <- max(evd) / min(evd) 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) ## consider skipping warning message if we've ## already hit the previous flag? 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)==0) res$code <- 0 res } lme4/LICENSE.note0000644000176200001440000000022615036542626013075 0ustar liggesusersThis package is licensed under GPL (>=2), except for the code in R/simulate.formula.R, which is licensed under the MIT license (details in that file).lme4/vignettes/0000755000176200001440000000000015225715200013122 5ustar liggesuserslme4/vignettes/glmer.Rnw0000644000176200001440000025260515224173400014731 0ustar liggesusers%\VignetteEngine{knitr::knitr} %\VignetteDepends{ggplot2} %\VignetteDepends{gridExtra} %\VignetteDepends{performance} %\VignetteDepends{merDeriv} %\VignetteDepends{DHARMa} %\VignetteIndexEntry{Fitting Generalized Linear Mixed-Effects Models using lme4} \documentclass[nojss]{jss} %% need no \usepackage{Sweave.sty} \usepackage[T1]{fontenc}% for correct hyphenation and T1 encoding \usepackage[utf8]{inputenc} \usepackage{lmodern}% latin modern font \usepackage[american]{babel} %% for texi2dvi ~ bug \usepackage{bm,amsmath,amsfonts} \DeclareMathOperator{\tr}{tr} \DeclareMathOperator{\VEC}{vec} \newcommand{\bbeta}{{\bm \beta}} \newcommand{\btheta}{{\bm \theta}} \newcommand{\bmb}[1]{{\color{blue} #1}} \DeclareUnicodeCharacter{0394}{$\Delta$} % \shortcites{lesnoff_within-herd_2004} %% BMB: what does JSS assume? %\bibliographystyle{chicago} \author{ Anna Ly\\McMaster University \And Rune Haubo Bojesen Christensen\\Copenhagen Research Centre \\for Biological and Precision Psychiatry\AND Douglas Bates\\University of Wisconsin - Madison \And Martin M\"achler\\ETH Zurich\AND Benjamin M. Bolker\\McMaster University } \Plainauthor{A. Ly, R. H. B. Christensen, D. M. Bates, M. M\"achler, B. M. Bolker} \title{Fitting generalized linear mixed-effects models using \pkg{lme4}} \Plaintitle{Fitting generalized linear mixed models using lme4} \Shorttitle{GLMMs with lme4} \Abstract{% The \pkg{lme4} \proglang{R} package can be used to fit generalized linear mixed models (GLMMs), which extend the class of linear mixed models (LMMs). The two main extensions provided by GLMMs are (1) allowing for the conditional distribution of the response given the random effects to be non-Gaussian (e.g. binomial, Poisson) and (2) allowing the conditional mean to be a nonlinear function of a linear combination of the fixed and random effect coefficients, via an inverse link function. The conditional mode of the random effects given the observed data, the variance-covariance matrix of the random effects, and the fixed effect parameters are determined using penalized iteratively reweighted least squares. We compute an approximation of the integral over the distributions of the conditional modes to compute the maximum likelihood estimate for a given set of parameters (by default we use the Laplace approximation or, alternatively, the more computationally expensive adaptive Gauss-Hermite quadrature). The package provides all the standard features available for GLMs in base \proglang{R}, including the standard set of accessor functions as well as the possibility of user-specified distributions (within the exponential dispersion family) and link functions.} % \Keywords{% sparse matrix methods, generalized linear mixed models, penalized least squares, Cholesky decomposition} \Address{ Anna Ly\\ Department of Mathematics \& Statistics \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ Email: \email{annahuynh.ly@utoronto.ca} \par\bigskip Rune Haubo Bojesen Christensen \\ Copenhagen Research Centre for Biological and Precision Psychiatry \\ Mental Health Centre Copenhagen, Copenhagen University Hospital - Bispebjerg and Frederiksberg \\ Copenhagen, Denmark \\ Email: \email{Rune.Haubo@pm.me} \par\bigskip Douglas Bates\\ Department of Statistics, University of Wisconsin - Madison\\ 1205 University Ave. \\ Madison, WI 53706, U.S.A.\\ E-mail: \email{bates@stat.wisc.edu} \par\bigskip Martin M\"achler\\ Seminar f\"ur Statistik, HG G~16\\ ETH Zurich\\ 8092 Zurich, Switzerland\\ E-mail: \email{maechler@stat.math.ethz.ch}\\ % URL: \url{http://stat.ethz.ch/people/maechler} \par\bigskip Benjamin M. Bolker\\ Departments of Mathematics \& Statistics and Biology \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ E-mail: \email{bolker@mcmaster.ca} } \newcommand{\Var}{\operatorname{Var}} \newcommand{\abs}{\operatorname{abs}} \newcommand{\bLt}{\ensuremath{\bm\Lambda_\theta}} \newcommand{\mc}[1]{\ensuremath{\mathcal{#1}}} \newcommand{\trans}{\ensuremath{^\top}} \newcommand{\yobs}{\ensuremath{\bm y_{\mathrm{obs}}}} \newcommand{\Lsat}{\ensuremath{L_{\mathrm{sat}}}} \newcommand*{\eq}[1]{eqn.~\ref{#1}}% or just {(\ref{#1})} \DeclareMathOperator*{\argmax}{arg\,max} \DeclareMathOperator*{\argmin}{arg\,min} \DeclareMathOperator*{\ylogy}{ylogy} \usepackage{etoolbox} \usepackage{lineno} %% line numbering hack from Claude \makeatletter \let\@@par@orig\@@par \renewcommand{\@@par}{% \@@par@orig \ifnum\currentgrouplevel=0 \linenumbers \fi } \makeatother % <>= options(width=69, show.signif.stars=FALSE, str=strOptions(strict.width="cut")) library(knitr) library(lme4) library(ggplot2) theme_set(theme_bw()) revguide <- guide_legend(reverse = TRUE) library(grid) library(gridExtra) zmargin <- theme(panel.margin=unit(0,"lines")) library(lattice) library(DHARMa) library(performance) opts_chunk$set(engine='R',dev='pdf',fig.width=10, fig.height=6.5,prompt=TRUE, ## strip.white=all, error=FALSE, ## stop on error tidy=FALSE,comment=NA) ## using knitr::knit2pdf() may lead to xcolor 'incompatible color definition' ## warnings. The code below resolves that, but simultaneously breaks ## vignette compilation in other contexts ... ## https://tex.stackexchange.com/questions/148188/knitr-xcolor-incompatible-color-definition ## knit_hooks$set(document = function(x) {sub('\\usepackage[]{xcolor}', '\\usepackage[dvipsnames]{xcolor}', x, fixed = TRUE)}) @ \begin{document} \linenumbers \section{Introduction} \label{sec:intro} The \pkg{lme4} package for \proglang{R} can be used to fit a broad range of mixed-effects models. One major advantage of \pkg{lme4} over its predecessor, \pkg{nlme}, is that it can be used to fit generalized linear mixed models (GLMMs), which combine the flexibility of linear mixed models (LMMs) and generalized linear models (GLMs). In a companion paper, we have described the facilities in \pkg{lme4} for fitting linear mixed models (LMMs). Here we describe the facilities for fitting GLMMs. \section{Generalized Linear Mixed Models} \label{sec:GLMMdef} Generalized linear mixed models extend the class of linear models in two ways: allowing for both fixed-effects parameters and random effects in the linear predictor, as in linear mixed models (LMMs), and allowing for non-Gaussian distributions of the response, whose mean is an inverse link applied to the linear predictor, as in generalized linear models (GLMs). We consider several characteristics of each of these model types. \subsection{The Linear Model} A linear model can be written as $\mc Y\sim\mc N\left(\bm X\bm\beta,\sigma^2\bm I\right)$, where $\mc Y$ is the $n$-dimensional random variable representing the response, $\bm X$ is an $n\times p$ model matrix and $\bm\beta$ is a $p$-dimensional coefficient vector. The vector $\bm\eta=\bm X\bm\beta$ (the \emph{linear predictor}) is mapped to the \emph{mean vector}, $\bm\mu=\bm g^{-1}(\bm\eta)$, in this case using an \emph{identity} link and inverse link function. (The \emph{link} function, $\bm g$, maps $\bm\mu$ to $\bm\eta$ and the \emph{inverse link}, $\bm g^{-1}$, maps $\bm\eta$ to $\bm\mu$.) The maximum likelihood estimates (MLEs) of the coefficients, $\widehat{\bm\beta}$, are the values that minimize the (weighted) sum of squared residuals \begin{equation} \label{eq:LMMmles} \widehat{\bm\beta} = \argmin_{\bm\beta}\sum_{i=1}^n w_i (y_i - \mu_i)^2 . \end{equation} with weights $w_i$. The weighted squared residuals, $d(y_i,\mu_i, w_i)= w_i (y_i - \mu_i)^2$, are the \emph{unit deviances} for the Gaussian family.\footnote{In the \proglang{R} \emph{family} lists of functions that encapsulate the distribution families in arguments to \code{glm} and \code{glmer}, the function that returns the unit deviances is named \code{dev.resids}, a source of confusion in some cases because they are not the values returned by \code{residuals(m, type="deviance")}.} \subsection{The Generalized Linear Model} In a \emph{generalized linear model} (GLM) the linear predictor is still $\bm\eta=\bm X\bm\beta$ but the distribution of the response, $\mc Y$, with mean $\bm\mu=\bm g^{-1}(\bm\eta)$, can be from distribution families other than the Gaussian, specifically from the class of exponential dispersion families; the most common examples are Bernoulli, binomial, or Poisson. Individual components of the response, ${\mc Y}_i,i=1,\dots,n$, are pairwise independent. The distribution family determines the \emph{unit deviance} function, $d(y_i,\mu_i)$, and the MLEs of the coefficients are those that minimize the sum of the unit deviances \begin{equation} \label{eq:sumofunitdeviances} \widehat{\bm\beta} = \argmin_{\bm\beta}\sum_{i=1}^n d(y_i,\mu_i, w_i) . \end{equation} The unit deviances are the (weighted) difference between negative twice the log-likelihood at $(y_i, \mu_i)$ and negative twice the log-likelihood at $(y_i, y_i)$ (which is often zero). For the Poisson distribution the unit deviance function is \begin{equation} \label{eq:Poissonunitdeviance} d(y_i,\mu_i,w_i)= \begin{cases} 2 w_i \mu_i & \text{if } y_i = 0 \\ 2 w_i (y_i \log(y_i/\mu_i) - (y_i - \mu_i)) & \text{otherwise} \end{cases} \end{equation} where $w_i$ is an optional prior case weight. For simplicity we generally neglect the prior weights and write $d(y_i, u_i)$ below. Minimizing the sum of the squared residuals in a linear model (i.e. finding the \emph{least squares} estimates $\widehat{\bm\beta}$ for an LM) can be performed as a direct (i.e. non-iterative) calculation. For a generalized linear model minimizing the sum of unit deviances usually must be done through iteration. Fortunately, this can be done using a fast, robust algorithm, \emph{iteratively reweighted least squares} \cite[IRLS:][]{McCullaghNelder1989}. The link and inverse link functions are \emph{diagonal mappings}, in the sense that there is a scalar function, $g$, such that the $i$th component of $\bm\eta$ is $g$ applied to the $i$th component of $\bm\mu_{\mc Y}$. (The name ``diagonal'' reflects the fact that the Jacobian matrix, $\frac{d\eta}{d\mu\trans}$, of such a mapping will be diagonal.) If the distribution family is one of the exponential distribution families a \emph{canonical link} can be derived from the form of the distribution. The canonical link is the identity for the Gaussian family, the \emph{logit} or ``log-odds'' function, $g(\mu)=\log(\mu/(1 - \mu))$, for the Bernoulli or binomial families, and the natural logarithm, $g(\mu)=\log(\mu)$, for the Poisson. \subsection{The Linear Mixed Model} In a linear mixed model (LMM), described in \cite{bates2015fitting}, there are two vector-valued random variables: $\mc Y$, the $n$-dimensional response, and $\mc B$, the $q$-dimensional random effects vector. The unconditional distribution $\mc B\sim\mc N(\bm 0,\bm\Sigma_{\bm\theta})$ depends on a \emph{covariance parameter} $\bm\theta$. The conditional distribution, $(\mc Y| \mc B=\bm b)\sim\mc N(\bm X\bm\beta+\bm Z\bm b, \sigma^2\bm I)$, has mean, $\bm\mu$, from the identity link applied to the linear predictor $\bm\eta=\bm X\bm\beta+\bm Z\bm b$, where $\bm Z$ is an $n\times q$ model matrix for the random effects and $\bm b$ is a value of $\mc B$. In practice the covariance parameter, $\bm\theta$, determines a lower triangular \emph{relative covariance factor}, $\bm\Lambda_{\bm\theta}$, with $\bm\Sigma_{\bm\theta}=\sigma^2\bm\Lambda_{\bm\theta}\bm\Lambda_{\bm\theta}\trans$ and we work with a ``spherical'' random effects variable, $\mc U\sim\mc N(\bm 0,\sigma^2\bm I)$, such that $\mc B=\bm\Lambda_{\bm\theta}\mc U$, and for which the linear predictor is \begin{equation} \label{eq:LMMlinpred} \bm\eta=\bm X\bm\beta+\bm Z\bm b=\bm X\bm\beta+\bm Z\bm\Lambda_{\bm\theta}\bm u . \end{equation} ($\mc U$ is said to be ``spherical'' because contours of constant probability density are spheres centered at the origin.) Most generally, $\bm\Lambda_{\bm\theta}$ can be any lower triangular matrix, since $\bm\Lambda_{\bm\theta}\bm\Lambda_{\bm\theta}\trans$ is then guaranteed to be positive semidefinite. In \pkg{lme4} version 2.0 and later, we have also implemented \emph{structured covariance matrices}, which introduce a more elaborate mapping from $\bm\theta$ to $\bm\Lambda_{\bm\theta}$ that lets users specify a range of structured forms such as diagonal, compound symmetric, or first-order autoregressive (AR1) covariance matrices. We introduce the syntax for these structures in the CBPP example (Section~\ref{sec:cbpp}); see the \href{https://CRAN.R-project.org/package=lme4/vignettes/covariance_structures.html}{lme4 covariance structures vignette} for the details of how $\bm\Lambda_{\bm\theta}$ is constructed for each structure. The likelihood of the parameters, $\bm\beta$, $\bm\theta$ and $\sigma^2$, given $\mc Y=\bm y$, is the marginal density of $\mc Y$ evaluated at the observed $\bm y$. Conceptually, we determine an expression for the integral of the joint density, $f_{\mc Y,\mc U}(\bm y,\bm u)$, with respect to $\bm u$, then evaluate that expression at the observed $\bm y$. In practice, it is easier to reverse the order of the evaluation at the observed $\bm y$ and the integration with respect to $\bm u$. The joint density is \begin{equation} \label{eq:jointLMMdensity} f_{\mc Y,\mc U}(\bm y,\bm u)=\frac{1}{(2\pi\sigma^2)^{(n+q)/2}} \exp\left(\frac{\|\bm y-\bm\mu\|^2 + \|\bm u\|^2}{-2\sigma^2}\right) , \end{equation} where the expression in the numerator of the integrand is the \emph{penalized sum of the unit deviances} (PSUD) for the Gaussian family, which is the penalized sum of squared residuals (PSSR). (The sum of the unit deviances is $\|\bm y-\bm\mu\|^2$ and the penalty is $\|\bm u\|^2$.) To evaluate the integral we determine the \emph{conditional mode} of $\mc U$, given $\mc Y=\bm y$, which minimizes the PSSR with respect to $\bm u$ \begin{equation} \label{eq:penalizedsumofsquares} (\tilde{\bm u} | \mc Y=\bm y,\bm\theta,\bm\beta) = \argmin_{\bm u}\left[\sum_{i=1}^n(y_i-\mu_i)^2+\|\bm u\|^2\right] . \end{equation} The PSSR can be minimized directly (i.e. without iteration) and the minimum doesn't depend on $\sigma^2$. When the minimum PSSR and the determinant of the Hessian of the PSSR, which can be evaluated from a Cholesky factor created in the process of solving eq.~\ref{eq:penalizedsumofsquares}, are available the MLE of $\sigma^2$ can be evaluated separately, as is commonly done in linear models. Because $\bm\beta$ and $\bm u$ both occur as coefficients in the linear predictor, the conditional estimate, $\widehat{\bm\beta}|\bm\theta$, can be determined along with $\tilde{\bm u}$ by extending the penalized least squares problem, (eq.~\ref{eq:penalizedsumofsquares}), to minimize with respect to both $\bm u$ and $\bm\beta$. Thus, given a value of $\bm\theta$ and the solution to this extended PSSR problem, the profiled log-likelihood, which is a function of $\bm\theta$ only, can be evaluated. General nonlinear optimizers applied to the profiled log-likelihood as a function of $\bm\theta$ are used to determine the MLEs for all the parameters. The point of using the profiled log-likelihood instead of the original log-likelihood is that the dimension of the general nonlinear optimization problem is much smaller in the profiled problem. \subsection{The Generalized Linear Mixed Model} As stated earlier, a GLMM combines the distribution family and link function, from a GLM, with random effects in the linear predictor, as in an LMM. The unconditional distribution of the random effects, $\mc B\sim\mc N(\bm 0, \bm\Sigma_{\bm\theta})$, and the definitions of the spherical random effects, $\mc U$, such that $\mc B=\bm\Lambda_{\bm\theta}\mc U$ where $\Lambda_{\bm\theta}\Lambda_{\bm\theta}\trans=\bm\Sigma$ are as in the LMM except that the scale parameter, $\sigma$, is not present in the most common GLMMs (binomial and Poisson families). The mean of the conditional distribution, $\mc Y|\mc U=\bm u$, is the inverse link applied to the linear predictor $\bm\eta=\bm X\bm\beta+\bm Z\bm\Lambda_{\bm\theta}\bm u$. The conditional mode, which minimizes the \emph{penalized sum of unit deviances} (PSUD), \begin{equation} \label{eq:condmodeGLMM} (\tilde{\bm u}|\mc Y=\bm y,\bm\theta,\bm\beta)=\argmin_{\bm u}\left[\sum_{i=1}^n d(y_i,\mu_i) + \|\bm u\|^2\right], \end{equation} is determined by penalized iteratively reweighted least squares (PIRLS). In the case of an LMM, minimizing the PSSR provided the value of the integral defining the likelihood of the parameters, given the observed response, $\mc Y=\bm y$. For a GLMM, minimizing the PSUD provides a local quadratic approximation to the logarithm of the joint density, $f_{\mc Y,\mc U}(\bm y,\bm u)$. Approximating the integral with respect to $\bm u$ of the joint density (evaluated at the observed $\bm y$) by the integral of this local quadratic approximation is \emph{Laplace's method}. For simple models involving scalar random effects from a single random-effects term the multivariate integral with respect to $\bm u$ can be factored into a product of scalar integrals, which can be evaluated by Gauss-Hermite rules. %\footnote{The \code{lme4} package supports fitting negative binomial GLMMs, %which are an extension of GLMMs; the negative binomial family is within the %exponential dispersion family if the dispersion parameter is fixed. %The \code{glmer.nb} function uses a one-dimensional optimizer %to estimate the dispersion parameter, fitting a negative binomial GLMM with %a fixed dispersion parameter at each trial value. In practice this %implementation is slower than those in other R packages (e.g., the \code{glmmTMB} package).} To summarize: \begin{enumerate} \item Like a GLM, the definition of a GLMM incorporates a distribution family and a link function. The distribution family determines the unit deviances, $d(y_i,\mu_i),i=1,\dots,n$. Distributions in the exponential distribution family have a canonical link which is the default link in \code{glm} and in \code{glmer} for those families. \item As in an LMM the linear predictor, $\bm\eta=\bm X\bm\beta+\bm Z\bm b$, incorporates fixed-effects parameters, $\bm\beta$, and random effects, $\mc B\sim\mc N(\bm 0,\bm\Sigma_{\bm\theta})$. \item The parameters $\bm\theta$ determine a triangular relative covariance factor, $\bm\Lambda_{\bm\theta}$, such that $\bm\Sigma_{\bm\theta}=\bm\Lambda_{\bm\theta}\bm\Lambda_{\bm\theta}\trans$. (A scale parameter, $\sigma$, is incorporated for families like the Gaussian that use one.) \item For given values of $\bm\beta$ and $\bm\theta$, the penalized sum of unit deviances (PSUD), $\sum_{i=1}^n d(y_i,\mu_i)+\|\bm u\|^2$, is minimized with respect to $\bm u$ using PIRLS. \item A local quadratic approximation to the PSUD at the conditional mode provides Laplace's approximation to the log-likelihood, which is minimized with respect to $\bm\beta$ and $\bm\theta$. \item In certain simple models adaptive Gauss-Hermite quadrature (aGHQ) can be used to approximate the log-likelihood more accurately, at the expense of more evaluations of the PSUD for each candidate combination of $\bm\beta$ and $\bm\theta$. \item If the PSUD is minimized with respect to $\bm u$ and $\bm\beta$ simultaneously then the approximate profiled log-likelihood becomes a function of $\bm\theta$ only, as discussed below. This approximation can save computation time for large problems. \end{enumerate} \subsection{Determining the conditional mode} \label{sec:conditionalMode} The iteratively reweighted least squares (IRLS) algorithm is an efficient method of determining the maximum likelihood estimates of the coefficients in a GLM. As the name IRLS implies this is an iterative algorithm where the $(k+1)$st coefficient vector, $\bm\beta^{(k+1)}$, is determined from $\bm\beta^{(k)}$, and the process continues until convergence. At the $k$th iteration, the linear predictor is $\bm\eta^{(k)}=\bm X\bm\beta^{(k)}$ and the mean response vector is $\bm\mu^{(k)}=\bm g^{-1}(\bm\eta^{(k)})$. The residual on the response scale, $\bm r^{(k)}=\bm y-\bm\mu^{(k)}$, is mapped to a \emph{working residual} on the linear predictor scale via a linear approximation to the link function. Because the link and inverse link are diagonal maps we can write the working residual component-wise as \begin{equation} \label{eq:wrkresid} \tilde{r}_i^{(k)}=(y_i - \mu_i^{(k)})g^\prime(\mu_i^{(k)})\quad i=1,\dots,n , \end{equation} where $g^\prime(\mu_i^{(k)})$ denotes the derivative of the link function at $\mu_i^{(k)}$. Because the variances of the working residuals are not constant we must evaluate these variances and use weighted least squares, with the weights inversely proportional to the variances, to determine an increment $\bm\delta^{(k)}$ such that $\bm\beta^{(k+1)}=\bm\beta^{(k)}+\bm\delta^{(k)}$. (The \emph{working weights} based on the variances are combined with the prior weights $w_i$, if any have been specified.) An alternative approach is to define a \emph{working response} \begin{equation} \label{eq:wrkresp} \tilde{y}_i^{(k)}=(\eta_i^{(k)}- o_i)+\tilde{r}_i^{(k)},\quad i=1,\dots,k \end{equation} where $o_i$ is an optional \emph{offset} to be applied on the linear predictor scale. IRLS is usually implemented by solving a weighted least squares problem on the working residual for the increment, $\bm\delta^{(k)}$, at each iteration. For the \emph{penalized iteratively reweighted least squares} (PIRLS) algorithm to determine $\bm u^{(k+1)}$ from $\bm u^{(k)}$ it is easiest to use the working response because the penalty is defined as $\|\bm u^{(k+1)}\|^2$ so the penalized weighted least squares calculation should be in terms of $\bm u$. In more detail, the PIRLS algorithm has the form \begin{enumerate} \item Given parameter values, $\bm\beta$ and $\bm\theta$, incorporate the fixed-effects contribution to the linear predictor, $\bm X\bm\beta$, as an \emph{offset}, $\bm o$, to be used in evaluating the working response (eq. \ref{eq:wrkresp}). Set the initial values of $\bm u^{(0)}=\bm 0$ so that the PIRLS iterations always start from the same value of $\bm u$, providing for a stable result that depends only on $\bm\beta$ and $\bm\theta$. Evaluate the lower triangular $\bm\Lambda_{\bm\theta}$, the linear predictor \begin{equation} \label{eq:linpredPIRLS0} \bm\eta^{(0)}=\bm Z\bm\Lambda_{\bm\theta}\bm u^{(0)} + \bm o, \end{equation} the conditional mean of $\mc Y|\mc U=\bm u^{(0)}$, \begin{equation} \label{eq:condmeanPIRLS0} \bm\mu^{(0)}=\bm g^{-1}(\bm\eta^{(0)}), \end{equation} the (diagonal) Jacobian matrix, \begin{equation} \label{eq:Jacobian} \bm J^{(0)}=\frac{d \bm\mu}{d \bm\eta^\top}={\bm g^{-1}}^\prime \end{equation} and the conditional variance \begin{equation} \label{eq:confvarPIRLS} \bm V^{(0)}=\mathrm{Var}(\mc Y|\bm\mu=\bm\mu^{(0)}) \end{equation} which is also a diagonal matrix. \item Establish the weights as the inverse of the combined variance contributions from $\bm\eta$: \begin{equation} \label{eq:PIRLSweights} \bm W^{(0)}=\left(\bm J^{(0)\top}\bm V^{(0)}\bm J^{(0)}\right)^{-1} \end{equation} (we would also multiply this quantity by a diagonal matrix of prior weights, if any were specified). Eq. \ref{eq:PIRLSweights} is written as a product and an inverse of matrices but all the matrices involved are diagonal and the evaluation of eq.~\ref{eq:PIRLSweights} is performed as vector operations. \item Evaluate $\bm u^{(1)}$ as the solution to the penalized, weighted least squares problem \begin{equation} \label{eq:PIRLSeqn} \left(\bm \Lambda^\top\bm Z^\top\bm W^{(0)}\bm Z\bm\Lambda + \bm I\right)\bm u^{(1)}= \bm\Lambda^\top\bm Z^\top \bm W^{(0)}\tilde{\bm y}^{(0)} \end{equation} using the sparse Cholesky factor, $\bm L_{\bm\beta,\bm\theta}^{(0)}$, defined by \begin{equation} \label{eq:sparseChol} \bm L_{\bm\beta,\bm\theta}^{(0)}\bm L_{\bm\beta,\bm\theta}^{(0)\top}= \bm P\left(\bm \Lambda^\top\bm Z^\top\bm W^{(0)}\bm Z\bm\Lambda + \bm I\right)\bm P^\top , \end{equation} where $\bm P$ is the matrix representation of a \emph{fill-reducing permutation} determined from the structure of $\bm Z^\top\bm Z$. (In simple GLMM problems $\bm P$ can be an identity matrix but for general sparse Cholesky evaluations determining and employing a fill-reducing permutation can be important in reducing memory usage and compute time.) \item Evaluate PSUD, the penalized sum of unit deviances, at $\bm u^{(1)}$. If the PSUD at $\bm u^{(1)}$ exceeds that at $\bm u^{(0)}$ use \emph{step-halving} which, in this case, means replacing $\bm u^{(1)}$ by the average of $\bm u^{(0)}$ and $\bm u^{(1)}$, and trying again. We set a maximum, usually 10 or fewer, on the number of step-halvings that are allowed before declaring the algorithm to have failed. \item If the iteration succeeds in reducing the PSUD, check for convergence by comparing the weights, $\bm W^{(i+1)}$, to $\bm W^{(i)}$. If the relative differences in the weights are small the algorithm is declared to have converged. Otherwise repeat the previous steps using evaluations at $\bm u^{(i)}$ to produce $\bm u^{(i+1)}$. \end{enumerate} \subsection{Evaluating the likelihood for GLMMs using the Laplace approximation} \label{sec:Laplace} Evaluating the likelihood for generalized linear mixed models requires approximating an intractable integral over the random effects distribution. The \code{glmer} function offers several approximations, controlled by the \code{nAGQ} argument. The default value of \code{nAGQ=1} specifies the \emph{Laplace approximation} \citep{madsen2011}. A second-order Taylor series approximation to $-2\log[f_{\mc Y,\mc U}(\bm y,\bm u)]$ based at $\tilde{\bm u}$ provides an approximation of the unscaled conditional density as a multiple of the density for the multivariate Gaussian $\mathcal{N}(\tilde{\bm u},\bm L\bm L\trans)$. The change of variable \begin{equation} \label{eq:LaplaceChg} \bm u = \tilde{\bm u} + \bm L\bm z \end{equation} provides \begin{equation} \label{eq:GLMMLaplace} \begin{aligned} L(\bm\beta,\bm\theta|\bm y)&=\int_{\mathbb{R}^q}f_{\mc Y,\mc U}(\bm y,\bm u)\,d\bm u\\ &\approx \tilde{f}\,|\bm L|\, \int_{\mathbb{R}^q}e^{-\|\bm z\|^2/2}\,(2\pi)^{-q/2}\,d\bm z\\ &=\tilde{f}\, |\bm L| \end{aligned} \end{equation} (where $\tilde f$ is the penalized deviance evaluated at the conditional modes) or, on the deviance scale, \begin{equation} \label{eq:LaplaceDev} -2\ell(\bm\beta,\bm\theta|\bm y)\approx\sum_{i=1}^n d(y_i, \mu_i) + \|\tilde{\bm u}\|^2 + \log(|\bm L|^2)+\frac{q}{2}\log(2\pi) \end{equation} The Laplace approximation normally conditions on both the fixed effects $\beta$ and the variance-covariance parameters $\theta$. A further approximation, which is denoted in \code{glmer} by \code{nAGQ=0}, profiles out the fixed effects by minimizing with respect to $\bm\beta$ and $\bm u$ simultaneously in the PIRLS algorithm (i.e., replacing $\bm u$ with $(\bm \beta \; \bm u)$ and $\bm Z \bm \Lambda$ with $(\bm X | \bm Z \bm \Lambda)$ throughout, except with the penalty term still applying only to $\bm u$). This approximation is exact when (1) $\partial(\log L)/\partial \beta$ is a linear function of the conditional modes $\bm u$ and (2) when the conditional mode is equal to the conditional mean (typically, although not necessarily, implying a symmetric conditional distribution). Both assumptions hold for linear mixed models (although a Laplace approximation is not necessary there), consistent with \cite{bates2015fitting} showing that the fixed effects can be profiled out of the log-likelihood for LMMs. The Julia \code{MixedModels.jl} package offers the same approximation as the \code{fast} argument to the \code{pirls!} function (\url{https://juliastats.org/MixedModels.jl/stable/optimization/}); Template Model Builder \citep{kristensenTMB2016}, and downstream packages such as \code{glmmTMB}, provide this function via a \code{profile} argument. By default, \code{glmer} uses a two-stage optimization procedure (described below) with \code{nAGQ=0} in the first stage; users can also specify \code{nAGQ=0} for faster, approximate model fits. \subsubsection{Decomposing the deviance for simple models} \label{sec:simplescalar} A common special case of mixed models is those where scalar (typically intercept) random effects are associated with levels of a single grouping factor, $\bm h$. In this case the dimension, $q$, of the random effects is the number of levels of $\bm h$ --- i.e.{} there is exactly one random effect associated with each level of $\bm h$. We will write the vector of variance-covariance parameters, which is one-dimensional, as a scalar, $\theta$. The matrix $\bm\Lambda_{\bm\theta}$ is a multiple of the identity, $\theta\bm I_q$, and $\bm Z$ is the $n\times q$ matrix of indicators of the levels of $\bm f$. The permutation matrix, $\bm P$, can be set to the identity and $\bm L$ is diagonal, although not necessarily homogeneous (i.e., a scalar multiple of the identity matrix). Because each element of $\bm\mu$ depends on only one element of $\bm u$ and the elements of $\mc Y$ are conditionally independent, given $\mc U=\bm u$, the conditional densities of the $u_j,j=1,\dots,q$ given $\mc Y=\bm y$ are independent. We partition the indices $1,\dots,n$ as $\mathbb{I}_j,j=1,\dots,q$ according to the levels of $\bm h$. That is, the index $i$ is in $\mathbb{I}_j$ if $h_i=j$. This partitioning also applies to the deviance residuals in that the $i$th deviance residual depends only on $u_j$ when $i\in\mathbb{I}_j$. Writing the univariate conditional densities as \begin{equation} \label{eq:univariateCondDens} f_j(\bm y,u_j)=\exp\left(-\frac{\sum_{i\in\mathbb{I}_j}d(y_i, u_j)+u_j^2}{2}\right)(2\pi)^{-1/2} \end{equation} we have \begin{equation} \label{eq:vectorCondDens} f_{\mc Y,\mc U}(\bm y,\bm u)=\prod_{j=1}^q f_j(\bm y,u_j) \end{equation} and \begin{equation} \label{eq:ssLike} \begin{aligned} L(\bm\beta,\bm\theta|\bm y)=\prod_{j=1}^q\int_{\mathbb{R}}f_j(\bm y,u)\,du \end{aligned} \end{equation} We consider this special case both because it occurs frequently and because, for some software, it is the only type of GLMM that can be fit. Also, in this particular case we can graphically assess the quality of the Laplace approximation by comparing the actual integrand to its approximation. Consider the \code{cbpp} data on contagious bovine pleuropneumonia (CBPP) incidence according to season and herd, available in the \pkg{lme4} package (see \ref{sec:cbpp} for more details), and the model <>= print(m1 <- glmer(cbind(incidence, size-incidence) ~ period + (1|herd), cbpp, binomial), corr=FALSE) @ This model has been fit by minimizing the Laplace approximation to the deviance. We can assess the quality of this approximation by evaluating the unscaled conditional density at $u_j(z)=\tilde{u_j} + z/{\bm L_{j,j}}$ and comparing the ratio, $f_j(\bm y,u)/(\tilde{f_j}\sqrt{2\pi})$, to the standard normal density, $\phi(z)=e^{-z^2/2}/\sqrt{2\pi}$, as shown in Figure~\ref{fig:densities}. <>= zeta <- function(m, zmin=-3, zmax=3, npts=301L, rank = FALSE) { stopifnot (is(m, "glmerMod"), length(m@flist) == 1L, # single grouping factor length(m@cnms[[1]]) == 1L) # single column for that grouping factor pp <- m rr <- m@resp u0 <- getME(pp,"u") sd <- 1/getME(pp,"L")@x ff <- as.integer(getME(pp,"flist")[[1]]) fc <- getME(pp,"X") %*% getME(pp,"beta") # fixed-effects contribution to linear predictor ZL <- t(getME(pp,"Lambdat") %*% getME(pp,"Zt")) dc <- function(z) { # evaluate the unscaled conditional density on the deviance scale uu <- u0 + z * sd rr$updateMu(fc + ZL %*% uu) unname(as.vector(tapply(rr$devResid(), ff, sum))) + uu * uu } zvals <- seq(zmin, zmax, length.out = npts) d0 <- dc(0) # because this is the last evaluation, the model is restored to its incoming state # signed square root sqrtmat <- t(sqrt(vapply(zvals, dc, d0, USE.NAMES=FALSE) - d0)) * array(ifelse(zvals < 0, -1, 1), c(npts, length(u0))) if (rank) { ## order by 'badness' (variance of normalized profile) nvals <- exp(-0.5*sqrtmat^2)/sqrt(2*pi)/dnorm(zvals) colnames(sqrtmat) <- seq(ncol(sqrtmat)) sqrtmat <- sqrtmat[,order(apply(sqrtmat, 2, var), decreasing = TRUE)] } list(zvals=zvals, sqrtmat= sqrtmat ) } smult <- function(x, y) { sweep(x, y, MARGIN = 2, FUN = "*") } lagr_basis_i <- function(i, xvec, q) { num <- sapply(xvec, \(x) prod(x-q[-i])) denom <- prod(q[i]-q[-i]) num/denom } lagr_basis_deriv_i <- function(i, xvec, q) { if (length(q)==1) return(rep(0, length(xvec))) f <- function(j) sapply(xvec, \(x) prod(x-q[-c(i,j)])) num <- rowSums(sapply(seq_along(q)[-i], f)) denom <- prod(q[i]-q[-i]) num/denom } lagr_basis <- function(xvec, q, deriv = FALSE) { FUN <- if (!deriv) lagr_basis_i else lagr_basis_deriv_i sapply(seq_along(q), \(i) FUN(i, xvec, q)) } calc_h <- function(xvec, Q) { gg <- GHrule(Q) ell <- lagr_basis(xvec, gg[,"z"]) ## dl_i/dx(x_i) bb <- lagr_basis(gg[,"z"], gg[,"z"], deriv = TRUE) d_ell <- if (length(bb) == 1) bb else diag(bb) xdiff <- outer(xvec, gg[,"z"], "-") h <- (1 - 2*smult(xdiff, d_ell))*ell^2 hbar <- xdiff*ell^2 list(h = h, hbar = hbar) } ## FIXME: modify to work when Q = 1 ghq_fun <- function(Q, zvals, f, fbar, H = NULL) { q <- GHrule(Q)[,"z"] H <- H %||% calc_h(zvals, Q = Q) dz <- diff(zvals[1:2]) Qvals <- sapply(q, \(x) which.min(abs(zvals - x))) if (any(Qvals == 1)) stop("need to extend zm calculation") q_approx <- rowSums(smult(H$h, f[Qvals])) + rowSums(smult(H$hbar, fbar[Qvals])) q_approx } calc_q <- function(Q, zm) { dz <- diff(zm$zvals[1:2]) dmat <- exp(-0.5*zm$sqrtmat^2)/sqrt(2*pi)/dnorm(zm$zvals) ## finite difference (NA to match dimension) d_dmat <- rbind(NA,apply(dmat, 2, function(x) diff(x)/dz)) H <- calc_h(zm$zvals, Q = Q) res <- sapply(1:ncol(dmat), \(i) ghq_fun(Q, zm$zvals, dmat[,i], d_dmat[,i], H = H) ) attr(res, "nAGQ") <- Q res } plot_zeta <- function(z, q_approx = NULL, norm = FALSE, ylab = if (!norm) "density" else "t(z)", which = NULL, layout = c(5,3), ylim = NULL, auto.key = list(lines = TRUE, points = FALSE)) { dmat <- exp(-0.5*z$sqrtmat^2)/sqrt(2*pi) Q <- attr(q_approx, "nAGQ") ## rescue attribute before subsetting if (!is.null(which)) { dmat <- dmat[, which] q_approx <- q_approx[, which] } ## columnwise scaling/unscaling ## q_approx is normalized by default if (norm) dmat <- dmat/dnorm(z$zvals) if (!norm) q_approx <- q_approx*dnorm(z$zvals) nobs <- nrow(dmat) npanel <- ncol(dmat) idx <- gl(npanel, nobs) ngrp <- 3 ref_val <- if (!norm) dnorm(z$zvals) else rep(1, nobs) ref_val <- rep(ref_val, npanel) grps <- c("conditional\ndensity", sprintf("AGQ(%d)", Q), if (!norm) "N(0,1)" else "") groups <- factor(rep(grps, each = nobs * npanel), levels = grps) resp <- c(as.vector(dmat), as.vector(q_approx), ref_val) ylim <- ylim %||% extendrange(resp) zvec <- rep(z$zvals, ngrp * npanel) xyplot(resp ~ zvec | rep(idx, ngrp), groups = groups, type = c("g", "l"), aspect = 0.6, layout = layout, xlab = "z", ylab = ylab, auto.key = auto.key, par.settings = list(superpose.line = list(lty = 1:3)), ylim = ylim) } @ \begin{figure}[tbp] \centering <>= zm <- zeta(m1, -3.750440, 3.750440) qq <- calc_q(3, zm) plot_zeta(zm, q_approx = qq) @ \caption{Comparison of univariate integrands (solid, blue line); 3-point Gauss-Hermite quadrature (dashed, yellow); and standard normal density function (green, dotted) for the CBPP model. For this model, the three approximations are nearly indistinguishable.} \label{fig:densities} \end{figure} As Figure~\ref{fig:densities} shows, the univariate integrands are very close to the standard normal density, indicating that the Laplace approximation to the deviance is a good approximation in this case. \section{Adaptive Gauss-Hermite quadrature for GLMMs} \label{sec:aGQ} When the first integral in (\ref{eq:GLMMLaplace}) can be expressed as a product of low-dimensional integrals, we can use Gauss-Hermite quadrature to provide a closer approximation to the integral. Univariate Gauss-Hermite quadrature evaluates the integral of a function that is multiplied by a ``kernel'' where the kernel is a multiple of $e^{-z^2}$ or $e^{-z^2/2}$. For statisticians the natural candidate is the standard normal density, $\phi(z)=e^{-z^2/2}/\sqrt(2\pi)$. A $k$th-order Gauss-Hermite formula provides knots, $z_i,i=1,...,k$, and weights, $w_i,i=1,\dots,k$, such that \begin{equation} \label{eq:GHquad} \int_{\mathbb{R}}t(z)\phi(z)\,dz\approx\sum_{i=1}^kw_it(z_i) \end{equation} The function \code{GHrule} in \pkg{lme4} (based on code in the \pkg{SparseGrid} package) provides knots and weights relative to the standard normal kernel for orders $k$ from 1 to 100. For example, <>= GHrule(5) @ where \code{z} is the vector of knots, \code{w} is the vector of weights, and \code{ldnorm} is the log-density of the standard normal distribution at $z$. The choice of the value of $k$ depends on the behavior of the function $t(z)$. If $t(z)$ is a polynomial of degree $2k-1$ then the Gauss-Hermite formula for orders $k$ or greater provides an exact answer. The fact that we want $t(z)$ to behave like a low-order polynomial is often neglected in the formulation of a Gauss-Hermite approximation to a quadrature. The quadrature knots on the $u$ scale are chosen as \begin{equation} \label{eq:quadraturepts} u_{i,j}(z)=\tilde{u_j} + z_i/{\bm L_{j,j}},\quad i=1,\dots,k;\;j=1,\dots,q \end{equation} exactly so that the function $t(z)$ should behave like a low-order polynomial over the region of interest, which is to say the region where quadrature knots with large weights are located. The term ``adaptive Gauss-Hermite quadrature'' reflects the fact that the approximating Gaussian density is scaled and shifted to provide a second order approximation to the logarithm of the unscaled conditional density. Figure~\ref{fig:tfunc} shows $t(z)$ for each of the unidimensional integrals in the likelihood for the model \code{m1} at the parameter estimates. While this view shows the deficiency of the Laplace approximation (deviation from a horizontal reference line at $z=1$) clearly, The AGQ(3) approximation fits extremely well over the range shown. The tails of the polynomials implied by the AGQ approximation can fluctuate widely, but these fluctuations are suppressed by multiplying by the thin tails of the Gaussian distribution (so that in Figure~\ref{fig:densities} the deviations of the conditional density from the standard Normal are barely visible). \begin{figure}[tbp] \centering <>= plot_zeta(zm, q_approx = qq, norm = TRUE, ylim = c(0.5, 1.5)) @ \caption{The function $t(z)$, which is the ratio of the normalized unscaled conditional density to the standard normal density, for each of the univariate integrals in the evaluation of the deviance for model \code{m1} (blue, solid line). As in Figure~\ref{fig:densities}, the dashed yellow line shows the approximation for 3-point adaptive Gauss-Hermite quadrature. The horizontal green reference line ($z=1$) gives the reference value that would apply for the Laplace approximation, which assumes the conditional density is exactly equal to the standard normal. The $y$-axis limits are truncated to (0.5, 1.5). } \label{fig:tfunc} \end{figure} <>= data("toenail", package = "lme4") ttab <- with(toenail, table(table(patientID))) ## sum(as.numeric(names(ttab))*ttab/sum(ttab)) @ The CBPP data set is a relatively well-behaved data set, where Laplace approximation works well. In contrast, a widely used data set on toenail onychomycosis \citep{debacker+1998}, which has a very low effective sample size per cluster --- an average of about 6.5 binary observations (``moderate or severe'' vs ``none or mild'' disease) per patient --- represents an example where Gauss-Hermite quadrature is necessary for reliable results. In this case the conditional densities depart much more clearly from the standard normal (Figure~\ref{fig:toenailplot}; note the scale of the density ratios goes from 0 to 10, in contrast the maximum of 4 in Figure~\ref{fig:tfunc}). \cite{stringerAsymptoticsNumericalIntegration2022} and \cite{stringerExactGradientEvaluation2024} further explore the limitations of Laplace approximation. %% from Alex S.: The "Stringer A, Bilodeau B, Tang Y (2022)” paper was accepted in March 2025: Bilodeau, B., Stringer, A., and Tang, Y. (2026). Asymptotics of adaptive quadrature for two-level mixed models. Bernoulli (forthcoming). It is scheduled to be published quite soon I believe. \begin{figure}[tbp] \centering <>= data("toenail", package = "lme4") toemod <- glmer(outcome ~ time*treatment + (1 | patientID), data = toenail, family = binomial(link = "logit")) zm <- zeta(toemod) q_toe <- calc_q(3, zm) set.seed(101); s <- sample(ncol(zm$sqrtmat), size = 9) gridExtra::grid.arrange( plot_zeta(zm, q_approx = q_toe, which = s, layout = c(3,3), auto.key = FALSE), plot_zeta(zm, which = s, norm = TRUE, q_approx = q_toe, layout = c(3,3), ylim = c(0, 5)), nrow = 1, ## widths hand-tweaked to equalize plot size with/without scale widths = c(0.5, 0.63)) @ \caption{Normalized unscaled conditional density (left) and ratio of density to the standard normal density (right) for a random sample of 9 patients from the toenail onychomycosis data set. The $y$-axis limits in the right panel ($t(z)$) are truncated to $(0,5)$.} \label{fig:toenailplot} \end{figure} To use adaptive Gauss-Hermite quadrature for model fitting in \code{glmer} models, users would set the argument \code{nAGQ}, the number of quadrature points (i.e. $k$ in eq.~\ref{eq:GHquad}), to a value greater than 1. Increasing the number of nodes generally improves the accuracy of the likelihood approximation at the expense of computation time --- although rounding errors may accumulate when using large numbers of quadrature points. A reasonable strategy for choosing the number of nodes is to re-fit the model with increasing values of \code{nAGQ} until the parameter estimates stabilize \citep{tuerlinckxStatisticalInferenceGeneralized2006a}; a ``warm-start'' procedure using the parameter estimates from the previous fit as starting values (and using \code{control = glmerControl(nAGQ0initStep = FALSE)} to disable the \code{nAGQ=0} preliminary fit) will speed up this procedure. At present, AGQ is only available for models with a single scalar random effect. (The \code{GLMMadaptive} package implements AGQ for vector-valued random effect models, although it is still restricted to models with a single random effect; \cite{rabe-heskethMaximumLikelihoodEstimation2005b} describe methods for AGQ for models with nested random effects.) \section{Model fitting} Once we can calculate the deviance by PIRLS for specified values of $\btheta$ and $\bbeta$ (or only $\btheta$ if profiling out the fixed effects via \code{nAGQ=0}), we then estimate the parameters by nonlinear optimization. This procedure largely follows the description in \cite{bates2015fitting}, using derivative-free optimizers with box constraints to prevent non-positive-(semi)definite covariance matrices. Specifically, the elements of $\btheta$ corresponding to the diagonal of $\bm\Lambda_\theta$ are currently constrained to be non-negative. The only difference is that by default \code{glmer} uses a two-step fitting procedure, using \code{nAGQ=0} at the first stage to get preliminary estimates which are then used as starting points for a second optimization with Laplace approximation or Gauss-Hermite quadrature as specified by the user. Different nonlinear optimizers can be used at each stage: the current default, as specified in \code{glmerControl}, is to use Powell's BOBYQA \citep{Powell_bobyqa} followed by a box-constrained variant of the Nelder-Mead simplex algorithm. For faster, approximate fitting, the second stage can be omitted; in the rare cases where the initial \code{nAGQ=0} fit gives poor results, the first stage can be skipped via \code{glmerControl(nAGQ0initStep = FALSE)}. However, because the profiled log-likelihood is an even function of the diagonal elements of $\btheta$ and $\bm\Sigma_\theta=\bm\Lambda_\theta\bm\Lambda_\theta\trans$ depends on them only through their squares, positive and negative values yield identical likelihoods. This symmetry means that constrained optimization is not strictly necessary --- an unconstrained optimizer will converge to a correct solution, approaching zero from either side in the boundary case of a singular random-effects covariance matrix. (Once a solution is found, we can map it to a unique solution where the diagonal elements are all non-negative.) A similar approach to removing constraints could work for structured covariance matrices where correlation parameters are constrained to $(-1,1)$, e.g. by parameterizing the model in terms of a phase parameter $p$ where $\rho = \sin(p)$ (and then mapping $p$ to $(0, 2\pi)$). Removing these constraint would permit the use of a broader class of unconstrained optimizers, though this feature has not yet been incorporated into \code{lme4}. \section{Examples} \subsection{CBPP} \label{sec:cbpp} The \code{?cbpp} help page describes the CBPP data set \citep{lesnoff_within-herd_2004} as follows: \begin{quote} Contagious bovine pleuropneumonia (CBPP) is a major disease of cattle in Africa, caused by a mycoplasma. This dataset describes the serological incidence of CBPP in zebu cattle during a follow-up survey implemented in 15 commercial herds located in the Boji district of Ethiopia. The goal of the survey was to study the within-herd spread of CBPP in newly infected herds. Blood samples were quarterly collected from all animals of these herds to determine their CBPP status. These data were used to compute the serological incidence of CBPP (new cases occurring during a given time period). Some data are missing (lost to follow-up). \end{quote} \cite{lesnoff_within-herd_2004} estimated the effects of different treatments using (1) ordinary logistic regression incorporating a variance-inflation factor, also known as a quasi-binomial model (``logistic regression'' is sometimes used specifically to describe analyses of Bernoulli responses, but in this case there are multiple trials per observation [cows that could become seropositive], and so a dispersion or scale parameter can be estimated); (2) a GLMM implemented in \code{lme4}; and a (3) Markov chain Monte Carlo algorithm \citep{zeger1991generalized}, which as they state allows for a non-parametric rather than a Normal model for the random effects. The authors did not find any significant effects of treatment, ascribing the null results to ``a lack of power in the statistical analyses or to a quality problem for the medications used (and more generally, for health-care delivery in the Boji district).'' <>= cbpp2 <- read.csv(system.file("vignette_data", "cbpp2.csv", package = "lme4")) cbpp2 <- transform(cbpp2,period=factor(period), treatment=factor(treatment, levels=c("Partial/null","Complete","Unknown"))) @ (Note that Table 1 of \cite{lesnoff_within-herd_2004} contains a known typographical error for herd 6. Consequently, results obtained using the \code{cbpp} data set may not exactly reproduce some of the findings reported in that paper.) The \code{lme4} package includes two variants of the \code{cbpp} data set. The second variant, \code{cbpp2}, contains corrected values corresponding to Table~1 of \cite{lesnoff_within-herd_2004}. Although the precise provenance of these data sets is unclear, the \code{cbpp} data set matches the version held by the corresponding author of \cite{lesnoff_within-herd_2004}. <>= g0 <- ggplot(cbpp2,aes(period, incidence/size, colour=treatment, shape = treatment)) + ## scale_y_continuous(limits = c(0, 1))+ labs(x="Period",y="Proportional incidence")+ scale_colour_brewer(palette="Dark2") ## faceted plot ## g0 + ## geom_point(aes(size = size)) + ## facet_wrap(~herd) + ## zmargin ## g0 + geom_point(aes(size = size),alpha=0.4) + geom_line(aes(group=herd),alpha=0.3) ## geom_boxplot(fill="black",alpha=0.1,width=0.5, ## aes(group=interaction(period,treatment))) ## ## boxplot(incidence/size ~ period, data = cbpp, las = 1, ## xlab = 'Period', ylab = 'Probability of sero-positivity') @ We model proportional incidence as a binomial response depending on the additive fixed effects of period, treatment and average herd size; to account for repeated measures we fit a model with a random effect of herd. In practice we might also be interested in a period by treatment interaction, but we neglect that term here. As in \code{glm}, we can specify a binomial response as a proportion and use the \code{weights} argument to specify the sample size, instead of the more typical two-column \code{cbind(successes,failures)} format: <>= gm1 <- glmer(incidence/size ~ period + treatment + avg_size + (1 | herd), family = binomial, data = cbpp2, weights = size) @ <>= ## diagnostic junk about N-M vs bobyqa differences tmpf <- function(x) c(deviance(x), unlist(getME(x,c("theta","beta")))) gm1 <- glmer(incidence/size ~ period + treatment + avg_size + (1 | herd), family = binomial, data = cbpp2, weights = size) gm1B <- update(gm1,control=glmerControl(optimizer="bobyqa")) cbind(tmpf(gm1),tmpf(gm1B)) dd1 <- update(gm1,devFunOnly=TRUE) dd1B <- update(gm1B,devFunOnly=TRUE) gm1@optinfo$derivs$gradient gm1B@optinfo$derivs$gradient gm1@optinfo$derivs$gradient/gm1B@optinfo$derivs$gradient library(numDeriv) grad(dd1,tmpf(gm1)[-1]) grad(dd1B,tmpf(gm1B)[-1]) @ It is also worth considering adding an observation-level random effect to the model \citep{harrisonComparisonObservationlevelRandom2015}, which we can do by creating a new factor based on observation number and using \code{update()} on the previous model (we switch the optimizer to BOBYQA for both phases for one of the updates): <>= cbpp2 <- transform(cbpp2,obs=factor(seq(nrow(cbpp2)))) bob_opt <- glmerControl(optimizer = "bobyqa") ## herd and observation-level REs gm2 <- update(gm1,.~.+(1|obs), control = bob_opt) ## observation-level REs only gm3 <- update(gm1,.~.-(1|herd)+(1|obs)) @ <>= aa <- allFit(gm2, verbose=FALSE) ok <- summary(aa)[["which.OK"]] lapply(aa[ok], \(x) x@optinfo$conv$lme4$messages) @ \subsubsection{Model summary} The first part of the summary reiterates the family and link function used, the model formula, and gives various summary statistics (log-likelihood etc.), as well as quantiles of the scaled (Pearson) residuals: <>= ss <- summary(gm1) cc <- capture.output(print(summary(gm1))) reRow <- grep("^Random effects",cc) cat(cc[1:(reRow-2)],sep="\n") @ These quantities are also accessible via standard accessors (\code{AIC()}, \code{BIC()}, \code{logLik()}). The next chunk of \code{summary()} describes the random effects and the number of levels associated with each grouping factor (the latter is useful for checking that random-effects formulae have been specified correctly): <>= feRow <- grep("^Fixed effects",cc) cat(cc[reRow:(feRow-2)],sep="\n") @ This information is also accessible via \code{VarCorr()}, which returns a list of variance-covariance matrices (the \code{print} method for \code{VarCorr} objects allows control of whether the variance, or standard deviation, or both, are printed). Next come the estimates of the fixed effects, along with Wald estimates of the standard error, $Z$ statistic, and $p$-value: <>= corRow <- grep("^Correlation",cc) cat(cc[feRow:(corRow-2)],sep="\n") @ One can use \code{coef(summary())} to retrieve this information, and optionally format it with \code{printCoefmat()}. The last component of \code{summary()} gives the estimated correlations among the fixed-effect parameters, which can be useful for assessing multicollinearity (it can also be overwhelming: it is suppressed by default for models with more than 20 fixed-effect parameters, and can also be suppressed by using \code{print(summary(.),correlation=FALSE)}). <>= cat(cc[corRow:length(cc)],sep="\n") @ \subsubsection{Diagnostics} A range of graphical diagnostic tools is available for \code{merMod} objects. The plot methods in the \code{lme4} package are inspired by those in the \code{nlme} package, using \code{lattice} plots to provide a reasonable blend of convenience and flexibility. \code{merMod} objects are also compatible with the \code{performance} package and the \code{DHARMa} package, both commonly used for model checking. The following code produces a standard range of diagnostic plots (Figure~\ref{fig:glmerDiag}), similar to the ones in base R's \code{plot.lm} method. These diagnostics will generally be useful for models where the conditional density is approximately normal (but heteroscedastic) --- e.g., Poisson responses with large mean or binomial responses with large numbers of successes --- and less so otherwise, e.g. for binary responses. <>= ## basic residual plot plot(gm1) ## scale-location plot plot(gm1,sqrt(abs(resid(.)))~fitted(.),type=c("p","smooth")) ## boxplot of residuals grouped by a categorical predictor plot(gm1,period~resid(.)) ## Q-Q plot qqmath(gm1) @ <>= p1 <- plot(gm1,type=c("p","smooth"), main="Default (Pearson resid vs. fitted)") p2 <- plot(gm1,sqrt(abs(resid(.)))~fitted(.),type=c("p","smooth"), main="Scale-location") p3 <- plot(gm1,period~resid(.), main = "Grouped residuals") p4 <- qqmath(gm1,main="Quantile-quantile plot",type=c("p","r")) grid.arrange(p1,p2,p3,p4,nrow=2) @ The \code{ranef()} accessor extracts the conditional modes; the argument \code{condVar=TRUE} additionally extracts the variances of the conditional modes, which are stored as an attribute labelled \code{"postVar"}\footnote{In earlier versions of the software, these elements were called ``posterior variances'' rather than ``conditional variances'', based on the close correspondence between mixed models and hierarchical Bayesian models.} --- a three-dimensional array that gives the variance-covariance matrix of the conditional modes for each level of the grouping variable. The plotting methods \code{dotplot()} and \code{qqmath()} return lists of graphical objects showing \emph{caterpillar plots} (ordered values of the random effects with confidence bars); in the case of the Q-Q plot (\code{qqmath}) the $y$-axis shows corresponding values of the standard normal quantiles (Figure~\ref{fig:glmerRanefplot}). <>= rr <- ranef(gm1, condVar=TRUE) dd <- dotplot(rr) qq <- qqmath(rr, type=c("p","r")) grid.arrange(dd$herd, qq$herd, ncol=2) @ \code{performance::check\_model()} checks a variety of classical assumptions of GLMs. For mixed-effect models, it also assesses the normality of the distribution of conditional modes (Figure~\ref{fig:perf_chk_mod_cbpp}). <>= check_model(gm1, check = c("pp_check", "binned_residuals", "qq", "reqq")) @ The \code{DHARMa} package is also compatible with \code{merMod} objects. \code{DHARMa} generates simulation-based residuals for generalized linear (mixed) models and uses them for graphical and statistical tests of model assumptions (Figure~\ref{fig:dharma_mod_cbpp}). <>= ## FIXME: versions of DHARMa before 0.5.0 gave a significant nonlinearity test, so the caption ## included: 'Other exploration (such as \\code{plot(simulationOutput, form = cbpp2\\$period)}) does not reveal any obvious problems such as nonlinear responses, so we proceed with the analysis despite the significant adjusted quantile test.' ## Post 0.5.0, there are no test rejections; instead we get the warning 'In getSimulations.merMod(fittedModel, nsim = n, simulateREs = simulateREs, : ## Model was fit with prior weights. These will be ignored in the simulation. See ?getSimulations for details.' ## (is this a false positive?) ## simulationOutput <- simulateResiduals(fittedModel = gm1) plot(simulationOutput) @ Having checked the diagnostics, we would now like to compare the three models we have fitted. Inspecting the \code{VarCorr} components, we see that when we fit both herd- and observation-level random effects, the among-herd variance is estimated as zero. The appropriate procedure at this point (e.g. whether one drops non-significant terms, or those with small scaled magnitudes, or those that worsen the AIC or BIC of the model) depends on the goals of the analysis and one's philosophy of model-building \citep{barrRandomEffectsStructure2013,matuschekBalancingTypeError2017,scandola2024}. One might either stick with the full model, or continue with the reduced model with observation-level random effects only (as it has exactly the same likelihood as the full model but uses an additional parameter, it would be chosen according to either an information-theoretic or a hypothesis-testing model selection framework). Here we will start by computing likelihood profiles and confidence intervals (CIs) for the model incorporating both random effects; although it has the same point estimates and maximum likelihood as the reduced model, confidence intervals that incorporate non-local information (i.e. profile- or parametric bootstrap-based) will give different, more conservative results for the full model. %% lme4 wishlist: allow [Ww]ald in confint.merMod? <>= cbpp_batch_vars <- load(system.file("vignette_data", "cbpp_batch.rda", package = "lme4")) contr_batch_vars <- load(system.file("vignette_data", "Contraception_batch.rda", package = "lme4")) @ The \code{profile} method computes profile likelihoods. The computation can be slow, since complete profiling for a model with $p$ random- and fixed-effect parameters requires fitting $p$ profiles, each of which requires many $p-1$-dimensional optimizations. The machinery for generating likelihood profiles for GLMMs is similar to that for LMMs (see \cite{bates2015fitting}, \S\ 5.1). The \code{profile} method returns an object of class \code{thpr} --- a data frame containing the profiles, augmented with attributes containing interpolation splines for each parameter profile and their inverses (using \code{splines::interpSpline} and \code{splines::backSpline}); the latter are used for plotting profiles and computing confidence intervals. An \code{as.data.frame} method adds \code{.focal} and \code{.par} variables to the data frame, useful for customized plots. Profiles can be used for univariate (\code{xyplot}) and bivariate (\code{splom}) profile plots, and to compute profile confidence intervals (\code{confint}). (\code{confint} applied to a \code{glmer} fit will first fit the profile, then use it to compute profile confidence intervals. Given the computational cost of profiling, it makes sense to compute and save the profile as an intermediate step if one plans to do anything other than computing confidence intervals.) Two other common methods for computing confidence intervals are parametric bootstrapping (\code{method = "boot"}) and the classical Wald approximation (\code{method = "Wald"}). Parametric bootstrapping is much slower, but more accurate (and, via the \code{FUN} argument, can generate confidence intervals for any quantity that can be derived from a fitted model). The Wald approximation is faster and less accurate than profile confidence intervals. By default \code{glmer} only returns estimates for the fixed-effects parameters, as the assumptions of the Wald approximation are often violated badly for random-effects (co)variances and correlations. In the examples below we use the finite-difference Hessian (second derivative matrix of the estimated parameters) and the delta method to compute Wald confidence intervals for random-effects standard deviations and correlations, when possible. Figure~\ref{fig:cbppcompplot} compares all three of these confidence intervals across all three of the models fitted. <>= des_ord <- c("sd_(Intercept)|herd", "sd_(Intercept)|obs", "avg_size", "treatmentUnknown", "treatmentComplete") combCI <- subset(cbpp_combCI,var!="(Intercept)" & !grepl("^period",var)) combCI <- transform(combCI, var = factor(var, levels = rev(des_ord))) combCI <- transform(combCI, vartype = factor(ifelse(grepl("^sd", var), "random effects", "fixed effects")) ) @ <>= mnames <- cbpp_df_name$mnames pd <- position_dodge(width=0.6) ggplot(combCI, aes(var, est, colour=type, shape=model)) + geom_pointrange(aes(ymin=lwr, ymax=upr), position=pd) + labs(x="", y="Estimate (log-odds of seropositivity)") + geom_hline(yintercept=0, lty=2) + coord_flip() + scale_colour_brewer(palette="Dark2", guide = revguide) + scale_shape(guide=revguide, labels = mnames) + facet_wrap(~ vartype, ncol = 1, scale = "free") @ If the default optimizers (BOBYQA followed by Nelder-Mead) do not perform well, one could attempt to re-fit the model with a variety of different optimizers using \code{allFit()}. The command \code{allFit(show.meth.tab=TRUE)} lists the optimizers \code{lme4} currently supports. To use \code{allFit()}, supply the initial fitted model as input. Useful results are obtained from \code{summary(allFit())}; the components below (other than \code{\$which.OK}) apply only to the optimizers that succeeded: \begin{itemize} \item \code{\$which.OK} --- which optimizers worked \item \code{\$llik} --- log-likelihoods \item \code{\$fixef} --- fixed-effect estimates \item \code{\$sdcor} --- random-effect standard deviations and correlations \item \code{\$theta} --- random-effect parameters on the Cholesky scale \end{itemize} We will show the summary results for \code{\$sdcor}; the other components are similar. <>= gm_all <- allFit(gm1) @ <>= ss <- summary(gm_all) ss$sdcor @ As of version 2.0, \code{lme4} can also specify structured variance-covariance matrices for (generalized) linear mixed models. \code{lme4} now supports unstructured (general positive definite), diagonal, compound symmetry, and first-order autoregressive (AR1) structures. By default, AR1 models assume a homogeneous-variance model (the variance is the same for all time steps), while the other models assume heterogeneous-variance models (variances differ for every level of the varying term); users can adjust this with the \code{hom} argument (e.g. \code{ar1(..., hom = FALSE)}). The unstructured covariance structure is the default for mixed models. Here we illustrate fitting an AR1 model; the next example will show a compound symmetric model. <>= gm.ar1 <- glmer(incidence/size ~ ar1(1 + herd | period), family = binomial, data = cbpp, weights = size) print(VarCorr(gm.ar1)) @ For this particular model, a heterogeneous AR1 model (\code{ar1(..., hom = FALSE)}) results in a singular fit. \subsection{Contraception} \citet{huq1990bangladesh} use multilevel models to analyze data from a fertility survey of women in Bangladesh. These data are available as the \code{Contraception} object in the \pkg{mlmRev} package. The response variable is binary and indicates whether or not each woman was using contraception at the time of the survey. Covariates included the woman's age, the number of live children she had, whether she lived in an urban or rural setting, and the district in which she lived. <>= library(mlmRev) data(Contraception) @ <>= Contraception <- transform(Contraception, facet_urban = ifelse(urban=="Y","Urban","Rural")) gg0 <- ggplot(Contraception) + geom_smooth(aes(age, ifelse(use == "Y",1,0), colour = livch, fill = livch, linetype = livch), method = "gam", alpha = 0.1, method.args = list(gamma = 0.6), formula = y ~ s(x, bs = "cs")) + facet_wrap(~facet_urban) + scale_x_continuous("Centered age") + scale_y_continuous("Proportion", limits = c(0, 1), expand = c(0,0)) + scale_linetype("Number\nof living\nchildren") + scale_colour_brewer("Number\nof living\nchildren", palette="Dark2") + scale_fill_brewer("Number\nof living\nchildren", palette="Dark2", guide = guide_legend(override.aes = list(alpha = 0.1))) + ## wider key to see line types: ## https://stackoverflow.com/a/7624378/190277 theme(legend.key.width = unit(3, "line")) ## add marginal density ribbons gg0 + geom_density( data = subset(Contraception, use == "N"), aes(x = age, y = after_stat(density), fill = livch), alpha = 0.3, colour = NA) + geom_ribbon( data = subset(Contraception, use == "Y"), stat = "density", aes( x = age, ymin = 1 - after_stat(density) * 0.5, ymax = 1, fill = livch ), alpha = 0.3, colour = NA ) @ <>= Contraception <- transform(Contraception, ch = factor(livch != 0, labels = c("N","Y")), age_s = age/(2*sd(age))) @ Figure~\ref{fig:graphContraception} shows exploratory smooth curves of contraceptive use as a function of centered age, stratified by number of living children and urban/rural residence. In rural areas, women with two living children show the highest rates of contraceptive use, peaking near 50\% at the average age, while women in urban areas with one living child show the highest rates near the average age but with a more pronounced decline at older ages. In both settings, women with no living children consistently show the lowest rates of contraceptive use. The nonmonotonic effect of age on contraceptive use and the apparent dependence of this age trend on child status motivate the model specifications explored below. (These nonmonotonic trends were not noticed in the original analysis of the data, which concluded that there was no significant effect of age.) We construct six \code{glmer} models with varying choices of explanatory variables and random effects structure, comparing them via \code{anova}. The models considered different variables. For instance, there are two different ways to encode the number of living children: \code{livch} is a four-level factor distinguishing \code{0}, \code{1}, \code{2}, or \code{3+} children, while other models use \code{ch} instead, which is a binary indicator for whether the woman has any living children (in Table~\ref{tab:contraictab} and Figure~\ref{fig:contracompplot} we label this variable as \code{binary\_child}). Second, we vary whether child status interacts with the woman's age: two models include \code{ch} (or \code{livch}) and \code{age} as additive terms, while the other four include a \code{ch} and \code{age} interaction. A quadratic effect of age (\code{I(age\^{}2)}) was added to account for the nonlinear effect of age. Third, we explore different random effects structures at the district level. Three of them use a single random intercept per district \code{(1 | district)}. One of them extends this with a random slope for urban status \code{(urban | district)}, allowing the urban/rural difference to vary by district. The next uses nested random intercepts for district and site within district (\code{1 | district/urban}) separating district-level from urban-within-district variation. (\cite{scandola2024} refer to this formulation as a ``complex random intercepts'' model). The remaining model uses only the \code{urban:district} grouping. To reduce convergence warnings and facilitate interpretability, age (already approximately centered in the data set) was standardized by scaling by twice the standard deviation \citep{gelman2008scaling}. <>= cm1 <- glmer(use ~ age_s + I(age_s^2) + urban + livch + (1|district), Contraception, binomial) ## switch from livch (ordinal) to ch (binary) cm2 <- update(cm1, . ~ . - livch + ch) ## add age by children interaction cm3 <- update(cm2, . ~ . + age_s:ch) ## allow urban effect to vary across districts (correlated) cm4 <- update(cm3, . ~ . - (1|district) + (1+urban|district)) ## compound symmetric/nested formulation cm5 <- update(cm3, . ~ . - (1|district) + (1 | district/urban)) ## as above but drop district effect cm6 <- update(cm3, . ~ . - (1|district) + (1 | district:urban)) @ <>= ## copy of bbmle::AICtab AICtab <- function(..., mnames) { aic_df <- do.call(AIC, list(...)) LLvec <- sapply(list(...), function(x) c(logLik(x))) rownames(aic_df) <- mnames aic_df <- transform(aic_df, Δnegloglik = -LLvec - min(-LLvec), ΔAIC = AIC - min(AIC)) aic_df <- subset(aic_df, select = -AIC) aic_df <- aic_df[order(aic_df$ΔAIC),] aic_df } mod_list <- c(cm1, cm2, cm3, cm4, cm5, cm6) op <- options(digits = 3) mnamevec <- c("int_child + age + (1 | district)", "binary_child + age + (1 | district)", "binary_child Ă— age + (1 | district)", "binary_child Ă— age + (1 + urban | district)", "binary_child Ă— age + (1 | district/urban)", "binary_child Ă— age + (1 | district:urban)") aictab <- do.call(AICtab, c(mod_list, list(mnames = mnamevec))) @ \begin{table} <>= knitr::kable(aictab, digits = 3) @ \caption{Model comparison for Contraception fits. Note that for likelihood ratio tests, or for AIC comparisons restricted to nested models \citep{ripleySelectingAmongstLarge2004a}, the nesting sequence for the random-effects models is \code{(1+urban|district)} $>$ \code{(1|district/urban)} $>$ \{% \code{(1|district)}, \code{(1|district:urban)}% \}. } \label{tab:contraictab} \end{table} Table~\ref{tab:contraictab} shows that the top three models, all of which include a child-by-age interaction and some effect of urbanization, fit approximately equally well ($\Delta$ negative log-likelihood $<0.5$). The \code{(1|district/urban)} model barely improves on the fit of \code{(1|district:urban)} (0.005 log-likelihood units), at the cost of an extra variance parameter, so it is almost 2 AIC units worse. \code{(1 + urban | district)} is a bit better ($\approx$ 0.5 log-likelihood units), but includes a covariance parameter. Models that drop the interaction between child status and age or replace the binary child indicator with an integer count perform substantially worse ($\Delta \textrm{AIC} > 10$). Overall, the results suggest that accounting for urban/rural variation at the district level and including the age and child interaction are both important, but the precise random effects structure for urban/rural variation is relatively unimportant. <>= agevec <- seq(-15, 20) pframe <- with(Contraception, expand.grid(age = agevec, urban = levels(urban), ch = levels(ch))) pframe <- transform(pframe, age_s = age/(2*sd(Contraception$age)), facet_urban = ifelse(urban=="Y","Urban","Rural")) pred <- predict(cm5, newdata = pframe, se.fit = TRUE, re.form = NA) pframe$use <- plogis(pred$fit) pframe$lwr <- plogis(pred$fit-1.96*pred$se.fit) pframe$upr <- plogis(pred$fit+1.96*pred$se.fit) pframe2 <- with(Contraception, expand.grid(age = agevec, urban = levels(urban), ch = levels(ch), district = levels(district))) pframe2 <- transform(pframe2, age_s = age/(2*sd(Contraception$age)), facet_urban = ifelse(urban=="Y","Urban","Rural"), dist_urb = paste(urban, district, sep = ":")) c_urb <- unique(with(Contraception, paste(urban, district, sep = ":"))) pframe2 <- subset(pframe2, dist_urb %in% c_urb) pred2 <- predict(cm5, newdata = pframe2, re.form = NULL) pframe2$use <- plogis(pred2) pframe2$ch <- factor(pframe2$ch, levels = c("N", "Y"), labels = c("no", "yes")) pframe$ch <- factor(pframe$ch, levels = c("N", "Y"), labels = c("no", "yes")) ggplot(pframe, aes(age)) + geom_line(aes(y = use, colour = ch)) + geom_ribbon(aes(ymin = lwr, ymax = upr, fill = ch), color = NA, alpha = 0.3) + facet_wrap(~facet_urban) + scale_x_continuous("Centered age") + scale_y_continuous("Proportion", limits = c(0, 1), expand = c(0,0)) + scale_colour_brewer("Living\nchildren", palette="Dark2", guide = guide_legend(reverse = TRUE)) + scale_fill_brewer("Living\nchildren", palette="Dark2", guide = guide_legend(reverse = TRUE)) + geom_line(data = pframe2, aes(group = interaction(dist_urb, ch), colour = ch, y = use), alpha = 0.2) @ As with the CBPP data set, we can also compute profile, Wald, and parametric bootstrap confidence intervals for all of the models to understand the effects of each variable and visualize the among-model variation. <>= contr_combCI <- subset(contr_combCI, var != "(Intercept)") combCI <- transform(contr_combCI, vartype = factor(ifelse(grepl("^(sd|cor)", var), "random effects", "fixed effects")), model = factor(model, levels = rev(levels(model))) ## flip AND flip order of guide below ) @ <>= ggplot(combCI, aes(var, est, colour=type, shape=model)) + geom_pointrange(aes(ymin=lwr, ymax=upr), position=position_dodge(width=0.6)) + labs(x="", y="Estimate (log-odds of seropositivity)") + geom_hline(yintercept=0, lty=2) + coord_flip() + scale_colour_brewer(palette="Dark2", guide = revguide) + scale_shape(guide=revguide) + facet_wrap(~vartype, ncol = 1, scale = "free", space = "free_y") + theme(legend.position = "inside", legend.justification = c("left", "top"), legend.box = "horizontal", legend.background = element_rect(fill = "white", colour = "grey50"), #legend.margin = margin(t = 5, r = 5, b = 5, l = 5, unit = "pt"), legend.box.margin = margin(t = 10, l = 10, unit = "pt")) @ The point estimates and confidence intervals of the explanatory variables are similar across the six models, and across different methods for confidence interval construction, with a few exceptions. Urban residence, presence of living children, and age were all strong predictors of contraceptive use among women in Bangladesh (because we are fitting a quadratic model for the effect of age, the non-significant effect of \code{age\_s} simply means that the marginal effect of age \emph{at the mean age} is not clearly negative or positive). Returning to the structured covariance matrices introduced in Section~\ref{sec:cbpp}, we can replace the unstructured random effect \code{(1+urban|district)} with diagonal (\code{diag}) or compound symmetric (\code{cs}) structures, with either heterogeneous or homogeneous variances (via the \code{hom} argument): <>= cc <- glmerControl(check.conv.grad = .makeCC("warning", tol = 1e-2), check.conv.hess = "ignore") base_form <- use ~ age*ch + I(age^2) + urban cm.diag <- glmer(update(base_form, . ~ . + diag(1 + urban|district)), Contraception, binomial, control = cc ) cm.homdiag <- glmer(update(base_form, . ~ . + diag(1 + urban|district, hom = TRUE)), Contraception, binomial, control = cc) cm.homcs <- glmer(update(base_form, . ~ . + cs(1 + urban|district, hom = TRUE)), Contraception, binomial, control = cc) @ For example, the compound symmetric model is fitted as follows: <>= cm.cs <- glmer(use ~ age*ch + I(age^2) + urban + cs(1 + urban | district), Contraception, binomial, control = cc) @ We can use \code{VarCorr} and other accessor methods as we would for models with default, unstructured covariance matrices, e.g.: <>= print(VarCorr(cm.cs)) @ \section*{Acknowledgements} We would like to thank Steve Walker, for early work on \code{glmer}, and Alex Stringer, for helpful comments on the manuscript. \bibliography{glmer} \section*{Package versions used} <>= pkglist <- c("lme4", "performance", "DHARMa", "see") pp <- sapply(pkglist, function(x) sprintf("%s: %s", x, format(packageVersion(x)))) ppp <- paste(pp, collapse = "; ") @ Compiled with \Sexpr{R.version.string} and package versions \Sexpr{pp}. \section{Appendix: derivation of PIRLS} We seek to maximize the unscaled conditional log density for a GLMM over the conditional modes, $\bm u$. This problem is very similar to maximizing the log-likelihood for a GLM, which is a very thoroughly studied problem \citep[e.g.][]{McCullaghNelder1989}. The standard algorithm for dealing with this kind of problem is iteratively reweighted least squares (IRLS). Here we modify IRLS by incorporating a penalty term that accounts for variation in the random effects; we call the resulting algorithm penalized iteratively reweighted least squares (PIRLS). The unscaled conditional log-density takes the form, \begin{equation} f(\bm u) = \log p(\bm y, \bm u | \bm\beta, \bm\theta) = \bm\psi^\top \bm A \bm y - \bm a^\top \bm \phi + \bm c - \frac{1}{2}\bm u^\top \bm u - \frac{q}{2}\log{2\pi} \label{eq:unsccondlogdens} \end{equation} where $\bm\psi$ is the $n$-by-$1$ canonical parameter of an exponential family, $\bm\phi$ is the $n$-by-$1$ vector of cumulant functions, $\bm c$ an $n$-by-$1$ vector of normalizing constants, and $\bm A$ is an $n$-by-$n$ diagonal matrix of prior weights, $\bm a$. Both $\bm a$ and $\bm c$ could depend on a dispersion parameter, although we ignore this possibility for now. The canonical parameter, $\bm\psi$, and vector of cumulant functions, $\bm\phi$, depend on a linear predictor, \begin{equation} \bm\eta = \bm o + \bm X \bm\beta + \bm Z \bm\Lambda_\theta \bm u \end{equation} where $\bm o$ is an $n$-by-$1$ vector of \emph{a priori} offsets. The specific form of this dependency is specified by the choice of the exponential family. The mean of this distribution, $\bm\mu$, is the \emph{inverse link function} $g^{-1}$ applied to $\bm\eta$. Our goal is to find the values of $\bm u$ that maximize the unscaled conditional density, for given $\bm\theta$ and $\bm\beta$ vectors. These maximizers are the conditional modes, which we require for the Laplace approximation and adaptive Gauss-Hermite quadrature. To do this maximization we use a variant of the Fisher scoring method, which is the basis of the iteratively reweighted least squares algorithm for generalized linear models. Fisher scoring is itself based on Newton's method, which we apply first. \subsection{Newton's method} To apply Newton's method, we need the gradient and the Hessian of the unscaled conditional log-likelihood. Following standard GLM theory \citep{McCullaghNelder1989}, we use the chain rule, \begin{displaymath} \frac{d L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u} = \frac{d L'(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm\psi} \frac{d \bm\psi}{d \bm\mu} \frac{d \bm\mu}{d \bm\eta} \frac{d \bm\eta}{d \bm u} - \frac{1}{2} \frac{d \, (\bm u^\top \bm u)}{d \, \bm u} \end{displaymath} where $L'$ represents the log-density in (\ref{eq:unsccondlogdens}) exclusive of the penalty term. The first derivative in the first term's chain follows from basic results in GLM theory, \begin{displaymath} \frac{d L'(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm\psi} = (\bm y - \bm\mu)^\top \bm A . \end{displaymath} Again from standard GLM theory, the next two derivatives define the inverse diagonal variance matrix, \begin{displaymath} \frac{d \bm\psi}{d \bm\mu} = \bm V^{-1} \end{displaymath} and the diagonal Jacobian matrix, \begin{displaymath} \frac{d \bm\mu}{d \bm\eta} = \bm M \quad . \end{displaymath} Finally, because $\bm u$ affects $\bm\eta$ only linearly, \begin{displaymath} \frac{d \bm\eta}{d \bm u} = \bm Z \bm\Lambda_\theta \end{displaymath} Therefore we have, \begin{equation} \frac{d L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u} = (\bm y - \bm\mu)^\top \bm A \bm V^{-1} \bm M \bm Z \bm\Lambda_\theta - \bm u^\top \quad . \label{eq:dPDEVdu} \end{equation} This is very similar to the gradient for GLMs with respect to fixed effects coefficients, $\bm\beta$. The only difference induced by including the penalty term for the random effects ($\bm u$), is the subtraction of the $\bm u^\top$ term. Again we apply the chain rule to take the Hessian, \begin{equation} \frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm u} = \frac{d^2 L'(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm\mu} \frac{d \bm\mu}{d \bm\eta} \frac{d \bm\eta}{d \bm u} - \bm I_q \end{equation} which leads to, \begin{equation} \frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm u} = \frac{d^2 L'(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm\mu}\bm M \bm Z \bm\Lambda_\theta - \bm I_q \end{equation} The first derivative in this chain can be expressed as, \begin{equation} \frac{d^2 L'(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm\mu} = -\bm\Lambda_\theta^\top \bm Z^\top \bm M \bm V^{-1} \bm A + \bm\Lambda_\theta^\top \bm Z^\top \left[ \frac{d \bm M \bm V^{-1}}{d \bm\mu} \right] \bm A \bm R \end{equation} where $\bm R$ is a diagonal residuals matrix with $\bm y-\bm\mu$ on the diagonal. The two terms arise from a type of product rule, where we first differentiate the residuals, $\bm y-\bm\mu$, and then the diagonal matrix, $\bm M \bm V^{-1}$, with respect to $\bm\mu$. The Hessian can therefore be expressed as, \begin{equation} \frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u d \bm u} = -\bm \Lambda_\theta^\top \bm Z^\top \bm M \bm A^{1/2}\bm V^{-1/2}\left( \bm I_n - \bm V \bm M^{-1}\left[ \frac{d \bm M \bm V^{-1}}{d \bm\mu} \right] \bm R \right) \bm V^{-1/2}\bm A^{1/2} \bm M \bm Z \bm\Lambda_\theta - \bm I_q \label{eq:betaHessian} \end{equation} This result can be simplified by expressing it in terms of a weighted random-effects design matrix, $\bm U = \bm A^{1/2}\bm V^{-1/2}\bm M \bm Z \bm\Lambda_\theta$, \begin{equation} \frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm u} = -\bm U^\top\left( \bm I_n - \bm V \bm M^{-1}\left[ \frac{d \bm V^{-1}\bm M}{d \bm\mu} \right] \bm R \right) \bm U - \bm I_q \quad . \label{eq:betaHessiansimp} \end{equation} \subsection{Fisher-like scoring} There are two ways to further simplify this expression for $\bm U^\top \bm U$. The first is to use the canonical link function for the family being used. Canonical links have the property that $\bm V = \bm M$, which means that for canonical links, \begin{equation} \frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm u} = -\bm U^\top\left( \bm I_n - \bm I_n \left[ \frac{d \bm I_n}{d \bm\mu} \right] \bm R \right) \bm U - \bm I_q = - \bm U^\top \bm U - \bm I_q \end{equation} The second way to simplify the Hessian is to take its expectation with respect to the distribution of the response, conditional on the current values of the spherical random effects coefficients, $\bm u$. The diagonal residual matrix, $\bm R$, has expectation 0. Therefore, because the response only enters into the expression for the Hessian via $\bm R$, we have that, \begin{equation} E\left(\frac{d^2 L(\bm\beta, \bm\theta | \bm y, \bm u)}{d \bm u \, d \bm u} | \bm u \right) = -\bm U^\top\left( \bm I_n - \bm U \bm M^{-1}\left[ \frac{d \bm V^{-1}\bm M}{d\mu} \right] E(\bm R) \right) \bm U - \bm I_q = - \bm U^\top \bm U - \bm I_q \label{eq:simphesstwo} \end{equation} Like base R's \code{glm}, \code{glmer} uses Fisher scoring throughout (which is identical to Newton's method for canonical links) to enable the use of the (P)IRLS algorithm. As usual, we minimize the conditional negative log-density rather than maximizing the conditional log-density. \end{document} lme4/vignettes/glmer.bib0000644000176200001440000012375115221061066014717 0ustar liggesusers@InCollection{Chambers:1993, author = {John M. Chambers}, title = {Linear Models}, booktitle = {Statistical Models in \proglang{S}}, publisher = {Chapman \& Hall}, year = 1993, editor = {John M. Chambers and Trevor J. Hastie}, chapter = {4}, pages = {95--144}} @Book{Rauden:Bryk:2002, author = {Stephen W. Raudenbush and Anthony S. Bryk}, title = {Hierarchical Linear Models: Applications and Data Analysis Methods}, publisher = {Sage}, year = 2002, edition = {2nd}, ISBN = {0-7619-1904-X} } @Book{MLwiNUser:2000, author = {J. Rasbash and W. Browne and H. Goldstein and M. Yang and I. Plewis}, title = {A User's Guide to {MLwiN}}, publisher = {Multilevel Models Project, Institute of Education, University of London}, year = 2000, address = {London} } @Book{davis06:csparse_book, author = {Tim Davis}, title = {Direct Methods for Sparse Linear Systems}, publisher = {SIAM}, address = {Philadelphia, PA}, year = 2006} @Article{laird_ware_1982, author = {Nan M. Laird and James H. Ware}, title = {Random-Effects Models for Longitudinal Data}, journal = {Biometrics}, year = 1982, volume = 38, pages = {963--974}} @Book{bateswatts88:_nonlin, author = {Douglas M. Bates and Donald G. Watts}, title = {Nonlinear Regression Analysis and Its Applications}, publisher = {Wiley}, year = 1988, ISBN = {0-471-81643-4}, address = {Hoboken, NJ}} @Book{R:Pinheiro+Bates:2000, author = {Jose C. Pinheiro and Douglas M. Bates}, title = {Mixed-Effects Models in {S} and {S-Plus}}, publisher = {Springer}, year = 2000, isbn = {0-387-98957-0}, publisherurl = {http://www.springeronline.com/sgw/cda/frontpage/0,11855,4-10129-22-2102822-0,00.html?changeHeader=true}, abstract = {A comprehensive guide to the use of the `nlme' package for linear and nonlinear mixed-effects models.}, orderinfo = {springer.txt} } @article{bates04:_linear, Author = {Douglas M. Bates and Saikat DebRoy}, Journal = {Journal of Multivariate Analysis}, doi = {10.1016/j.jmva.2004.04.013}, Number = 1, Pages = {1--17}, Title = {Linear Mixed Models and Penalized Least Squares}, Volume = 91, Year = 2004} @article{gelman2005analysis, title={Analysis of Variance --- Why it is More Important than Ever}, author={Gelman, Andrew}, journal={The Annals of Statistics}, volume={33}, number={1}, pages={1--53}, year={2005}, publisher={Institute of Mathematical Statistics} } @ARTICLE{1977EfronAndMorris, author = {{Efron}, B. and {Morris}, C.}, title = "{Stein's Paradox in Statistics}", journal = {Scientific American}, year = 1977, month = may, volume = 236, pages = {119-127}, doi = {10.1038/scientificamerican0577-119}, adsurl = {http://adsabs.harvard.edu/abs/1977SciAm.236e.119E}, adsnote = {Provided by the SAO/NASA Astrophysics Data System} } @article{henderson_1982, Abstract = {The model generally considered in analysis of covariance has all levels of classification factors and interactions fixed, and also covariate regression coefficients fixed. Mixed models are more appropriate in most applications. A summary of estimation and hypothesis testing for analysis of covariance in the mixed model, including the case of random regression coefficients, is presented. Higher-level covariate regressions (i.e., regressions in which, for all levels of a factor or interaction, all observations on the same level have a common covariate value) are discussed. Nonestimability problems that result from defining such covariates at the levels of fixed effects are illustrated. The case of nonhomogeneous covariate regressions in the mixed model is considered in the context of interpreting predicted future differences among levels of a given factor or interaction. Nonhomogeneous regressions complicate interpretations only when they are associated with the contrast(s) of interest among fixed effects in the model. The question of whether the regressions are homogeneous is itself often of substantive interest. Different random regression coefficients associated with the levels of a random effect are also examined.}, Author = {Henderson, Jr., Charles R.}, Copyright = {Copyright {\copyright} 1982 International Biometric Society}, Journal = {Biometrics}, Jstor_Articletype = {research-article}, Jstor_Formatteddate = {Sep., 1982}, Jstor_Issuetitle = {Special Issue: Analysis of Covariance}, Language = {English}, Number = {3}, Pages = {623--640}, Publisher = {International Biometric Society}, Title = {Analysis of Covariance in the Mixed Model: Higher-Level, Nonhomogeneous, and Random Regressions}, Url = {http://www.jstor.org/stable/2530044}, Volume = {38}, Year = {1982}, Bdsk-Url-1 = {http://www.jstor.org/stable/2530044}} @article{golub_pereyra_1973, Abstract = {For given data (ti, yi), i = 1, â‹Ż, m, we consider the least squares fit of nonlinear models of the form $\eta(\mathbf{a, \alpha};t) = \sum^n_{j = 1} a_j \varphi_j(\mathbf{\alpha};t),\quad \mathbf{a} \in \mathscr{R}^n, \mathbf{\alpha} \in \mathscr{R}^k.$ For this purpose we study the minimization of the nonlinear functional r(a, α) = â‘m i = 1 (yi - η(a, α, ti))2. It is shown that by defining the matrix {Φ(α)}i,j = φj(α; ti), and the modified functional r2(α) = |y - Φ(α)Φ+ (α)y|2 2, it is possible to optimize first with respect to the parameters α, and then to obtain, a posteriori, the optimal parameters $\hat{\mathbf{a}}$ . The matrix Φ+(α) is the Moore-Penrose generalized inverse of Φ(α). We develop formulas for the Frechet derivative of orthogonal projectors associated with Φ(α) and also for Φ+(α), under the hypothesis that Φ(α) is of constant (though not necessarily full) rank. Detailed algorithms are presented which make extensive use of well-known reliable linear least squares techniques, and numerical results and comparisons are given. These results are generalizations of those of H. D. Scolnik [20] and Guttman, Pereyra and Scolnik [9].}, Author = {Golub, G. H. and Pereyra, V.}, Copyright = {Copyright {\copyright} 1973 Society for Industrial and Applied Mathematics}, Journal = {SIAM Journal on Numerical Analysis}, Jstor_Articletype = {research-article}, Jstor_Formatteddate = {Apr., 1973}, Language = {English}, Number = {2}, Pages = {pp. 413-432}, Publisher = {Society for Industrial and Applied Mathematics}, Title = {The Differentiation of Pseudo-Inverses and Nonlinear Least Squares Problems Whose Variables Separate}, Url = {http://www.jstor.org/stable/2156365}, Volume = {10}, Year = {1973}, Bdsk-Url-1 = {http://www.jstor.org/stable/2156365}} @article{sleepstudy, Author = {Gregory Belenky and Nancy J. Wesensten and David R. Thorne and Maria L. Thomas and Helen C. Sing and Daniel P. Redmond and Michael B. Russo and Thomas J. Balkin}, Date-Modified = {2014-02-14 21:07:17 +0000}, Journal = {Journal of Sleep Research}, Pages = {pp. 1-12}, Title = {Patterns of Performance Degradation and Restoration During Sleep Restriction and Subsequent Recovery: A Sleep Dose-Response Study}, Volume = {12}, Year = {2003}} @article{Chen:2008:ACS:1391989.1391995, author = {Chen, Yanqing and Davis, Timothy A. and Hager, William W. and Rajamanickam, Sivasankaran}, title = {Algorithm 887: CHOLMOD, Supernodal Sparse Cholesky Factorization and Update/Downdate}, journal = {ACM Trans. Math. Softw.}, issue_date = {October 2008}, volume = {35}, number = {3}, month = oct, year = {2008}, pages = {22:1--22:14}, articleno = {22}, numpages = {14}, url = {http://doi.acm.org/10.1145/1391989.1391995}, doi = {10.1145/1391989.1391995}, acmid = {1391995}, publisher = {ACM}, address = {New York, NY, USA}, keywords = {Cholesky factorization, linear equations, sparse matrices}, } @article{kenward_small_1997, title = {Small Sample Inference for Fixed Effects from Restricted Maximum Likelihood}, volume = {53}, abstract = {Restricted maximum likelihood {(REML)} is now well established as a method for estimating the parameters of the general Gaussian linear model with a structured covariance matrix, in particular for mixed linear models. Conventionally, estimates of precision and inference for fixed effects are based on their asymptotic distribution, which is known to be inadequate for some small-sample problems. In this paper, we present a scaled Wald statistic, together with an F approximation to its sampling distribution, that is shown to perform well in a range of small sample settings. The statistic uses an adjusted estimator of the covariance matrix that has reduced small sample bias. This approach has the advantage that it reproduces both the statistics and F distributions in those settings where the latter is exact, namely for Hotelling T\${\textasciicircum}2\$ type statistics and for analysis of variance F-ratios. The performance of the modified statistics is assessed through simulation studies of four different {REML} analyses and the methods are illustrated using three examples.}, number = {3}, journal = {Biometrics}, author = {M. G Kenward and J. H Roger}, year = {1997}, pages = {983--997} } @Article{Satterthwaite_1946, author = {F. E. Satterthwaite}, title = {An Approximate Distribution of Estimates of Variance Components}, journal = {Biometrics Bulletin}, year = {1946}, volume = {2}, number = {6}, pages = {110-114} } @Manual{gamm4, title = {\pkg{gamm4}: Generalized Additive Mixed Models using mgcv and lme4}, author = {Simon Wood and Fabian Scheipl}, year = {2013}, note = {R package version 0.2-2}, url = {http://CRAN.R-project.org/package=gamm4}, } @Manual{blme, title = {\pkg{blme}: {Bayesian} Linear Mixed-Effects Models}, author = {Vincent Dorie}, year = {2013}, note = {R package version 1.0-1}, url = {http://CRAN.R-project.org/package=blme}, } @article{doran2007estimating, title={Estimating the Multilevel {Rasch} Model: With the \pkg{lme4} Package}, author={Doran, Harold and Bates, Douglas and Bliese, Paul and Dowling, Maritza}, journal={Journal of Statistical Software}, volume={20}, number={2}, pages={1--18}, year={2007}, publisher={American Statistical Association} } @TechReport{Powell_bobyqa, author = {M. J. D. Powell}, title = {The {BOBYQA} Algorithm for Bound Constrained Optimization without Derivatives}, institution = {Centre for Mathematical Sciences, University of Cambridge}, year = {2009}, number = {DAMTP 2009/NA06}, address = {Cambridge, England}, url = {http://www.damtp.cam.ac.uk/user/na/NA_papers/NA2009_06.pdf} } @article{pinheiro_unconstrained_1996, title = {Unconstrained Parametrizations for Variance-Covariance Matrices}, volume = {6}, doi = {10.1007/BF00140873}, abstract = {The estimation of variance-covariance matrices through optimization of an objective function, such as a log-likelihood function, is usually a difficult numerical problem. Since the estimates should be positive semi-definite matrices, we must use constrained optimization, or employ a parametrization that enforces this condition. We describe here five different parametrizations for variance-covariance matrices that ensure positive definiteness, thus leaving the estimation problem unconstrained. We compare the parametrizations based on their computational efficiency and statistical interpretability. The results described here are particularly useful in maximum likelihood and restricted maximum likelihood estimation in linear and non-linear mixed-effects models, but are also applicable to other areas of statistics.}, number = {3}, urldate = {2010-01-05}, journal = {Statistics and Computing}, author = {Pinheiro, JosĂ© C. and Bates, Douglas M.}, year = {1996}, pages = {289--296} } @article{bolker_strategies_2013, title = {Strategies for Fitting Nonlinear Ecological Models in \proglang{R}, {AD} {Model} {Builder}, and \proglang{BUGS}}, volume = {4}, url = {http://doi.wiley.com/10.1111/2041-210X.12044}, doi = {10.1111/2041-210X.12044}, number = {6}, urldate = {2013-06-11}, journal = {Methods in Ecology and Evolution}, author = {Bolker, Benjamin M. and Gardner, Beth and Maunder, Mark and Berg, Casper W. and Brooks, Mollie and Comita, Liza and Crone, Elizabeth and Cubaynes, Sarah and Davies, Trevor and de Valpine, Perry and Ford, Jessica and Gimenez, Olivier and KĂ©ry, Marc and Kim, Eun Jung and Lennert-Cody, Cleridy and Magnusson, Arni and Martell, Steve and Nash, John and Nielsen, Anders and Regetz, Jim and Skaug, Hans and Zipkin, Elise}, editor = {Ramula, Satu}, month = jun, year = {2013}, pages = {501--512}, pdf={bbpapers/bolker_strategies_2013.pdf} } @Article{Klein_nelder_2013, author = {Kyle Klein and Julian Neira}, title = {{Nelder-Mead} Simplex Optimization Routine for Large-Scale Problems: A Distributed Memory Implementation}, journal = {Computational Economics}, year = {2013}, doi = {10.1007/s10614-013-9377-8} } @Misc{merBoot, author = {JosĂ© A. Sánchez-Espigares and Jordi Ocaña}, title = {An \proglang{R} Implementation of Bootstrap Procedures for Mixed Models}, howpublished = {Conference presentation, useR!}, month = {July}, year = {2009}, note = {accessed 25 May 2014}, url = {http://www.r-project.org/conferences/useR-2009/slides/SanchezEspigares+Ocana.pdf} } @book{gelman_data_2006, address = {Cambridge, England}, title = {Data Analysis Using Regression and {Multilevel/Hierarchical} Models}, url = {http://www.stat.columbia.edu/~gelman/arm/}, publisher = {Cambridge University Press}, author = {Gelman, Andrew and Hill, Jennifer}, year = {2006}, keywords = {uploaded} } @article{khatri1968solutions, title={Solutions to Some Functional Equations and their Applications to Characterization of Probability Distributions}, author={Khatri, CG and Rao, C Radhakrishna}, journal={Sankhy{\=a}: The Indian Journal of Statistics, Series A}, pages={167--180}, year={1968}, publisher={JSTOR} } @incollection{zhang2006schur, year={2005}, booktitle={The Schur Complement and its Applications}, volume={4}, series={Numerical Methods and Algorithms}, editor={Zhang, Fuzhen}, title={Basic Properties of the Schur Complement}, url={http://dx.doi.org/10.1007/0-387-24273-2_2}, publisher={Springer-Verlag}, author={Horn, RogerA. and Zhang, Fuzhen}, pages={17-46} } @book{gelman2013bayesian, title={Bayesian Data Analysis}, author={Gelman, Andrew and Carlin, John B and Stern, Hal S and Dunson, David B and Vehtari, Aki and Rubin, Donald B}, year={2013}, publisher={CRC press} } @Manual{Matrix_pkg, title = {\pkg{Matrix}: Sparse and Dense Matrix Classes and Methods}, author = {Douglas Bates and Martin Maechler}, year = {2014}, note = {\proglang{R} package version 1.1-3}, url = {http://CRAN.R-project.org/package=Matrix}, } @Manual{minqa_pkg, title = {\pkg{minqa}: Derivative-Free Optimization Algorithms by Quadratic Approximation}, author = {Douglas Bates and Katharine M. Mullen and John C. Nash and Ravi Varadhan}, year = {2014}, note = {\proglang{R} package version 1.2.3}, url = {http://CRAN.R-project.org/package=minqa}, } @Article{optimx_pkg, title = {Unifying Optimization Algorithms to Aid Software System Users: \pkg{optimx} for \proglang{R}}, author = {John C. Nash and Ravi Varadhan}, journal = {Journal of Statistical Software}, year = {2011}, volume = {43}, number = {9}, pages = {1--14}, url = {http://www.jstatsoft.org/v43/i09/}, } @Misc{NLopt, author = {Steven G. Johnson}, title = {The \pkg{NLopt} Nonlinear-Optimization Package}, year = {2014}, url = {http://ab-initio.mit.edu/nlopt} } @Manual{nlme_pkg, title = {\pkg{nlme}: Linear and Nonlinear Mixed Effects Models}, author = {Jose Pinheiro and Douglas Bates and Saikat DebRoy and Deepayan Sarkar and {\proglang{R} Core Team}}, year = {2014}, note = {\proglang{R} package version 3.1-117}, url = {http://CRAN.R-project.org/package=nlme}, } @Article{HLMdiag_pkg, title = {\pkg{HLMdiag}: A Suite of Diagnostics for Hierarchical Linear Models in \proglang{R}}, author = {Adam Loy and Heike Hofmann}, journal = {Journal of Statistical Software}, year = {2014}, volume = {56}, number = {5}, pages = {1--28}, url = {http://www.jstatsoft.org/v56/i05/}, } @Article{influenceME_pkg, title = {\proglang{Influence.ME}: Tools for Detecting Influential Data in Mixed Effects Models}, author = {Rense Nieuwenhuis and Manfred {Te Grotenhuis} and Ben Pelzer}, year = {2012}, journal = {R Journal}, volume = {4}, number = {2}, pages = {38-47}, } @Manual{boot_pkg, author = { Angelo Canty and Brian Ripley}, year = 2013, title = { \pkg{boot}: Bootstrap \proglang{R} (\proglang{S-PLUS}) Functions}, note = {\proglang{R} package version 1.3-9}, url = {http://CRAN.R-project.org/package=boot} } @Book{DavisonHinkley1997, author = {A. C. Davison and D. V. Hinkley}, title = { Bootstrap Methods and Their Applications}, publisher = {Cambridge University Press}, year = {1997}, ISBN = {0-521-57391-2}, address = {Cambridge, England} } @article{vaida2005conditional, title={Conditional Akaike Information for Mixed-Effects Models}, author={Vaida, Florin and Blanchard, Suzette}, journal={Biometrika}, volume={92}, number={2}, pages={351--370}, year={2005}, publisher={Biometrika Trust} } @book{cook1982residuals, title={Residuals and Influence in Regression}, author={Cook, R Dennis and Weisberg, Sanford}, year={1982}, publisher={New York: Chapman and Hall} } @article{lesnoff_within-herd_2004, title = {Within-herd spread of contagious bovine pleuropneumonia in Ethiopian highlands}, volume = {64}, doi = {10.1016/j.prevetmed.2004.03.005}, abstract = {Contagious bovine pleuropneumonia ({CBPP)} is a major threat for cattle health and production in Africa. This disease is caused by the small-colony type of Mycoplasma mycoides subspecies mycoides ({MmmSC).} Transmission occurs from direct and repeated contacts between sick and healthy animals. Veterinary services recently reported a resurgence of {CBPP} in the province of West Wellega, in the Ethiopian highlands. A research program was set up to estimate the epidemiological parameters of the within-herd infection spread. A follow-up survey was implemented in 71 sampled herds of the Boji district (West Wellega province). Fifteen herds were classified as newly infected and used in a serological- and clinical-incidence study. The overall 16-month cumulative sero-incidence risk was 34\%. Clinical cases were recorded for 39\% of the seropositive cattle; case-fatality risk was 13\%. There was no evidence of benefit on infection spread of {CBPP-control} measures used locally by farmers (isolation or antibiotic treatments of sick animals). This might be related to a lack of power in the statistical analyses or to a quality problem for the medications used (and more generally, for health-care delivery in the Boji district).}, number = {1}, urldate = {2013-10-03}, journal = {Preventive Veterinary Medicine}, author = {Lesnoff, Matthieu and Laval, GĂ©raud and Bonnet, Pascal and Abdicho, Sintayehu and Workalemahu, Asseguid and Kifle, Daniel and Peyraud, Armelle and Lancelot, Renaud and Thiaucourt, François}, month = jun, year = {2004}, keywords = {Clinical signs, Contagious bovine pleuropneumonia, Ethiopia, Herd monitoring, Within-herd incidence}, pages = {27--40} } @book{harrell_regression_2001, title = {Regression Modeling Strategies}, isbn = {0387952322}, publisher = {Springer}, author = {Harrell, Frank}, year = {2001} } @Article{steele_et_al_1996, author = {F. Steele and I. Diamond and S. Amin}, title = {Immunization uptake in rural Bangladesh: a multilevel analysis}, journal = {Journal of the Royal Statistical Society, Series A}, year = 1996, volume = 159, pages = {289--299}} @book{huq1990bangladesh, title={Bangladesh fertility survey 1989}, author={Huq, Najmul and Cleland, John}, publisher={National Institute of Population Research and Training}, address = {Dhaka}, year={1990} } @BOOK{McCullaghNelder1989, title = {Generalized Linear Models}, publisher = {Chapman and Hall}, year = {1989}, author = {P. McCullagh and J. A. Nelder}, address = {London} } @article{zeger1991generalized, title={Generalized linear models with random effects: a Gibbs sampling approach}, author={Zeger, Scott L and Karim, M Rezaul}, journal={Journal of the American Statistical Association}, volume={86}, number={413}, pages={79--86}, year={1991}, doi = {10.1080/01621459.1991.10475006} } @article{bates2015fitting, title={Fitting linear mixed-effects models using lme4}, author={Bates, Douglas and M{\"a}chler, Martin and Bolker, Ben and Walker, Steve}, journal={Journal of Statistical Software}, doi = {10.18637/jss.v067.i01}, volume={67}, pages={1--48}, year={2015} } @article{gelman2008scaling, title={Scaling regression inputs by dividing by two standard deviations}, author={Gelman, Andrew}, journal={Statistics in medicine}, volume={27}, number={15}, pages={2865--2873}, year={2008}, doi = {10.1002/sim.3107} } @book{madsen2011, title = {Introduction to General and Generalized Linear Models}, author = {Madsen, Henrik and Thyregod, Poul}, year = 2011, publisher = {CRC Press}, abstract = {Bridging the gap between theory and practice for modern statistical model building, Introduction to General and Generalized Linear Models presents likelihood-based techniques for statistical modelling using various types of data. Implementations using R are provided throughout the text, although other software packages are also discussed. Numerous examples show how the problems are solved with R.After describing the necessary likelihood theory, the book covers both general and generalized linear models using the same likelihood-based methods. It presents the corresponding/parallel results for the general linear models first, since they are easier to understand and often more well known. The authors then explore random effects and mixed effects in a Gaussian context. They also introduce non-Gaussian hierarchical models that are members of the exponential family of distributions. Each chapter contains examples and guidelines for solving the problems via R. Providing a flexible framework for data analysis and model building, this text focuses on the statistical methods and models that can help predict the expected value of an outcome, dependent, or response variable. It offers a sound introduction to general and generalized linear models using the popular and powerful likelihood techniques. Ancillary materials are available at www.imm.dtu.dk/\textasciitilde hm/GLM}, isbn = {978-1-4200-9155-7}, langid = {english}, keywords = {Business & Economics / Statistics,Mathematics / Probability & Statistics / General} } @article{kristensenTMB2016, title = {{TMB} : Automatic Differentiation and {Laplace} Approximation}, author = {Kristensen, Kasper and Nielsen, Anders and Berg, Casper W. and Skaug, Hans and Bell, Bradley M.}, year = 2016, journal = {Journal of Statistical Software}, volume = {70}, number = {5}, doi = {10.18637/jss.v070.i05}, urldate = {2017-05-23}, langid = {english} } @article{debacker+1998, title = {Twelve weeks of continuous oral therapy for toenail onychomycosis caused by dermatophytes: a double-blind comparative trial of terbinafine 250 mg/day versus itraconazole 200 mg/day}, author = {De Backer, M. and De Vroey, C. and Lesaffre, E. and Scheys, I. and De Keyser, P.}, year = 1998, month = may, journal = {Journal of the American Academy of Dermatology}, volume = {38}, number = {5, Supplement 2}, pages = {S57-S63}, doi = {10.1016/S0190-9622(98)70486-4}, urldate = {2015-03-28}, abstract = {Background: Dermatophyte infections of the toenail have been difficult to treat, requiring long courses of therapy and having high recurrence rates. New oral antifungal agents with better outcomes and minimal adverse events are needed. Objective: The purpose of this study was to compare two newer antifungal compounds, terbinafine and itraconazole, for efficacy and safety in toenail onychomycosis caused by dermatophytes. Methods: The study was randomized and double-blind. It compared 12 weeks of continuous oral treatment with terbinafine 250 mg/day or itraconazole 200 mg/day for confirmed toenail dermatophyte onychomycosis. Clinical symptoms and mycologic outcome were assessed at weeks 4, 8, 12, 24, 36, and 48. A total of 372 patients (186 in each group) with dermatophyte infection confirmed by microscopy and culture were included in the intent-to-treat analysis. Results: At week 48, a statistically significantly greater percentage of the terbinafine group than itraconazole group showed negative mycology (73\% [119 of 163] vs 45.8\% [77 of 168]; p \< 0.0001) (difference = 27.2\%; 95\% CI = [17.0\%, 37.3\%]). The difference was also confirmed clinically (p = 0.001) in the patients who were clinically cured or had only minimal symptoms at the end of the study (76.2\% [125 of 164] vs 58.1\% [100 of 172]) (difference = 18.1\%; 95\% CI = [8.24\%, 27.9\%]). The geometric mean length of healthy nail of the big toe was significantly greater in the terbinafine than itraconazole group (8.1 vs 6.4 mm; p = 0.026). Tolerability was good to very good in almost 90\% of patients in both groups, and all reported adverse events were known for these compounds. Conclusion: Terbinafine produced higher rates of clinical and mycologic cure at follow-up than did itraconazole. (J Am Acad Dermatol 1998;38:S57-63.)} } @article{scandola2024, title = {Reliability and Feasibility of Linear Mixed Models in Fully Crossed Experimental Designs}, author = {Scandola, Michele and Tidoni, Emmanuele}, year = 2024, month = jan, journal = {Advances in Methods and Practices in Psychological Science}, volume = {7}, number = {1}, pages = {25152459231214454}, publisher = {SAGE Publications Inc}, doi = {10.1177/25152459231214454}, urldate = {2024-12-24}, abstract = {The use of linear mixed models (LMMs) is increasing in psychology and neuroscience research In this article, we focus on the implementation of LMMs in fully crossed experimental designs. A key aspect of LMMs is choosing a random-effects structure according to the experimental needs. To date, opposite suggestions are present in the literature, spanning from keeping all random effects (maximal models), which produces several singularity and convergence issues, to removing random effects until the best fit is found, with the risk of inflating Type I error (reduced models). However, defining the random structure to fit a nonsingular and convergent model is not straightforward. Moreover, the lack of a standard approach may lead the researcher to make decisions that potentially inflate Type I errors. After reviewing LMMs, we introduce a step-by-step approach to avoid convergence and singularity issues and control for Type I error inflation during model reduction of fully crossed experimental designs. Specifically, we propose the use of complex random intercepts (CRIs) when maximal models are overparametrized. CRIs are multiple random intercepts that represent the residual variance of categorical fixed effects within a given grouping factor. We validated CRIs and the proposed procedure by extensive simulations and a real-case application. We demonstrate that CRIs can produce reliable results and require less computational resources. Moreover, we outline a few criteria and recommendations on how and when scholars should reduce overparametrized models. Overall, the proposed procedure provides clear solutions to avoid overinflated results using LMMs in psychology and neuroscience.} } @article{matuschekBalancingTypeError2017, title = {Balancing {{Type I}} Error and Power in Linear Mixed Models}, author = {Matuschek, Hannes and Kliegl, Reinhold and Vasishth, Shravan and Baayen, Harald and Bates, Douglas}, year = 2017, month = jun, journal = {Journal of Memory and Language}, volume = {94}, pages = {305--315}, doi = {10.1016/j.jml.2017.01.001}, urldate = {2021-05-08}, abstract = {Linear mixed-effects models have increasingly replaced mixed-model analyses of variance for statistical inference in factorial psycholinguistic experiments. Although LMMs have many advantages over ANOVA, like ANOVAs, setting them up for data analysis also requires some care. One simple option, when numerically possible, is to fit the full variance-covariance structure of random effects (the maximal model; Barr, Levy, Scheepers \& Tily, 2013), presumably to keep Type I error down to the nominal {$\alpha$} in the presence of random effects. Although it is true that fitting a model with only random intercepts may lead to higher Type I error, fitting a maximal model also has a cost: it can lead to a significant loss of power. We demonstrate this with simulations and suggest that for typical psychological and psycholinguistic data, higher power is achieved without inflating Type I error rate if a model selection criterion is used to select a random effect structure that is supported by the data.}, langid = {english}, keywords = {Hypothesis testing,Linear mixed effect model,Power} } @article{barrRandomEffectsStructure2013, title = {Random Effects Structure for Confirmatory Hypothesis Testing: {{Keep}} It Maximal}, shorttitle = {Random Effects Structure for Confirmatory Hypothesis Testing}, author = {Barr, Dale J. and Levy, Roger and Scheepers, Christoph and Tily, Harry J.}, year = 2013, month = apr, journal = {Journal of Memory and Language}, volume = {68}, number = {3}, pages = {255--278}, doi = {10.1016/j.jml.2012.11.001}, urldate = {2016-02-20}, langid = {english} } @article{stringerAsymptoticsNumericalIntegration2022, title = {Asymptotics of Numerical Integration for Two-Level Mixed Models}, author = {Stringer, Alex and Bilodeau, Blair and Tang, Yanbo}, year = 2026, journal = {Bernoulli}, note = {(forthcoming)}, abstract = {We study mixed models with a single grouping factor, where inference about unknown parameters requires optimizing a marginal likelihood defined by an intractable integral. Low-dimensional numerical integration techniques are regularly used to approximate these integrals, with inferences about parameters based on the resulting approximate marginal likelihood. For a generic class of mixed models that satisfy explicit regularity conditions, we derive the stochastic relative error rate incurred for both the likelihood and maximum likelihood estimator when adaptive numerical integration is used to approximate the marginal likelihood. We then specialize the analysis to well-specified generalized linear mixed models having exponential family response and multivariate Gaussian random effects, verifying that the regularity conditions hold, and hence that the convergence rates apply. We also prove that for models with likelihoods satisfying very weak concentration conditions that the maximum likelihood estimators from non-adaptive numerical integration approximations of the marginal likelihood are not consistent, further motivating adaptive numerical integration as the preferred tool for inference in mixed models. Code to reproduce the simulations in this paper is provided at https://github.com/awstringer1/aq-theory-paper-code.}, keywords = {Statistics - Applications,Statistics - Methodology}, annotation = {ADS Bibcode: 2022arXiv220207864S}, file = {/home/bolker/Documents/zotero_new/storage/4DSMQGKX/Stringer et al. - 2022 - Asymptotics of numerical integration for two-level mixed models.pdf} } @article{stringerExactGradientEvaluation2024, title = {Exact Gradient Evaluation for Adaptive Quadrature Approximate Marginal Likelihood in Mixed Models for Grouped Data}, author = {Stringer, Alex}, year = 2024, month = nov, journal = {Statistics and Computing}, volume = {35}, number = {1}, pages = {4}, issn = {1573-1375}, doi = {10.1007/s11222-024-10536-z}, urldate = {2025-08-24}, abstract = {A method is introduced for approximate marginal likelihood inference via adaptive Gaussian quadrature in mixed models with a single grouping factor. The core technical contribution is an algorithm for computing the exact gradient of the approximate log-marginal likelihood. This leads to efficient maximum likelihood via quasi-Newton optimization that is demonstrated to be faster than existing approaches based on finite-differenced gradients or derivative-free optimization. The method is specialized to Bernoulli mixed models with multivariate, correlated Gaussian random effects; here computations are performed using an inverse log-Cholesky parameterization of the Gaussian density that involves no matrix decomposition during model fitting, while Wald confidence intervals are provided for variance parameters on the original scale. Simulations give evidence of these intervals attaining nominal coverage if enough quadrature points are used, for data comprised of a large number of very small groups exhibiting large between-group heterogeneity. The Laplace approximation is well-known to give especially poor coverage and high bias for data comprised of a large number of small groups. Adaptive quadrature mitigates this, and the methods in this paper improve the computational feasibility of this more accurate method. All results may be reproduced using code available at https://github.com/awstringer1/aghmm-paper-code.}, langid = {english}, keywords = {Adaptive quadrature,Approximate inference,Grouped data,Longitudinal data,Mixed models}, file = {/home/bolker/Documents/zotero_new/storage/ZMVMUHFS/Stringer - 2024 - Exact gradient evaluation for adaptive quadrature approximate marginal likelihood in mixed models fo.pdf} } @incollection{ripleySelectingAmongstLarge2004a, title = {Selecting amongst Large Classes of Models}, author = {Ripley, Brian D.}, year = 2004, booktitle = {Methods and models in statistics: In honor of Professor John Nelder, FRS}, editor = {Adams, Niall M. and Crowder, Martin and Hand, D.J. and Stephens, Dave}, place = London, publisher = {Imperial College Press}, pages = {155--170}, } @misc{stringerFittingGeneralizedLinear2022b, title = {Fitting {{Generalized Linear Mixed Models}} Using {{Adaptive Quadrature}}}, author = {Stringer, Alex and Bilodeau, Blair}, year = 2022, month = feb, number = {arXiv:2202.07864}, eprint = {2202.07864}, publisher = {arXiv}, doi = {10.48550/arXiv.2202.07864}, urldate = {2024-11-14}, abstract = {We describe how to approximate the intractable marginal likelihood that arises when fitting generalized linear mixed models. We prove that non-adaptive quadrature approximations yield high error asymptotically in every statistical model satisfying weak regularity conditions. We derive the rate of error incurred when using adaptive quadrature to approximate the marginal likelihood in a broad class of generalized linear mixed models, which includes non-exponential family response and non-Gaussian random effects distributions. We provide an explicit recommendation for how many quadrature points to use, and show that this recommendation recovers and explains many empirical results from published simulation studies and data analyses. Particular attention is paid to models for dependent binary and survival/time-to-event observations. Code to reproduce results in the manuscript is found at https://github.com/awstringer1/glmm-aq-paper-code.}, archiveprefix = {arXiv}, keywords = {Statistics - Applications,Statistics - Methodology}, file = {/home/bolker/Documents/zotero_new/storage/CCAGE8L6/Stringer and Bilodeau - 2022 - Fitting Generalized Linear Mixed Models using Adaptive Quadrature.pdf;/home/bolker/Documents/zotero_new/storage/99P5FKXQ/2202.html} } @article{harrisonComparisonObservationlevelRandom2015, title = {A Comparison of Observation-Level Random Effect and Beta-Binomial Models for Modelling Overdispersion in Binomial Data in Ecology and Evolution}, author = {Harrison, Xavier A.}, year = 2015, month = jul, journal = {PeerJ}, volume = {3}, pages = {e1114}, publisher = {PeerJ Inc.}, issn = {2167-8359}, doi = {10.7717/peerj.1114}, urldate = {2023-06-20}, abstract = {Overdispersion is a common feature of models of biological data, but researchers often fail to model the excess variation driving the overdispersion, resulting in biased parameter estimates and standard errors. Quantifying and modeling overdispersion when it is present is therefore critical for robust biological inference. One means to account for overdispersion is to add an observation-level random effect (OLRE) to a model, where each data point receives a unique level of a random effect that can absorb the extra-parametric variation in the data. Although some studies have investigated the utility of OLRE to model overdispersion in Poisson count data, studies doing so for Binomial proportion data are scarce. Here I use a simulation approach to investigate the ability of both OLRE models and Beta-Binomial models to recover unbiased parameter estimates in mixed effects models of Binomial data under various degrees of overdispersion. In addition, as ecologists often fit random intercept terms to models when the random effect sample size is low ({$<$}5 levels), I investigate the performance of both model types under a range of random effect sample sizes when overdispersion is present. Simulation results revealed that the efficacy of OLRE depends on the process that generated the overdispersion; OLRE failed to cope with overdispersion generated from a Beta-Binomial mixture model, leading to biased slope and intercept estimates, but performed well for overdispersion generated by adding random noise to the linear predictor. Comparison of parameter estimates from an OLRE model with those from its corresponding Beta-Binomial model readily identified when OLRE were performing poorly due to disagreement between effect sizes, and this strategy should be employed whenever OLRE are used for Binomial data to assess their reliability. Beta-Binomial models performed well across all contexts, but showed a tendency to underestimate effect sizes when modelling non-Beta-Binomial data. Finally, both OLRE and Beta-Binomial models performed poorly when models contained {$<$}5 levels of the random intercept term, especially for estimating variance components, and this effect appeared independent of total sample size. These results suggest that OLRE are a useful tool for modelling overdispersion in Binomial data, but that they do not perform well in all circumstances and researchers should take care to verify the robustness of parameter estimates of OLRE models.}, langid = {english}, file = {/home/bolker/Documents/zotero_new/storage/5W9YL625/Harrison - 2015 - A comparison of observation-level random effect an.pdf} } @article{rabe-heskethMaximumLikelihoodEstimation2005b, title = {Maximum Likelihood Estimation of Limited and Discrete Dependent Variable Models with Nested Random Effects}, author = {{Rabe-Hesketh}, Sophia and Skrondal, Anders and Pickles, Andrew}, year = 2005, month = oct, journal = {Journal of Econometrics}, volume = {128}, number = {2}, pages = {301--323}, issn = {0304-4076}, doi = {10.1016/j.jeconom.2004.08.017}, urldate = {2026-06-20}, abstract = {Gauss--Hermite quadrature is often used to evaluate and maximize the likelihood for random component probit models. Unfortunately, the estimates are biased for large cluster sizes and/or intraclass correlations. We show that adaptive quadrature largely overcomes these problems. We then extend the adaptive quadrature approach to general random coefficient models with limited and discrete dependent variables. The models can include several nested random effects (intercepts and coefficients) representing unobserved heterogeneity at different levels of a hierarchical dataset. The required multivariate integrals are evaluated efficiently using spherical quadrature rules. Simulations show that adaptive quadrature performs well in a wide range of situations.}, keywords = {Adaptive quadrature,GLLAMM,Hierarchical models,Multilevel models,Numerical integration,Random coefficients,Random effects,Spherical quadrature rules}, file = {/home/bolker/Documents/zotero_new/storage/V84YE3JC/Rabe-Hesketh et al. - 2005 - Maximum likelihood estimation of limited and discrete dependent variable models with nested random e.pdf;/home/bolker/Documents/zotero_new/storage/3TFPFBID/S0304407604001599.html} } @article{tuerlinckxStatisticalInferenceGeneralized2006a, title = {Statistical Inference in Generalized Linear Mixed Models: {{A}} Review}, shorttitle = {Statistical Inference in Generalized Linear Mixed Models}, author = {Tuerlinckx, Francis and Rijmen, Frank and Verbeke, Geert and De Boeck, Paul}, year = 2006, journal = {British Journal of Mathematical and Statistical Psychology}, volume = {59}, number = {2}, pages = {225--255}, issn = {2044-8317}, doi = {10.1348/000711005X79857}, urldate = {2026-06-24}, abstract = {We present a review of statistical inference in generalized linear mixed models (GLMMs). GLMMs are an extension of generalized linear models and are suitable for the analysis of non-normal data with a clustered structure. A GLMM contains parameters common to all clusters (fixed regression effects and variance components) and cluster-specific parameters. The latter parameters are assumed to be randomly drawn from a population distribution. The parameters of this population distribution (the variance components) have to be estimated together with the fixed effects. We focus on the case in which the cluster-specific parameters are normally distributed. The cluster-specific effects are integrated out of the likelihood so that the fixed effects and variance components can be estimated. Unfortunately, the integral over the cluster-specific effects is intractable for most GLMMs with a normal mixing distribution. Within a classical statistical framework, we distinguish between two broad classes of methods to handle this intractable integral: methods that rely on a numerical approximation to the integral and methods that use an analytical approximation to the integrand. Finally, we present an overview of available methods for testing hypotheses about the parameters of GLMMs.}, copyright = {2006 The British Psychological Society}, langid = {english} } lme4/vignettes/lmer.bib0000644000176200001440000004332515143107606014552 0ustar liggesusers%% This BibTeX bibliography file was created using BibDesk. %% http://bibdesk.sourceforge.net/ %% Created for Steven Walker at 2014-02-14 16:07:20 -0500 %% Saved with string encoding Unicode (UTF-8) @InCollection{Chambers:1993, author = {John M. Chambers}, title = {Linear Models}, booktitle = {Statistical Models in \proglang{S}}, publisher = {Chapman \& Hall}, year = 1993, editor = {John M. Chambers and Trevor J. Hastie}, chapter = 4, pages = {95--144}, } @book{Rauden:Bryk:2002, Author = {Stephen W. Raudenbush and Anthony S. Bryk}, Edition = {2nd}, Isbn = {0-7619-1904-X}, Publisher = {Sage}, Title = {Hierarchical Linear Models: Applications and Data Analysis Methods}, Year = 2002 } @book{MLwiNUser:2000, Address = {London}, Author = {J. Rasbash and W. Browne and H. Goldstein and M. Yang and I. Plewis}, Publisher = {Multilevel Models Project, Institute of Education, University of London}, Title = {A User's Guide to \pkg{MLwiN}}, Year = 2000} @Book{davis06:csparse_book, address = {Philadelphia, PA}, author = {Tim Davis}, publisher = {SIAM}, title = {Direct Methods for Sparse Linear Systems}, year = 2006, doi = {10.1137/1.9780898718881}, } @Article{laird_ware_1982, author = {Nan M. Laird and James H. Ware}, journal = {Biometrics}, pages = {963--974}, title = {Random-Effects Models for Longitudinal Data}, volume = 38, number = 4, year = 1982, doi = {10.2307/2529876}, } @Book{bateswatts88:_nonlin, address = {Hoboken, NJ}, author = {Douglas M. Bates and Donald G. Watts}, publisher = {John Wiley \& Sons}, title = {Nonlinear Regression Analysis and Its Applications}, year = 1988, doi = {10.1002/9780470316757}, } @book{R:Pinheiro+Bates:2000, Author = {Jose C. Pinheiro and Douglas M. Bates}, Title = {Mixed-Effects Models in \proglang{S} and \proglang{S-PLUS}}, Year = 2000, Orderinfo = {springer.txt}, ISBN = {0-387-98957-0}, Publisher = {Springer-Verlag}, Abstract = {A comprehensive guide to the use of the `nlme' package for linear and nonlinear mixed-effects models.}, } @article{bates04:_linear, Author = {Douglas M. Bates and Saikat DebRoy}, Journal = {Journal of Multivariate Analysis}, doi = {10.1016/j.jmva.2004.04.013}, Number = 1, Pages = {1--17}, Title = {Linear Mixed Models and Penalized Least Squares}, Volume = 91, Year = 2004} @article{gelman2005analysis, title = {Analysis of Variance --- Why it is More Important than Ever}, author = {Gelman, Andrew}, journal = {The Annals of Statistics}, volume = 33, number = 1, pages = {1--53}, year = 2005, doi = {10.1214/009053604000001048}, publisher = {Institute of Mathematical Statistics} } @ARTICLE{1977EfronAndMorris, author = {{Efron}, B. and {Morris}, C.}, title = "{Stein's Paradox in Statistics}", journal = {Scientific American}, year = 1977, month = may, volume = 236, pages = {119-127}, doi = {10.1038/scientificamerican0577-119}, adsurl = {http://adsabs.harvard.edu/abs/1977SciAm.236e.119E}, adsnote = {Provided by the SAO/NASA Astrophysics Data System} } @article{henderson_1982, author = {Charles R. {Henderson Jr.}}, Title = {Analysis of Covariance in the Mixed Model: Higher-Level, Nonhomogeneous, and Random Regressions}, Journal = {Biometrics}, Year = 1982, Volume = 38, Number = 3, Pages = {623--640}, Language = {English}, Publisher = {International Biometric Society}, Url = {http://www.jstor.org/stable/2530044}, } @article{golub_pereyra_1973, Author = {Golub, G. H. and Pereyra, V.}, Title = {The Differentiation of Pseudo-Inverses and Nonlinear Least Squares Problems Whose Variables Separate}, Year = 1973, Journal = {SIAM Journal on Numerical Analysis}, Volume = 10, Number = 2, Pages = {413--432}, doi = {10.1137/0710036}, } @article{sleepstudy, Author = {Gregory Belenky and Nancy J. Wesensten and David R. Thorne and Maria L. Thomas and Helen C. Sing and Daniel P. Redmond and Michael B. Russo and Thomas J. Balkin}, Date-Modified = {2014-02-14 21:07:17 +0000}, Journal = {Journal of Sleep Research}, Pages = {1--12}, Title = {Patterns of Performance Degradation and Restoration During Sleep Restriction and Subsequent Recovery: A Sleep Dose-Response Study}, Volume = 12, Year = 2003, doi = {10.1046/j.1365-2869.2003.00337.x}, } @article{Chen:2008:ACS:1391989.1391995, author = {Chen, Yanqing and Davis, Timothy A. and Hager, William W. and Rajamanickam, Sivasankaran}, title = {Algorithm 887: CHOLMOD, Supernodal Sparse Cholesky Factorization and Update/Downdate}, journal = {ACM Trans. Math. Softw.}, year = 2008, volume = 35, number = 3, month = oct, issn = {0098-3500}, pages = {22:1--22:14}, articleno = 22, doi = {10.1145/1391989.1391995}, publisher = {ACM}, address = {New York, NY, USA}, keywords = {Cholesky factorization, linear equations, sparse matrices}, } @article{kenward_small_1997, author = {M. G Kenward and J. H Roger}, title = {Small Sample Inference for Fixed Effects from Restricted Maximum Likelihood}, year = {1997}, journal = {Biometrics}, volume = {53}, number = {3}, pages = {983--997}, abstract = {Restricted maximum likelihood {(REML)} is now well established as a method for estimating the parameters of the general Gaussian linear model with a structured covariance matrix, in particular for mixed linear models. Conventionally, estimates of precision and inference for fixed effects are based on their asymptotic distribution, which is known to be inadequate for some small-sample problems. In this paper, we present a scaled Wald statistic, together with an F approximation to its sampling distribution, that is shown to perform well in a range of small sample settings. The statistic uses an adjusted estimator of the covariance matrix that has reduced small sample bias. This approach has the advantage that it reproduces both the statistics and F distributions in those settings where the latter is exact, namely for Hotelling T\${\textasciicircum}2\$ type statistics and for analysis of variance F-ratios. The performance of the modified statistics is assessed through simulation studies of four different {REML} analyses and the methods are illustrated using three examples.}, doi = {10.2307/2533558}, } @Article{Satterthwaite_1946, author = {F. E. Satterthwaite}, title = {An Approximate Distribution of Estimates of Variance Components}, journal = {Biometrics Bulletin}, year = 1946, volume = 2, number = 6, pages = {110-114}, doi = {10.2307/3002019}, } @Manual{gamm4, title = {\pkg{gamm4}: Generalized Additive Mixed Models Using \pkg{mgcv} and \pkg{lme4}}, author = {Simon Wood and Fabian Scheipl}, year = 2014, note = {\proglang{R} package version 0.2-3}, url = {https://CRAN.R-project.org/package=gamm4}, } @Manual{blme, title = {\pkg{blme}: {Bayesian} Linear Mixed-Effects Models}, author = {Vincent Dorie}, year = 2015, note = {R package version 1.0-4}, url = {https://CRAN.R-project.org/package=blme}, } @Article{blme2, title = {A Nondegenerate Penalized Likelihood Estimator for Variance Parameters in Multilevel Models}, author = {Yeojin Chung and Sophia Rabe-Hesketh and Vincent Dorie and Andrew Gelman and Jingchen Liu}, year = 2013, journal = {Psychometrika}, volume = 78, number = 4, pages = {685--709}, } @article{doran2007estimating, author={Doran, Harold and Bates, Douglas and Bliese, Paul and Dowling, Maritza}, title={Estimating the Multilevel {Rasch} Model: With the \pkg{lme4} Package}, year=2007, journal={Journal of Statistical Software}, volume=20, number=2, pages={1--18}, doi = {10.18637/jss.v020.i02}, publisher={American Statistical Association}, } @TechReport{Powell_bobyqa, author = {M. J. D. Powell}, title = {The {BOBYQA} Algorithm for Bound Constrained Optimization without Derivatives}, institution = {Centre for Mathematical Sciences, University of Cambridge}, year = {2009}, number = {DAMTP 2009/NA06}, address = {Cambridge, England}, url = {http://www.damtp.cam.ac.uk/user/na/NA_papers/NA2009_06.pdf} } @article{pinheiro_unconstrained_1996, title = {Unconstrained Parametrizations for Variance-Covariance Matrices}, volume = {6}, doi = {10.1007/BF00140873}, abstract = {The estimation of variance-covariance matrices through optimization of an objective function, such as a log-likelihood function, is usually a difficult numerical problem. Since the estimates should be positive semi-definite matrices, we must use constrained optimization, or employ a parametrization that enforces this condition. We describe here five different parametrizations for variance-covariance matrices that ensure positive definiteness, thus leaving the estimation problem unconstrained. We compare the parametrizations based on their computational efficiency and statistical interpretability. The results described here are particularly useful in maximum likelihood and restricted maximum likelihood estimation in linear and non-linear mixed-effects models, but are also applicable to other areas of statistics.}, number = {3}, urldate = {2010-01-05}, journal = {Statistics and Computing}, author = {Pinheiro, JosĂ© C. and Bates, Douglas M.}, year = {1996}, pages = {289--296} } @article{bolker_strategies_2013, title = {Strategies for Fitting Nonlinear Ecological Models in \proglang{R}, \pkg{AD Model Builder}, and \proglang{BUGS}}, volume = 4, doi = {10.1111/2041-210X.12044}, number = 6, urldate = {2013-06-11}, journal = {Methods in Ecology and Evolution}, author = {Bolker, Benjamin M. and Gardner, Beth and Maunder, Mark and Berg, Casper W. and Brooks, Mollie and Comita, Liza and Crone, Elizabeth and Cubaynes, Sarah and Davies, Trevor and de Valpine, Perry and Ford, Jessica and Gimenez, Olivier and KĂ©ry, Marc and Kim, Eun Jung and Lennert-Cody, Cleridy and Magnusson, Arni and Martell, Steve and Nash, John and Nielsen, Anders and Regetz, Jim and Skaug, Hans and Zipkin, Elise}, editor = {Ramula, Satu}, month = jun, year = 2013, pages = {501--512}, pdf={bbpapers/bolker_strategies_2013.pdf} } @Article{Klein_nelder_2013, author = {Kyle Klein and Julian Neira}, title = {{Nelder-Mead} Simplex Optimization Routine for Large-Scale Problems: A Distributed Memory Implementation}, journal = {Computational Economics}, year = 2013, doi = {10.1007/s10614-013-9377-8} } @Misc{merBoot, author = {JosĂ© A. Sánchez-Espigares and Jordi Ocaña}, title = {An \proglang{R} Implementation of Bootstrap Procedures for Mixed Models}, howpublished = {Conference presentation, useR!}, month = {July}, year = {2009}, note = {accessed 25 May 2014}, url = {https://www.r-project.org/conferences/useR-2009/slides/SanchezEspigares+Ocana.pdf} } @book{gelman_data_2006, address = {Cambridge, England}, title = {Data Analysis Using Regression and {Multilevel/Hierarchical} Models}, url = {https://sites.stat.columbia.edu/gelman/arm/}, publisher = {Cambridge University Press}, author = {Gelman, Andrew and Hill, Jennifer}, year = {2006}, keywords = {uploaded} } @article{khatri1968solutions, title={Solutions to Some Functional Equations and their Applications to Characterization of Probability Distributions}, author={Khatri, CG and Rao, C Radhakrishna}, journal={Sankhy{\=a}: The Indian Journal of Statistics A}, pages={167--180}, volume = 30, number = 2, year = 1968, } @incollection{zhang2006schur, year={2005}, booktitle={The Schur Complement and its Applications}, volume={4}, series={Numerical Methods and Algorithms}, editor={Zhang, Fuzhen}, title={Basic Properties of the Schur Complement}, doi = {10.1007/0-387-24273-2_2}, publisher={Springer-Verlag}, author={Horn, RogerA. and Zhang, Fuzhen}, pages={17--46} } @book{gelman2013bayesian, title={Bayesian Data Analysis}, author={Gelman, Andrew and Carlin, John B and Stern, Hal S and Dunson, David B and Vehtari, Aki and Rubin, Donald B}, year={2013}, publisher={CRC press} } @Manual{Matrix_pkg, title = {\pkg{Matrix}: Sparse and Dense Matrix Classes and Methods}, author = {Douglas Bates and Martin Maechler}, year = 2015, note = {\proglang{R} package version 1.2-2}, url = {https://CRAN.R-project.org/package=Matrix}, } @Manual{minqa_pkg, title = {\pkg{minqa}: Derivative-Free Optimization Algorithms by Quadratic Approximation}, author = {Douglas Bates and Katharine M. Mullen and John C. Nash and Ravi Varadhan}, year = {2014}, note = {\proglang{R} package version 1.2.4}, url = {https://CRAN.R-project.org/package=minqa}, } @Article{optimx_pkg, author = {John C. Nash and Ravi Varadhan}, title = {Unifying Optimization Algorithms to Aid Software System Users: \pkg{optimx} for \proglang{R}}, journal = {Journal of Statistical Software}, year = 2011, volume = 43, number = 9, pages = {1--14}, doi = {10.18637/jss.v043.i09}, url = {https://www.jstatsoft.org/v43/i09/}, } @Misc{NLopt, author = {Steven G. Johnson}, title = {The \pkg{NLopt} Nonlinear-Optimization Package}, year = {2014}, url = { https://nlopt.readthedocs.io/en/latest/} } @Manual{nlme_pkg, title = {\pkg{nlme}: Linear and Nonlinear Mixed Effects Models}, author = {Jose Pinheiro and Douglas Bates and Saikat DebRoy and Deepayan Sarkar and {\proglang{R} Core Team}}, year = 2014, note = {\proglang{R} package version 3.1-117}, url = {https://CRAN.R-project.org/package=nlme}, } @Article{HLMdiag_pkg, title = {\pkg{HLMdiag}: A Suite of Diagnostics for Hierarchical Linear Models in \proglang{R}}, author = {Adam Loy and Heike Hofmann}, journal = {Journal of Statistical Software}, year = 2014, volume = 56, number = 5, pages = {1--28}, doi = {10.18637/jss.v056.i05}, url = {https://www.jstatsoft.org/v56/i05/}, } @Article{influenceME_pkg, title = {\proglang{Influence.ME}: Tools for Detecting Influential Data in Mixed Effects Models}, author = {Rense Nieuwenhuis and Manfred {Te Grotenhuis} and Ben Pelzer}, year = 2012, journal = {R Journal}, volume = 4, number = 2, pages = {38-47}, } @Manual{boot_pkg, author = {Angelo Canty and Brian Ripley}, year = 2015, title = { \pkg{boot}: Bootstrap \proglang{R} (\proglang{S-PLUS}) Functions}, note = {\proglang{R} package version 1.3-17}, url = {https://CRAN.R-project.org/package=boot} } @Book{DavisonHinkley1997, author = {A. C. Davison and D. V. Hinkley}, title = {Bootstrap Methods and Their Applications}, year = 1997, publisher = {Cambridge University Press}, ISBN = {0-521-57391-2}, address = {Cambridge, England} } @article{vaida2005conditional, title={Conditional Akaike Information for Mixed-Effects Models}, author={Vaida, Florin and Blanchard, Suzette}, journal={Biometrika}, volume={92}, number={2}, pages={351--370}, year={2005}, doi = {10.1093/biomet/92.2.351}, publisher={Biometrika Trust} } @book{cook1982residuals, title={Residuals and Influence in Regression}, author={Cook, R Dennis and Weisberg, Sanford}, year={1982}, publisher={New York: Chapman and Hall} } %% -------- Software manuals, mostly R and R packages --------- @Manual{lme4, title = {\pkg{lme4}: Linear Mixed-Effects Models Using \pkg{Eigen} and \proglang{S}4}, author = {Douglas Bates and Martin Maechler and Ben Bolker and Steven Walker}, year = 2014, note = {\proglang{R} package version 1.1-7}, url = {https://CRAN.R-project.org/package=lme4}, } @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 = 2015, url = {https://www.R-project.org/}, } @Unpublished{Julia, title = {\proglang{Julia}: A Fast Dynamic Language for Technical Computing}, author = {Jeff Bezanson and Stefan Karpinski and Viral B. Shah and Alan Edelman}, year = 2012, url = {https://arxiv.org/abs/1209.5145}, note = {{arXiv}:1209.5145 [cs.PL]}, } @Manual{MixedModels, title = {\pkg{MixedModels}: A \proglang{Julia} Package for Fitting (Statistical) Mixed-Effects Models}, author = {Douglas Bates}, year = 2015, note = {\proglang{Julia} package version 0.3-22}, url = {https://github.com/JuliaStats/MixedModels.jl}, } @Manual{lme4pureR, title = {\pkg{lme4pureR}: \pkg{lme4} in Pure \proglang{R}}, author = {Douglas Bates and Steven Walker}, year = 2013, note = {\proglang{R} package version 0.1-0}, url = {https://github.com/lme4/lme4pureR}, } @Manual{Eigen, title = {\pkg{Eigen}3}, author = {G Guennebaud and B Jacob and {and others}}, year = 2015, url = {https://libeigen.gitlab.io/} } @Manual{SuiteSparse, title = {\pkg{SuiteSparse}: A Suite of Sparse Matrix Software}, author = {Timothy A. Davis and others}, year = 2015, note = {Version 4.4-5}, url = {https://aldenmath.com} } @Book{lattice, title = {\pkg{lattice}: Multivariate Data Visualization with \proglang{R}}, author = {Deepayan Sarkar}, publisher = {Springer-Verlag}, address = {New York}, year = 2008, url = {http://lmdvr.R-Forge.R-project.org}, } @Article{Bates_JSS, title = {Fitting Linear Mixed-Effects Models Using {lme4}}, author = {Douglas Bates and Martin M{\"a}chler and Ben Bolker and Steve Walker}, journal = {Journal of Statistical Software}, year = {2015}, volume = {67}, number = {1}, pages = {1--48}, doi = {10.18637/jss.v067.i01}, } lme4/vignettes/lme4.bib0000644000176200001440000000611615036542626014457 0ustar liggesusers@Book{bateswatts88:_nonlin, author = {Douglas M. Bates and Donald G. Watts}, title = {Nonlinear Regression Analysis and Its Applications}, publisher = {Wiley}, year = 1988} @Article{Davis:1996, author = {Tim Davis}, title = {An approximate minimal degree ordering algorithm}, journal = {SIAM J. Matrix Analysis and Applications}, year = 1996, volume = 17, number = 4, pages = {886-905} } @Misc{CSparse, author = {Tim Davis}, title = {{CSparse}: a concise sparse matrix package}, howpublished = {http://www.cise.ufl.edu/research/sparse/CSparse}, year = 2005 } @misc{Cholmod, author = {Tim Davis}, title = {{CHOLMOD}: sparse supernodal {Cholesky} factorization and update/downdate}, howpublished = {http://www.cise.ufl.edu/research/sparse/cholmod}, year = 2005 } @Book{mccullagh89:_gener_linear_model, author = {Peter McCullagh and John Nelder}, title = {Generalized Linear Models}, publisher = {Chapman and Hall}, year = 1989, edition = {2nd}} @Article{mccullough99:_asses_reliab_of_statis_softw, author = {B. D. McCullough}, title = {Assessing the reliability of statistical software: Part II}, journal = {The American Statistician}, year = 1999, volume = 53, number = 2, month = {May}} @Book{davis06:csparse_book, author = {Timothy A. Davis }, title = {Direct Methods for Sparse Linear Systems}, publisher = {SIAM}, year = 2006, series = {Fundamentals of Algorithms} } @Book{pinh:bate:2000, author = {Jos\'{e} C. Pinheiro and Douglas M. Bates}, title = {Mixed-Effects Models in {S} and {S-PLUS}}, year = 2000, pages = {528}, ISBN = {0-387-98957-9}, publisher = {Springer} } @Article{bate:debr:2004, author = {Douglas M. Bates and Saikat DebRoy}, title = {Linear Mixed Models and Penalized Least Squares}, journal = {J. of Multivariate Analysis}, year = 2004, note = {to appear} } @Book{mccullagh:nelder:1989, author = {P. McCullagh and J.A. Nelder}, title = {Generalized Linear Models}, publisher = {Chapman \& Hall}, year = 1989 } @TechReport{Davis:2004, author = {Timothy A. Davis}, title = {Algorithm 8xx: {A} concise sparse {C}holesky factorization package}, institution = {Department of Computer and Information Science and Engineering, University of Florida}, year = 2004 } @Article{tier:kada:1986, journal = JASA, volume = "81", number = "393", pages = "82--86", author = "Luke Tierney and Joseph B. Kadane", title = "Accurate approximations for posterior moments and densities", year = "1986", } @Book{Sing:Will:2003, author = {Judith D. Singer and John B. Willett}, title = {Applied Longitudinal Data Analysis}, publisher = {Oxford University Press}, year = 2003, ISBN = {0-19-515296-4} } @BOOK{R:Chambers+Hastie:1992, author = {John M. Chambers and Trevor J. Hastie}, title = {Statistical Models in {S}}, publisher = {Chapman \& Hall}, year = 1992, address = {London} } lme4/vignettes/lmerperf.Rmd0000644000176200001440000001321515036542626015416 0ustar liggesusers--- title: "lme4 performance tips" --- ```{r opts, echo = FALSE, message = FALSE} library("knitr") knitr::opts_chunk$set( ) (load(system.file("testdata", "lmerperf.rda", package="lme4")))# 'ss' 'fitlist' ``` ```{r loadpkg,message=FALSE} library("lme4") ``` ## overview In general `lme4`'s algorithms scale reasonably well with the number of observations and the number of random effect levels. The biggest bottleneck is in the number of *top-level parameters*, i.e. covariance parameters for `lmer` fits or `glmer` fits with `nAGQ`=0 [`length(getME(model, "theta"))`], covariance and fixed-effect parameters for `glmer` fits with `nAGQ`>0. `lme4` does a derivative-free (by default) nonlinear optimization step over the top-level parameters. For this reason, "maximal" models involving interactions of factors with several levels each (e.g. `(stimulus*primer | subject)`) will be slow (as well as hard to estimate): if the two factors have `f1` and `f2` levels respectively, then the corresponding `lmer` fit will need to estimate `(f1*f2)*(f1*f2+1)/2` top-level parameters. `lme4` automatically constructs the random effects model matrix ($Z$) as a sparse matrix. At present it does *not* allow an option for a sparse fixed-effects model matrix ($X$), which is useful if the fixed-effect model includes factors with many levels. Treating such factors as random effects instead, and using the modular framework (`?modular`) to fix the variance of this random effect at a large value, will allow it to be modeled using a sparse matrix. (The estimates will converge to the fixed-effect case in the limit as the variance goes to infinity.) ## setting `calc.derivs = FALSE` After finding the best-fit model parameters (in most cases using *derivative-free* algorithms such as Powell's BOBYQA or Nelder-Mead, `[g]lmer` does a series of finite-difference calculations to estimate the gradient and Hessian at the MLE. These are used to try to establish whether the model has converged reliably, and (for `glmer`) to estimate the standard deviations of the fixed effect parameters (a less accurate approximation is used if the Hessian estimate is not available. As currently implemented, this computation takes `2*n^2 - n + 1` additional evaluations of the deviance, where `n` is the total number of top-level parameters. Using `control = [g]lmerControl(calc.derivs = FALSE)` to turn off this calculation can speed up the fit, e.g. ```{r noderivs, eval = FALSE} m0 <- lmer(y ~ service * dept + (1|s) + (1|d), InstEval, control = lmerControl(calc.derivs = FALSE)) ``` ```{r calcs, echo = FALSE} ## based on loaded lmerperf file t1 <- fitlist$basic$times[["elapsed"]] t2 <- fitlist$noderivs$times[["elapsed"]] pct <- round(100*(t1-t2)/t1) e1 <- fitlist$basic$optinfo$feval ``` Benchmark results for this run with and without derivatives show an approximately `r pct`% speedup (from `r round(t1)` to `r round(t2)` seconds on a Linux machine with AMD Ryzen 9 2.2 GHz processors). This is a case with only 2 top-level parameters, but the fit took only `r e1` deviance function evaluations (see `m0@optinfo$feval`) to converge, so the effect of the additional 7 ($n^2 -n +1$) function evaluations is noticeable. ## choice of optimizer ```{r glmeropt, echo=FALSE} gg <- glmerControl()$optimizer ``` `lmer` uses the "`r lmerControl()$optimizer`" optimizer by default; `glmer` uses a combination of `r gg[1]` (`nAGQ=0` stage) and `r gg[2]`. These are reasonably good choices, although switching `glmer` fits to `nloptwrap` for both stages may be worth a try. `allFits()` gives an easy way to check the timings of a large range of optimizers: ```{r times, as.is=TRUE, echo=FALSE} tt <- sort(ss$times[,"elapsed"]) tt2 <- data.frame(optimizer = names(tt), elapsed = tt) rownames(tt2) <- NULL knitr::kable(tt2) ``` As expected, bobyqa - both the implementation in the `minqa` package [`[g]lmerControl(optimizer="bobyqa")`] and the one in `nloptwrap` [`optimizer="nloptwrap"` or `optimizer="nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_BOBYQA"`] - are fastest. ## changing optimizer tolerances Occasionally, the default optimizer stopping tolerances are unnecessarily strict. These tolerances are specific to each optimizer, and can be set via the `optCtrl` argument in `[g]lmerControl`. To see the defaults for `nloptwrap`: ```{r default} environment(nloptwrap)$defaultControl ``` ```{r calcs2, echo = FALSE} ## based on loaded lmerperf file t1 <- fitlist$basic$times[["elapsed"]] t2 <- fitlist$noderivs$times[["elapsed"]] t3 <- fitlist$nlopt_sloppy$times[["elapsed"]] pct <- round(100*(t1-t2)/t1) e1 <- fitlist$basic$optinfo$feval ``` In the particular case of the `InstEval` example, this doesn't help much - loosening the tolerances to `ftol_abs=1e-4`, `xtol_abs=1e-4` only saves 2 functional evaluations and a few seconds, while loosening the tolerances still further gives convergence warnings. ## parallelization/BLAS There are not many options for parallelizing `lme4`. Optimized BLAS does not seem to help much. ## other packages - `glmmTMB` may be faster than `lme4` for GLMMs with large numbers of top-level parameters, especially for negative binomial models (i.e. compared to `glmer.nb`) - the `MixedModels.jl` package in Julia may be *much* faster for some problems. You do need to install Julia. - see [this short tutorial](https://github.com/ginettelafit/MixedModelswithRandJulia) or [this example](https://github.com/RePsychLing/MixedModels-lme4-bridge/blob/master/using_jellyme4.ipynb) (Jupyter notebook) - the [JellyMe4](https://github.com/palday/JellyMe4.jl) and [jglmm](https://github.com/mikabr/jglmm) packages provide R interfaces lme4/vignettes/PLSvGLS.Rnw0000644000176200001440000004356215036542626015030 0ustar liggesusers\documentclass[12pt]{article} \usepackage{Sweave,amsmath,amsfonts,bm} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} \DeclareMathOperator \tr {tr} \DefineVerbatimEnvironment{Sinput}{Verbatim} {formatcom={\vspace{-1ex}},fontshape=sl, fontfamily=courier,fontseries=b, fontsize=\footnotesize} \DefineVerbatimEnvironment{Soutput}{Verbatim} {formatcom={\vspace{-1ex}},fontfamily=courier,fontseries=b,% fontsize=\footnotesize} %%\VignetteIndexEntry{PLS vs GLS for LMMs} %%\VignetteDepends{lme4} \title{Penalized least squares versus generalized least squares representations of linear mixed models} \author{Douglas Bates\\Department of Statistics\\% University of Wisconsin -- Madison} \begin{document} \SweaveOpts{engine=R,eps=FALSE,pdf=TRUE,strip.white=true,keep.source=TRUE} \SweaveOpts{include=FALSE} \setkeys{Gin}{width=\textwidth} \newcommand{\code}[1]{\texttt{\small{#1}}} \newcommand{\package}[1]{\textsf{\small{#1}}} \newcommand{\trans}{\ensuremath{^\prime}} <>= options(width=65,digits=5) #library(lme4) @ \maketitle \begin{abstract} The methods in the \code{lme4} package for \code{R} for fitting linear mixed models are based on sparse matrix methods, especially the Cholesky decomposition of sparse positive-semidefinite matrices, in a penalized least squares representation of the conditional model for the response given the random effects. The representation is similar to that in Henderson's mixed-model equations. An alternative representation of the calculations is as a generalized least squares problem. We describe the two representations, show the equivalence of the two representations and explain why we feel that the penalized least squares approach is more versatile and more computationally efficient. \end{abstract} \section{Definition of the model} \label{sec:Definition} We consider linear mixed models in which the random effects are represented by a $q$-dimensional random vector, $\bm{\mathcal{B}}$, and the response is represented by an $n$-dimensional random vector, $\bm{\mathcal{Y}}$. We observe a value, $\bm y$, of the response. The random effects are unobserved. For our purposes, we will assume a ``spherical'' multivariate normal conditional distribution of $\bm{\mathcal{Y}}$, given $\bm{\mathcal{B}}$. That is, we assume the variance-covariance matrix of $\bm{\mathcal{Y}}|\bm{\mathcal{B}}$ is simply $\sigma^2\bm I_n$, where $\bm I_n$ denotes the identity matrix of order $n$. (The term ``spherical'' refers to the fact that contours of the conditional density are concentric spheres.) The conditional mean, $\mathrm{E}[\bm{\mathcal{Y}}|\bm{\mathcal{B}}=\bm b]$, is a linear function of $\bm b$ and the $p$-dimensional fixed-effects parameter, $\bm\beta$, \begin{equation} \label{eq:condmean} \mathrm{E}[\bm{\mathcal{Y}}|\bm{\mathcal{B}}=\bm b]= \bm X\bm\beta+\bm Z\bm b , \end{equation} where $\bm X$ and $\bm Z$ are known model matrices of sizes $n\times p$ and $n\times q$, respectively. Thus \begin{equation} \label{eq:yconditional} \bm{\mathcal{Y}}|\bm{\mathcal{B}}\sim \mathcal{N}\left(\bm X\bm\beta+\bm Z\bm b,\sigma^2\bm I_n\right) . \end{equation} The marginal distribution of the random effects \begin{equation} \label{eq:remargin} \bm{\mathcal{B}}\sim\mathcal{N}\left(\bm 0,\sigma^2\bm\Sigma(\bm\theta)\right) \end{equation} is also multivariate normal, with mean $\bm 0$ and variance-covariance matrix $\sigma^2\bm\Sigma(\bm\theta)$. The scalar, $\sigma^2$, in (\ref{eq:remargin}) is the same as the $\sigma^2$ in (\ref{eq:yconditional}). As described in the next section, the relative variance-covariance matrix, $\bm\Sigma(\bm\theta)$, is a $q\times q$ positive semidefinite matrix depending on a parameter vector, $\bm\theta$. Typically the dimension of $\bm\theta$ is much, much smaller than $q$. \subsection{Variance-covariance of the random effects} \label{sec:revarcov} The relative variance-covariance matrix, $\bm\Sigma(\bm\theta)$, must be symmetric and positive semidefinite (i.e. $\bm x\trans\bm\Sigma\bm x\ge0,\forall\bm x\in\mathbb{R}^q$). Because the estimate of a variance component can be zero, it is important to allow for a semidefinite $\bm\Sigma$. We do not assume that $\bm\Sigma$ is positive definite (i.e. $\bm x\trans\bm\Sigma\bm x>0,\forall\bm x\in\mathbb{R}^q, \bm x\ne\bm 0$) and, hence, we cannot assume that $\bm\Sigma^{-1}$ exists. A positive semidefinite matrix such as $\bm\Sigma$ has a Cholesky decomposition of the so-called ``LDL$\trans$'' form. We use a slight modification of this form, \begin{equation} \label{eq:TSdef} \bm\Sigma(\bm\theta)=\bm T(\bm\theta)\bm S(\bm\theta)\bm S(\bm\theta)\bm T(\bm\theta)\trans , \end{equation} where $\bm T(\bm\theta)$ is a unit lower-triangular $q\times q$ matrix and $\bm S(\bm\theta)$ is a diagonal $q\times q$ matrix with nonnegative diagonal elements that act as scale factors. (They are the relative standard deviations of certain linear combinations of the random effects.) Thus, $\bm T$ is a triangular matrix and $\bm S$ is a scale matrix. Both $\bm T$ and $\bm S$ are highly patterned. \subsection{Orthogonal random effects} \label{sec:orthogonal} Let us define a $q$-dimensional random vector, $\bm{\mathcal{U}}$, of orthogonal random effects with marginal distribution \begin{equation} \label{eq:Udist} \bm{\mathcal{U}}\sim\mathcal{N}\left(\bm 0,\sigma^2\bm I_q\right) \end{equation} and, for a given value of $\bm\theta$, express $\bm{\mathcal{B}}$ as a linear transformation of $\bm{\mathcal{U}}$, \begin{equation} \label{eq:UtoB} \bm{\mathcal{B}}=\bm T(\bm\theta)\bm S(\bm\theta)\bm{\mathcal{U}} . \end{equation} Note that the transformation (\ref{eq:UtoB}) gives the desired distribution of $\bm{\mathcal{B}}$ in that $\mathrm{E}[\bm{\mathcal{B}}]=\bm T\bm S\mathrm{E}[\bm{\mathcal{U}}]=\bm 0$ and \begin{displaymath} \mathrm{Var}(\bm{\mathcal{B}})=\mathrm{E}[\bm{\mathcal{B}}\bm{\mathcal{B}}\trans] =\bm T\bm S\mathrm{E}[\bm{\mathcal{U}}\bm{\mathcal{U}}\trans]\bm S\bm T\trans=\sigma^2\bm T\bm S\bm S\bm T\trans=\bm\Sigma . \end{displaymath} The conditional distribution, $\bm{\mathcal{Y}}|\bm{\mathcal{U}}$, can be derived from $\bm{\mathcal{Y}}|\bm{\mathcal{B}}$ as \begin{equation} \label{eq:YgivenU} \bm{\mathcal{Y}}|\bm{\mathcal{U}}\sim\mathcal{N}\left(\bm X\bm\beta+\bm Z\bm T\bm S\bm u, \sigma^2\bm I\right) \end{equation} We will write the transpose of $\bm Z\bm T\bm S$ as $\bm A$. Because the matrices $\bm T$ and $\bm S$ depend on the parameter $\bm\theta$, $\bm A$ is also a function of $\bm\theta$, \begin{equation} \label{eq:Adef} \bm A\trans(\bm\theta)=\bm Z\bm T(\bm\theta)\bm S(\bm\theta) . \end{equation} In applications, the matrix $\bm Z$ is derived from indicator columns of the levels of one or more factors in the data and is a \emph{sparse} matrix, in the sense that most of its elements are zero. The matrix $\bm A$ is also sparse. In fact, the structure of $\bm T$ and $\bm S$ are such that pattern of nonzeros in $\bm A$ is that same as that in $\bm Z\trans$. \subsection{Sparse matrix methods} \label{sec:sparseMatrix} The reason for defining $\bm A$ as the transpose of a model matrix is because $\bm A$ is stored and manipulated as a sparse matrix. In the compressed column-oriented storage form that we use for sparse matrices, there are advantages to storing $\bm A$ as a matrix of $n$ columns and $q$ rows. In particular, the CHOLMOD sparse matrix library allows us to evaluate the sparse Cholesky factor, $\bm L(\bm\theta)$, a sparse lower triangular matrix that satisfies \begin{equation} \label{eq:SparseChol} \bm L(\bm\theta)\bm L(\bm\theta)\trans= \bm P\left(\bm A(\bm\theta)\bm A(\bm\theta)\trans+\bm I_q\right)\bm P\trans , \end{equation} directly from $\bm A(\bm\theta)$. In (\ref{eq:SparseChol}) the $q\times q$ matrix $\bm P$ is a ``fill-reducing'' permutation matrix determined from the pattern of nonzeros in $\bm Z$. $\bm P$ does not affect the statistical theory (if $\bm{\mathcal{U}}\sim\mathcal{N}(\bm 0,\sigma^2\bm I)$ then $\bm P\trans\bm{\mathcal{U}}$ also has a $\mathcal{N}(\bm 0,\sigma^2\bm I)$ distribution because $\bm P\bm P\trans=\bm P\trans\bm P=\bm I$) but, because it affects the number of nonzeros in $\bm L$, it can have a tremendous impact on the amount storage required for $\bm L$ and the time required to evaluate $\bm L$ from $\bm A$. Indeed, it is precisely because $\bm L(\bm\theta)$ can be evaluated quickly, even for complex models applied the large data sets, that the \code{lmer} function is effective in fitting such models. \section{The penalized least squares approach to linear mixed models} \label{sec:Penalized} Given a value of $\bm\theta$ we form $\bm A(\bm\theta)$ from which we evaluate $\bm L(\bm\theta)$. We can then solve for the $q\times p$ matrix, $\bm R_{\bm{ZX}}$, in the system of equations \begin{equation} \label{eq:RZX} \bm L(\theta)\bm R_{\bm{ZX}}=\bm P\bm A(\bm\theta)\bm X \end{equation} and for the $p\times p$ upper triangular matrix, $\bm R_{\bm X}$, satisfying \begin{equation} \label{eq:RX} \bm R_{\bm X}\trans\bm R_{\bm X}= \bm X\trans\bm X-\bm R_{\bm{ZX}}\trans\bm R_{\bm{ZX}} \end{equation} The conditional mode, $\tilde{\bm u}(\bm\theta)$, of the orthogonal random effects and the conditional mle, $\widehat{\bm\beta}(\bm\theta)$, of the fixed-effects parameters can be determined simultaneously as the solutions to a penalized least squares problem, \begin{equation} \label{eq:PLS} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \widehat{\bm\beta}(\bm\theta) \end{bmatrix}= \arg\min_{\bm u,\bm\beta}\left\| \begin{bmatrix}\bm y\\\bm 0\end{bmatrix} - \begin{bmatrix} \bm A\trans\bm P\trans & \bm X\\ \bm I_q & \bm 0 \end{bmatrix} \begin{bmatrix}\bm u\\\bm\beta\end{bmatrix} , \right\|^2 \end{equation} for which the solution satisfies \begin{equation} \label{eq:PLSsol} \begin{bmatrix} \bm P\left(\bm A\bm A\trans+\bm I\right)\bm P\trans & \bm P\bm A\bm X\\ \bm X\trans\bm A\trans\bm P\trans & \bm X\trans\bm X \end{bmatrix} \begin{bmatrix} \tilde{\bm u}(\bm\theta)\\ \widehat{\bm\beta}(\bm\theta) \end{bmatrix}= \begin{bmatrix}\bm P\bm A\bm y\\\bm X\trans\bm y\end{bmatrix} . \end{equation} The Cholesky factor of the system matrix for the PLS problem can be expressed using $\bm L$, $\bm R_{\bm Z\bm X}$ and $\bm R_{\bm X}$, because \begin{equation} \label{eq:PLSChol} \begin{bmatrix} \bm P\left(\bm A\bm A\trans+\bm I\right)\bm P\trans & \bm P\bm A\bm X\\ \bm X\trans\bm A\trans\bm P\trans & \bm X\trans\bm X \end{bmatrix} = \begin{bmatrix} \bm L & \bm 0\\ \bm R_{\bm Z\bm X}\trans & \bm R_{\bm X}\trans \end{bmatrix} \begin{bmatrix} \bm L\trans & \bm R_{\bm Z\bm X}\\ \bm 0 & \bm R_{\bm X} \end{bmatrix} . \end{equation} In the \code{lme4} package the \code{"mer"} class is the representation of a mixed-effects model. Several slots in this class are matrices corresponding directly to the matrices in the preceding equations. The \code{A} slot contains the sparse matrix $\bm A(\bm\theta)$ and the \code{L} slot contains the sparse Cholesky factor, $\bm L(\bm\theta)$. The \code{RZX} and \code{RX} slots contain $\bm R_{\bm Z\bm X}(\bm\theta)$ and $\bm R_{\bm X}(\bm\theta)$, respectively, stored as dense matrices. It is not necessary to solve for $\tilde{\bm u}(\bm\theta)$ and $\widehat{\bm\beta}(\bm\theta)$ to evaluate the \emph{profiled} log-likelihood, which is the log-likelihood evaluated $\bm\theta$ and the conditional estimates of the other parameters, $\widehat{\bm\beta}(\bm\theta)$ and $\widehat{\sigma^2}(\bm\theta)$. All that is needed for evaluation of the profiled log-likelihood is the (penalized) residual sum of squares, $r^2$, from the penalized least squares problem (\ref{eq:PLS}) and the determinant $|\bm A\bm A\trans+\bm I|=|\bm L|^2$. Because $\bm L$ is triangular, its determinant is easily evaluated as the product of its diagonal elements. Furthermore, $|\bm L|^2 > 0$ because it is equal to $|\bm A\bm A\trans + \bm I|$, which is the determinant of a positive definite matrix. Thus $\log(|\bm L|^2)$ is both well-defined and easily calculated from $\bm L$. The profiled deviance (negative twice the profiled log-likelihood), as a function of $\bm\theta$ only ($\bm\beta$ and $\sigma^2$ at their conditional estimates), is \begin{equation} \label{eq:profiledDev} d(\bm\theta|\bm y)=\log(|\bm L|^2)+n\left(1+\log(r^2)+\frac{2\pi}{n}\right) \end{equation} The maximum likelihood estimates, $\widehat{\bm\theta}$, satisfy \begin{equation} \label{eq:thetamle} \widehat{\bm\theta}=\arg\min_{\bm\theta}d(\bm\theta|\bm y) \end{equation} Once the value of $\widehat{\bm\theta}$ has been determined, the mle of $\bm\beta$ is evaluated from (\ref{eq:PLSsol}) and the mle of $\sigma^2$ as $\widehat{\sigma^2}(\bm\theta)=r^2/n$. Note that nothing has been said about the form of the sparse model matrix, $\bm Z$, other than the fact that it is sparse. In contrast to other methods for linear mixed models, these results apply to models where $\bm Z$ is derived from crossed or partially crossed grouping factors, in addition to models with multiple, nested grouping factors. The system (\ref{eq:PLSsol}) is similar to Henderson's ``mixed-model equations'' (reference?). One important difference between (\ref{eq:PLSsol}) and Henderson's formulation is that Henderson represented his system of equations in terms of $\bm\Sigma^{-1}$ and, in important practical examples, $\bm\Sigma^{-1}$ does not exist at the parameter estimates. Also, Henderson assumed that equations like (\ref{eq:PLSsol}) would need to be solved explicitly and, as we have seen, only the decomposition of the system matrix is needed for evaluation of the profiled log-likelihood. The same is true of the profiled the logarithm of the REML criterion, which we define later. \section{The generalized least squares approach to linear mixed models} \label{sec:GLS} Another common approach to linear mixed models is to derive the marginal variance-covariance matrix of $\bm{\mathcal{Y}}$ as a function of $\bm\theta$ and use that to determine the conditional estimates, $\widehat{\bm\beta}(\bm\theta)$, as the solution of a generalized least squares (GLS) problem. In the notation of \S\ref{sec:Definition} the marginal mean of $\bm{\mathcal{Y}}$ is $\mathrm{E}[\bm{\mathcal{Y}}]=\bm X\bm\beta$ and the marginal variance-covariance matrix is \begin{equation} \label{eq:marginalvarcovY} \mathrm{Var}(\bm{\mathcal{Y}})=\sigma^2\left(\bm I_n+\bm Z\bm T\bm S\bm S\bm T\trans\bm Z\trans\right)=\sigma^2\left(\bm I_n+\bm A\trans\bm A\right) =\sigma^2\bm V(\bm\theta) , \end{equation} where $\bm V(\bm\theta)=\bm I_n+\bm A\trans\bm A$. The conditional estimates of $\bm\beta$ are often written as \begin{equation} \label{eq:condbeta} \widehat{\bm\beta}(\bm\theta)=\left(\bm X\trans\bm V^{-1}\bm X\right)^{-1}\bm X\trans\bm V^{-1}\bm y \end{equation} but, of course, this formula is not suitable for computation. The matrix $\bm V(\bm\theta)$ is a symmetric $n\times n$ positive definite matrix and hence has a Cholesky factor. However, this factor is $n\times n$, not $q\times q$, and $n$ is always larger than $q$ --- sometimes orders of magnitude larger. Blithely writing a formula in terms of $\bm V^{-1}$ when $\bm V$ is $n\times n$, and $n$ can be in the millions does not a computational formula make. \subsection{Relating the GLS approach to the Cholesky factor} \label{sec:GLStoL} We can use the fact that \begin{equation} \label{eq:Vinv} \bm V^{-1}(\bm\theta)=\left(\bm I_n+\bm A\trans\bm A\right)^{-1}= \bm I_n-\bm A\trans\left(\bm I_q+\bm A\bm A\trans\right)^{-1}\bm A \end{equation} to relate the GLS problem to the PLS problem. One way to establish (\ref{eq:Vinv}) is simply to show that the product \begin{multline*} (\bm I+\bm A\trans\bm A)\left(\bm I-\bm A\trans\left(\bm I+\bm A\bm A\trans\right)^{-1}\bm A\right)\\ \begin{aligned} =&\bm I+\bm A\trans\bm A-\bm A\trans\left(\bm I+\bm A\bm A\trans\right) \left(\bm I+\bm A\bm A\trans\right)^{-1}\bm A\\ =&\bm I+\bm A\trans\bm A-\bm A\trans\bm A\\ =&\bm I . \end{aligned} \end{multline*} Incorporating the permutation matrix $\bm P$ we have \begin{equation} \label{eq:PLA} \begin{aligned} \bm V^{-1}(\bm\theta)=&\bm I_n-\bm A\trans\bm P\trans\bm P\left(\bm I_q+\bm A\bm A\trans\right)^{-1}\bm P\trans\bm P\bm A\\ =&\bm I_n-\bm A\trans\bm P\trans(\bm L\bm L\trans)^{-1}\bm P\bm A\\ =&\bm I_n-\left(\bm L^{-1}\bm P\bm A\right)\trans\bm L^{-1}\bm P\bm A . \end{aligned} \end{equation} Even in this form we would not want to routinely evaluate $\bm V^{-1}$. However, (\ref{eq:PLA}) does allow us to simplify many common expressions. For example, the variance-covariance of the estimator $\widehat{\bm \beta}$, conditional on $\bm\theta$ and $\sigma$, can be expressed as \begin{equation} \label{eq:varcovbeta} \begin{aligned} \sigma^2\left(\bm X\trans\bm V^{-1}(\bm\theta)\bm X\right)^{-1} =&\sigma^2\left(\bm X\trans\bm X-\left(\bm L^{-1}\bm P\bm A\bm X\right)\trans\left(\bm L^{-1}\bm P\bm A\bm X\right)\right)^{-1}\\ =&\sigma^2\left(\bm X\trans\bm X-\bm R_{\bm Z\bm X}\trans\bm R_{\bm Z\bm X}\right)^{-1}\\ =&\sigma^2\left(\bm R_{\bm X}\trans\bm R_{\bm X}\right)^{-1} . \end{aligned} \end{equation} \section{Trace of the ``hat'' matrix} \label{sec:hatTrace} Another calculation that is of interest to some is the the trace of the ``hat'' matrix, which can be written as \begin{multline} \label{eq:hatTrace} \tr\left(\begin{bmatrix}\bm A\trans&\bm X\end{bmatrix} \left(\begin{bmatrix}\bm A\trans&\bm X\\\bm I&\bm0\end{bmatrix}\trans \begin{bmatrix}\bm A\trans&\bm X\\\bm I&\bm0\end{bmatrix}\right)^{-1} \begin{bmatrix}\bm A\\\bm X\trans\end{bmatrix}\right)\\ = \tr\left(\begin{bmatrix}\bm A\trans&\bm X\end{bmatrix} \left(\begin{bmatrix}\bm L&\bm0\\ \bm R_{\bm{ZX}}\trans&\bm R_{\bm X}\trans\end{bmatrix} \begin{bmatrix}\bm L\trans&\bm R_{\bm{ZX}}\\ \bm0&\bm R_{\bm X}\end{bmatrix}\right)^{-1} \begin{bmatrix}\bm A\\\bm X\trans\end{bmatrix}\right) \end{multline} \end{document} lme4/vignettes/autoscale_ref.bib0000644000176200001440000000241315127735433016427 0ustar liggesusers@article{bolker2013strategies, title={Strategies for fitting nonlinear ecological models in R, AD Model Builder, and BUGS}, author={Bolker, Benjamin M and Gardner, Beth and Maunder, Mark and Berg, Casper W and Brooks, Mollie and Comita, Liza and Crone, Elizabeth and Cubaynes, Sarah and Davies, Trevor and de Valpine, Perry and others}, journal={Methods in Ecology and Evolution}, volume={4}, number={6}, pages={501--512}, year={2013}, publisher={Wiley Online Library} } @article{gelman2008scaling, title={Scaling regression inputs by dividing by two standard deviations}, author={Gelman, Andrew}, journal={Statistics in medicine}, volume={27}, number={15}, pages={2865--2873}, year={2008}, publisher={Wiley Online Library} } @article{schielzethSimple2010, title = {Simple Means to Improve the Interpretability of Regression Coefficients: {{Interpretation}} of Regression Coefficients}, shorttitle = {Simple Means to Improve the Interpretability of Regression Coefficients}, author = {Schielzeth, Holger}, year = {2010}, month = feb, journal = {Methods in Ecology and Evolution}, volume = {1}, number = {2}, pages = {103--113}, issn = {2041210X, 2041210X}, doi = {10.1111/j.2041-210X.2010.00012.x}, urldate = {2016-06-08} } lme4/vignettes/autoscale.Rmd0000644000176200001440000001325615127735433015570 0ustar liggesusers--- title: "Autoscaling in lme4" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Autoscaling in lme4} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} bibliography: autoscale_ref.bib --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` Scaling predictors in a linear model (or extended linear models, such as LMMs or GLMMs) so that all of the predictors are on a similar scale (and thus, in general, the estimated parameters should have a similar scale) can improve the behaviour of various computational methods (see e.g. the "Remove eccentricity by scaling" section of @bolker2013strategies). `lmer()` and `glmer()` issue warnings suggesting that users consider re-scaling predictors when the predictor variables are on very different scales. Re-scaling predictors can improve both computation and interpretation [@schielzethSimple2010] of (extended) linear models. However, in cases where researchers want to scale predictors for computational stability, but get parameter estimates on the scale of the original (unscaled) predictors, back-transforming the predictors, covariance matrix, etc., is tedious. `lme4` now allows this scaling to be done automatically, behind the scenes. An example of a warning message due to disparate predictor scales: ```{r setup} library(lme4) set.seed(1) sleepstudy$var1 = runif(nrow(sleepstudy), 1e6, 1e7) fit1 <- lmer(Reaction ~ var1 + Days + (Days | Subject), sleepstudy) ``` Instead of re-fitting with scaled predictors we can use a new (as of `lme4` version >= 1.1.37) argument for `(g)lmerControl`, called `autoscale`, where `scale()` is automatically applied to the continuous covariates, but when delivered to the user, the coefficient estimates and the covariances are back-transformed. This maintains the original interpretation and minimizes user intervention. Hence: ```{r fit} fit2 <- lmer(Reaction ~ var1 + Days + (Days | Subject), control = lmerControl(autoscale = TRUE), sleepstudy) all.equal(fixef(fit1), fixef(fit2)) all.equal(vcov(fit2), vcov(fit2)) ``` ```{r echo = FALSE} ## https://stackoverflow.com/a/67456510/190277 get_val <- function(x) as.numeric(gsub("^.*?(\\d+\\.?\\d+e?[+-]?\\d+).*$", "\\1", x)) get_tol <- function(x,y, dig=1) signif(get_val(all.equal(x, y, tolerance = 0)), dig) ftol <- get_tol(fixef(fit1), fixef(fit2)) vtol <- get_tol(vcov(fit1), vcov(fit2)) ``` The parameters are in fact slightly different (relative difference in fixed effects of $`r vtol`$, and in covariance matrices of $`r ftol`$); these differences will be larger for less numerically stable models (i.e. more complicated or poorly data-constrained). ## Autoscale Mechanism The base function `scale()` is applied to the model matrix `X` as found in `lFormula()` or `glFormula()` from `R/Modular.R`. To back transform, we use the `scaled:center` and `scaled:scale` attributes to reverse the changes found in `fixef.merMod()`, `model.matrix.merMod()`, and `vcov.merMod()` such that the `summary()` output shows the coefficients according to the original scale. Reverting back the changes for `fixef.merMod()`, the $\beta$ coefficients, is not too difficult. However, reverting said changes for the variance-covariance matrix is a bit more involved. The exact modification can be found from the function `scale_vcov()` (found in `R/utilities.R`), and the derivation is explained below. Consider the following estimation of a simple linear model: \[ \widehat{Y} = \widehat{\beta}_{0} + \widehat{\beta}_{1} X^{*}, \] where $X^{*}$ represents the scaled version of $X$. That is, if we let $C$ represent a vector that contains the values for centering and $S$ represent a vector that contains the values for scaling, we have: \[ \widehat{Y} = \widehat{\beta}_{0} + \widehat{\beta}_{1} \left( \frac{X - C}{S} \right) \] \[ \widehat{Y} = \widehat{\beta}_{0} - \sum_{i=1}^{p} \frac{\widehat{\beta}_{i}c_{i}}{s_{i}} + \sum_{i=1}^{p} \frac{\widehat{\beta}_{i} x_{i}}{s_{i}}. \] From the above, it is clear that the new intercept can be represented as: \[ \widehat{\beta}_{0}' = \widehat{\beta}_{0} - \sum_{i=1}^{p} \frac{\widehat{\beta}_{i}c_{i}}{s_{i}}. \] Similarly, the new coefficients are represented as: \[ \widehat{\beta}_{i}' = \frac{\widehat{\beta}_{i}}{s_{i}}. \] Then, the new variance-covariance matrix can be derived using the following: \newcommand{\cov}{\textrm{Cov}}} \[ \cov\left( \frac{\widehat{\beta}_{i}}{s_{i}}, \frac{\widehat{\beta}_{j}}{s_{j}} \right) = \frac{1}{s_{i}s_{j}} \cov(\widehat{\beta}_{i}, \widehat{\beta_{j}}) = \frac{\sigma_{ij}^{2}}{s_{i}s_{j}} \] \begin{equation} \begin{split} \cov\left( \widehat{\beta}_{0} - \sum_{i=1}^{p} \frac{\widehat{\beta}_{i}c_{i}}{s_{i}}, \widehat{\beta}_{0} - \sum_{j=1}^{p} \frac{\widehat{\beta}_{i}c_{i}}{s_{i}} \right) &= \cov(\widehat{\beta}_{0}, \widehat{\beta}_{0} ) - 2 \sum_{i=1}^{p} \frac{c_{i}}{s_{i}} \cov(\widehat{\beta}_{0} , \widehat{\beta}_{i}) + \sum_{i=1}^{p} \sum_{j=1}^{p} \frac{c_{i}c_{j}}{s_{i}s_{j}} \cov(\widehat{\beta}_{i}, \widehat{\beta}_{j}) \\ &= \sigma_{0}^{2} - 2 \sum_{i=1}^{p} \frac{c_{i}}{s_{i}} \sigma_{0i}^{2} + \sum_{i=1}^{p} \sum_{j=1}^{p} \frac{c_{i}c_{j}}{s_{i}s_{j}} \sigma_{ij}^{2} \end{split} \end{equation} \begin{equation} \begin{split} \cov\left( \widehat{\beta}_{0} - \sum_{i=1}^{p} \frac{\widehat{\beta}_{i}c_{i}}{s_{i}}, \frac{\widehat{\beta_{j}}}{s_{j}} \right) &= \cov\left( \widehat{\beta}_{0}, \frac{\widehat{\beta}_{j}}{s_{j}} \right) - \sum_{i=1}^{p} \frac{c_{i}}{s_{i}s_{j}} \cov \left( \widehat{\beta}_{i}, \widehat{\beta}_{j} \right) \\ &= \frac{\sigma_{0j}^{2}}{s_{j}} - \sum_{i=1}^{p} \frac{c_{i}}{s_{i}s_{j}} \sigma_{ij}^{2}, \end{split} \end{equation} for $j = 1, 2, ..., p$. ## References lme4/vignettes/jsslogo.jpg0000644000176200001440000005431315206606050015313 0ustar liggesusers˙Ř˙ŕJFIF˙ţI CREATOR: XV Version 3.10 Rev: 12/16/94 Quality = 75, Smoothing = 0 ˙ŰC    $.' ",#(7),01444'9=82<.342˙ŰC  2!!22222222222222222222222222222222222222222222222222˙Ŕ"˙Ä ˙ĵ}!1AQa"q2‘ˇ#B±ÁRŃđ$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz„…†‡‰Š’“”•–—™š˘Ł¤Ą¦§¨©Ş˛ł´µ¶·¸ąşÂĂÄĹĆÇČÉĘŇÓÔŐÖ×ŘŮÚáâăäĺćçčéęńňóôőö÷řůú˙Ä ˙ĵw!1AQaq"2B‘ˇ±Á #3RđbrŃ $4á%ń&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚„…†‡‰Š’“”•–—™š˘Ł¤Ą¦§¨©Ş˛ł´µ¶·¸ąşÂĂÄĹĆÇČÉĘŇÓÔŐÖ×ŘŮÚâăäĺćçčéęňóôőö÷řůú˙Ú ?ĆŮśddö ÇŰó«r9ÇNÔͤő®í$¬Ń7~ëI´ôĹYŔďÖAëý)_knÉŔĄ lźĄKÓ©Ídă@Ćy`/ g4mö©0IęjC)\h®Tc‘Í $㊜B} 8CřRş›+N‡­8}*o$çÍSgúQ΂̇‚ÄbšŃäđµh@ŮéOíÉ*ôŁťL©ÉᦑÇÍ_Ů?rźö^FőĄÎ‚Ćf;Ś{űRů~˘´ľÉŽ6Žýi†Ü‘Âoz\Čv3ü°O< FB0qZ‚Čž6ńďCYd&EČ,d'ŻNĄXĆ6€ô­o±g‚ą Ů r˘ź: Lłč9Ĺ6Ú;V§ŮF *G†Ű…Łť ĆVĆă˝'”KmĆMjýś˙w4ńgÓĺĄĚ‚ĆYŹÔóI·t;}iJŚÖŻŮAÎGaGظĆÚ\Č,dŕ4ď/ڴŨ=ţTﲌź—s ±ś#ÇĄ8!Íh}€0{űR@ţ(ç ţOŻj<Ľő­&·8R ?ěçđŁÚŠn´ő€b®‰vžbĆ úQíČg#˝ ‡Źjľa$pü)LDvĎ˝.pĺ3üś”y\U˙!‹8Ą6řÇ"ź´ ĽŁéšq‹ĐU±Šy€âŽaXˇĺă­7ʆj÷ŮÉ >¸ŁČ'·Ňź5‚Ĺ}§ÓĄ7`'Ą^ň:S,@ůsKś,T =)DY?J·ä·qO°Ŕ^”sŹ”¨W=¸¤ňřŕUď+$ {b”BOsG2)@Ž"šUH­ŕŹÂ`öůŃ6(qH@éŹzľ-Î~ďľ@¤kp2zóOť™A”wJŚ¨ükE­1Ôsči¦ŘçQÎ…fPÚ;s@<Šľ-pH&[sÁĄÎ‚Ĺ]Ş"“ö«źeČÁŁěę(çCł)Š‘ŚqÍXű7?­;ČÉéĹ.d+3ÁŁJ¸- éNű#c Tó˘¬ĘYăž(Ď˝]ŤÁŰÍ/Ůźţyţ”ů¬Q`ôm©Öĺ‚E;Ęn¸éG2 2©QL!V2ĚBÉ>• ÖÍśăŁ{eňźxĘczŇu,®5»UďŠâ†w†Ţ0)ĆăĐÔ6^*ťµ–xBÇk`óT|CŁ®ź¨ką˘pd==jć•ĄBt;ťBp Ć"ç˝sşú\ô'ŁÇc(e;äj”X§§J—J‰†Źkćó'”ą©ÎëíIŐ0T•ĘÍ:çA¶‹ «‡qůši(Ď4ťQű2ŞŰ§¦MH!Nę?*“ŕp*=¨ý™”¤ň(ňWÓµ1ţťé0A#Ňź´fC´ŁéM(;Š°@â¨ĹĐ9 űWŚ <±ŚV6sžÔc·"Źh„…;Ëg§Z~Î3ÍdOڢўp)|Ąî8§líJ#ůqUír23öćDąč*]‚ĹŃ •‘yKž”މéúÔ‚"(zdzŃíÔ D&—Ę@Ü ›Ë\pE]Ŕ@ĄíWqű6D°Ż8žPǧ­LAč>´m=ű{Ô{TWł+Âđ§G F6–=¨ŰóžiűdĚ‹bŇőĆ*pŁż?JaPqŽ”ý¨˝ß)1ÔÓLJG&Ŕ;š:tŁÚ!FÇ_zr ďJXŽÜŇĹÔ9‘W#ÂŁ´Ş@ŔíK»"ŹjĂŮ e˙•&Ő?Z íŽirqŽ”˝˝Ń´űçÜR¬Y´˝»±HoéůŇŚüř `Ž}iT ŢÔ{f'IÚ1ĆN=é›pGR䔀ć´U™’#Ř1׏jO(qÍM·čÇ9ŕÓöĚ^ÉĚ]»ý)¦1VŹř­|¸ç9Í?¬‹Ř•Ę69â“gÇ7qś†OSUíÉö#cC’ŢžÓ”G=)Ă’)űq{!ŤÝxëC 4üäă˝9±·4ýł'ŘăŹŇ™=ÍLŁŽq×4Ą~˙CžiŞÁěx÷â”FFH ź§n´ăň§í…ěÄGőÍ;ʤ\Í)ąŞUEěŃĚr*ĹÎy5.4ń“Ŕâźµf6śđx¤Ś@5chü)6űuŁÚ‹Ů ŁžsIŚő5.ŐľiHąŁÚ±ű"śdô¨Ś\*ĎŽďIÎzgźJ=°{4VÚĂך<ˇŽjÇÚ›ŹQKÚ‡ł+2ńÁ9=©úwö«'Ž˝3#ŻÔŇöěČBŚń×úÓÖ 94đ~”đJźḣädţ4˝8=sRŕp3÷<ŃíČ7dŇuç?říMĆ"“#ÖŹić„ >QČéëŠv8Ŕç·ôˇJíč?\€=ńÖŹhÍyă ţÎk+Äm·I—*1ôô­MÄg'§=+Äq–ÓĄ©v>[{¦¶űë†ÉćşK®–Ťý×^•Íé!EÜŞNŢk~ü˙˘)ÎBsZUÜҢHAPW““Šŕ{Q ˛…Ô‚0sŠV˘¸ŃmČŕś~5sŽ*RH^ťč €sRŮ6!Ú~†‚*NřČ4Ü ň(¸XhÎxĄPG8Í<ŕžFIb‹˛¬=@viFAé@űÝ9ŞšŽĄo¦[™ç#=ŁyŹ +·dIjy˘¶·’âv Xž‚ął«ÜëwŃE¤ >ʇ2ĚFúU?łęŢ(şŤî˘k[% ±Ëzë­­ ±·@»PÂŞ\°ZęÁ+˛vQŽNžőN:ćžNW‘ŠőŕW5Ů­‡gŹzPŘäÓ&ŠWcXdâ‚rhűÝxĄ+Ç\VA$šP8÷Łič9¤ÁĎ ţTÂsśőü)ŕ69gÖ™‚OCO ÷¤¸Ł88#šANăHAŚŚÓ~”śç8˘‹‡*ô4ő>ĽfN:f€ 9§ĚÄâLHě;f”´Ü~éČĄ@âŽf€WśšO/ą8ę3ÜQśfťĹĘ4§Ż4,dŽśÇó§©Č¨–ÄxëÔS‚b¤\sŠx#t'Ţ™"°ČÇ4¦3·?ĄH1śgźçG˸súŐ¦¤x ň1Ĺyçô§6Öň}é29çŇ‹±XŤGÍČëO+“śqšp#8ěN(Óój“(Š“âęéFwE_1ĆF>™'ňĄśŽ)FĄÁŚfŽf‚äÎăA\ ž=ÍC%ĺ¤ÜÂźďHl,‰6ŕÜ0qŽ˝«#Qń^“§Áş;®%<,P¶â*Żmâ76ĘÇů-śPî‚É›¤Ý)¸95‡{âŘ-0ZÂí¸ä…âąÝWĆ÷÷´» #'ř¤oĘš„Ą°´;Ü÷Í7$ŽµçVWÚÝÄE®ĚčHĆH9úWGg¬Ëgnâvó€č0F?IÂHĄĘo@éMĆů×/qâ]I›÷6‘¨÷ć–O¨/íÂG’ /j%`VgPˇäŠńdä ΋VÓ¦PÉ{«Yúż‹,tż-GúC°ĎĘĂëYĄ6ě7‹=†sHq돭p˛řâöu˙F¶Ť©95š%ŐőIKK,çćěH ô­}›JňvNű#ŇšTŠ=îÁSÔšŹíPö’<×A\IŇo§Ťa˝ż‘áSţ­jě5ălÜq÷ŹřVN¤#§1k'ĐęAČçü˙ú©Ŕ:ŕf ˛jAČć·lÉ!ĚÜqYú¬fM6S×˝^›j)źŻGz«ć›">Ő׆«Ěś™5âă˘='DđĽ:V“W(Ż>3!ţ”Ż,Ź±B¦îŐ`ëp_A Ž21őĹdÝß,lT±/Óă^m[ÎnÇMËI$¬Ř×OóřóQ}¶Ôqć/çX:ŤäÓIş¶×™‚ŹQëYÇĂ’'5´0ŞJňv븻#ŃNM/<`Ň(R)üv8®˙Şľç•ő…ŘNýj78ŤňOCҤlUKéD63¸<„8ĄőVťîXOˇĺÚ«â÷pçć5§$ű¬be<©ÍbęD™˝hÚ0:iďÎkĄ­âő;o]Ź&hrN0Ă5ż#ÄxRĺWRAž*A®ř¨ç<śţ&ą'C™šűnR–ćϧăJdçÚ¬™ĺqMs)/…úžj~¨ßPúÂěUçţu"ÉÜŚíҲďüG¦XäŢă€qÚ§ŽgšVK*ť±T°rîßČ[[ĽÉć ÇNőÁkž3şżo#Ni#^ĺO'ń¬¨­ő}~uF9<í^ řĆĆ5ü $Ě2“…­cJ4÷Őę¶Î'HđÝy’–<¬ž?:ęŁđa+ţ‘{ŰřEv©0 H*Ž ŠÝAýjgĎ-ť†ŞEnqřŘŚĄĚ€ű¨®;]ӢѯŤżš$8ę1őŻfň€ÇgšńĎĘÄw ölUQSżĽÄęEěŚF)ÓĄBUĘąŻZ™‘HÝŠŚĆq]¤VŽŇđ?ďQ¶»w<÷®ň9Ľ’NPŚúכ鄛KłÓ =Ťvmré „Ç%$M¤˙Zť™ťEˇąŔ%ň¸Áč P·ťˇÔná$ŕ|Ę3ëQůűŘŔÉőŞ1ĘÇYžsŰę)$ięŤöl&BŮz äŃ|˛ š7íščĄfe ścŽkôó}ăaúR6¦ě¬zf™oi5źĎo Ź×-'® +%#m¤é¬ż Ě'Ó fv çŇş )ĎĘyŐpň”®™Ô«Ć+T@ż(Â(Qě)rIëĎz”ôĄ ˝p*V÷¬Ç±ÁÇúŠÚxgĐU€ŞGAK±3÷E?Ş>áő…ŘŞyŕR}F~µgËŹŇťĺ&:RúŁîX*žżQɦçóVĽ” ‚˝ DÝhú›îXE<ý(==ęד*1G’„p´}M÷Ö[¶{Ň>ŐoĘ_îÓv!ţG­R}Ĺő•Ř®c§>´Ą°ĽÔŢJö@)UQĘ{ńOęOą?Z]秥'™‚sS…ĆFÎ;ńY7ţ!°°fV;¤^Şő§ő'ÜXň}¨Cc÷nqťľµĆęŢ"ş›y3a챜Tµď é7"ŞŕaTzÖĘó[ĺ©<šŇ•©nwF¦hoÚK¦šTNTg?\ÖÔ‹G´[ĤP Vužş–v‰mn9ÇEŚdšŃk{ż˛¤Ćß÷˛ …ęyö¨«vÍcdŚÉôńqwçÝJŢXF‘·Jž[ءŚ*ś©Ýśń#Âfó€Űĺúú~fŰD†ádŽâm·B"ŢRžžßZ}Âć\úž[q䎞Ő]n.ďä1[¤˛Ičąâµ4Ż ˝ÔîoĚ‘ŔŁ·«©ł¶łđüR˝„; Ś33HëTç˘ć{śĹż…ŻŢ{ą„ÝźĎŇÚu•”2M;‹™€ůŹ”qZwúĽÓĆčOČzŹZ秕Ąb3ÇĄRR{’fέŔP`1W´­*ăTľK0¦Rą%şQ¬io+ŚŻ§˝uţÓNţgýü«ŔôëŐTáp§MÎVFî“á{}´¦S5Ôí9č29ăÓ5OMÓăÄ‹o0߼Cĺn§o­[ĽÔĽf9~Ůë“ŠÓŇ·ZéâyQVćRd”ęxĘĽĺ^Jň™Ó*I+Grާ~\qc#=;{W/­ů­ëvĂ—U$HôĎĐŐëÍA¦—:`zÔQH ›ł’9=˙Ď˙Ş°sn\ĆѧË‘ŠĘ(BěŔµaNĘgyşp@>śźoóúÔ÷7oĺ€9Ŕ¬«›Ś®ÜdšI6ĘŠ2őKéJ¤PçĚůkĎá]…¤C˘ŮĘÎIĺĺ¨'č+Ž2}ŁÄvp“ň#®}€95ŮĎ3y„xČÇůú×U_ÝĹ(ő2·<źÉç>YfcÁČźJ•Ś“?ÍŽŕţ})o´p˝eĎpÍs´\I#`ý(ĄIîÂsKDI‘w. ěHA¶ů8­…ÔĄÚ>˙JČČ:ąµ_ř÷¶\źBqźçXňkFÚ˙.N>•·+fWG¨©@§8®Hx’˙żďš”xšü mńZő6xĘHę9ď×˝VÔâ2i7\Ë#ŹĘ°Šµ đuţé˙mÇŠ/ć´š'†8üir1¦Žüçgz˝¦6mĘűf˛o$b#ö«ş\‡kÓ¤Ö‡Lw&­asą9­üo¨Čó˛=HÎ]»É!{ăšZ)Î졩V°ĺczăÇWůÂĚÎz t¬™µ}fńŽéآ CŚAAîŐ§omo §"BÝ=+D»"’)Yxv˙T”˛Ěí×?:î4O‡ÖđÇ·ßţy©üą§ÚxŔŰB‘C´aFU8ţu~/5ŔůŚ~ŽqţqPá2}¬M»;+-62–°„ĎšĚ{.k-uw—Oţ˝ ©Ě9ĚíÇ˙^ŁŮ°öŃ.۸ž3řŇÜwďXŇkwňŘ)Öź¤kŤŞßKo˛3ĺ®IQCŤ•ÁI=Ťl‘·Sç[Ó*´dcŽsţ*çî"hb•KnůO&HŁŃĽ óhVýS]IQŠç<48ř㮍‰8ë\í»–ÄÚ}¨éÚŤÇő<Óę=i\›gŠnqÚ‘śĘ‚{EÂĂ÷{PŁ'Đý(&©\Džaő 1ÍAćs‚1“Fě~4Á’łd{â€@čO¶*#qźÖ—Ż+ÜzóMr|ŇŠ‹w'švţi«‰˛ZBę3LÝÎ .áśw«ĚÝvć[{0"%wťĄ‡jó­JŢ C—˝`OQ·˝z•ÝĽWPśdΰ®<%kr§'ç>żýj—ą¬^‡śf@‘¤©8lúÔܱÂ8lř¨Ďұµ-IďŁDAĺ½˝~µ-¤†˘ĺĐŮąÖŢę=°ł8Ď÷Şî‰ywŁË%ÄK¸¸ĆÖk”łżK@0»Ť^>!lňśW^vô;é{8«ń…ú˝”}s×®wÄ×Í«Ä.Ś"6N•ý¸Ääç­I¦.Ő —?8Ŕ&•5>mP§Ém °ŕ®*F˙WÓšŠŘ€Jž˘¬lÎsÇzčfDš+Ö­Xđ7[¶„ť6ç?é„ëĹs–gÉÔm΋µtVĽÓfçrI>Ľ L‰ě[Śv€ ÉĹPÓîDÚŤŘ…ô5q˛Ńą^ĂŇłt«c ŐŰĎALÉlhÜJ±DçĐbąůä2śg‡`µ{W»e”*.#ĆMd,án˘ß’±ź0ăóˇlizöp¶:Liś7jĽuXrr@ăÖĽ•üi9P‰*?řL&ţ8A¬ůÜRR=hë0÷—ŹzŠ]RÉV9é^S˙ [Ě_­HĂüi¨¤/±čCPF'÷Łíč śW˙ «cq—ň köą1ô§Ę»“ďö;“©)î:rsŇźöĺ'n{ó\T^!´˙ž¤cÚřŠĘ6?ľcźAÖ«’=Ĺďv;Ÿ ?Ď\ç8ďŚ×|_hĘ}öŇZHŠsžąüiYĄŘô%›'šx%ĎqŔçéă«ë ăŹAŹçVăńö™Ŕ˙IQîŁüh˛+ěw1ťßxäý)ăŚgń®B?i.?Ö·ÓmJO?zŁÓ®Ö 9mnăf#Ś®:“L1éąű“ţB§™­‰älÓÇhČçëNÍŚŕ=+–/ľě‘ŹÂă C˛Ç]çťěäu‚ߌĽÔ:„Ékc&üĺ†rMrgĹZ‰<´xôĹ2}ZçR„yäaO PŘŐ7r˛ć[čŔÉŕVíŘ+ &vÖ6š7^†«jńK·ýŽk)nt­ŽęŘ´ÚEł((+2ďr‚%˝»W˙ ŽĄBÚ!—ŔůiŤă AţúÄGűµhć•6oLű˝8PÂÇ Á¬źřK/p@Š}VŹřKő8KoĆ:«ŤS‘®,ćŔ%Hő≥·ÓŔó2ž‘ÍeŻ‹u d D#•źŽ)ĄěâÚ}ÍQŞôůŽ}iÉ©€A-Y杀yöŁŮDjĽÍłŞ!ś~&”jŽŹČ™5 foş¤úâ˛ůiy´Ő;u­~†çŰßČ—o-y žDn‰lç‘řVP-žôŕÇ{0UźCOí€đZŹ´ž Ö^=i~qĆę=š·}M?ŚRů䞼ÖIw­ląëĎÖŹd…íÍo8ç­cëĹeůďפó›4ýšli—ç“Ĺ3ÍŢýj™úS|×ţńŁŮ‹ŰŁ0(ĹMň×5%˛Á,Áer ÷Ĺtś…lŐb> Ć1Í>împb ät"ŁrBí@z{®¤ĎaŇ­ßf)É< ‹Ă±ŕLŕsŚŚŇÎáęMDŮĄ5s Ú6OËřŇ}Ť»˙:Ń`6úÔŕóP¤ĘqHŞ-¨§ 5čZ¤=:Ňg'š«˛l D`ŔśÁ©„’<“Hqśž¸¤ă®zR`!8¤Ą=)í@=)¤ô©aqŠaç  ś CÓé ă Ä4HŔđqZ?ÚÍ®üt5šHĎJ’)O™T°öŞJâfěÚ«ip¬V ż‚¨·QW-ą;€ĎîĄ5G9"”Ť˘0çŠpçŇŚńLÎ^* q´÷9¤ÍĐ}@Ş$BOzôĄíšLäP 1ĎĄ8 1@ J •c qš.p¸ďNâ›Ţ”z;śf’—µ*J Râ“˝)†QŠ/ćđE;© ÇĄŁÔÜ)F1ŇśGŇ“ŹĄH :ôĄ&€pi  tČ óFx¤É"‚D*1QíĹ8šiÔĘLŃ`'FmŔ© Ž„zÖüíý©¦­Ę¶.Pm”c¨®ośÔŃ\<`áČüé ×7ôËpşFŁs(ĆČ°‡Ü‘ÇĺX™=8Ą“Qą’ÓěŢoîIÉP:š¬˛ĐĐŃ6r1NÔyçśPXŽEM‡rbĽűŇg¨˛iI4Xd™ă×ÖűS4ţŁé@„ć“&ŚŇĐöĄ m(>ô v}ésďMĎ–‚…÷§•îisďA"çšqă­3Šő ˇÔŕsLńNĎŻ5 -)ĐhÎhÔqI¸ăŻjLŕsŚP±GăÍ&ńA>ťčĂSN"…ÝŽi őé@8¦–ě)„śó@Ćx§a\xę)èłŽ¦ťž2i^¦‚{f˝!=¨N=Mę ‹>ô â®I‘š3PÁëNó?:V Ž'ŚkźéLÝMÝE„ÇŚfŠfxă˝â­ăŚuĹGřQźz3ţsLcObŁűÜv©3Ň“Ž´k€=:Ö–Ť›.˙JĚłqŢş=5E˝®RsD´D–µsű‹uř«K÷ĎűUĄ.v÷@Íc®|˛}Nk'©qcÉS cĄ5ŽZŚ°ˇ"›źĘ“?JhďHxĹP®8ň? Lôć“8¤ÉĹ4K9 )™Ą ˘OjLúŐěŃšfiTĐöŁ9¦ž”Pçš\⛚;'­¤˘€$ą¨ésÚ‹ýÜR“éQćťR÷§‘Qf”PÁńž´źZŹqäŇ‚zE†HHÇ|ŇdfŁĎ<óIžh°\›w8Ą§*0yĄÉ6\攞*-Ôgž´X.;Š3Ú“q4›¨°ɧg)Śr)Ą°iŚ—qĹŞ r8 šV.xĄÝU÷qNČÍU…rlđGj3ž3P†Ĺ85M‡r\€(v5îqG™E‚äůďšM¡Ţ)7U`ą1lŚô¦3Á¦yÓws‘E€™ŹĎ™ŔĆj-ĂđúRäE€~i ´Í›ş‹ äą&ŤŘčj-Ř4ĎjvĹ,Oz ¦çš ɧ`¸ěńÖ“4ÚNh&}čÝéMĎ4@ žh¤˘®\]>fŔć™sföWęk^ßĺŘOÖ˛/.MĹÔŚOµcŰ4’Iˇ?Ľ·¸‹pGnk@Č5¸ »©éW"'—t@ě Ba mŹZtČCF¦i:qëY;šE+cȤ6Ä÷§“ŽhÉę8˘ěvC~ČÝQö&nŚ*Q&:Ňďô˘ěvEo±>>đ¤űâ­äP“š9ąQWěRôP,ĄääU˛Ô§ĚĂ•Í‹±Îá“Iýź.zZŕdšBÝűŃí$±(˙fÍŘŠpÓ'Ďoή†8ëJ­ó´ąä>H”?ł'ÜRŚbš3šwSŰ1WŠEäu¤š=ŹZSÚśδĽĐy§¨îi= ?“ÔĐ“¸})2}(#ľh#ž´ 1»úŇŽ´Ńňś pó€;Đ1g¸C×ç< ÍaňľO4łĘexč)ůN=+X«#;˛)9éÚŹz˛S©ťéx QšLź­'z š3FxĹĄ{ŃźZh§f‚CÚŹJ=iŘâ‚„Ł4śvŁµ(#84dR{ĐM.i2h&›ľ€š Íôťh$q'đ¦ŇűJżkĄÍ1 ęRŐ"Dí÷FjŐµ™ňüĆŘцÍć}ĐOzžfݢ7h«ČÇűž¤ —ěШńÔÖě:RŰw<šŻą†č[Ü(bOĘŔvôýkoc'ąÎńÖĆ9 Κg–OHšşK´µ·¸Š<‚Y°:—ű6Úd; ČîqŽžŐkű™}cČćbŹ#&"F}{Ó 0al}kN{!¸LE´¸ÁsÖ®6™±ń>2qG±‘^Ý^uŁdËOňÎbďZobĘsŽ:óţ{Őy­a Lă`Xv¨t™J˛*5´Ş2VŞÝ˲- `źĺWÖ)¬d©ß?ZÓŐŕ¶Ő´hć† .˘_›Ťbß,¬ÍÓ掇;óSvźĄB¸ÍYF~•Đű™ĄĐ§KÓĄ4t§g@0ŃKÖ‚($/sIŢŽů 3ß·Ą-QIŢŽôę ˘ŚĐP”ąŁSB¶:PHî٦SńMŔ ˘ž“€3[vžľš$ Á8Ç|ý(Ě-§*Hm§śâf'ĐV˝Ävríc"‘Ů…mčw‚ă6ňâ;žÄ ¤Ű)+”ôß­˛‰ďq»´b®]J6ăhtéҬ\+-ÁGçĎ^źăTg%†2IβÔŮ+$—<ž{Ö†ĺo#$Îł¤[$w©í›lŕŽ*€ô›t±Ö¤r{šŁ§J&€@cš´pŁŹOZȆ‰„Íą6·ć¨j~Óµuýę훨’.˙°IÚ§n•ÇçÚ©HŽ[ś©ŕ}BȻ۹‹Ôp*ć綞ŢB“ÄŃ°ěĂěBC·žŁľϵ6Xŕ•U¸ćçüö«U•ŁĆŹÜúW§^x{NąůI«o[1>T¬>µ\čVgÍ8}+¨o *·3¶>”ŤáTÇ$}iÝŽ\â‚+¤˙„dw»đ¨˙áUű×Cđs ł9ŢÔw®ű™Î~•^]2?+.‚ĚÇ4™É­?±EüY¨ÚŮŹ&‹ ±NVŚJ: fÎŕS⊔L"€FihëL4P1FµjŚ•ČÜö»ő¦ç&ąÍÇg⣠ç*zš†âC»Şd† ܵ˘\¬tăěץ¦UxÜ2?úÔ–1­ţ· R6›sVYĽç#¦°ťˇÔ–]Ř$u¬ÜÔ“hę%fšř•@!_z/áRÇ<ń2Ű˶F2 2Ś˝ĎÓśRŘĹö»[qäqéMśKc"Ý"7ĘąÇČ:uş0đJ791ĽÚeÉ$TË#?Z¬Ó–…Ůc+`nţURk{™2Ě$útüńúţRGĹJµ±ç’Nsźĺ]:śüŞ×1ŻŻĚ··ŞŤĹ¶ŽzVĆ“#™JýÚŘ#Ź­UłŇ’?0]DËćg‘[qĹ\Bíúóýj#{˛ç$—* y $ńĐt˙?äS‰8|Žř w˙?Ö—ŹĎ·qM'„'¦OJŃłť!Ž3ל¤çÖ«K °Ă("§ü˝N}ĎáW4Ë:`Ě8Ď­bŮĽV†dk2ÜźfXÇ—»éU4·6ú¸ŤřőŻB¸·AdĘGŢűל_ćÚř2Ś“­rU\Čé˘ő0/퍞Ą4ŔG Sb ©Ҷüg‹]/IQ^°Ôp~•QwŠföŐ•qIJÜfx­›AĹť©TgŠb ozS×zPÚ–—ń¤ “ĄčĎ´ŕ 8ˇ+[Š†cę3M¶Dű˙ůhÓmĎ ĹiާچEĺČÎsAE$Šő˛"Źe@*xäÔD{pĚ1ÎTéL‹ÄwöęVÝ•8ĆvZžÓÄ· .n7»@4 Ĺ« "˙P %¬ gćŚÖ´ćđ%ɲ’!Ve˙–JÜš·ˇë´Ë°~Ř­ůőÇ[¸ŕD ‘Ź©Ć=ę['S;ÂÚ•m‡P˛‹íŮ8ó€`G¶x®© X0Š0çśíÁ5™}KuU9Ŕ=ý©–—ď4l“ʇćÇqô¦®Dµ2őKC¨JWĺaćHŰÓŹĎĘ\Úě0ŮÝH꧍wä«HNÜúüąÍs!‰çş~›ŕv#üi°¦ő°M;ßé±Ě[lÖäÇ3÷‡Pß^OĺY’úF8ÇĄ>ÎsÄJă1Ę<ąčjţYq€«6Ž¸˛´Ł,i±’#öăéP‚q@ΧHź<ěmłł“×­rZ\řťGç]8o3žÂłhL0ă·Ą)'’ŞâPŁç5Ű"RpÄVXivď!ąúÔm3Çnj¬—I'Lätކĺ@'wlńŢť†h4ěAů uÍ@ÎÆȬö˝ ŽN_×ü˙…0ęK´¸őçĄabóJX•0şžűN+"]@âçŇŞ6 ÄŚ~§4ěĹcj[µpă#'ç˙ŻUš\ť§đ˙?çéÎhĽ-ŚđEFnuz«<÷ĎŇŞI)a’qL’ŕwć iTŽ5HÍŠĚNqźÎŁbsĎó¦™*3!=ę¬"CÓŻ5j=Ů ·4ěHăL'ąíMő4QÚŹéE08Í.}čŁńýhH“÷E7ŚŇgšç7!hK6iżf©«§Šwb˛3¦ŚFp9©Šćç^ÇÚ–ńI9–3¤lb”~éř>Ő} öf扪íDäx®–IT(`Ŕń‘Íp÷6/n~ŃÝZ·cŻ=¸Ę»”őĄU9ň™Ő¤§ŻSfóV¸‚OÜ[¬¸·'§˙Z¨Á®jŻi''ŹOóřŐŘu2lłÎ;ô˙?ăZIłŹÜ¬xÇ5şwŮśÎ.:8”ţÝ1Ź%IÎ1»ˇ˙<ţ46Ą:ýëqďó˙źjŃ0EÁ ż•(‡RńÇJ¶źs;®ĆQŐ®1˙G×ďi‡W¸5“ źV´¨˝%é銎H€<ŹĂü˙žj©i®Ć öĄ<đ”ůÉ äăÓôý+gÁ púśČ­#Z¨˙–śö«6:L7SI•ŕFÍšąáĚ:ĄÎÉäĆk#^ek-ć.O`kÍőĽyĹĆd®ăYÔŤQŁD_ĎGÁéžőÄjń, “/×˝cSD]vWń“—»±'kGČ~•±ăC­ěN‘ÄéYCýSńÚ¦—ŔŽ©|LĎ=i§éN'ÓŠoZ݉šJ1E2Eę3ŢŚRŇgšZLŇQ@ zŇcŠ·g§]^śC#ÖşO1 ×7sü*3I´‡cž˛Šió HHÎx®™4K›čc[†Ú«Đ ÜłÓ-´řöC}ńR}Ąb íëëRęvŚcŕř„Dî$ýk*űĂŹod$ăµwÜ™06đGZĆ&R¬3źj<ĆšĘá|¬¦şí6úZÖ8§r“[·šTdzŠv­áä–d8=zW/ĺËc:†ůJ·Ë'§±ö5[Śő(Y~Ę.ĎúźzÁÔ.˙±¦IÎ0ĎrT˙QYÚ^¸6˝•ÖQ\ťÝ=ëvçMľšŹ(ýé_ť{{5bô%Ě1\DĂË‘A^>•ZýQa‘°¤‘‚qďU`–m/FŠ!ń+’q…ěĄUą˝v‘ś°ňž p:Ň’ÔĆ ™Ń9?Ľ$sŽý $šCžw˙źÂ‹6ÝůÝ@8üč‘·6Gp ˙?ü)3˘$ 8öŞü÷;t$ć ©4d¶’ĺ29´ş‹Şc9'Úł-˘‰"k‰Ř,qŚźz„x†b±[:­Nä¶hË©ÎIăéUeżlîÉȬÉuç$kćj?í¤'-hŃ©Ř._ţŇaĆ=?N•—ůő* Ő-ČćÔŹř˙Z™öčźÜ°Ş°®[kýËŚTi'€W7±cĺSQĎH†~´ě+—Yźš‹Ín¸ŞÍpäp¨w1±§b[/™X “úÔfcŽµPB´X.Y2îď“L-žőCŇ–ť-HNzŇQA!EPKB‘ߎ)(>´QÚ€8 î}飭‰ü©¤Ĺ4âś+ŠiŕW9¸ŇZQśRícÓµ'sŠISrŐ"1žGĄ‘ŚzÓă+ Ĺ2 {ç„lš3ÔTÇě×gäm®}j-[ĆEV*Tđ:UY=ŚÝŃpŮÜĂĘĂÚĄ‹P¸‡±ŞIs4G†8üęSz|ńEîkCâIW ĹŞě^%\|ĂëšçCZÉÔ•ü)†+|üłŚ{NﻓÝ#°MvĆ3Ĺ^·™.ů@pa\,PNÜŔᾆş? ë'NŐ>Ë~€Ă?ĘŔóŹz—9­S¸˝”KÖ“‘Źś†ŚŚÔZ,:”„˝l_zźN•VÖt_¸„…úVm†§ ńH´Vů„qďÉĹi¤®s8¸¶‹ÝĄÄţ[ġ‡›n€×)Şćbb2ůĹz$ŠLez×®ĆÂywpľh8ük:«Bđď]NÄNf×®XžCcôŞńŹÝ¸µ\ń «[k,X˛Ëô5MF#sĐb”]ŕŽĆ˝ćg7ZJRrئšŘŔ:RŇc4”ą¤˘Š`=T»Q’k Ňt4•‹Lw‘Řt¬űDQ‰\rÜ ě´xvĂóz†ËHŇ‚Ţ+hDHŞ01Ĺ8ä¨âĄęOÓ6ŕrqPW Đ¬x#?Ťc±oµÉ§c[|»=:×>gk•±¸“ňŚő©Ť8śŞ†ÜŐ‘?9ÁÎzw¬ČĄiů$„ţ÷ô~X˘Ęsر˘ábŕÉűĂÖ˛5=.ă%>•¤Bő'Ôš‘$eh\§qe=ş…9dVČ rµ=Ź®ě›h”°‰®ÂćÂ)ó•ő®b˙ĂĘId#9éZ)&KŤ‹gĹh RŰHĘŔ‚ţu™7ťw*DfŽ4ÇË9oóÇ­bĎm4lÉĎAÍlXéó^Jn%]Ĺ"Ü@î ŕ˙*˘v4ě-<řDPnČíß9áŇŞČ… ϡăÓµhśYęy[É‘YOQÔ~5Vŕn“'<žxĹK5‹*ő¤Ůž1Ö¬ł€NqţĎó© ‡Ě”Ž9ëRY­\8ah:YöÜĘ9ĆYŐżä'pÚĹQF(Ů«KhcÔłpŔ±ŔďQyGnjÁŚI‡Q‘Ţ`dt•ÂĹ3ÔŚRgŠ–HđMBx5D‹Ú…RNi3OSžÔ0%M0ŻqJbšNx¤†ÄĄ=)1@ţÄ-RšN{Pđ(8Ł©¤ď@4RŽ””z{QßQGĄ´żJJQÖ€ 8ôĄďNć!qŠNśÍFeP:Ô-qŚâ°ł6ąc$ô4±ź~őTK+*“řS¶Îz!?…;dď* äÓEŇPg9¶~Â×0PĎżvˇµbă$aR4 t5fćŃ­ăGÜ1Ć=*©5ŞwF2V`ćšTŇťš:Ó ´g*H÷¨“›†µoůhÖaˇ¦¦éˇíšÎ¦×îzV‚´űˇ˝EféškŹ<çýXC'OQĹnxqXĹ2í ő÷«p۵9fPŘh”iĐř k;M˘ĚŮÚ@Çą®GÄpůŚäsÇ?ZëäĆF+žÖ˘ Śđzb®˘ĐĆ—ÄŽ_ÄĐ™ô˝:ü śyN}1Ň°ŔýÉďĹu3¨—áóďSćG?ąhÉ1Óĺüë––ÖěĎMîet&žsJÝOÖš+­Ě7{QšZmťî•w4Úµa›w 94¦HĹţ í¬#ňíĐ0Á®6~ľ™Ż@ŤFÔŔč+&h…Éă'’irŔüi’±1ŽsÍ?LL ·ňů:|¬N0¦ą{Ś°ËEuZĽM6—rŠ2q‘\M“ćăžÜ ö4%ˇWÔé-ś`ďůFô>źZľłÇÝAĐ‚˛!1űŞx㯽[I ŹśmŹµ"‹ńĘ ä|DZ5:łĎńTáŢ[ĺR:rE\Ś.ě—ÉéÖĄn&Ęňj w|Ŕ|ř©PzÓř`GSKa3„ÔăjQĽŁ‰#Ű˝hŨ[Ç +dűd·f*qţ¶&9?áRx‚Ü'©ë\Ô3Ë Ř°SGjéNčĹŁpŤ·.ŔaHÂŹAÍHcÉQÜ`O_N{žjv.»ćROqžßçú}jĚ—*x'zž9ţçŽŐ›5ŠĐfŇĺÉ#§–ĎéV­‚0sŠŤÝŰ$ŚÇ˙ăţy«QFą% ŕäÎ+YRşśăý¬Öq­=z@u™ŠúóY™ďZŁKĚ˝ =ś1Îy5]xćśh0<óQ¸*ÜŚSrzf‚Äő4€0(cš3š:S$4c˝­)éA@E/ni=)G^h$0qAÍ:PO4”QAäĐEŠZJ Í Đ8¸¤ ŁŹJ÷ť0'†Úi±ëV-Ł†ć§‰‹®GíU”–Y äĹav΄ŁdH˛°RŚÔ°,Ş Ý{gĄBĘd¤$óÁ§IŤ©+8ÚżÂ9l\>-I<ÖVÇ\SCq)‰ŃOE7tM"±-ó¤Uµ…6î\ŚŽk7dmËĐ«ö?˛ÍąIhă´ô«ß±^FčŰŚź¨­Ł•Ś‰*~ď<1ő¬©ešÚŕŁv=é|z Ą~…Íb˛3)>Y9Ď˝cjÝƢóŰ6sžőP3 €qšŢšiYśµZo@ĎŤ(꤫vPä™ăµ7˘ąšWv žŠĐŃűe°ëűÎj•ďúŃV4¦ň§…˙» ÍDő]OdĐTgĽŤć­¸Ă{VMŁ\Úiďwö cŕyL8É?…l ŽµT?†Ž:˙(ęRĎ Łr˘CŔ,ő®~YÍÜI›9$î cŇÜ®ř¶îÁő«•Ľ…,VvV$ňI'–cWSálTµ’E †1ř×oú×0Ł‚?Ů®—Ä2tkK@@Žá\Üc &yůN+†Ľoćz˛Vv12r@W“Űúf˛{š-„ą”­đÚq…Íh‘Y7­–‡¦vŚ~5Ą‚XA Î9¨ľŁ¶„“Éŕ×%â'ě2ý¦Ýu!ů‡÷MuąÁëRWŚŁ.Aőd=ÄY8\– sŹ_JÖŚ…9áĺ#…łŻ¬N™|ę§9Č>•$oű°TŚő9ĺŞZ-3T3t¸OANŠâ Çbgß­eů¸( ÇSÖź¸2ç­IF×ÚÔ3Ś~µú‚C%łÁéĹbK+‘ňśńÍEś×‡¸CÖ‹uy-ěÇű™ĹY˛Ó“`i°^{Uřl!±·y§!w'­rzî®o® p1ËŔëV®ö3vgCsŻiVl"DóăÖ˘‡]Ńî¤ÄŃ4#×Ć€IäöŁ«ĺ"ç Ť.Ćí|Ű+¨Ď¨Ą:ĺbŃ´ůfžŕŰň¨<µyîHi9#Ż4rŽú <Í<ňJÝXäÔb—ŚbťŢ¬‘ĘC€N;S8§wëACsGZwlŃA# 3A u  QIŢ”ĐI@Í/zJ8ďHG>”˘€Žôc4”ľ””´”qŽ((˘—ŠJ:ŃKLŽ=©)Ű}čô®ŕ‡tČ˙…ĐC/š¬ ă=ŞÎč˘,…˛XÄ<ÂNZ=Ä1Ĺb·:%{jÂ-ŕ™FIëޤ(×c …p3ą»Ôp®©} Ž=ęŘ…ç—s8eŹĄAGRš4¤´ddç#ŠÚ±‰–iy+Đfˇ$@Î;ÖĄť»\´6đçĚť‚©ő¬jLëŁMEݲ¤WÓ}§ěaómĚv>µťŻ(ű\O×r ÖŢŁ§&•¨Ý*>âkëßĎę҆–5ĎÝQE?‰4*żĂÔÎŁ>ĽŃÚŽŢőÖp Şe(&·a…`…ö¨t»0"űC “ÂÔňĽ®zú×=IßCjjÚ™úLÇéúÓ4ö‘^~˘ĄąŐD†MępEZWŤžŽç©iÓié¶Âs¶u2Żb5ÖJNFGjóĎĚEćŘ_ĺ‘7(ţë d~YŻD—;CŚŽ”čiîś•˙©4ź)Ď ä/›íš”vęq˝u™XłŔ?•p~{Eewt[2»`Tb^–F(&Ü™KWżţĐÔ$•Nc\,`öL}ŇqÔhč)ŮÄEłÎ f˘’I×»1%Čb)“K/ß4Á]}P#ž´ęn( Í^±“ĺ’,đFjŤK”™Oŕh(˛§düz×]¦Ëć(É$fą Ća[UéÚń?(G Ô44Í{Ňě"¸„1Ź.E«¶3ćŔsúÔ˶¶©Ä›¶Ęs÷©u[ÂĎL:V Ůk"ĘC!ę=*AÎMSµa·ĺlŚóW‡CÖ™-'_ôD—’RAÍcEqúíąë[^*!,x<’+¶ç“Ć8ĹRŘť‹˙Ľ—ŹŢ7Ö§‚&Ü°=yć‹M’q»\š‹Z¸6±,ÉťĚcÇÔZásBćçO˛Qç*±Ç;NMeOâ'_řň€˘ôÉäÖf<° }sÍ!b‚TÓQ%˛KËŰ»–&ââYč ©㊔ťÜi5ŞĐ–'|ÓzŠwnh#ž)ozZBpE;µ%'~´wŁ·4¦Nă’€p9Ą¤Ą ŕ÷¤ŕwâRĐŽ´´ÁĹ8úó@Ď1IA=é1Ú€ôŁ˝qÍÖ€v¤ â€(ü(§SH=h¤Ąü);†>”…/˝—đý)(˙=)Ż-Ś<9vtć™5´˛IL\tďN·”Üçpă ő5qcýČLăs\·hôT¶E )v'zg  şĆ¨Ŕ ?\zô¤¸ů2#089㊱i0üÜŚwŰĐÎ1÷¬őµYaŹĘĽ‚OJże«ÍĄŢ ĘĘB–ĎËî? ĄçâT ŔÁ#µ\ľ»űMŮşd•PŠ±ô{Ö{ť<˝Ż%1ÁžMssHe”±­ FçjÉo˝í޲}ëZQŇěĺÄÔ»˛x©m 77 ţ.ţ•Sý+sO¶‘‡~]˙JŇR˛9ŕ®Ë…D0Ş'EŔVLłn<š|ĎÉ9=y¦ ÜŔ s-u:|eMŔňÍ™jŐ9ä“TîĐ«r0kZlʢ%ĐoełÔbd' Űş×·\J˛CŽ ¨?ťxů3ĆxŻg†ü`éó㓏ƵJÓG%exŚŐ—Nśă˙*ŕďWn Ű“]žą8‹K•IGXů®/Vh˘† E;¶I« OńFř%ű¶Ě°)ÄúR`¤šQ »?áŠĐaÉ̇ëIJNN}é+¤ćsIKÚ–‚FŇ‚ëÍ!ŁúPQjD§cţžŚöňôHdŠ»ÄRüł §i˝e|ŢCBĘ oÉö5lG‘ĺÄ‚L|¬§X1—‡yŐˇţcPËÎy¬¤Ť™ą§´Ł†g ­S.Tç#žkĘŕ4[Aɧ’yb8qY´_23üU+"^ŰłúW91m¨…Éč+®¸ÓçŐ_'ćˇRhĘ_p’^ť0ůĹiŚ·+XŰjň„0ŰçUĽEĚŃۉ7 ĆÜç¶5 VâĂĂ^t?ëgmľf~č®sO˝qűć%ĺĎ%ŽMRŃ\Ťng-Ł«ŔĄ\—Iś@g‰„Ę:ăµj5ÜcÄ˙xT÷"Â`ČÂ@zŚpjnË9ăĆsM­‹›<Ź5±3gËô¬ą#11V0ěkTî"3FNr(=(îi’ćŇŽÔśĐb–”ÓG\PZZSMÁ t ('˝­ťŘPojJP9ĄĆhç± ç¦9 ś ^hűĆ€vĄŁë@(é@Ju&hč4”âyÍ5Wqâ’”PŚ;b’—Żn((ü?JSÖ›Ďů4Ń,k…` ;T€€:ô¨UvĆ;ńR ś‘ëţĄqžĽlUĽ·s&őŐXľµ*‡’~P„vöţUd<űsŰü˙žµŇ(R•AşQ},OłIó˛:ů\×]^-Ľ~˛;T‚D€îőcY,ĆF,NkHSosžĄn[¤:IL’c’M74”ŞĄ(ęOѱÇrŐŤ±¸› Ú9bkq›&™Kmh" óĽ}i=zW-GvtSŤ×mÇßľi‘őśF~´¨¸8çŽÔ‹Üź3#<Ő[˝Ädžžµi‰-ÇZ‚ĺN¦ž¤Ďc8FĚĸÍzN‘<·Ţ´xĽ–Ě2ąëţs^q1NŚÖş Zm&W6"ą‘ĹjŰVg3Ťô7/Ąy[Éfům·JyĎN€×*Ň™&,Ü“×5Đ›äk·sȤ1ő®pő®u.i6ÎĄH$<ŽzŐ-N|"Â>¦®©V=Ü›î¤>‡­5vMGdAEWAĚ(éKMéE.x¤Ą“ŠwAŠe`úS¨ń\´ Z3IžÔ§ĄÝăű´´gÜÓtÜÂDŁéUÖů#$–ĎҲąÎő‡˛GKÄIšŇjŞÔ>ćłç¸yÎć'1P‘ŢŹjŃSH‰V”·‚)pcšŁ+KK¶//śĂäN™îj‚/› QÔšč#Aon‘(č9¨¨ě‹¦®Ç± u¨ÎsÖ—śŇU˛ĽăÖąŽ› Śăšr®IŇ“i2~4«ÇĚrA ´/sÖ nÉ©‹sŹţµ5 óĹ™lfşŐí 2î_ÖžńéŇš ôéZ7ˇŹ.Ąée‹ÉHaM‘ŽH=IŞŘÉëš@ÄŚRŚî¨±¦á+yp»gµaą‰=I­=JlF;ÖgŃMY\Ć«ÖÁEUQEŠ?Z<ćS¨Ą¦ôúŇć€ĎŠ:qÖóE”§ }©(  Q_2ń(Ü*ĚW(˛ mŘŁŁ=k2ŠVβß]žáŁ·”a äÖgeYŻ†Óś Î=k5.epĂÚŁggbĚrOZIY…Ă~ÎiőB ŕc­%'SKH”QŚŠ>´Ŕ3šJ1ĆsG| (ŁđŁŚPsNÚJX〽7ÚťšJCFMS˛(4QޜŠëEfëš;ŃIźzR8ÎhŠqÇqM4”QÚŽĽŠ (ę)( ďE%ĽzŃřŇu¤Çµ0¨¤j(¤G\Rgš( ďH(˘€4´¨g#îôĎ­iő;ŤW4߼tSřHů'§=)뜏z(¨fČcôśzQEş‘Ó#˘Šd>†›ÚŠ(Bbr~”őŕŚŃE0FMëîąltUj(®•±Í-ŢŠ)’fŚQE¨˘ŠZ1EQÖŠ(Ŕső¦ž˝sES¨˘€RQE&8ŁúŃEqAéEŽ3Nă˝P:`P:ýh˘€śR@˘Š <Ńš( ‘˝hő˘Š¨˘€ÚťÎ(˘€ 0OQ@ Ž”QE-%PÚ—袀µQ@Ąh˘€y¤Á˙"Š(˙Ůlme4/vignettes/lmer.Rnw0000644000176200001440000041472315225517403014571 0ustar liggesusers%\VignetteEngine{knitr::knitr} %\VignetteDepends{ggplot2} %\VignetteDepends{gamm4} %\VignetteIndexEntry{Fitting Linear Mixed-Effects Models using lme4} \documentclass[nojss]{jss} \usepackage[T1]{fontenc}% for correct hyphenation and T1 encoding \usepackage[utf8]{inputenc}% \usepackage{lmodern}% latin modern font \usepackage[american]{babel} %% for texi2dvi ~ bug \usepackage{bm,amsmath,thumbpdf,amsfonts}%,minted} \usepackage{blkarray} \usepackage{array} %% huxtable-ish stuff %% \usepackage{adjustbox} %% \usepackage{threeparttable} %% \newcolumntype{P}[1]{>{\raggedright\arraybackslash}p{#1}} \newcommand{\matindex}[1]{\mbox{\scriptsize#1}}% Matrix index \newcommand{\github}{Github} \DeclareMathOperator{\tr}{tr} \DeclareMathOperator{\VEC}{vec} \newcommand{\bmb}[1]{{\color{red} \emph{#1}}} \newcommand{\scw}[1]{{\color{blue} \emph{#1}}} \newcommand{\dmb}[1]{{\color{magenta} \emph{#1}}} \shortcites{bolker_strategies_2013,sleepstudy,gelman2013bayesian} \author{Douglas Bates\\University of Wisconsin-Madison\And Martin M\"achler\\ETH Zurich\And Benjamin M. Bolker\\McMaster University\And Steven C. Walker\\McMaster University } \Plainauthor{Douglas Bates, Martin M\"achler, Ben Bolker, Steve Walker} \title{Fitting Linear Mixed-Effects Models Using \pkg{lme4}} \Plaintitle{Fitting Linear Mixed-Effects Models using lme4} \Shorttitle{Linear Mixed Models with lme4} \Abstract{% Maximum likelihood or restricted maximum likelihood (REML) estimates of the parameters in linear mixed-effects models can be determined using the \code{lmer} function in the \pkg{lme4} package for \proglang{R}. As for most model-fitting functions in \proglang{R}, the model is described in an \code{lmer} call by a formula, in this case including both fixed- and random-effects terms. The formula and data together determine a numerical representation of the model from which the profiled deviance or the profiled REML criterion can be evaluated as a function of some of the model parameters. The appropriate criterion is optimized, using one of the constrained optimization functions in \proglang{R}, to provide the parameter estimates. We describe the structure of the model, the steps in evaluating the profiled deviance or REML criterion, and the structure of classes or types that represents such a model. Sufficient detail is included to allow specialization of these structures by users who wish to write functions to fit specialized linear mixed models, such as models incorporating pedigrees or smoothing splines, that are not easily expressible in the formula language used by \code{lmer}.} \Keywords{% sparse matrix methods, linear mixed models, penalized least squares, Cholesky decomposition} \Address{ Douglas Bates\\ Department of Statistics, University of Wisconsin\\ 1300 University Ave.\\ Madison, WI 53706, U.S.A.\\ E-mail: \email{bates@stat.wisc.edu}\\ \par\bigskip Martin M\"achler\\ Seminar f\"ur Statistik, HG G~16\\ ETH Zurich\\ 8092 Zurich, Switzerland\\ E-mail: \email{maechler@stat.math.ethz.ch}\\ % URL: \url{http://stat.ethz.ch/people/maechler}\\ \par\bigskip Benjamin M. Bolker\\ Departments of Mathematics \& Statistics and Biology \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ E-mail: \email{bolker@mcmaster.ca}\\ \par\bigskip Steven C. Walker\\ Department of Mathematics \& Statistics \\ McMaster University \\ 1280 Main Street W \\ Hamilton, ON L8S 4K1, Canada \\ E-mail: \email{scwalker@math.mcmaster.ca } } \newcommand{\thetavec}{{\bm\theta}} \newcommand{\betavec}{{\bm\beta}} \newcommand{\Var}{\operatorname{Var}} \newcommand{\abs}{\operatorname{abs}} \newcommand{\bLt}{\ensuremath{\bm\Lambda_{\bm\theta}}} \newcommand{\mc}[1]{\ensuremath{\mathcal{#1}}} \newcommand{\trans}{\ensuremath{^\top}} % JSS wants \top \newcommand{\yobs}{\ensuremath{\bm y_{\mathrm{obs}}}} \newcommand*{\eq}[1]{eqn.~\ref{#1}}% or just {(\ref{#1})} <>= options(width=70, show.signif.stars=FALSE, str=strOptions(strict.width="cut"), ## prefer empty continuation for reader's cut'n'paste: continue = " ", #JSS: prompt = "R> ", continue = "+ ", useFancyQuotes = FALSE) library("knitr") library("lme4") library("ggplot2")# Keeping default theme, nicer "on line": #JSS theme_set(theme_bw()) library("grid") zmargin <- theme(panel.spacing=unit(0,"lines")) library("lattice") library("minqa") library("reformulas") opts_chunk$set(engine='R',dev='pdf', fig.width=9, fig.height=5.5, prompt=TRUE, cache=TRUE, tidy=FALSE, comment=NA, error = FALSE) knitr::render_sweave() @ \setkeys{Gin}{width=\textwidth} \setkeys{Gin}{height=3.5in} \begin{document} A version of this manuscript has been published online in the \emph{Journal of Statistical Software}, on Oct.\ 2015, with DOI \linebreak[3] \texttt{10.18637/jss.v067.i01}, see \url{https://www.jstatsoft.org/article/view/v067i01/}. \section{Introduction} \label{sec:intro} The \pkg{lme4} package \citep{lme4} for \proglang{R} \citep{R} provides functions to fit and analyze linear mixed models, generalized linear mixed models and nonlinear mixed models. In each of these names, the term ``mixed'' or, more fully, ``mixed effects'', denotes a model that incorporates both fixed- and random-effects terms in a linear predictor expression from which the conditional mean of the response can be evaluated. In this paper we describe the formulation and representation of linear mixed models. The techniques used for generalized linear and nonlinear mixed models will be described separately, in a future paper. At present, the main alternative to \pkg{lme4} for mixed modeling in \proglang{R} is the \pkg{nlme} package \citep{nlme_pkg}. The main features distinguishing \pkg{lme4} from \pkg{nlme} are (1) more efficient linear algebra tools, giving improved performance on large problems; (2) simpler syntax and more efficient implementation for fitting models with crossed random effects; (3) the implementation of profile likelihood confidence intervals on random-effects parameters; and (4) the ability to fit generalized linear mixed models (although in this paper we restrict ourselves to linear mixed models). The main advantage of \pkg{nlme} relative to \pkg{lme4} is a user interface for fitting models with structure in the residuals (various forms of heteroscedasticity and autocorrelation) and in the random-effects covariance matrices (e.g., compound symmetric models). With some extra effort, the computational machinery of \pkg{lme4} can be used to fit structured models that the basic \code{lmer} function cannot handle (see Appendix~\ref{sec:modularExamples}). The development of general software for fitting mixed models remains an active area of research with many open problems. Consequently, the \pkg{lme4} package has evolved since it was first released, and continues to improve as we learn more about mixed models. However, we recognize the need to maintain stability and backward compatibility of \pkg{lme4} so that it continues to be broadly useful. In order to maintain stability while continuing to advance mixed-model computation, we have developed several additional frameworks that draw on the basic ideas of \pkg{lme4} but modify its structure or implementation in various ways. These descendants include the \mbox{\pkg{MixedModels}} package \citep{MixedModels} in \proglang{Julia} \citep{Julia}, the \pkg{lme4pureR} package \citep{lme4pureR} in \proglang{R}, and the \pkg{flexLambda} development branch of \pkg{lme4}. The current article is largely restricted to describing the current stable version of the \pkg{lme4} package (1.1-7), with Appendix~\ref{sec:modularExamples} describing hooks into the computational machinery that are designed for extension development. The \pkg{gamm4} \citep{gamm4} and \pkg{blme} \citep{blme, blme2} packages currently make use of these hooks. Another goal of this article is to contrast the approach used by \pkg{lme4} with previous formulations of mixed models. The expressions for the profiled log-likelihood and profiled REML (restricted maximum likelihood) criteria derived in Section~\ref{sec:profdev} are similar to those presented in \citet{bates04:_linear} and, indeed, are closely related to ``Henderson's mixed-model equations''~\citep{henderson_1982}. Nonetheless there are subtle but important changes in the formulation of the model and in the structure of the resulting penalized least squares (PLS) problem to be solved (Section~\ref{sec:PLSpureR}). We derive the current version of the PLS problem (Section~\ref{sec:plsMath}) and contrast this result with earlier formulations (Section~\ref{sec:previous_lmm_form}). This article is organized into four main sections (Sections~\ref{sec:lFormula}, \ref{sec:mkLmerDevfun}, \ref{sec:optimizeLmer}, and \ref{sec:mkMerMod}), each of which corresponds to one of the four largely separate modules that comprise \pkg{lme4}. Before describing the details of each module, we describe the general form of the linear mixed model underlying \pkg{lme4} (Section~\ref{sec:LMMs}); introduce the \code{sleepstudy} data that will be used as an example throughout (Section~\ref{sec:sleepstudy}); and broadly outline \pkg{lme4}'s modular structure (Section~\ref{sec:modular}). \subsection{Linear mixed models} \label{sec:LMMs} Just as a linear model is described by the distribution of a vector-valued random response variable, $\mc{Y}$, whose observed value is $\yobs$, a linear mixed model is described by the distribution of two vector-valued random variables: $\mc{Y}$, the response, and $\mc{B}$, the vector of random effects. In a linear model the distribution of $\mc Y$ is multivariate normal,%\begin{linenomath} \begin{equation} \label{eq:linearmodel} \mc Y\sim\mc{N}(\bm X\bm\beta+\bm o,\sigma^2\bm W^{-1}), \end{equation} where $n$ is the dimension of the response vector, $\bm W$ is a diagonal matrix of known prior weights, $\bm\beta$ is a $p$-dimensional coefficient vector, $\bm X$ is an $n\times p$ model matrix, and $\bm o$ is a vector of known prior offset terms. The parameters of the model are the coefficients $\bm\beta$ and the scale parameter $\sigma$. In a linear mixed model it is the \emph{conditional} distribution of $\mc Y$ given $\mc B=\bm b$ that has such a form, \begin{equation} \label{eq:LMMcondY} ( \mc Y|\mc B=\bm b)\sim\mc{N}(\bm X\bm\beta+\bm Z\bm b+\bm o,\sigma^2\bm W^{-1}), % | <- for ESS \end{equation} where $\bm Z$ is the $n\times q$ model matrix for the $q$-dimensional vector-valued random-effects variable, $\mc B$, whose value we are fixing at $\bm b$. The unconditional distribution of $\mc B$ is also multivariate normal with mean zero and a parameterized $q\times q$ variance-covariance matrix, $\bm\Sigma$, \begin{equation} \label{eq:LMMuncondB} \mc B\sim\mc N(\bm0,\bm\Sigma) . \end{equation} As a variance-covariance matrix, $\bm\Sigma$ must be positive semidefinite. It is convenient to express the model in terms of a \emph{relative covariance factor}, $\bLt$, which is a $q\times q$ matrix, depending on the \emph{variance-component parameter}, $\bm\theta$, and generating the symmetric $q\times q$ variance-covariance matrix, $\bm\Sigma$, according to%\begin{linenomath} \begin{equation} \label{eq:relcovfac} \bm\Sigma_{\bm\theta}=\sigma^2\bLt\bLt\trans , \end{equation}%\end{linenomath} where $\sigma$ is the same scale factor as in the conditional distribution (\ref{eq:LMMcondY}). Although Equations~\ref{eq:LMMcondY}, \ref{eq:LMMuncondB}, and \ref{eq:relcovfac} fully describe the class of linear mixed models that \pkg{lme4} can fit, this terse description hides many important details. Before moving on to these details, we make a few observations: \begin{itemize} \item This formulation of linear mixed models allows for a relatively compact expression for the profiled log-likelihood of $\bm\theta$ (Section~\ref{sec:profdev}, Equation~\ref{eq:profiledDeviance}). \item The matrices associated with random effects, $\bm Z$ and $\bLt$, typically have a sparse structure with a sparsity pattern that encodes various model assumptions. Sections~\ref{sec:LMMmatrix} and \ref{sec:CSCmats} provide details on these structures, and how to represent them efficiently. \item The interface provided by \pkg{lme4}'s \code{lmer} function is slightly less general than the model described by Equations~\ref{eq:LMMcondY}, \ref{eq:LMMuncondB}, and \ref{eq:relcovfac}. To take advantage of the entire range of possibilities, one may use the modular functions (Sections~\ref{sec:modular} and Appendix~\ref{sec:modularExamples}) or explore the experimental \pkg{flexLambda} branch of \pkg{lme4} on \github. \end{itemize} \subsection{Example} \label{sec:sleepstudy} Throughout our discussion of \pkg{lme4}, we will work with a data set on the average reaction time per day for subjects in a sleep deprivation study \citep{sleepstudy}. On day 0 the subjects had their normal amount of sleep. Starting that night they were restricted to 3 hours of sleep per night. The response variable, \code{Reaction}, represents average reaction times in milliseconds (ms) on a series of tests given each \code{Day} to each \code{Subject} (Figure~\ref{fig:sleepPlot}), % <>= str(sleepstudy) @ <>= ## BMB: seemed more pleasing to arrange by increasing slope rather than ## intercept ... xyplot(Reaction ~ Days | Subject, sleepstudy, aspect = "xy", layout = c(9, 2), type = c("g", "p", "r"), index.cond = function(x, y) coef(lm(y ~ x))[2], xlab = "Days of sleep deprivation", ylab = "Average reaction time (ms)", as.table = TRUE) @ % | Each subject's reaction time increases approximately linearly with the number of sleep-deprived days. However, subjects also appear to vary in the slopes and intercepts of these relationships, which suggests a model with random slopes and intercepts. As we shall see, such a model may be fitted by minimizing the REML criterion (Equation~\ref{eq:REMLdeviance}) using <>= fm1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) @ % | The estimates of the standard deviations of the random effects for the intercept and the slope are \Sexpr{round(sqrt(VarCorr(fm1)$Subject[1,1]), 2)} ms % $ and \Sexpr{round(sqrt(VarCorr(fm1)$Subject[2,2]), 2)} ms/day. % $ The fixed-effects coefficients, $\betavec$, are \Sexpr{round(fixef(fm1)[1], 1)} ms and \Sexpr{round(fixef(fm1)[2], 2)} ms/day for the intercept and slope. In this model, one interpretation of these fixed effects is that they are the estimated population mean values of the random intercept and slope (Section~\ref{sec:intuitiveFormulas}). We have chosen the \code{sleepstudy} example because it is a relatively small and simple example to illustrate the theory and practice underlying \code{lmer}. However, \code{lmer} is capable of fitting more complex mixed models to larger data sets. For example, we direct the interested reader to \code{RShowDoc("lmerperf", package = "lme4")} for examples that more thoroughly exercise the performance capabilities of \code{lmer}. \subsection{High-level modular structure} \label{sec:modular} The \code{lmer} function is composed of four largely independent modules. In the first module, a mixed-model formula is parsed and converted into the inputs required to specify a linear mixed model (Section~\ref{sec:lFormula}). The second module uses these inputs to construct an \proglang{R} function which takes the covariance parameters, $\bm\theta$, as arguments and returns negative twice the log profiled likelihood or the REML criterion (Section~\ref{sec:mkLmerDevfun}). The third module optimizes this objective function to produce maximum likelihood (ML) or REML estimates of $\bm\theta$ (Section~\ref{sec:optimizeLmer}). Finally, the fourth module provides utilities for interpreting the optimized model (Section~\ref{sec:mkMerMod}). \begin{table}[tb] \centering \begin{tabular}{lllp{2.1in}} \hline Module & & \proglang{R} function & Description \\ \hline Formula module & (Section~\ref{sec:lFormula}) & \code{lFormula} & Accepts a mixed-model formula, data, and other user inputs, and returns a list of objects required to fit a linear mixed model. \\ Objective function module & (Section~\ref{sec:mkLmerDevfun}) & \code{mkLmerDevfun} & Accepts the results of \code{lFormula} and returns a function to calculate the deviance (or restricted deviance) as a function of the covariance parameters, $\bm\theta$.\\ Optimization module & (Section~\ref{sec:optimizeLmer}) & \code{optimizeLmer} & Accepts a deviance function returned by \code{mkLmerDevfun} and returns the results of the optimization of that deviance function. \\ Output module & (Section~\ref{sec:mkMerMod}) & \code{mkMerMod} & Accepts an optimized deviance function and packages the results into a useful object. \\ \hline \end{tabular} \caption{The high-level modular structure of \code{lmer}.} \label{tab:modular} \end{table} To illustrate this modularity, we recreate the \code{fm1} object by a series of four modular steps; the formula module, <>= parsedFormula <- lFormula(formula = Reaction ~ Days + (Days | Subject), data = sleepstudy) @ the objective function module, <>= devianceFunction <- do.call(mkLmerDevfun, parsedFormula) @ the optimization module, <>= optimizerOutput <- optimizeLmer(devianceFunction) @ and the output module, <>= mkMerMod( rho = environment(devianceFunction), opt = optimizerOutput, reTrms = parsedFormula$reTrms, fr = parsedFormula$fr) @ % | \section{Formula module} \label{sec:lFormula} \subsection{Mixed-model formulas} \label{sec:formulas} Like most model-fitting functions in \proglang{R}, \code{lmer} takes as its first two arguments a \emph{formula} specifying the model and the \emph{data} with which to evaluate the formula. This second argument, \code{data}, is optional but recommended and is usually the name of an \proglang{R} data frame. In the \proglang{R} \code{lm} function for fitting linear models, formulas take the form \verb+resp ~ expr+, where \code{resp} determines the response variable and \code{expr} is an expression that specifies the columns of the model matrix. Formulas for the \code{lmer} function contain special random-effects terms, <>= resp ~ FEexpr + (REexpr1 | factor1) + (REexpr2 | factor2) + ... @ where \code{FEexpr} is an expression determining the columns of the fixed-effects model matrix, $\bm X$, and the random-effects terms, \code{(REexpr1 | factor1)} and \code{(REexpr2 | factor2)}, determine both the random-effects model matrix, $\bm Z$ (Section~\ref{sec:mkZ}), and the structure of the relative covariance factor, $\bLt$ (Section~\ref{sec:mkLambdat}). In principle, a mixed-model formula may contain arbitrarily many random-effects terms, but in practice the number of such terms is typically low. \subsection{Understanding mixed-model formulas} \label{sec:intuitiveFormulas} Before describing the details of how \pkg{lme4} parses mixed-model formulas (Section~\ref{sec:LMMmatrix}), we provide an informal explanation and then some examples. Our discussion assumes familiarity with the standard \proglang{R} modeling paradigm \citep{Chambers:1993}. Each random-effects term is of the form \code{(expr | factor)}. The expression \code{expr} is evaluated as a linear model formula, producing a model matrix following the same rules used in standard \proglang{R} modeling functions (e.g., \code{lm} or \code{glm}). The expression \code{factor} is evaluated as an \proglang{R} factor. One way to think about the vertical bar operator is as a special kind of interaction between the model matrix and the grouping factor. This interaction ensures that the columns of the model matrix have different effects for each level of the grouping factor. What makes this a special kind of interaction is that these effects are modeled as unobserved random variables, rather than unknown fixed parameters. Much has been written about important practical and philosophical differences between these two types of interactions \citep[e.g., ][]{henderson_1982,gelman2005analysis}. For example, the random-effects implementation of such interactions can be used to obtain shrinkage estimates of regression coefficients \citep[e.g., ][]{1977EfronAndMorris}, or account for lack of independence in the residuals due to block structure or repeated measurements \citep[e.g., ][]{laird_ware_1982}. Table~\ref{tab:formulas} provides several examples of the right-hand-sides of mixed-model formulas. The first example, \code{(1 | g)}, % | is the simplest possible mixed-model formula, where each level of the grouping factor, \code{g}, has its own random intercept. The mean and standard deviation of these intercepts are parameters to be estimated. Our description of this model incorporates any nonzero mean of the random effects as fixed-effects parameters. If one wishes to specify that a random intercept has \emph{a priori} known means, one may use the \code{offset} function as in the second model in Table~\ref{tab:formulas}. This model contains no fixed effects, or more accurately the fixed-effects model matrix, $\bm X$, has zero columns and $\bm\beta$ has length zero. \begin{table}[tb] \centering \begin{tabular}{llP{1.5in}} %% see new column type for ragged right \hline Formula & Alternative & Meaning \\ \hline%------------------------------------------------ \code{(1 | g)} & \code{1 + (1 | g)} & Random intercept with fixed mean. \\ \code{0 + offset(o) + (1 | g)} & \code{-1 + offset(o) + (1 | g)} & Random intercept with \emph{a priori} means. \\ \code{(1 | g1/g2)} & \code{(1 | g1)+(1 | g1:g2)} % | & Intercept varying among \code{g1} and \code{g2} within \code{g1}. \\ \code{(1 | g1) + (1 | g2)} & \code{1 + (1 | g1) + (1 | g2)}. & Intercept varying among \code{g1} and \code{g2}. \\ \code{x + (x | g)} & \code{1 + x + (1 + x | g)} & Correlated random intercept and slope. \\ \code{x + (x || g)} & \code{1 + x + (1 | g) + (0 + x | g)} & Uncorrelated random intercept and slope. \\ \hline \end{tabular} \caption{Examples of the right-hand-sides of mixed-effects model formulas. The names of grouping factors are denoted \code{g}, \code{g1}, and \code{g2}, and covariates and \emph{a priori} known offsets as \code{x} and \code{o}.} \label{tab:formulas} \end{table} We may also construct models with multiple grouping factors. For example, if the observations are grouped by \code{g2}, which is nested within \code{g1}, then the third formula in Table \ref{tab:formulas} can be used to model variation in the intercept. A common objective in mixed modeling is to account for such nested (or hierarchical) structure. However, one of the most useful aspects of \pkg{lme4} is that it can be used to fit random effects associated with non-nested grouping factors. For example, suppose the data are grouped by fully crossing two factors, \code{g1} and \code{g2}, then the fourth formula in Table \ref{tab:formulas} may be used. Such models are common in item response theory, where \code{subject} and \code{item} factors are fully crossed \citep{doran2007estimating}. In addition to varying intercepts, we may also have varying slopes (e.g., the \code{sleepstudy} data, Section~\ref{sec:sleepstudy}). The fifth example in Table~\ref{tab:formulas} gives a model where both the intercept and slope vary among the levels of the grouping factor. \subsubsection{Specifying uncorrelated random effects} \label{sec:uncor} By default, \pkg{lme4} assumes that all coefficients associated with the same random-effects term are correlated. To specify an uncorrelated slope and intercept (for example), one may either use double-bar notation, \code{(x || g)}, or equivalently use multiple random-effects terms, \code{x + (1 | g) + (0 + x | g)}, as in the final example of Table~\ref{tab:formulas}. For example, if one examined the results of model \code{fm1} of the \code{sleepstudy} data (Section~\ref{sec:sleepstudy}) using \code{summary(fm1)}, one would see that the estimated correlation between the slope for \code{Days} and the intercept is fairly low (\Sexpr{round(attr(VarCorr(fm1)$Subject, "correlation")[2],3)}) % $ (See Section~\ref{sec:summary} below for more on how to extract the random-effects covariance matrix.) We may use double-bar notation to fit a model that excludes a correlation parameter: <>= fm2 <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy) @ Although mixed models where the random slopes and intercepts are assumed independent are commonly used to reduce the complexity of random-slopes models, they do have one subtle drawback. Models in which the slopes and intercepts are allowed to have a nonzero correlation (e.g., \code{fm1}) are invariant to additive shifts of the continuous predictor (\code{Days} in this case). This invariance breaks down when the correlation is constrained to zero; any shift in the predictor will necessarily lead to a change in the estimated correlation, and in the likelihood and predictions of the model. For example, we can eliminate the correlation in \code{fm1} simply by adding an amount equal to the ratio of the estimated among-subject standard deviations multiplied by the estimated correlation (i.e., $\sigma_{\text{\small slope}}/\sigma_{\text{\small intercept}} \cdot \rho_{\text{\small slope:intercept}}$) to the \code{Days} variable. The use of models such as \code{fm2} should ideally be restricted to cases where the predictor is measured on a ratio scale (i.e., the zero point on the scale is meaningful, not just a location defined by convenience or convention), as is the case here. %% <>= %% sleepstudyShift <- within(sleepstudy, { %% Days <- Days + (24.74*0.07)/5.92 }) %% lmer(Reaction ~ Days + (Days | Subject), sleepstudyShift) %% @ \subsection{Algebraic and computational account of mixed-model formulas} \label{sec:LMMmatrix} The fixed-effects terms of a mixed-model formula are parsed to produce the fixed-effects model matrix, $\bm X$, in the same way that the \proglang{R} \code{lm} function generates model matrices. However, a mixed-model formula incorporates $k\ge1$ random-effects terms of the form \code{(r | f)} as well. % | These $k$ terms are used to produce the random-effects model matrix, $\bm Z$ (Equation~\ref{eq:LMMcondY}; Section~\ref{sec:mkZ}), and the structure of the relative covariance factor, $\bLt$ (Equation~\ref{eq:relcovfac}; Section~\ref{sec:mkLambdat}), which are matrices that typically have a sparse structure. We now describe how one might construct these matrices from the random-effects terms, considering first a single term, \code{(r | f)}, % | and then generalizing to multiple terms. Tables~\ref{tab:dim} and \ref{tab:algebraic} summarize the matrices and vectors that determine the structure of $\bm Z$ and $\bLt$. \begin{table}[tb] \centering \begin{tabular}{lll} \hline Symbol & Size \\ \hline $n$ & Length of the response vector, $\mc{Y}$ \\ $p$ & Number of columns of fixed-effects model matrix, $\bm X$ \\ $q = \sum_i^k q_i$ & Number of columns of random-effects model matrix, $\bm Z$ \\ $p_i$ & Number of columns of the raw model matrix, $\bm X_i$ \\ $\ell_i$ & Number of levels of the grouping factor indices, $\bm i_i$ \\ $q_i = p_i\ell_i$ & Number of columns of the term-wise model matrix, $\bm Z_i$ \\ $k$ & Number of random-effects terms \\ $m_i = \binom{p_i+1}{2}$ & Number of covariance parameters for term $i$ \\ $m = \sum_i^k m_i$ & Total number of covariance parameters \\ \hline \end{tabular} \caption{Dimensions of linear mixed models. The subscript $i = 1, \dots, k$ denotes a specific random-effects term.} \label{tab:dim} \end{table} \begin{table}[tb] \centering \begin{tabular}{lll} \hline Symbol & Size & Description \\ \hline $\bm X_i$ & $n\times p_i$ & Raw random-effects model matrix \\ $\bm J_i$ & $n\times \ell_i$ & Indicator matrix of grouping factor indices\\ $\bm X_{ij}$ & $p_i\times 1$ & Column vector containing $j$th row of $\bm X_i$ \\ $\bm J_{ij}$ & $\ell_i\times 1$ & Column vector containing $j$th row of $\bm J_i$ \\ $\bm i_i$ & $n$ & Vector of grouping factor indices \\ $\bm Z_i$ & $n\times q_i$ & Term-wise random-effects model matrix \\ $\bm\theta$ & $m$ & Covariance parameters \\ $\bm T_i$ & $p_i\times p_i$ & Lower triangular template matrix \\ $\bm\Lambda_i$ & $q_i\times q_i$ & Term-wise relative covariance factor \\ \hline \end{tabular} \caption{Symbols used to describe the structure of the random-effects model matrix and the relative covariance factor. The subscript $i = 1, \dots, k$ denotes a specific random-effects term.} \label{tab:algebraic} \end{table} The expression, \code{r}, is a linear model formula that evaluates to an \proglang{R} model matrix, $\bm X_i$, of size $n\times p_i$, called the \emph{raw random-effects model matrix} for term $i$. A term is said to be a \emph{scalar} random-effects term when $p_i=1$, otherwise it is \emph{vector-valued}. For a \emph{simple, scalar} random-effects term of the form \code{(1 | f)}, $\bm X_i$ is the % | $n\times 1$ matrix of ones, which implies a random intercept model. The expression \code{f} evaluates to an \proglang{R} factor, called the \emph{grouping factor}, for the term. For the $i$th term, we represent this factor mathematically with a vector $\bm i_i$ of \emph{factor indices}, which is an $n$-vector of values from $1,\dots,\ell_i$.\footnote{In practice, fixed-effects model matrices and random-effects terms are evaluated with respect to a \emph{model frame}, ensuring that any expressions for grouping factors have been coerced to factors and any unused levels of these factors have been dropped. That is, $\ell_i$, the number of levels in the grouping factor for the $i$th random-effects term, is well-defined.} Let $\bm J_i$ be the $n\times \ell_i$ matrix of indicator columns for $\bm i_i$. Using the \pkg{Matrix} package \citep{Matrix_pkg} in \proglang{R}, we may construct the transpose of $\bm J_i$ from a factor vector, \code{f}, by coercing \code{f} to a `\code{sparseMatrix}' object. For example, <>= set.seed(2) @ <>= (f <- gl(3, 2)) (Ji <- t(as(f, Class = "sparseMatrix"))) @ When $k>1$ we order the random-effects terms so that $\ell_1\ge\ell_2\ge\dots\ge\ell_k$; in general, this ordering reduces ``fill-in'' (i.e., the proportion of elements that are zero in the lower triangle of $\bLt\trans\bm Z\trans\bm W\bm Z\bLt+\bm I$ but not in the lower triangle of its left Cholesky factor, $\bm L_{\bm\theta}$, described below in Equation~\ref{eq:blockCholeskyDecomp}). This reduction in fill-in provides more efficient matrix operations within the penalized least squares algorithm (Section~\ref{sec:plsMath}). \subsubsection{Constructing the random-effects model matrix} \label{sec:mkZ} The $i$th random-effects term contributes $q_i=\ell_ip_i$ columns to the model matrix $\bm Z$. We group these columns into a matrix, $\bm Z_i$, which we refer to as the \emph{term-wise model matrix} for the $i$th term. Thus $q$, the number of columns in $\bm Z$ and the dimension of the random variable, $\mc{B}$, is \begin{equation} \label{eq:qcalc} q=\sum_{i=1}^k q_i = \sum_{i=1}^k \ell_i\,p_i . \end{equation} Creating the matrix $\bm Z_i$ from $\bm X_i$ and $\bm J_i$ is a straightforward concept that is, nonetheless, somewhat awkward to describe. Consider $\bm Z_i$ as being further decomposed into $\ell_i$ blocks of $p_i$ columns. The rows in the first block are the rows of $\bm X_i$ multiplied by the 0/1 values in the first column of $\bm J_i$ and similarly for the subsequent blocks. With these definitions we may define the term-wise random-effects model matrix, $\bm Z_i$, for the $i$th term as a transposed Khatri-Rao product, \begin{equation} \label{eq:Zi} \bm Z_i = (\bm J_i\trans * \bm X_i\trans)\trans = \begin{bmatrix} \bm J_{i1}\trans \otimes \bm X_{i1}\trans \\ \bm J_{i2}\trans \otimes \bm X_{i2}\trans \\ \vdots \\ \bm J_{in}\trans \otimes \bm X_{in}\trans \\ \end{bmatrix}, \end{equation} where $*$ and $\otimes$ are the Khatri-Rao\footnote{Note that the original definition of the Khatri-Rao product is more general than the definition used in the \pkg{Matrix} package, which is the definition we use here.} \citep{khatri1968solutions} and Kronecker products, and $\bm J_{ij}\trans$ and $\bm X_{ij}\trans$ are row vectors of the $j$th rows of $\bm J_i$ and $\bm X_i$. These rows correspond to the $j$th sample in the response vector, $\mc Y$, and thus $j$ runs from $1, \dots, n$. The \pkg{Matrix} package for \proglang{R} contains a \code{KhatriRao} function, which can be used to form $\bm Z_i$. For example, if we begin with a raw model matrix, <>= (Xi <- cbind(1, rep.int(c(-1, 1), 3L))) @ then the term-wise random-effects model matrix is, <>= (Zi <- t(KhatriRao(t(Ji), t(Xi)))) @ <>= ## alternative formulation of Zi (eq:Zi) rbind( Ji[1,] %x% Xi[1,], Ji[2,] %x% Xi[2,], Ji[3,] %x% Xi[3,], Ji[4,] %x% Xi[4,], Ji[5,] %x% Xi[5,], Ji[6,] %x% Xi[6,]) @ In particular, for a simple, scalar term, $\bm Z_i$ is exactly $\bm J_i$, the matrix of indicator columns. For other scalar terms, $\bm Z_i$ is formed by element-wise multiplication of the single column of $\bm X_i$ by each of the columns of $\bm J_i$. Because each $\bm Z_i$ is generated from indicator columns, its cross-product, $\bm Z_i\trans\bm Z_i$ is block-diagonal consisting of $\ell_i$ diagonal blocks each of size $p_i$.\footnote{To see this, note that by the properties of Kronecker products we may write the cross-product matrix $Z_i\trans Z_i$ as $\sum_{j=1}^n \bm J_{ij} \bm J_{ij}\trans \otimes \bm X_{ij} \bm X_{ij}\trans$. Because $\bm J_{ij}$ is a unit vector along a coordinate axis, the cross-product $\bm J_{ij} \bm J_{ij}\trans$ is a $p_i\times p_i$ matrix of all zeros except for a single $1$ along the diagonal. Therefore, the cross-products, $\bm X_{ij} \bm X_{ij}\trans$, will be added to one of the $\ell_i$ blocks of size $p_i\times p_i$ along the diagonal of $Z_i\trans Z_i$.} Note that this means that when $k=1$ (i.e., there is only one random-effects term, and $\bm Z_i = \bm Z$), $\bm Z\trans\bm Z$ will be block diagonal. These block-diagonal properties allow for more efficient sparse matrix computations (Section~\ref{sec:CSCmats}). The full random-effects model matrix, $\bm Z$, is constructed from $k\ge 1$ blocks, \begin{equation} \label{eq:Z} \bm Z = \begin{bmatrix} \bm Z_1 & \bm Z_2 & \hdots & \bm Z_k \\ \end{bmatrix}. \end{equation} By transposing Equation~\ref{eq:Z} and substituting in Equation~\ref{eq:Zi}, we may represent the structure of the transposed random-effects model matrix as follows, \begin{equation} \label{eq:Zt} \bm Z\trans = \begin{blockarray}{ccccc} \text{sample 1} & \text{sample 2} & \hdots & \text{sample } n & \\ \begin{block}{[cccc]c} \bm J_{11} \otimes \bm X_{11} & \bm J_{12} \otimes \bm X_{12} & \hdots & \bm J_{1n} \otimes \bm X_{1n} & \text{term 1} \\ \bm J_{21} \otimes \bm X_{21} & \bm J_{22} \otimes \bm X_{22} & \hdots & \bm J_{2n} \otimes \bm X_{2n} & \text{term 2} \\ \vdots & \vdots & \ddots & \vdots & \vdots \\ \end{block} \end{blockarray}. \end{equation} Note that the proportion of elements of $Z\trans$ that are structural zeros is \begin{equation} \label{eq:ZtSparsity} \frac{\sum_{i=1}^k p_i(\ell_i - 1)}{\sum_{i=1}^k p_i} \qquad . \end{equation} Therefore, the sparsity of $\bm Z\trans$ increases with the number of grouping factor levels. As the number of levels is often large in practice, it is essential for speed and efficiency to take account of this sparsity, for example by using sparse matrix methods, when fitting mixed models (Section~\ref{sec:CSCmats}). \subsubsection{Constructing the relative covariance factor} \label{sec:mkLambdat} The $q\times q$ covariance factor, $\bLt$, is a block diagonal matrix whose $i$th diagonal block, $\bm\Lambda_i$, is of size $q_i,i=1,\dots,k$. We refer to $\bm\Lambda_i$ as the \emph{term-wise relative covariance factor}. Furthermore, $\bm\Lambda_i$ is a homogeneous block diagonal matrix with each of the $\ell_i$ lower-triangular blocks on the diagonal being a copy of a $p_i\times p_i$ lower-triangular \emph{template matrix}, $\bm T_i$. The covariance parameter vector, $\bm\theta$, of length $m_i =\binom{p_i+1}{2}$, consists of the elements in the lower triangle of $\bm T_i,i=1,\dots,k$. To provide a unique representation we require that the diagonal elements of the $\bm T_i,i=1,\dots,k$ be non-negative. The template, $\bm T_i$, can be constructed from the number $p_i$ alone. In \proglang{R} code we denote $p_i$ as \code{nc}. For example, if we set \code{nc <- 3}\Sexpr{nc <- 3}, we could create the template for term $i$ as, <>= nc <- 3 @ %% sequence() is equivalent to unlist(lapply(nvec, seq_len)) %% and (?sequence) ``mainly exists in reverence to the very early history of R'' %% scw: i like sequence, and in fact i never understood why that %% statement is there in the help file. <